#include #include #include #include #include "registry.h" #include "protos.h" #include "data.h" #include "sym.h" /* read in the Registry file and build the internal representation of the registry */ #define MAXTOKENS 1000 /* fields for state entries (note, these get converted to field entries in the reg_parse routine; therefore, only TABLE needs to be looked at */ #define TABLE 0 /* fields for field entries (TABLE="typedef" and, with some munging, TABLE="state") */ #define FIELD_OF 1 #define FIELD_TYPE 2 #define FIELD_SYM 3 #define FIELD_DIMS 4 #define FIELD_USE 5 #define FIELD_NTL 6 #define FIELD_STAG 7 #define FIELD_IO 8 #define FIELD_DNAME 9 #define FIELD_DESCRIP 10 #define FIELD_UNITS 11 #define F_OF 0 #define F_TYPE 1 #define F_SYM 2 #define F_DIMS 3 #define F_USE 4 #define F_NTL 5 #define F_STAG 6 #define F_IO 7 #define F_DNAME 8 #define F_DESCRIP 9 #define F_UNITS 10 /* fields for rconfig entries (RCNF) */ #define RCNF_TYPE_PRE 1 #define RCNF_SYM_PRE 2 #define RCNF_HOWSET_PRE 3 #define RCNF_NENTRIES_PRE 4 #define RCNF_DEFAULT_PRE 5 #define RCNF_IO_PRE 6 #define RCNF_DNAME_PRE 7 #define RCNF_DESCRIP_PRE 8 #define RCNF_UNITS_PRE 9 #define RCNF_TYPE 2 #define RCNF_SYM 3 #define RCNF_USE FIELD_USE #define RCNF_IO FIELD_IO #define RCNF_DNAME FIELD_DNAME #define RCNF_DESCRIP FIELD_DESCRIP #define RCNF_UNITS FIELD_UNITS #define RCNF_HOWSET 20 #define RCNF_NENTRIES 21 #define RCNF_DEFAULT 22 /* fields for dimension entries (TABLE="dimspec") */ #define DIM_NAME 1 #define DIM_ORDER 2 #define DIM_SPEC 3 #define DIM_ORIENT 4 #define DIM_DATA_NAME 5 #define PKG_SYM 1 #define PKG_ASSOC 2 #define PKG_STATEVARS 3 #define PKG_4DSCALARS 4 #define COMM_ID 1 #define COMM_USE 2 #define COMM_DEFINE 3 static int ntracers = 0 ; static char tracers[1000][100] ; int pre_parse( char * dir, FILE * infile, FILE * outfile ) { char inln[4096], parseline[4096], parseline_save[4096] ; int found ; char *p, *q ; char *tokens[MAXTOKENS], *toktmp[MAXTOKENS], newdims[NAMELEN], newdims4d[NAMELEN],newname[NAMELEN] ; int i, ii, len_of_tok ; char x, xstr[NAMELEN] ; int is4d, wantstend, wantsbdy ; int ifdef_stack_ptr = 0 ; int ifdef_stack[100] ; int inquote, retval ; ifdef_stack[0] = 1 ; retval = 0 ; parseline[0] = '\0' ; /* main parse loop over registry lines */ while ( fgets ( inln , 4096 , infile ) != NULL ) { /*** preprocessing directives ****/ /* look for an include statement */ for ( p = inln ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ; if ( !strncmp( p , "include", 7 ) && ! ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) ) { FILE *include_fp ; char include_file_name[128] ; p += 7 ; for ( ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ; if ( strlen( p ) > 127 ) { fprintf(stderr,"Registry warning: invalid include file name: %s\n", p ) ; } else { sprintf( include_file_name , "%s/%s", dir , p ) ; if ( (p=index(include_file_name,'\n')) != NULL ) *p = '\0' ; fprintf(stderr,"opening %s\n",include_file_name) ; if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { fprintf(stderr,"including %s\n",include_file_name ) ; pre_parse( dir , include_fp , outfile ) ; fclose( include_fp ) ; } else { fprintf(stderr,"Registry warning: cannot open %s. Ignoring.\n", include_file_name ) ; } } } else if ( !strncmp( p , "ifdef", 5 ) ) { char value[32] ; p += 5 ; for ( ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ; strncpy(value, p, 31 ) ; value[31] = '\0' ; if ( (p=index(value,'\n')) != NULL ) *p = '\0' ; if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,' ')) != NULL ) *p = '\0' ; ifdef_stack_ptr++ ; ifdef_stack[ifdef_stack_ptr] = ( sym_get(value) != NULL && ifdef_stack[ifdef_stack_ptr-1] ) ; if ( ifdef_stack_ptr >= 100 ) { fprintf(stderr,"Registry fatal: too many nested ifdefs\n") ; exit(1) ; } continue ; } else if ( !strncmp( p , "ifndef", 6 ) ) { char value[32] ; p += 6 ; for ( ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ; strncpy(value, p, 31 ) ; value[31] = '\0' ; if ( (p=index(value,'\n')) != NULL ) *p = '\0' ; if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,' ')) != NULL ) *p = '\0' ; ifdef_stack_ptr++ ; ifdef_stack[ifdef_stack_ptr] = ( sym_get(value) == NULL && ifdef_stack[ifdef_stack_ptr-1] ) ; if ( ifdef_stack_ptr >= 100 ) { fprintf(stderr,"Registry fatal: too many nested ifdefs\n") ; exit(1) ; } continue ; } else if ( !strncmp( p , "endif", 5 ) ) { ifdef_stack_ptr-- ; if ( ifdef_stack_ptr < 0 ) { fprintf(stderr,"Registry fatal: unmatched endif\n") ; exit(1) ; } continue ; } else if ( !strncmp( p , "define", 6 ) ) { char value[32] ; p += 6 ; for ( ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ; strncpy(value, p, 31 ) ; value[31] = '\0' ; if ( (p=index(value,'\n')) != NULL ) *p = '\0' ; if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,' ')) != NULL ) *p = '\0' ; sym_add( value ) ; continue ; } if ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) continue ; /*** end of preprocessing directives ****/ strcat( parseline , inln ) ; /* allow \ to continue the end of a line */ if (( p = index( parseline, '\\' )) != NULL ) { if ( *(p+1) == '\n' || *(p+1) == '\0' ) { *p = '\0' ; continue ; /* go get another line */ } } make_lower( parseline ) ; if (( p = index( parseline , '\n' )) != NULL ) *p = '\0' ; /* discard newlines */ /* check line and zap any # characters that are in double quotes */ for ( p = parseline, inquote = 0 ; *p ; p++ ) { if ( *p == '"' && inquote ) inquote = 0 ; else if ( *p == '"' && !inquote ) inquote = 1 ; else if ( *p == '#' && inquote ) *p = ' ' ; else if ( *p == '#' && !inquote ) { *p = '\0' ; break ; } } if ( inquote ) { retval=1 ; fprintf(stderr,"Registry error: unbalanced quotes in line:\n%s\n",parseline) ;} for ( i = 0 ; i < MAXTOKENS ; i++ ) tokens[i] = NULL ; i = 0 ; strcpy( parseline_save, parseline ) ; if ((tokens[i] = my_strtok(parseline)) != NULL ) i++ ; while (( tokens[i] = my_strtok(NULL) ) != NULL && i < MAXTOKENS ) i++ ; if ( i <= 0 ) continue ; for ( i = 0 ; i < MAXTOKENS ; i++ ) { if ( tokens[i] == NULL ) tokens[i] = "-" ; } /* remove quotes from quoted entries */ for ( i = 0 ; i < MAXTOKENS ; i++ ) { char * pp ; if ( tokens[i][0] == '"' ) tokens[i]++ ; if ((pp=rindex( tokens[i], '"' )) != NULL ) *pp = '\0' ; } if ( !strcmp( tokens[ TABLE ] , "state" ) ) { strcpy( newdims, "" ) ; strcpy( newdims4d, "" ) ; is4d = 0 ; wantstend = 0 ; wantsbdy = 0 ; for ( i = 0 ; i < (len_of_tok = strlen(tokens[F_DIMS])) ; i++ ) { x = tolower(tokens[F_DIMS][i]) ; if ( x >= 'a' && x <= 'z' ) { if ( x == 'f' ) { is4d = 1 ; } if ( x == 't' ) { wantstend = 1 ; } if ( x == 'b' ) { wantsbdy = 1 ; } } sprintf(xstr,"%c",x) ; if ( x != 'b' ) strcat ( newdims , xstr ) ; if ( x != 'f' && x != 't' ) strcat( newdims4d , xstr ) ; } if ( wantsbdy ) { /* first re-gurg the original entry without the b in the dims */ fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"%s\" \"%s\"\n",tokens[F_TYPE],tokens[F_SYM], newdims, tokens[F_USE],tokens[F_NTL],tokens[F_STAG],tokens[F_IO], tokens[F_DNAME],tokens[F_DESCRIP],tokens[F_UNITS] ) ; if ( strcmp( tokens[F_SYM] , "-" ) ) { /* if not unnamed, as can happen with first 4d tracer */ /* next, output some additional entries for the boundary arrays for these guys */ if ( is4d == 1 ) { for ( i = 0, found = 0 ; i < ntracers ; i++ ) { if ( !strcmp( tokens[F_USE] , tracers[i] ) ) found = 1 ; } if ( found == 0 ) { sprintf(tracers[ntracers],tokens[F_USE]) ; ntracers++ ; /* add entries for _b and _bt arrays */ sprintf(newname,"%s_b",tokens[F_USE]) ; fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy %s\" \"%s\"\n",tokens[F_TYPE],newname,newdims4d, "_4d_bdy_array_","-",tokens[F_STAG],"b", newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ; sprintf(newname,"%s_bt",tokens[F_USE]) ; fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy tend %s\" \"(%s)/dt\"\n",tokens[F_TYPE],newname,newdims4d, "_4d_bdy_array_","-",tokens[F_STAG],"b", newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ; } } else { /* add entries for _b and _bt arrays */ sprintf(newname,"%s_b",tokens[F_SYM]) ; fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy %s\" \"%s\"\n",tokens[F_TYPE],newname,tokens[F_DIMS], tokens[F_USE],"-",tokens[F_STAG],"b", newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ; sprintf(newname,"%s_bt",tokens[F_SYM]) ; fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy tend %s\" \"(%s)/dt\"\n",tokens[F_TYPE],newname,tokens[F_DIMS], tokens[F_USE],"-",tokens[F_STAG],"b", newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ; } } parseline[0] = '\0' ; /* reset parseline */ continue ; } } normal: /* otherwise output the line as is */ fprintf(outfile,"%s\n",parseline_save) ; parseline[0] = '\0' ; /* reset parseline */ } return(retval) ; } int reg_parse( FILE * infile ) { char inln[4096], parseline[4096] ; char *p, *q ; char *tokens[MAXTOKENS], *toktmp[MAXTOKENS] ; int i, ii ; int defining_state_field, defining_rconfig_field, defining_i1_field ; parseline[0] = '\0' ; max_time_level = 1 ; /* main parse loop over registry lines */ while ( fgets ( inln , 4096 , infile ) != NULL ) { strcat( parseline , inln ) ; /* allow \ to continue the end of a line */ if (( p = index( parseline, '\\' )) != NULL ) { if ( *(p+1) == '\n' || *(p+1) == '\0' ) { *p = '\0' ; continue ; /* go get another line */ } } make_lower( parseline ) ; if (( p = index( parseline , '#' )) != NULL ) *p = '\0' ; /* discard comments (dont worry about quotes for now) */ if (( p = index( parseline , '\n' )) != NULL ) *p = '\0' ; /* discard newlines */ for ( i = 0 ; i < MAXTOKENS ; i++ ) tokens[i] = NULL ; i = 0 ; if ((tokens[i] = my_strtok(parseline)) != NULL ) i++ ; while (( tokens[i] = my_strtok(NULL) ) != NULL && i < MAXTOKENS ) i++ ; if ( i <= 0 ) continue ; for ( i = 0 ; i < MAXTOKENS ; i++ ) { if ( tokens[i] == NULL ) tokens[i] = "-" ; } /* remove quotes from quoted entries */ for ( i = 0 ; i < MAXTOKENS ; i++ ) { char * pp ; if ( tokens[i][0] == '"' ) tokens[i]++ ; if ((pp=rindex( tokens[i], '"' )) != NULL ) *pp = '\0' ; } defining_state_field = 0 ; defining_rconfig_field = 0 ; defining_i1_field = 0 ; /* state entry */ if ( !strcmp( tokens[ TABLE ] , "state" ) ) { /* turn a state entry into a typedef to define a field in the top-level built-in type domain */ tokens[TABLE] = "typedef" ; for ( i = MAXTOKENS-1 ; i >= 2 ; i-- ) tokens[i] = tokens[i-1] ; /* shift the fields to the left */ tokens[FIELD_OF] = "domain" ; if ( !strcmp( tokens[FIELD_TYPE], "double" ) ) tokens[FIELD_TYPE] = "doubleprecision" ; defining_state_field = 1 ; } if ( !strcmp( tokens[ TABLE ] , "rconfig" ) ) { /* turn a rconfig entry into a typedef to define a field in the top-level built-in type domain */ for ( i = 0 ; i < MAXTOKENS ; i++ ) { toktmp[i] = tokens[i] ; tokens[i] = "-" ; } tokens[TABLE] = "typedef" ; tokens[FIELD_OF] = "domain" ; tokens[RCNF_TYPE] = toktmp[RCNF_TYPE_PRE] ; if ( !strcmp( tokens[RCNF_TYPE], "double" ) ) tokens[RCNF_TYPE] = "doubleprecision" ; tokens[RCNF_SYM] = toktmp[RCNF_SYM_PRE] ; tokens[RCNF_IO] = toktmp[RCNF_IO_PRE] ; tokens[RCNF_DNAME] = toktmp[RCNF_DNAME_PRE] ; tokens[RCNF_USE] = "-" ; tokens[RCNF_DESCRIP] = toktmp[RCNF_DESCRIP_PRE] ; tokens[RCNF_UNITS] = toktmp[RCNF_UNITS_PRE] ; tokens[RCNF_HOWSET] = toktmp[RCNF_HOWSET_PRE] ; tokens[RCNF_NENTRIES] = toktmp[RCNF_NENTRIES_PRE] ; tokens[RCNF_DEFAULT] = toktmp[RCNF_DEFAULT_PRE] ; defining_rconfig_field = 1 ; } if ( !strcmp( tokens[ TABLE ] , "i1" ) ) { /* turn a state entry into a typedef to define a field in the top-level built-in type domain */ tokens[TABLE] = "typedef" ; /* shift the fields to the left */ for ( i = MAXTOKENS-1 ; i >= 2 ; i-- ) tokens[i] = tokens[i-1] ; tokens[FIELD_OF] = "domain" ; if ( !strcmp( tokens[FIELD_TYPE], "double" ) ) tokens[FIELD_TYPE] = "doubleprecision" ; defining_i1_field = 1 ; } /* NOTE: fall through */ /* typedef entry */ if ( !strcmp( tokens[ TABLE ] , "typedef" ) ) { node_t * field_struct ; node_t * type_struct ; if ( !defining_state_field && ! defining_i1_field && !defining_rconfig_field && !strcmp(tokens[FIELD_OF],"domain") ) { fprintf(stderr,"Registry warning: 'domain' is a reserved registry type name. Cannot 'typedef domain'\n") ; } type_struct = get_type_entry( tokens[ FIELD_OF ] ) ; if ( type_struct == NULL ) { type_struct = new_node( TYPE ) ; strcpy( type_struct->name, tokens[FIELD_OF] ) ; type_struct->type_type = DERIVED ; add_node_to_end( type_struct , &Type ) ; } if ( defining_i1_field ) { field_struct = new_node( I1 ) ; } else if ( defining_rconfig_field ) { field_struct = new_node( RCONFIG ) ; } else { field_struct = new_node( FIELD ) ; } strcpy( field_struct->name, tokens[FIELD_SYM] ) ; if ( set_state_type( tokens[FIELD_TYPE], field_struct ) ) { fprintf(stderr,"Registry warning: type %s used before defined \n",tokens[FIELD_TYPE] ) ; } if ( set_state_dims( tokens[FIELD_DIMS], field_struct ) ) { fprintf(stderr,"Registry warning: some problem with dimstring %s\n", tokens[FIELD_DIMS] ) ; } if ( strcmp( tokens[FIELD_NTL], "-" ) ) /* that is, if not equal "-" */ { field_struct->ntl = atoi(tokens[FIELD_NTL]) ; } field_struct->ntl = ( field_struct->ntl > 0 )?field_struct->ntl:1 ; /* calculate the maximum number of time levels and store in global variable */ if ( field_struct->ntl > max_time_level && field_struct->ntl <= 3 ) max_time_level = field_struct->ntl ; field_struct->stag_x = 0 ; field_struct->stag_y = 0 ; field_struct->stag_z = 0 ; for ( i = 0 ; i < strlen(tokens[FIELD_STAG]) ; i++ ) { if ( tolower(tokens[FIELD_STAG][i]) == 'x' || sw_all_x_staggered ) field_struct->stag_x = 1 ; if ( tolower(tokens[FIELD_STAG][i]) == 'y' || sw_all_y_staggered ) field_struct->stag_y = 1 ; if ( tolower(tokens[FIELD_STAG][i]) == 'z' ) field_struct->stag_z = 1 ; } field_struct->history = 0 ; field_struct->input = 0 ; field_struct->auxhist1 = 0 ; field_struct->auxinput1 = 0 ; field_struct->auxhist2 = 0 ; field_struct->auxinput2 = 0 ; field_struct->auxhist3 = 0 ; field_struct->auxinput3 = 0 ; field_struct->auxhist4 = 0 ; field_struct->auxinput4 = 0 ; field_struct->auxhist5 = 0 ; field_struct->auxinput5 = 0 ; field_struct->restart = 0 ; field_struct->boundary = 0 ; field_struct->io_mask = 0 ; { char prev = '\0' ; char x ; int len_of_tok ; char fcn_name[2048], aux_fields[2048] ; for ( i = 0 ; i < (len_of_tok = strlen(tokens[FIELD_IO])) ; i++ ) { x = tolower(tokens[FIELD_IO][i]) ; if ( x >= 'a' && x <= 'z' && ! ( x == 'g' || x == 'o' ) ) { if ( x == 'h' ) {field_struct->history = 10 ; field_struct->io_mask |= HISTORY ;} if ( x == 'i' ) {field_struct->input = 10 ; field_struct->io_mask |= INPUT ;} if ( x == 'r' ) {field_struct->restart = 10 ; field_struct->io_mask |= RESTART ;} if ( x == 'b' ) {field_struct->boundary = 10 ; field_struct->io_mask |= BOUNDARY ;} if ( x == 'f' || x == 'd' || x == 'u' || x == 's' ) { strcpy(aux_fields,"") ; strcpy(fcn_name,"") ; if ( tokens[FIELD_IO][i+1] == '(' ) /* catch a possible error */ { fprintf(stderr, "Registry warning: syntax error in %c specifier of IO field for %s\n",x,tokens[FIELD_SYM]) ; fprintf(stderr, " equal sign needed before left paren\n") ; } if ( tokens[FIELD_IO][i+1] == '=' ) { int ii, jj, state ; state = 0 ; jj = 0 ; for ( ii = i+3 ; ii < len_of_tok ; ii++ ) { if ( tokens[FIELD_IO][ii] == ')' ) { if (state == 0 )fcn_name[jj] = '\0' ; aux_fields[jj] = '\0' ; break ; } if ( tokens[FIELD_IO][ii] == ':' ) { fcn_name[jj] = '\0' ; jj= 0 ; state++ ; continue ;} if ( tokens[FIELD_IO][ii] == ',' && state == 0 ) { fprintf(stderr, "Registry warning: syntax error in %c specifier of IO field for %s\n",x, tokens[FIELD_SYM]) ; } if ( state == 0 ) /* looking for interpolation fcn name */ { fcn_name[jj++] = tokens[FIELD_IO][ii] ; } if ( state > 0 ) { aux_fields[jj++] = tokens[FIELD_IO][ii] ; } } i = ii ; } else { if ( x == 'f' || x == 'd' ) strcpy(fcn_name,"interp_fcn") ; if ( x == 'u' ) strcpy(fcn_name,"copy_fcn") ; if ( x == 's' ) strcpy(fcn_name,"smoother") ; } if ( x == 'f' ) { field_struct->io_mask |= FORCE_DOWN ; strcpy(field_struct->force_fcn_name, fcn_name ) ; strcpy(field_struct->force_aux_fields, aux_fields ) ; } else if ( x == 'd' ) { field_struct->io_mask |= INTERP_DOWN ; strcpy(field_struct->interpd_fcn_name, fcn_name ) ; strcpy(field_struct->interpd_aux_fields, aux_fields ) ; } else if ( x == 's' ) { field_struct->io_mask |= SMOOTH_UP ; strcpy(field_struct->smoothu_fcn_name, fcn_name ) ; strcpy(field_struct->smoothu_aux_fields, aux_fields ) ; } else if ( x == 'u' ) { field_struct->io_mask |= INTERP_UP ; strcpy(field_struct->interpu_fcn_name, fcn_name ) ; strcpy(field_struct->interpu_aux_fields, aux_fields ) ; } } prev = x ; } else if ( x >= '0' && x <= '9' || x == 'g' || x == 'o' ) { if ( prev == 'i' ) { field_struct->io_mask &= ! INPUT ; /* turn off setting from 'i' */ field_struct->input = field_struct->input % 10 ; /* turn off setting from 'i' */ if ( x == '0' ) field_struct->input = 1 ; if ( x == '1' ) field_struct->auxinput1 = 1 ; if ( x == '2' ) field_struct->auxinput2 = 1 ; if ( x == '3' ) field_struct->auxinput3 = 1 ; if ( x == '4' ) field_struct->auxinput4 = 1 ; if ( x == '5' ) field_struct->auxinput5 = 1 ; if ( x == '6' ) field_struct->auxinput6 = 1 ; if ( x == '7' ) field_struct->auxinput7 = 1 ; if ( x == '8' ) field_struct->auxinput8 = 1 ; if ( x == '9' ) field_struct->auxinput9 = 1 ; if ( x == 'g' ) field_struct->auxinput10 = 1 ; if ( x == 'o' ) field_struct->auxinput11 = 1 ; } if ( prev == 'h' ) { field_struct->io_mask &= ! HISTORY ; /* turn off setting from 'h' */ field_struct->history = field_struct->history % 10 ; /* turn off setting from 'h' */ if ( x == '0' ) field_struct->history = 1 ; if ( x == '1' ) field_struct->auxhist1 = 1 ; if ( x == '2' ) field_struct->auxhist2 = 1 ; if ( x == '3' ) field_struct->auxhist3 = 1 ; if ( x == '4' ) field_struct->auxhist4 = 1 ; if ( x == '5' ) field_struct->auxhist5 = 1 ; if ( x == '6' ) field_struct->auxhist6 = 1 ; if ( x == '7' ) field_struct->auxhist7 = 1 ; if ( x == '8' ) field_struct->auxhist8 = 1 ; if ( x == '9' ) field_struct->auxhist9 = 1 ; if ( x == 'g' ) field_struct->auxhist10 = 1 ; if ( x == 'o' ) field_struct->auxhist11 = 1 ; } } } if ( field_struct->history > 0 ) { field_struct->history = 1 ; field_struct->io_mask |= HISTORY ; } if ( field_struct->auxhist1 > 0 ) { field_struct->auxhist1 = 1 ; field_struct->io_mask |= AUXHIST1 ; } if ( field_struct->auxhist2 > 0 ) { field_struct->auxhist2 = 1 ; field_struct->io_mask |= AUXHIST2 ; } if ( field_struct->auxhist3 > 0 ) { field_struct->auxhist3 = 1 ; field_struct->io_mask |= AUXHIST3 ; } if ( field_struct->auxhist4 > 0 ) { field_struct->auxhist4 = 1 ; field_struct->io_mask |= AUXHIST4 ; } if ( field_struct->auxhist5 > 0 ) { field_struct->auxhist5 = 1 ; field_struct->io_mask |= AUXHIST5 ; } if ( field_struct->auxhist6 > 0 ) { field_struct->auxhist6 = 1 ; field_struct->io_mask |= AUXHIST6 ; } if ( field_struct->auxhist7 > 0 ) { field_struct->auxhist7 = 1 ; field_struct->io_mask |= AUXHIST7 ; } if ( field_struct->auxhist8 > 0 ) { field_struct->auxhist8 = 1 ; field_struct->io_mask |= AUXHIST8 ; } if ( field_struct->auxhist9 > 0 ) { field_struct->auxhist9 = 1 ; field_struct->io_mask |= AUXHIST9 ; } if ( field_struct->auxhist10 > 0 ) { field_struct->auxhist10 = 1 ; field_struct->io_mask |= AUXHIST10 ; } if ( field_struct->auxhist11 > 0 ) { field_struct->auxhist11 = 1 ; field_struct->io_mask |= AUXHIST11 ; } if ( field_struct->input > 0 ) { field_struct->input = 1 ; field_struct->io_mask |= INPUT ; } if ( field_struct->auxinput1 > 0 ) { field_struct->auxinput1 = 1 ; field_struct->io_mask |= AUXINPUT1 ; } if ( field_struct->auxinput2 > 0 ) { field_struct->auxinput2 = 1 ; field_struct->io_mask |= AUXINPUT2 ; } if ( field_struct->auxinput3 > 0 ) { field_struct->auxinput3 = 1 ; field_struct->io_mask |= AUXINPUT3 ; } if ( field_struct->auxinput4 > 0 ) { field_struct->auxinput4 = 1 ; field_struct->io_mask |= AUXINPUT4 ; } if ( field_struct->auxinput5 > 0 ) { field_struct->auxinput5 = 1 ; field_struct->io_mask |= AUXINPUT5 ; } if ( field_struct->auxinput6 > 0 ) { field_struct->auxinput6 = 1 ; field_struct->io_mask |= AUXINPUT6 ; } if ( field_struct->auxinput7 > 0 ) { field_struct->auxinput7 = 1 ; field_struct->io_mask |= AUXINPUT7 ; } if ( field_struct->auxinput8 > 0 ) { field_struct->auxinput8 = 1 ; field_struct->io_mask |= AUXINPUT8 ; } if ( field_struct->auxinput9 > 0 ) { field_struct->auxinput9 = 1 ; field_struct->io_mask |= AUXINPUT9 ; } if ( field_struct->auxinput10 > 0 ) { field_struct->auxinput10 = 1 ; field_struct->io_mask |= AUXINPUT10 ; } if ( field_struct->auxinput11 > 0 ) { field_struct->auxinput11 = 1 ; field_struct->io_mask |= AUXINPUT11 ; } if ( field_struct->restart > 0 ) { field_struct->restart = 1 ; field_struct->io_mask |= RESTART ; } if ( field_struct->boundary > 0 ) { field_struct->boundary = 1 ; field_struct->io_mask |= BOUNDARY ; } } field_struct->dname[0] = '\0' ; if ( strcmp( tokens[FIELD_DNAME], "-" ) ) /* that is, if not equal "-" */ { strcpy( field_struct->dname , tokens[FIELD_DNAME] ) ; } strcpy(field_struct->descrip,"-") ; if ( strcmp( tokens[FIELD_DESCRIP], "-" ) ) /* that is, if not equal "-" */ { strcpy( field_struct->descrip , tokens[FIELD_DESCRIP] ) ; } strcpy(field_struct->units,"-") ; if ( strcmp( tokens[FIELD_UNITS], "-" ) ) /* that is, if not equal "-" */ { strcpy( field_struct->units , tokens[FIELD_UNITS] ) ; } strcpy(field_struct->use,"-") ; if ( strcmp( tokens[FIELD_USE], "-" ) ) /* that is, if not equal "-" */ { strcpy( field_struct->use , tokens[FIELD_USE] ) ; if ( ! defining_rconfig_field && ! field_struct->scalar_array_member && !strncmp( tokens[FIELD_USE], "dyn_", 4 ) ) add_core_name( tokens[FIELD_USE]+4 ) ; } /* specific settings for RCONFIG entries */ if ( defining_rconfig_field ) { if ( strcmp( tokens[RCNF_NENTRIES] , "-" ) ) /* that is, if not equal "-" */ { strcpy(field_struct->nentries, tokens[RCNF_NENTRIES] ) ; } else { strcpy(field_struct->nentries, "1" ) ; } if ( strcmp( tokens[RCNF_HOWSET] , "-" ) ) /* that is, if not equal "-" */ { strcpy(field_struct->howset,tokens[RCNF_HOWSET]) ; } else { strcpy(field_struct->howset,"") ; } if ( strcmp( tokens[RCNF_DEFAULT] , "-" ) ) /* that is, if not equal "-" */ { strcpy(field_struct->dflt,tokens[RCNF_DEFAULT]) ; } else { strcpy(field_struct->dflt,"") ; } } if ( field_struct->type != NULL ) if ( field_struct->type->type_type == DERIVED && field_struct->ndims > 0 ) { fprintf(stderr,"Registry warning: type item %s of type %s can not be multi-dimensional ", tokens[FIELD_SYM], tokens[FIELD_TYPE] ) ; } /**/ if ( ! field_struct->scalar_array_member ) { add_node_to_end( field_struct , &(type_struct->fields) ) ; } /**/ else /* if ( field_struct->scalar_array_member ) */ { /* Here we are constructing a list of nodes to represent the list of 4D scalar arrays in the model This list is rooted at the FourD pointer. Each array is represented by its own node; each node has a pointer, members, to the list of fields that make it up. */ node_t * q , * member ; if (( q = get_4d_entry(field_struct->use )) == NULL ) /* first instance of a 4d array member */ { q = new_node( FOURD ) ; *q = *field_struct ; /* this overwrites the node */ strcpy( q->name, field_struct->use ) ; strcpy( q->use, "" ) ; q->node_kind = FOURD ; q->scalar_array_member = 0 ; q->next4d = NULL ; q->next = NULL ; /* add 4d q node to the list of fields of this type and also attach it to the global list of 4d arrays */ add_node_to_end( q , &(type_struct->fields) ) ; add_node_to_end_4d( q , &(FourD) ) ; } member = new_node( MEMBER ) ; *member = *q ; member->node_kind = MEMBER ; member->members = NULL ; member->scalar_array_member = 1 ; strcpy( member->name , field_struct->name ) ; strcpy( member->dname , field_struct->dname ) ; strcpy( member->use , field_struct->use ) ; strcpy( member->descrip , field_struct->descrip ) ; strcpy( member->units , field_struct->units ) ; member->next = NULL ; member->io_mask = field_struct->io_mask ; member->ndims = field_struct->ndims ; strcpy( member->interpd_fcn_name, field_struct->interpd_fcn_name) ; strcpy( member->interpd_aux_fields, field_struct->interpd_aux_fields) ; strcpy( member->interpu_fcn_name, field_struct->interpu_fcn_name) ; strcpy( member->interpu_aux_fields, field_struct->interpu_aux_fields) ; strcpy( member->smoothu_fcn_name, field_struct->smoothu_fcn_name) ; strcpy( member->smoothu_aux_fields, field_struct->smoothu_aux_fields) ; strcpy( member->force_fcn_name, field_struct->force_fcn_name) ; strcpy( member->force_aux_fields, field_struct->force_aux_fields) ; for ( ii = 0 ; ii < member->ndims ; ii++ ) member->dims[ii] = field_struct->dims[ii] ; add_node_to_end( member , &(q->members) ) ; free(field_struct) ; /* We've used all the information about this entry. It is not a field but the name of one of the members of a 4d field. we have handled that here. Discard the original node. */ } } /* dimespec entry */ else if ( !strcmp( tokens[ TABLE ] , "dimspec" ) ) { node_t * dim_struct ; dim_struct = new_node( DIM ) ; if ( strlen( tokens[DIM_NAME] ) > 1 ) { fprintf(stderr,"Registry warning: dimspec (%s) must be only one letter\n",tokens[DIM_NAME] ) ; } if ( get_dim_entry ( tokens[DIM_NAME][0] ) != NULL ) { fprintf(stderr,"Registry warning: dimspec (%c) already defined\n",tokens[DIM_NAME][0] ) ; } dim_struct->dim_name = tokens[DIM_NAME][0] ; if ( set_dim_order( tokens[DIM_ORDER], dim_struct ) ) { fprintf(stderr,"Registry warning: problem with dimorder (%s)\n",tokens[DIM_ORDER] ) ; } if ( set_dim_len( tokens[DIM_SPEC], dim_struct ) ) { fprintf(stderr,"Registry warning: problem with dimspec (%s)\n",tokens[DIM_SPEC] ) ; } if ( set_dim_orient( tokens[DIM_ORIENT], dim_struct ) ) { fprintf(stderr,"Registry warning: problem with dimorient (%s)\n",tokens[DIM_ORIENT] ) ; } if ( strcmp( tokens[DIM_DATA_NAME], "-" ) ) /* that is, if not equal "-" */ { strcpy( dim_struct->dim_data_name , tokens[DIM_DATA_NAME] ) ; } add_node_to_end( dim_struct , &Dim ) ; } /* package */ else if ( !strcmp( tokens[ TABLE ] , "package" ) ) { node_t * package_struct ; package_struct = new_node( PACKAGE ) ; strcpy( package_struct->name , tokens[PKG_SYM] ) ; strcpy( package_struct->pkg_assoc , tokens[PKG_ASSOC] ) ; strcpy( package_struct->pkg_statevars , tokens[PKG_STATEVARS] ) ; strcpy( package_struct->pkg_4dscalars , tokens[PKG_4DSCALARS] ) ; add_node_to_end( package_struct , &Packages ) ; } /* halo, period, xpose */ else if ( !strcmp( tokens[ TABLE ] , "halo" ) ) { node_t * comm_struct ; comm_struct = new_node( HALO ) ; strcpy( comm_struct->name , tokens[COMM_ID] ) ; strcpy( comm_struct->use , tokens[COMM_USE] ) ; #if 1 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) { for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;} } #else strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ; #endif add_node_to_end( comm_struct , &Halos ) ; } else if ( !strcmp( tokens[ TABLE ] , "period" ) ) { node_t * comm_struct ; comm_struct = new_node( PERIOD ) ; strcpy( comm_struct->name , tokens[COMM_ID] ) ; strcpy( comm_struct->use , tokens[COMM_USE] ) ; #if 1 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) { for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;} } #else strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ; #endif add_node_to_end( comm_struct , &Periods ) ; } else if ( !strcmp( tokens[ TABLE ] , "xpose" ) ) { node_t * comm_struct ; comm_struct = new_node( XPOSE ) ; strcpy( comm_struct->name , tokens[COMM_ID] ) ; strcpy( comm_struct->use , tokens[COMM_USE] ) ; #if 1 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) { for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;} } #else strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ; #endif add_node_to_end( comm_struct , &Xposes ) ; } else if ( !strcmp( tokens[ TABLE ] , "swap" ) ) { node_t * comm_struct ; comm_struct = new_node( SWAP ) ; strcpy( comm_struct->name , tokens[COMM_ID] ) ; strcpy( comm_struct->use , tokens[COMM_USE] ) ; #if 1 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) { for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;} } #else strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ; #endif add_node_to_end( comm_struct , &Swaps ) ; } else if ( !strcmp( tokens[ TABLE ] , "cycle" ) ) { node_t * comm_struct ; comm_struct = new_node( CYCLE ) ; strcpy( comm_struct->name , tokens[COMM_ID] ) ; strcpy( comm_struct->use , tokens[COMM_USE] ) ; #if 1 for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ ) { for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;} } #else strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ; #endif add_node_to_end( comm_struct , &Cycles ) ; } #if 0 fprintf(stderr,"vvvvvvvvvvvvvvvvvvvvvvvvvvv\n") ; show_nodelist( Type ) ; fprintf(stderr,"^^^^^^^^^^^^^^^^^^^^^^^^^^^\n") ; #endif parseline[0] = '\0' ; /* reset parseline */ } Domain = *(get_type_entry( "domain" )) ; #if 0 show_node( &Domain ) ; #endif return(0) ; } node_t * get_dim_entry( char c ) { node_t * p ; for ( p = Dim ; p != NULL ; p = p->next ) { if ( p->dim_name == c ) return( p ) ; } return(NULL) ; } int set_state_type( char * typename, node_t * state_entry ) { if ( typename == NULL ) return(1) ; return (( state_entry->type = get_type_entry( typename )) == NULL ) ; } int set_dim_len ( char * dimspec , node_t * dim_entry ) { if (!strcmp( dimspec , "standard_domain" )) { dim_entry->len_defined_how = DOMAIN_STANDARD ; } else if (!strncmp( dimspec, "constant=" , 9 )) { char *p, *colon, *paren ; p = &(dimspec[9]) ; /* check for colon */ if (( colon = index(p,':')) != NULL ) { *colon = '\0' ; if (( paren = index(p,'(')) !=NULL ) { dim_entry->coord_start = atoi(paren+1) ; } else { fprintf(stderr,"WARNING: illegal syntax (missing opening paren) for constant: %s\n",p) ; } dim_entry->coord_end = atoi(colon+1) ; } else { dim_entry->coord_start = 1 ; dim_entry->coord_end = atoi(p) ; } dim_entry->len_defined_how = CONSTANT ; } else if (!strncmp( dimspec, "namelist=", 9 )) { char *p, *colon ; p = &(dimspec[9]) ; /* check for colon */ if (( colon = index(p,':')) != NULL ) { *colon = '\0' ; strcpy( dim_entry->assoc_nl_var_s, p ) ; strcpy( dim_entry->assoc_nl_var_e, colon+1 ) ; } else { strcpy( dim_entry->assoc_nl_var_s, "1" ) ; strcpy( dim_entry->assoc_nl_var_e, p ) ; } dim_entry->len_defined_how = NAMELIST ; } else { return(1) ; } return(0) ; } int set_dim_orient ( char * dimorient , node_t * dim_entry ) { if (!strcmp( dimorient , "x" )) { dim_entry->coord_axis = COORD_X ; } else if (!strcmp( dimorient , "y" )) { dim_entry->coord_axis = COORD_Y ; } else if (!strcmp( dimorient , "z" )) { dim_entry->coord_axis = COORD_Z ; } else { dim_entry->coord_axis = COORD_C ; } return(0) ; } /* integrity checking of dimension list; make sure that namelist specified dimensions have an associated namelist variable */ int check_dimspecs() { node_t * p, *q ; int ord ; for ( p = Dim ; p != NULL ; p = p->next ) { if ( p->len_defined_how == DOMAIN_STANDARD ) { if ( p->dim_order < 1 || p->dim_order > 3 ) { fprintf(stderr,"WARNING: illegal dim order %d for dimspec %s\n",p->dim_order,p->name) ; } ord = p->dim_order-1 ; if ( model_order[ord] != p->coord_axis ) { if ( model_order[ord] == -1 ) model_order[ord] = p->coord_axis ; else { fprintf(stderr,"WARNING: coord-axis/dim-order for dimspec %s is inconsistent with previous dimspec.\n",p->name) ; } } } else if ( p->len_defined_how == NAMELIST ) { if ( strcmp( p->assoc_nl_var_s, "1" ) ) /* if not equal to "1" */ { if (( q = get_entry(p->assoc_nl_var_s,Domain.fields)) == NULL ) { fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n", p->assoc_nl_var_s,p->name ) ; return(1) ; } if ( ! q->node_kind & RCONFIG ) { fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n", p->assoc_nl_var_s,p->name ) ; return(1) ; } if ( strcmp( q->type->name , "integer" ) ) /* if not integer */ { fprintf(stderr,"WARNING: namelist variable %s must be an integer if used to define dimension %s\n", p->assoc_nl_var_s,p->name ) ; return(1) ; } if ( strcmp( q->nentries , "1" ) ) /* if not 1 entry */ { fprintf(stderr,"WARNING: namelist variable %s must have only one entry if used to define dimension %s\n", p->assoc_nl_var_s,p->name ) ; return(1) ; } } if (( q = get_entry(p->assoc_nl_var_e,Domain.fields)) == NULL ) { fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n", p->assoc_nl_var_e,p->name ) ; return(1) ; } if ( ! q->node_kind & RCONFIG ) { fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n", p->assoc_nl_var_e,p->name ) ; return(1) ; } if ( strcmp( q->type->name , "integer" ) ) /* if not integer */ { fprintf(stderr,"WARNING: namelist variable %s must be an integer if used to define dimension %s\n", p->assoc_nl_var_e,p->name ) ; return(1) ; } if ( strcmp( q->nentries , "1" ) ) /* if not 1 entry */ { fprintf(stderr,"WARNING: namelist variable %s must have only one entry if used to define dimension %s\n", p->assoc_nl_var_e,p->name ) ; return(1) ; } } } return(0) ; } int set_dim_order ( char * dimorder , node_t * dim_entry ) { dim_entry->dim_order = atoi(dimorder) ; return(0) ; } init_parser() { model_order[0] = -1 ; model_order[1] = -1 ; model_order[2] = -1 ; return(0) ; }