source: trunk/WRF.COMMON/WRFV3/tools/gen_defs.c @ 3094

Last change on this file since 3094 was 2759, checked in by aslmd, 2 years ago

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