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) || ( p->boundary_array ) ) { |
---|
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 (!strcmp( corename , p->use+4 ) && sw==ACTUAL) |
---|
133 | sprintf(fname,"%s_%s",corename,field_name(t4,p,(p->ntl>1)?tag:0)) ; |
---|
134 | else |
---|
135 | strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ; |
---|
136 | strcpy(indices,"") ; |
---|
137 | if ( sw_deref_kludge && sw==ACTUAL ) |
---|
138 | sprintf(indices, "%s",index_with_firstelem("(","",t2,p,post)) ; |
---|
139 | /* generate argument */ |
---|
140 | strcpy(y,structname) ; strcat(y,fname) ; strcat(y,indices) ; strcat(y,",") ; |
---|
141 | lenarg = strlen(y) ; |
---|
142 | if ( lenarg+*linelen > MAX_ARGLINE ) { strcat(outstr," &\n") ; *linelen = 0 ; } |
---|
143 | strcat(outstr,y) ; |
---|
144 | *linelen += lenarg ; |
---|
145 | } |
---|
146 | } |
---|
147 | } |
---|
148 | if ( p->type != NULL ) |
---|
149 | { |
---|
150 | if ( p->type->type_type == DERIVED && !only4d ) |
---|
151 | { |
---|
152 | if ( deep ) |
---|
153 | { |
---|
154 | sprintf(x,"%s%s%%",structname,p->name ) ; |
---|
155 | gen_args1(fp, outstr, (sw==ACTUAL)?x:"", corename, p->type,linelen,sw,deep) ; |
---|
156 | } |
---|
157 | else |
---|
158 | { |
---|
159 | /* generate argument */ |
---|
160 | strcpy(y,structname) ; strcat(y,p->name) ; strcat(y,",") ; |
---|
161 | lenarg = strlen(y) ; |
---|
162 | if ( lenarg+*linelen > MAX_ARGLINE ) { strcat(outstr," &\n") ; *linelen = 0 ; } |
---|
163 | strcat(outstr,y) ; |
---|
164 | *linelen += lenarg ; |
---|
165 | p->mark = 1 ; |
---|
166 | } |
---|
167 | } |
---|
168 | } |
---|
169 | } |
---|
170 | return(0) ; |
---|
171 | } |
---|
172 | |
---|