reg_parse.c
References to this file elsewhere.
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 if ( ! defining_rconfig_field && ! field_struct->scalar_array_member && !strncmp( tokens[FIELD_USE], "dyn_", 4 ) )
606 add_core_name( tokens[FIELD_USE]+4 ) ;
607 }
608
609 /* specific settings for RCONFIG entries */
610 if ( defining_rconfig_field )
611 {
612 if ( strcmp( tokens[RCNF_NENTRIES] , "-" ) ) /* that is, if not equal "-" */
613 {
614 strcpy(field_struct->nentries, tokens[RCNF_NENTRIES] ) ;
615 } else {
616 strcpy(field_struct->nentries, "1" ) ;
617 }
618 if ( strcmp( tokens[RCNF_HOWSET] , "-" ) ) /* that is, if not equal "-" */
619 {
620 strcpy(field_struct->howset,tokens[RCNF_HOWSET]) ;
621 } else {
622 strcpy(field_struct->howset,"") ;
623 }
624 if ( strcmp( tokens[RCNF_DEFAULT] , "-" ) ) /* that is, if not equal "-" */
625 {
626 strcpy(field_struct->dflt,tokens[RCNF_DEFAULT]) ;
627 } else {
628 strcpy(field_struct->dflt,"") ;
629 }
630 }
631
632 if ( field_struct->type != NULL )
633 if ( field_struct->type->type_type == DERIVED && field_struct->ndims > 0 )
634 { fprintf(stderr,"Registry warning: type item %s of type %s can not be multi-dimensional ",
635 tokens[FIELD_SYM], tokens[FIELD_TYPE] ) ; }
636
637 /**/ if ( ! field_struct->scalar_array_member )
638 {
639 add_node_to_end( field_struct , &(type_struct->fields) ) ;
640 }
641 /**/ else /* if ( field_struct->scalar_array_member ) */
642 {
643 /*
644 Here we are constructing a list of nodes to represent the list of 4D scalar arrays in the model
645
646 This list is rooted at the FourD pointer.
647 Each array is represented by its own node; each node has a pointer, members, to the list
648 of fields that make it up.
649
650 */
651 node_t * q , * member ;
652 if (( q = get_4d_entry(field_struct->use )) == NULL ) /* first instance of a 4d array member */
653 {
654 q = new_node( FOURD ) ;
655 *q = *field_struct ; /* this overwrites the node */
656 strcpy( q->name, field_struct->use ) ;
657 strcpy( q->use, "" ) ;
658 q->node_kind = FOURD ;
659 q->scalar_array_member = 0 ;
660 q->next4d = NULL ;
661 q->next = NULL ;
662 /* add 4d q node to the list of fields of this type and also attach
663 it to the global list of 4d arrays */
664 add_node_to_end( q , &(type_struct->fields) ) ;
665 add_node_to_end_4d( q , &(FourD) ) ;
666 }
667 member = new_node( MEMBER ) ;
668 *member = *q ;
669 member->node_kind = MEMBER ;
670 member->members = NULL ;
671 member->scalar_array_member = 1 ;
672 strcpy( member->name , field_struct->name ) ;
673 strcpy( member->dname , field_struct->dname ) ;
674 strcpy( member->use , field_struct->use ) ;
675 strcpy( member->descrip , field_struct->descrip ) ;
676 strcpy( member->units , field_struct->units ) ;
677 member->next = NULL ;
678 member->io_mask = field_struct->io_mask ;
679 member->ndims = field_struct->ndims ;
680 strcpy( member->interpd_fcn_name, field_struct->interpd_fcn_name) ;
681 strcpy( member->interpd_aux_fields, field_struct->interpd_aux_fields) ;
682 strcpy( member->interpu_fcn_name, field_struct->interpu_fcn_name) ;
683 strcpy( member->interpu_aux_fields, field_struct->interpu_aux_fields) ;
684 strcpy( member->smoothu_fcn_name, field_struct->smoothu_fcn_name) ;
685 strcpy( member->smoothu_aux_fields, field_struct->smoothu_aux_fields) ;
686 strcpy( member->force_fcn_name, field_struct->force_fcn_name) ;
687 strcpy( member->force_aux_fields, field_struct->force_aux_fields) ;
688 for ( ii = 0 ; ii < member->ndims ; ii++ )
689 member->dims[ii] = field_struct->dims[ii] ;
690 add_node_to_end( member , &(q->members) ) ;
691 free(field_struct) ; /* We've used all the information about this entry.
692 It is not a field but the name of one of the members of
693 a 4d field. we have handled that here. Discard the original node. */
694 }
695 }
696
697 /* dimespec entry */
698 else if ( !strcmp( tokens[ TABLE ] , "dimspec" ) )
699 {
700 node_t * dim_struct ;
701 dim_struct = new_node( DIM ) ;
702 if ( strlen( tokens[DIM_NAME] ) > 1 )
703 { fprintf(stderr,"Registry warning: dimspec (%s) must be only one letter\n",tokens[DIM_NAME] ) ; }
704 if ( get_dim_entry ( tokens[DIM_NAME][0] ) != NULL )
705 { fprintf(stderr,"Registry warning: dimspec (%c) already defined\n",tokens[DIM_NAME][0] ) ; }
706 dim_struct->dim_name = tokens[DIM_NAME][0] ;
707 if ( set_dim_order( tokens[DIM_ORDER], dim_struct ) )
708 { fprintf(stderr,"Registry warning: problem with dimorder (%s)\n",tokens[DIM_ORDER] ) ; }
709 if ( set_dim_len( tokens[DIM_SPEC], dim_struct ) )
710 { fprintf(stderr,"Registry warning: problem with dimspec (%s)\n",tokens[DIM_SPEC] ) ; }
711 if ( set_dim_orient( tokens[DIM_ORIENT], dim_struct ) )
712 { fprintf(stderr,"Registry warning: problem with dimorient (%s)\n",tokens[DIM_ORIENT] ) ; }
713 if ( strcmp( tokens[DIM_DATA_NAME], "-" ) ) /* that is, if not equal "-" */
714 { strcpy( dim_struct->dim_data_name , tokens[DIM_DATA_NAME] ) ; }
715
716 add_node_to_end( dim_struct , &Dim ) ;
717 }
718
719 /* package */
720 else if ( !strcmp( tokens[ TABLE ] , "package" ) )
721 {
722 node_t * package_struct ;
723 package_struct = new_node( PACKAGE ) ;
724 strcpy( package_struct->name , tokens[PKG_SYM] ) ;
725 strcpy( package_struct->pkg_assoc , tokens[PKG_ASSOC] ) ;
726 strcpy( package_struct->pkg_statevars , tokens[PKG_STATEVARS] ) ;
727 strcpy( package_struct->pkg_4dscalars , tokens[PKG_4DSCALARS] ) ;
728
729 add_node_to_end( package_struct , &Packages ) ;
730 }
731
732 /* halo, period, xpose */
733 else if ( !strcmp( tokens[ TABLE ] , "halo" ) )
734 {
735 node_t * comm_struct ;
736 comm_struct = new_node( HALO ) ;
737 strcpy( comm_struct->name , tokens[COMM_ID] ) ;
738 strcpy( comm_struct->use , tokens[COMM_USE] ) ;
739 #if 1
740 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) {
741 for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
742 }
743 #else
744 strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
745 #endif
746 add_node_to_end( comm_struct , &Halos ) ;
747 }
748 else if ( !strcmp( tokens[ TABLE ] , "period" ) )
749 {
750 node_t * comm_struct ;
751 comm_struct = new_node( PERIOD ) ;
752 strcpy( comm_struct->name , tokens[COMM_ID] ) ;
753 strcpy( comm_struct->use , tokens[COMM_USE] ) ;
754 #if 1
755 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) {
756 for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
757 }
758 #else
759 strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
760 #endif
761 add_node_to_end( comm_struct , &Periods ) ;
762 }
763 else if ( !strcmp( tokens[ TABLE ] , "xpose" ) )
764 {
765 node_t * comm_struct ;
766 comm_struct = new_node( XPOSE ) ;
767 strcpy( comm_struct->name , tokens[COMM_ID] ) ;
768 strcpy( comm_struct->use , tokens[COMM_USE] ) ;
769 #if 1
770 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) {
771 for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
772 }
773 #else
774 strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
775 #endif
776 add_node_to_end( comm_struct , &Xposes ) ;
777 }
778 else if ( !strcmp( tokens[ TABLE ] , "swap" ) )
779 {
780 node_t * comm_struct ;
781 comm_struct = new_node( SWAP ) ;
782 strcpy( comm_struct->name , tokens[COMM_ID] ) ;
783 strcpy( comm_struct->use , tokens[COMM_USE] ) ;
784 #if 1
785 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) {
786 for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
787 }
788 #else
789 strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
790 #endif
791 add_node_to_end( comm_struct , &Swaps ) ;
792 }
793 else if ( !strcmp( tokens[ TABLE ] , "cycle" ) )
794 {
795 node_t * comm_struct ;
796 comm_struct = new_node( CYCLE ) ;
797 strcpy( comm_struct->name , tokens[COMM_ID] ) ;
798 strcpy( comm_struct->use , tokens[COMM_USE] ) ;
799 #if 1
800 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) {
801 for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
802 }
803 #else
804 strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
805 #endif
806 add_node_to_end( comm_struct , &Cycles ) ;
807 }
808
809
810 #if 0
811 fprintf(stderr,"vvvvvvvvvvvvvvvvvvvvvvvvvvv\n") ;
812 show_nodelist( Type ) ;
813 fprintf(stderr,"^^^^^^^^^^^^^^^^^^^^^^^^^^^\n") ;
814 #endif
815 parseline[0] = '\0' ; /* reset parseline */
816 }
817
818 Domain = *(get_type_entry( "domain" )) ;
819
820 #if 0
821 show_node( &Domain ) ;
822 #endif
823
824 return(0) ;
825
826 }
827
828 node_t *
829 get_dim_entry( char c )
830 {
831 node_t * p ;
832 for ( p = Dim ; p != NULL ; p = p->next )
833 {
834 if ( p->dim_name == c ) return( p ) ;
835 }
836 return(NULL) ;
837 }
838
839 int
840 set_state_type( char * typename, node_t * state_entry )
841 {
842 if ( typename == NULL ) return(1) ;
843 return (( state_entry->type = get_type_entry( typename )) == NULL ) ;
844 }
845
846 int
847 set_dim_len ( char * dimspec , node_t * dim_entry )
848 {
849 if (!strcmp( dimspec , "standard_domain" ))
850 { dim_entry->len_defined_how = DOMAIN_STANDARD ; }
851 else if (!strncmp( dimspec, "constant=" , 9 ))
852 {
853 char *p, *colon, *paren ;
854 p = &(dimspec[9]) ;
855 /* check for colon */
856 if (( colon = index(p,':')) != NULL )
857 {
858 *colon = '\0' ;
859 if (( paren = index(p,'(')) !=NULL )
860 {
861 dim_entry->coord_start = atoi(paren+1) ;
862 }
863 else
864 {
865 fprintf(stderr,"WARNING: illegal syntax (missing opening paren) for constant: %s\n",p) ;
866 }
867 dim_entry->coord_end = atoi(colon+1) ;
868 }
869 else
870 {
871 dim_entry->coord_start = 1 ;
872 dim_entry->coord_end = atoi(p) ;
873 }
874 dim_entry->len_defined_how = CONSTANT ;
875 }
876 else if (!strncmp( dimspec, "namelist=", 9 ))
877 {
878 char *p, *colon ;
879
880 p = &(dimspec[9]) ;
881 /* check for colon */
882 if (( colon = index(p,':')) != NULL )
883 {
884 *colon = '\0' ;
885 strcpy( dim_entry->assoc_nl_var_s, p ) ;
886 strcpy( dim_entry->assoc_nl_var_e, colon+1 ) ;
887 }
888 else
889 {
890 strcpy( dim_entry->assoc_nl_var_s, "1" ) ;
891 strcpy( dim_entry->assoc_nl_var_e, p ) ;
892 }
893 dim_entry->len_defined_how = NAMELIST ;
894 }
895 else
896 {
897 return(1) ;
898 }
899 return(0) ;
900 }
901
902 int
903 set_dim_orient ( char * dimorient , node_t * dim_entry )
904 {
905 if (!strcmp( dimorient , "x" ))
906 { dim_entry->coord_axis = COORD_X ; }
907 else if (!strcmp( dimorient , "y" ))
908 { dim_entry->coord_axis = COORD_Y ; }
909 else if (!strcmp( dimorient , "z" ))
910 { dim_entry->coord_axis = COORD_Z ; }
911 else
912 { dim_entry->coord_axis = COORD_C ; }
913 return(0) ;
914 }
915
916 /* integrity checking of dimension list; make sure that
917 namelist specified dimensions have an associated namelist variable */
918 int
919 check_dimspecs()
920 {
921 node_t * p, *q ;
922 int ord ;
923
924 for ( p = Dim ; p != NULL ; p = p->next )
925 {
926 if ( p->len_defined_how == DOMAIN_STANDARD )
927 {
928 if ( p->dim_order < 1 || p->dim_order > 3 )
929 {
930 fprintf(stderr,"WARNING: illegal dim order %d for dimspec %s\n",p->dim_order,p->name) ;
931 }
932 ord = p->dim_order-1 ;
933 if ( model_order[ord] != p->coord_axis )
934 {
935 if ( model_order[ord] == -1 ) model_order[ord] = p->coord_axis ;
936 else
937 {
938 fprintf(stderr,"WARNING: coord-axis/dim-order for dimspec %s is inconsistent with previous dimspec.\n",p->name) ;
939 }
940 }
941 }
942 else if ( p->len_defined_how == NAMELIST )
943 {
944 if ( strcmp( p->assoc_nl_var_s, "1" ) ) /* if not equal to "1" */
945 {
946 if (( q = get_entry(p->assoc_nl_var_s,Domain.fields)) == NULL )
947 {
948 fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
949 p->assoc_nl_var_s,p->name ) ;
950 return(1) ;
951 }
952 if ( ! q->node_kind & RCONFIG )
953 {
954 fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
955 p->assoc_nl_var_s,p->name ) ;
956 return(1) ;
957 }
958 if ( strcmp( q->type->name , "integer" ) ) /* if not integer */
959 {
960 fprintf(stderr,"WARNING: namelist variable %s must be an integer if used to define dimension %s\n",
961 p->assoc_nl_var_s,p->name ) ;
962 return(1) ;
963 }
964 if ( strcmp( q->nentries , "1" ) ) /* if not 1 entry */
965 {
966 fprintf(stderr,"WARNING: namelist variable %s must have only one entry if used to define dimension %s\n",
967 p->assoc_nl_var_s,p->name ) ;
968 return(1) ;
969 }
970 }
971 if (( q = get_entry(p->assoc_nl_var_e,Domain.fields)) == NULL )
972 {
973 fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
974 p->assoc_nl_var_e,p->name ) ;
975 return(1) ;
976 }
977 if ( ! q->node_kind & RCONFIG )
978 {
979 fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
980 p->assoc_nl_var_e,p->name ) ;
981 return(1) ;
982 }
983 if ( strcmp( q->type->name , "integer" ) ) /* if not integer */
984 {
985 fprintf(stderr,"WARNING: namelist variable %s must be an integer if used to define dimension %s\n",
986 p->assoc_nl_var_e,p->name ) ;
987 return(1) ;
988 }
989 if ( strcmp( q->nentries , "1" ) ) /* if not 1 entry */
990 {
991 fprintf(stderr,"WARNING: namelist variable %s must have only one entry if used to define dimension %s\n",
992 p->assoc_nl_var_e,p->name ) ;
993 return(1) ;
994 }
995 }
996 }
997 return(0) ;
998 }
999
1000 int
1001 set_dim_order ( char * dimorder , node_t * dim_entry )
1002 {
1003 dim_entry->dim_order = atoi(dimorder) ;
1004 return(0) ;
1005 }
1006
1007 init_parser()
1008 {
1009 model_order[0] = -1 ;
1010 model_order[1] = -1 ;
1011 model_order[2] = -1 ;
1012 return(0) ;
1013 }