source: trunk/WRF.COMMON/WRFV2/tools/reg_parse.c @ 2756

Last change on this file since 2756 was 11, checked in by aslmd, 14 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 38.0 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[4096], parseline[4096], parseline_save[4096] ;
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          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
828node_t *
829get_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
839int
840set_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
846int
847set_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
902int
903set_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 */
918int
919check_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
1000int
1001set_dim_order ( char * dimorder , node_t * dim_entry )
1002{
1003  dim_entry->dim_order = atoi(dimorder) ;
1004  return(0) ;
1005}
1006
1007init_parser()
1008{
1009  model_order[0] = -1 ;
1010  model_order[1] = -1 ;
1011  model_order[2] = -1 ;
1012  return(0) ;
1013}
Note: See TracBrowser for help on using the repository browser.