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 | |
---|
21 | int |
---|
22 | gen_actual_args ( char * dirname ) |
---|
23 | { |
---|
24 | gen_args ( dirname , ACTUAL ) ; |
---|
25 | return(0) ; |
---|
26 | } |
---|
27 | |
---|
28 | /* only generate actual args for the 4d arrays */ |
---|
29 | int |
---|
30 | gen_actual_args_new ( char * dirname ) |
---|
31 | { |
---|
32 | gen_args ( dirname , ACTUAL_NEW ) ; |
---|
33 | return(0) ; |
---|
34 | } |
---|
35 | |
---|
36 | int |
---|
37 | gen_dummy_args ( char * dirname ) |
---|
38 | { |
---|
39 | gen_args ( dirname , DUMMY ) ; |
---|
40 | return(0) ; |
---|
41 | } |
---|
42 | |
---|
43 | /* only generate dummy args for the 4d arrays */ |
---|
44 | int |
---|
45 | gen_dummy_args_new ( char * dirname ) |
---|
46 | { |
---|
47 | gen_args ( dirname , DUMMY_NEW ) ; |
---|
48 | return(0) ; |
---|
49 | } |
---|
50 | |
---|
51 | int |
---|
52 | gen_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 | |
---|
83 | int |
---|
84 | gen_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 | |
---|