gen_defs.c

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