Merge remote-tracking branch 'origin/release-v4.6.1'
[WRF.git] / tools / gen_args.c
blobea995d4230fbfd329ca65ad87a8f417cdc7d2cdc
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
12 #include "protos.h"
13 #include "registry.h"
14 #include "data.h"
16 #define DUMMY 1
17 #define ACTUAL 2
18 #define DUMMY_NEW 3
19 #define ACTUAL_NEW 4
21 int
22 gen_actual_args ( char * dirname )
24 gen_args ( dirname , ACTUAL ) ;
25 return(0) ;
28 /* only generate actual args for the 4d arrays */
29 int
30 gen_actual_args_new ( char * dirname )
32 gen_args ( dirname , ACTUAL_NEW ) ;
33 return(0) ;
36 int
37 gen_dummy_args ( char * dirname )
39 gen_args ( dirname , DUMMY ) ;
40 return(0) ;
43 /* only generate dummy args for the 4d arrays */
44 int
45 gen_dummy_args_new ( char * dirname )
47 gen_args ( dirname , DUMMY_NEW ) ;
48 return(0) ;
51 int
52 gen_args ( char * dirname , int sw )
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] ;
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) ; }
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) ;
83 int
84 gen_args1 ( FILE * fp , char * outstr , char * structname ,
85 node_t * node , int *linelen , int sw , int deep )
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 ;
96 if ( sw == ACTUAL_NEW ) { sw = ACTUAL ; only4d = 1 ; }
97 if ( sw == DUMMY_NEW ) { sw = DUMMY ; only4d = 1 ; }
99 if ( node == NULL ) return(1) ;
100 for ( p = node->fields ; p != NULL ; p = p->next )
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 ;
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) )
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++ )
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 ;
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 ;
150 if ( p->type != NULL )
152 if ( p->type->type_type == DERIVED && !only4d )
154 if ( deep )
156 sprintf(x,"%s%s%%",structname,p->name ) ;
157 gen_args1(fp, outstr, (sw==ACTUAL)?x:"", p->type,linelen,sw,deep) ;
159 else
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 ;
172 return(0) ;