5 #define rindex(X,Y) strrchr(X,Y)
6 #define index(X,Y) strchr(X,Y)
22 gen_actual_args ( char * dirname
)
24 gen_args ( dirname
, ACTUAL
) ;
28 /* only generate actual args for the 4d arrays */
30 gen_actual_args_new ( char * dirname
)
32 gen_args ( dirname
, ACTUAL_NEW
) ;
37 gen_dummy_args ( char * dirname
)
39 gen_args ( dirname
, DUMMY
) ;
43 /* only generate dummy args for the 4d arrays */
45 gen_dummy_args_new ( char * dirname
)
47 gen_args ( dirname
, DUMMY_NEW
) ;
52 gen_args ( char * dirname
, int sw
)
56 char * fn
= "_args.inc" ;
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
) ; }
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
) ;
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
) ;
84 gen_args1 ( FILE * fp
, char * outstr
, char * structname
,
85 node_t
* node
, int *linelen
, int sw
, int deep
)
91 char x
[NAMELEN
], y
[NAMELEN
] ;
92 char indices
[NAMELEN
] ;
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 ;
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
) {
123 for ( bdy
= 1 ; bdy
<= 4 ; bdy
++ ) {
124 strcpy(fname
,field_name_bdy(t4
,p
,(p
->ntl
>1)?tag
:0,bdy
)) ;
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
,",") ;
131 if ( lenarg
+*linelen
> MAX_ARGLINE
) { strcat(outstr
," &\n") ; *linelen
= 0 ; }
136 strcpy(fname
,field_name(t4
,p
,(p
->ntl
>1)?tag
:0)) ;
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
,",") ;
143 if ( lenarg
+*linelen
> MAX_ARGLINE
) { strcat(outstr
," &\n") ; *linelen
= 0 ; }
150 if ( p
->type
!= NULL
)
152 if ( p
->type
->type_type
== DERIVED
&& !only4d
)
156 sprintf(x
,"%s%s%%",structname
,p
->name
) ;
157 gen_args1(fp
, outstr
, (sw
==ACTUAL
)?x
:"", p
->type
,linelen
,sw
,deep
) ;
161 /* generate argument */
162 strcpy(y
,structname
) ; strcat(y
,p
->name
) ; strcat(y
,",") ;
164 if ( lenarg
+*linelen
> MAX_ARGLINE
) { strcat(outstr
," &\n") ; *linelen
= 0 ; }