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