source: lmdz_wrf/trunk/WRFV3/tools/gen_args.c @ 1393

Last change on this file since 1393 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: 5.1 KB
Line 
1#include <stdio.h>
2#include <stdlib.h>
3#include <string.h>
4#ifdef _WIN32
5#define rindex(X,Y) strrchr(X,Y)
6#define index(X,Y) strchr(X,Y)
7#else
8# include <strings.h>
9#endif
10 
11
12#include "protos.h"
13#include "registry.h"
14#include "data.h"
15
16#define DUMMY 1
17#define ACTUAL 2
18#define DUMMY_NEW 3
19#define ACTUAL_NEW 4
20
21int
22gen_actual_args ( char * dirname )
23{
24  gen_args ( dirname , ACTUAL ) ; 
25  return(0) ;
26}
27
28/* only generate actual args for the 4d arrays */
29int
30gen_actual_args_new ( char * dirname )
31{
32  gen_args ( dirname , ACTUAL_NEW ) ;
33  return(0) ;
34}
35
36int
37gen_dummy_args ( char * dirname )
38{
39  gen_args ( dirname , DUMMY ) ;
40  return(0) ;
41}
42
43/* only generate dummy args for the 4d arrays */
44int
45gen_dummy_args_new ( char * dirname )
46{
47  gen_args ( dirname , DUMMY_NEW ) ;
48  return(0) ;
49}
50
51int
52gen_args ( char * dirname , int sw )
53{
54  FILE * fp ;
55  char  fname[NAMELEN] ;
56  char * fn = "_args.inc" ;
57  char * p ;
58  int linelen ;
59  /* Had to increase size for SOA from 64*4096 to 64*7000 */
60  char outstr[64*7000] ;
61
62  if ( dirname == NULL ) return(1) ;
63  if ( strlen(dirname) > 0 ) 
64   { sprintf(fname,"%s/%s%s%s",dirname,
65             (sw==ACTUAL||sw==ACTUAL_NEW)?"actual":"dummy",(sw==ACTUAL_NEW||sw==DUMMY_NEW)?"_new":"",fn) ; }
66  else                       
67   { sprintf(fname,"%s%s%s",
68             (sw==ACTUAL||sw==ACTUAL_NEW)?"actual":"dummy",(sw==ACTUAL_NEW||sw==DUMMY_NEW)?"_new":"",fn) ; }
69
70  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
71  print_warning(fp,fname) ;
72  linelen = 0 ;
73  strcpy(outstr,",") ;
74  gen_args1 ( fp , outstr, (sw==ACTUAL||sw==ACTUAL_NEW)?"grid%":"",
75              &Domain , &linelen , sw , 0 ) ;
76  /* remove trailing comma */
77  if ((p=rindex(outstr,','))!=NULL) *p = '\0' ;
78  fputs(outstr,fp);fputs(" &\n",fp) ;
79  close_the_file( fp ) ;
80  return(0) ;
81}
82
83int
84gen_args1 ( FILE * fp , char * outstr , char * structname , 
85            node_t * node , int *linelen , int sw , int deep )
86{
87  node_t * p ;
88  int tag ;
89  char post[NAMELEN] ;
90  char fname[NAMELEN] ;
91  char x[NAMELEN], y[NAMELEN] ;
92  char indices[NAMELEN] ;
93  int lenarg ; 
94  int only4d = 0 ;
95
96  if ( sw == ACTUAL_NEW ) { sw = ACTUAL ; only4d = 1 ; }
97  if ( sw == DUMMY_NEW )  { sw = DUMMY  ; only4d = 1 ; }
98
99  if ( node == NULL ) return(1) ;
100  for ( p = node->fields ; p != NULL ; p = p->next )
101  {
102    if ( p->node_kind & I1 ) continue ;              /* short circuit any field that is not state */
103                                                     /* short circuit scalars; shortening argument lists */
104    if ( p->ndims == 0 && p->type->type_type != DERIVED && sw_limit_args ) continue ; 
105
106    if (                 (
107          (p->node_kind & FOURD)                   /* scalar arrays or */
108                                                   /* it is not a derived type -ajb */
109       || (p->node_kind & FIELD && (p->type->type_type != DERIVED) ) 
110                         )
111       )
112    {
113      if (!only4d || (p->node_kind & FOURD) || associated_with_4d_array(p) ) {
114        if      ( p->node_kind & FOURD ) { sprintf(post,",1)") ; }
115        else if ( p->boundary_array )     { sprintf(post,")") ; }
116        else                              { sprintf(post,")") ; }
117        for ( tag = 1 ; tag <= p->ntl ; tag++ )
118        {
119          /* if this is a core-specific variable, prepend the name of the core to */
120          /* the variable at the driver level */
121          if ( p->boundary_array && sw_new_bdys ) {
122            int bdy ;
123            for ( bdy = 1 ; bdy <= 4 ; bdy++ ) {
124              strcpy(fname,field_name_bdy(t4,p,(p->ntl>1)?tag:0,bdy)) ;
125              strcpy(indices,"") ;
126              if ( sw_deref_kludge && sw==ACTUAL ) 
127                sprintf(indices, "%s",index_with_firstelem("(","",bdy,t2,p,post)) ;
128              /* generate argument */
129              strcpy(y,structname) ; strcat(y,fname) ; strcat(y,indices) ; strcat(y,",") ;
130              lenarg = strlen(y) ;
131              if ( lenarg+*linelen > MAX_ARGLINE ) { strcat(outstr," &\n") ; *linelen = 0 ; }
132              strcat(outstr,y) ;
133              *linelen += lenarg ;
134            }
135          } else {
136            strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
137            strcpy(indices,"") ;
138            if ( sw_deref_kludge && sw==ACTUAL )
139              sprintf(indices, "%s",index_with_firstelem("(","",-1,t2,p,post)) ;
140            /* generate argument */
141            strcpy(y,structname) ; strcat(y,fname) ; strcat(y,indices) ; strcat(y,",") ;
142            lenarg = strlen(y) ;
143            if ( lenarg+*linelen > MAX_ARGLINE ) { strcat(outstr," &\n") ; *linelen = 0 ; }
144            strcat(outstr,y) ;
145            *linelen += lenarg ;
146          }
147        }
148      }
149    }
150    if ( p->type != NULL )
151    {
152      if ( p->type->type_type == DERIVED && !only4d )
153      {
154        if ( deep )
155        {
156          sprintf(x,"%s%s%%",structname,p->name ) ;
157          gen_args1(fp, outstr, (sw==ACTUAL)?x:"", p->type,linelen,sw,deep) ;
158        }
159        else
160        {
161          /* generate argument */
162          strcpy(y,structname) ; strcat(y,p->name) ; strcat(y,",") ;
163          lenarg = strlen(y) ;
164          if ( lenarg+*linelen > MAX_ARGLINE ) { strcat(outstr," &\n") ; *linelen = 0 ; }
165          strcat(outstr,y) ;
166          *linelen += lenarg ;
167          p->mark = 1 ;
168        }
169      }
170    }
171  }
172  return(0) ;
173}
174
Note: See TracBrowser for help on using the repository browser.