source: trunk/WRF.COMMON/WRFV3/tools/reg_parse.c @ 3094

Last change on this file since 3094 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 37.8 KB
Line 
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
82static int ntracers = 0 ;
83static char tracers[1000][100] ;
84
85int
86pre_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    }
284normal:
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
292int
293reg_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
826node_t *
827get_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
837int
838set_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
844int
845set_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
900int
901set_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 */
916int
917check_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
998int
999set_dim_order ( char * dimorder , node_t * dim_entry )
1000{
1001  dim_entry->dim_order = atoi(dimorder) ;
1002  return(0) ;
1003}
1004
1005init_parser()
1006{
1007  model_order[0] = -1 ;
1008  model_order[1] = -1 ;
1009  model_order[2] = -1 ;
1010  return(0) ;
1011}
Note: See TracBrowser for help on using the repository browser.