?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
merge standard release WRF/WPS V3.0.1.1 into wrffire
[wrffire.git] / wrfv2_fire / tools / reg_parse.c
blob8b362887588eda39ebcc7cd8a66b09fb49b61a98
1 #include <stdio.h>
2 #include <stdlib.h>
3 #include <string.h>
4 #include <strings.h>
5
6 #include "registry.h"
7 #include "protos.h"
8 #include "data.h"
9 #include "sym.h"
10
11 /* read in the Registry file and build the internal representation of the registry */
12
13 #define MAXTOKENS 1000
14
15 /* fields for state entries (note, these get converted to field entries in the
16 reg_parse routine; therefore, only TABLE needs to be looked at */
17 #define TABLE 0
18
19 /* fields for field entries (TABLE="typedef" and, with some munging, TABLE="state") */
20 #define FIELD_OF 1
21 #define FIELD_TYPE 2
22 #define FIELD_SYM 3
23 #define FIELD_DIMS 4
24 #define FIELD_USE 5
25 #define FIELD_NTL 6
26 #define FIELD_STAG 7
27 #define FIELD_IO 8
28 #define FIELD_DNAME 9
29 #define FIELD_DESCRIP 10
30 #define FIELD_UNITS 11
31
32 #define F_OF 0
33 #define F_TYPE 1
34 #define F_SYM 2
35 #define F_DIMS 3
36 #define F_USE 4
37 #define F_NTL 5
38 #define F_STAG 6
39 #define F_IO 7
40 #define F_DNAME 8
41 #define F_DESCRIP 9
42 #define F_UNITS 10
43
44 /* fields for rconfig entries (RCNF) */
45 #define RCNF_TYPE_PRE 1
46 #define RCNF_SYM_PRE 2
47 #define RCNF_HOWSET_PRE 3
48 #define RCNF_NENTRIES_PRE 4
49 #define RCNF_DEFAULT_PRE 5
50 #define RCNF_IO_PRE 6
51 #define RCNF_DNAME_PRE 7
52 #define RCNF_DESCRIP_PRE 8
53 #define RCNF_UNITS_PRE 9
54
55 #define RCNF_TYPE 2
56 #define RCNF_SYM 3
57 #define RCNF_USE FIELD_USE
58 #define RCNF_IO FIELD_IO
59 #define RCNF_DNAME FIELD_DNAME
60 #define RCNF_DESCRIP FIELD_DESCRIP
61 #define RCNF_UNITS FIELD_UNITS
62 #define RCNF_HOWSET 20
63 #define RCNF_NENTRIES 21
64 #define RCNF_DEFAULT 22
65
66 /* fields for dimension entries (TABLE="dimspec") */
67 #define DIM_NAME 1
68 #define DIM_ORDER 2
69 #define DIM_SPEC 3
70 #define DIM_ORIENT 4
71 #define DIM_DATA_NAME 5
72
73 #define PKG_SYM 1
74 #define PKG_ASSOC 2
75 #define PKG_STATEVARS 3
76 #define PKG_4DSCALARS 4
77
78 #define COMM_ID 1
79 #define COMM_USE 2
80 #define COMM_DEFINE 3
81
82 static int ntracers = 0 ;
83 static char tracers[1000][100] ;
84
85 int
86 pre_parse( char * dir, FILE * infile, FILE * outfile )
87 {
88 char inln[8192], parseline[8192], parseline_save[8192] ;
89 int found ;
90 char *p, *q ;
91 char *tokens[MAXTOKENS], *toktmp[MAXTOKENS], newdims[NAMELEN], newdims4d[NAMELEN],newname[NAMELEN] ;
92 int i, ii, len_of_tok ;
93 char x, xstr[NAMELEN] ;
94 int is4d, wantstend, wantsbdy ;
95 int ifdef_stack_ptr = 0 ;
96 int ifdef_stack[100] ;
97 int inquote, retval ;
98
99 ifdef_stack[0] = 1 ;
100 retval = 0 ;
101
102 parseline[0] = '\0' ;
103 /* main parse loop over registry lines */
104 while ( fgets ( inln , 4096 , infile ) != NULL )
105 {
106
107 /*** preprocessing directives ****/
108 /* look for an include statement */
109 for ( p = inln ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ;
110 if ( !strncmp( p , "include", 7 ) && ! ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) ) {
111 FILE *include_fp ;
112 char include_file_name[128] ;
113 p += 7 ; for ( ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ;
114 if ( strlen( p ) > 127 ) { fprintf(stderr,"Registry warning: invalid include file name: %s\n", p ) ; }
115 else {
116 sprintf( include_file_name , "%s/%s", dir , p ) ;
117 if ( (p=index(include_file_name,'\n')) != NULL ) *p = '\0' ;
118 fprintf(stderr,"opening %s\n",include_file_name) ;
119 if (( include_fp = fopen( include_file_name , "r" )) != NULL ) {
120
121 fprintf(stderr,"including %s\n",include_file_name ) ;
122 pre_parse( dir , include_fp , outfile ) ;
123
124 fclose( include_fp ) ;
125 } else {
126 fprintf(stderr,"Registry warning: cannot open %s. Ignoring.\n", include_file_name ) ;
127 }
128 }
129 }
130 else if ( !strncmp( p , "ifdef", 5 ) ) {
131 char value[32] ;
132 p += 5 ; for ( ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ;
133 strncpy(value, p, 31 ) ; value[31] = '\0' ;
134 if ( (p=index(value,'\n')) != NULL ) *p = '\0' ;
135 if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,' ')) != NULL ) *p = '\0' ;
136 ifdef_stack_ptr++ ;
137 ifdef_stack[ifdef_stack_ptr] = ( sym_get(value) != NULL && ifdef_stack[ifdef_stack_ptr-1] ) ;
138 if ( ifdef_stack_ptr >= 100 ) { fprintf(stderr,"Registry fatal: too many nested ifdefs\n") ; exit(1) ; }
139 continue ;
140 }
141 else if ( !strncmp( p , "ifndef", 6 ) ) {
142 char value[32] ;
143 p += 6 ; for ( ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ;
144 strncpy(value, p, 31 ) ; value[31] = '\0' ;
145 if ( (p=index(value,'\n')) != NULL ) *p = '\0' ;
146 if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,' ')) != NULL ) *p = '\0' ;
147 ifdef_stack_ptr++ ;
148 ifdef_stack[ifdef_stack_ptr] = ( sym_get(value) == NULL && ifdef_stack[ifdef_stack_ptr-1] ) ;
149 if ( ifdef_stack_ptr >= 100 ) { fprintf(stderr,"Registry fatal: too many nested ifdefs\n") ; exit(1) ; }
150 continue ;
151 }
152 else if ( !strncmp( p , "endif", 5 ) ) {
153 ifdef_stack_ptr-- ;
154 if ( ifdef_stack_ptr < 0 ) { fprintf(stderr,"Registry fatal: unmatched endif\n") ; exit(1) ; }
155 continue ;
156 }
157 else if ( !strncmp( p , "define", 6 ) ) {
158 char value[32] ;
159 p += 6 ; for ( ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ;
160 strncpy(value, p, 31 ) ; value[31] = '\0' ;
161 if ( (p=index(value,'\n')) != NULL ) *p = '\0' ;
162 if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,' ')) != NULL ) *p = '\0' ;
163 sym_add( value ) ;
164 continue ;
165 }
166 if ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) continue ;
167 /*** end of preprocessing directives ****/
168
169 strcat( parseline , inln ) ;
170
171 /* allow \ to continue the end of a line */
172 if (( p = index( parseline, '\\' )) != NULL )
173 {
174 if ( *(p+1) == '\n' || *(p+1) == '\0' )
175 {
176 *p = '\0' ;
177 continue ; /* go get another line */
178 }
179 }
180 make_lower( parseline ) ;
181
182 if (( p = index( parseline , '\n' )) != NULL ) *p = '\0' ; /* discard newlines */
183
184 /* check line and zap any # characters that are in double quotes */
185
186 for ( p = parseline, inquote = 0 ; *p ; p++ ) {
187 if ( *p == '"' && inquote ) inquote = 0 ;
188 else if ( *p == '"' && !inquote ) inquote = 1 ;
189 else if ( *p == '#' && inquote ) *p = ' ' ;
190 else if ( *p == '#' && !inquote ) { *p = '\0' ; break ; }
191 }
192 if ( inquote ) { retval=1 ; fprintf(stderr,"Registry error: unbalanced quotes in line:\n%s\n",parseline) ;}
193
194 for ( i = 0 ; i < MAXTOKENS ; i++ ) tokens[i] = NULL ;
195 i = 0 ;
196
197 strcpy( parseline_save, parseline ) ;
198
199 if ((tokens[i] = my_strtok(parseline)) != NULL ) i++ ;
200 while (( tokens[i] = my_strtok(NULL) ) != NULL && i < MAXTOKENS ) i++ ;
201 if ( i <= 0 ) continue ;
202
203 for ( i = 0 ; i < MAXTOKENS ; i++ )
204 {
205 if ( tokens[i] == NULL ) tokens[i] = "-" ;
206 }
207 /* remove quotes from quoted entries */
208 for ( i = 0 ; i < MAXTOKENS ; i++ )
209 {
210 char * pp ;
211 if ( tokens[i][0] == '"' ) tokens[i]++ ;
212 if ((pp=rindex( tokens[i], '"' )) != NULL ) *pp = '\0' ;
213 }
214 if ( !strcmp( tokens[ TABLE ] , "state" ) )
215 {
216 strcpy( newdims, "" ) ;
217 strcpy( newdims4d, "" ) ;
218 is4d = 0 ; wantstend = 0 ; wantsbdy = 0 ;
219 for ( i = 0 ; i < (len_of_tok = strlen(tokens[F_DIMS])) ; i++ )
220 {
221 x = tolower(tokens[F_DIMS][i]) ;
222 if ( x >= 'a' && x <= 'z' ) {
223 if ( x == 'f' ) { is4d = 1 ; }
224 if ( x == 't' ) { wantstend = 1 ; }
225 if ( x == 'b' ) { wantsbdy = 1 ; }
226 }
227 sprintf(xstr,"%c",x) ;
228 if ( x != 'b' ) strcat ( newdims , xstr ) ;
229 if ( x != 'f' && x != 't' ) strcat( newdims4d , xstr ) ;
230
231 }
232 if ( wantsbdy ) {
233
234
235 /* first re-gurg the original entry without the b in the dims */
236
237 fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"%s\" \"%s\"\n",tokens[F_TYPE],tokens[F_SYM], newdims,
238 tokens[F_USE],tokens[F_NTL],tokens[F_STAG],tokens[F_IO],
239 tokens[F_DNAME],tokens[F_DESCRIP],tokens[F_UNITS] ) ;
240
241 if ( strcmp( tokens[F_SYM] , "-" ) ) { /* if not unnamed, as can happen with first 4d tracer */
242 /* next, output some additional entries for the boundary arrays for these guys */
243 if ( is4d == 1 ) {
244 for ( i = 0, found = 0 ; i < ntracers ; i++ ) {
245 if ( !strcmp( tokens[F_USE] , tracers[i] ) ) found = 1 ;
246 }
247 if ( found == 0 ) {
248 sprintf(tracers[ntracers],tokens[F_USE]) ;
249 ntracers++ ;
250
251 /* add entries for _b and _bt arrays */
252
253 sprintf(newname,"%s_b",tokens[F_USE]) ;
254 fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy %s\" \"%s\"\n",tokens[F_TYPE],newname,newdims4d,
255 "_4d_bdy_array_","-",tokens[F_STAG],"b",
256 newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;
257
258 sprintf(newname,"%s_bt",tokens[F_USE]) ;
259 fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy tend %s\" \"(%s)/dt\"\n",tokens[F_TYPE],newname,newdims4d,
260 "_4d_bdy_array_","-",tokens[F_STAG],"b",
261 newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;
262
263 }
264 } else {
265
266 /* add entries for _b and _bt arrays */
267
268 sprintf(newname,"%s_b",tokens[F_SYM]) ;
269 fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy %s\" \"%s\"\n",tokens[F_TYPE],newname,tokens[F_DIMS],
270 tokens[F_USE],"-",tokens[F_STAG],"b",
271 newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;
272
273 sprintf(newname,"%s_bt",tokens[F_SYM]) ;
274 fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy tend %s\" \"(%s)/dt\"\n",tokens[F_TYPE],newname,tokens[F_DIMS],
275 tokens[F_USE],"-",tokens[F_STAG],"b",
276 newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;
277
278 }
279 }
280 parseline[0] = '\0' ; /* reset parseline */
281 continue ;
282 }
283 }
284 normal:
285 /* otherwise output the line as is */
286 fprintf(outfile,"%s\n",parseline_save) ;
287 parseline[0] = '\0' ; /* reset parseline */
288 }
289 return(retval) ;
290 }
291
292 int
293 reg_parse( FILE * infile )
294 {
295 char inln[4096], parseline[4096] ;
296 char *p, *q ;
297 char *tokens[MAXTOKENS], *toktmp[MAXTOKENS] ;
298 int i, ii ;
299 int defining_state_field, defining_rconfig_field, defining_i1_field ;
300
301 parseline[0] = '\0' ;
302
303 max_time_level = 1 ;
304
305 /* main parse loop over registry lines */
306 while ( fgets ( inln , 4096 , infile ) != NULL )
307 {
308 strcat( parseline , inln ) ;
309 /* allow \ to continue the end of a line */
310 if (( p = index( parseline, '\\' )) != NULL )
311 {
312 if ( *(p+1) == '\n' || *(p+1) == '\0' )
313 {
314 *p = '\0' ;
315 continue ; /* go get another line */
316 }
317 }
318
319 make_lower( parseline ) ;
320 if (( p = index( parseline , '#' )) != NULL ) *p = '\0' ; /* discard comments (dont worry about quotes for now) */
321 if (( p = index( parseline , '\n' )) != NULL ) *p = '\0' ; /* discard newlines */
322 for ( i = 0 ; i < MAXTOKENS ; i++ ) tokens[i] = NULL ;
323 i = 0 ;
324
325 if ((tokens[i] = my_strtok(parseline)) != NULL ) i++ ;
326
327 while (( tokens[i] = my_strtok(NULL) ) != NULL && i < MAXTOKENS ) i++ ;
328 if ( i <= 0 ) continue ;
329
330 for ( i = 0 ; i < MAXTOKENS ; i++ )
331 {
332 if ( tokens[i] == NULL ) tokens[i] = "-" ;
333 }
334
335 /* remove quotes from quoted entries */
336 for ( i = 0 ; i < MAXTOKENS ; i++ )
337 {
338 char * pp ;
339 if ( tokens[i][0] == '"' ) tokens[i]++ ;
340 if ((pp=rindex( tokens[i], '"' )) != NULL ) *pp = '\0' ;
341 }
342
343 defining_state_field = 0 ;
344 defining_rconfig_field = 0 ;
345 defining_i1_field = 0 ;
346
347 /* state entry */
348 if ( !strcmp( tokens[ TABLE ] , "state" ) )
349 {
350 /* turn a state entry into a typedef to define a field in the top-level built-in type domain */
351 tokens[TABLE] = "typedef" ;
352 for ( i = MAXTOKENS-1 ; i >= 2 ; i-- ) tokens[i] = tokens[i-1] ; /* shift the fields to the left */
353 tokens[FIELD_OF] = "domain" ;
354 if ( !strcmp( tokens[FIELD_TYPE], "double" ) ) tokens[FIELD_TYPE] = "doubleprecision" ;
355 defining_state_field = 1 ;
356 }
357 if ( !strcmp( tokens[ TABLE ] , "rconfig" ) )
358 {
359 /* turn a rconfig entry into a typedef to define a field in the top-level built-in type domain */
360 for ( i = 0 ; i < MAXTOKENS ; i++ ) { toktmp[i] = tokens[i] ; tokens[i] = "-" ; }
361 tokens[TABLE] = "typedef" ;
362 tokens[FIELD_OF] = "domain" ;
363 tokens[RCNF_TYPE] = toktmp[RCNF_TYPE_PRE] ;
364 if ( !strcmp( tokens[RCNF_TYPE], "double" ) ) tokens[RCNF_TYPE] = "doubleprecision" ;
365 tokens[RCNF_SYM] = toktmp[RCNF_SYM_PRE] ;
366 tokens[RCNF_IO] = toktmp[RCNF_IO_PRE] ;
367 tokens[RCNF_DNAME] = toktmp[RCNF_DNAME_PRE] ;
368 tokens[RCNF_USE] = "-" ;
369 tokens[RCNF_DESCRIP] = toktmp[RCNF_DESCRIP_PRE] ;
370 tokens[RCNF_UNITS] = toktmp[RCNF_UNITS_PRE] ;
371 tokens[RCNF_HOWSET] = toktmp[RCNF_HOWSET_PRE] ;
372 tokens[RCNF_NENTRIES] = toktmp[RCNF_NENTRIES_PRE] ;
373 tokens[RCNF_DEFAULT] = toktmp[RCNF_DEFAULT_PRE] ;
374 defining_rconfig_field = 1 ;
375 }
376 if ( !strcmp( tokens[ TABLE ] , "i1" ) )
377 {
378 /* turn a state entry into a typedef to define a field in
379 the top-level built-in type domain */
380 tokens[TABLE] = "typedef" ;
381 /* shift the fields to the left */
382 for ( i = MAXTOKENS-1 ; i >= 2 ; i-- ) tokens[i] = tokens[i-1] ;
383 tokens[FIELD_OF] = "domain" ;
384 if ( !strcmp( tokens[FIELD_TYPE], "double" ) ) tokens[FIELD_TYPE] = "doubleprecision" ;
385 defining_i1_field = 1 ;
386 }
387
388 /* NOTE: fall through */
389
390 /* typedef entry */
391 if ( !strcmp( tokens[ TABLE ] , "typedef" ) )
392 {
393 node_t * field_struct ;
394 node_t * type_struct ;
395
396 if ( !defining_state_field && ! defining_i1_field &&
397 !defining_rconfig_field && !strcmp(tokens[FIELD_OF],"domain") )
398 { fprintf(stderr,"Registry warning: 'domain' is a reserved registry type name. Cannot 'typedef domain'\n") ; }
399
400 type_struct = get_type_entry( tokens[ FIELD_OF ] ) ;
401 if ( type_struct == NULL )
402 {
403 type_struct = new_node( TYPE ) ;
404 strcpy( type_struct->name, tokens[FIELD_OF] ) ;
405 type_struct->type_type = DERIVED ;
406 add_node_to_end( type_struct , &Type ) ;
407 }
408
409 if ( defining_i1_field ) {
410 field_struct = new_node( I1 ) ;
411 } else if ( defining_rconfig_field ) {
412 field_struct = new_node( RCONFIG ) ;
413 } else {
414 field_struct = new_node( FIELD ) ;
415 }
416
417 strcpy( field_struct->name, tokens[FIELD_SYM] ) ;
418
419 if ( set_state_type( tokens[FIELD_TYPE], field_struct ) )
420 { fprintf(stderr,"Registry warning: type %s used before defined \n",tokens[FIELD_TYPE] ) ; }
421
422 if ( set_state_dims( tokens[FIELD_DIMS], field_struct ) )
423 { fprintf(stderr,"Registry warning: some problem with dimstring %s\n", tokens[FIELD_DIMS] ) ; }
424
425 if ( strcmp( tokens[FIELD_NTL], "-" ) ) /* that is, if not equal "-" */
426 { field_struct->ntl = atoi(tokens[FIELD_NTL]) ; }
427 field_struct->ntl = ( field_struct->ntl > 0 )?field_struct->ntl:1 ;
428 /* calculate the maximum number of time levels and store in global variable */
429 if ( field_struct->ntl > max_time_level && field_struct->ntl <= 3 ) max_time_level = field_struct->ntl ;
430
431 field_struct->stag_x = 0 ; field_struct->stag_y = 0 ; field_struct->stag_z = 0 ;
432 for ( i = 0 ; i < strlen(tokens[FIELD_STAG]) ; i++ )
433 {
434 if ( tolower(tokens[FIELD_STAG][i]) == 'x' || sw_all_x_staggered ) field_struct->stag_x = 1 ;
435 if ( tolower(tokens[FIELD_STAG][i]) == 'y' || sw_all_y_staggered ) field_struct->stag_y = 1 ;
436 if ( tolower(tokens[FIELD_STAG][i]) == 'z' ) field_struct->stag_z = 1 ;
437 }
438
439 field_struct->history = 0 ; field_struct->input = 0 ;
440 field_struct->auxhist1 = 0 ; field_struct->auxinput1 = 0 ;
441 field_struct->auxhist2 = 0 ; field_struct->auxinput2 = 0 ;
442 field_struct->auxhist3 = 0 ; field_struct->auxinput3 = 0 ;
443 field_struct->auxhist4 = 0 ; field_struct->auxinput4 = 0 ;
444 field_struct->auxhist5 = 0 ; field_struct->auxinput5 = 0 ;
445 field_struct->restart = 0 ; field_struct->boundary = 0 ;
446 field_struct->io_mask = 0 ;
447 {
448 char prev = '\0' ;
449 char x ;
450 int len_of_tok ;
451 char fcn_name[2048], aux_fields[2048] ;
452
453 for ( i = 0 ; i < (len_of_tok = strlen(tokens[FIELD_IO])) ; i++ )
454 {
455 x = tolower(tokens[FIELD_IO][i]) ;
456 if ( x >= 'a' && x <= 'z' && ! ( x == 'g' || x == 'o' ) ) {
457 if ( x == 'h' ) {field_struct->history = 10 ; field_struct->io_mask |= HISTORY ;}
458 if ( x == 'i' ) {field_struct->input = 10 ; field_struct->io_mask |= INPUT ;}
459 if ( x == 'r' ) {field_struct->restart = 10 ; field_struct->io_mask |= RESTART ;}
460 if ( x == 'b' ) {field_struct->boundary = 10 ; field_struct->io_mask |= BOUNDARY ;}
461 if ( x == 'f' || x == 'd' || x == 'u' || x == 's' ) {
462 strcpy(aux_fields,"") ;
463 strcpy(fcn_name,"") ;
464 if ( tokens[FIELD_IO][i+1] == '(' ) /* catch a possible error */
465 {
466 fprintf(stderr,
467 "Registry warning: syntax error in %c specifier of IO field for %s\n",x,tokens[FIELD_SYM]) ;
468 fprintf(stderr,
469 " equal sign needed before left paren\n") ;
470 }
471
472 if ( tokens[FIELD_IO][i+1] == '=' )
473 {
474 int ii, jj, state ;
475 state = 0 ;
476 jj = 0 ;
477 for ( ii = i+3 ; ii < len_of_tok ; ii++ )
478 {
479 if ( tokens[FIELD_IO][ii] == ')' ) { if (state == 0 )fcn_name[jj] = '\0' ; aux_fields[jj] = '\0' ; break ; }
480 if ( tokens[FIELD_IO][ii] == ':' ) { fcn_name[jj] = '\0' ; jj= 0 ; state++ ; continue ;}
481 if ( tokens[FIELD_IO][ii] == ',' && state == 0 ) {
482 fprintf(stderr,
483 "Registry warning: syntax error in %c specifier of IO field for %s\n",x,
484 tokens[FIELD_SYM]) ;
485 }
486 if ( state == 0 ) /* looking for interpolation fcn name */
487 {
488 fcn_name[jj++] = tokens[FIELD_IO][ii] ;
489 }
490 if ( state > 0 )
491 {
492 aux_fields[jj++] = tokens[FIELD_IO][ii] ;
493 }
494 }
495 i = ii ;
496 }
497 else
498 {
499 if ( x == 'f' || x == 'd' ) strcpy(fcn_name,"interp_fcn") ;
500 if ( x == 'u' ) strcpy(fcn_name,"copy_fcn") ;
501 if ( x == 's' ) strcpy(fcn_name,"smoother") ;
502 }
503 if ( x == 'f' ) {
504 field_struct->io_mask |= FORCE_DOWN ;
505 strcpy(field_struct->force_fcn_name, fcn_name ) ;
506 strcpy(field_struct->force_aux_fields, aux_fields ) ;
507 }
508 else if ( x == 'd' ) {
509 field_struct->io_mask |= INTERP_DOWN ;
510 strcpy(field_struct->interpd_fcn_name, fcn_name ) ;
511 strcpy(field_struct->interpd_aux_fields, aux_fields ) ;
512 }
513 else if ( x == 's' ) {
514 field_struct->io_mask |= SMOOTH_UP ;
515 strcpy(field_struct->smoothu_fcn_name, fcn_name ) ;
516 strcpy(field_struct->smoothu_aux_fields, aux_fields ) ;
517 }
518 else if ( x == 'u' ) {
519 field_struct->io_mask |= INTERP_UP ;
520 strcpy(field_struct->interpu_fcn_name, fcn_name ) ;
521 strcpy(field_struct->interpu_aux_fields, aux_fields ) ;
522 }
523 }
524 prev = x ;
525 } else if ( x >= '0' && x <= '9' || x == 'g' || x == 'o' )
526 {
527 if ( prev == 'i' )
528 {
529 field_struct->io_mask &= ! INPUT ; /* turn off setting from 'i' */
530 field_struct->input = field_struct->input % 10 ; /* turn off setting from 'i' */
531 if ( x == '0' ) field_struct->input = 1 ;
532 if ( x == '1' ) field_struct->auxinput1 = 1 ;
533 if ( x == '2' ) field_struct->auxinput2 = 1 ;
534 if ( x == '3' ) field_struct->auxinput3 = 1 ;
535 if ( x == '4' ) field_struct->auxinput4 = 1 ;
536 if ( x == '5' ) field_struct->auxinput5 = 1 ;
537 if ( x == '6' ) field_struct->auxinput6 = 1 ;
538 if ( x == '7' ) field_struct->auxinput7 = 1 ;
539 if ( x == '8' ) field_struct->auxinput8 = 1 ;
540 if ( x == '9' ) field_struct->auxinput9 = 1 ;
541 if ( x == 'g' ) field_struct->auxinput10 = 1 ;
542 if ( x == 'o' ) field_struct->auxinput11 = 1 ;
543 }
544 if ( prev == 'h' )
545 {
546 field_struct->io_mask &= ! HISTORY ; /* turn off setting from 'h' */
547 field_struct->history = field_struct->history % 10 ; /* turn off setting from 'h' */
548 if ( x == '0' ) field_struct->history = 1 ;
549 if ( x == '1' ) field_struct->auxhist1 = 1 ;
550 if ( x == '2' ) field_struct->auxhist2 = 1 ;
551 if ( x == '3' ) field_struct->auxhist3 = 1 ;
552 if ( x == '4' ) field_struct->auxhist4 = 1 ;
553 if ( x == '5' ) field_struct->auxhist5 = 1 ;
554 if ( x == '6' ) field_struct->auxhist6 = 1 ;
555 if ( x == '7' ) field_struct->auxhist7 = 1 ;
556 if ( x == '8' ) field_struct->auxhist8 = 1 ;
557 if ( x == '9' ) field_struct->auxhist9 = 1 ;
558 if ( x == 'g' ) field_struct->auxhist10 = 1 ;
559 if ( x == 'o' ) field_struct->auxhist11 = 1 ;
560 }
561 }
562 }
563 if ( field_struct->history > 0 ) { field_struct->history = 1 ; field_struct->io_mask |= HISTORY ; }
564 if ( field_struct->auxhist1 > 0 ) { field_struct->auxhist1 = 1 ; field_struct->io_mask |= AUXHIST1 ; }
565 if ( field_struct->auxhist2 > 0 ) { field_struct->auxhist2 = 1 ; field_struct->io_mask |= AUXHIST2 ; }
566 if ( field_struct->auxhist3 > 0 ) { field_struct->auxhist3 = 1 ; field_struct->io_mask |= AUXHIST3 ; }
567 if ( field_struct->auxhist4 > 0 ) { field_struct->auxhist4 = 1 ; field_struct->io_mask |= AUXHIST4 ; }
568 if ( field_struct->auxhist5 > 0 ) { field_struct->auxhist5 = 1 ; field_struct->io_mask |= AUXHIST5 ; }
569 if ( field_struct->auxhist6 > 0 ) { field_struct->auxhist6 = 1 ; field_struct->io_mask |= AUXHIST6 ; }
570 if ( field_struct->auxhist7 > 0 ) { field_struct->auxhist7 = 1 ; field_struct->io_mask |= AUXHIST7 ; }
571 if ( field_struct->auxhist8 > 0 ) { field_struct->auxhist8 = 1 ; field_struct->io_mask |= AUXHIST8 ; }
572 if ( field_struct->auxhist9 > 0 ) { field_struct->auxhist9 = 1 ; field_struct->io_mask |= AUXHIST9 ; }
573 if ( field_struct->auxhist10 > 0 ) { field_struct->auxhist10 = 1 ; field_struct->io_mask |= AUXHIST10 ; }
574 if ( field_struct->auxhist11 > 0 ) { field_struct->auxhist11 = 1 ; field_struct->io_mask |= AUXHIST11 ; }
575
576 if ( field_struct->input > 0 ) { field_struct->input = 1 ; field_struct->io_mask |= INPUT ; }
577 if ( field_struct->auxinput1 > 0 ) { field_struct->auxinput1 = 1 ; field_struct->io_mask |= AUXINPUT1 ; }
578 if ( field_struct->auxinput2 > 0 ) { field_struct->auxinput2 = 1 ; field_struct->io_mask |= AUXINPUT2 ; }
579 if ( field_struct->auxinput3 > 0 ) { field_struct->auxinput3 = 1 ; field_struct->io_mask |= AUXINPUT3 ; }
580 if ( field_struct->auxinput4 > 0 ) { field_struct->auxinput4 = 1 ; field_struct->io_mask |= AUXINPUT4 ; }
581 if ( field_struct->auxinput5 > 0 ) { field_struct->auxinput5 = 1 ; field_struct->io_mask |= AUXINPUT5 ; }
582 if ( field_struct->auxinput6 > 0 ) { field_struct->auxinput6 = 1 ; field_struct->io_mask |= AUXINPUT6 ; }
583 if ( field_struct->auxinput7 > 0 ) { field_struct->auxinput7 = 1 ; field_struct->io_mask |= AUXINPUT7 ; }
584 if ( field_struct->auxinput8 > 0 ) { field_struct->auxinput8 = 1 ; field_struct->io_mask |= AUXINPUT8 ; }
585 if ( field_struct->auxinput9 > 0 ) { field_struct->auxinput9 = 1 ; field_struct->io_mask |= AUXINPUT9 ; }
586 if ( field_struct->auxinput10 > 0 ) { field_struct->auxinput10 = 1 ; field_struct->io_mask |= AUXINPUT10 ; }
587 if ( field_struct->auxinput11 > 0 ) { field_struct->auxinput11 = 1 ; field_struct->io_mask |= AUXINPUT11 ; }
588
589 if ( field_struct->restart > 0 ) { field_struct->restart = 1 ; field_struct->io_mask |= RESTART ; }
590 if ( field_struct->boundary > 0 ) { field_struct->boundary = 1 ; field_struct->io_mask |= BOUNDARY ; }
591 }
592
593 field_struct->dname[0] = '\0' ;
594 if ( strcmp( tokens[FIELD_DNAME], "-" ) ) /* that is, if not equal "-" */
595 { strcpy( field_struct->dname , tokens[FIELD_DNAME] ) ; }
596 strcpy(field_struct->descrip,"-") ;
597 if ( strcmp( tokens[FIELD_DESCRIP], "-" ) ) /* that is, if not equal "-" */
598 { strcpy( field_struct->descrip , tokens[FIELD_DESCRIP] ) ; }
599 strcpy(field_struct->units,"-") ;
600 if ( strcmp( tokens[FIELD_UNITS], "-" ) ) /* that is, if not equal "-" */
601 { strcpy( field_struct->units , tokens[FIELD_UNITS] ) ; }
602 strcpy(field_struct->use,"-") ;
603 if ( strcmp( tokens[FIELD_USE], "-" ) ) /* that is, if not equal "-" */
604 { strcpy( field_struct->use , tokens[FIELD_USE] ) ;
605 }
606
607 /* specific settings for RCONFIG entries */
608 if ( defining_rconfig_field )
609 {
610 if ( strcmp( tokens[RCNF_NENTRIES] , "-" ) ) /* that is, if not equal "-" */
611 {
612 strcpy(field_struct->nentries, tokens[RCNF_NENTRIES] ) ;
613 } else {
614 strcpy(field_struct->nentries, "1" ) ;
615 }
616 if ( strcmp( tokens[RCNF_HOWSET] , "-" ) ) /* that is, if not equal "-" */
617 {
618 strcpy(field_struct->howset,tokens[RCNF_HOWSET]) ;
619 } else {
620 strcpy(field_struct->howset,"") ;
621 }
622 if ( strcmp( tokens[RCNF_DEFAULT] , "-" ) ) /* that is, if not equal "-" */
623 {
624 strcpy(field_struct->dflt,tokens[RCNF_DEFAULT]) ;
625 } else {
626 strcpy(field_struct->dflt,"") ;
627 }
628 }
629
630 if ( field_struct->type != NULL )
631 if ( field_struct->type->type_type == DERIVED && field_struct->ndims > 0 )
632 { fprintf(stderr,"Registry warning: type item %s of type %s can not be multi-dimensional ",
633 tokens[FIELD_SYM], tokens[FIELD_TYPE] ) ; }
634
635 /**/ if ( ! field_struct->scalar_array_member )
636 {
637 add_node_to_end( field_struct , &(type_struct->fields) ) ;
638 }
639 /**/ else /* if ( field_struct->scalar_array_member ) */
640 {
641 /*
642 Here we are constructing a list of nodes to represent the list of 4D scalar arrays in the model
643
644 This list is rooted at the FourD pointer.
645 Each array is represented by its own node; each node has a pointer, members, to the list
646 of fields that make it up.
647
648 */
649 node_t * q , * member ;
650 if (( q = get_4d_entry(field_struct->use )) == NULL ) /* first instance of a 4d array member */
651 {
652 q = new_node( FOURD ) ;
653 *q = *field_struct ; /* this overwrites the node */
654 strcpy( q->name, field_struct->use ) ;
655 strcpy( q->use, "" ) ;
656 q->node_kind = FOURD ;
657 q->scalar_array_member = 0 ;
658 q->next4d = NULL ;
659 q->next = NULL ;
660 /* add 4d q node to the list of fields of this type and also attach
661 it to the global list of 4d arrays */
662 add_node_to_end( q , &(type_struct->fields) ) ;
663 add_node_to_end_4d( q , &(FourD) ) ;
664 }
665 member = new_node( MEMBER ) ;
666 *member = *q ;
667 member->node_kind = MEMBER ;
668 member->members = NULL ;
669 member->scalar_array_member = 1 ;
670 strcpy( member->name , field_struct->name ) ;
671 strcpy( member->dname , field_struct->dname ) ;
672 strcpy( member->use , field_struct->use ) ;
673 strcpy( member->descrip , field_struct->descrip ) ;
674 strcpy( member->units , field_struct->units ) ;
675 member->next = NULL ;
676 member->io_mask = field_struct->io_mask ;
677 member->ndims = field_struct->ndims ;
678 strcpy( member->interpd_fcn_name, field_struct->interpd_fcn_name) ;
679 strcpy( member->interpd_aux_fields, field_struct->interpd_aux_fields) ;
680 strcpy( member->interpu_fcn_name, field_struct->interpu_fcn_name) ;
681 strcpy( member->interpu_aux_fields, field_struct->interpu_aux_fields) ;
682 strcpy( member->smoothu_fcn_name, field_struct->smoothu_fcn_name) ;
683 strcpy( member->smoothu_aux_fields, field_struct->smoothu_aux_fields) ;
684 strcpy( member->force_fcn_name, field_struct->force_fcn_name) ;
685 strcpy( member->force_aux_fields, field_struct->force_aux_fields) ;
686 for ( ii = 0 ; ii < member->ndims ; ii++ )
687 member->dims[ii] = field_struct->dims[ii] ;
688 add_node_to_end( member , &(q->members) ) ;
689 free(field_struct) ; /* We've used all the information about this entry.
690 It is not a field but the name of one of the members of
691 a 4d field. we have handled that here. Discard the original node. */
692 }
693 }
694
695 /* dimespec entry */
696 else if ( !strcmp( tokens[ TABLE ] , "dimspec" ) )
697 {
698 node_t * dim_struct ;
699 dim_struct = new_node( DIM ) ;
700 if ( strlen( tokens[DIM_NAME] ) > 1 )
701 { fprintf(stderr,"Registry warning: dimspec (%s) must be only one letter\n",tokens[DIM_NAME] ) ; }
702 if ( get_dim_entry ( tokens[DIM_NAME][0] ) != NULL )
703 { fprintf(stderr,"Registry warning: dimspec (%c) already defined\n",tokens[DIM_NAME][0] ) ; }
704 dim_struct->dim_name = tokens[DIM_NAME][0] ;
705 if ( set_dim_order( tokens[DIM_ORDER], dim_struct ) )
706 { fprintf(stderr,"Registry warning: problem with dimorder (%s)\n",tokens[DIM_ORDER] ) ; }
707 if ( set_dim_len( tokens[DIM_SPEC], dim_struct ) )
708 { fprintf(stderr,"Registry warning: problem with dimspec (%s)\n",tokens[DIM_SPEC] ) ; }
709 if ( set_dim_orient( tokens[DIM_ORIENT], dim_struct ) )
710 { fprintf(stderr,"Registry warning: problem with dimorient (%s)\n",tokens[DIM_ORIENT] ) ; }
711 if ( strcmp( tokens[DIM_DATA_NAME], "-" ) ) /* that is, if not equal "-" */
712 { strcpy( dim_struct->dim_data_name , tokens[DIM_DATA_NAME] ) ; }
713
714 add_node_to_end( dim_struct , &Dim ) ;
715 }
716
717 /* package */
718 else if ( !strcmp( tokens[ TABLE ] , "package" ) )
719 {
720 node_t * package_struct ;
721 package_struct = new_node( PACKAGE ) ;
722 strcpy( package_struct->name , tokens[PKG_SYM] ) ;
723 strcpy( package_struct->pkg_assoc , tokens[PKG_ASSOC] ) ;
724 strcpy( package_struct->pkg_statevars , tokens[PKG_STATEVARS] ) ;
725 strcpy( package_struct->pkg_4dscalars , tokens[PKG_4DSCALARS] ) ;
726
727 add_node_to_end( package_struct , &Packages ) ;
728 }
729
730 /* halo, period, xpose */
731 else if ( !strcmp( tokens[ TABLE ] , "halo" ) )
732 {
733 node_t * comm_struct ;
734 comm_struct = new_node( HALO ) ;
735 strcpy( comm_struct->name , tokens[COMM_ID] ) ;
736 strcpy( comm_struct->use , tokens[COMM_USE] ) ;
737 #if 1
738 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) {
739 for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
740 }
741 #else
742 strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
743 #endif
744 add_node_to_end( comm_struct , &Halos ) ;
745 }
746 else if ( !strcmp( tokens[ TABLE ] , "period" ) )
747 {
748 node_t * comm_struct ;
749 comm_struct = new_node( PERIOD ) ;
750 strcpy( comm_struct->name , tokens[COMM_ID] ) ;
751 strcpy( comm_struct->use , tokens[COMM_USE] ) ;
752 #if 1
753 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) {
754 for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
755 }
756 #else
757 strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
758 #endif
759 add_node_to_end( comm_struct , &Periods ) ;
760 }
761 else if ( !strcmp( tokens[ TABLE ] , "xpose" ) )
762 {
763 node_t * comm_struct ;
764 comm_struct = new_node( XPOSE ) ;
765 strcpy( comm_struct->name , tokens[COMM_ID] ) ;
766 strcpy( comm_struct->use , tokens[COMM_USE] ) ;
767 #if 1
768 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) {
769 for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
770 }
771 #else
772 strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
773 #endif
774 add_node_to_end( comm_struct , &Xposes ) ;
775 }
776 else if ( !strcmp( tokens[ TABLE ] , "swap" ) )
777 {
778 node_t * comm_struct ;
779 comm_struct = new_node( SWAP ) ;
780 strcpy( comm_struct->name , tokens[COMM_ID] ) ;
781 strcpy( comm_struct->use , tokens[COMM_USE] ) ;
782 #if 1
783 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) {
784 for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
785 }
786 #else
787 strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
788 #endif
789 add_node_to_end( comm_struct , &Swaps ) ;
790 }
791 else if ( !strcmp( tokens[ TABLE ] , "cycle" ) )
792 {
793 node_t * comm_struct ;
794 comm_struct = new_node( CYCLE ) ;
795 strcpy( comm_struct->name , tokens[COMM_ID] ) ;
796 strcpy( comm_struct->use , tokens[COMM_USE] ) ;
797 #if 1
798 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) {
799 for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
800 }
801 #else
802 strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
803 #endif
804 add_node_to_end( comm_struct , &Cycles ) ;
805 }
806
807
808 #if 0
809 fprintf(stderr,"vvvvvvvvvvvvvvvvvvvvvvvvvvv\n") ;
810 show_nodelist( Type ) ;
811 fprintf(stderr,"^^^^^^^^^^^^^^^^^^^^^^^^^^^\n") ;
812 #endif
813 parseline[0] = '\0' ; /* reset parseline */
814 }
815
816 Domain = *(get_type_entry( "domain" )) ;
817
818 #if 0
819 show_node( &Domain ) ;
820 #endif
821
822 return(0) ;
823
824 }
825
826 node_t *
827 get_dim_entry( char c )
828 {
829 node_t * p ;
830 for ( p = Dim ; p != NULL ; p = p->next )
831 {
832 if ( p->dim_name == c ) return( p ) ;
833 }
834 return(NULL) ;
835 }
836
837 int
838 set_state_type( char * typename, node_t * state_entry )
839 {
840 if ( typename == NULL ) return(1) ;
841 return (( state_entry->type = get_type_entry( typename )) == NULL ) ;
842 }
843
844 int
845 set_dim_len ( char * dimspec , node_t * dim_entry )
846 {
847 if (!strcmp( dimspec , "standard_domain" ))
848 { dim_entry->len_defined_how = DOMAIN_STANDARD ; }
849 else if (!strncmp( dimspec, "constant=" , 9 ))
850 {
851 char *p, *colon, *paren ;
852 p = &(dimspec[9]) ;
853 /* check for colon */
854 if (( colon = index(p,':')) != NULL )
855 {
856 *colon = '\0' ;
857 if (( paren = index(p,'(')) !=NULL )
858 {
859 dim_entry->coord_start = atoi(paren+1) ;
860 }
861 else
862 {
863 fprintf(stderr,"WARNING: illegal syntax (missing opening paren) for constant: %s\n",p) ;
864 }
865 dim_entry->coord_end = atoi(colon+1) ;
866 }
867 else
868 {
869 dim_entry->coord_start = 1 ;
870 dim_entry->coord_end = atoi(p) ;
871 }
872 dim_entry->len_defined_how = CONSTANT ;
873 }
874 else if (!strncmp( dimspec, "namelist=", 9 ))
875 {
876 char *p, *colon ;
877
878 p = &(dimspec[9]) ;
879 /* check for colon */
880 if (( colon = index(p,':')) != NULL )
881 {
882 *colon = '\0' ;
883 strcpy( dim_entry->assoc_nl_var_s, p ) ;
884 strcpy( dim_entry->assoc_nl_var_e, colon+1 ) ;
885 }
886 else
887 {
888 strcpy( dim_entry->assoc_nl_var_s, "1" ) ;
889 strcpy( dim_entry->assoc_nl_var_e, p ) ;
890 }
891 dim_entry->len_defined_how = NAMELIST ;
892 }
893 else
894 {
895 return(1) ;
896 }
897 return(0) ;
898 }
899
900 int
901 set_dim_orient ( char * dimorient , node_t * dim_entry )
902 {
903 if (!strcmp( dimorient , "x" ))
904 { dim_entry->coord_axis = COORD_X ; }
905 else if (!strcmp( dimorient , "y" ))
906 { dim_entry->coord_axis = COORD_Y ; }
907 else if (!strcmp( dimorient , "z" ))
908 { dim_entry->coord_axis = COORD_Z ; }
909 else
910 { dim_entry->coord_axis = COORD_C ; }
911 return(0) ;
912 }
913
914 /* integrity checking of dimension list; make sure that
915 namelist specified dimensions have an associated namelist variable */
916 int
917 check_dimspecs()
918 {
919 node_t * p, *q ;
920 int ord ;
921
922 for ( p = Dim ; p != NULL ; p = p->next )
923 {
924 if ( p->len_defined_how == DOMAIN_STANDARD )
925 {
926 if ( p->dim_order < 1 || p->dim_order > 3 )
927 {
928 fprintf(stderr,"WARNING: illegal dim order %d for dimspec %s\n",p->dim_order,p->name) ;
929 }
930 ord = p->dim_order-1 ;
931 if ( model_order[ord] != p->coord_axis )
932 {
933 if ( model_order[ord] == -1 ) model_order[ord] = p->coord_axis ;
934 else
935 {
936 fprintf(stderr,"WARNING: coord-axis/dim-order for dimspec %s is inconsistent with previous dimspec.\n",p->name) ;
937 }
938 }
939 }
940 else if ( p->len_defined_how == NAMELIST )
941 {
942 if ( strcmp( p->assoc_nl_var_s, "1" ) ) /* if not equal to "1" */
943 {
944 if (( q = get_entry(p->assoc_nl_var_s,Domain.fields)) == NULL )
945 {
946 fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
947 p->assoc_nl_var_s,p->name ) ;
948 return(1) ;
949 }
950 if ( ! q->node_kind & RCONFIG )
951 {
952 fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
953 p->assoc_nl_var_s,p->name ) ;
954 return(1) ;
955 }
956 if ( strcmp( q->type->name , "integer" ) ) /* if not integer */
957 {
958 fprintf(stderr,"WARNING: namelist variable %s must be an integer if used to define dimension %s\n",
959 p->assoc_nl_var_s,p->name ) ;
960 return(1) ;
961 }
962 if ( strcmp( q->nentries , "1" ) ) /* if not 1 entry */
963 {
964 fprintf(stderr,"WARNING: namelist variable %s must have only one entry if used to define dimension %s\n",
965 p->assoc_nl_var_s,p->name ) ;
966 return(1) ;
967 }
968 }
969 if (( q = get_entry(p->assoc_nl_var_e,Domain.fields)) == NULL )
970 {
971 fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
972 p->assoc_nl_var_e,p->name ) ;
973 return(1) ;
974 }
975 if ( ! q->node_kind & RCONFIG )
976 {
977 fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
978 p->assoc_nl_var_e,p->name ) ;
979 return(1) ;
980 }
981 if ( strcmp( q->type->name , "integer" ) ) /* if not integer */
982 {
983 fprintf(stderr,"WARNING: namelist variable %s must be an integer if used to define dimension %s\n",
984 p->assoc_nl_var_e,p->name ) ;
985 return(1) ;
986 }
987 if ( strcmp( q->nentries , "1" ) ) /* if not 1 entry */
988 {
989 fprintf(stderr,"WARNING: namelist variable %s must have only one entry if used to define dimension %s\n",
990 p->assoc_nl_var_e,p->name ) ;
991 return(1) ;
992 }
993 }
994 }
995 return(0) ;
996 }
997
998 int
999 set_dim_order ( char * dimorder , node_t * dim_entry )
1000 {
1001 dim_entry->dim_order = atoi(dimorder) ;
1002 return(0) ;
1003 }
1004
1005 init_parser()
1006 {
1007 model_order[0] = -1 ;
1008 model_order[1] = -1 ;
1009 model_order[2] = -1 ;
1010 return(0) ;
1011 }
A coupled weather-fire forecasting model built on top of Weather Research and Forecasting (WRF).