tools/gen_defs.c

   1 #include <stdio.h>
   2 #include <stdlib.h>
   3 #include <string.h>
   4 #ifndef _WIN32
   5 # include <strings.h>
   6 #endif
   7
   8 #include "protos.h"
   9 #include "registry.h"
  10 #include "data.h"
  11
  12 enum sw_ranges { COLON_RANGE , ARGADJ , GRIDREF } ;
  13 enum sw_pointdecl { POINTERDECL , NOPOINTERDECL } ;
  14
  15 int
  16 gen_state_struct ( char * dirname )
  17 {
  18   FILE * fp ;
  19   char  fname[NAMELEN] ;
  20   char * fn = "state_struct.inc" ;
  21
  22   strcpy( fname, fn ) ;
  23   if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
  24   if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
  25   print_warning(fp,fname) ;
  26   gen_decls ( fp , &Domain , COLON_RANGE , POINTERDECL , FIELD | RCONFIG | FOURD , DRIVER_LAYER ) ;
  27   close_the_file( fp ) ;
  28   return(0) ;
  29 }
  30
  31 int
  32 gen_state_subtypes ( char * dirname )
  33 {
  34   FILE * fp ;
  35   char  fname[NAMELEN] ;
  36   char * fn = "state_subtypes.inc" ;
  37
  38   strcpy( fname, fn ) ;
  39   if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
  40
  41   if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
  42   print_warning(fp,fname) ;
  43   gen_state_subtypes1( fp , &Domain , COLON_RANGE , POINTERDECL , FIELD | RCONFIG | FOURD ) ;
  44   close_the_file(fp) ;
  45   return(0) ;
  46 }
  47
  48 int
  49 gen_dummy_decls ( char * dn )
  50 {
  51   FILE * fp ;
  52   char fname[NAMELEN] ;
  53   char * fn = "dummy_decl.inc" ;
  54
  55   if ( dn == NULL ) return(1) ;
  56   if ( strlen(dn) > 0 ) { sprintf(fname,"%s/%s",dn,fn) ; }
  57   else                  { sprintf(fname,"%s",fn) ; }
  58   if ((fp = fopen( fname , "w" )) != NULL ) {
  59     print_warning(fp,fname) ;
  60     gen_decls ( fp, &Domain , GRIDREF , NOPOINTERDECL , FIELD | FOURD , MEDIATION_LAYER ) ;
  61     fprintf(fp,"#undef COPY_IN\n") ;
  62     fprintf(fp,"#undef COPY_OUT\n") ;
  63     close_the_file( fp ) ;
  64   }
  65   return(0);
  66 }
  67
  68 int
  69 gen_dummy_decls_new ( char * dn )
  70 {
  71   FILE * fp ;
  72   char fname[NAMELEN] ;
  73   char * fn = "dummy_new_decl.inc" ;
  74
  75   if ( dn == NULL ) return(1) ;
  76   if ( strlen(dn) > 0 ) { sprintf(fname,"%s/%s",dn,fn) ; }
  77   else                  { sprintf(fname,"%s",fn) ; }
  78   if ((fp = fopen( fname , "w" )) != NULL ) {
  79     print_warning(fp,fname) ;
  80     gen_decls ( fp, &Domain , GRIDREF , NOPOINTERDECL , FOURD | FIELD | BDYONLY , MEDIATION_LAYER ) ;
  81     fprintf(fp,"#undef COPY_IN\n") ;
  82     fprintf(fp,"#undef COPY_OUT\n") ;
  83     close_the_file( fp ) ;
  84   }
  85   return(0);
  86 }
  87
  88
  89 int
  90 gen_i1_decls ( char * dn )
  91 {
  92   FILE * fp ;
  93   char  fname[NAMELEN], post[NAMELEN] ;
  94   char * fn = "i1_decl.inc" ;
  95   char * dimspec ;
  96   node_t * p ;
  97
  98   if ( dn == NULL ) return(1) ;
  99   if ( strlen(dn) > 0 ) { sprintf(fname,"%s/%s",dn,fn) ; }
 100   else                  { sprintf(fname,"%s",fn) ; }
 101   if ((fp = fopen( fname , "w" )) != NULL ) {
 102     print_warning(fp,fname) ;
 103     gen_decls ( fp , &Domain , GRIDREF , NOPOINTERDECL , I1 , MEDIATION_LAYER ) ;
 104
 105     /* now generate tendencies for 4d vars if specified  */
 106     for ( p = FourD ; p != NULL ; p = p->next )
 107     {
 108       if ( p->node_kind & FOURD && p->has_scalar_array_tendencies )
 109       {
 110         sprintf(fname,"%s_tend",p->name) ;
 111         sprintf(post,",num_%s)",p->name) ;
 112         dimspec=dimension_with_ranges( "grid%",",DIMENSION(",-1,t2,p,post,"" ) ;
 113         /*          type dim pdecl   name */
 114         fprintf(fp, "%-10s%-20s%-10s :: %s\n",
 115                     field_type( t1, p ) ,
 116                     dimspec ,
 117                     "" ,
 118                     fname ) ;
 119         sprintf(fname,"%s_old",p->name) ;
 120         sprintf(post,",num_%s)",p->name) ;
 121         dimspec=dimension_with_ranges( "grid%",",DIMENSION(",-1,t2,p,post,"" ) ;
 122         /*          type dim pdecl   name */
 123         fprintf(fp, "#ifndef NO_I1_OLD\n") ;
 124         fprintf(fp, "%-10s%-20s%-10s :: %s\n",
 125                     field_type( t1, p ) ,
 126                     dimspec ,
 127                     "" ,
 128                     fname ) ;
 129         fprintf(fp, "#endif\n") ;
 130       }
 131     }
 132     close_the_file( fp ) ;
 133   }
 134   return(0) ;
 135 }
 136
 137 int
 138 gen_decls ( FILE * fp , node_t * node , int sw_ranges, int sw_point , int mask , int layer )
 139 {
 140   node_t * p ;
 141   int tag, ipass ;
 142   char fname[NAMELEN], post[NAMELEN] ;
 143   char * dimspec ;
 144   int bdyonly = 0 ;
 145
 146   if ( node == NULL ) return(1) ;
 147
 148   bdyonly = mask & BDYONLY ;
 149
 150 /* make two passes; the first is for scalars, second for arrays.                     */
 151 /* do it this way so that the scalars get declared first (some compilers complain    */
 152 /* if a scalar is used to declare an array before it's declared)                     */
 153
 154   for ( ipass = 0 ; ipass < 2 ; ipass++ )
 155   {
 156   for ( p = node->fields ; p != NULL ; p = p->next )
 157   {
 158     if ( p->node_kind & mask )
 159     {
 160       /* add an extra dimension to the 4d arrays.                                       */
 161       /* note the call to dimension_with_colons, below, does this by itself             */
 162       /* but dimension_with_ranges needs help (since the last arg is not just a colon)  */
 163
 164       if       ( p->node_kind & FOURD ) {
 165           sprintf(post,",num_%s)",field_name(t4,p,0)) ;
 166       } else {
 167           sprintf(post,")") ;
 168       }
 169
 170       for ( tag = 1 ; tag <= p->ntl ; tag++ )
 171       {
 172         strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
 173
 174         if ( ! p->boundary_array || ! sw_new_bdys ) {
 175           switch ( sw_ranges )
 176           {
 177             case COLON_RANGE :
 178               dimspec=dimension_with_colons( ",DIMENSION(",t2,p,")" ) ; break ;
 179             case GRIDREF :
 180               dimspec=dimension_with_ranges( "grid%",",DIMENSION(",-1,t2,p,post,"" ) ; break ;
 181             case ARGADJ :
 182               dimspec=dimension_with_ranges( "",",DIMENSION(",-1,t2,p,post,"" ) ; break ;
 183           }
 184         } else {
 185           dimspec="dummy" ; /* allow fall through on next tests. dimension with ranges will be called again anyway for bdy arrays */
 186         }
 187
 188         if ( !strcmp( dimspec, "" ) && ipass == 1 ) continue ; /* short circuit scalars on 2nd pass  */
 189         if (  strcmp( dimspec, "" ) && ipass == 0 ) continue ; /* short circuit arrays on 2nd pass   */
 190         if ( bdyonly && p->node_kind & FIELD && ! p->boundary_array )  continue ;  /* short circuit all fields except bdy arrrays */
 191
 192         if ( p->boundary_array && sw_new_bdys ) {
 193           if ( layer == DRIVER_LAYER || associated_with_4d_array(p) ) {
 194           int bdy ;
 195           for ( bdy = 1; bdy <=4 ; bdy++ ) {
 196             switch ( sw_ranges )
 197             {
 198               case COLON_RANGE :
 199                 dimspec=dimension_with_colons( ",DIMENSION(",t2,p,")" ) ; break ;
 200               case GRIDREF :
 201                 dimspec=dimension_with_ranges( "grid%",",DIMENSION(",bdy,t2,p,post,"" ) ; break ;
 202               case ARGADJ :
 203                 dimspec=dimension_with_ranges( "",",DIMENSION(",bdy,t2,p,post,"" ) ; break ;
 204             }
 205             /*          type dim pdecl   name */
 206             fprintf(fp, "%-10s%-20s%-10s :: %s%s\n",
 207                         field_type( t1, p ) ,
 208                         dimspec ,
 209                         (sw_point==POINTERDECL)?declare_array_as_pointer(t3,p):"" ,
 210                         fname, bdy_indicator( bdy )  ) ;
 211           }
 212           }
 213         } else {
 214           switch ( sw_ranges )
 215           {
 216             case COLON_RANGE :
 217               dimspec=dimension_with_colons( ",DIMENSION(",t2,p,")" ) ; break ;
 218             case GRIDREF :
 219               dimspec=dimension_with_ranges( "grid%",",DIMENSION(",-1,t2,p,post,"" ) ; break ;
 220             case ARGADJ :
 221               dimspec=dimension_with_ranges( "",",DIMENSION(",-1,t2,p,post,"" ) ; break ;
 222           }
 223           /*          type dim pdecl   name */
 224           fprintf(fp, "%-10s%-20s%-10s :: %s\n",
 225                       field_type( t1, p ) ,
 226                       dimspec ,
 227                       (sw_point==POINTERDECL)?declare_array_as_pointer(t3,p):"" ,
 228                       fname ) ;
 229         }
 230       }
 231     }
 232   }
 233   }
 234   return(0) ;
 235 }
 236
 237 int
 238 gen_state_subtypes1 ( FILE * fp , node_t * node , int sw_ranges , int sw_point , int mask )
 239 {
 240   node_t * p ;
 241   int i ;
 242   int new;
 243   char TypeName [NAMELEN] ;
 244   char tempname [NAMELEN] ;
 245   if ( node == NULL ) return(1) ;
 246   for ( p = node->fields ; p != NULL ; p = p->next )
 247   {
 248     if ( p->type != NULL )
 249       if ( p->type->type_type == DERIVED )
 250       {
 251         new = 1 ;    /* determine if this is a new type -ajb */
 252         strcpy( tempname, p->type->name ) ;
 253         for ( i = 0 ; i < get_num_typedefs() ; i++ )
 254         {
 255           strcpy( TypeName, get_typename_i(i) ) ;
 256           if ( ! strcmp( TypeName, tempname ) ) new = 0 ;
 257         }
 258
 259         if ( new )   /* add this type to the history and generate declarations -ajb */
 260         {
 261           add_typedef_name ( tempname ) ;
 262           gen_state_subtypes1 ( fp , p->type , sw_ranges , sw_point , mask ) ;
 263           fprintf(fp,"TYPE %s\n",p->type->name) ;
 264           gen_decls ( fp , p->type , sw_ranges , sw_point , mask , DRIVER_LAYER ) ;
 265           fprintf(fp,"END TYPE %s\n",p->type->name) ;
 266         }
 267       }
 268   }
 269   return(0) ;
 270 }
 271
 272 /* old version of gen_state_subtypes1 -ajb */
 273 /*
 274 int
 275 gen_state_subtypes1 ( FILE * fp , node_t * node , int sw_ranges , int sw_point , int mask )
 276 {
 277   node_t * p ;
 278   int tag ;
 279   if ( node == NULL ) return(1) ;
 280   for ( p = node->fields ; p != NULL ; p = p->next )
 281   {
 282     if ( p->type != NULL )
 283       if ( p->type->type_type == DERIVED )
 284       {
 285         gen_state_subtypes1 ( fp , p->type , sw_ranges , sw_point , mask ) ;
 286         fprintf(fp,"TYPE %s\n",p->type->name) ;
 287         gen_decls ( fp , "", p->type , sw_ranges , sw_point , mask , DRIVER_LAYER ) ;
 288         fprintf(fp,"END TYPE %s\n",p->type->name) ;
 289       }
 290   }
 291   return(0) ;
 292 }
 293 */