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