PageRenderTime 54ms CodeModel.GetById 22ms RepoModel.GetById 0ms app.codeStats 0ms

/wrfv2_fire/tools/reg_parse.c

http://github.com/jbeezley/wrf-fire
C | 1039 lines | 890 code | 94 blank | 55 comment | 400 complexity | a8b1d00565f7e2c5145dc1bab3a37952 MD5 | raw file
Possible License(s): AGPL-1.0 
    

  1. #include <stdio.h>
    2. 

  2. #include <stdlib.h>
    3. 

  3. #include <string.h>
    4. 

  4. #ifdef _WIN32
    5. 

  5. # define rindex(X,Y) strrchr(X,Y)
    6. 

  6. # define index(X,Y) strchr(X,Y)
    7. 

  7. #else
    8. 

  8. # include <strings.h>
    9. 

  9. #endif
    10. 

  10. 

  11. #include "registry.h"
    12. 

  12. #include "protos.h"
    13. 

  13. #include "data.h"
    14. 

  14. #include "sym.h"
    15. 

  15. 

  16. /* read in the Registry file and build the internal representation of the registry */
    17. 

  17. 

  18. #define MAXTOKENS 5000 /*changed MAXTOKENS from 1000 to 5000 by Manish Shrivastava on 01/28/2010*/
    19. 

  19. 

  20. /* fields for state entries (note, these get converted to field entries in the
    21. 

  21.    reg_parse routine; therefore, only TABLE needs to be looked at */
    22. 

  22. #define TABLE 0
    23. 

  23. 

  24. /* fields for field entries (TABLE="typedef" and, with some munging,  TABLE="state") */
    25. 

  25. #define FIELD_OF        1
    26. 

  26. #define FIELD_TYPE     2
    27. 

  27. #define FIELD_SYM      3
    28. 

  28. #define FIELD_DIMS     4
    29. 

  29. #define FIELD_USE      5
    30. 

  30. #define FIELD_NTL      6
    31. 

  31. #define FIELD_STAG     7
    32. 

  32. #define FIELD_IO       8
    33. 

  33. #define FIELD_DNAME    9
    34. 

  34. #define FIELD_DESCRIP 10
    35. 

  35. #define FIELD_UNITS   11
    36. 

  36. 

  37. #define F_OF       0
    38. 

  38. #define F_TYPE     1
    39. 

  39. #define F_SYM      2
    40. 

  40. #define F_DIMS     3
    41. 

  41. #define F_USE      4
    42. 

  42. #define F_NTL      5
    43. 

  43. #define F_STAG     6
    44. 

  44. #define F_IO       7
    45. 

  45. #define F_DNAME    8
    46. 

  46. #define F_DESCRIP  9
    47. 

  47. #define F_UNITS   10
    48. 

  48. 

  49. /* fields for rconfig entries (RCNF) */
    50. 

  50. #define RCNF_TYPE_PRE       1
    51. 

  51. #define RCNF_SYM_PRE        2
    52. 

  52. #define RCNF_HOWSET_PRE     3
    53. 

  53. #define RCNF_NENTRIES_PRE   4
    54. 

  54. #define RCNF_DEFAULT_PRE    5
    55. 

  55. #define RCNF_IO_PRE         6
    56. 

  56. #define RCNF_DNAME_PRE      7
    57. 

  57. #define RCNF_DESCRIP_PRE    8
    58. 

  58. #define RCNF_UNITS_PRE      9
    59. 

  59. 

  60. #define RCNF_TYPE       2
    61. 

  61. #define RCNF_SYM        3
    62. 

  62. #define RCNF_USE        FIELD_USE
    63. 

  63. #define RCNF_IO         FIELD_IO
    64. 

  64. #define RCNF_DNAME      FIELD_DNAME
    65. 

  65. #define RCNF_DESCRIP    FIELD_DESCRIP
    66. 

  66. #define RCNF_UNITS      FIELD_UNITS
    67. 

  67. #define RCNF_HOWSET    20
    68. 

  68. #define RCNF_NENTRIES  21
    69. 

  69. #define RCNF_DEFAULT   22
    70. 

  70. 

  71. /* fields for dimension entries (TABLE="dimspec") */
    72. 

  72. #define DIM_NAME       1
    73. 

  73. #define DIM_ORDER      2
    74. 

  74. #define DIM_SPEC       3
    75. 

  75. #define DIM_ORIENT     4
    76. 

  76. #define DIM_DATA_NAME  5
    77. 

  77. 

  78. #define PKG_SYM            1
    79. 

  79. #define PKG_ASSOC          2
    80. 

  80. #define PKG_STATEVARS      3
    81. 

  81. #define PKG_4DSCALARS      4
    82. 

  82. 

  83. #define COMM_ID            1
    84. 

  84. #define COMM_USE           2
    85. 

  85. #define COMM_DEFINE        3
    86. 

  86. 

  87. static int ntracers = 0 ;
    88. 

  88. static char tracers[1000][100] ;
    89. 

  89. 

  90. int
    91. 

  91. pre_parse( char * dir, FILE * infile, FILE * outfile )
    92. 

  92. {
    93. 

  93.   /* Decreased size for SOA from 8192 to 8000--double check if necessary, Manish Shrivastava 2010 */
    94. 

  94.   char inln[8000], parseline[8000], parseline_save[8000] ;
    95. 

  95.   int found ; 
    96. 

  96.   char *p, *q ;
    97. 

  97.   char *tokens[MAXTOKENS], *toktmp[MAXTOKENS], newdims[NAMELEN_LONG], newdims4d[NAMELEN_LONG],newname[NAMELEN_LONG] ;
    98. 

  98.   int i, ii, len_of_tok ;
    99. 

  99.   char x, xstr[NAMELEN_LONG] ;
    100. 

  100.   int is4d, wantstend, wantsbdy ;
    101. 

  101.   int ifdef_stack_ptr = 0 ;
    102. 

  102.   int ifdef_stack[100] ;
    103. 

  103.   int inquote, retval ;
    104. 

  104. 

  105.   ifdef_stack[0] = 1 ;
    106. 

  106.   retval = 0 ;
    107. 

  107. 

  108.   parseline[0] = '\0' ;
    109. 

  109. /* main parse loop over registry lines */
    110. 

  110.   /* Had to increase size for SOA from 4096 to 7000, Manish Shrivastava 2010 */
    111. 

  111.   while ( fgets ( inln , 7000 , infile ) != NULL )
    112. 

  112.   {
    113. 

  113. 

  114. /*** preprocessing directives ****/
    115. 

  115.     /* look for an include statement */
    116. 

  116.     for ( p = inln ; ( *p == ' ' || *p == '	' ) && *p != '\0' ; p++ ) ;
    117. 

  117.     if ( !strncmp( p , "include", 7 ) &&  ! ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) ) {
    118. 

  118.       FILE *include_fp ;
    119. 

  119.       char include_file_name[128] ;
    120. 

  120.       p += 7 ; for ( ; ( *p == ' ' || *p == '	' ) && *p != '\0' ; p++ ) ;
    121. 

  121.       if ( strlen( p ) > 127 ) { fprintf(stderr,"Registry warning: invalid include file name: %s\n", p ) ; }
    122. 

  122.       else {
    123. 

  123.         sprintf( include_file_name , "%s/%s", dir , p ) ;
    124. 

  124.         if ( (p=index(include_file_name,'\n')) != NULL ) *p = '\0' ;
    125. 

  125.         fprintf(stderr,"opening %s\n",include_file_name) ;
    126. 

  126.         if (( include_fp = fopen( include_file_name , "r" )) != NULL ) {
    127. 

  127. 

  128.           fprintf(stderr,"including %s\n",include_file_name ) ;
    129. 

  129.           pre_parse( dir , include_fp , outfile ) ;
    130. 

  130. 

  131.           fclose( include_fp ) ;
    132. 

  132.         } else {
    133. 

  133.           fprintf(stderr,"Registry warning: cannot open %s. Ignoring.\n", include_file_name ) ;
    134. 

  134.         } 
    135. 

  135.       }
    136. 

  136.     }
    137. 

  137.     else if ( !strncmp( p , "ifdef", 5 ) ) {
    138. 

  138.       char value[32] ;
    139. 

  139.       p += 5 ; for ( ; ( *p == ' ' || *p == '	' ) && *p != '\0' ; p++ ) ;
    140. 

  140.       strncpy(value, p, 31 ) ; value[31] = '\0' ;
    141. 

  141.       if ( (p=index(value,'\n')) != NULL ) *p = '\0' ;
    142. 

  142.       if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,'	')) != NULL ) *p = '\0' ; 
    143. 

  143.       ifdef_stack_ptr++ ;
    144. 

  144.       ifdef_stack[ifdef_stack_ptr] = ( sym_get(value) != NULL && ifdef_stack[ifdef_stack_ptr-1] ) ;
    145. 

  145.       if ( ifdef_stack_ptr >= 100 ) { fprintf(stderr,"Registry fatal: too many nested ifdefs\n") ; exit(1) ; }
    146. 

  146.       continue ;
    147. 

  147.     }
    148. 

  148.     else if ( !strncmp( p , "ifndef", 6 ) ) {
    149. 

  149.       char value[32] ;
    150. 

  150.       p += 6 ; for ( ; ( *p == ' ' || *p == '	' ) && *p != '\0' ; p++ ) ;
    151. 

  151.       strncpy(value, p, 31 ) ; value[31] = '\0' ;
    152. 

  152.       if ( (p=index(value,'\n')) != NULL ) *p = '\0' ;
    153. 

  153.       if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,'	')) != NULL ) *p = '\0' ; 
    154. 

  154.       ifdef_stack_ptr++ ;
    155. 

  155.       ifdef_stack[ifdef_stack_ptr] = ( sym_get(value) == NULL && ifdef_stack[ifdef_stack_ptr-1] ) ;
    156. 

  156.       if ( ifdef_stack_ptr >= 100 ) { fprintf(stderr,"Registry fatal: too many nested ifdefs\n") ; exit(1) ; }
    157. 

  157.       continue ;
    158. 

  158.     }
    159. 

  159.     else if ( !strncmp( p , "endif", 5 ) ) {
    160. 

  160.       ifdef_stack_ptr-- ; 
    161. 

  161.       if ( ifdef_stack_ptr < 0 ) { fprintf(stderr,"Registry fatal: unmatched endif\n") ; exit(1) ; }
    162. 

  162.       continue ;
    163. 

  163.     }
    164. 

  164.     else if ( !strncmp( p , "define", 6 ) ) {
    165. 

  165.       char value[32] ;
    166. 

  166.       p += 6 ; for ( ; ( *p == ' ' || *p == '	' ) && *p != '\0' ; p++ ) ;
    167. 

  167.       strncpy(value, p, 31 ) ; value[31] = '\0' ;
    168. 

  168.       if ( (p=index(value,'\n')) != NULL ) *p = '\0' ;
    169. 

  169.       if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,'	')) != NULL ) *p = '\0' ; 
    170. 

  170.       sym_add( value ) ;
    171. 

  171.       continue ;
    172. 

  172.     }
    173. 

  173.     if ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) continue ;
    174. 

  174. /*** end of preprocessing directives ****/
    175. 

  175. 

  176.     strcat( parseline , inln ) ;
    177. 

  177. 

  178.     /* allow \ to continue the end of a line */
    179. 

  179.     if (( p = index( parseline,  '\\'  )) != NULL )
    180. 

  180.     {
    181. 

  181.       if ( *(p+1) == '\n' || *(p+1) == '\0' )
    182. 

  182.       {
    183. 

  183.         *p = '\0' ;
    184. 

  184.         continue ;  /* go get another line */
    185. 

  185.       }
    186. 

  186.     }
    187. 

  187.     make_lower( parseline ) ;
    188. 

  188. 

  189.     if (( p = index( parseline , '\n' )) != NULL  ) *p = '\0' ; /* discard newlines */
    190. 

  190. 

  191.     /* check line and zap any # characters that are in double quotes */
    192. 

  192. 

  193.     for ( p = parseline, inquote = 0 ; *p ; p++ ) {
    194. 

  194.       if      ( *p == '"' && inquote ) inquote = 0 ;
    195. 

  195.       else if ( *p == '"' && !inquote ) inquote = 1 ;
    196. 

  196.       else if ( *p == '#' && inquote ) *p = ' ' ;
    197. 

  197.       else if ( *p == '#' && !inquote ) { *p = '\0' ; break ; }
    198. 

  198.     }
    199. 

  199.     if ( inquote ) { retval=1 ; fprintf(stderr,"Registry error: unbalanced quotes in line:\n%s\n",parseline) ;}
    200. 

  200. 

  201.     for ( i = 0 ; i < MAXTOKENS ; i++ ) tokens[i] = NULL ;
    202. 

  202.     i = 0 ;
    203. 

  203. 

  204.     strcpy( parseline_save, parseline ) ;
    205. 

  205. 

  206.     if ((tokens[i] = my_strtok(parseline)) != NULL ) i++ ;
    207. 

  207.     while (( tokens[i] = my_strtok(NULL) ) != NULL && i < MAXTOKENS ) i++ ;
    208. 

  208.     if ( i <= 0 ) continue ;
    209. 

  209. 

  210.     for ( i = 0 ; i < MAXTOKENS ; i++ )
    211. 

  211.     {
    212. 

  212.       if ( tokens[i] == NULL ) tokens[i] = "-" ;
    213. 

  213.     }
    214. 

  214. /* remove quotes from quoted entries */
    215. 

  215.     for ( i = 0 ; i < MAXTOKENS ; i++ )
    216. 

  216.     {
    217. 

  217.       char * pp ;
    218. 

  218.       if ( tokens[i][0] == '"' ) tokens[i]++ ;
    219. 

  219.       if ((pp=rindex( tokens[i], '"' )) != NULL ) *pp = '\0' ;
    220. 

  220.     }
    221. 

  221.     if      ( !strcmp( tokens[ TABLE ] , "state" ) )
    222. 

  222.     {
    223. 

  223.         int inbrace = 0 ;
    224. 

  224.         strcpy( newdims, "" ) ;
    225. 

  225.         strcpy( newdims4d, "" ) ;
    226. 

  226.         is4d = 0 ; wantstend = 0 ; wantsbdy = 0 ; 
    227. 

  227.         for ( i = 0 ; i < (len_of_tok = strlen(tokens[F_DIMS])) ; i++ )
    228. 

  228.         {
    229. 

  229.           x = tolower(tokens[F_DIMS][i]) ;
    230. 

  230.           if ( x == '{' ) { inbrace = 1 ; }
    231. 

  231.           if ( x == '}' ) { inbrace = 0 ; }
    232. 

  232.           if ( x >= 'a' && x <= 'z' && !inbrace ) {
    233. 

  233.             if ( x == 'f' ) { is4d = 1 ; }
    234. 

  234.             if ( x == 't' ) { wantstend = 1 ; }
    235. 

  235.             if ( x == 'b' ) { wantsbdy = 1 ; }
    236. 

  236.           }
    237. 

  237.           sprintf(xstr,"%c",x) ;
    238. 

  238.           if ( x != 'b' || inbrace ) strcat ( newdims , xstr ) ;
    239. 

  239.           if ( x != 'f' && x != 't' || inbrace ) strcat( newdims4d , xstr ) ;
    240. 

  240. 

  241.         }
    242. 

  242.         if ( wantsbdy ) {
    243. 

  243. 

  244. 

  245. /* first re-gurg the original entry without the b in the dims */
    246. 

  246. 

  247.  fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"%s\" \"%s\"\n",tokens[F_TYPE],tokens[F_SYM], newdims,
    248. 

  248.                   tokens[F_USE],tokens[F_NTL],tokens[F_STAG],tokens[F_IO],
    249. 

  249.                   tokens[F_DNAME],tokens[F_DESCRIP],tokens[F_UNITS] ) ;
    250. 

  250. 

  251.           if ( strcmp( tokens[F_SYM] , "-" ) ) {  /* if not unnamed, as can happen with first 4d tracer */
    252. 

  252. /* next, output some additional entries for the boundary arrays for these guys */
    253. 

  253.             if ( is4d == 1 ) {
    254. 

  254.               for ( i = 0, found = 0 ; i < ntracers ; i++ ) {
    255. 

  255. 	        if ( !strcmp( tokens[F_USE] , tracers[i] ) ) found = 1 ; 
    256. 

  256.               }
    257. 

  257. 	      if ( found == 0 ) {
    258. 

  258. 	        sprintf(tracers[ntracers],tokens[F_USE]) ;
    259. 

  259. 	        ntracers++ ;
    260. 

  260. 

  261. /* add entries for _b and _bt arrays */
    262. 

  262. 

  263.  sprintf(newname,"%s_b",tokens[F_USE]) ;
    264. 

  264.  fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy %s\" \"%s\"\n",tokens[F_TYPE],newname,newdims4d,
    265. 

  265.                   "_4d_bdy_array_","-",tokens[F_STAG],"b",
    266. 

  266.                   newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;
    267. 

  267. 

  268.  sprintf(newname,"%s_bt",tokens[F_USE]) ;
    269. 

  269.  fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy tend %s\" \"(%s)/dt\"\n",tokens[F_TYPE],newname,newdims4d,
    270. 

  270.                   "_4d_bdy_array_","-",tokens[F_STAG],"b",
    271. 

  271.                   newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;
    272. 

  272. 

  273.   	      }
    274. 

  274.             } else {
    275. 

  275. 

  276. /* add entries for _b and _bt arrays */
    277. 

  277. 

  278.  sprintf(newname,"%s_b",tokens[F_SYM]) ;
    279. 

  279.  fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy %s\" \"%s\"\n",tokens[F_TYPE],newname,tokens[F_DIMS],
    280. 

  280.                   tokens[F_USE],"-",tokens[F_STAG],"b",
    281. 

  281.                   newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;
    282. 

  282. 

  283.  sprintf(newname,"%s_bt",tokens[F_SYM]) ;
    284. 

  284.  fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy tend %s\" \"(%s)/dt\"\n",tokens[F_TYPE],newname,tokens[F_DIMS],
    285. 

  285.                   tokens[F_USE],"-",tokens[F_STAG],"b",
    286. 

  286.                   newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;
    287. 

  287. 

  288.             }
    289. 

  289.           }
    290. 

  290.           parseline[0] = '\0' ;  /* reset parseline */
    291. 

  291.           continue ;
    292. 

  292.         }
    293. 

  293.     }
    294. 

  294. normal:
    295. 

  295.     /* otherwise output the line as is */
    296. 

  296.     fprintf(outfile,"%s\n",parseline_save) ;
    297. 

  297.     parseline[0] = '\0' ;  /* reset parseline */
    298. 

  298.   }
    299. 

  299.   return(retval) ;
    300. 

  300. }
    301. 

  301. 

  302. int
    303. 

  303. reg_parse( FILE * infile )
    304. 

  304. {
    305. 

  305.   /* Had to increase size for SOA from 4096 to 7000, Manish Shrivastava 2010 */
    306. 

  306.   char inln[7000], parseline[7000] ;
    307. 

  307.   char *p, *q ;
    308. 

  308.   char *tokens[MAXTOKENS], *toktmp[MAXTOKENS] ; 
    309. 

  309.   int i, ii ;
    310. 

  310.   int defining_state_field, defining_rconfig_field, defining_i1_field ;
    311. 

  311. 

  312.   parseline[0] = '\0' ;
    313. 

  313. 

  314.   max_time_level = 1 ;
    315. 

  315. 

  316. /* main parse loop over registry lines */
    317. 

  317. /* Had to increase size for SOA from 4096 to 7000, Manish Shrivastava 2010 */
    318. 

  318.   while ( fgets ( inln , 7000 , infile ) != NULL )
    319. 

  319.   {
    320. 

  320.     strcat( parseline , inln ) ; 
    321. 

  321.     /* allow \ to continue the end of a line */
    322. 

  322.     if (( p = index( parseline,  '\\'  )) != NULL )
    323. 

  323.     {
    324. 

  324.       if ( *(p+1) == '\n' || *(p+1) == '\0' )
    325. 

  325.       {
    326. 

  326. 	*p = '\0' ;
    327. 

  327. 	continue ;  /* go get another line */
    328. 

  328.       }
    329. 

  329.     }
    330. 

  330. 

  331.     make_lower( parseline ) ;
    332. 

  332.     if (( p = index( parseline , '#' ))  != NULL  ) *p = '\0' ; /* discard comments (dont worry about quotes for now) */
    333. 

  333.     if (( p = index( parseline , '\n' )) != NULL  ) *p = '\0' ; /* discard newlines */
    334. 

  334.     for ( i = 0 ; i < MAXTOKENS ; i++ ) tokens[i] = NULL ; 
    335. 

  335.     i = 0 ;
    336. 

  336. 

  337.     if ((tokens[i] = my_strtok(parseline)) != NULL ) i++ ; 
    338. 

  338. 

  339.     while (( tokens[i] = my_strtok(NULL) ) != NULL && i < MAXTOKENS ) i++ ;
    340. 

  340.     if ( i <= 0 ) continue ;
    341. 

  341. 

  342.     for ( i = 0 ; i < MAXTOKENS ; i++ )
    343. 

  343.     {
    344. 

  344.       if ( tokens[i] == NULL ) tokens[i] = "-" ;
    345. 

  345.     }
    346. 

  346. 

  347. /* remove quotes from quoted entries */
    348. 

  348.     for ( i = 0 ; i < MAXTOKENS ; i++ )
    349. 

  349.     {
    350. 

  350.       char * pp ;
    351. 

  351.       if ( tokens[i][0] == '"' ) tokens[i]++ ;
    352. 

  352.       if ((pp=rindex( tokens[i], '"' )) != NULL ) *pp = '\0' ;
    353. 

  353.     }
    354. 

  354. 

  355.     defining_state_field = 0 ;
    356. 

  356.     defining_rconfig_field = 0 ;
    357. 

  357.     defining_i1_field = 0 ;
    358. 

  358. 

  359. /* state entry */
    360. 

  360.     if      ( !strcmp( tokens[ TABLE ] , "state" ) )
    361. 

  361.     {
    362. 

  362.       /* turn a state entry into a typedef to define a field in the top-level built-in type domain */
    363. 

  363.       tokens[TABLE] = "typedef" ;
    364. 

  364.       for ( i = MAXTOKENS-1 ; i >= 2 ; i-- ) tokens[i] = tokens[i-1] ; /* shift the fields to the left */
    365. 

  365.       tokens[FIELD_OF] = "domain" ;
    366. 

  366.                  if ( !strcmp( tokens[FIELD_TYPE], "double" ) ) tokens[FIELD_TYPE] = "doubleprecision" ; 
    367. 

  367.       defining_state_field = 1 ;
    368. 

  368.     }
    369. 

  369.     if      ( !strcmp( tokens[ TABLE ] , "rconfig" ) )
    370. 

  370.     {
    371. 

  371. 

  372.       char *pp, value[256] ;
    373. 

  373.       for ( pp = tokens[RCNF_SYM_PRE] ; (*pp == ' ' || *pp == '	') && *pp ; pp++ ) ;
    374. 

  374.       sprintf(value, "RCONFIG_%s" ,pp) ;
    375. 

  375.       if ( sym_get(value) == NULL ) {
    376. 

  376.         sym_add(value) ;
    377. 

  377.       } else {
    378. 

  378.         parseline[0] = '\0' ;  /* reset parseline */
    379. 

  379.         continue ;
    380. 

  380.       }
    381. 

  381. 

  382.       /* turn a rconfig entry into a typedef to define a field in the top-level built-in type domain */
    383. 

  383.       for ( i = 0 ; i < MAXTOKENS ; i++ ) { toktmp[i] = tokens[i] ; tokens[i] = "-" ; }
    384. 

  384.       tokens[TABLE] = "typedef" ;
    385. 

  385.       tokens[FIELD_OF]       = "domain" ;
    386. 

  386.       tokens[RCNF_TYPE]      = toktmp[RCNF_TYPE_PRE] ;
    387. 

  387.                  if ( !strcmp( tokens[RCNF_TYPE], "double" ) ) tokens[RCNF_TYPE] = "doubleprecision" ; 
    388. 

  388.       tokens[RCNF_SYM]       = toktmp[RCNF_SYM_PRE] ;
    389. 

  389.       tokens[RCNF_IO]        = toktmp[RCNF_IO_PRE] ;
    390. 

  390.       tokens[RCNF_DNAME]     = toktmp[RCNF_DNAME_PRE] ;
    391. 

  391.       tokens[RCNF_USE]       = "-" ;
    392. 

  392.       tokens[RCNF_DESCRIP]   = toktmp[RCNF_DESCRIP_PRE] ;
    393. 

  393.       tokens[RCNF_UNITS]     = toktmp[RCNF_UNITS_PRE] ;
    394. 

  394.       tokens[RCNF_HOWSET]    = toktmp[RCNF_HOWSET_PRE] ;
    395. 

  395.       tokens[RCNF_NENTRIES]  = toktmp[RCNF_NENTRIES_PRE] ;
    396. 

  396.       tokens[RCNF_DEFAULT]   = toktmp[RCNF_DEFAULT_PRE] ;
    397. 

  397.       defining_rconfig_field = 1 ;
    398. 

  398.     }
    399. 

  399.     if      ( !strcmp( tokens[ TABLE ] , "i1" ) )
    400. 

  400.     {
    401. 

  401.       /* turn a state entry into a typedef to define a field in 
    402. 

  402.          the top-level built-in type domain */
    403. 

  403.       tokens[TABLE] = "typedef" ;
    404. 

  404.       /* shift the fields to the left */
    405. 

  405.       for ( i = MAXTOKENS-1 ; i >= 2 ; i-- ) tokens[i] = tokens[i-1] ; 
    406. 

  406.       tokens[FIELD_OF] = "domain" ;
    407. 

  407.                  if ( !strcmp( tokens[FIELD_TYPE], "double" ) ) tokens[FIELD_TYPE] = "doubleprecision" ; 
    408. 

  408.       defining_i1_field = 1 ;
    409. 

  409.     }
    410. 

  410. 

  411.     /* NOTE: fall through */
    412. 

  412. 

  413. /* typedef entry */
    414. 

  414.     if ( !strcmp( tokens[ TABLE ] , "typedef" ) )
    415. 

  415.     {
    416. 

  416.       node_t * field_struct ;
    417. 

  417.       node_t * type_struct ;
    418. 

  418. 

  419.       if ( !defining_state_field && ! defining_i1_field && 
    420. 

  420.            !defining_rconfig_field && !strcmp(tokens[FIELD_OF],"domain") )
    421. 

  421.        { fprintf(stderr,"Registry warning: 'domain' is a reserved registry type name. Cannot 'typedef domain'\n") ; }
    422. 

  422. 

  423.       type_struct = get_type_entry( tokens[ FIELD_OF ] ) ;
    424. 

  424.       if ( type_struct == NULL ) 
    425. 

  425.       {  
    426. 

  426.         type_struct = new_node( TYPE ) ;
    427. 

  427.         strcpy( type_struct->name, tokens[FIELD_OF] ) ;
    428. 

  428.         type_struct->type_type = DERIVED ;
    429. 

  429.         add_node_to_end( type_struct , &Type ) ;
    430. 

  430.       }
    431. 

  431. 

  432.       if        ( defining_i1_field )      {
    433. 

  433.         field_struct = new_node( I1 ) ;
    434. 

  434.       } else if ( defining_rconfig_field ) {
    435. 

  435.         field_struct = new_node( RCONFIG ) ;
    436. 

  436.       } else {
    437. 

  437.         field_struct = new_node( FIELD ) ;
    438. 

  438.       }
    439. 

  439. 

  440.       strcpy( field_struct->name, tokens[FIELD_SYM] ) ;
    441. 

  441. 

  442.       if ( set_state_type( tokens[FIELD_TYPE], field_struct ) )
    443. 

  443.        { fprintf(stderr,"Registry warning: type %s used before defined \n",tokens[FIELD_TYPE] ) ; }
    444. 

  444. 

  445.       if ( set_state_dims( tokens[FIELD_DIMS], field_struct ) )
    446. 

  446.        { fprintf(stderr,"Registry warning: some problem with dimstring %s\n", tokens[FIELD_DIMS] ) ; }
    447. 

  447. 

  448.       if ( strcmp( tokens[FIELD_NTL], "-" ) ) /* that is, if not equal "-" */
    449. 

  449.        { field_struct->ntl = atoi(tokens[FIELD_NTL]) ; }
    450. 

  450.       field_struct->ntl = ( field_struct->ntl > 0 )?field_struct->ntl:1 ;
    451. 

  451.       /* calculate the maximum number of time levels and store in global variable */
    452. 

  452.       if ( field_struct->ntl > max_time_level && field_struct->ntl <= 3 ) max_time_level = field_struct->ntl ;
    453. 

  453. 

  454.       field_struct->stag_x = 0 ; field_struct->stag_y = 0 ; field_struct->stag_z = 0 ;
    455. 

  455.       for ( i = 0 ; i < strlen(tokens[FIELD_STAG]) ; i++ )
    456. 

  456.       {
    457. 

  457. 	if ( tolower(tokens[FIELD_STAG][i]) == 'x' || sw_all_x_staggered ) field_struct->stag_x = 1 ;
    458. 

  458. 	if ( tolower(tokens[FIELD_STAG][i]) == 'y' || sw_all_y_staggered ) field_struct->stag_y = 1 ;
    459. 

  459. 	if ( tolower(tokens[FIELD_STAG][i]) == 'z' ) field_struct->stag_z = 1 ;
    460. 

  460.       }
    461. 

  461. 

  462.       field_struct->restart  = 0 ; field_struct->boundary  = 0 ;
    463. 

  463.       for ( i = 0 ; i < MAX_STREAMS ; i++ ) { 
    464. 

  464.         reset_mask( field_struct->io_mask, i ) ;
    465. 

  465.       }
    466. 

  466. 

  467.       {
    468. 

  468. 	char prev = '\0' ;
    469. 

  469. 	char x ;
    470. 

  470.         char tmp[NAMELEN], tmp1[NAMELEN], tmp2[NAMELEN] ;
    471. 

  471. 	int len_of_tok ;
    472. 

  472.         char fcn_name[2048], aux_fields[2048] ;
    473. 

  473. 

  474.         strcpy(tmp,tokens[FIELD_IO]) ;
    475. 

  475.         if (( p = index(tmp,'=') ) != NULL ) { *p = '\0' ; }
    476. 

  476.         for ( i = 0 ; i < strlen(tmp) ; i++ )
    477. 

  477.         {
    478. 

  478. 	  x = tolower(tmp[i]) ;
    479. 

  479.           if ( x == 'h' || x == 'i' ) {
    480. 

  480.             char c, *p, *pp ;
    481. 

  481.             int unitid ;
    482. 

  482.             int stream ;
    483. 

  483.             unsigned int * mask ;
    484. 

  484.             stream = ( x == 'h' )?HISTORY_STREAM:INPUT_STREAM ;
    485. 

  485.             mask = field_struct->io_mask ;
    486. 

  486.             set_mask( mask , stream ) ;
    487. 

  487.             strcpy(tmp1, &(tmp[++i])) ;
    488. 

  488.             for ( p = tmp1  ; *p ; i++, p++ ) { 
    489. 

  489.               c = tolower(*p) ; if ( c >= 'a' && c <= 'z' ) { *p = '\0' ; i-- ; break ; }
    490. 

  490.               reset_mask( mask , stream ) ;
    491. 

  491.             }
    492. 

  492.             for ( p = tmp1  ; *p ; p++ ) { 
    493. 

  493.               x = *p ;
    494. 

  494.               if ( x >= '0' && x <= '9' ) { 
    495. 

  495.                 set_mask( mask , stream + x - '0' ) ; 
    496. 

  496.               }
    497. 

  497. 	      else if ( x == '{' ) {
    498. 

  498.                 strcpy(tmp2,p+1) ;
    499. 

  499.                 if (( pp = index(tmp2,'}') ) != NULL ) {
    500. 

  500.                   *pp = '\0' ;
    501. 

  501.                   unitid = atoi(tmp2) ;  /* JM 20100416 */
    502. 

  502.                   if ( unitid >= 0  || unitid < MAX_STREAMS && stream + unitid < MAX_HISTORY ) {
    503. 

  503.                     set_mask( mask , stream + unitid   ) ;
    504. 

  504.                   }
    505. 

  505.                   p = p + strlen(tmp2) + 1 ;
    506. 

  506.                 } else {
    507. 

  507.                   fprintf(stderr,"registry syntax error: unmatched {} in the io string for definition of %s\n",tokens[FIELD_SYM]) ;
    508. 

  508.                   exit(9) ;
    509. 

  509.                 }
    510. 

  510.               }
    511. 

  511.             }
    512. 

  512.           }
    513. 

  513.         }
    514. 

  514. 

  515.         for ( i = 0 ; i < (len_of_tok = strlen(tokens[FIELD_IO])) ; i++ )
    516. 

  516.         {
    517. 

  517.           int unitid = -1 ;
    518. 

  518. 	  x = tolower(tokens[FIELD_IO][i]) ;
    519. 

  519. 	  if ( x == '{' ) {
    520. 

  520.             int ii,iii ;
    521. 

  521.             char * pp ;
    522. 

  522.             char tmp[NAMELEN] ;
    523. 

  523.             strcpy(tmp,tokens[FIELD_IO]) ;   
    524. 

  524. 

  525.             if (( pp = index(tmp,'}') ) != NULL ) {
    526. 

  526.               *pp = '\0' ;
    527. 

  527.               iii = pp - (tmp + i + 1) ;
    528. 

  528.               unitid = atoi(tmp+i+1) ;  /* JM 20091102 */
    529. 

  529.               if ( unitid >= 0  || unitid < MAX_STREAMS  && unitid < MAX_HISTORY ) {
    530. 

  530.                 if        ( prev == 'i' ) {
    531. 

  531.                   set_mask( field_struct->io_mask , unitid + MAX_HISTORY  ) ;
    532. 

  532.                 } else if ( prev == 'h' ) {
    533. 

  533.                   set_mask( field_struct->io_mask , unitid   ) ;
    534. 

  534.                 }
    535. 

  535.               }
    536. 

  536. /* avoid infinite loop.  iii can go negative if the '}' is at the end of the line. */
    537. 

  537.               if ( iii > 0 ) i += iii ;
    538. 

  538.               continue ;
    539. 

  539.             } else {
    540. 

  540.               fprintf(stderr,"registry syntax error: unmatched {} in the io string for definition of %s\n",tokens[FIELD_SYM]) ;
    541. 

  541.               exit(9) ;
    542. 

  542.             }
    543. 

  543. 

  544. 	  } else if ( x >= 'a' && x <= 'z' ) {
    545. 

  545. 	    if ( x == 'r' ) { field_struct->restart = 1 ; set_mask( field_struct->io_mask , RESTART_STREAM   ) ; }
    546. 

  546. 	    if ( x == 'b' ) { field_struct->boundary  = 1 ; set_mask( field_struct->io_mask , BOUNDARY_STREAM   ) ; }
    547. 

  547. 	    if ( x == 'f' || x == 'd' || x == 'u' || x == 's' ) { 
    548. 

  548.                                strcpy(aux_fields,"") ;
    549. 

  549.                                strcpy(fcn_name,"") ; 
    550. 

  550. 	                       if ( tokens[FIELD_IO][i+1] == '(' )     /* catch a possible error */
    551. 

  551.                                {
    552. 

  552. 				 fprintf(stderr,
    553. 

  553. 				    "Registry warning: syntax error in %c specifier of IO field for %s\n",x,tokens[FIELD_SYM]) ;
    554. 

  554. 				 fprintf(stderr,
    555. 

  555. 				    "                  equal sign needed before left paren\n") ;
    556. 

  556. 			       }
    557. 

  557. 

  558. 	                       if ( tokens[FIELD_IO][i+1] == '=' ) 
    559. 

  559. 			       {
    560. 

  560. 				 int ii, jj, state ;
    561. 

  561. 				 state = 0 ;
    562. 

  562. 				 jj = 0 ;
    563. 

  563. 				 for ( ii = i+3 ; ii < len_of_tok ; ii++ )
    564. 

  564. 				 {
    565. 

  565. 				   if ( tokens[FIELD_IO][ii] == ')' ) { if (state == 0 )fcn_name[jj] = '\0' ; aux_fields[jj] = '\0' ; break ; }
    566. 

  566. 				   if ( tokens[FIELD_IO][ii] == ':' ) { fcn_name[jj] = '\0' ; jj= 0 ; state++ ; continue ;}
    567. 

  567. 				   if ( tokens[FIELD_IO][ii] == ',' && state == 0 ) {
    568. 

  568. 				     fprintf(stderr,
    569. 

  569.                                              "Registry warning: syntax error in %c specifier of IO field for %s\n",x,
    570. 

  570.                                              tokens[FIELD_SYM]) ;
    571. 

  571. 				   }
    572. 

  572. 				   if ( state == 0 )  /* looking for interpolation fcn name */
    573. 

  573. 				   {
    574. 

  574. 				     fcn_name[jj++] = tokens[FIELD_IO][ii] ;
    575. 

  575. 				   }
    576. 

  576. 				   if ( state > 0 )
    577. 

  577. 				   {
    578. 

  578. 				     aux_fields[jj++] = tokens[FIELD_IO][ii] ;
    579. 

  579. 				   }
    580. 

  580. 				 }
    581. 

  581. 				 i = ii ;
    582. 

  582. 			       }
    583. 

  583.                                else
    584. 

  584. 			       {
    585. 

  585. 				 if ( x == 'f' || x == 'd' ) strcpy(fcn_name,"interp_fcn") ;
    586. 

  586. 				 if ( x == 'u' ) strcpy(fcn_name,"copy_fcn") ;
    587. 

  587. 				 if ( x == 's' ) strcpy(fcn_name,"smoother") ;
    588. 

  588. 			       }
    589. 

  589. 	                       if      ( x == 'f' )  { 
    590. 

  590.                                  field_struct->nest_mask |= FORCE_DOWN ; 
    591. 

  591.                                  strcpy(field_struct->force_fcn_name, fcn_name ) ;
    592. 

  592.                                  strcpy(field_struct->force_aux_fields, aux_fields ) ;
    593. 

  593.                                }
    594. 

  594.                                else if ( x == 'd' )  { 
    595. 

  595.                                  field_struct->nest_mask |= INTERP_DOWN ; 
    596. 

  596.                                  strcpy(field_struct->interpd_fcn_name, fcn_name ) ;
    597. 

  597.                                  strcpy(field_struct->interpd_aux_fields, aux_fields ) ;
    598. 

  598.                                }
    599. 

  599.                                else if ( x == 's' )  { 
    600. 

  600.                                  field_struct->nest_mask |= SMOOTH_UP ; 
    601. 

  601.                                  strcpy(field_struct->smoothu_fcn_name, fcn_name ) ;
    602. 

  602.                                  strcpy(field_struct->smoothu_aux_fields, aux_fields ) ;
    603. 

  603.                                }
    604. 

  604.                                else if ( x == 'u' )  { 
    605. 

  605.                                  field_struct->nest_mask |= INTERP_UP ; 
    606. 

  606.                                  strcpy(field_struct->interpu_fcn_name, fcn_name ) ;
    607. 

  607.                                  strcpy(field_struct->interpu_aux_fields, aux_fields ) ;
    608. 

  608.                                }
    609. 

  609.             }
    610. 

  610. 	    prev = x ;
    611. 

  611. 	  }
    612. 

  612.         }
    613. 

  613.       }
    614. 

  614. 

  615.       field_struct->dname[0] = '\0' ;
    616. 

  616.       if ( strcmp( tokens[FIELD_DNAME], "-" ) ) /* that is, if not equal "-" */
    617. 

  617.         { strcpy( field_struct->dname , tokens[FIELD_DNAME] ) ; }
    618. 

  618.       strcpy(field_struct->descrip,"-") ;
    619. 

  619.       if ( strcmp( tokens[FIELD_DESCRIP], "-" ) ) /* that is, if not equal "-" */
    620. 

  620.         { strcpy( field_struct->descrip , tokens[FIELD_DESCRIP] ) ; }
    621. 

  621.       strcpy(field_struct->units,"-") ;
    622. 

  622.       if ( strcmp( tokens[FIELD_UNITS], "-" ) ) /* that is, if not equal "-" */
    623. 

  623.         { strcpy( field_struct->units , tokens[FIELD_UNITS] ) ; }
    624. 

  624.       strcpy(field_struct->use,"-") ;
    625. 

  625.       if ( strcmp( tokens[FIELD_USE], "-" ) ) /* that is, if not equal "-" */
    626. 

  626.         { strcpy( field_struct->use , tokens[FIELD_USE] ) ;
    627. 

  627.         }
    628. 

  628. 

  629.       /* specific settings for RCONFIG entries */
    630. 

  630.       if ( defining_rconfig_field )
    631. 

  631.       {
    632. 

  632. 	if ( strcmp( tokens[RCNF_NENTRIES] , "-" ) ) /* that is, if not equal "-" */
    633. 

  633. 	{
    634. 

  634. 	  strcpy(field_struct->nentries, tokens[RCNF_NENTRIES] ) ;
    635. 

  635. 	} else {
    636. 

  636. 	  strcpy(field_struct->nentries, "1" ) ;
    637. 

  637. 	}
    638. 

  638. 	if ( strcmp( tokens[RCNF_HOWSET] , "-" ) ) /* that is, if not equal "-" */
    639. 

  639. 	{
    640. 

  640. 	  strcpy(field_struct->howset,tokens[RCNF_HOWSET]) ;
    641. 

  641. 	} else {
    642. 

  642. 	  strcpy(field_struct->howset,"") ;
    643. 

  643. 	}
    644. 

  644. 	if ( strcmp( tokens[RCNF_DEFAULT] , "-" ) ) /* that is, if not equal "-" */
    645. 

  645. 	{
    646. 

  646. 	  strcpy(field_struct->dflt,tokens[RCNF_DEFAULT]) ;
    647. 

  647. 	} else {
    648. 

  648. 	  strcpy(field_struct->dflt,"") ;
    649. 

  649. 	}
    650. 

  650.       }
    651. 

  651. 

  652.       if ( field_struct->type != NULL )
    653. 

  653.         if ( field_struct->type->type_type == DERIVED && field_struct->ndims > 0 )
    654. 

  654.           { fprintf(stderr,"Registry warning: type item %s of type %s can not be multi-dimensional ",
    655. 

  655. 	  		   tokens[FIELD_SYM], tokens[FIELD_TYPE] ) ; }
    656. 

  656. 

  657. /**/  if ( ! field_struct->scalar_array_member )
    658. 

  658.       {
    659. 

  659.         add_node_to_end( field_struct , &(type_struct->fields) ) ;
    660. 

  660.       }
    661. 

  661. /**/  else   /* if ( field_struct->scalar_array_member ) */
    662. 

  662.       {
    663. 

  663. /* 
    664. 

  664.    Here we are constructing a list of nodes to represent the list of 4D scalar arrays in the model
    665. 

    666. 

  666.    This list is rooted at the FourD pointer.
    667. 

  667.    Each array is represented by its own node; each node has a pointer, members, to the list
    668. 

  668.    of fields that make it up.  
    669. 

    670. 

  670. */
    671. 

  671. 	node_t * q , * member  ;
    672. 

  672. 	if (( q = get_4d_entry(field_struct->use )) == NULL )  /* first instance of a 4d array member */
    673. 

  673. 	{
    674. 

  674. 	  q = new_node( FOURD ) ;
    675. 

  675. 	  *q = *field_struct ;  /* this overwrites the node */
    676. 

  676. 	  strcpy( q->name, field_struct->use ) ;
    677. 

  677. 	  strcpy( q->use, "" ) ;
    678. 

  678. 	  q->node_kind = FOURD ;
    679. 

  679. 	  q->scalar_array_member = 0 ;
    680. 

  680. 	  q->next4d = NULL ;
    681. 

  681. 	  q->next = NULL ;
    682. 

  682.                   /* add 4d q node to the list of fields of this type and also attach
    683. 

  683.                      it to the global list of 4d arrays */
    684. 

  684. 	  add_node_to_end( q , &(type_struct->fields) ) ;
    685. 

  685. 	  add_node_to_end_4d( q , &(FourD) ) ;
    686. 

  686. 	}
    687. 

  687. 	member = new_node( MEMBER ) ;
    688. 

  688.         *member = *q ;
    689. 

  689. 	member->node_kind = MEMBER ;
    690. 

  690. 	member->members = NULL ;
    691. 

  691.         member->scalar_array_member = 1 ;
    692. 

  692. 	strcpy( member->name , field_struct->name ) ;
    693. 

  693. 	strcpy( member->dname , field_struct->dname ) ;
    694. 

  694. 	strcpy( member->use , field_struct->use ) ;
    695. 

  695. 	strcpy( member->descrip , field_struct->descrip ) ;
    696. 

  696. 	strcpy( member->units , field_struct->units ) ;
    697. 

  697. 	member->next = NULL ;
    698. 

  698.         for ( i = 0 ; i < IO_MASK_SIZE ; i++ ) {
    699. 

  699. 	  member->io_mask[i] = field_struct->io_mask[i] ;
    700. 

  700.         }
    701. 

  701. 	member->nest_mask = field_struct->nest_mask ;
    702. 

  702. 	member->ndims = field_struct->ndims ;
    703. 

  703. 	member->restart = field_struct->restart ;
    704. 

  704. 	member->boundary = field_struct->boundary ;
    705. 

  705. 	strcpy( member->interpd_fcn_name, field_struct->interpd_fcn_name) ;
    706. 

  706. 	strcpy( member->interpd_aux_fields,  field_struct->interpd_aux_fields)  ;
    707. 

  707. 	strcpy( member->interpu_fcn_name, field_struct->interpu_fcn_name) ;
    708. 

  708. 	strcpy( member->interpu_aux_fields,  field_struct->interpu_aux_fields)  ;
    709. 

  709. 	strcpy( member->smoothu_fcn_name, field_struct->smoothu_fcn_name) ;
    710. 

  710. 	strcpy( member->smoothu_aux_fields,  field_struct->smoothu_aux_fields)  ;
    711. 

  711. 	strcpy( member->force_fcn_name, field_struct->force_fcn_name) ;
    712. 

  712. 	strcpy( member->force_aux_fields,  field_struct->force_aux_fields)  ;
    713. 

  713.         for ( ii = 0 ; ii < member->ndims ; ii++ )
    714. 

  714. 	  member->dims[ii] = field_struct->dims[ii] ;
    715. 

  715. 	add_node_to_end( member , &(q->members) ) ;
    716. 

  716.         free(field_struct) ;  /* We've used all the information about this entry.
    717. 

  717.                                  It is not a field but the name of one of the members of
    718. 

  718.                                  a 4d field.  we have handled that here. Discard the original node. */
    719. 

  719.       }
    720. 

  720.     }
    721. 

  721. 

  722. /* dimespec entry */
    723. 

  723.     else if ( !strcmp( tokens[ TABLE ] , "dimspec" ) )
    724. 

  724.     {
    725. 

  725.       node_t * dim_struct ;
    726. 

  726.       dim_struct = new_node( DIM ) ;
    727. 

  727.       if ( get_dim_entry ( tokens[DIM_NAME] ) != NULL )
    728. 

  728.         { fprintf(stderr,"Registry warning: dimspec (%s) already defined\n",tokens[DIM_NAME] ) ; }
    729. 

  729.       strcpy(dim_struct->dim_name,tokens[DIM_NAME]) ;
    730. 

  730.       if ( set_dim_order( tokens[DIM_ORDER], dim_struct ) )
    731. 

  731.         { fprintf(stderr,"Registry warning: problem with dimorder (%s)\n",tokens[DIM_ORDER] ) ; }
    732. 

  732.       if ( set_dim_len( tokens[DIM_SPEC], dim_struct ) )
    733. 

  733.         { fprintf(stderr,"Registry warning: problem with dimspec (%s)\n",tokens[DIM_SPEC] ) ; }
    734. 

  734.       if ( set_dim_orient( tokens[DIM_ORIENT], dim_struct ) )
    735. 

  735.         { fprintf(stderr,"Registry warning: problem with dimorient (%s)\n",tokens[DIM_ORIENT] ) ; }
    736. 

  736.       if ( strcmp( tokens[DIM_DATA_NAME], "-" ) ) /* that is, if not equal "-" */
    737. 

  737.         { strcpy( dim_struct->dim_data_name , tokens[DIM_DATA_NAME] ) ; }
    738. 

  738. 

  739.       add_node_to_end( dim_struct , &Dim ) ;
    740. 

  740.     }
    741. 

  741. 

  742. /* package */
    743. 

  743.     else if ( !strcmp( tokens[ TABLE ] , "package" ) )
    744. 

  744.     {
    745. 

  745.       node_t * package_struct ;
    746. 

  746.       package_struct = new_node( PACKAGE ) ;
    747. 

  747.       strcpy( package_struct->name          , tokens[PKG_SYM]       ) ;
    748. 

  748.       strcpy( package_struct->pkg_assoc     , tokens[PKG_ASSOC]     ) ;
    749. 

  749.       strcpy( package_struct->pkg_statevars , tokens[PKG_STATEVARS] ) ;
    750. 

  750.       strcpy( package_struct->pkg_4dscalars , tokens[PKG_4DSCALARS] ) ;
    751. 

  751. 

  752.       add_node_to_end( package_struct , &Packages ) ;
    753. 

  753.     }
    754. 

  754. 

  755. /* halo, period, xpose */
    756. 

  756.     else if ( !strcmp( tokens[ TABLE ] , "halo" ) )
    757. 

  757.     {
    758. 

  758.       node_t * comm_struct ;
    759. 

  759.       comm_struct = new_node( HALO ) ;
    760. 

  760.       strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
    761. 

  761.       strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
    762. 

  762. #if 1
    763. 

  763.       for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
    764. 

  764.         for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
    765. 

  765.       } 
    766. 

  766. #else
    767. 

  767.       strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
    768. 

  768. #endif
    769. 

  769.       add_node_to_end( comm_struct , &Halos ) ;
    770. 

  770.     }
    771. 

  771.     else if ( !strcmp( tokens[ TABLE ] , "period" ) )
    772. 

  772.     {
    773. 

  773.       node_t * comm_struct ;
    774. 

  774.       comm_struct = new_node( PERIOD ) ;
    775. 

  775.       strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
    776. 

  776.       strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
    777. 

  777. #if 1
    778. 

  778.       for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
    779. 

  779.         for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
    780. 

  780.       } 
    781. 

  781. #else
    782. 

  782.       strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
    783. 

  783. #endif
    784. 

  784.       add_node_to_end( comm_struct , &Periods ) ;
    785. 

  785.     }
    786. 

  786.     else if ( !strcmp( tokens[ TABLE ] , "xpose" ) )
    787. 

  787.     {
    788. 

  788.       node_t * comm_struct ;
    789. 

  789.       comm_struct = new_node( XPOSE ) ;
    790. 

  790.       strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
    791. 

  791.       strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
    792. 

  792. #if 1
    793. 

  793.       for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
    794. 

  794.         for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
    795. 

  795.       } 
    796. 

  796. #else
    797. 

  797.       strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
    798. 

  798. #endif
    799. 

  799.       add_node_to_end( comm_struct , &Xposes ) ;
    800. 

  800.     }
    801. 

  801.     else if ( !strcmp( tokens[ TABLE ] , "swap" ) )
    802. 

  802.     {
    803. 

  803.       node_t * comm_struct ;
    804. 

  804.       comm_struct = new_node( SWAP ) ;
    805. 

  805.       strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
    806. 

  806.       strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
    807. 

  807. #if 1
    808. 

  808.       for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
    809. 

  809.         for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
    810. 

  810.       }
    811. 

  811. #else
    812. 

  812.       strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
    813. 

  813. #endif
    814. 

  814.       add_node_to_end( comm_struct , &Swaps ) ;
    815. 

  815.     }
    816. 

  816.     else if ( !strcmp( tokens[ TABLE ] , "cycle" ) )
    817. 

  817.     {
    818. 

  818.       node_t * comm_struct ;
    819. 

  819.       comm_struct = new_node( CYCLE ) ;
    820. 

  820.       strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
    821. 

  821.       strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
    822. 

  822. #if 1
    823. 

  823.       for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
    824. 

  824.         for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
    825. 

  825.       }
    826. 

  826. #else
    827. 

  827.       strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
    828. 

  828. #endif
    829. 

  829.       add_node_to_end( comm_struct , &Cycles ) ;
    830. 

  830.     }
    831. 

  831. 

  832. 

  833. #if 0
    834. 

  834.      fprintf(stderr,"vvvvvvvvvvvvvvvvvvvvvvvvvvv\n") ;
    835. 

  835.      show_nodelist( Type ) ;
    836. 

  836.      fprintf(stderr,"^^^^^^^^^^^^^^^^^^^^^^^^^^^\n") ;
    837. 

  837. #endif
    838. 

  838.      parseline[0] = '\0' ;  /* reset parseline */
    839. 

  839.   }
    840. 

  840. 

  841.   Domain = *(get_type_entry( "domain" )) ;
    842. 

  842. 

  843. #if 0
    844. 

  844.   show_node( &Domain ) ;
    845. 

  845. #endif
    846. 

  846. 

  847.   return(0) ;
    848. 

  848. 

  849. }
    850. 

  850. 

  851. node_t *
    852. 

  852. get_dim_entry( char *s )
    853. 

  853. {
    854. 

  854.   node_t * p ;
    855. 

  855.   for ( p = Dim ; p != NULL ; p = p->next )
    856. 

  856.   {
    857. 

  857.     if ( !strcmp(p->dim_name, s ) ) {
    858. 

  858.       return( p ) ;
    859. 

  859.     }
    860. 

  860.   }
    861. 

  861.   return(NULL) ;
    862. 

  862. }
    863. 

  863. 

  864. int
    865. 

  865. set_state_type( char * typename, node_t * state_entry )
    866. 

  866. {
    867. 

  867.   if ( typename == NULL ) return(1) ;
    868. 

  868.   return (( state_entry->type = get_type_entry( typename )) == NULL )  ;
    869. 

  869. }
    870. 

  870. 

  871. int
    872. 

  872. set_dim_len ( char * dimspec , node_t * dim_entry )
    873. 

  873. {
    874. 

  874.   if      (!strcmp( dimspec , "standard_domain" ))
    875. 

  875.    { dim_entry->len_defined_how = DOMAIN_STANDARD ; }
    876. 

  876.   else if (!strncmp( dimspec, "constant=" , 9 ))
    877. 

  877.   {
    878. 

  878.     char *p, *colon, *paren ;
    879. 

  879.     p = &(dimspec[9]) ;
    880. 

  880.     /* check for colon */
    881. 

  881.     if (( colon = index(p,':')) != NULL )
    882. 

  882.     {
    883. 

  883.       *colon = '\0' ;
    884. 

  884.       if (( paren = index(p,'(')) !=NULL )
    885. 

  885.       {
    886. 

  886.         dim_entry->coord_start = atoi(paren+1) ;
    887. 

  887.       }
    888. 

  888.       else
    889. 

  889.       {
    890. 

  890.         fprintf(stderr,"WARNING: illegal syntax (missing opening paren) for constant: %s\n",p) ;
    891. 

  891.       }
    892. 

  892.       dim_entry->coord_end   = atoi(colon+1) ;
    893. 

  893.     }
    894. 

  894.     else
    895. 

  895.     {
    896. 

  896.       dim_entry->coord_start = 1 ;
    897. 

  897.       dim_entry->coord_end   = atoi(p) ;
    898. 

  898.     }
    899. 

  899.     dim_entry->len_defined_how = CONSTANT ;
    900. 

  900.   }
    901. 

  901.   else if (!strncmp( dimspec, "namelist=", 9 ))
    902. 

  902.   {
    903. 

  903.     char *p, *colon ;
    904. 

  904. 

  905.     p = &(dimspec[9]) ;
    906. 

  906.     /* check for colon */
    907. 

  907.     if (( colon = index(p,':')) != NULL )
    908. 

  908.     {
    909. 

  909.       *colon = '\0' ;
    910. 

  910.       strcpy( dim_entry->assoc_nl_var_s, p ) ;
    911. 

  911.       strcpy( dim_entry->assoc_nl_var_e, colon+1 ) ;
    912. 

  912.     }
    913. 

  913.     else
    914. 

  914.     {
    915. 

  915.       strcpy( dim_entry->assoc_nl_var_s, "1" ) ;
    916. 

  916.       strcpy( dim_entry->assoc_nl_var_e, p ) ;
    917. 

  917.     }
    918. 

  918.     dim_entry->len_defined_how = NAMELIST ;
    919. 

  919.   }
    920. 

  920.   else
    921. 

  921.   {
    922. 

  922.     return(1) ;
    923. 

  923.   }
    924. 

  924.   return(0) ;
    925. 

  925. }
    926. 

  926. 

  927. int
    928. 

  928. set_dim_orient ( char * dimorient , node_t * dim_entry )
    929. 

  929. {
    930. 

  930.   if      (!strcmp( dimorient , "x" ))
    931. 

  931.    { dim_entry->coord_axis = COORD_X ; }
    932. 

  932.   else if (!strcmp( dimorient , "y" )) 
    933. 

  933.    { dim_entry->coord_axis = COORD_Y ; }
    934. 

  934.   else if (!strcmp( dimorient , "z" )) 
    935. 

  935.    { dim_entry->coord_axis = COORD_Z ; }
    936. 

  936.   else
    937. 

  937.    { dim_entry->coord_axis = COORD_C ; }
    938. 

  938.   return(0) ;
    939. 

  939. }
    940. 

  940. 

  941. /* integrity checking of dimension list; make sure that
    942. 

  942.    namelist specified dimensions have an associated namelist variable */
    943. 

  943. int
    944. 

  944. check_dimspecs()
    945. 

  945. {
    946. 

  946.   node_t * p, *q ;
    947. 

  947.   int ord ;
    948. 

  948. 

  949.   for ( p = Dim ; p != NULL ; p = p->next )
    950. 

  950.   {
    951. 

  951.     if      ( p->len_defined_how == DOMAIN_STANDARD )
    952. 

  952.     {
    953. 

  953.       if ( p->dim_order < 1 || p->dim_order > 3 )
    954. 

  954.       {
    955. 

  955.         fprintf(stderr,"WARNING: illegal dim order %d for dimspec %s\n",p->dim_order,p->name) ;
    956. 

  956.       }
    957. 

  957.       ord = p->dim_order-1 ;
    958. 

  958.       if ( model_order[ord] != p->coord_axis )
    959. 

  959.       {
    960. 

  960.         if ( model_order[ord] == -1 ) model_order[ord] = p->coord_axis ;
    961. 

  961.         else
    962. 

  962.         {
    963. 

  963.           fprintf(stderr,"WARNING: coord-axis/dim-order for dimspec %s is inconsistent with previous dimspec.\n",p->name) ;
    964. 

  964.         }
    965. 

  965.       }
    966. 

  966.     }
    967. 

  967.     else if ( p->len_defined_how == NAMELIST )
    968. 

  968.     {
    969. 

  969.       if ( strcmp( p->assoc_nl_var_s, "1" ) )   /* if not equal to "1" */
    970. 

  970.       {
    971. 

  971.         if (( q = get_entry(p->assoc_nl_var_s,Domain.fields)) == NULL )
    972. 

  972.         {
    973. 

  973. 	  fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
    974. 

  974. 		  p->assoc_nl_var_s,p->name ) ;
    975. 

  975. 	  return(1) ;
    976. 

  976.         }
    977. 

  977.         if ( ! q->node_kind & RCONFIG )
    978. 

  978.         {
    979. 

  979. 	  fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
    980. 

  980. 		  p->assoc_nl_var_s,p->name ) ;
    981. 

  981. 	  return(1) ;
    982. 

  982.         }
    983. 

  983.         if ( strcmp( q->type->name , "integer" ) )   /* if not integer */
    984. 

  984.         {
    985. 

  985. 	  fprintf(stderr,"WARNING: namelist variable %s must be an integer if used to define dimension %s\n",
    986. 

  986. 		  p->assoc_nl_var_s,p->name ) ;
    987. 

  987. 	  return(1) ;
    988. 

  988.         }
    989. 

  989.         if ( strcmp( q->nentries , "1" ) )   /* if not 1 entry */
    990. 

  990.         {
    991. 

  991. 	  fprintf(stderr,"WARNING: namelist variable %s must have only one entry if used to define dimension %s\n",
    992. 

  992. 		  p->assoc_nl_var_s,p->name ) ;
    993. 

  993. 	  return(1) ;
    994. 

  994.         }
    995. 

  995.       }
    996. 

  996.       if (( q = get_entry(p->assoc_nl_var_e,Domain.fields)) == NULL )
    997. 

  997.       {
    998. 

  998. 	fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
    999. 

  999. 		p->assoc_nl_var_e,p->name ) ;
    1000. 

  1000. 	return(1) ;
    1001. 

  1001.       }
    1002. 

  1002.       if ( ! q->node_kind & RCONFIG )
    1003. 

  1003.       {
    1004. 

  1004. 	fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
    1005. 

  1005. 		p->assoc_nl_var_e,p->name ) ;
    1006. 

  1006. 	return(1) ;
    1007. 

  1007.       }
    1008. 

  1008.       if ( strcmp( q->type->name , "integer" ) )   /* if not integer */
    1009. 

  1009.       {
    1010. 

  1010. 	fprintf(stderr,"WARNING: namelist variable %s must be an integer if used to define dimension %s\n",
    1011. 

  1011. 		p->assoc_nl_var_e,p->name ) ;
    1012. 

  1012. 	return(1) ;
    1013. 

  1013.       }
    1014. 

  1014.       if ( strcmp( q->nentries , "1" ) )   /* if not 1 entry */
    1015. 

  1015.       {
    1016. 

  1016. 	fprintf(stderr,"WARNING: namelist variable %s must have only one entry if used to define dimension %s\n",
    1017. 

  1017. 		p->assoc_nl_var_e,p->name ) ;
    1018. 

  1018. 	return(1) ;
    1019. 

  1019.       }
    1020. 

  1020.     }
    1021. 

  1021.   }
    1022. 

  1022.   return(0) ;
    1023. 

  1023. }
    1024. 

  1024. 

  1025. int
    1026. 

  1026. set_dim_order ( char * dimorder , node_t * dim_entry )
    1027. 

  1027. {
    1028. 

  1028.   dim_entry->dim_order = atoi(dimorder) ;
    1029. 

  1029.   return(0) ;
    1030. 

  1030. }
    1031. 

  1031. 

  1032. int
    1033. 

  1033. init_parser()
    1034. 

  1034. {
    1035. 

  1035.   model_order[0] = -1 ;
    1036. 

  1036.   model_order[1] = -1 ;
    1037. 

  1037.   model_order[2] = -1 ;
    1038. 

  1038.   return(0) ;
    1039. 

  1039. }
    1040. 

  1040.