source: lmdz_wrf/branches/LMDZ_WRFmeas/WRFV3/tools/gen_defs.c @ 102

Last change on this file since 102 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 9.2 KB
Line 
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
12enum sw_ranges { COLON_RANGE , ARGADJ , GRIDREF } ;
13enum sw_pointdecl { POINTERDECL , NOPOINTERDECL } ;
14
15int
16gen_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
31int
32gen_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
48int
49gen_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
68int
69gen_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
89int
90gen_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
137int
138gen_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
237int
238gen_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/*
274int
275gen_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*/
Note: See TracBrowser for help on using the repository browser.