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