/*********************************/ /* */ /* Keyword Data Module (KDM) */ /* */ /*********************************/ /*-Title: Keyword Data Module (KDM) -end*/ /*-Intro: The Keyword Data Module (KDM) routines enable a set of keyworded parameters to be defined. Parameters may de defined for individual sets or subsets within the overall data set. In general, a KDM set of parameters may have some parameters which apply too the dataset as a whole, some which have different values for each set and some which may have different values for each subset. An example woould be the ROTGEN program to predict unique data coverage for sets of rotation data. A 'set' in this context is a series of consecutive images collected from a start to end oscillation angle. Parameters such as the crystal system and lattice type apply to the whole dataset whereas parameters defining the oscillation range, number of images etc. are set based; this program does not require subset based parameters. An example of a dataset with all three classes of parameter would be analogous to that used in the Laue Data Module where a set would refer to a pack of images and a subset parameter would refer to each individual image within the pack. Parameters may be of type integer, real or character string and normally have a single value associated with each keyword though some more complex options are also available. For a set based parameter the keyword may have a set number appended in square brackets e.g. ROTSTART[2] 50.0; if the set number is omitted, it is assumed that the value following the keyword refers to all sets e.g. NUMIMG 20. Similarly a subset based parameter may have a set and subset number appended e.g. SPOTW[2][3] 0.7; SPOTW 0.6 sets the same value for all sets and subsets; SPOTW[][3] 0.75 sets the same value for subset 3 of each set and SPOTW[2}[] 0.55 sets the value for all subsets of set 2. -end*/ /*-Section: Initialise a KDM Dataset A KDM dataset must be initialised before the keyword parameters are defined. -end*/ #include #include #include #include "kdm_systyp.h" #include "kdm.h" #define MAX_NAME_LEN 50 /* Maximum allowed length of keyword */ #define MAXVLENGTH 2000 /* Maximum allowed length for a parameter value string including leading blank */ #define MAXPOINTERS 20 /* Maximum no. of pointers for KDMSTR transfers */ #define FBLANK ' ' /* Fortran blank character */ #define MAX_INDIRECT 20 /* Maximum level of indirection */ #define MAX_LEN 250 /* Maximum length of an input line */ #define MAXC_OUT 120 /* Maximum length of an output line */ /* Define Fortran binding names */ #if LINKTYP == 1 #define kdmf_init kdmf_init_ #define kdmf_numpars kdmf_numpars_ #define kdmf_parname kdmf_parname_ #define kdmf_define_int kdmf_define_int_ #define kdmf_define_float kdmf_define_float_ #define kdmf_define_str kdmf_define_str_ #define kdmf_define_varr kdmf_define_varr_ #define kdmf_set_alias kdmf_set_alias_ #define kdmf_printname kdmf_printname_ #define kdmf_checkpar kdmf_checkpar_ #define kdmf_reset kdmf_reset_ #define kdmf_setvalue kdmf_setvalue_ #define kdmf_setndvar kdmf_setndvar_ #define kdmf_resetstd kdmf_resetstd_ #define kdmf_getvalue kdmf_getvalue_ #define kdmf_getvalstr kdmf_getvalstr_ #define kdmf_output kdmf_output_ #define kdmf_strval kdmf_strval_ #define kdmf_ch_reset kdmf_ch_reset_ #define kdmf_any_ch kdmf_any_ch_ #define kdmf_changed kdmf_changed_ #define kdmf_set_chkerr kdmf_set_chkerr_ #define kdmstr kdmstr_ #endif #if LINKTYP == 2 #define kdmf_init KDMF_INIT #define kdmf_numpars KDMF_NUMPARS #define kdmf_parname KDMF_PARNAME #define kdmf_define_int KDMF_DEFINE_INT #define kdmf_define_float KDMF_DEFINE_FLOAT #define kdmf_define_str KDMF_DEFINE_STR #define kdmf_define_varr KDMF_DEFINE_VARR #define kdmf_set_alias KDMF_SET_ALIAS #define kdmf_printname KDMF_PRINTNAME #define kdmf_checkpar KDMF_CHECKPAR #define kdmf_reset KDMF_RESET #define kdmf_setvalue KDMF_SETVALUE #define kdmf_setndvar KDMF_SETNDVAR #define kdmf_resetstd KDMF_RESETSTD #define kdmf_getvalue KDMF_GETVALUE #define kdmf_getvalstr KDMF_GETVALSTR #define kdmf_output KDMF_OUTPUT #define kdmf_strval KDMF_STRVAL #define kdmf_ch_reset KDMF_CH_RESET #define kdmf_any_ch KDMF_ANY_CH #define kdmf_changed KDMF_CHANGED #define kdmf_set_chkerr KDMF_SET_CHKERR #define kdmstr KDMSTR #endif void kdmf_init(); void kdmf_numpars(); void kdmf_parname(); void kdmf_define_int(); void kdmf_define_float(); void kdmf_define_str(); void kdmf_define_varr(); void kdmf_set_alias(); void kdmf_printname(); void kdmf_checkpar(); void kdmf_reset(); void kdmf_setvalue(); void kdmf_setndvar(); void kdmf_resetstd(); void kdmf_getvalue(); void kdmf_getvalstr(); void kdmf_output(); void kdmf_strval(); void kdmf_ch_reset(); void kdmf_any_ch(); void kdmf_changed(); void kdmf_set_chkerr(); int kdmstr(); #include "kdm_systyp.h" typedef struct _KDM_parlist { char name[MAX_NAME_LEN+1]; /* Keyword name (full) stored in upper case */ int klen; /* Length of keyword name */ int minlen; /* Minimum length which must be matched */ char alias[MAX_NAME_LEN+1]; /* Keyword alias name (full) stored in upper case */ int alen; /* Length of alias name (0 if none) */ int aminlen; /* Minimum length of alias name which must be matched */ int use_alias; /* Use alias name when printing parameter =1, use normal name = 0 */ int type; /* Parameter type flag = 1 integer = 2 set dependent integer parameter = 3 subset dependent integer parameter = 4 float = 5 set dependent float parameter = 6 subset dependent float parameter = 7 string = 8 set dependent string parameter = 9 subset dependent string parameter = 10 variable length integer/real arrays = 11 set dependent variable length integer/real arrays = 12 subset dependent variable length integer/real arrays */ int pr_std; /* Include parameter in standard output (ireduce==2 in kdm_output) even if it has the default value. =1 yes, =0 no */ int pr_std_dflt; /* Saves default value of pr_std */ void *data; /* Pointer to parameter data storage area: KDM_int_par structure for ityp 1-3 KDM_float_par structure for ityp 4-6 KDM_str_par structure for ityp 7-9 */ }KDM_parlist; typedef struct _KDM_keyword_set { int num_pars; /* No. of parameters in keyword set */ int max_sets; /* Maximum no. of sets */ int max_subsets; /* Maximum no. of subsets */ KDM_parlist * parlist; /* Parameter structures array */ char * name_nums; /* Name of 'current no. of sets' parameter */ char * name_numss; /* Name of 'current no. of subsets/set' parameter */ char * snam; /* String for 'set' in messages */ char * ssnam; /* String for 'subset' in messages */ }KDM_keyword_set; typedef struct _KDM_int_par { int * idata; /* Pointer to 1, max_sets or max_sets*max_subsets times num_vals integer values depending on parameter type */ int num_vals; /* No. of values associated with keyword */ int *i_default; /* Default values (num_vals values) */ int * ch_flags; /* Parameter value changed flags ## */ int * st_flags; /* Parameter status flags ## */ int chk_typ; /* Check value option =0 any integer OK, =1 any >=0 =2 any >0 =3 any <=0 =4 any <0 =5 must be in range i_min to i_max =6 check using supplied function called with chk_func(ival) where 'ival' is value to be checked. Must return 0 if OK, 1 if error. =7 0<= ival<= max_sets =8 0<= ival<= max_sub sets */ int i_min; /* Minimum allowed value (if chk_typ==5) */ int i_max; /* Maximum allowed value (if chk_typ==5) */ int (*chk_func)(); /* Function to check value (if chk_typ==6) */ }KDM_int_par; typedef struct _KDM_float_par { float * fdata; /* Pointer to 1, max_sets or max_sets*max_subsets times num_vals float values depending on parameter type */ int num_vals; /* No. of values associated with keyword */ float *f_default; /* Default values (num_vals values) */ int * ch_flags; /* Parameter value changed flags ## */ int * st_flags; /* Parameter status flags ## */ int * nd_flags; /* No. of decimal places flags (no. of values as for fdata) */ int default_nd; /* No. decimal places for default value print */ int nd; /* No. decimal places for recalculated value print*/ int chk_typ; /* Check value option =0 any integer OK, =1 any >=0.0 =2 any >0.0 =3 any <=0.0 =4 any <0.0 =5 must be in range f_min to f_max =6 check using supplied function called with chk_func(fval) where 'fval' is value to be checked. Must return 0 if OK, 1 if error. */ float f_min; /* Minimum allowed value (if chk_typ==5) */ float f_max; /* Maximum allowed value (if chk_typ==5) */ int (*chk_func)(); /* Function to check value (if chk_typ==6) */ }KDM_float_par; typedef struct _KDM_str_par { char ** sdata; /* Pointer to 1, max_sets or max_sets*max_subsets string values depending on parameter type */ int maxlen; /* Maximum length allowed for value string */ int * ch_flags; /* Parameter value changed flags ## */ int * st_flags; /* Parameter status flags ## */ char * s_default; /* Default value string */ char ** allowed_strings; /* Valid strings for values */ int num_allowed; /* No. of allowed string values */ int match; /* Minimum no. of characters to be matched if chk_typ==1; if -match given then only match characters will be checked and remainder will be ignored; if match==0 all characters will be checked */ int mult; /* =0 single token string; =1 multiple token string */ int chk_typ; /* Check value option =0 any string OK =1 check using allowed strings =2 check using supplied function called with chk_func(). Must return 0 if OK, 1 if error. (String to be checked is stored internally & accessed via the kdm_strval (kdmf_strval) routine) */ int (*chk_func)(); /* Function to check value (if chk_typ==6) */ }KDM_str_par; typedef struct _KDM_varr_par { int * idata; /* Pointer to 1, max_sets or max_sets*max_subsets times num_vals int values depending on parameter type - ignore elements for which irtyp[i]!=1 */ float * fdata; /* Pointer to 1, max_sets or max_sets*max_subsets times num_vals float values depending on parameter type - ignore elements for which irtyp[i]!=2 */ int *irtyp; /* Type flags for array item 1=int, 2=float (num_vals values) */ int num_vals; /* No. of values associated with keyword (maximum)*/ int num_vals_min; /* Minimum no. of values which must be given */ int *i_default; /* Default values (num_vals values) ignore elements for which irtyp[i]!=1 */ float *f_default; /* Default values (num_vals values) ignore elements for which irtyp[i]!=2 */ int * ch_flags; /* Parameter value changed flags ## */ int * st_flags; /* Parameter status flags ## */ int * nd_flags; /* No. of decimal places flags */ int * num_inp; /* No. of values input ## */ int *default_nd; /* No. decimal places for default value print (num_vals values (ignored for integer entries)) */ int *nd; /* No. decimal places for recalculated value print (num_vals values (ignored for integer entries)) */ int npr_dflt; /* No. of values to print when outputting default value */ int chk_typ; /* Check value option =0 any values OK, =1 check using supplied function called with chk_func(ivals,fvals,irtyp, ,ninp) where 'ivals' and 'fvals' are the arrays of integer & real values to be checked, 'irtyp' in the array indicating the type of each relevant element (1=int, 2=real) and 'ninp' is the number of values input. Must return 0 if OK, 1 if error. */ int (*chk_func)(); /* Function to check value (if chk_typ==1) */ }KDM_varr_par; /* ## 1, max_sets or max_sets*max_subsets values depending on whether parameter is dataset, set or subset based. nd_flags for real values, indicate no. of decimal places if a value was input by string >= 0; this will be used when the parameter value is output to a parameters file. In general, a negative value indicates scientific notation with -ND decimal places. A special value of -1000 indicates that the default output format for that parameter is to be used when the parameter value is written out to a parameters file. st_flags parameter status flags =0 default =1 changed explicitly =2 changed globally ch_flags are flags indicating parameter value changes for a series of change reference points (up to 16). */ static num_kdm_sets=0; KDM_keyword_set *keyword_sets=0; static int init=0; static int ch_mask = 0xffff; static char * KDM_strval_str = 0; static int KDM_strval_len = 0; FILE *fp_indirect[MAX_INDIRECT]; /* Pointers list for KDMSTR */ char * KDM_pointers[MAXPOINTERS]; /* List of string pointers */ int KDM_pointers_index=MAXPOINTERS; /* Last index to pointers currently used (list used in a circular manner */ /* For output routine */ char output_str[2051]; FILE *fpout; static char KDM_chk_errstr[101]; /*-Routine: Initialise a KDM keyword set - kdm_init The initialisation routine kdm_init (kdmf_init) initialises a new keyword data module set of keyword parameters. An index is returned to be used with all calls for that parameter set. -end*/ /* *************************** ** kdm_init ** *************************** Purpose: Initialise 'kdm' routines Author: John W. Campbell, June 1995 CD-Fortran: CALL KDMF_INIT (MAXSETS, MAXSUBSETS, KDM(NUMS_NAM), LENS, + KDMSTR(NUMSS_NAM), LENSS, + KDMSTR(SNAM), LENSNAM, + KDMSTR(SSNAM), LENSSNAM, KDX, IERR) CD-end: */ /*-Parameters: MAXSETS i (R) Maximum no. of sets for set specific parameters MAXSUBSETS i (R) Maximum no. of subsets for subset specific parameters NUMS_NAM c (R) Name of the keyword defining the current number of sets being used; if used, this must be defined as an nteger parameter (type=dataset) using the KDMF_DEFINE_INT routine. ** Pass address index using the KDMSTR function ** LENS i (R) Length of NUMS_NAM string NUMSS_NAM c (R) Name of the keyword defining the current number of subsets being used for each set; if used, this must be defined as an integer parameter (type=set dependent) using the KDMF_DEFINE_INT routine. ** Pass address index using the KDMSTR function ** LENSS i (R) Length of NUMSS_NAM string SNAM c (R) String for 'set' in message e.g. 'set or 'pack' ** Pass address index using the KDMSTR function ** LENSNAM i (R) Length of SNAM string SSNAM c (R) String for 'subset' in message e.ge. 'subset', or 'plate' ** Pass address index using the KDMSTR function ** LENSSNAM i (R) Length of SSNAM string KDX i (W) Index to be used in subsequent calls to kdm routines for this keyword set IERR i (W) Error return code from kdm_init call Note: The current number of sets and numbers of subsets/set parameters may be used internally by the kdm_output (kdmf_output) routine. If this option is to be used, both parameters must be set up as described. If they are not required, the the current number of sets and numbers of subsets/set must be explicitly passed to the kdm_output (kdmf_output) routine; blank names may be passed in this latter case. Also, if internal names are being used, then a blank set name implies 1 set and a blank subset name implies one subset/set; no parameters are set up via define routines for such blank names; an error will be returned for any other set or subset names if the corresponding parameters are not defined. -end*/ /*-C:*/ int kdm_init (int maxnum_sets, int maxnum_subsets, char * nums_nam, int lens, char * numss_nam, int lenss, char * snam, int lensnam, char * ssnam, int lenssnam, int * kdx) /*end*/ /*-Parameters: int maxnum_sets; Maximum no. of sets for set specific parameters (R) int maxnum_subsets; Maximum no. of subsets for subset specific parameters (R) char * nums_nam; Name of the keyword defining the current number of sets being used; this must be defined as an integer parameter (type=dataset) using the kdm_define_int routine. (R) int lens; Length of nums_nam string; may be 0 if nums_nam is null terminated (R) char * numss_nam; Name of the keyword defining the current number of subsets being used for each set; this must be defined as an integer parameter (type=set dependent) using the kdm_define_int routine. (R) int lenss; Length of numss_nam string; may be 0 if numss_nam is null terminated (R) char * snam String for 'set' in message e.g. 'set or 'pack' (R) int lensnam; Length of snam string; may be 0 if snam is null terminated (R) char * ssnam String for 'subset' in message e.g. 'subset' or 'plate' (R) int lenssnam; Length of ssnam string; may be 0 if ssnam is null terminated (R) int *kdx; Index to be used in subsequent calls to kdm routines for this keyword set (W) Note: The current number of sets and numbers of subsets/set parameters may be used internally by the kdm_output (kdmf_output) routine. If this option is to be used, both parameters must be set up as described. If they are not required, the the current number of sets and numbers of subsets/set must be explicitly passed to the kdm_output (kdmf_output) routine; blank names may be passed in this latter case. Return: Error flag =0 no error; =1 invalid parameter maxnum_sets<1 or maxnum_subsets<1 or (maxnum_subsets>0 and maxnum_sets<=0) =-1 unable to allocate memory for new keyword set -end*/ { KDM_keyword_set * p; int l; char * str1; char * str2; char * str3; char * str4; *kdx = -1; if (maxnum_sets<1) return 1; if (maxnum_subsets<1) return 1; if (maxnum_subsets>0&&maxnum_sets<=0) return 1; l = lens; if (l<=0) l = strlen (nums_nam); str1 = (char *) malloc (l+1); if (str1==0) return -1; str1[0] = 0; strncat (str1, nums_nam, l); l = lenss; if (l<=0) l = strlen (numss_nam); str2 = (char *) malloc (l+1); if (str2==0) return -1; str2[0] = 0; strncat (str2, numss_nam, l); l = lensnam; if (l<=0) l = strlen (snam); str3 = (char *) malloc (l+1); if (str3==0) return -1; str3[0] = 0; strncat (str3, snam, l); l = lenssnam; if (l<=0) l = strlen (ssnam); str4 = (char *) malloc (l+1); if (str4==0) return -1; str4[0] = 0; strncat (str4, ssnam, l); if (num_kdm_sets==0) { keyword_sets = (KDM_keyword_set *) malloc (sizeof(KDM_keyword_set)); if (keyword_sets==0) return -1; *kdx = num_kdm_sets; keyword_sets[num_kdm_sets].num_pars=0; keyword_sets[num_kdm_sets].max_sets=maxnum_sets; keyword_sets[num_kdm_sets].max_subsets=maxnum_subsets; keyword_sets[num_kdm_sets].parlist=0; keyword_sets[num_kdm_sets].name_nums = str1; keyword_sets[num_kdm_sets].name_numss = str2; keyword_sets[num_kdm_sets].snam = str3; keyword_sets[num_kdm_sets].ssnam = str4; num_kdm_sets++; } else { p = (KDM_keyword_set*) realloc (keyword_sets, (num_kdm_sets+1)*sizeof(KDM_keyword_set)); if (p==0) return -1; keyword_sets = p; *kdx = num_kdm_sets; keyword_sets[num_kdm_sets].num_pars=0; keyword_sets[num_kdm_sets].max_sets=maxnum_sets; keyword_sets[num_kdm_sets].max_subsets=maxnum_subsets; keyword_sets[num_kdm_sets].parlist=0; keyword_sets[num_kdm_sets].name_nums = str1; keyword_sets[num_kdm_sets].name_numss = str2; keyword_sets[num_kdm_sets].snam = str3; keyword_sets[num_kdm_sets].ssnam = str4; num_kdm_sets++; } init = 1; return 0; } /* Fortran binding: kdmf_init */ void kdmf_init (maxsets, maxsubsets, nums_nam, lens, numss_nam, lenss, snam, lensnam, ssnam, lenssnam, kdx, ierr) int * maxsets, *maxsubsets, *nums_nam, *lens, *numss_nam, *lenss; int *snam, *lensnam, *ssnam, *lenssnam, *kdx, *ierr; { *ierr = kdm_init (*maxsets, *maxsubsets, KDM_pointers[*nums_nam], *lens, KDM_pointers[*numss_nam], *lenss, KDM_pointers[*snam], *lensnam, KDM_pointers[*ssnam], *lenssnam, kdx); } /*-Section: Get Details from a KDM Set Routines are available to return the number of parameters defined for a KDM data set and the keyword names of the parameters. -end*/ /*-Routine: Get number of parameters - kdm_numpars The routine kdm_numpars (kdmf_numpars) returns the number of parameters currently defined for a KDM keyword data set. -end*/ /* *************************** ** kdm_numpars ** *************************** Purpose: Get no. of parameters in a KDM datset Author: John W. Campbell, July 1995 CD-Fortran: CALL KDMF_NUMPARS (KDX, NUMP, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT NUMP i (W) No. of parameters in the KDM data set IERR i (W) Error return code from kdm_numpars call -end*/ /*-C:*/ int kdm_numpars (int kdx, int * nump) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) int * nump; Returns the no. of parameters in the KDM data set (W) Return: Error flag =0 no error; =1 KDM dataset not set up -end*/ { KDM_keyword_set * keyset; *nump = 0; /* Check parameters */ if (init<0) return 1; if (init==0) return 1; if (kdx<0||kdx>=num_kdm_sets) return 1; /* Get no. of parameters */ keyset = &keyword_sets[kdx]; *nump = keyset->num_pars; return 0; } /* Fortran binding: kdmf_numpars */ void kdmf_numpars (kdx, nump, ierr) int *kdx, *nump, *ierr; { *ierr = kdm_numpars (*kdx, nump); } /*-Routine: Get parameter name - kdm_parname The routine kdm_parname (kdmf_parname) returns the name of a KDM keyword parameter for a requested parameter number. -end*/ /* *************************** ** kdm_parname ** *************************** Purpose: Get a parameter name from a KDM datset Author: John W. Campbell, July 1995 CD-Fortran: CALL KDMF_PARNAME (KDX, IPAR, KDMSTR(NAME), MAXN, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT IPAR i (R) The parameter number from 1 to the NUMP value returned by KDMF_NUMPARS NAME c (W) Returns the full keyword parameter name in upper case ** Pass address index using the KDMSTR function ** MAXN i (R) Maximum length allowed for returned name IERR i (W) Error return code from kdm_parname call -end*/ /*-C:*/ int kdm_parname (int kdx, int ipar, char * name, int maxn) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * name; Returns full parameter name in upper case (W) int maxn; if >0 Maximum length of returned name string allowed (excluding terminating null - name must be at least maxn + 1 characters in length) if <0 abs(maxn) characters will be returned padded with blanks if needed (for 'fortran' use) (R) Return: Error flag =0 no error; =1 KDM dataset not set up =2 Invalid parameter number -end*/ { KDM_keyword_set * keyset; KDM_parlist * parlist; int nump; /* Check parameters */ if (init<0) return 1; if (init==0) return 1; if (kdx<0||kdx>=num_kdm_sets) return 1; /* Get no. of parameters */ keyset = &keyword_sets[kdx]; parlist = keyset->parlist; nump = keyset->num_pars; if (ipar<1||ipar>nump) return 2; kdm_copy_chars (parlist[ipar-1].name, parlist[ipar-1].klen, name, maxn); return 0; } /* Fortran binding: kdmf_parname */ void kdmf_parname (kdx, ipar, name, maxn, ierr) int *kdx, *ipar, *name, *maxn, *ierr; { int maxlen; maxlen = -(*maxn); if (maxlen>0) maxlen = -maxlen; *ierr = kdm_parname (*kdx, *ipar, KDM_pointers[*name], maxlen); } /*-Routine: Check a parsed parameter keyword string - kdm_checkpar The routine kdm_checkpar (kdmf_checkpar) is used to check for the presence of a parameter within a KDM data set. The keyword name and any set/subset specifications must be previously parsed from the keyword string. The input parameter name need only have the minimum number of characters defined for the parameter in question via the appropriate kdm_define_... (kdmf_define_...) call. The full parameter name is returned together with a flag indicating the parameter type. -end*/ /* *************************** ** kdm_checkpar ** *************************** Purpose: Find and check a (parsed) KDM parameter specification Author: John W. Campbell, June 1995 CD-Fortran: CALL KDMF_CHECKPAR (KDX, KDMSTR(KEYWORD), LENK, ISET, ISUBSET, + ISS, NAME, MAXN, ITYP, NVALS, IPAR, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT KEYWORD c (R) Parameter name character string (at least minimum required characters in length) ** Pass address index using the KDMSTR function ** LENK i (R) Length of keyword ISET i (R) Set number from parsed keyword string ISUBSET i (R) Subset number from parsed keyword string ISS i (R) Flag =0 keyword had no set/subset specification attached =1 keyword had set specification attached =2 keyword had subset specification attached NAME c (W) Returns the full keyword parameter name in upper case ** Pass address index using the KDMSTR function ** MAXN i (R) Maximum length allowed for returned name ITYP i (W) Returns parameter type flag = 1 integer = 2 set dependent integer parameter = 3 subset dependent integer parameter = 4 float = 5 set dependent float parameter = 6 subset dependent float parameter = 7 string (single token) = 8 set dependent string parameter (single token) = 9 subset dependent string parameter (single token) = 10 string (multiple token) = 11 set dependent string parameter (multiple token) = 12 subset dependent string parameter (multiple token) = 13 variable array parameter = 14 set dependent variable array parameter = 15 subset dependent variable array parameter NVALS i (W) No. of values associated with the keyword for integer or float type parameters or maximum for a variable length array of (mixed) int/real values. IPAR i (W) The number of the parameter in the keyword parameters list (from 1 upwards); 0 if not found IERR i (W) Error return from kdm_checkpar routine Note: Can pass ISET=0, ISUBSET=0 & ISS=0 to check keyword and return the KDM parameter type -end*/ /*-C:*/ int kdm_checkpar (int kdx, char * keyword, int lenk, int iset, int isubset, int iss, char * name, int maxn, int * ityp, int *nvals, int * ipar) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * keyword; Parameter keyword string at least minimum no. of characters required (R) int lenk; Length of keyword string (may be 0 if string is null terminated (R) int iset; Set number from parsed keyword string (R) int isubset; Subset number from parsed keyword string (R) int iss; Flag =0 keyword had no set/subset specification attached =1 keyword had set specification attached =2 keyword had subset specification attached (R) char * name; Returns full parameter name in upper case (W) int maxn; if >0 Maximum length of returned name string allowed (excluding terminating null - name must be at least maxn + 1 characters in length) if <0 abs(maxn) characters will be returned padded with blanks if needed (for 'fortran' use) (R) int * ityp; Returns parameter type flag = 1 integer = 2 set dependent integer parameter = 3 subset dependent integer parameter = 4 float = 5 set dependent float parameter = 6 subset dependent float parameter = 7 string (single token) = 8 set dependent string parameter (single token) = 9 subset dependent string parameter (single token) = 10 string (multiple token) = 11 set dependent string parameter (multiple token) = 12 subset dependent string parameter (multiple token) = 13 variable array parameter = 14 set dependent variable array parameter = 15 subset dependent variable array parameter (W) int * nvals; No. of values associated with the keyword for integer or float type parameters or maximum for a variable length array of (mixed) int/real values. (W) int * ipar; Returns the number of the parameter in the parameter list (from 1 upwards); 0 if not found (W) Note: Can pass iset=0, isubset=0 & iss=0 to check keyword and return the KDM parameter type Return: Error flag = 0 OK KDM parameter = 1 Not a KDM parameter of this keyword dataset =-1 Set specified when none allowed or out of valid range =-2 Subset specified when none allowed or out of valid range -end*/ { KDM_keyword_set * keyset; KDM_parlist * parlist; KDM_int_par * idp; KDM_float_par * fdp; KDM_str_par * sdp; KDM_varr_par * vdp; int lk; int iclass; int found; int i; *ipar = 0; if (init<0) return 1; if (init==0) return 1; if (kdx<0||kdx>=num_kdm_sets) return 1; keyset = &keyword_sets[kdx]; parlist = keyset->parlist; if (iset<0||iset>keyset->max_sets) return -1; if (isubset<0||isubset>keyset->max_subsets) return -2; lk = lenk; if (lk<=0) lk = strlen(keyword); /* Now search for keyword */ found = -1; for (i=0;inum_pars;++i) { if (lk>=parlist[i].minlen) { if (lk<=parlist[i].klen) { if (kdm_ncasecmp(parlist[i].name, keyword, lk)==0) {found=i; break;} } } if (parlist[i].alen>0) { if (lk>=parlist[i].aminlen) { if (lk<=parlist[i].alen) { if (kdm_ncasecmp(parlist[i].alias, keyword, lk)==0) {found=i; break;} } } } } if (found<0) return 1; *ipar = found + 1; iclass = (parlist[found].type-1)%3 + 1; switch (iclass) { case 1: if (iss>0) return -1; break; case 2: if (iss>1) return -2; break; } *nvals = 1; *ityp = parlist[found].type; if (*ityp>0&&*ityp<4) { idp = (KDM_int_par *) parlist[found].data; *nvals = idp->num_vals; } if (*ityp>3&&*ityp<7) { fdp = (KDM_float_par *) parlist[found].data; *nvals = fdp->num_vals; } if (*ityp>6&&*ityp<10) { sdp = (KDM_str_par *) parlist[found].data; if (sdp->mult) *ityp += 3; } if (*ityp>9) { vdp = (KDM_varr_par *) parlist[found].data; *nvals = vdp->num_vals; *ityp += 3; } kdm_copy_chars (parlist[found].name, parlist[found].klen, name, maxn); return 0; } /* Fortran binding: kdmf_checkpar */ void kdmf_checkpar (kdx, keyword, lenk, iset, isubset, iss, name, maxn, ityp, nvals, ipar, ierr) int *kdx, *keyword, *lenk, *iset, *isubset, *iss, *name, *maxn, *ityp; int *nvals, *ipar, *ierr; { int maxlen; maxlen = -(*maxn); if (maxlen>0) maxlen = -maxlen; *ierr = kdm_checkpar (*kdx, KDM_pointers[*keyword], *lenk, *iset, *isubset, *iss, KDM_pointers[*name], maxlen, ityp, nvals, ipar); } /*-Section: Define KDM Parameters Routines are available to define the keywords for various types of parameter including integer, real and character string. -end*/ /*-Routine: Define an integer parameter keyword - kdm_define_int The routine kdm_define_int (kdmf_define_int) is used to define a new integer value parameter keyword. The type of parameter value checking is defined which may be a standard type or done via a user supplied routine. -end*/ /* *************************** ** kdm_define_int ** *************************** Purpose: Define an integer 'kdm' parameter Author: John W. Campbell, June 1995 CD-Fortran: CALL KDMF_DEFINE_INT (KDX, KDMSTR(NAME), LENN, MINL, ITYP, ISTD, + NVALS I_DEFLT, I_MIN, I_MAX, + ICHK, CHKFUN, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT NAME c (R) Parameter name (full) character string ** Pass address index using the KDMSTR function ** LENN i (R) Length of name MINL i (R) Minimum length for keyword match ITYP i (R) Parameter type 1=dataset, 2=set, 3=subset specific ISTD i (R) Standard parameter for output (see KDMF_OUTPUT) = 1 yes, =0 no NVALS i (R) No. of values associated with the keyword - normally 1 I_DEFLT() i (R) Default parameter values (NVALS values) I_MIN i (R) Minimum allowed value (if ICHK==5) I_MAX i (R) Maximum allowed value (if ICHK==5) ICHK i (R) Check value option =0 any integer OK, =1 any >=0 =2 any >0 =3 any <=0 =4 any <0 =5 must be in range i_min to i_max =6 check using supplied function CHKFUN =7 0<= ival<= max_sets =8 0<= ival<= max_sub sets CHKFUN s (R) Check value function (used if ICHK==6) Call will be I = CHKFUN (IVAL) IVAL (R) Value to be checked RETURN 0 OK, 1 error Use KDMF_SET_CHKERR within CHKFUN to set error string IERR i (W) Error return status flag from the kdm_define_int call -end*/ /*-C:*/ int kdm_define_int (int kdx, char * name, int lenn, int minl, int ityp, int std, int nvals, int * i_default, int i_min, int i_max, int chk_typ, int (*chk_func)()) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * name; Parameter name (full) (R) int lenn; Length of name string (may be 0 if null term) (R) int minl; Minimum length for keyword matching (R) int ityp; Parameter type 1=dataset, 2=set, 3=subset specific (R) int std Standard parameter for output (see kdm_output) = 1 yes, =0 no (R) int nvals; No. of values associated with the keyword - normally 1 (R) int *i_default; Default parameter values (nvals values) (R) int i_min; Minimum allowed value (if chk_typ==5) (R) int i_max; Maximum allowed value (if chk_typ==5) (R) int chk_typ; Check value option =0 any integer OK, =1 any >=0 =2 any >0 =3 any <=0 =4 any <0 =5 must be in range i_min to i_max =6 check using supplied function called with chk_func. Must return 0 if OK, 1 if error. =7 0<= ival<= max_sets =8 0<= ival<= max_sub sets (R) int (*chk_func)(); Check value function (used if chk_typ==6) call will be i = chk_func (ival); return 0 ok, 1 error int *ival (r) value to be checked Use kdm_set_chkerr within chk_func to set error string (R) Return: Error flag = 0 no error; =-1 memory allocation error =-2 a previous memory allocation error had occurred = 1 parameter name too long = 2 other invalid parameter passed to the routine = 3 'kdm' routines not initialised -end*/ { KDM_int_par * data; KDM_parlist * parlist; KDM_keyword_set * keyset; int n; int * idata; int * df_data; int * ch_flags; int * st_flags; int i; int j; int kk; int ln; /* Check parameters */ if (init<0) return -2; if (init==0) return 3; if (kdx<0||kdx>=num_kdm_sets) return 3; ln = lenn; if (ln<=0) ln = strlen(name); if (ln>MAX_NAME_LEN) return 1; if (ityp<1||ityp>3) return 2; if (chk_typ<0||chk_typ>8) return 2; if (nvals<=0) return 2; if (std!=1) std = 0; keyset = &keyword_sets[kdx]; if (ityp==2&&keyset->max_sets==0) return 2; if (ityp==3&&(keyset->max_sets==0||keyset->max_subsets==0)) return 2; /* Allocate structure for new keyword */ if (keyset->num_pars==0) { parlist = (KDM_parlist *) malloc (sizeof(KDM_parlist)); if (parlist==0) goto mem_err; keyset->num_pars ++; keyset->parlist = parlist; } else { parlist = (KDM_parlist *) realloc (keyset->parlist, (keyset->num_pars+1)*sizeof(KDM_parlist)); if (parlist==0) goto mem_err; keyset->parlist = parlist; keyset->num_pars ++; } keyset->parlist[keyset->num_pars-1].name[0] = 0; strncat (keyset->parlist[keyset->num_pars-1].name, name, ln); keyset->parlist[keyset->num_pars-1].alias[0] = 0; kdm_upc (keyset->parlist[keyset->num_pars-1].name); keyset->parlist[keyset->num_pars-1].klen = ln; keyset->parlist[keyset->num_pars-1].minlen = minl; keyset->parlist[keyset->num_pars-1].alen = 0; keyset->parlist[keyset->num_pars-1].aminlen = 0; keyset->parlist[keyset->num_pars-1].use_alias = 0; /* Allocate storage for the new parameter's data */ data = (KDM_int_par *) malloc (sizeof(KDM_int_par)); if (data==0) goto mem_err; n = 1; if (ityp==2) n = keyset->max_sets; if (ityp==3) n = keyset->max_sets*keyset->max_subsets; idata = (int *) malloc (n*nvals*sizeof(int)); if (idata==0) goto mem_err; df_data = (int *) malloc (nvals*sizeof(int)); if (df_data==0) goto mem_err; ch_flags = (int *) malloc (n*sizeof(int)); if (ch_flags==0) goto mem_err; for (i=0;ii_default = df_data; for (i=0;ii_default[i] = i_default[i]; data->idata = idata; for (i=0;iidata[kk+j] = i_default[j]; } data->num_vals = nvals; data->chk_typ = chk_typ; data->i_min = i_min; data->i_max = i_max; data->chk_func = chk_func; data->ch_flags = ch_flags; data->st_flags = st_flags; keyset->parlist[keyset->num_pars-1].type = ityp; keyset->parlist[keyset->num_pars-1].data = (void *) data; keyset->parlist[keyset->num_pars-1].pr_std = std; keyset->parlist[keyset->num_pars-1].pr_std_dflt = std; return 0; /* Memory allocation error */ mem_err: init = -1; return -1; } /* Fortran binding: kdmf_define_int */ void kdmf_define_int (kdx, name, lenn, minl, ityp, istd, nvals, i_deflt, i_min, i_max, ichk, chkfun, ierr) int *kdx, *name, *lenn, *minl, *ityp, *istd, *nvals, *i_deflt; int *i_min, *i_max, *ichk, *ierr; int (*chkfun)(); { *ierr = kdm_define_int (*kdx, KDM_pointers[*name], *lenn, *minl, *ityp, *istd, *nvals, i_deflt, *i_min, *i_max, *ichk, chkfun); } /*-Routine: Define a float parameter keyword - kdm_define_float The routine kdm_define_float (kdmf_define_float) is used to define a new floating point value parameter keyword. The type of parameter value checking is defined which may be a standard type or done via a user supplied routine. -end*/ /* *************************** ** kdm_define_float ** *************************** Purpose: Define a float 'kdm' parameter Author: John W. Campbell, June 1995 CD-Fortran: CALL KDMF_DEFINE_FLOAT (KDX, KDMSTR(NAME), LENN, + MINL, ITYP, ISTD, NVALS, F_DEFLT, F_MIN, + F_MAX, ICHK, CHKFUN, ND, ND_DEFAULT, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT NAME c (R) Parameter name (full) character string ** Pass address index using the KDMSTR function ** LENN i (R) Length of name MINL i (R) Minimum length for keyword match ITYP i (R) Parameter type 1=dataset, 2=set, 3=subset specific ISTD i (R) Standard parameter for output (see KDMF_OUTPUT) = 1 yes, =0 no NVALS i (R) No. of values associated with the keyword - normally 1 F_DEFLT() r (R) Default parameter values (NVALS values) F_MIN r (R) Minimum allowed value (if ICHK==5) F_MAX r (R) Maximum allowed value (if ICHK==5) ICHK i (R) Check value option =0 any float OK, =1 any >=0.0 =2 any >0.0 =3 any <=0.0 =4 any <0.0 =5 must be in range f_min to f_max =6 check using supplied function CHKFUN CHKFUN s (R) Check value function (used if ICHK==6) Call will be I = CHKFUN (FVAL) FVAL (R) Value to be checked RETURN 0 OK, 1 error Use KDMF_SET_CHKERR within CHKFUN to set error string ND i (R) No. of decimal places for printing value when it was recalculated by a program ND_DEFLT i (R) No. of decimal places for printing the default value IERR i (W) Error return status flag from the kdm_define_int call -end*/ /*-C:*/ int kdm_define_float (int kdx, char * name, int lenn, int minl, int ityp, int std, int nvals, float *f_default, float f_min, float f_max, int chk_typ, int (*chk_func)(), int nd, int default_nd) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * name; Parameter name (full) (R) int lenn; Length of name string (may be 0 if null term) (R) int minl; Minimum length for keyword matching (R) int ityp; Parameter type 1=dataset, 2=set, 3=subset specific (R) int std Standard parameter for output (see kdm_output) = 1 yes, =0 no (R) int nvals; No. of values associated with the keyword - normally 1 (R) float *f_default; Default parameter values (num_vals values) (R) int f_min; Minimum allowed value (if chk_typ==5) (R) int f_max; Maximum allowed value (if chk_typ==5) (R) int chk_typ; Check value option =0 any float OK, =1 any >=0.0 =2 any >0.0 =3 any <=0.0 =4 any <0.0 =5 must be in range f_min to f_max =6 check using supplied function chk_func. int (*chk_func)(); Check value function (used if chk_typ==6) call will be i = chk_func (fval); return 0 ok, 1 error float *fval (r) value to be checked Use kdm_set_chkerr within chk_func to set error string (R) int nd; No. of decimal places for printing value when it was recalculated by a program (R) int default_nd; No. of decimal places for printing the default value (R) Return: Error flag = 0 no error; =-1 memory allocation error =-2 a previous memory allocation error had occurred = 1 parameter name or too long = 2 other invalid parameter passed to the routine = 3 'kdm' routines not initialised -end*/ { KDM_float_par * data; KDM_parlist * parlist; KDM_keyword_set * keyset; int n; float * fdata; float * df_data; int * ch_flags; int * st_flags; int * nd_flags; int i; int j; int kk; int ln; /* Check parameters */ if (init<0) return -2; if (init==0) return 3; if (kdx<0||kdx>=num_kdm_sets) return 3; ln = lenn; if (ln<=0) ln = strlen(name); if (ln>MAX_NAME_LEN) return 1; if (ityp<1||ityp>3) return 2; if (chk_typ<0||chk_typ>6) return 2; if (nvals<=0) return 2; if (std!=1) std = 0; keyset = &keyword_sets[kdx]; if (ityp==2&&keyset->max_sets==0) return 2; if (ityp==3&&(keyset->max_sets==0||keyset->max_subsets==0)) return 2; /* Allocate structure for new keyword */ if (keyset->num_pars==0) { parlist = (KDM_parlist *) malloc (sizeof(KDM_parlist)); if (parlist==0) goto mem_err; keyset->parlist = parlist; keyset->num_pars ++; } else { parlist = (KDM_parlist *) realloc (keyset->parlist, (keyset->num_pars+1)*sizeof(KDM_parlist)); if (parlist==0) goto mem_err; keyset->parlist = parlist; keyset->num_pars ++; } keyset->parlist[keyset->num_pars-1].name[0] = 0; strncat (keyset->parlist[keyset->num_pars-1].name, name, ln); keyset->parlist[keyset->num_pars-1].alias[0] = 0; kdm_upc (keyset->parlist[keyset->num_pars-1].name); keyset->parlist[keyset->num_pars-1].klen = ln; keyset->parlist[keyset->num_pars-1].minlen = minl; keyset->parlist[keyset->num_pars-1].alen = 0; keyset->parlist[keyset->num_pars-1].aminlen = 0; keyset->parlist[keyset->num_pars-1].use_alias = 0; /* Allocate storage for the new parameter's data */ data = (KDM_float_par *) malloc (sizeof(KDM_float_par)); if (data==0) goto mem_err; n = 1; if (ityp==2) n = keyset->max_sets; if (ityp==3) n = keyset->max_sets*keyset->max_subsets; fdata = (float *) malloc (n*nvals*sizeof(float)); if (fdata==0) goto mem_err; df_data = (float *) malloc (nvals*sizeof(float)); if (df_data==0) goto mem_err; ch_flags = (int *) malloc (n*sizeof(int)); if (ch_flags==0) goto mem_err; for (i=0;if_default = df_data; for (i=0;if_default[i] = f_default[i]; data->fdata = fdata; for (i=0;ifdata[kk+j] = f_default[j]; } data->num_vals = nvals; data->chk_typ = chk_typ; data->f_min = f_min; data->f_max = f_max; data->chk_func = chk_func; data->ch_flags = ch_flags; data->nd_flags = nd_flags; data->st_flags = st_flags; data->nd = nd; data->default_nd = default_nd; keyset->parlist[keyset->num_pars-1].type = ityp+3; keyset->parlist[keyset->num_pars-1].data = (void *) data; keyset->parlist[keyset->num_pars-1].pr_std = std; keyset->parlist[keyset->num_pars-1].pr_std_dflt = std; return 0; /* Memory allocation error */ mem_err: init = -1; return -1; } /* Fortran binding: kdmf_define_float */ void kdmf_define_float (kdx, name, lenn, minl, ityp, istd, nvals, f_deflt, f_min, f_max, ichk, chkfun, nd, nd_deflt, ierr) int *kdx, *name, *lenn, *minl, *ityp, *istd, *nvals, *ichk, *ierr; float *f_deflt, *f_min, *f_max; int *nd, *nd_deflt; int (*chkfun)(); { *ierr = kdm_define_float (*kdx, KDM_pointers[*name], *lenn, *minl, *ityp, *istd, *nvals, f_deflt, *f_min, *f_max, *ichk, chkfun, *nd, *nd_deflt); } /*-Routine: Define a string parameter keyword - kdm_define_str The routine kdm_define_str (kdmf_define_str) is used to define a new string value parameter keyword. The type of parameter value checking is defined which may be to check a standard list of parameter value strings or to use a user supplied checking routine. -end*/ /* *************************** ** kdm_define_str ** *************************** Purpose: Define a string 'kdm' parameter Author: John W. Campbell, June 1995 CD-Fortran: CALL KDMF_DEFINE_STR (KDX, KDMSTR(NAME), LENN, + MINL, ITYP, ISTD, MAXLEN, + KDMSTR(S_DEFLT), LEND, + KDMSTR(STRINGS), NUMS, LENS, ICHK, MATCH, + CHKFUN, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT NAME c (R) Parameter name (full) character string ** Pass address index using the KDMSTR function ** LENN i (R) Length of name MINL i (R) Minimum length for keyword match ITYP i (R) Parameter type 1=dataset, 2=set, 3=subset specific for single token; 4=dataset, 5=set, 6=subset specific multiple token string ISTD i (R) Standard parameter for output (see KDMF_OUTPUT) = 1 yes, =0 no MAXLEN i (R) Maximum string length for parameter value S_DEFLT c (R) Default character string ** Pass address index using the KDMSTR function ** LEND i (R) Length of default string STRINGS() c (R) Array of character strings containing allowed values CHARACTER*LENS STRINGS(NUMS) ** Pass address index using the KDMSTR function ** NUMS i (R) No. of strings in STRINGS LENS i (R) Length of each character string element in the STRINGS array ICHK i (R) Check value option =0 any string OK =1 check using allowed strings =2 check using supplied function CHKFUN MATCH i (R) Minimum no. of characters to be matched if ICHK==1; if -MATCH given then only MATCH characters will be checked and remainder will be ignored; if MATCH==0 all characters will be checked CHKFUN s (R) Check value function (used if ICHK==2) Call will be I = CHKFUN (IDUM) IDUM (R) Dummy parameter RETURN 0 OK, 1 error Use KDMF_SET_CHKERR within CHKFUN to set error string To get the value of the string to be checked within the CHKFUN routine, use the function KDM_STRVAL CALL KDMF_STRVAL (KDMSTR(VALSTR), MAXL) VALSTR (W) Returns the value string ** Pass address index using the KDMSTR function ** MAXL (R) Maximum length allowed for the string (must be at least MAXLEN characters long) IERR i (W) Error return status flag from the kdm_define_int call -end*/ /*-C:*/ int kdm_define_str (int kdx, char * name, int lenn, int minl, int ityp, int std, int maxlen, char * s_default, int lend, char ** strings, int nums, int lens, int chk_typ, int match, int (*chk_func)()) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * name; Parameter name (full) (R) int lenn; Length of name string (may be 0 if null term) (R) int minl; Minimum length for keyword matching (R) int ityp; Parameter type 1=dataset, 2=set, 3=subset specific for single token; 4=dataset, 5=set, 6=subset specific multiple token string (R) int std Standard parameter for output (see kdm_output) = 1 yes, =0 no (R) int maxlen; Maximum string length for parameter value (R) char * s_default; Default value string (R) int lend; Length of default string (may be 0 if null term) char ** strings; Value strings - this may either be an array of pointers to 'nums' null terminated character strings (lens==0) or a character string nums*lens in length with each value string occupying lens characters (left justified and padded to the right with blanks if needed. (R) (used if chk_typ==0) (R) int nums; The number of values in strings (R) int lens; Values strings length (0 = array of pointers to null terminated character strings (e.g. for 'C' programs) or the length of each value string (e.g. for Fortran programs). See also the previous item. (R) int chk_typ; Check value option =0 any string OK =1 check using allowed strings =2 check using supplied function chk_func (R) int match; Minimum no. of characters to be matched if chk_typ==1; if -match given then only match characters will be checked and remainder will be ignored; if match==0 all characters will be checked (R) int (*chk_func)(); Function to check value (if chk_typ==1) call will be i = chk_func (dum); int *idum (r) dummy value return 0 ok, 1 error Use kdm_set_chkerr within chk_func to set error string within chk_func, get the value of the parameter string to be checked using the function (void) kdm_strval (valstr, maxl) char * valstr (w) string into which value is to be returned (it will be null terminated) must be at least maxl+1 characters in length int maxl (r) maximum length for returned string (must be at least maxlen) (R) Return: Error flag = 0 no error; =-1 memory allocation error =-2 a previous memory allocation error had occurred = 1 parameter name too long = 2 other invalid parameter passed to the routine = 3 'kdm' routines not initialised -end*/ { KDM_str_par * data; KDM_parlist * parlist; KDM_keyword_set * keyset; int n; int l; char ** strs; char * str; char * fstr; char * stp; char * tmp; char ** sdata; int * ch_flags; int * st_flags; int i; int ln; int ld; int jtyp; /* Check parameters */ jtyp = ityp; if (ityp>3) jtyp = ityp-3; if (init<0) return -2; if (init==0) return 3; if (kdx<0||kdx>=num_kdm_sets) return 3; ln = lenn; if (ln<=0) ln = strlen(name); if (ln>MAX_NAME_LEN) return 1; if (ityp<1||ityp>6) return 2; if (chk_typ<0||chk_typ>2) return 2; if (std!=1) std = 0; keyset = &keyword_sets[kdx]; if (jtyp==2&&keyset->max_sets==0) return 2; if (jtyp==3&&(keyset->max_sets==0||keyset->max_subsets==0)) return 2; /* Allocate structure for new keyword */ if (keyset->num_pars==0) { parlist = (KDM_parlist *) malloc (sizeof(KDM_parlist)); if (parlist==0) goto mem_err; keyset->num_pars ++; keyset->parlist = parlist; } else { parlist = (KDM_parlist *) realloc (keyset->parlist, (keyset->num_pars+1)*sizeof(KDM_parlist)); if (parlist==0) goto mem_err; keyset->parlist = parlist; keyset->num_pars ++; } keyset->parlist[keyset->num_pars-1].name[0] = 0; strncat (keyset->parlist[keyset->num_pars-1].name, name, ln); keyset->parlist[keyset->num_pars-1].alias[0] = 0; kdm_upc (keyset->parlist[keyset->num_pars-1].name); keyset->parlist[keyset->num_pars-1].klen = ln; keyset->parlist[keyset->num_pars-1].minlen = minl; keyset->parlist[keyset->num_pars-1].alen = 0; keyset->parlist[keyset->num_pars-1].aminlen = 0; keyset->parlist[keyset->num_pars-1].use_alias = 0; /* Allocate storage for the new parameter's data */ strs = 0; fstr = (char *) strings; if (nums>0) { strs = (char **) malloc ((nums+1)*sizeof(char *)); if (strs==0) goto mem_err; strs[nums]=0; for (i=0;i0;--l) if(stp[l-1]!=' ') break; str = (char *) malloc ((l+1)*sizeof(char)); if (str==0) goto mem_err; strs[i] = str; str[0] = 0; strncat (strs[i], stp, l); } } } data = (KDM_str_par *) malloc (sizeof(KDM_str_par)); if (data==0) goto mem_err; n = 1; if (jtyp==2) n = keyset->max_sets; if (jtyp==3) n = keyset->max_sets*keyset->max_subsets; sdata = (char **) malloc ((n+1)*sizeof(char *)); if (sdata==0) goto mem_err; sdata[n] = 0; ld = lend; if (ld<=0) ld = strlen(s_default); for (i=0;is_default = tmp; data->allowed_strings = strs; data->num_allowed = nums; data->match = match; data->mult = 0; if (ityp>3) data->mult = 1; data->chk_typ = chk_typ; data->chk_func = chk_func; data->sdata = sdata; data->maxlen = maxlen; data->ch_flags = ch_flags; data->st_flags = st_flags; keyset->parlist[keyset->num_pars-1].type = jtyp+6; keyset->parlist[keyset->num_pars-1].data = (void *) data; keyset->parlist[keyset->num_pars-1].pr_std = std; keyset->parlist[keyset->num_pars-1].pr_std_dflt = std; return 0; /* Memory allocation error */ mem_err: init = -1; return -1; } /* Fortran binding: kdmf_define_str */ void kdmf_define_str (kdx, name, lenn, minl, ityp, istd, maxlen, s_deflt, lend, strings, nums, lens, ichk, match, chkfun, ierr) int *kdx, *name, *lenn, *minl, *ityp, *istd, *maxlen, *ichk, *ierr; int *s_deflt, *lend, *strings, *nums, *lens, *match; int (*chkfun)(); { *ierr = kdm_define_str (*kdx, KDM_pointers[*name], *lenn, *minl, *ityp, *istd, *maxlen, KDM_pointers[*s_deflt], *lend, (char **) KDM_pointers[*strings], *nums, *lens, *ichk, *match, chkfun); } /*-Routine: Define a variable array keyword - kdm_define_varr The routine kdm_define_varr (kdmf_define_varr) is used to define a new parameter keyword which has a variable length array of integer/real values following it (up to some maximum specified number of words). There is either no value checking done or it is done via a user supplied routine. -end*/ /* *************************** ** kdm_define_varr ** *************************** Purpose: Define variable length array of integer/real values 'kdm' parameter Author: John W. Campbell, June 1995 CD-Fortran: CALL KDMF_DEFINE_VARR (KDX, KDMSTR(NAME), LENN, + MINL, ITYP, ISTD, NVALS, NVALS_MIN, + I_DEFLT, F_DEFLT, IRTYP, ICHK, CHKFUN, + ND, ND_DEFAULT, NPR_DFLT, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT NAME c (R) Parameter name (full) character string ** Pass address index using the KDMSTR function ** LENN i (R) Length of name MINL i (R) Minimum length for keyword match ITYP i (R) Parameter type 1=dataset, 2=set, 3=subset specific ISTD i (R) Standard parameter for output (see KDMF_OUTPUT) = 1 yes, =0 no NVALS i (R) Max no. of values associated with the keyword NVALS_MIN i (R) Minimum no. of values which must be given (>=1) I_DEFLT() i (R) Default integer parameter values (NVALS values) (Values for which IRTYP(i).NE.1 ignored) F_DEFLT() r (R) Default real parameter values (NVALS values) (Values for which IRTYP(i).NE.2 ignored) Note: I_DEFLT and F_DEFLT can be equivalenced IRTYP() i (R) Integer/real flags for NVALS elements flag =1 for integer, =2 for real (any value!=1) ICHK i (R) Check value option =0 any integer OK, =1 check using supplied function CHKFUN CHKFUN s (R) Check value function (used if ICHK==6) Call will be I = CHKFUN (IVALS, FVALS, IRTYP, NINP) IVALS (R) Array of integer values to be checked (ignore elements unless IRTYP(i).EQ.1) FVALS (R) Array of real Values to be checked (ignore elements unless IRTYP(i).EQ.2) IRTYP (R) Array of element type flags. flag =1 for integer, =2 for real NINP (R) No. of input values to check. RETURN 0 OK, 1 error Use KDMF_SET_CHKERR within CHKFUN to set error string ND() i (R) No. of decimal places for printing values when a real was recalculated by a program (NVALS values) - ignored for integer values. ND_DEFLT() i (R) No. of decimal places for printing a default real value (NVALS values) - ignored for integer values NPR_DFLT i (R) No. of values to print when outputting default value (>=1) IERR i (W) Error return status flag from the kdm_define_varr call -end*/ /*-C:*/ int kdm_define_varr (int kdx, char * name, int lenn, int minl, int ityp, int std, int nvals, int nvals_min, int *i_default, float *f_default, int *irtyp, int chk_typ, int (*chk_func)(), int *nd, int *default_nd, int npr_dflt) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * name; Parameter name (full) (R) int lenn; Length of name string (may be 0 if null term) (R) int minl; Minimum length for keyword matching (R) int ityp; Parameter type 1=dataset, 2=set, 3=subset specific (R) int std Standard parameter for output (see kdm_output) = 1 yes, =0 no (R) int nvals; No. of values associated with the keyword (maximum) (R) int nvals_min; Minimum no. of values which must be give (>=1) (R) float *i_default; Default parameter values (num_vals values) (Values for which irtyp(i)!=1 ignored) (R) float *f_default; Default parameter values (num_vals values) (Values for which irtyp(i)!=2 ignored) (R) int *irtyp; Parameter element type flags (num_vals values) flags = 1 for int, =2 for float (any value!=1) (R) int chk_typ; Check value option =0 any float OK, =1 check using supplied function chk_func . int (*chk_func)(); Check value function (used if chk_typ==1) call will be i = chk_func (ivals, fvals, irtyp, ninp); return 0 ok, 1 error int *ivals (r) Array of int values to be checked (ignore elements unless irtyp[i]==1) float *fvals (r) Array of float values to be checked (ignore elements unless irtyp[i]==2) int *irtyp (r) Array of element type flags =1 int, =2 float int *ninp (r) No. of input values to be checked. Use kdm_set_chkerr within chk_func to set error string (R) int *nd; No. of decimal places for printing values when it was recalculated by a program (nvals values) - ignored for integer values (R) int *default_nd; No. of decimal places for printing the default value (nvals values) - ignored for integer values (R) int npr_dflt; No. of values to print when outputting default value (>=1) (R) Return: Error flag = 0 no error; =-1 memory allocation error =-2 a previous memory allocation error had occurred = 1 parameter name or too long = 2 other invalid parameter passed to the routine = 3 'kdm' routines not initialised -end*/ { KDM_varr_par * data; KDM_parlist * parlist; KDM_keyword_set * keyset; int n; int * idata; float * fdata; int * irt; int * df_idata; float * df_fdata; int * ch_flags; int * st_flags; int * nd_flags; int * nd_arr; int * default_nd_arr; int * num_inp; int i; int j; int kk; int ln; /* Check parameters */ if (init<0) return -2; if (init==0) return 3; if (kdx<0||kdx>=num_kdm_sets) return 3; ln = lenn; if (ln<=0) ln = strlen(name); if (ln>MAX_NAME_LEN) return 1; if (ityp<1||ityp>3) return 2; if (chk_typ<0||chk_typ>6) return 2; if (nvals<=0) return 2; if (nvals_min<1) return 2; if (npr_dflt<1) return 2; if (std!=1) std = 0; keyset = &keyword_sets[kdx]; if (ityp==2&&keyset->max_sets==0) return 2; if (ityp==3&&(keyset->max_sets==0||keyset->max_subsets==0)) return 2; /* Allocate structure for new keyword */ if (keyset->num_pars==0) { parlist = (KDM_parlist *) malloc (sizeof(KDM_parlist)); if (parlist==0) goto mem_err; keyset->parlist = parlist; keyset->num_pars ++; } else { parlist = (KDM_parlist *) realloc (keyset->parlist, (keyset->num_pars+1)*sizeof(KDM_parlist)); if (parlist==0) goto mem_err; keyset->parlist = parlist; keyset->num_pars ++; } keyset->parlist[keyset->num_pars-1].name[0] = 0; strncat (keyset->parlist[keyset->num_pars-1].name, name, ln); keyset->parlist[keyset->num_pars-1].alias[0] = 0; kdm_upc (keyset->parlist[keyset->num_pars-1].name); keyset->parlist[keyset->num_pars-1].klen = ln; keyset->parlist[keyset->num_pars-1].minlen = minl; keyset->parlist[keyset->num_pars-1].alen = 0; keyset->parlist[keyset->num_pars-1].aminlen = 0; keyset->parlist[keyset->num_pars-1].use_alias = 0; /* Allocate storage for the new parameter's data */ data = (KDM_varr_par *) malloc (sizeof(KDM_varr_par)); if (data==0) goto mem_err; n = 1; if (ityp==2) n = keyset->max_sets; if (ityp==3) n = keyset->max_sets*keyset->max_subsets; idata = (int *) malloc (n*nvals*sizeof(int)); if (idata==0) goto mem_err; fdata = (float *) malloc (n*nvals*sizeof(float)); if (fdata==0) goto mem_err; irt = (int *) malloc (nvals*sizeof(int)); if (irt==0) goto mem_err; df_idata = (int *) malloc (nvals*sizeof(int)); if (df_idata==0) goto mem_err; df_fdata = (float *) malloc (nvals*sizeof(float)); if (df_fdata==0) goto mem_err; nd_arr = (int *) malloc (nvals*sizeof(int)); if (nd_arr==0) goto mem_err; default_nd_arr = (int *) malloc (nvals*sizeof(int)); if (default_nd_arr==0) goto mem_err; ch_flags = (int *) malloc (n*sizeof(int)); if (ch_flags==0) goto mem_err; for (i=0;inum_inp = num_inp; for (i=0;inum_inp[i] = npr_dflt; nd_flags = (int *) malloc (n*nvals*sizeof(int)); if (nd_flags==0) goto mem_err; data->i_default = df_idata; for (i=0;ii_default[i] = i_default[i]; data->f_default = df_fdata; for (i=0;if_default[i] = f_default[i]; data->irtyp = irt; for (i=0;iirtyp[i] = irtyp[i]; if (data->irtyp[i]!=1) data->irtyp[i] = 2; } data->nd = nd_arr; for (i=0;ind[i] = nd[i]; data->default_nd = default_nd_arr; for (i=0;idefault_nd[i] = default_nd[i]; data->idata = idata; data->fdata = fdata; data->nd_flags = nd_flags; for (i=0;iidata[kk+j] = i_default[j]; for (j=0;jfdata[kk+j] = f_default[j]; for (j=0;jnd_flags[kk+j] = default_nd[j]; } data->num_vals = nvals; data->num_vals_min = nvals_min; data->npr_dflt = npr_dflt; data->chk_typ = chk_typ; data->chk_func = chk_func; data->ch_flags = ch_flags; data->nd_flags = nd_flags; data->st_flags = st_flags; keyset->parlist[keyset->num_pars-1].type = ityp+9; keyset->parlist[keyset->num_pars-1].data = (void *) data; keyset->parlist[keyset->num_pars-1].pr_std = std; keyset->parlist[keyset->num_pars-1].pr_std_dflt = std; return 0; /* Memory allocation error */ mem_err: init = -1; return -1; } /* Fortran binding: kdmf_define_varr */ void kdmf_define_varr (kdx, name, lenn, minl, ityp, istd, nvals, nvals_min, i_deflt, f_deflt, irtyp, ichk, chkfun, nd, nd_deflt, npr_dflt, ierr) int *kdx, *name, *lenn, *minl, *ityp, *istd, *nvals, *nvals_min; int *i_deflt, *irtyp, *ichk, *npr_dflt, *ierr; float *f_deflt; int *nd, *nd_deflt; int (*chkfun)(); { *ierr = kdm_define_varr (*kdx, KDM_pointers[*name], *lenn, *minl, *ityp, *istd, *nvals, *nvals_min, i_deflt, f_deflt, irtyp, *ichk, chkfun, nd, nd_deflt, *npr_dflt); } /*-Section: KDM Name Aliases Routines are available to set an alias or alternative name for a parameter and to select which name to use when the keyword is printed. -end*/ /*-Routine: Define an alias name - kdm_set_alias The routine kdm_set_alias (kdmf_set_alias) allows an alternative or alias name to be set for a 'kdm' parameter. Either this name or the alias may be used in the input keyworded data. The choice for output is set using the routine kdm_printname (kdmf_printname). -end*/ /* *************************** ** kdm_set_alias ** *************************** Purpose: Set an alternative or alias name for a 'kdm' parameter Author: John W. Campbell, April 1997 CD-Fortran: CALL KDMF_SET_ALIAS (KDX, KDMSTR(KEYWORD), LENK, KDMSTR(ALIAS), + LENA, MINLEN, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT KEYWORD c (R) Parameter name (full) character string ** Pass address index using the KDMSTR function ** LENK i (R) Length of keyword ALIAS c (R) Alias name character string ** Pass address index using the KDMSTR function ** LENA i (R) Length of the alias name (>0) MINLEN i (R) Minimum length of alias name for a valid match IERR i (W) Error flag as returned from kdm_set_alias -end*/ /*-C:*/ int kdm_set_alias (int kdx, char * keyword, int lenk, char * alias, int lena, int minlen) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * keyword; Parameter keyword string (full) (R) int lenk; Length of keyword string (may be 0 if string is null terminated (R) char * alias; The alias name (R) int lena; Length of alias name string (may be 0 if string is null terminated (R) int minlen; Minimum length of alias name for a valid match Return: Error flag = 0 no error = 1 invalid keyword specification =-100 index does not point to valid KDM dataset -end*/ { int i; int ll; int la; int found; KDM_keyword_set * keyset; KDM_parlist * parlist; if (init<=0) return -100; if (kdx<0||kdx>=num_kdm_sets) return -100; keyset = &keyword_sets[kdx]; parlist = keyset->parlist; if (keyset->num_pars<1) return -100; /* Search for keyword */ ll = lenk; if (ll<=0) ll = strlen(keyword); found = -1; for (i=0;inum_pars;++i) { if (ll==parlist[i].klen) { if (kdm_ncasecmp(parlist[i].name, keyword, ll)==0) {found=i; break;} } } if (found<0) return 1; /* Keyword found */ la = lena; if (la<=0) la = strlen(alias); parlist[found].alen = la; parlist[found].aminlen = minlen; parlist[found].alias[0] = 0; strncat (parlist[found].alias, alias, la); return 0; } /* Fortran binding: kdmf_set_alias */ void kdmf_set_alias (kdx, keyword, lenk, alias, lena, minlen, ierr) int *kdx, *keyword, *lenk, *alias, *lena, *minlen, *ierr; { *ierr = kdm_set_alias (*kdx, KDM_pointers[*keyword], *lenk, KDM_pointers[*alias], *lena, *minlen); } /*-Routine: Select name for output - kdm_printname The routine kdm_printname (kdmf_printname) selects which keyword name to use on output if an alias has been defined for the keyword. -end*/ /* *************************** ** kdm_printname ** *************************** Purpose: Choose normal or alias keyword name for output Author: John W. Campbell, April 1997 CD-Fortran: CALL KDMF_PRINTNAME (KDX, KDMSTR(KEYWORD), LENK, USE_ALIAS, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT KEYWORD c (R) Parameter name (full) character string ** Pass address index using the KDMSTR function ** LENK i (R) Length of keyword USE_ALIAS i (R) = 1 use Alias name = 0 use Normal name IERR i (W) Error flag as returned from kdm_printname -end*/ /*-C:*/ int kdm_printname (int kdx, char * keyword, int lenk, int use_alias) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * keyword; Parameter keyword string (full) (R) int lenk; Length of keyword string (may be 0 if string is null terminated (R) int use_alias; Flag =1 use Alias name, =0 use Normal name (R) Return: Error flag = 0 no error = 1 invalid keyword specification =-100 index does not point to valid KDM dataset -end*/ { int i; int ll; int found; KDM_keyword_set * keyset; KDM_parlist * parlist; if (init<=0) return -100; if (kdx<0||kdx>=num_kdm_sets) return -100; keyset = &keyword_sets[kdx]; parlist = keyset->parlist; if (keyset->num_pars<1) return -100; /* Search for keyword */ ll = lenk; if (ll<=0) ll = strlen(keyword); found = -1; for (i=0;inum_pars;++i) { if (ll==parlist[i].klen) { if (kdm_ncasecmp(parlist[i].name, keyword, ll)==0) {found=i; break;} } if (parlist[i].alen>0&&ll==parlist[i].alen) { if (kdm_ncasecmp(parlist[i].alias,keyword,ll)==0) {found=i; break;} } } if (found<0) return 1; if (use_alias!=0) use_alias = 1; if (parlist[found].alen>0) { parlist[found].use_alias = use_alias; } else { parlist[found].use_alias = 0; } return 0; } /* Fortran binding: kdmf_printname */ void kdmf_printname (kdx, keyword, lenk, use_alias, ierr) int *kdx, *keyword, *lenk, *use_alias, *ierr; { *ierr = kdm_printname (*kdx, KDM_pointers[*keyword], *lenk, *use_alias); } /*-Section: Set KDM Parameter Values Routines are available to set KDM parameter values and to reset default values. -end*/ /*-Routine: Reset default KDM parameter value(s) - kdm_reset The routine kdm_reset (kdmf_reset) is used to reset the default value for a selected KDM parameter or for all parameters. Values may be reset for single sets/subsets or all sets/subsets as desired. -end*/ /* *************************** ** kdm_reset ** *************************** Purpose: Reset default values for 'kdm' parameter(s) Author: John W. Campbell, June 1995 CD-Fortran: CALL KDMF_RESET (KDX, KDMSTR(KEYWORD), LENK, ISET, ISUBSET, + KDMSTR(ERRSTR), MAXE, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT KEYWORD c (R) Parameter name (full) character string ** Pass address index using the KDMSTR function ** LENK i (R) Length of keyword ISET i (R) Set number, 0=all sets - ignored for single value type parameters ISUBSET i (R) Subset number, 0=all subsets - ignored for single value or set type parameters ERRSTR c (W) Returns an error string ** Pass address index using the KDMSTR function ** MAXE i (R) Maximum length allowed for error string (should be >= 80) IERR i (W) Error flag as returned from kdm_reset -end*/ /*-C:*/ int kdm_reset (int kdx, char * keyword, int lenk, int iset, int isubset, char * errstr, int maxe) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * keyword; Parameter keyword string (full) (R) int lenk; Length of keyword string (may be 0 if string is null terminated (R) int iset; Set number, 0=all sets - ignored for single value type parameters (R) int isubset; Subset number, 0=all subsets - ignored for single value or set type parameters (R) char *errstr; Returns an error string (W) int maxe; if >0 Maximum length of returned error string allowed (excluding terminating null - errstr must be at least maxe + 1 characters in length) if <0 abs(maxe) characters will be returned padded with blanks if needed (for 'fortran' use) (should allow 80 chars for error messages) (R) Return: Error flag = 0 no error =-1 invalid set specification =-2 invalid subset specification =-3 invalid keyword specification =-100 index does not point to valid KDM dataset -end*/ { KDM_keyword_set * keyset; KDM_parlist * parlist; KDM_int_par * idp; KDM_float_par * fdp; KDM_str_par * sdp; KDM_varr_par * vdp; int ll; int i; int j; int n; int ioff; int kk; int nvals; int found; int iclass; int minoff; int maxoff; char str[80]; kdm_copy_chars (" ", 0, errstr, maxe); if (init<=0) {kdm_copy_chars ("KDM data not set up", 0, errstr, maxe); return -100;} if (kdx<0||kdx>=num_kdm_sets) {kdm_copy_chars ("KDM data set not initialised", 0, errstr, maxe); return -100;} keyset = &keyword_sets[kdx]; parlist = keyset->parlist; if (keyset->num_pars<1) {kdm_copy_chars ("No KDM parameters defined", 0, errstr, maxe); return -100;} if (iset<0||iset>keyset->max_sets) { sprintf (str,"Invalid %s value",keyset->snam); kdm_copy_chars (str, 0, errstr, maxe); return -1; } if (isubset<0||isubset>keyset->max_subsets) { sprintf (str,"Invalid %s value",keyset->ssnam); kdm_copy_chars (str, 0, errstr, maxe); return -2; } ll = lenk; if (ll<=0) ll = strlen(keyword); if (kdm_blank_string (keyword, ll)==0) { found = -1; for (i=0;inum_pars;++i) { if (ll==parlist[i].klen) { if (kdm_ncasecmp(parlist[i].name,keyword,ll)==0) {found=i; break;} } if (parlist[i].alen>0&&ll==parlist[i].alen) { if (kdm_ncasecmp(parlist[i].alias,keyword,ll)==0) {found=i; break;} } } if (found<0) {kdm_copy_chars ("Keyword not found", 0, errstr, maxe); return -3;} minoff = found; maxoff = found; } else { minoff = 0; maxoff = keyset->num_pars-1; } for (ioff=minoff;ioff<=maxoff;++ioff) { switch (parlist[ioff].type) { case 1: case 2: case 3: /* Integer value cases */ idp = (KDM_int_par *) parlist[ioff].data; nvals = idp->num_vals; for (kk=0;kkidata[kk] = idp->i_default[kk]; idp->ch_flags[0] = ch_mask; idp->st_flags[0] = 0; break; case 2: /* Set dependent parameter value */ if (iset!=0) { idp->idata[(iset-1)*nvals+kk] = idp->i_default[kk]; idp->ch_flags[iset-1] = ch_mask; idp->st_flags[iset-1] = 0; } else { for(i=0;imax_sets;++i) { idp->idata[i*nvals+kk] = idp->i_default[kk]; idp->ch_flags[i] = ch_mask; idp->st_flags[i] = 0; } } break; case 3: /* Set plate dependent parameter value */ if (iset==0) { if (isubset==0) { n = keyset->max_sets*keyset->max_subsets; for (i=0;iidata[i*nvals+kk] = idp->i_default[kk]; idp->ch_flags[i] = ch_mask; idp->st_flags[i] = 0; } } else { for (i=0;imax_sets;++i) { j = i*keyset->max_subsets + isubset - 1; idp->idata[j*nvals+kk] = idp->i_default[kk]; idp->ch_flags[j] = ch_mask; idp->st_flags[j] = 0; } } } else { if (isubset==0) { for (i=0;imax_subsets;++i) { j = (iset-1)*keyset->max_subsets + i; idp->idata[j*nvals+kk] = idp->i_default[kk]; idp->ch_flags[j] = ch_mask; idp->st_flags[j] = 0; } } else { j = (iset-1)*keyset->max_subsets + isubset - 1; idp->idata[j*nvals+kk] = idp->i_default[kk]; idp->ch_flags[j] = ch_mask; idp->st_flags[j] = 0; } } } } break; case 4: case 5: case 6: /* Float value cases */ fdp = (KDM_float_par *) parlist[ioff].data; nvals = fdp->num_vals; for (kk=0;kkfdata[kk] = fdp->f_default[kk]; fdp->nd_flags[kk] = fdp->default_nd; fdp->ch_flags[0] = ch_mask; fdp->st_flags[0] = 0; break; case 2: /* Set dependent parameter value */ if (iset!=0) { fdp->fdata[(iset-1)*nvals+kk] = fdp->f_default[kk]; fdp->nd_flags[(iset-1)*nvals+kk] = fdp->default_nd; fdp->ch_flags[iset-1] = ch_mask; fdp->st_flags[iset-1] = 0; } else { for(i=0;imax_sets;++i) { fdp->fdata[i*nvals+kk] = fdp->f_default[kk]; fdp->nd_flags[i*nvals+kk] = fdp->default_nd; fdp->ch_flags[i] = ch_mask; fdp->st_flags[i] = 0; } } break; case 3: /* Set plate dependent parameter value */ if (iset==0) { if (isubset==0) { n = keyset->max_sets*keyset->max_subsets; for (i=0;ifdata[i*nvals+kk] = fdp->f_default[kk]; fdp->nd_flags[i*nvals+kk] = fdp->default_nd; fdp->ch_flags[i] = ch_mask; fdp->st_flags[i] = 0; } } else { for (i=0;imax_sets;++i) { j = i*keyset->max_subsets + isubset - 1; fdp->fdata[j*nvals+kk] = fdp->f_default[kk]; fdp->nd_flags[j*nvals+kk] = fdp->default_nd; fdp->ch_flags[j] = ch_mask; fdp->st_flags[j] = 0; } } } else { if (isubset==0) { for (i=0;imax_subsets;++i) { j = (iset-1)*keyset->max_subsets + i; fdp->fdata[j*nvals+kk] = fdp->f_default[kk]; fdp->nd_flags[j*nvals+kk] = fdp->default_nd; fdp->ch_flags[j] = ch_mask; fdp->st_flags[j] = 0; } } else { j = (iset-1)*keyset->max_subsets + isubset - 1; fdp->fdata[j*nvals+kk] = fdp->f_default[kk]; fdp->nd_flags[j*nvals+kk] = fdp->default_nd; fdp->ch_flags[j] = ch_mask; fdp->st_flags[j] = 0; } } } } break; case 7: case 8: case 9: /* String value cases */ sdp = (KDM_str_par *) parlist[ioff].data; iclass = (parlist[ioff].type-1)%3 + 1; switch (iclass) { case 1: /* Single value */ strcpy (sdp->sdata[0], sdp->s_default); sdp->ch_flags[0] = ch_mask; sdp->st_flags[0] = 0; break; case 2: /* Set dependent parameter value */ if (iset!=0) { strcpy (sdp->sdata[iset-1], sdp->s_default); sdp->ch_flags[iset-1] = ch_mask; sdp->st_flags[iset-1] = 0; } else { for(i=0;imax_sets;++i) { strcpy (sdp->sdata[i], sdp->s_default); sdp->ch_flags[i] = ch_mask; sdp->st_flags[i] = 0; } } break; case 3: /* Set plate dependent parameter value */ if (iset==0) { if (isubset==0) { n = keyset->max_sets*keyset->max_subsets; for (i=0;isdata[i], sdp->s_default); sdp->ch_flags[i] = ch_mask; sdp->st_flags[i] = 0; } } else { for (i=0;imax_sets;++i) { j = i*keyset->max_subsets + isubset - 1; strcpy (sdp->sdata[j], sdp->s_default); sdp->ch_flags[j] = ch_mask; sdp->st_flags[j] = 0; } } } else { if (isubset==0) { for (i=0;imax_subsets;++i) { j = (iset-1)*keyset->max_subsets + i; strcpy (sdp->sdata[j], sdp->s_default); sdp->ch_flags[j] = ch_mask; sdp->st_flags[j] = 0; } } else { j = (iset-1)*keyset->max_subsets + isubset - 1; strcpy (sdp->sdata[j], sdp->s_default); sdp->ch_flags[j] = ch_mask; sdp->st_flags[j] = 0; } } } break; case 10: case 11: case 12: /* Variable array value cases */ vdp = (KDM_varr_par *) parlist[ioff].data; nvals = vdp->num_vals; for (kk=0;kkidata[kk] = vdp->i_default[kk]; vdp->fdata[kk] = vdp->f_default[kk]; vdp->nd_flags[kk] = vdp->default_nd[kk]; vdp->ch_flags[0] = ch_mask; vdp->st_flags[0] = 0; vdp->num_inp[0] = vdp->npr_dflt; break; case 2: /* Set dependent parameter value */ if (iset!=0) { vdp->idata[(iset-1)*nvals+kk] = vdp->i_default[kk]; vdp->fdata[(iset-1)*nvals+kk] = vdp->f_default[kk]; vdp->nd_flags[(iset-1)*nvals+kk] = vdp->default_nd[kk]; vdp->ch_flags[iset-1] = ch_mask; vdp->st_flags[iset-1] = 0; vdp->num_inp[iset-1] = vdp->npr_dflt; } else { for(i=0;imax_sets;++i) { vdp->idata[i*nvals+kk] = vdp->i_default[kk]; vdp->fdata[i*nvals+kk] = vdp->f_default[kk]; vdp->nd_flags[i*nvals+kk] = vdp->default_nd[kk]; vdp->ch_flags[i] = ch_mask; vdp->st_flags[i] = 0; vdp->num_inp[i] = vdp->npr_dflt; } } break; case 3: /* Set plate dependent parameter value */ if (iset==0) { if (isubset==0) { n = keyset->max_sets*keyset->max_subsets; for (i=0;iidata[i*nvals+kk] = vdp->i_default[kk]; vdp->fdata[i*nvals+kk] = vdp->f_default[kk]; vdp->nd_flags[i*nvals+kk] = vdp->default_nd[kk]; fdp->ch_flags[i] = ch_mask; fdp->st_flags[i] = 0; vdp->num_inp[i] = vdp->npr_dflt; } } else { for (i=0;imax_sets;++i) { j = i*keyset->max_subsets + isubset - 1; vdp->idata[j*nvals+kk] = vdp->i_default[kk]; vdp->fdata[j*nvals+kk] = vdp->f_default[kk]; vdp->nd_flags[j*nvals+kk] = vdp->default_nd[kk]; vdp->ch_flags[j] = ch_mask; vdp->st_flags[j] = 0; vdp->num_inp[j] = vdp->npr_dflt; } } } else { if (isubset==0) { for (i=0;imax_subsets;++i) { j = (iset-1)*keyset->max_subsets + i; vdp->idata[j*nvals+kk] = vdp->i_default[kk]; vdp->fdata[j*nvals+kk] = vdp->f_default[kk]; vdp->nd_flags[j*nvals+kk] = vdp->default_nd[kk]; vdp->ch_flags[j] = ch_mask; vdp->st_flags[j] = 0; vdp->num_inp[j] = vdp->npr_dflt; } } else { j = (iset-1)*keyset->max_subsets + isubset - 1; vdp->idata[j*nvals+kk] = vdp->i_default[kk]; vdp->fdata[j*nvals+kk] = vdp->f_default[kk]; vdp->nd_flags[j*nvals+kk] = vdp->default_nd[kk]; vdp->ch_flags[j] = ch_mask; vdp->st_flags[j] = 0; vdp->num_inp[j] = vdp->npr_dflt; } } } } break; } } } /* Fortran binding: kdmf_reset */ void kdmf_reset (kdx, keyword, lenk, iset, isubset, errstr, maxe, ierr) int *kdx, *keyword, *lenk, *iset, *isubset; int *errstr, *maxe, *ierr; { int max_err; max_err = -(*maxe); if (max_err>0) max_err = -max_err; *ierr = kdm_reset (*kdx, KDM_pointers[*keyword], *lenk, *iset, *isubset, KDM_pointers[*errstr], max_err); } /*-Routine: Set a KDM parameter value - kdm_setvalue The routine kdm_setvalue (kdmf_setvalue) is used to set a KDM parameter value for any of the available parameter types. The full keyword string for the parameter must be given. The values may be passed as a string or, in the case of integer or floating point values, in a data item of the corresponding data type. A value may be set for a single set/subset or globally for sets/subsets where relevant and where desired. When floating point values are input as strings the number of decimal places used will be preserved for future printing of the parameter value; when input via a floating point variable, the default format for that parameter as defined via kdm_define_float (kdmf_define_float) will be used when the parameter value is printed. -end*/ /* *************************** ** kdm_setvalue ** *************************** Purpose: Set value for a 'kdm' parameter Author: John W. Campbell, June 1995 CD-Fortran: Fortran: CALL KDMF_SETVALUE (KDX, KDMSTR(KEYWORD), LENK, ISET, ISUBSET, + KDMSTR(VALSTR), LENV, IVAL, FVAL, IOPT, + KDMSTR(ERRSTR), MAXE, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT KEYWORD c (R) Parameter name (full) character string ** Pass address index using the KDMSTR function ** LENK i (R) Length of keyword ISET i (R) Set number, 0=all sets - ignored for single value type parameters ISUBSET i (R) Subset number, 0=all subsets - ignored for single value or set type parameters VALSTR c (R) Value string (-ignored if iopt>0) ** Pass address index using the KDMSTR function ** LENV i (R) Length of value string IVAL() i (R) Integer values for an integer parameter - used if IOPT=1 (NVALS values as defined in KDMF_DEFINE_INT call) FVAL() r (R) Float values for an float value parameter - used if IOPT=1 (NVALS values as defined in KDMF_DEFINE_FLOAT call) IOPT i (R) Flag =0 use value string (for float values the no. of decimal places for printing the values will be determined from this string) =1 use IVAL if an integer parameter and FVAL for a float parameter value (invalid for a string parameter) (for a float value the no. of decimal places for printing the value will be set to use the pre-defined default). Both arrays may be accessed for a variable array type parameter or >0 No. of input values for a variable array of values type parameter using IVAL and FVAL arrays ERRSTR c (W) Returns an error string ** Pass address index using the KDMSTR function ** MAXE i (R) Maximum length allowed for error string (should be >= 80) IERR i (W) Error flag as returned from kdm_setvalue -end*/ /*-C:*/ int kdm_setvalue (int kdx, char * keyword, int lenk, int iset, int isubset, char * valstr, int lenv, int * ival, float * fval, int iopt, char * errstr, int maxe) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * keyword; Parameter keyword string (full) (R) int lenk; Length of keyword string (may be 0 if string is null terminated (R) int iset; Set number, 0=all sets - ignored for single value type parameters (R) int isubset; Subset number, 0=all subsets - ignored for single value or set type parameters (R) char * valstr; Value string (-ignored if iopt=1) (R) int lenv; Length of value string; may be 0 if valstr is null terminated (R) int * ival; Integer values for an integer parameter - used if iopt=1 (nvals values as dedined in kdm_define_int call) (R) float * fval; Float values for an float value parameter - used if iopt=1 (nvals values as dedined in kdm_define_float call)(R) int iopt; Flag =0 use value string (for a float value the no. of decimal places for printing the value will be determined from this string) =1 use ival if an integer parameter and fval for a float parameter value (invalid for a string parameter) (for a float value the no. of decimal places for printing the value will be set to use the pre-defined default) or >0 No. of input values for a variable array of values type parameter using ival and fval arrays (R) char *errstr; Returns an error string (W) int maxe; if >0 Maximum length of returned error string allowed (excluding terminating null - errstr must be at least maxe + 1 characters in length) if <0 abs(maxe) characters will be returned padded with blanks if needed (for 'fortran' use) (should allow 80 chars for error messages) (R) Return: Error flag = 0 no error = 1 syntax error in number = 2 invalid value = -1 invalid set specification = -2 invalid subset specification = -3 invalid keyword = -4 memory allocation error (variable array parameter type only) = -100 index does not point to valid KDM dataset -end*/ { int ll; int i; int j; int n; int l; int kk; int nvals; int lc; int found; int ok; int iclass; int dec; int start; int nd; int iv; int *ivtemp; int *ndtemp; int ii; int num_inp; int dummy; float fv; float *fvtemp; KDM_int_par * idp; KDM_float_par * fdp; KDM_str_par * sdp; KDM_varr_par * vdp; KDM_keyword_set * keyset; KDM_parlist * parlist; char tmp[81]; char tmpstr[81]; int lv; kdm_copy_chars (" ", 0, errstr, maxe); KDM_chk_errstr[0] = 0; if (init<=0) {kdm_copy_chars ("KDM data not set up", 0, errstr, maxe); return -100;} if (kdx<0||kdx>=num_kdm_sets) {kdm_copy_chars ("KDM data set not initialised", 0, errstr, maxe); return -100;} keyset = &keyword_sets[kdx]; parlist = keyset->parlist; if (keyset->num_pars<1) {kdm_copy_chars ("No KDM parameters defined", 0, errstr, maxe); return -100;} if (iset<0||iset>keyset->max_sets) { sprintf (tmp,"Invalid %s value", keyset->snam); kdm_copy_chars (tmp, 0, errstr, maxe); return -1; } if (isubset<0||isubset>keyset->max_subsets) { sprintf (tmp,"Invalid %s value", keyset->ssnam); kdm_copy_chars (tmp, 0, errstr, maxe); return -2; } /* Search for keyword */ ll = lenk; if (ll<=0) ll = strlen(keyword); found = -1; for (i=0;inum_pars;++i) { if (ll==parlist[i].klen) { if (kdm_ncasecmp(parlist[i].name, keyword, ll)==0) {found=i; break;} } if (parlist[i].alen>0&&ll==parlist[i].alen) { if (kdm_ncasecmp(parlist[i].alias,keyword,ll)==0) {found=i; break;} } } if (found<0) {kdm_copy_chars ("Keyword not found", 0, errstr, maxe); return -3;} /* Keyword found */ lv = lenv; if (lv<=0) lv = strlen(valstr); switch (parlist[found].type) { case 1: case 2: case 3: /* Integer value cases, check value */ idp = (KDM_int_par *) parlist[found].data; lc = -1; nvals = idp->num_vals; for (kk=0;kk0) { kdm_copy_chars ("Syntax error in integer value", 0, errstr, maxe); return 1; } } else { iv = ival[kk]; } switch (idp->chk_typ) { case 0: break; case 1: if (iv<0) {kdm_copy_chars ("Value must be >= 0", 0, errstr, maxe); return 2;} break; case 2: if (iv<=0) {kdm_copy_chars ("Value must be > 0", 0, errstr, maxe); return 2;} break; case 3: if (iv>0) {kdm_copy_chars ("Value must be <= 0", 0, errstr, maxe); return 2;} break; case 4: if (iv>=0) {kdm_copy_chars ("Value must be < 0", 0, errstr, maxe); return 2;} break; case 5: if (ivi_min||iv>idp->i_max) { sprintf(tmpstr, "Value out of range %d to %d", idp->i_min, idp->i_max); kdm_copy_chars (tmpstr, 0, errstr, maxe); return 2; } break; case 6: if (idp->chk_func(&iv)!=0) { kdm_copy_chars (KDM_chk_errstr, 0, errstr, maxe); return 2; } break; case 7: if (iv<0||iv>keyset->max_sets) { sprintf(tmpstr, "Value out of range 0 to %d", keyset->max_sets); kdm_copy_chars (tmpstr, 0, errstr, maxe); return -1; } break; case 8: if (iv<0||iv>keyset->max_subsets) { sprintf(tmpstr, "Value out of range 0 to %d", keyset->max_subsets); kdm_copy_chars (tmpstr, 0, errstr, maxe); return -2; } break; } iclass = (parlist[found].type-1)%3 + 1; switch (iclass) { case 1: /* Single value */ idp->idata[kk] = iv; idp->ch_flags[0] = ch_mask; idp->st_flags[0] = 1; break; case 2: /* Set dependent parameter value */ if (iset!=0) { idp->idata[(iset-1)*nvals+kk] = iv; idp->ch_flags[iset-1] = ch_mask; idp->st_flags[iset-1] = 1; } else { for(i=0;imax_sets;++i) { idp->idata[i*nvals+kk] = iv; idp->ch_flags[i] = ch_mask; idp->st_flags[i] = 2; } } break; case 3: /* Set plate dependent parameter value */ if (iset==0) { if (isubset==0) { n = keyset->max_sets*keyset->max_subsets; for (i=0;iidata[i*nvals+kk] = iv; idp->ch_flags[i] = ch_mask; idp->st_flags[i] = 2; } } else { for (i=0;imax_sets;++i) { j = i*keyset->max_subsets + isubset - 1; idp->idata[j*nvals+kk] = iv; idp->ch_flags[j] = ch_mask; idp->st_flags[j] = 2; } } } else { if (isubset==0) { for (i=0;imax_subsets;++i) { j = (iset-1)*keyset->max_subsets + i; idp->idata[j*nvals+kk] = iv; idp->ch_flags[j] = ch_mask; idp->st_flags[j] = 2; } } else { j = (iset-1)*keyset->max_subsets + isubset - 1; idp->idata[j*nvals+kk] = iv; idp->ch_flags[j] = ch_mask; idp->st_flags[j] = 1; } } } } break; case 4: case 5: case 6: /* Float value cases, check value */ fdp = (KDM_float_par *) parlist[found].data; lc = -1; nvals = fdp->num_vals; for (kk=0;kk0) { kdm_copy_chars ("Syntax error in float value", 0, errstr, maxe); return 1; } } else { fv = fval[kk]; nd = -1000; } switch (fdp->chk_typ) { case 0: break; case 1: if (fv<0.0) {kdm_copy_chars ("Value must be >= 0.0", 0, errstr, maxe); return 2;} break; case 2: if (fv<=0.0) {kdm_copy_chars ("Value must be > 0.0", 0, errstr, maxe); return 2;} break; case 3: if (fv>0.0) {kdm_copy_chars ("Value must be <= 0.0", 0, errstr, maxe); return 2;} break; case 4: if (fv>=0.0) {kdm_copy_chars ("Value must be < 0.0", 0, errstr, maxe); return 2;} break; case 5: if (fvf_min||fv>fdp->f_max) { sprintf (tmp, "Value out of range %%.%df to %%.%df", fdp->nd, fdp->nd); sprintf (tmpstr, tmp, fdp->f_min, fdp->f_max); kdm_copy_chars (tmpstr, 0, errstr, maxe); return 2; } break; case 6: if (fdp->chk_func(&fv)!=0) { kdm_copy_chars (KDM_chk_errstr, 0, errstr, maxe); return 2; } break; } iclass = (parlist[found].type-1)%3 + 1; switch (iclass) { case 1: /* Single value */ fdp->fdata[kk] = fv; fdp->ch_flags[0] = ch_mask; fdp->st_flags[0] = 1; fdp->nd_flags[kk] = nd; break; case 2: /* Set dependent parameter value */ if (iset!=0) { fdp->fdata[(iset-1)*nvals+kk] = fv; fdp->ch_flags[iset-1] = ch_mask; fdp->st_flags[iset-1] = 1; fdp->nd_flags[(iset-1)*nvals+kk] = nd; } else { for(i=0;imax_sets;++i) { fdp->fdata[i*nvals+kk] = fv; fdp->ch_flags[i] = ch_mask; fdp->st_flags[i] = 2; fdp->nd_flags[i*nvals+kk] = nd; } } break; case 3: /* Set plate dependent parameter value */ if (iset==0) { if (isubset==0) { n = keyset->max_sets*keyset->max_subsets; for (i=0;ifdata[i*nvals+kk] = fv; fdp->ch_flags[i] = ch_mask; fdp->st_flags[i] = 2; fdp->nd_flags[i*nvals+kk] = nd; } } else { for (i=0;imax_sets;++i) { j = i*keyset->max_subsets + isubset - 1; fdp->fdata[j*nvals+kk] = fv; fdp->ch_flags[j] = ch_mask; fdp->st_flags[j] = 2; fdp->nd_flags[j*nvals+kk] = nd; } } } else { if (isubset==0) { for (i=0;imax_subsets;++i) { j = (iset-1)*keyset->max_subsets + i; fdp->fdata[j*nvals+kk] = fv; fdp->ch_flags[j] = ch_mask; fdp->st_flags[j] = 2; fdp->nd_flags[j*nvals+kk] = nd; } } else { j = (iset-1)*keyset->max_subsets + isubset - 1; fdp->fdata[j*nvals+kk] = fv; fdp->ch_flags[j] = ch_mask; fdp->st_flags[j] = 1; fdp->nd_flags[j*nvals+kk] = nd; } } } } break; case 7: case 8: case 9: /* String value cases, check value */ sdp = (KDM_str_par *) parlist[found].data; if (iopt!=0) {kdm_copy_chars ("String value must be given", 0, errstr, maxe); return 1;} switch (sdp->chk_typ) { case 0: break; case 1: n = sdp->num_allowed; if (n==0) {kdm_copy_chars ("No valid strings defined", 0, errstr, maxe); return 1;} ok = 0; for (i=0;imatch==0) { if (kdm_ncasecmp(valstr,sdp->allowed_strings[i],lv)==0) {ok=1; j=i; break;} } else if (sdp->match>0) { l = lv; if (lmatch) continue; if (kdm_ncasecmp(valstr,sdp->allowed_strings[i],l)==0) {ok=1; j=i; break;} } else if (sdp->match<0) { l = lv; if (l<-sdp->match) continue; if (kdm_ncasecmp(valstr,sdp->allowed_strings[i],-sdp->match)==0) {ok=1; j=i; break;} } } if (!ok) {kdm_copy_chars ("Not a valid string", 0, errstr, maxe); return 2;} break; case 2: KDM_strval_str = valstr; KDM_strval_len = lv; if (sdp->chk_func(&dummy)!=0) { kdm_copy_chars (KDM_chk_errstr, 0, errstr, maxe); return 2; } break; } iclass = (parlist[found].type-1)%3 + 1; switch (iclass) { case 1: /* Single value */ if (sdp->chk_typ==1) { strcpy (sdp->sdata[0], sdp->allowed_strings[j]); } else { if (lv>sdp->maxlen) lv = sdp->maxlen; strcpy (sdp->sdata[0],""); strncat (sdp->sdata[0], valstr, lv); } sdp->ch_flags[0] = ch_mask; sdp->st_flags[0] = 1; break; case 2: /* Set dependent parameter value */ if (iset!=0) { if (sdp->chk_typ==1) { strcpy (sdp->sdata[iset-1], sdp->allowed_strings[j]); } else { if (lv>sdp->maxlen) lv = sdp->maxlen; strcpy (sdp->sdata[iset-1],""); strncat (sdp->sdata[iset-1], valstr, lv); } sdp->ch_flags[iset-1] = ch_mask; sdp->st_flags[iset-1] = 1; } else { for(i=0;imax_sets;++i) { if (sdp->chk_typ==1) { strcpy (sdp->sdata[i], sdp->allowed_strings[j]); } else { if (lv>sdp->maxlen) lv = sdp->maxlen; strcpy (sdp->sdata[i],""); strncat (sdp->sdata[i], valstr, lv); } sdp->ch_flags[i] = ch_mask; sdp->st_flags[i] = 2; } } break; case 3: /* Set plate dependent parameter value */ if (iset==0) { if (isubset==0) { n = keyset->max_sets*keyset->max_subsets; for (i=0;ichk_typ==1) { strcpy (sdp->sdata[i], sdp->allowed_strings[j]); } else { if (lv>sdp->maxlen) lv = sdp->maxlen; strcpy (sdp->sdata[i],""); strncat (sdp->sdata[i], valstr, lv); } sdp->ch_flags[i] = ch_mask; sdp->st_flags[i] = 2; } } else { for (i=0;imax_sets;++i) { j = i*keyset->max_subsets + isubset - 1; if (sdp->chk_typ==1) { strcpy (sdp->sdata[j], sdp->allowed_strings[j]); } else { if (lv>sdp->maxlen) lv = sdp->maxlen; strcpy (sdp->sdata[j],""); strncat (sdp->sdata[j], valstr, lv); } sdp->ch_flags[j] = ch_mask; sdp->st_flags[j] = 2; } } } else { if (isubset==0) { for (i=0;imax_subsets;++i) { j = (iset-1)*keyset->max_subsets + i; if (sdp->chk_typ==1) { strcpy (sdp->sdata[j], sdp->allowed_strings[j]); } else { if (lv>sdp->maxlen) lv = sdp->maxlen; strcpy (sdp->sdata[j],""); strncat (sdp->sdata[j], valstr, lv); } sdp->ch_flags[j] = ch_mask; sdp->st_flags[j] = 2; } } else { j = (iset-1)*keyset->max_subsets + isubset - 1; if (sdp->chk_typ==1) { strcpy (sdp->sdata[j], sdp->allowed_strings[j]); } else { if (lv>sdp->maxlen) lv = sdp->maxlen; strcpy (sdp->sdata[j],""); strncat (sdp->sdata[j], valstr, lv); } sdp->ch_flags[j] = ch_mask; sdp->st_flags[j] = 1; } } } break; case 10: case 11: case 12: /* Variable array value cases, check values */ vdp = (KDM_varr_par *) parlist[found].data; nvals = vdp->num_vals; ivtemp = (int *) malloc (vdp->num_vals*sizeof(int)); if (ivtemp==0) return -4; fvtemp = (float *) malloc (vdp->num_vals*sizeof(float)); if (fvtemp==0) { if (ivtemp!=0) free(ivtemp); return -4; } ndtemp = (int *) malloc (vdp->num_vals*sizeof(int)); if (ndtemp==0) { if (ivtemp!=0) free(ivtemp); if (fvtemp!=0) free(fvtemp); return -4; } if (iopt<=0) { lc = -1; num_inp = 0; ii = -1; nxtv: ii = ii + 1; if (iinum_vals) { if (vdp->irtyp[ii]==1) { i = kdm_next_int (valstr, lenv, " ,", &ivtemp[ii], &lc); if (i<0) goto eos; ndtemp[ii] = 0; if (i>0) { kdm_copy_chars ("Syntax error in integer value", 0, errstr, maxe); return 1; } } else { i = kdm_next_float (valstr, lenv, " ,", &fvtemp[ii], &ndtemp[ii], &lc); if (i<0) goto eos; if (i>0) { kdm_copy_chars ("Syntax error in float value", 0, errstr, maxe); return 1; } } num_inp = num_inp + 1; goto nxtv; } } else { num_inp = iopt; if (num_inp>vdp->num_vals) num_inp = vdp->num_vals; for (ii=0;iiirtyp[ii]==2) ndtemp[ii] = -1000; } } eos: if (num_inpnum_vals_min) { kdm_copy_chars("Too few values given", 0, errstr, maxe); return 2; } if (vdp->chk_typ==1) { if (vdp->chk_func(ivtemp, fvtemp, vdp->irtyp, &num_inp)!=0) { kdm_copy_chars (KDM_chk_errstr, 0, errstr, maxe); return 2; } } for (kk=0;kkirtyp[kk]==1) { vdp->idata[kk] = ivtemp[kk]; } else { vdp->fdata[kk] = fvtemp[kk]; } vdp->ch_flags[0] = ch_mask; vdp->st_flags[0] = 1; vdp->num_inp[0] = num_inp; vdp->nd_flags[kk] = ndtemp[kk]; break; case 2: /* Set dependent parameter value */ if (iset!=0) { if (vdp->irtyp[kk]==1) { vdp->idata[(iset-1)*nvals+kk] = ivtemp[kk]; } else { vdp->fdata[(iset-1)*nvals+kk] = fvtemp[kk]; } vdp->ch_flags[iset-1] = ch_mask; vdp->st_flags[iset-1] = 1; vdp->num_inp[iset-1] = num_inp; vdp->nd_flags[(iset-1)*nvals+kk] = ndtemp[kk]; } else { for(i=0;imax_sets;++i) { if (vdp->irtyp[kk]==1) { vdp->idata[i*nvals+kk] = ivtemp[kk]; } else { vdp->fdata[i*nvals+kk] = fvtemp[kk]; } vdp->ch_flags[i] = ch_mask; vdp->st_flags[i] = 2; vdp->num_inp[i] = num_inp; vdp->nd_flags[i*nvals+kk] = ndtemp[kk]; } } break; case 3: /* Set plate dependent parameter value */ if (iset==0) { if (isubset==0) { n = keyset->max_sets*keyset->max_subsets; for (i=0;iirtyp[kk]==1) { vdp->idata[i*nvals+kk] = ivtemp[kk]; } else { vdp->fdata[i*nvals+kk] = fvtemp[kk]; } vdp->ch_flags[i] = ch_mask; vdp->st_flags[i] = 2; vdp->num_inp[i] = num_inp; vdp->nd_flags[i*nvals+kk] = ndtemp[kk]; } } else { for (i=0;imax_sets;++i) { j = i*keyset->max_subsets + isubset - 1; if (vdp->irtyp[kk]==1) { vdp->idata[j*nvals+kk] = ivtemp[kk]; } else { vdp->fdata[j*nvals+kk] = fvtemp[kk]; } vdp->ch_flags[j] = ch_mask; vdp->st_flags[j] = 2; vdp->num_inp[j] = num_inp; vdp->nd_flags[j*nvals+kk] = ndtemp[kk]; } } } else { if (isubset==0) { for (i=0;imax_subsets;++i) { j = (iset-1)*keyset->max_subsets + i; if (vdp->irtyp[kk]==1) { vdp->idata[j*nvals+kk] = ivtemp[kk]; } else { vdp->fdata[j*nvals+kk] = fvtemp[kk]; } vdp->ch_flags[j] = ch_mask; vdp->st_flags[j] = 2; vdp->num_inp[j] = num_inp; vdp->nd_flags[j*nvals+kk] = ndtemp[kk]; } } else { j = (iset-1)*keyset->max_subsets + isubset - 1; if (vdp->irtyp[kk]==1) { vdp->idata[j*nvals+kk] = ivtemp[i]; } else { vdp->fdata[j*nvals+kk] = fvtemp[i]; } vdp->ch_flags[j] = ch_mask; vdp->st_flags[j] = 1; vdp->num_inp[j] = num_inp; vdp->nd_flags[j*nvals+kk] = ndtemp[kk]; } } } } if (ivtemp!=0) free (ivtemp); if (fvtemp!=0) free (fvtemp); if (ndtemp!=0) free (ndtemp); break; } return 0; } /* Fortran binding: kdmf_setvalue */ void kdmf_setvalue (kdx, keyword, lenk, iset, isubset, valstr, lenv, ival, fval, iopt, errstr, maxe, ierr) int *kdx, *keyword, *lenk, *iset, *isubset, *valstr, *lenv, *ival; int *iopt, *errstr, *maxe, *ierr; float *fval; { int max_err; max_err = -(*maxe); if (max_err>0) max_err = -max_err; *ierr = kdm_setvalue (*kdx, KDM_pointers[*keyword], *lenk, *iset, *isubset, KDM_pointers[*valstr], *lenv, ival, fval, *iopt, KDM_pointers[*errstr], max_err); } /*-Routine: Set new decimal places flag - kdm_setndvar The routine kdm_setndvar (kdmf_setndvar) is a routine which enables the number of decimal places flag for a data item of a variable array keyword parameter to be set to a new value. -end*/ /* *************************** ** kdm_setndvar ** *************************** Purpose: Set a new no. of decimal places flag for a variable array keyword Author: John W. Campbell, August 1997 CD-Fortran: CALL KDMF_SETNDVAR (KDX, KDMSTR(KEYWORD), LENK, ITM, ND_NEW, + IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT KEYWORD c (R) Parameter name (full) character string ** Pass address index using the KDMSTR function ** LENK i (R) Length of keyword ITM i (R) Variable array item no. (from 1 to the maximum defined for the keyword) ND_NEW i (R) The new no. of decimal places for printing the value of a real data value recalculated by the program - ignored for an integer value IERR i (W) Error flag as returned from kdm_setndvar -end*/ /*-C:*/ int kdm_setndvar (int kdx, char * keyword, int lenk, int itm, int nd_new) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * keyword; Parameter keyword string (full) (R) int lenk; Length of keyword string (may be 0 if string is null terminated (R) int itm; Variable array item no. (from 1 to the maximum defined for the keyword) (R) int nd_new; The new no. of decimal places for printing the value of a real data value recalculated by the program - ignored for an integer value (R) Return: Error flag = 0 no error = 1 invalid keyword specification = 2 not a variable array parameter =-100 index does not point to valid KDM dataset -end*/ { int i; int ll; int found; KDM_varr_par * vdp; KDM_keyword_set * keyset; KDM_parlist * parlist; if (init<=0) return -100; if (kdx<0||kdx>=num_kdm_sets) return -100; keyset = &keyword_sets[kdx]; parlist = keyset->parlist; if (keyset->num_pars<1) return -100; /* Search for keyword */ ll = lenk; if (ll<=0) ll = strlen(keyword); found = -1; for (i=0;inum_pars;++i) { if (ll==parlist[i].klen) { if (kdm_ncasecmp(parlist[i].name, keyword, ll)==0) {found=i; break;} } } if (found<0) return 1; /* Keyword found */ if (parlist[found].type<10||parlist[found].type>12) return 2; vdp = (KDM_varr_par *) parlist[found].data; if (itm<1||itm>vdp->num_vals) return 0; vdp->nd[itm-1] = nd_new; return 0; } /* Fortran binding: kdmf_setndvar */ void kdmf_setndvar (kdx, keyword, lenk, itm, nd_new, ierr) int *kdx, *keyword, *lenk, *itm, *nd_new, *ierr; { *ierr = kdm_setndvar (*kdx, KDM_pointers[*keyword], *lenk, *itm, *nd_new); } /*-Routine: Reset standard output parameter flag - kdm_resetstd The routine kdm_resetstd (kdmf_resetstd) is a routine which enables the number 'standard output parameter' flag to be reset for a requested keyword parameter. -end*/ /* *************************** ** kdm_resetstd ** *************************** Purpose: Reset 'standard parameter' flag Author: John W. Campbell, November 1997 CD-Fortran: CALL KDMF_RESETSTD (KDX, KDMSTR(KEYWORD), LENK, IFLAG, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT KEYWORD c (R) Parameter name (full) character string ** Pass address index using the KDMSTR function ** LENK i (R) Length of keyword IFLAG i (R) =1 Set as standard parameter, =0 set as not a standard parameter, =-1 reset default. IERR i (W) Error flag as returned from kdm_resetstd -end*/ /*-C:*/ int kdm_resetstd (int kdx, char * keyword, int lenk, int iflag) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * keyword; Parameter keyword string (full) (R) int lenk; Length of keyword string (may be 0 if string is null terminated (R) int iflag; =1 Set as standard parameter, =0 set as not a standard parameter, =-1 reset default (R) Return: Error flag = 0 no error = 1 invalid keyword specification KDM dataset = 2 invalid value of iflag =-100 index does not point to valid KDM dataset -end*/ { int i; int ll; int found; KDM_keyword_set * keyset; KDM_parlist * parlist; if (init<=0) return -100; if (kdx<0||kdx>=num_kdm_sets) return -100; keyset = &keyword_sets[kdx]; parlist = keyset->parlist; if (keyset->num_pars<1) return -100; if (iflag<-1||iflag>1) return 2; /* Search for keyword */ ll = lenk; if (ll<=0) ll = strlen(keyword); found = -1; for (i=0;inum_pars;++i) { if (ll==parlist[i].klen) { if (kdm_ncasecmp(parlist[i].name, keyword, ll)==0) {found=i; break;} } } if (found<0) return 1; /* Keyword found */ if (iflag>=0) { parlist[found].pr_std = iflag; } else { parlist[found].pr_std = parlist[found].pr_std_dflt; } return 0; } /* Fortran binding: kdmf_resetstd */ void kdmf_resetstd (kdx, keyword, lenk, iflag, ierr) int *kdx, *keyword, *lenk, *iflag, *ierr; { *ierr = kdm_resetstd (*kdx, KDM_pointers[*keyword], *lenk, *iflag); } /*-Section: Get KDM Parameter Values Routines are avaiable to return the current values of KDM parameters. -end*/ /*-Routine: Get a KDM parameter value - kdm_getvalue The routine kdm_getvalue (kdmf_getvalue) is used to get a KDM parameter value for any of the available parameter types. The full keyword string for the parameter must be given. The value will be returned a string and also, in the case of integer or floating point values, in a data item of the corresponding data type. A set and subset value must be given explicitly where relevant. -end*/ /* *************************** ** kdm_getvalue ** *************************** Purpose: Get value for a 'kdm' parameter Author: John W. Campbell, June 1995 CD-Fortran: CALL KDMF_GETVALUE (KDX, KDMSTR(KEYWORD), LENK, ISET, ISUBSET, + MAXV, KDMSTR(VALSTR), FVAL, ND, IVAL, + NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), + MAXE, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT KEYWORD c (R) Parameter name (full) character string ** Pass address index using the KDMSTR function ** LENK i (R) Length of keyword ISET i (R) Set number,(>0) - ignored for single value type parameters ISUBSET i (R) Subset number, (>0) - ignored for single value or set type parameters MAXV i (R) Maximum length allowed for returned value string VALSTR c (W) Returned Value string (must be at least MAXV chars in length ** Pass address index using the KDMSTR function ** FVAL() r (W) Returned float values for a float type parameter (NVALS values as defined in KDMF_DEFINE_FLOAT call) or, in selected elements, for a variable length array parameter (see also NUM_INP) ND() i (W) Returned no. of decimal places flags for a float type parameter (-ve for E format)(NVALS values as defined in KDMF_DEFINE_FLOAT call) or, in selected elements, for a variable length array parameter (see also NUM_INP) IVAL() i (W) Returned integer values for an integer type parameter (NVALS values as dedined in KDMF_DEFINE_INT call) or, in selected elements, for a variable length array parameter (see also NUM_INP) NUM_INP i (W) No. of values presently stored for a a variable length array parameter (otherwise 0). For each array element from 1 to NUM_INP, a value will either be returned in either IVAL or FVAL as defined when the parameter was set up. ISTAT i (W) Parameter value status = 0 default = 1 set explicitly = 2 set globally ITYP i (W) Parameter type = 1 integer (string also returned) = 2 float (string also returned) = 3 string (single token) = 4 string (multiple token) = 5 variable array ERRSTR c (W) Returns an error string ** Pass address index using the KDMSTR function ** MAXE i (R) Maximum length allowed for error string (should be >= 80) IERR i (W) Error flag as returned from kdm_getvalue -end*/ /*-C:*/ int kdm_getvalue (int kdx, char * keyword, int lenk, int iset, int isubset, int maxv, char * valstr, float * fval, int * nd, int * ival, int * num_inp, int * istat, int * ityp, char * errstr, int maxe) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * keyword; Parameter keyword string (full) (R) int lenk; Length of keyword string (may be 0 if string is null terminated (R) int iset; Set number (>0) - ignored for single value type parameters (R) int isubset; Subset number (>0) - ignored for single value or set type parameters (R) int maxv; if >0 Maximum length of returned value string allowed (excluding terminating null - valstr must be at least maxv + 1 characters in length) if <0 abs(maxv) characters will be returned padded with blanks if needed (for 'fortran' use) (R) char * valstr; Returned Value string (must be at least maxval+1 chars in length (W) float * fval; Returned float values for a float type parameter (nvals values as defined in kdm_define_float call) or, in selected elements, for a variable length array parameter (see also num_inp) (W) int * nd; Returned no. of decimal places flags for a float type parameter (-ve for E format) (nvals values as defined in kdm_define_float call) or, in selected elements, for a variable length array parameter (see also num_inp) (W) int * ival; Returned integer values for an integer type parameter (nvals values as dedined in kdm_define_int call) or, in selected elements, for a variable length array parameter (see also num_inp) (W) int * num_inp; Returns no. of values presently stored for a a variable length array parameter (otherwise 0) For each array element from 0 to num_inp-1, a value will either be returned in either ival or fval as defined when the parameter was set up. (W) int *istat; Parameter value status = 0 default = 1 set explicitly = 2 set globally (W) int *ityp; Parameter type = 1 integer (string also returned) = 2 float (string also returned) = 3 string (single token) = 4 string (multiple tokens) = 5 variable array (W) char *errstr; Returns an error string (W) int maxe; if >0 Maximum length of returned error string allowed (excluding terminating null - errstr must be at least maxe + 1 characters in length) if <0 abs(maxe) characters will be returned padded with blanks if needed (for 'fortran' use) (should allow 80 chars for error messages) (R) Return: Error flag = 0 no error = 1 error -end*/ { int ll; int i; int j; int l; int found; int iclass; int iv; float fv; int maxvlen; int kk; int nvals; int nv; KDM_int_par * idp; KDM_float_par * fdp; KDM_str_par * sdp; KDM_varr_par * vdp; KDM_keyword_set * keyset; KDM_parlist * parlist; char fmt[21]; char tmp[41]; char err1[81]; char err2[81]; kdm_copy_chars (" ", 0, errstr, maxe); *ival = 0; *fval = 0; *istat = 0; *ityp = 0; *num_inp = 0; kdm_copy_chars (" ", 0, valstr, maxv); maxvlen = maxv; if (maxvlen<0) maxvlen = -maxvlen; if (init<=0) { kdm_copy_chars("KDM data not set up", 0, errstr, maxe); return 1; } if (kdx<0||kdx>=num_kdm_sets) { kdm_copy_chars ("KDM data set not initialised", 0, errstr, maxe); return 1; } keyset = &keyword_sets[kdx]; parlist = keyset->parlist; sprintf(err1, "Invalid %s value", keyset->snam); sprintf(err2, "Invalid %s value", keyset->ssnam); if (keyset->num_pars<1) { kdm_copy_chars ("No KDM parameters defined", 0, errstr, maxe); return 1; } /* Search for keyword */ ll = lenk; if (ll<=0) ll = strlen(keyword); found = -1; for (i=0;inum_pars;++i) { if (ll==parlist[i].klen) { if (kdm_ncasecmp(parlist[i].name, keyword, ll)==0) {found=i; break;} } if (parlist[i].alen>0&&ll==parlist[i].alen) { if (kdm_ncasecmp(parlist[i].alias,keyword,ll)==0) {found=i; break;} } } if (found<0) { kdm_copy_chars("Keyword not found",0,errstr,maxe); return 1; } /* Keyword found */ iclass = (parlist[found].type-1)%3 + 1; if (iclass>1) { if (iset<0||iset>keyset->max_sets) { kdm_copy_chars(err1, 0, errstr, maxe); return 1; } } if (iclass>2) { if (isubset<0||isubset>keyset->max_subsets) { kdm_copy_chars(err2, 0, errstr, maxe); return 1; } } switch (parlist[found].type) { case 1: case 2: case 3: /* Integer value cases */ idp = (KDM_int_par *) parlist[found].data; nvals = idp->num_vals; valstr[0] = 0; ll = 0; *ityp = 1; for (kk=0;kkidata[kk]; *istat = idp->st_flags[0]; break; case 2: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} iv = idp->idata[(iset-1)*nvals+kk]; *istat = idp->st_flags[iset-1]; break; case 3: if (iset==0) {kdm_copy_chars (err1, 0, errstr,maxe); return 1;} if (isubset==0) {kdm_copy_chars (err2, 0, errstr, maxe); return 1;} j = (iset-1)*keyset->max_subsets + isubset - 1; iv = idp->idata[j*nvals+kk]; *istat = idp->st_flags[j]; break; } ival[kk] = iv; if (kk==0){sprintf (tmp, "%d", iv);}else{sprintf (tmp, " %d", iv);} l = strlen(tmp); if (ll+l>maxvlen) l = maxvlen - ll; if (l>0) { if (maxv>0) { kdm_copy_chars (tmp, l, &valstr[ll], maxv-ll); } else { kdm_copy_chars (tmp, l, &valstr[ll], maxv+ll); } ll += l; } } break; case 4: case 5: case 6: /* Float value cases */ fdp = (KDM_float_par *) parlist[found].data; nvals = fdp->num_vals; valstr[0] = 0; ll = 0; *ityp = 2; for (kk=0;kkfdata[kk]; *istat = fdp->st_flags[0]; nd[kk] = fdp->nd_flags[kk]; break; case 2: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} fv = fdp->fdata[(iset-1)*nvals+kk]; *istat = fdp->st_flags[iset-1]; nd[kk] = fdp->nd_flags[(iset-1)*nvals+kk]; break; case 3: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} if (isubset==0) {kdm_copy_chars (err2, 0, errstr, maxe); return 1;} j = (iset-1)*keyset->max_subsets + isubset - 1; fv = fdp->fdata[j*nvals+kk]; *istat = fdp->st_flags[j]; nd[kk] = fdp->nd_flags[j*nvals+kk]; break; } fval[kk] = fv; if (nd[kk]==-1000) nd[kk] = fdp->nd; if (nd[kk]>=0) { if (kk==0) { sprintf (fmt,"%%.%df", nd[kk]); } else { sprintf (fmt," %%.%df", nd[kk]); } } else { if (kk==0) { sprintf (fmt,"%%.%de", -nd[kk]); } else { sprintf (fmt," %%.%de", -nd[kk]); } } sprintf (tmp, fmt, fv); l = strlen(tmp); if (ll+l>maxvlen) l = maxvlen - ll; if (l>0) { if (maxv>0) { kdm_copy_chars (tmp, l, &valstr[ll], maxv-ll); } else { kdm_copy_chars (tmp, l, &valstr[ll], maxv+ll); } ll += l; } } break; case 7: case 8: case 9: /* String value cases */ sdp = (KDM_str_par *) parlist[found].data; *ityp = 3; if (sdp->mult) *ityp = 4; switch (iclass) { case 1: j = 0; break; case 2: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} j = iset - 1;; break; case 3: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} if (isubset==0) {kdm_copy_chars (err2, 0, errstr, maxe); return 1;} j = (iset-1)*keyset->max_subsets + isubset - 1; break; } *istat = sdp->st_flags[j]; l = strlen (sdp->sdata[j]); if (l>maxvlen) l = maxvlen; kdm_copy_chars (sdp->sdata[j], l, valstr, maxv); break; case 10: case 11: case 12: /* Variable array value cases */ vdp = (KDM_varr_par *) parlist[found].data; switch (iclass) { case 1: j = 0; break; case 2: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} j = iset - 1;; break; case 3: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} if (isubset==0) {kdm_copy_chars (err2, 0, errstr, maxe); return 1;} j = (iset-1)*keyset->max_subsets + isubset - 1; break; } nvals = vdp->num_inp[j]; *num_inp = nvals; nv = vdp->num_vals; valstr[0] = 0; ll = 0; *ityp = 5; for (kk=0;kkidata[kk]; fv = vdp->fdata[kk]; *istat = vdp->st_flags[0]; nd[kk] = vdp->nd_flags[kk]; break; case 2: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} iv = vdp->idata[(iset-1)*nv+kk]; fv = vdp->fdata[(iset-1)*nv+kk]; *istat = vdp->st_flags[iset-1]; nd[kk] = vdp->nd_flags[(iset-1)*nv+kk]; break; case 3: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} if (isubset==0) {kdm_copy_chars (err2, 0, errstr, maxe); return 1;} j = (iset-1)*keyset->max_subsets + isubset - 1; iv = vdp->idata[j*nv+kk]; fv = vdp->fdata[j*nv+kk]; *istat = vdp->st_flags[j]; nd[kk] = vdp->nd_flags[j*nv+kk]; break; } if (vdp->irtyp[kk]==1) { ival[kk] = iv; fval[kk] = 0.0; nd[kk] = 0; if (kk==0){sprintf (tmp, "%d", iv);}else{sprintf (tmp, " %d", iv);} } else { fval[kk] = fv; ival[kk] = 0; if (nd[kk]==-1000) nd[kk] = vdp->nd[kk]; if (nd[kk]>=0) { if (kk==0) { sprintf (fmt,"%%.%df", nd[kk]); } else { sprintf (fmt," %%.%df", nd[kk]); } } else { if (kk==0) { sprintf (fmt,"%%.%de", -nd[kk]); } else { sprintf (fmt," %%.%de", -nd[kk]); } } sprintf (tmp, fmt, fv); } l = strlen(tmp); if (ll+l>maxvlen) l = maxvlen - ll; if (l>0) { if (maxv>0) { kdm_copy_chars (tmp, l, &valstr[ll], maxv-ll); } else { kdm_copy_chars (tmp, l, &valstr[ll], maxv+ll); } ll += l; } } break; } return 0; } /* Fortran binding: kdmf_getvalue */ void kdmf_getvalue (kdx, keyword, lenk, iset, isubset, maxv, valstr, fval, nd, ival, num_inp, istat, ityp, errstr, maxe, ierr) int *kdx, *keyword, *lenk, *iset, *isubset, *maxv, *valstr, *nd, *ival; int *num_inp; int *istat, *ityp, *errstr, *maxe, *ierr; float *fval; { int max_err; int maxvlen; max_err = -(*maxe); if (max_err>0) max_err = -max_err; maxvlen = -(*maxv); if (maxvlen>0) maxvlen = -maxvlen; *ierr = kdm_getvalue (*kdx, KDM_pointers[*keyword], *lenk, *iset, *isubset, maxvlen, KDM_pointers[*valstr], fval, nd, ival, num_inp, istat, ityp, KDM_pointers[*errstr], max_err); } /*-Routine: Get a KDM parameter value string - kdm_getvalstr The routine kdm_getvalstr (kdmf_getvalstr) is used to get a KDM parameter value for any of the available parameter types. The full keyword string for the parameter must be given. The value will be returned a string only (cf kdm_getvalue (kdmf_getvalue)). A set and subset value must be given explicitly where relevant. -end*/ /* *************************** ** kdm_getvalstr ** *************************** Purpose: Get value for a 'kdm' parameter as a string only Author: John W. Campbell, June 1995 CD-Fortran: CALL KDMF_GETVALSTR (KDX, KDMSTR(KEYWORD), LENK, ISET, ISUBSET, + MAXV, KDMSTR(VALSTR), ISTAT, + ITYP, KDMSTR(ERRSTR), MAXE, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT KEYWORD c (R) Parameter name (full) character string ** Pass address index using the KDMSTR function ** LENK i (R) Length of keyword ISET i (R) Set number,(>0) - ignored for single value type parameters ISUBSET i (R) Subset number, (>0) - ignored for single value or set type parameters MAXV i (R) Maximum length allowed for returned value string VALSTR c (W) Returned Value string (must be at least MAXV chars in length ** Pass address index using the KDMSTR function ** ISTAT (i W) Parameter value status = 0 default = 1 set explicitly = 2 set globally ITYP i (W) Parameter type = 1 integer (string also returned) = 2 float (string also returned) = 3 string (single token) = 4 string (multiple token) ERRSTR c (W) Returns an error string ** Pass address index using the KDMSTR function ** MAXE i (R) Maximum length allowed for error string (should be >= 80) IERR i (W) Error flag as returned from kdm_setvalue -end*/ /*-C:*/ int kdm_getvalstr (int kdx, char * keyword, int lenk, int iset, int isubset, int maxv, char * valstr, int *istat, int *ityp, char * errstr, int maxe) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * keyword; Parameter keyword string (full) (R) int lenk; Length of keyword string (may be 0 if string is null terminated (R) int iset; Set number (>0) - ignored for single value type parameters (R) int isubset; Subset number (>0) - ignored for single value or set type parameters (R) int maxv; if >0 Maximum length of returned value string allowed (excluding terminating null - valstr must be at least maxv + 1 characters in length) if <0 abs(maxv) characters will be returned padded with blanks if needed (for 'fortran' use) (R) char * valstr; Returned Value string (must be at least maxval+1 chars in length (W) int *istat; Parameter value status = 0 default = 1 set explicitly = 2 set globally (W) int *ityp; Parameter type = 1 integer (string also returned) = 2 float (string also returned) = 3 string (single token) = 4 string (multiple tokens) (W) char *errstr; Returns an error string (W) int maxe; if >0 Maximum length of returned error string allowed (excluding terminating null - errstr must be at least maxe + 1 characters in length) if <0 abs(maxe) characters will be returned padded with blanks if needed (for 'fortran' use) (should allow 80 chars for error messages) (R) Return: Error flag = 0 no error = 1 error -end*/ { int ll; int i; int j; int l; int found; int iclass; int iv; float fv; int nd; int maxvlen; int kk; int nvals; int nv; KDM_int_par * idp; KDM_float_par * fdp; KDM_str_par * sdp; KDM_varr_par * vdp; KDM_keyword_set * keyset; KDM_parlist * parlist; char fmt[21]; char tmp[41]; char err1[81]; char err2[81]; kdm_copy_chars (" ", 0, errstr, maxe); *istat = 0; *ityp = 0; kdm_copy_chars (" ", 0, valstr, maxv); maxvlen = maxv; if (maxvlen<0) maxvlen = -maxvlen; if (init<=0) { kdm_copy_chars("KDM data not set up", 0, errstr, maxe); return 1; } if (kdx<0||kdx>=num_kdm_sets) { kdm_copy_chars("KDM data set not initialised", 0, errstr, maxe); return 1; } keyset = &keyword_sets[kdx]; parlist = keyset->parlist; sprintf (err1, "invalid %s value", keyset->snam); sprintf (err2, "invalid %s value", keyset->ssnam); if (keyset->num_pars<1) { kdm_copy_chars("No KDM parameters defined", 0, errstr, maxe); return 1; } /* Search for keyword */ ll = lenk; if (ll<=0) ll = strlen(keyword); found = -1; for (i=0;inum_pars;++i) { if (ll==parlist[i].klen) { if (kdm_ncasecmp(parlist[i].name, keyword, ll)==0) {found=i; break;} } if (parlist[i].alen>0&&ll==parlist[i].alen) { if (kdm_ncasecmp(parlist[i].alias,keyword,ll)==0) {found=i; break;} } } if (found<0) { kdm_copy_chars("Keyword not found", 0, errstr, maxe); return 1; } /* Keyword found */ iclass = (parlist[found].type-1)%3 + 1; if (iclass>1) { if (iset<0||iset>keyset->max_sets) { kdm_copy_chars(err1, 0, errstr, maxe); return 1; } } if (iclass>2) { if (isubset<0||isubset>keyset->max_subsets) { kdm_copy_chars(err2, 0, errstr, maxe); return 1; } } switch (parlist[found].type) { case 1: case 2: case 3: /* Integer value cases */ idp = (KDM_int_par *) parlist[found].data; nvals = idp->num_vals; valstr[0] = 0; ll = 0; *ityp = 1; for (kk=0;kkidata[kk]; *istat = idp->st_flags[0]; break; case 2: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} iv = idp->idata[(iset-1)*nvals+kk]; *istat = idp->st_flags[iset-1]; break; case 3: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} if (isubset==0) {kdm_copy_chars (err2, 0, errstr, maxe); return 1;} j = (iset-1)*keyset->max_subsets + isubset - 1; iv = idp->idata[j*nvals+kk]; *istat = idp->st_flags[j]; break; } if (kk==0){sprintf (tmp, "%d", iv);}else{sprintf (tmp, " %d", iv);} l = strlen(tmp); if (ll+l>maxvlen) l = maxvlen - ll; if (l>0) { if (maxv>0) { kdm_copy_chars (tmp, l, &valstr[ll], maxv-ll); } else { kdm_copy_chars (tmp, l, &valstr[ll], maxv+ll); } ll += l; } } break; case 4: case 5: case 6: /* Float value cases */ fdp = (KDM_float_par *) parlist[found].data; nvals = fdp->num_vals; valstr[0] = 0; ll = 0; *ityp = 2; for (kk=0;kkfdata[kk]; *istat = fdp->st_flags[0]; nd = fdp->nd_flags[kk]; break; case 2: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} fv = fdp->fdata[(iset-1)*nvals+kk]; *istat = fdp->st_flags[iset-1]; nd = fdp->nd_flags[(iset-1)*nvals+kk]; break; case 3: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} if (isubset==0) {kdm_copy_chars (err2, 0, errstr, maxe); return 1;} j = (iset-1)*keyset->max_subsets + isubset - 1; fv = fdp->fdata[j*nvals+kk]; *istat = fdp->st_flags[j]; nd = fdp->nd_flags[j*nvals+kk]; break; } if (nd==-1000) nd = fdp->nd; if (nd>=0) { if (kk==0) { sprintf (fmt,"%%.%df", nd); } else { sprintf (fmt," %%.%df", nd); } } else { if (kk==0) { sprintf (fmt,"%%.%de", -nd); } else { sprintf (fmt," %%.%de", -nd); } } sprintf (tmp, fmt, fv); l = strlen(tmp); if (ll+l>maxvlen) l = maxvlen - ll; if (l>0) { if (maxv>0) { kdm_copy_chars (tmp, l, &valstr[ll], maxv-ll); } else { kdm_copy_chars (tmp, l, &valstr[ll], maxv+ll); } ll += l; } } break; case 7: case 8: case 9: /* String value cases */ sdp = (KDM_str_par *) parlist[found].data; *ityp = 3; if (sdp->mult) *ityp = 4; switch (iclass) { case 1: j = 0; break; case 2: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} j = iset - 1;; break; case 3: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} if (isubset==0) {kdm_copy_chars (err2, 0, errstr, maxe); return 1;} j = (iset-1)*keyset->max_subsets + isubset - 1; break; } *istat = sdp->st_flags[j]; l = strlen (sdp->sdata[j]); if (l>maxvlen) l = maxvlen; kdm_copy_chars (sdp->sdata[j], l, valstr, maxv); break; case 10: case 11: case 12: /* Variable array value cases */ vdp = (KDM_varr_par *) parlist[found].data; switch(iclass) { case 1: j = 0; break; case 2: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} j = iset - 1;; break; case 3: if (iset==0) {kdm_copy_chars (err1, 0, errstr, maxe); return 1;} if (isubset==0) {kdm_copy_chars (err2, 0, errstr, maxe); return 1;} j = (iset-1)*keyset->max_subsets + isubset - 1; break; } nvals = vdp->num_inp[j]; nv = vdp->num_vals; valstr[0] = 0; ll = 0; *ityp = 5; for (kk=0;kkidata[kk]; fv = vdp->fdata[kk]; *istat = vdp->st_flags[0]; nd = vdp->nd_flags[kk]; break; case 2: iv = vdp->idata[(iset-1)*nv+kk]; fv = vdp->fdata[(iset-1)*nv+kk]; *istat = vdp->st_flags[iset-1]; nd = vdp->nd_flags[(iset-1)*nv+kk]; break; case 3: j = (iset-1)*keyset->max_subsets + isubset - 1; iv = vdp->idata[j*nv+kk]; fv = vdp->fdata[j*nv+kk]; *istat = vdp->st_flags[j]; nd = vdp->nd_flags[j*nv+kk]; break; } if (vdp->irtyp[kk]==1) { if (kk==0){sprintf (tmp, "%d", iv);}else{sprintf (tmp, " %d", iv);} } else { if (nd==-1000) nd = vdp->nd[kk]; if (nd>=0) { if (kk==0) { sprintf (fmt,"%%.%df", nd); } else { sprintf (fmt," %%.%df", nd); } } else { if (kk==0) { sprintf (fmt,"%%.%de", -nd); } else { sprintf (fmt," %%.%de", -nd); } } sprintf (tmp, fmt, fv); } l = strlen(tmp); if (ll+l>maxvlen) l = maxvlen - ll; if (l>0) { if (maxv>0) { kdm_copy_chars (tmp, l, &valstr[ll], maxv-ll); } else { kdm_copy_chars (tmp, l, &valstr[ll], maxv+ll); } ll += l; } } break; } return 0; } /* Fortran binding: kdmf_getvalstr */ void kdmf_getvalstr (kdx, keyword, lenk, iset, isubset, maxv, valstr, istat, ityp, errstr, maxe, ierr) int *kdx, *keyword, *lenk, *iset, *isubset, *maxv, *valstr; int *istat, *ityp, *errstr, *maxe, *ierr; { int max_err; int maxvlen; max_err = -(*maxe); if (max_err>0) max_err = -max_err; maxvlen = -(*maxv); if (maxvlen>0) maxvlen = -maxvlen; *ierr = kdm_getvalstr (*kdx, KDM_pointers[*keyword], *lenk, *iset, *isubset, maxvlen, KDM_pointers[*valstr], istat, ityp, KDM_pointers[*errstr], max_err); } /*-Section: Output Keyword and Value Strings A routine enables the formation of output strings for writing KDM data. A user supplied routine does the actual output. -end*/ /*-Routine: Get output string for a KDM parameter - kdm_output The routine kdm_output (kdmf_output) is used to form a string with a KDM keyword and its value(s). It has an option to check for outputting only changed values for a requested change channel number. The routine may also suppress default values if required and indicates whether only default values are present for the parameter in question. For set/subset type parameters there is an option to reduce the amount of output where possible e.g. by combining values if they are all the same for a set etc. A user supplied function is given to do the actual output. -end*/ /* ************************ ** kdm_output ** ************************ Purpose: Get and output keyword and value string for a 'kdm' parameter Author: John W. Campbell, June 1995 CD-Fortran: CALL KDMF_OUTPUT (KDX, KDMSTR(KEYWORD), LENK, ICHANGED, + IREDUCE, NS, NSS, KDMSTR(OUTSTR), MAXO, + OP_FUNC, KDMSTR(ERRSTR), MAXE, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT KEYWORD c (R) Parameter name (full) character string ** Pass address index using the KDMSTR function ** LENK i (R) Length of keyword ICHANGED i (R) If 0 print parameter anyway, if 1-16, only create output parameter value string if parameter changed flag set for that parameter. IREDUCE i (R) =0 output all values for all sets & subsets =1 reduce output where feasible by recombining values if all the same for a set etc. =2 as for 1 but suppress default values for non 'standard print' parameters =3 as for 1 but suppress default values for all parameters (ignored if ICHANGED=1) NS i (R) Current no. of sets (give -1 if this and the nos. of subsets/set values are to be determined internally from the parameters named via KDMF_INIT) NSS() i (R) Array of current nos. of subsets in each set (at least NS values) - values ignored if NS = -1 OUTSTR c (*) Buffer used in printing output (should be at least 2050 characters in length) ** Pass address index using the KDMSTR function ** MAXO i (R) Maximum length allowed for OUTSTR (should be at least 2050) OP_FUNC s (R) Function to do the actual output. The data to be output by this function will be stored in OUTSTR, The call will be CALL OP_FUNC without any parameters so that the string OUTSTR must be available to the routine op_func via a common block possibly with other parameters such as Fortran unit numbers etc. If any keywords have a large number of values, then the output routine may wish to split the string into more than one record; if the output is to a parameter file which is subsequently to be read then all the records except the last one should be terminated with a '-' or '&' character to indicate continuation. ERRSTR c (W) Returns an error string ** Pass address index using the KDMSTR function ** MAXE i (R) Maximum length allowed for error string (should be >= 80) IERR i (W) Error flag as returned from kdm_output -end*/ /*-C:*/ int kdm_output (int kdx, char * keyword, int lenk, int ichanged, int ireduce, int ns, int * nss, char * outstr, int maxo, void (*op_func)(), char * errstr, int maxe) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * keyword; Parameter keyword string (full) (R) int lenk; Length of keyword string (may be 0 if string is null terminated (R) int ichanged; If 0 print parameter anyway, if 1-16, only create output parameter value string if parameter changed flag set for that parameter. (R) int ireduce; =0 output all values for all sets & subsets =1 reduce output where feasible by recombining values if all the same for a set etc. =2 as for 1 but suppress default values for non 'standard print' parameters =3 as for 1 but suppress default values for all parameters (ignored if (ichanged==1) (R) int ns; Current no. of sets (give -1 if this and the nos. of subsets/set values are to be determined internally from the parameters named via kdm_init) (R) int * nss; Array of current nos. of subsets in each set (at least nums values) - values ignored if ns = -1 (R) char * outstr; Returns the output string for printing (W) int maxo; if >0 Maximum length of returned output string allowed (excluding terminating null - outstr must be at least maxo + 1 characters in length); maxo should be at least 2050. if <0 abs(maxo) characters will be returned padded with blanks if needed (for 'fortran' use) (abs(maxo) should be at least 2050) (R) void (*op_func)(); Function to o/p the string; if NULL then o/p will be done to the standard output. If defined then this function will be called without parameters; the string 'outstr' will contain the required o/p and must be globally accessible to the output function together with any other special parameters required. If any keywords have a large number of values, then the output routine may wish to split the string into more than one record; if the output is to a parameter file which is subsequently to be read then all the records except the last one should be terminated with a '-' or '&' character to indicate continuation. (R) char *errstr; Returns an error string (W) int maxe; if >0 Maximum length of returned error string allowed (excluding terminating null - errstr must be at least maxe + 1 characters in length) if <0 abs(maxe) characters will be returned padded with blanks if needed (for 'fortran' use) (should allow 80 chars for error messages) (R) Return: Error flag = 0 no error = 1 error -end*/ { int ll; int i; int j; int k; int kk; int kkk; int ss; int done; int l; int lout; int found; int iclass; int maxlen; int nvals; int istat; int ityp; int ips; int ipss; int nv; int all_same; int nums; int * numss; int iret; int pr_default; int pr_std; KDM_int_par * idp; KDM_int_par * idps; KDM_int_par * idpss; KDM_float_par * fdp; KDM_str_par * sdp; KDM_varr_par * vdp; KDM_keyword_set * keyset; KDM_parlist * parlist; char fmt[21]; char tmp[51]; char tmpstr[MAXVLENGTH+1]; char str[MAXVLENGTH+1]; char linout[MAXVLENGTH+1]; char name[MAX_NAME_LEN+1]; int maxv; kdm_copy_chars (" ", 0, errstr, maxe); iret = 0; maxv = MAXVLENGTH; maxlen = maxo; if (maxlen<0) maxlen = -maxlen; if (op_func==0&&maxlen<0) maxlen = -maxlen; if (init<=0) { kdm_copy_chars ("KDM data not set up", 0, errstr, maxe); return 1; } if (kdx<0||kdx>=num_kdm_sets) { kdm_copy_chars ("KDM data set not initialised", 0, errstr, maxe); return 1; } if (ichanged<0||ichanged>16) { kdm_copy_chars ("Error in kdm_changed call", 0, errstr, maxe); return 1; } if (ichanged>0) ireduce = 0; keyset = &keyword_sets[kdx]; parlist = keyset->parlist; if (keyset->num_pars<1) { kdm_copy_chars ("No KDM parameters defined", 0, errstr, maxe); return 1; } numss = 0; numss = (int * ) malloc (keyset->max_sets*sizeof(int)); if (numss==0) { kdm_copy_chars ("Cannot allocate memory", 0, errstr, maxe); return 1; } if (ns<0) { /* Check that no. of sets & no. of subsets defined & of correct type */ if (!kdm_blank_string (keyset->name_nums, 0)) { i = kdm_checkpar (kdx, keyset->name_nums, 0, 0, 0, 0, tmp, 50, &ityp, &nv, &ips); if (i==1) { kdm_copy_chars ("No. of sets parameter not defined", 0,errstr, maxe); iret = 1; goto tidy; } if(ityp!=1) { kdm_copy_chars ("No. of sets parameter of wrong type", 0,errstr,maxe); iret = 1; goto tidy; } ips--; idps = (KDM_int_par *) parlist[ips].data; nums = idps->idata[0]; } else { nums = 1; } if (!kdm_blank_string (keyset->name_numss, 0)) { i = kdm_checkpar (kdx, keyset->name_numss, 0, 0, 0, 0, tmp, 50, &ityp, &nv, &ipss); if (i==1) { kdm_copy_chars("No. of subsets parameter not defined", 0,errstr,maxe); iret = 1; goto tidy; } if(ityp!=2) { kdm_copy_chars ("No. of subsets parameter of wrong type",0, errstr,maxe); iret = 1; goto tidy; } ipss --; idpss = (KDM_int_par *) parlist[ipss].data; for (i=0;iidata[i]; } else { for (i=0;inum_pars;++i) { if (ll==parlist[i].klen) { if (kdm_ncasecmp(parlist[i].name, keyword, ll)==0) {found=i; break;} } if (parlist[i].alen>0&&ll==parlist[i].alen) { if (kdm_ncasecmp(parlist[i].alias,keyword,ll)==0) {found=i; break;} } } if (found<0) { kdm_copy_chars ("Keyword not found", 0, errstr, maxe); iret = 1; goto tidy; } /* Keyword found */ if (parlist[found].use_alias) { strcpy (name, parlist[found].alias); } else { strcpy (name, parlist[found].name); } iclass = (parlist[found].type-1)%3 + 1; pr_std = parlist[found].pr_std; lout = 0; switch (iclass) { case 1: /* Dataset parameter */ if (ichanged>0) { if (kdm_changed(kdx, keyword, lenk, ichanged, 1, 1)==0) { iret = 0; goto tidy; } } kdm_getvalstr (kdx, keyword, lenk, 1, 1, maxv, tmpstr, &istat, &ityp, errstr, maxe); pr_default = 0; if (ireduce<2) pr_default = 1; if (ireduce==2&&pr_std==1) pr_default = 1; if (istat!=0||pr_default==1) { kdm_addstr (outstr, maxo, keyword, lenk, &lout); kdm_addstr (outstr, maxo, " ", 0, &lout); kdm_addstr (outstr, maxo, tmpstr, maxv, &lout); if (op_func) { op_func(); } else { printf ("%s\n",outstr); } } break; case 2: /* Set based parameters */ done = 0; if (ichanged==0&&ireduce!=0) { all_same = 1; switch (parlist[found].type) { case 2: /* Integer */ idp = (KDM_int_par *) parlist[found].data; all_same = 1; nvals = idp->num_vals; for (i=0;iidata[j*nvals+i]!=idp->idata[i])all_same=0; } } break; case 5: /* Float */ fdp = (KDM_float_par *) parlist[found].data; all_same = 1; nvals = fdp->num_vals; for (i=0;ifdata[j*nvals+i]!=fdp->fdata[i])all_same=0; } } break; case 8: /* String */ sdp = (KDM_str_par *) parlist[found].data; all_same = 1; for (j=0;jsdata[j],sdp->sdata[0])!=0) all_same=0; } break; case 11: /* Variable array */ vdp = (KDM_varr_par *) parlist[found].data; all_same = 1; nvals = vdp->num_vals; for (i=0;inum_inp[i]!=vdp->num_inp[0]) all_same = 0; } if (all_same) { for (i=0;inum_inp[0];++i) { for (j=0;jirtyp[i]==1) { if (vdp->idata[j*nvals+i]!=vdp->idata[i])all_same=0; } else { if (vdp->fdata[j*nvals+i]!=vdp->fdata[i])all_same=0; } } } } break; } if (all_same==1) { kdm_getvalstr (kdx, keyword, lenk, 1, 1, maxv, tmpstr, &istat, &ityp, errstr, maxe); pr_default = 0; if (ireduce<2) pr_default = 1; if (ireduce==2&&pr_std==1) pr_default = 1; if (istat!=0||pr_default==1) { kdm_addstr (outstr, maxo, keyword, lenk, &lout); kdm_addstr (outstr, maxo, " ", 0, &lout); kdm_addstr (outstr, maxo, tmpstr, maxv, &lout); if (op_func) { op_func(); } else { printf ("%s\n",outstr); } } done = 1; } } if (done==0) { /* All explicit, changed values or not all same values found */ linout[0] = 0; for (i=0;inum_vals; for (i=0;imax_subsets + k*nvals + i; if (idp->idata[kk]!=idp->idata[i])all_same=0; } } } break; case 6: /* Float */ fdp = (KDM_float_par *) parlist[found].data; all_same = 1; nvals = fdp->num_vals; for (i=0;imax_subsets + k*nvals + i; if (fdp->fdata[kk]!=fdp->fdata[i])all_same=0; } } } break; case 9: /* String */ sdp = (KDM_str_par *) parlist[found].data; all_same = 1; for (j=0;jmax_subsets + k; if (strcmp(sdp->sdata[kk],sdp->sdata[0])!=0) all_same=0; } } break; case 12: /* Variable array */ vdp = (KDM_varr_par *) parlist[found].data; all_same = 1; nvals = fdp->num_vals; for (i=0;inum_inp[i*keyset->max_subsets+j] !=vdp->num_inp[0]) all_same=0; } } if (all_same) { for (i=0;inum_inp[0];++i) { for (j=0;jmax_subsets + k*nvals + i; if (vdp->irtyp[i]==1) { if (vdp->idata[kk]!=vdp->idata[i])all_same=0; } else { if (vdp->fdata[kk]!=vdp->fdata[i])all_same=0; } } } } } break; } if (all_same==1) { kdm_getvalstr (kdx, keyword, lenk, 1, 1, maxv, tmpstr, &istat, &ityp, errstr, maxe); pr_default = 0; if (ireduce<2) pr_default = 1; if (ireduce==2&&pr_std==1) pr_default = 1; if (istat!=0||pr_default==1) { kdm_addstr (outstr, maxo, keyword, lenk, &lout); kdm_addstr (outstr, maxo, " ", 0, &lout); kdm_addstr (outstr, maxo, tmpstr, maxv, &lout); if (op_func) { op_func(); } else { printf ("%s\n",outstr); } } done = 1; } if (done==0) { /* See if same for all subsets within each set */ switch (parlist[found].type) { case 3: /* Integer */ idp = (KDM_int_par *) parlist[found].data; all_same = 1; nvals = idp->num_vals; for (i=0;imax_subsets + k*nvals + i; kkk = j*nvals*keyset->max_subsets + i; if (idp->idata[kk]!=idp->idata[kkk])all_same=0; } } } break; case 6: /* Float */ fdp = (KDM_float_par *) parlist[found].data; all_same = 1; nvals = fdp->num_vals; for (i=0;imax_subsets + k*nvals + i; kkk = j*nvals*keyset->max_subsets + i; if (fdp->fdata[kk]!=fdp->fdata[kkk])all_same=0; } } } break; case 9: /* String */ sdp = (KDM_str_par *) parlist[found].data; all_same = 1; for (j=0;jmax_subsets + k; kkk = j*keyset->max_subsets; if (strcmp(sdp->sdata[kkk],sdp->sdata[kk])!=0)all_same=0; } } break; case 12: /* Variable array */ vdp = (KDM_varr_par *) parlist[found].data; all_same = 1; nvals = vdp->num_vals; for (i=0;imax_subsets + j; kkk = i*keyset->max_subsets; if (vdp->num_inp[kk]!=vdp->num_inp[kkk]) all_same=0; } } if (all_same) { for (j=0;jnum_inp[j*keyset->max_subsets];++i) { for (k=0;kmax_subsets + k*nvals + i; kkk = j*nvals*keyset->max_subsets + i; if (vdp->irtyp[i]==1) { if (vdp->idata[kk]!=vdp->idata[kkk])all_same=0; } else { if (vdp->fdata[kk]!=vdp->fdata[kkk])all_same=0; } } } } } break; } if (all_same) { linout[0] = 0; for (i=0;inum_vals; for (i=0;imax_subsets + j*nvals + i; kk = j*nvals + i; if (idp->idata[kk]!=idp->idata[kkk])all_same=0; } } } break; case 6: /* Float */ fdp = (KDM_float_par *) parlist[found].data; all_same = 1; nvals = idp->num_vals; for (i=0;imax_subsets + j*nvals + i; kk = j*nvals + i; if (fdp->fdata[kk]!=fdp->fdata[kkk])all_same=0; } } } break; case 9: /* String */ sdp = (KDM_str_par *) parlist[found].data; all_same = 1; for (j=0;jmax_subsets + j; if(strcmp(sdp->sdata[kk],sdp->sdata[j])!=0) all_same=0; } } break; case 12: /* Variable array */ vdp = (KDM_varr_par *) parlist[found].data; all_same = 1; nvals = idp->num_vals; for (i=0;imax_subsets + i; kkk = i; if (vdp->num_inp[kk]!=vdp->num_inp[kkk]) all_same=0; } } if (all_same) { for (j=0;jnum_inp[k*keyset->max_subsets];++i) { kkk = k*nvals*keyset->max_subsets + j*nvals + i; kk = j*nvals + i; if (vdp->irtyp[i]==1) { if (vdp->idata[kk]!=vdp->idata[kkk])all_same=0; } else { if (vdp->fdata[kk]!=vdp->fdata[kkk])all_same=0; } } } } } break; } if (all_same) { linout[0] = 0; for (i=0;i0) max_err = -max_err; maxlen = -(*maxo); if (maxlen>0) maxlen = -maxlen; *ierr = kdm_output (*kdx, KDM_pointers[*keyword], *lenk, *ichanged, *ireduce, *ns, nss, KDM_pointers[*outstr], maxlen, op_func, KDM_pointers[*errstr], max_err); } /*-Section: Monitor KDM Parameter Changes Routines are available to assist with the monitoring of changes to KDM parameter values during the running of a program. The kdm_output (kdmf_output) routine, described in the previous section, is used to output such changed values when required. -end*/ /*-Routine: Reset parameter changed flags - kdm_ch_reset The routine kdm_ch_reset (kdmf_ch_reset) is used to reset (clear) parameter change monitoring flags for a requested channel or for all channels. -end*/ /* *************************** ** kdm_ch_reset ** *************************** Purpose: Reset (clear) parameter change monitoring flags for a requested channel or for all channels. Author: John W. Campbell, June 1995 CD-Fortran: CALL KDMF_CH_RESET (KDX, ICHAN, IERR) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT ICHAN i (R) Channel number for reset (1-16), 0 = all channels IERR i (W) Error flag as returned kdm_ch_reset call -end*/ /*-C:*/ int kdm_ch_reset (int kdx, int ichan) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) int ichan; Channel number for reset (1-16), 0 = all channels (R) Return: Error flag = 0 no error = 1 error in call parameter -end*/ { int kmask; int i; int j; int n; int iclass; KDM_int_par * idp; KDM_float_par * fdp; KDM_str_par * sdp; KDM_varr_par * vdp; KDM_keyword_set * keyset; KDM_parlist * parlist; if (ichan<0||ichan>16) return 1; if (ichan==0) { kmask = 0; } else { kmask = ~(1<<(ichan-1)); } keyset = &keyword_sets[kdx]; parlist = keyset->parlist; if (keyset->num_pars==0) return 0; if (kdx<0||kdx>=num_kdm_sets) return 0; for(i=0;inum_pars;++i) { iclass = (parlist[i].type-1)%3 + 1; switch (parlist[i].type) { case 1: case 2: case 3: /* Integer value cases */ idp = (KDM_int_par *) parlist[i].data; n = 1; if (iclass==2) n = keyset->max_sets; if (iclass==3) n = keyset->max_sets*keyset->max_subsets; for(j=0;jch_flags[j] &= kmask; break; case 4: case 5: case 6: /* Float value cases */ fdp = (KDM_float_par *) parlist[i].data; n = 1; if (iclass==2) n = keyset->max_sets; if (iclass==3) n = keyset->max_sets*keyset->max_subsets; for(j=0;jch_flags[j] &= kmask; break; case 7: case 8: case 9: /* String value cases */ sdp = (KDM_str_par *) parlist[i].data; n = 1; if (iclass==2) n = keyset->max_sets; if (iclass==3) n = keyset->max_sets*keyset->max_subsets; for(j=0;jch_flags[j] &= kmask; break; case 10: case 11: case 12: /* Variable array value cases */ vdp = (KDM_varr_par *) parlist[i].data; n = 1; if (iclass==2) n = keyset->max_sets; if (iclass==3) n = keyset->max_sets*keyset->max_subsets; for(j=0;jch_flags[j] &= kmask; break; } } return 0; } /* Fortran binding: kdmf_ch_reset */ void kdmf_ch_reset (kdx, ichan, ierr) int *kdx, *ichan, *ierr; { *ierr = kdm_ch_reset (*kdx, *ichan); } /*-Routine: See if any parameter changed - kdm_any_ch The routine kdm_any_ch (kdmf_any_ch) is used to test whether any parameter value has been changed for a requested channel or for all channels. -end*/ /* *************************** ** kdm_any_ch ** *************************** Purpose: See if any parameter has been changed for a requested channel no. Author: John W. Campbell, June 1995 CD-Fortran: CALL KDMF_ANY_CH (KDX, ICHAN, IFLAG) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT. ICHAN i (R) Channel number for test (1-16), 0 = all channels. IFLAG i (W) Flag as returned kdm_any_ch call; 0 = no change or error in call, 1 = parameter changed. -end*/ /*-C:*/ int kdm_any_ch (int kdx, int ichan) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) int ichan; Channel number for test (1-16), 0 = all channels (R) Return: Error flag = 0 no change or error in call parameter = 1 parameter changed -end*/ { int kmask; int i; int j; int n; int iclass; KDM_int_par * idp; KDM_float_par * fdp; KDM_str_par * sdp; KDM_varr_par * vdp; KDM_keyword_set * keyset; KDM_parlist * parlist; if (ichan<0||ichan>16) return 0; if (kdx<0||kdx>=num_kdm_sets) return 0; if (ichan==0) { kmask = 0xffff; } else { kmask = 1<<(ichan-1); } keyset = &keyword_sets[kdx]; parlist = keyset->parlist; if (keyset->num_pars==0) return 0; for(i=0;inum_pars;++i) { iclass = (parlist[i].type-1)%3 + 1; switch (parlist[i].type) { case 1: case 2: case 3: /* Integer value cases */ idp = (KDM_int_par *) parlist[i].data; n = 1; if (iclass==2) n = keyset->max_sets; if (iclass==3) n = keyset->max_sets*keyset->max_subsets; for(j=0;jch_flags[j] & kmask) return 1; break; case 4: case 5: case 6: /* Float value cases */ fdp = (KDM_float_par *) parlist[i].data; n = 1; if (iclass==2) n = keyset->max_sets; if (iclass==3) n = keyset->max_sets*keyset->max_subsets; for(j=0;jch_flags[j] & kmask) return 1; break; case 7: case 8: case 9: /* String value cases */ sdp = (KDM_str_par *) parlist[i].data; n = 1; if (iclass==2) n = keyset->max_sets; if (iclass==3) n = keyset->max_sets*keyset->max_subsets; for(j=0;jch_flags[j] & kmask) return 1; break; case 10: case 11: case 12: /* Variable array value cases */ vdp = (KDM_varr_par *) parlist[i].data; n = 1; if (iclass==2) n = keyset->max_sets; if (iclass==3) n = keyset->max_sets*keyset->max_subsets; for(j=0;jch_flags[j] & kmask) return 1; break; } } return 0; } /* Fortran binding: kdmf_any_ch */ void kdmf_any_ch (kdx, ichan, iflag) int *kdx, *ichan, *iflag; { *iflag = kdm_any_ch (*kdx, *ichan); } /*-Routine: See if a KDM parameter changed - kdm_changed The routine kdm_changed (kdmf_changed) is used to test whether any parameter value has been changed for a requested channel. -end*/ /* *************************** ** kdm_changed ** *************************** Purpose: See if a KDM parameter has been changed for a requested channel no. Author: John W. Campbell, June 1995 CD-Fortran: CALL KDMF_CHANGED (KDX, KDMSTR(KEYWORD), LENK, ICHAN, ISET, + ISUBSET, IFLAG) CD-end: */ /*-Parameters: KDX i (R) Index to keyword set as returned by KDMF_INIT. KEYWORD c (R) Parameter name (full) character string ** Pass address index using the KDMSTR function ** LENK i (R) Length of keyword ICHAN i (R) Channel number for test (1-16) ISET i (R) Set number (from 1 up) - ignored for dataset type parameter ISUBSET i (R) Subset number (from 1 up) - ignored for dataset type or set type parameter IFLAG i (W) Flag as returned kdm_any_ch call; 0 = no change or error in call, 1 = parameter changed. -end*/ /*-C:*/ int kdm_changed (int kdx, char * keyword, int lenk, int ichan, int iset, int isubset) /*end*/ /*-Parameters: int kdx; Index to keyword set as returned by kdm_init (R) char * keyword; Parameter keyword string (full) (R) int lenk; Length of keyword string (may be 0 if string is null terminated (R) int ichan; Channel number for test (1-16)(R) int iset; Set number (from 1 up) - ignored for dataset type parameter (R) int isubset; Subset number (from 1 up) - ignored for dataset type or set type parameter (R) Return: Error flag = 0 no change or error in call parameter = 1 parameter changed -end*/ { int kmask; int i; int j; int n; int iclass; int ll; int found; KDM_int_par * idp; KDM_float_par * fdp; KDM_str_par * sdp; KDM_varr_par * vdp; KDM_keyword_set * keyset; KDM_parlist * parlist; if (ichan<1||ichan>16) return 0; if (kdx<0||kdx>=num_kdm_sets) return 0; kmask = 1<<(ichan-1); keyset = &keyword_sets[kdx]; parlist = keyset->parlist; if (keyset->num_pars==0) return 0; /* Search for keyword */ ll = lenk; if (ll<=0) ll = strlen(keyword); found = -1; for (i=0;inum_pars;++i) { if (ll==parlist[i].klen) { if (kdm_ncasecmp(parlist[i].name, keyword, ll)==0) {found=i; break;} } if (parlist[i].alen>0&&ll==parlist[i].alen) { if (kdm_ncasecmp(parlist[i].alias,keyword,ll)==0) {found=i; break;} } } if (found<0) return 0; iclass = (parlist[found].type-1)%3 + 1; if (iclass>1&&(iset<1||iset>keyset->max_sets)) return 0; if (iclass>2&&(isubset<1||isubset>keyset->max_subsets)) return 0; n = 0; if (iclass==2) n = iset-1; if (iclass==3) n = (iset-1)*keyset->max_subsets + isubset - 1; switch (parlist[found].type) { case 1: case 2: case 3: /* Integer value cases */ idp = (KDM_int_par *) parlist[found].data; if (idp->ch_flags[n] & kmask) return 1; break; case 4: case 5: case 6: /* Float value cases */ fdp = (KDM_float_par *) parlist[found].data; if (fdp->ch_flags[n] & kmask) return 1; break; case 7: case 8: case 9: /* String value cases */ sdp = (KDM_str_par *) parlist[found].data; if (sdp->ch_flags[n] & kmask) return 1; break; case 10: case 11: case 12: /* Variable array value cases */ vdp = (KDM_varr_par *) parlist[found].data; if (vdp->ch_flags[n] & kmask) return 1; break; } return 0; } /* Fortran binding: kdmf_changed */ void kdmf_changed (kdx, keyword, lenk, ichan, iset, isubset, iflag) int *kdx, *keyword, *lenk, *ichan, *iset, *isubset, *iflag; { *iflag = kdm_changed (*kdx, KDM_pointers[*keyword], *lenk, *ichan, *iset, *isubset); } /*-Section: Routines for User Supplied Functions Some routines are avaiable to enable certain data items to be accessed within user supplied functions for parameter value checking. -end*/ /*-Routine: Get string parameter value for checking - kdm_strval The routine kdm_strval (kdmf_strval) is used to get the string to be checked from within a user supplied checking function for a string type parameter. -end*/ /* *********************** ** kdm_strval ** *********************** Purpose: Get string parameter value string within the checking function 'chk_func' for a string type keyword parameter. Author: John W. Campbell, June 1995 CD-Fortran: CALL KDMF_STRVAL (VALSTR, MAXL) CD-end: */ /*-Parameters: VALSTR c (W) Returns the value string ** Pass address index using the KDMSTR function ** MAXL i (R) Maximum length allowed for the string (must be at least MAXLEN characters long) -end*/ /*-C:*/ void kdm_strval (char * valstr, int maxl) /*end*/ /*-Parameters: char * valstr; Returns the value string (W) int maxl; if >0 Maximum length of returned string allowed (excluding terminating null - string must be at least maxl + 1 characters in length) if <0 abs(maxl) characters will be returned padded with blanks if needed (for 'fortran' use) (R) Return: None -end*/ { kdm_copy_chars (KDM_strval_str, KDM_strval_len, valstr, maxl); return; } /* Fortran binding: kdmf_strval */ void kdmf_strval (valstr, maxl) int *valstr, *maxl; { int max_len; max_len = -(*maxl); if (max_len>0) max_len = -max_len; kdm_strval (KDM_pointers[*valstr], max_len); return; } /*-Routine: Set parameter check error string - kdm_set_chkerr The routine kdm_set_chkerr (kdmf_set_chkerr) is used to set the error string from within a user supplied parameter value checking routine when an error in the parameter value is found. The error string set will be returned via a kdm_setvalue (kdmf_setvalue) routine call. -end*/ /* ************************* ** kdm_set_chkerr ** ************************* Purpose: Set error return string within a chk_func (CHKFUN) routine Author: John W. Campbell, December 1995 CD-Fortran: CALL KDMF_SET_CHKERR (KDMSTR(ERRSTR), LERR) CD-end: */ /*-Parameters: ERRSTR c (R) The error string ** Pass address index using the KDMSTR function ** LERR i (R) Length of the string -end*/ /*-C:*/ void kdm_set_chkerr (char * errstr, int lerr) /*end*/ /*-Parameters: char * errstr; Error string (R) int lerr; Length of error string; may be 0 if null terminated (R) Return: None -end*/ { int l; l = lerr; if (l<=0) l = strlen(errstr); KDM_chk_errstr[0] = 0; strncat (KDM_chk_errstr, errstr, l); return; } /* Fortran binding: kdmf_set_chkerr */ void kdmf_set_chkerr (errstr, lerr) int *errstr, *lerr; { int max_len; max_len = -(*lerr); if (max_len>0) max_len = -max_len; kdm_set_chkerr (KDM_pointers[*errstr], max_len); return; } /* *************************** ** kdm_next_field ** *************************** Purpose: Get next field from a character string Return: No. of characters in the string; = 0 absent field =-1 end of string =-2 no characters in separator string Author: John W. Campbell, June 1995 **** KDM SERVICE ROUTINE ONLY **** */ int kdm_next_field (char * text, int lent, char * sep, int * p1, int *p2, int *lc) /* char *text; Null terminated input text string (R)*/ /* int lent; Length of text string; may be 0 if string is null terminated (R)*/ /* char *sep; String containing field separator characters (null terminated). If first character is a space then white space or spaces + one other character is treated as a single separator and leading white space is ignored. (R)*/ /* int *p1; Offset in 'text' of start of field (-1 if empty/absent) (W)*/ /* int *p2; Offset in 'text' of end of field (-1 if empty/absent) (W)*/ /* int *lc; Last character offset position for previous field (including terminating character where relevant). This must be set to -1 on the initial call to get the first field and then passed unchanged to the routine on successive calls to get subsequent fields (R/W)*/ { int lmax; int minsep; int maxsep; int sp; int n; int nc; int ll; *p1 = -1; *p2 = -1; ll = lent; if (ll<=0) ll = strlen(text); lmax = ll - 1; if (lmax<0) return -1; minsep = 0; maxsep = strlen(sep) - 1; if (maxsep<0) return -2; sp = 0; if (sep[0]==' ') {sp = 1; minsep++;} if (*lc<0) *lc = -1; labl1: *lc += 1; if (*lc>lmax) return -1; if (sp==1&&text[*lc]==' ') goto labl1; if (minsep<=maxsep) { for (n=minsep;n<=maxsep;++n) if (text[*lc]==sep[n]) return 0; } *p1 = *lc; labl2: *p2 = *lc; *lc += 1; if (*lc>lmax) goto labl4; for (n=0;n<=maxsep;++n) if (text[*lc]==sep[n]) goto labl3; goto labl2; labl3: if (sp==0||text[*lc]!=' ') goto labl4; *lc += 1; if (*lc>lmax) goto labl4; if (text[*lc]==' ') goto labl3; if (minsep<=maxsep) { for (n=minsep;n<=maxsep;++n) if (text[*lc]==sep[n]) goto labl4; } *lc -= 1; labl4: nc = *p2 - *p1 + 1; if (*lc>lmax) *lc = lmax; return nc; } /* *************************** ** kdm_next_int ** *************************** Purpose: Get next field from a character string and decode it as an integer value Return: = 0 OK integer = 1 syntax error = 2 field too long to decode as an integer =-1 end of string =-2 no characters in separator string Author: John W. Campbell, June 1995 **** KDM SERVICE ROUTINE ONLY **** */ int kdm_next_int (char * text, int lent, char * sep, int * ival, int *lc) /* char *text; Null terminated input text string (R)*/ /* int lent; Length of text string; may be 0 if string is null terminated (R)*/ /* char *sep; String containing field separator characters (null terminated). If first character is a space then white space or spaces + one other character is treated as a single separator and leading white space is ignored. (R)*/ /* int *ival; Returns the integer value (0 if blank field or error) (W)*/ /* int *lc; Last character offset position for previous field (including terminating character where relevant). This must be set to -1 on the initial call to get the first field and then passed unchanged to the routine on successive calls to get subsequent fields (R/W)*/ { int i; int nc; int p1; int p2; int j; char tmpstr[51]; *ival = 0; nc = kdm_next_field (text, lent, sep, &p1, &p2, lc); if (nc<=0) return nc; if (nc>50) return 2; tmpstr[0] = 0; strncat (tmpstr, &text[p1], nc); for (j=0;j50) return 2; tmpstr[0] = 0; strncat (tmpstr, &text[p1], nc); for (j=0;j0) { dec = 0; for (i=0;i=MAXPOINTERS) KDM_pointers_index = 0; KDM_pointers[KDM_pointers_index] = ch; return KDM_pointers_index; } #endif #if CHAR_STRING_TYPE == 2 typedef struct { short int len; unsigned char type; unsigned char class; char * addr; } Vax_ch_desc; int kdmstr (ch_desc) Vax_ch_desc *ch_desc; /* Pointer to character descriptor (R)*/ { KDM_pointers_index++; if (KDM_pointers_index>=MAXPOINTERS) KDM_pointers_index = 0; KDM_pointers[KDM_pointers_index] = ch_desc->addr; return KDM_pointers_index; } #endif /*-Section: 'C' Routines to Read KDM Data A routine is available to read lines of keyworded data from a file, accessing indirect file references if present. An alternative routine will allow similar processing from a string again, following indirect file references if present. -end*/ /*-Routine: Read Line of Data from a File - kdm_readline This routine will return, on repeated calls, the next logical line of data read from a parameters file. Any indirectly referenced parameter files will be read as required. The logical line returned will contain any continuation lines present but will exclude any comments found. -end*/ /* *************************** ** kdm_readline ** *************************** Purpose: Read next logical line from a KDM parameters/control file Author: John W. Campbell, November 1997 */ /*-C:*/ int kdm_readline (FILE * fp_in, int * indirect, char * line, int maxlen) /*end*/ /*-Parameters: FILE * fp_in; File pointer for file being read (R) int * indirect; Current indirection level. MUST be set to 0 on first call to read the file and subsequently must give the previously returned value. User should ensure that the program repeats calls to the routine until kdm+readline is returned as -1 (end of file) or 'indirect' is returned as 0 (otherwise files will be left open) (R/W) char * line; Returns the next logical line with comments removed and with all continuation lines concatenated (null terminated). Length must be at least maxlen+1. (W) int maxlen; Maximum number of characters which may be returned in 'line' (R) Return: Error/End-of-file flag =0 No error, line read; =-1 End of file = 1 'line' too short, data truncated = 2 Error opening indirect file = 3 Maximum allowed level of indirection exceeded = 4 Calling error (invalid 'indirect' value) -end*/ { FILE *fp; int i; int ll; int ncat; int lcur; int il; int l; char * eof; int cont; int trunc; char lin[MAX_LEN+1]; char filnam[MAX_LEN+1]; static char sep[] = {' ',9,',','=',0}; int p1, p2; line[0] = 0; eof = 0; cont = 0; trunc = 0; /* Get required stream */ next_read: if (*indirect<=0) { *indirect = 0; fp = fp_in; } else { if (*indirect>MAX_INDIRECT) return 4; fp = fp_indirect[*indirect-1]; } eof = fgets (lin, MAX_LEN+1, fp); if (eof==0) { if (*indirect>0) { fclose (fp_indirect[*indirect-1]); *indirect -= 1; goto next_read; } else { return -1; } } ll = strlen (lin); if (lin[ll-1]=='\n')lin[ll-1]=0; /* Line read - remove any comments */ ll = strlen (lin); if (ll>0) { for (l=0;l0) { if (lin[p1]=='@') { if (p2==p1) { i = kdm_next_field (lin, 0, sep, &p1, &p2, &il); if (i<=0) { if (*indirect>0) { for (i=0;i<*indirect;++i) fclose (fp_indirect[i]); *indirect = 0; goto next_read; } } } else { p1++; } if (*indirect>=MAX_INDIRECT) { if (*indirect>0) for (i=0;i<*indirect;++i) fclose (fp_indirect[i]); *indirect = 0; return 3; } else { *indirect += 1; filnam[0] = 0; strncat(filnam,&lin[p1], p2-p1+1); fp = fopen (filnam, "r"); fp_indirect[*indirect-1] = fp; if (fp==0) { *indirect = *indirect - 1; if (*indirect>0) for (i=0;i<*indirect;++i) fclose (fp_indirect[i]); *indirect = 0; return 2; } goto next_read; } } } /* Test for continuation character */ cont = 0; ll = strlen(lin); if (ll>0) { for (i=ll-1;i>=0;--i) { if (lin[i]!=' ') { if (lin[i]=='-'||lin[i]=='&') { lin[i]=' '; cont = 1; } break; } } } /* Add string to line */ kdm_chop_end_blanks (lin); ll = strlen(lin); if (line[0]==0) { ncat = ll; if (ncat>maxlen) { trunc = 1; ncat = maxlen; } strncat (line, lin, ncat); } else { lcur = strlen(line); ncat = ll; if (lcur+ncat+1>maxlen) { trunc = 1; ncat = maxlen - lcur - 1; } strcat (line," "); if (ncat>0) strncat (line, lin, ncat); } if (cont) goto next_read; /* Next logical line now complete */ if (trunc) return 1; return 0; } /*-Routine: Handle Indirect File References in a String - kdm_readstr This routine is similar to 'kdm_readline' in its handling of indirect files. The difference is that the line for examination is passed to the routine rather than being read from a top level parameter file. -end*/ /* ************************** ** kdm_readstr ** ************************** Purpose: Read next logical line from a KDM parameters/control file Author: John W. Campbell, November 1997 */ /*-C:*/ int kdm_readstr (char * line, int maxlen, int *indirect, int *iflag) /*end*/ /*-Parameters: char * line; On input is the line to be decoded for indirect file specification. The string should not contain comment or continuation characters and, if an indirect file specification is used, then it should only contain that specification. On output is the next line read from an indirect file (or the original line if no indirection found (or blank if the input line contained '@' only) (R/W) int maxlen; Maximum number of characters which may be returned in 'line' (R) int * indirect; Current indirection level. MUST be set to 0 on first call to read the file and subsequently must give the previously returned value. User should ensure that the program repeats calls to the routine until kdm+readline is returned as -1 (end of file) or 'indirect' is returned as 0 (otherwise files will be left open) (R/W) int *iflag Flag = 0, if first call and string does not contain an indirect file specification. 'LINE' is returned as input. = 1, Line read from indirect file =-1, End of indirect data reached (W) Return: Error/End-of-file flag = 0 No error, line read = 1 'line' too short, data truncated = 2 Error opening indirect file = 3 Maximum allowed level of indirection exceeded = 4 Calling error (invalid 'indirect' value) -end*/ { FILE *fp; int i; int ll; int ncat; int lcur; int il; int l; char * eof; int cont; int trunc; char lin[MAX_LEN+1]; char filnam[MAX_LEN+1]; static char sep[] = {' ',9,',','=',0}; int p1, p2; *iflag = 0; eof = 0; cont = 0; /* Check on indirection on initial call */ if (*indirect<=0) { il = -1; i = kdm_next_field (lin, 0, sep, &p1, &p2, &il); if (i<=0) return 0; if (line[p1]!='@') return 0; } /* Further initialisations */ trunc = 0; strcpy (lin, line); line[0] = 0; /* Get required stream */ next_read: if (*indirect<=0) { *indirect = 0; fp = 0; } else { if (*indirect>MAX_INDIRECT) return 4; fp = fp_indirect[*indirect-1]; } if (fp!=0) { eof = fgets (lin, MAX_LEN+1, fp); if (eof==0) { fclose (fp_indirect[*indirect-1]); *indirect -= 1; if (*indirect==0) { *iflag = -1; return 0; } else { goto next_read; } } /* Line read - remove any comments */ *iflag = 1; ll = strlen (lin); if (ll>0) { for (l=0;l0) { if (lin[p1]=='@') { if (p2==p1) { i = kdm_next_field (lin, 0, sep, &p1, &p2, &il); if (i<=0) { if (*indirect>0) { for (i=0;i<*indirect;++i) fclose (fp_indirect[i]); *indirect = 0; line[0] = 0; *iflag = -1; return 0; } } } else { p1++; } if (*indirect>=MAX_INDIRECT) { if (*indirect>0) for (i=0;i<*indirect;++i) fclose (fp_indirect[i]); *indirect = 0; *iflag = -1; return 3; } else { *indirect += 1; filnam[0] = 0; strncat(filnam,&lin[p1], p2-p1+1); fp = fopen (filnam, "r"); fp_indirect[*indirect-1] = fp; if (fp==0) { *indirect = *indirect - 1; if (*indirect>0) for (i=0;i<*indirect;++i) fclose (fp_indirect[i]); *indirect = 0; *iflag = -1; return 2; } goto next_read; } } } /* Test for continuation character */ cont = 0; ll = strlen(lin); if (ll>0) { for (i=ll-1;i>=0;--i) { if (lin[i]=='-'||lin[i]=='&') { lin[i]=' '; cont = 1; break; } } } /* Add string to line */ kdm_chop_end_blanks (lin); ll = strlen(lin); if (line[0]==0) { ncat = ll; if (ncat>maxlen) { trunc = 1; ncat = maxlen; } strncat (line, lin, ncat); } else { lcur = strlen(line); ncat = ll; if (lcur+ncat+1>maxlen) { trunc = 1; ncat = maxlen - lcur - 1; } if (ncat>0) strncat (line, lin, ncat); } if (cont) goto next_read; /* Next logical line now complete */ if (trunc) return 1; return 0; } /*-Section: 'C' Routines to Parse 'KDM' Keyworded Data A routine is available to examine input lines for the presece of KDM data; if such data are found, the data will be checked for validity and stored in the Keyword Data Module. Any non-KDM data lines will be returned to the calling program for interpretation by that program and thus both KDM and other control or parameters data may be included in the file being read. Another routine parses the keyword string to determine any set/subset specification. -end*/ /*-Routine: Parse KDM Data with Checking - kdm_parsekdm This routine parses a given line of data, examining it for the presence of a requested set of KDM data. Any such data found is automatically checked and, if valid, stored in the appropriate Keyword Data Module. If the line does not contain KDM data from the requested set, then it is merely passed back to the calling program to allow further interpretation by that program. KDM and non-KDM data (or data items from different KDM sets) must not be given in the same line of data and a line of data containing any valid KDM keyword for the KDM set being examined will be assumed to be a KDM parameter line. The calling program should also take account of the fact that incorrectly specified KDM keyords may result in the line being returned to the calling program. A user supplied routine may make an additional check on each KDM parameter and disable its update if desired. -end*/ /* *************************** ** kdm_parsekdm ** *************************** Purpose: Parse line for KDM data and store any found Author: John W. Campbell, November 1997 */ /*-C:*/ int kdm_parsekdm (int kdx, char * line, int (*chk_func)(), char * badtok, int maxb, char * errstr, int maxe) /*end*/ /*-Parameters: int kdx; Index to required KDM data set. (R) char * line; Character string containing line to be parsed (Assume comments & continuations already removed) int (*chk_func)(); Function to make additional check on KDM parameters to restrict updates (or return other information to calling program about the parameters found via common blocks) The call will be as follows: ok = chk_func(keyword) char * keyword; Variable holding the full name of the KDM parameter. Return 1 if parameter may be updated or 0 if it may not. (R) char * badtok; Returns the bad token string - must be at least maxb+1 characters long (W) int maxb; Maximum length for bad token string (R) char * errstr; Error string ( max 80 characters) - must be at least maxe+1 characters long (W) int maxe; Maximum length for error string (R) Return = 0, KDM data found & OK = 1, Not KDM data = 2, No non-blank tokens of requested set < 0, KDM data but error(s) =-1, Invalid or inappropriate set specification =-2, Invalid or inappropriate subset specification =-3, Syntax error in set/subset specification =-4, Invalid value =-5, Non-KDM data mixed with KDM data (Possibly miss-spelt keyword) -100, Coding error in KWD routines, information supposedly already checked is found later to be invalid! -end*/ { int iflag; int i; int err; int il; int ii; int ll; int p1, p2; int ival[2]; int iset; int isubset; int iss; int ncat; int iok; int ityp; int ipar; int nvals; int pdum; float fval[2]; char keyword[MAX_NAME_LEN+1]; char name[MAX_NAME_LEN+1]; char tmpstr[MAX_LEN+1]; char valstr[MAXVLENGTH+1]; static char sep[] = {' ',9,',','=',0}; err = 0; iflag = 2; badtok[0] = 0; errstr[0] = 0; il = -1; ll = strlen(line); /* Get next token */ next_token: i = kdm_next_field (line, 0, sep, &p1, &p2, &il); if (i==-1) return iflag; if (i==0) goto next_token; tmpstr[0] = 0; strncat (tmpstr, &line[p1], p2-p1+1); err = kdm_parseitem (tmpstr, keyword, &iset, &isubset, &iss); if (err==0) err = kdm_checkpar (kdx, keyword, 0, iset, isubset, iss, name, MAX_NAME_LEN, &ityp, &nvals, &ipar); if (chk_func!=0) { iok = chk_func(name); } else { iok = 1; } if (err<=0) { iflag = 0; if (err<0) { ncat = p2-p1+1; if (ncat>maxb) ncat = maxb; if (ncat>0) strncat(badtok, &line[p1], ncat); iflag = err; tmpstr[0] = 0; if (err==-1) strcpy (tmpstr, "Invalid or inappropriate set specification"); if (err==-2) strcpy (tmpstr, "Invalid or inappropriate subset specification"); if (err==-3) strcpy (tmpstr, "Syntax error in set/subset specification"); ncat = strlen (tmpstr); if (ncat>maxe) ncat = maxe; if (ncat>0) strncat(errstr, tmpstr, ncat); return iflag; } i = kdm_next_field (line, 0, sep, &p1, &p2, &il); if (i<=0) { if(iok) { err = kdm_reset (kdx, keyword, 0, iset, isubset, errstr, maxe); if (err<0) { iflag = err; if (err==-3) iflag = -100; return iflag; } } if (i<0) return iflag; } else { if (ityp>9) { p2 = ll-1; il = ll-1; } if (ityp<7&&nvals>1) { for (ii=2;ii<=nvals;++ii) { i = kdm_next_field (line, 0, sep, &pdum, &p2, &il); if (i<=0) { iflag = -4; strcpy (tmpstr, "Too few values given for the parameter"); ncat = strlen (tmpstr); if (ncat>maxe) ncat = maxe; if (ncat>0) strncat(errstr, tmpstr, ncat); return iflag; } } } if (iok) { valstr[0] = 0; strncat (valstr, &line[p1], p2-p1+1); err = kdm_setvalue (kdx, name, 0, iset, isubset, valstr, 0, ival, fval, 0, errstr, maxe); } if (err>0) { ncat = p2-p1+1; if (ncat>maxb) ncat = maxb; if (ncat>0) strncat(badtok, &line[p1], ncat); iflag = -4; return iflag; } } } else { if (iflag==0) { ncat = p2-p1+1; if (ncat>maxb) ncat = maxb; if (ncat>0) strncat(badtok, &line[p1], ncat); iflag = -5; strcpy (tmpstr, "Mixed KDM and non-KDM data"); ncat = strlen (tmpstr); if (ncat>maxe) ncat = maxe; if (ncat>0) strncat(errstr, tmpstr, ncat); return iflag; } else { iflag = 1; return iflag; } } goto next_token; } /*-Routine: Parse a Keyword Item - kdm_parseitem This routine is used by the higher level parsing routine described above but may be called by the user if required. It examines a given keyword string and determines any set/subset specifications attached to the keyword. -end*/ /* *************************** ** kdm_parseitem ** *************************** Purpose: Examine keyword & find pack/plate specification if present Author: John W. Campbell, November 1997 */ /*-C:*/ int kdm_parseitem (char * str, char * keyword, int * iset, int * isubset, int * iss) /*end*/ /*-Parameters: char * str; String containing the keyword string to be examined (R) char * keyword; Returns the keyword name without any attached set/subset specification (W) int * iset; Returns set specification if present (W) int *isubset; Returns subset specification if present (W) int * iss; =0 keyword only present, =1 keyword + set specification present, =2 keyword + subset specification present (W) Return Error flag = 0 OK = 1 blank keyword =-3 Syntax error in set/subset specification -end*/ { int err; int il; int nc; int i; int p1, p2; char * p; static char sepbr[] = {'[','(',0}; static char digits[] = {'0','1','2','3','4','5','6','7','8','9',0}; err = 0; keyword[0] = 0; *iset = 0; *isubset = 0; *iss = 0; /* Get name part of the parameter name token */ il = -1; nc = kdm_next_field (str, 0, sepbr, &p1, &p2, &il); if (nc<1) { err = 1; return err; } strncat (keyword, &str[p1], p2-p1+1); /* Check set/subset fields */ /* First set field */ nc = kdm_next_field (str, 0, sepbr, &p1, &p2, &il); if (nc<=0) return err; *iss += 1; if (str[p2]!=']'&&str[p2]!=')') { err = 1; return err; } if (nc>1) { *iset = 0; for (i=p1;i<=p2-1;++i) { p = strchr (digits, str[i]); if (p==0) { err = -3; *iset = 0; return err; } *iset = 10*(*iset) + p - digits; } } /* Now subset field */ nc = kdm_next_field (str, 0, sepbr, &p1, &p2, &il); if (nc<=0) return err; *iss += 1; if (str[p2]!=']'&&str[p2]!=')') { err = -3; return err; } if (nc>1) { *isubset = 0; for (i=p1;i<=p2-1;++i) { p = strchr (digits, str[i]); if (p==0) { err = -3; *isubset = 0; return err; } *isubset = 10*(*isubset) + p - digits; } } /* Check that no trailing junk */ nc = kdm_next_field (str, 0, sepbr, &p1, &p2, &il); if (nc>0) err = 1; return err; } /*-Section: 'C' Routine to Write KDM Data A routine is available to write out, with various options, the Keyword Data Module (KDM) keyworded parameter data. -end*/ /*-Routine: Output a KDM data set - kdm_writekdm C This routine is used to output a KDM keyword parameter data set. A number C of options are available to control the amount and style of the output C and there is also an option to output only changed KDM parameter values. -end*/ /* ************************* ** kdm_writekdm ** ************************* Purpose: Write out KDM data Author: John W. Campbell, November 1997 Note: Sets globals output_str, fpout */ /*-C:*/ int kdm_writekdm (int kdx, FILE * fp, int ioptyp, int ichanged) /*end*/ /*-Parameters: int kdx; Index to required KDM dataset (R) FILE *fp; The output file stream (R) int ioptyp; Type of output = 1 minimum, do not o/p parameters with default values = 2 standard output, do not o/p parameters with default values except for those which have been flagged to be printed as standard. = 3 full (all parameters will be included) but with reduced output where feasible by recombining values if all the same for a set etc. = 4 all pamaeters and individual values given explicitly for all set/subset parameters. (R) int ichanged; = 0 Output all parameters = 1-16 Write changed parameter values since last reset of flag for channel 'ichanged' (R) Return 0 OK 1 Invalid KDM index or invalid parameter -end*/ { int err; int ireduce; int nump; int ip; char keyword[MAX_NAME_LEN+1]; char errstr[3]; int nss[2]; fpout = fp; if (ichanged<0||ichanged>16) return 1; if (ioptyp<1||ioptyp>4) return 1; ireduce = 0; if (ioptyp==3) ireduce = 1; if (ioptyp==2) ireduce = 2; if (ioptyp==1) ireduce = 3; err = kdm_numpars(kdx, &nump); if (err!=0) return 1; if (nump<=0) return 1; for (ip=1;ip<=nump;++ip) { err = kdm_parname(kdx, ip, keyword, MAX_NAME_LEN); if (err!=0) continue; kdm_output (kdx, keyword, 0, ichanged, ireduce, -1, nss, output_str, 2050, kdm_opfun, errstr, 2); } return 0; } /* ************************* ** kdm_opfun ** ************************* Purpose: Output routine for kdm_writekdm Author: John Campbell, November 1997 Note: Accesses globals output_str, fpout **** KDM SERVICE ROUTINE ONLY **** */ void kdm_opfun() { int i, j; int first; int il; int m1, m2; int nxt; int nch; char ch_sav; lab10: if (strlen(output_str)<=MAXC_OUT) { fputs(output_str, fpout); fputs("\n", fpout); return; } else { il = -1; nch = 0; nxt = 0; first = 1; lab20: i = kdm_next_field (output_str, 0, " ", &m1, &m2, &il); if (i>0) { if (first||m20) { i = 0; j = nxt-1; while (output_str[j]!=0) { output_str[i] = output_str[j]; i++; j++; } output_str[i] = 0; goto lab10; } } return; } /* ****************************** ** kdm_copy_chars ** ****************************** Purpose: Copy a string; The output string may be either a 'c' type string which will be null terminated, or a 'fortran' type string which will be padded with blanks if required but will have no terminating null. Author: John Campbell, June 1995 (modified copy of xdl_copy_chars) **** KDM SERVICE ROUTINE ONLY **** */ /* Copy an output string - kdm_copy_chars The routine kdm_copy_chars is used to copy an output string from a 'kdm' routine. The output string may be either a 'c' type string which will be null terminated, or a 'fortran' type string which will be padded with blanks if required but will have no terminating null. */ void kdm_copy_chars (string_in, lin, string_out, max_len) char * string_in; /*The string to be copied (R)*/ int lin; /*Length of string_in; may be 0 if string is null terminated (R)*/ char * string_out; /*The output string address for the copied string (W) */ int max_len; /*If >0 it is the maximum length allowed for the null terminated copied string. string_out must be at least (max_len + 1) characters in length. if <0 then up to abs(max_len) characters are copied to the output string. If the number of characters in the input string is less than this then the output string will be padded to abs(max_len) characters with blanks. (R) */ { int len; /* String length */ int i; /* Loop counter */ if (max_len==0) return; len = lin; if (len<=0) len =strlen (string_in); if (max_len>0) { if (len>max_len) len = max_len; strncpy (string_out, string_in, len); string_out[len] = 0; return; } else { max_len = - max_len; if (len>max_len) len = max_len; strncpy (string_out, string_in, len); if (max_len>len) { for (i=len;i0 it is the maximum length allowed for the null terminated copied string. outstr must be at least (maxo + 1) characters in length. if <0 then up to abs(maxo) characters are copied to the output string. If the number of characters in the input string is less than this then the output string will be padded to abs(maxo) characters with blanks. (R) */ char * str; /*The string to be added (R)*/ int lens; /*The length of the string to be added; may be 0 if 'str' is null terminated (R)*/ int *lout; /*Last offset; updated as needed; normall input as 0 on first call forming an output string; returned as -1 when bounds of output string would be exceeded (R/W)*/ { int ls; int maxout; int trunc = 0; if (*lout<0) { *lout = -1; return; } if (maxo>0&&*lout==0) outstr[0] = 0; maxout = maxo; if (maxout<0) maxout = -maxout; ls = lens; if (ls==0) ls = strlen(str); if (*lout+ls>maxout) { ls = maxout - *lout; trunc = 1; } if (ls>0) { if (maxo>0) { kdm_copy_chars (str, ls, &outstr[*lout], maxo - *lout); } else { kdm_copy_chars (str, ls, &outstr[*lout], maxo + *lout); } *lout += ls; } if (trunc) *lout = -1; return; } /* ****************************** ** kdm_addout ** ****************************** Purpose: Add a string to an output buffer & output/clear/add if no room Author: John Campbell, June 1995 **** KDM SRRVICE ROUTINE ONLY **** */ void kdm_addout (linout, llin, str, outstr, maxo, op_func) char * linout; /* O/p buffer (MAXVLENGTH+1 chars long)(R/W) */ int llin; /* Max length desired for o/p line (R) */ char * str; /* String to be added to o/p buffer; null term. (R)*/ char * outstr; /* Output string for use by op_func function (R)*/ void (*op_func)(); /* User suppiled function; null if o/p to standard output (R)*/ { int ll; int l1; int l2; l1 = strlen(linout); if (l1==0) { strcpy (linout, str); return; } l2 = strlen(str); if (l1+l2+1>llin) { if (op_func) { kdm_copy_chars (linout, 0, outstr, maxo); op_func(); } else { printf ("%s\n",linout); } strcpy (linout, str); return; } else { strcat (linout," "); strcat (linout, str); } return; } /* *************************** ** kdm_blank_string ** *************************** Purpose: Test for a blank(/null) character string Return: =1 (true) blank or null string found, =0 not a blank/null string Author: J. W. Campbell, June 1995 (modified copy from xdl_blank_string) **** KDM SERVICE ROUTINE ONLY **** */ /* Test for a blank string - kdm_blank_string The routine kdm_blank_string is used to test for a blank (/null) character string. */ int kdm_blank_string (str, len) char str[]; /*String to test (null terminated) (R)*/ int len; /*Length of string, may be 0 if str is null terminated (R)*/ { int i; /*Temp/loop variables*/ int l; /*Offset of last character in string*/ l = len; if (l<=0) l = strlen (str); if (l==0) return 1; for (i=0;i100) n = 100; if (n<=0) return 0; strncpy (tmp1, str1, n); strncpy (tmp2, str2, n); for (i=0;i=0;--i) { if (str[i]!=' ') return; str[i] = 0; } return; }