/* *******************************************************************
 *                                                                   *
 * Copyright (c) L-DGO/MIT/JGOFS                                     *
 *                                                                   *
 *                                                                   *
 * File             : defgb.c                                        *
 *                                                                   *
 * Purpose          : Enhanced def method for globec purposes.	     *
 *								     *
 *	Incompatibilities with def 1.7				     *
 *	  1) Return -9999.0 if any char of numeric field bad (not    *
 *		just first)					     *
 *        2) Ignore embedded comments anywhere			     *
 *	  3) Apostrophe is special character (unless changed w/	     *
 *		datafieldopts optional file)			     *
 *	  4) Tab & newline characters must be data separators	     *
 *                                                                   *
 * Version Number   : 2.9	                                     *
 *                                                                   *
 * Revision History :                                                *
 *                                                                   *
 * Date                              Developer                       *
 * ----                              ---------                       */
#define INNER_VERSION "defgb  version 2.9 26 Apr 1997"
/*  26 Apr 97 v 2.9 		    WJS				     *
 *	Change err to build one string (anticipation of outer 1.5)   *
 *	Allow null strings to err				     *
 *	    [Put on globec as testdefgb, _noheader 26 Apr 97]	     *
 *   3 Apr 97 v 2.9 		    WJS				     *
 *	Mod to restrict object input to only required level	     *
 *	  THIS MOD USES QUESTIONABLE LOGIC TO GET REQ LEVEL AND	     *
 *	  COULD BLOW UP WHEN METHOD IS ASKED FOR JGOFS PROTOCOL	     *
 *	  OUTPUT						     *
 *	    [Needs defgb.h 3.5]					     *
 *	    [Needs defgb_nonconfig.h 1.5]			     *
 *	    [Needs ioopen_routines 1.8]				     *
 *	    [Needs ioreadrec_routines 1.2]			     *
 *	    [Needs defgb_utils 1.1]				     *
 *	    [Begin 2.9]						     *
 *  26 Mar 97 v 2.8c 		    WJS				     *
 *	Bug fix: forgot to fill in pointers in noheader case.	     *
 *	    [Put on globec for real 26 Mar 97]			     *
 *	    [Put on globec as testdefgb, _noheader 19 Mar 97]	     *
 *	    [Begin 2.8c]					     *
 *  19 Mar 97 v 2.8b 		    WJS				     *
 *	Check output modes of all files and default to "a" if not    *
 *	  set.  Previously, this job was split between here & ioopen *
 *	Bug fix: don't try to write error message if open failed     *
 *      Bug fix: Incorrect pseudo-record count when generating null  *
 *	  data							     *
 *	Bug fix: not looking at subfile data properly		     *
 *	  Symptom: access violation crash			     *
 *	Version variable addition didn't work-try something else     *
 *	    [Put on globec as defgb28 & testdefgb 19 Mar 97]	     *
 *	    [Begin 2.8b]					     *
 *	    [Needs defgb.h 3.4a]				     *
 *	    [Needs ioopen_routines 1.7a]			     *
 *  10 Mar 97 v 2.8a 		    WJS				     *
 *	Bug fix: open_datafile wasn't modified to take null input    *
 *	Bug fix: forgot to check for exactly 1 extra var too many    *
 *	  on last data level					     *
 *	Add variables for .h files' versions, so strings will be     *
 *	  in executables exactly once.  .c files do this themselves  *
 *	Take per-level PROCESS_VARLIST.  Still method-wide, though   *
 *	Bug fix: Bad initialization of objvarlevel.  Symptom: 2nd    *
 *	  input object fails					     *
 *	Bug fix: Inserted comment related to varlist should end up   *
 *	  in correct place					     *
 *	W/addition of varlist, 1 line data file beginning w/ \ is    *
 *	  not as ridiculous as it once was, so remove test for this  *
 *	  (Will still be picked up as error at this point, though)   *
 *	Bug fix: ndatarec count includes variable list-shouldn't     *
 *	  Symptom: failure of "no data" logic			     *
 *	    [Put on globec as defgb28 10 Mar 97]		     *
 *	    [Begin 2.8a]					     *
 *	    [Needs defgb.h 3.4, nonconfig 1.4a]			     *
 *	    [Needs ioopen_routines 1.7 [sic] ]			     *
 *	    [Needs ioreadrec_routines 1.1a]			     *
 *	    [Needs defgb_utils 1.0a]				     *
 *  28 Feb 97 v 2.8 		    WJS				     *
 *	Apply rules that prohibit fixed field and free field vari-   *
 *	  ables at same level only to non-missing variables.	     *
 *	  Necessary to allow "variable insertion" at fixed-field     *
 *	  levels.  Also evaluate fixed/free status per level rather  *
 *	  than per-object (allows one file of level N input to be    *
 *	  fixed and another to be free.  However, all fixed must     *
 *	  still have same widths)				     *
 *	Bug fix: can't do pointers from 0 to [lev].nvar-must go back *
 *	  to firstvarlevel to nvarlevel[lev]			     *
 *	    [Put on globec as defgb28 ~28 Feb 97]		     *
 *	    [In use on gb1 in inventory object]			     *
 *  26 Feb 97 v 2.8 		    WJS				     *
 *	Bug fix: letting getrec provide single "nd" doesn't work     *
 *	  since we changed from 'pointers = -1' logic to	     *
 *	  'tabvalues = "nd"' logic.				     *
 *  25 Feb 97 v 2.8 		    WJS				     *
 *	Can EOD logic attempt since it cannot be made parallel to    *
 *	  JGOFS-object-reading logic w/o recreating jdbread & its    *
 *	  return value.						     *
 *  19 Feb 97 v 2.8 		    WJS				     *
 *	Attempt to read objects correctly(!)			     *
 *	Replace make_wjstbl_from_optfile w/ create_wjstbl	     *
 *  13 Feb 97 v 2.8 		    WJS				     *
 *	Have getrec throw out blank lines			     *
 *	Start EOD logic-needs lots more work			     *
 *	Bug fix: forgot to make scanheader0 calculate maxlen_	     *
 *	  fixed_field_rec when we made scanheader do it.	     *
 *	  This is an argument for calling scanheader for level 0,    *
 *	  too (and changing scanheader0 to "master_var_list" or some *
 *	  such).  However, see comments in scanheader0 & ioopen	     *
 *	Incorporate 2.7b mods (see below)			     *
 *	VARLIST (standalone lev 0 master variable list)		     *
 *	    [Needs defgb.h 3.4, nonconfig 1.4]			     *
 *	    [Needs ioreadrec_routines 1.1]			     *
 *   2 Feb 97 v 2.8 		    WJS				     *
 *	Swap some logic between open_datafile & analy_source	     *
 *	Do some work to automatically provide "nd" for truncated     *
 *	  level hierarchy.					     *
 *	Mods for extra nxttok parameter				     *
 *	Split some stuff into defgb_utils.			     *
 *	analy_source.  Among other things, replaces do_script	     *
 *	    [Needs defgb_utils 1.0]				     *
 *  31 Dec 96 v 2.8 		    WJS				     *
 *	More serious JGOFS object input mods			     *
 *	Add check that # vars does not exceed NVAR		     *
 *	data trace "inline" opt file data, too			     *
 *	do_data_trace will dump array as input "line"		     *
 *	    [Begin 2.8 because of defgb_utils split]		     *
 *	    [Needs ioopen_routines 1.7, defgb.h 3.3, nonconfig 1.3]  *
 *	    [Needs ioreadrec_routines 1.0b]			     *
 *  17 Dec 96 v 2.7 		    WJS				     *
 *	Alt_separators init to ioopen_routines.			     *
 *	nxttok to accept null separator strings			     *
 *	    [Continued 2.7 although should have begun 2.8.  Be-  ]   *
 *	    [  latedly decided to "save" this on VAX as 2.7 al-  ]   *
 *	    [  though never built or tested.  Something wrong	 ]   *
 *	    [  with what I saved, so scrambled to try to save 10 ]   *
 *	    [  Dec version.  Never tested that save, either; just]   *
 *	    [  used what worked (on globec) which was still there]   *
 *   6 Feb 97 v 2.7b		    WJS				     *
 *	2.7a analysis insufficiently profound.  Fix not correct in   *
 *	  2.7a context, but is correct after pointers mod (nxt item) *
 *	Pointers array used to map lev0 list into what was present;  *
 *	  having -1s indicating which lev0 variables were missing at *
 *	  a particular level.  Change whole logic scheme to scatter- *
 *	  write user data into tabvalues, with an index equal to     *
 *	  proper position in lev0 list.  For missing data, put "nd"  *
 *	  into tabvalues just as if user supplied it		     *
 *	Fix signif consec separators typo			     *
 *	Fix typo in looking at # of open files in err stuff	     *
 *	    [Needs ioopen_routines 1.6, defgb.h 3.3, nonconfig 1.2]  *
 *	    [Needs ioreadrec_routines 1.0c]			     *
 *   5 Feb 97 v 2.7a                WJS                              *
 *      ok_to_calc required variable to be non-missing.  This is     *
 *        wrong.  Correct behavior was in comment-too bad I was      *
 *        less careful w/code!                                       *
 *  10 Dec 96 v 2.7 		    WJS				     *
 *	More JGOFS object input mods				     *
 *	Clean up some error checking if script opening fails	     *
 *	    [2.7 never distributed.  An early version tested on	  ]  *
 *	    [  globec when 2.6 test failed there.  Decided not to ]  *
 *	    [  try to use that 2.7.				  ]  *
 *   6 Dec 96 v 2.7 		    WJS				     *
 *	dispwidths opt file					     *
 *	Handle W_EXTEND chars in translated varname		     *
 *	Bug fix: W_EXTEND chars must be removed from variable name   *
 *	  before using transvar on it				     *
 *	Move get_int_from_string in here from ioopen_routines	     *
 *	Bug fix: non-numeric checks via sscanf wrong.  Switch to     *
 *	  strtol (should be faster, too)			     *
 *	Begin source_is_object work (convert source_is... to	     *
 *	  source_type)						     *
 *	Tab must be separator					     *
 *	    [Needs ioopen_routines 1.6, defgb.h 3.3, nonconfig 1.2]  *
 *	    [Any version ioreadrec_routines]			     *
 *  11 Nov 96 v 2.6		    WJS				     *
 *	Alt_separators; alt_separators & separators @ run time as    *
 *	  well as compile time					     *
 *	Remove defmet-specific code				     *
 *	Bug fix in detection of missing datafile.		     *
 *	Bug fix in setting datafile's description to "script"	     *
 *	Detect blank or tab in file name.  Appears fopen is happy    *
 *	  to use portion of string for name (not sure this works)    *
 *	    [Needs ioopen_routines 1.5, defgb.h 3.2, nonconfig 1.1]  *
 *	    [Given to Chris 4 Dec; used briefly at GLOBEC mtg]	     *
 *  10 Mar 97 v 2.5d		    WJS				     *
 *	Bug fix: char variables used as integers should be explicit- *
 *	  ly signed or unsigned since default is machine dependent   *
 *	  This was problem on IRIX box.  This fix will be im-	     *
 *	  plemented in defgb_nonconfigurable.h in future defgb's     *
 *	Bug fix: bad initialization of WJSTBL in ioopen_routines     *
 *	  Worked if string array init'ed to \0 as I think the C	     *
 *	  standard says, but...					     *
 *		[Put on NMFS' server jgof.wh.whoi.edu, by Bob,]	     *
 *		[11 Mar 97.  Server is an IRIX box which      ]	     *
 *		["discovered" the problem		      ]	     *
 *  25 Oct 96 v 2.5c		    WJS				     *
 *	Bug fix: Problem when order of fixed field variables is not  *
 *	  same as order in level 0 variable list		     *
 *		["Official" globec version ~15 Dec 96]		     *
 *		[Put on globec as defgb25 ~25 Oct 96]		     *
 *  20 Jul 96 v 2.5		    WJS				     *
 *	[Needs IOOPEN_ROUTINES 1.4, DEFGBH 3.0]			     *
 *	[Needs IREADREC_ROUTINES 1.0, DEFGB_NONCONFIGURABLE 1.0]     *
 * [Comments about versions 1.1->2.5c moved to defgb_revision.doc]   *
 *  1 Jan 97                        WJS                              *
 *      From defw.c vers 1.2; itself from def.c.  Comments from      *
 *      original source file below.  Comments in quotation marks in  *
 *	the body of defmet come from outerw's descriptions of inner  *
 *	routines.  Date of source outerw approx 13 Sep 95	     *
 ********                                                            *
 * Sat Oct 17  1992 10.00           Glenn Flierl                     *
 * Oct 1993                         tabattributes                    *
 * July 1995                        Christine Hammond                *
 *        change to add field width determination based on width of  *
 *        the label in the data.  Preparer must determine max width  *
 *        of column from inspection of data column width.            *
 *        Ex:  event___ , sta__ ,bot                                 *
 *        will give lengths of 8, 5, and 3 for the respective cols   *
 * July 1995                        Christine Hammond                *
 *        change to allow subfiles to be located in different        *
 *        directories from header file                               *
 *                                                                   *   
 ******************************************************************* */

#include "defgb.h"

  /*  defgb_utils routines						*/
void analy_source();
char *buildstring();
void do_data_trace ();
int extract_wjstbl();
void free_lengthened_str();
char *lengthen_str();
char *lengthen_str_nl();
char *lengthen_str_and_free();
char *lookup_wjstbl ();
char *nxttok();
char *rem_delims ();
char *strdupl();

  /*  Following routines are only needed conditionally.  However,	*/
  /*  referencing them unconditionally means that the code using them	*/
  /*  can also be unconditionally compiled w/o warning.  We do a run-	*/
  /*  time check on open to be sure that, if used, program was com-	*/
  /*  piled with them.  For whatever reason, program links OK even if	*/
  /*  routines are not supplied to linker...				*/
void startchild();
FILE *scriptstream;	/* For use by child subprocs. Never opened here	*/
			/*  Logically a part of each datafile		*/
			/*   (analogous to file stream), but since we	*/
			/*    never have > 1 open...			*/
int jdbopen_();		/* Apparently, on IBM & HP systems, the jdb 	*/
int jdbreada_();	/*  routines do not have underscores in their	*/
int jdbclose_();	/*   names					*/
int jdblevel_();
int jdbattributes_();
int jdbcomments_();
int jdbunit;		/*  Identifier internal to jdb package		*/
			/*  Logically a part of each datafile		*/
			/*   (analogous to file stream), but since we	*/
			/*    never have > 1 open...			*/

  /*  Pointers array is not parallel to the rest.  pointers[N] contains	*/
  /*  the position within the level 0 array corresponding to variable N	*/
  /*  at the level we're looking at.  This is the reverse of the	*/
  /*  original def pointers array					*/
int pointers[NVAR];
int inpwidths[NVAR]; /* Input field width for each fixed-format variable */
int inpstarts[NVAR]; /* Input field starts for each fixed-format variable */
int tabwidths[NVAR];
char tabnames[NVAR][MAXVARNAMESIZE+1]; 
char tabattributes[NVAR][TOKEN+1];
char tabvalues[NVAR][TOKEN+1];
  /* Spare set of buffers for object input.  Idea is to get its values	*/
  /* into these buffers, then process them into "our" buffers.  When	*/
  /* possible, we go straight to "our" buffers, but convenient to have	*/
  /* these around... Sizes are too large since apparently jdb routines	*/
  /* truncate w/o error when getting data off net.  We want to know if	*/
  /* there's an error.							*/
#define MAXOBJVARNAMESIZE MAXVARNAMESIZE+1
#define MAXOBJTOKEN TOKEN+1
char objnames[NVAR][MAXOBJVARNAMESIZE+1]; 
char objattributes[NVAR][MAXOBJTOKEN+1];
char objvalues[NVAR][MAXOBJTOKEN+1];

  /*    Add one more level of indirection to allow removal of variables */
  /*    post_removal_varlist is list of pointers w/entries beyond 	*/
  /*    removed variables "shoved up" one.  That is, if we read in 3	*/
  /*	variables and want to remove #2, post_removal_varlist[0]=0,	*/
  /*    post_removal_varlist[1]=2, and post_removal_varlist[2] doesn't	*/
  /*	exist								*/
  /*	Because of the indirection, a set of io*__ routines replaced 	*/
  /*	the io*_ routines.  The io*_ routines now call the io*__ 	*/
  /*	routines with post_removal_varlist[*variable] as an arg instead	*/
  /*	of *variable.  The io*__ are used directly by defgb, since all	*/
  /*	variables "in here" "exist"					*/
int post_removal_varlist[NVAR];

  /*	Size of the comment buffer is tricky.				*/
  /*	  First, the comment buffer is used to hold comments from the	*/
  /*    indirect file and the diagnostic optional file.  After the lat-	*/
  /*	ter is read, the various comment sinks are known.  At this 	*/
  /*	point, the comments in the comment buffer are sent to the	*/
  /*	appropriate sink.						*/
  /*	  By default, all comments go to stdout.  After the various	*/
  /*	sink defns, redirections, etc, any comments that still go to	*/
  /*	stdout will use the comment buffer (note that it is possible to	*/
  /*	redirect all comments, so that it is possible that the comment	*/
  /*	buffer is not used further).  This buffer is emptied by		*/
  /*	outer every so often, so its size depends on how often outer	*/
  /*	empties it.  At present (outerw 13 Sep 1995), the buffer is	*/
  /*	emptied once after the level 0 file is read, then once per	*/
  /*	level if outer processes any data at that level.		*/
  /*	  Therefore, the comment buffer must be large enough to contain	*/
  /*	the level 0 comments.  If outer processes data from each level	*/
  /*	(as it usually does), the comment buffer must be large enough	*/
  /*	to contain any individual level's comments.  However, because	*/
  /*	of data	selection, the whole dataset may fail to produce any	*/
  /*	data that matches the selection/projection criteria that the	*/
  /*	user gave to outer.  In such a case, the buffer must be large	*/
  /*	enough to contain all the non-level0 comments in the dataset.	*/
  /*	Thus, a buffer that seems perfectly OK can overflow if a par-	*/
  /*	ticular selection is sufficiently inopportune.			*/
char tabcomments[COMMENTSIZE+1];
char *tabcomments_ptr;	/* Points to logical end of comments buffer	*/

int maxlev;		/* Number of the lowest level in this dataset	*/
int ncnt;		/* Number of the last variable in dataset	*/
int objmaxlev,objncnt;	/* Above; temps for object input		*/
int jdblev;		/* Need to maintain state while processing obj	*/
			/*  input.  This var is the lowest as-yet	*/
			/*   unprocessed level from the most recent	*/
			/*    jdbread.  See jdbread.c			*/
Logical objeof;		/* Temp until indirect file->eof logic		*/

/*  Index of into master variable list of first variable at each level	*/
/*    + 1 entry is 1 beyond end of list (number of variables in the	*/
/*    object)-used as upper bound for loops				*/
int firstvarlevel[MAXLEVELS+1];
int objfirstvarlevel[MAXLEVELS+1];	/* Same for object input 	*/

  /*	File information						*/
char *dirstring;
struct fileinfo datalev[MAXLEVELS];
struct fileinfo files[NFILETYPES]; 
struct fileinfo indirect_file;

    /* data field options						*/
    /*  data_field_trim cannot be changed from TRUE as of v 2.4.	*/
    /*  Issues about leading separators throughout system need to be	*/
    /*  addressed as well as issues about "would-be" separators (eg,	*/
    /*  leading blanks in a method where tabs are separators but blanks	*/
    /*  are not).  Code is in ioreadrec_ to implement data_field_trim =	*/
    /*  FALSE for fixed fields.  iovalstr__ strips off leading blanks	*/
    /*  anyway								*/
Logical significant_consec_separators =	SIGNIFICANT_CONSECUTIVE_SEPARATORS;
Logical significant_embedded_separators = SIGNIFICANT_EMBEDDED_SEPARATORS;
Logical data_field_trim = DATA_FIELD_TRIM;

    /* latitude & longitude info					*/
struct latlonformat inlatformat = { 'N', "decdeg", -1};
struct latlonformat outlatformat = { 'N', "decdeg", -1};
struct latlonformat inlonformat = { 'E', "decdeg", -1};
struct latlonformat outlonformat = { 'E', "decdeg", -1};

    /* time/date info							*/
    /*   A time/date "fragment" is one of a list of possible fragments	*/
    /*   that can be input.  The 5 output time variables (year, month,	*/
    /*   day, time, and displacement from prime meridian) are built	*/
    /*   from the input fragments provided.  See comments in ioopen_	*/
    /*   routines and defgb.h, and the "parameter 1" documentation.	*/
struct outtime out_timedate[NUM_TIMEDATE_FRAGS];
struct intime in_timedate[NUM_TIMEDATE_FRAGS];
      /*  Extra length of next list is because we present a window of	*/
      /*  length NUM_TIMEDATE_FRAGS+1 to get_timedate_frag.  See it for	*/
      /*  reason.							*/
char *timedatefragbuflist[2*NUM_TIMEDATE_FRAGS];

    /* Miscellaneous info about what to output & where			*/
struct outinfo output_opts;
    /*    Next defn for convenience, since stuff on right so long	*/
struct outfile *diagout = &output_opts.file[DIAG_SINK];
int max_trace_level;
char trace_msg[50];	/*  Trace message buf for messages that need	*/
			/*   formatting.  Too lazy to count better, etc	*/

    /* For info about format of next 3 strings, see ioopen_routines	*/
    /* (they are "wjstbl"s)						*/
char disp_data_widths[DISP_DATA_WIDTHS+1];
char var_data_widths[VAR_DATA_WIDTHS+1];
char trans_list[TRANS_LIST+1];
/*									*/
/************************************************************************/
/*									*/

void ioclose_()
/*	"Close files"							*/
{
  int i;
  for (i=0;i<maxlev;i++) 
    if (datalev[i].open) {
      if (datalev[i].source_type == JGOFS_OBJECT) jdbclose_(&jdbunit);
      else fclose(datalev[i].stream);
      datalev[i].open=FALSE;
    }
  for (i=0;i<NFILETYPES;i++) 
    if (files[i].open) {
      fclose(files[i].stream);
      files[i].open=FALSE;
    }
  for (i=0;i<NUM_SINKS;i++)
    if (output_opts.outsink_open_flags[i]) {
      fclose(output_opts.outsink_streams[i]);
      output_opts.outsink_open_flags[i]=FALSE;
    }
  if (indirect_file.open) {
    fclose(indirect_file.stream);
    indirect_file.open=FALSE;
  }
}

/*********	Functions called with index of variable.  See	**************/
/*********	post_removal_varlist comments up top for	**************/
/*********	reasons for _ & __ forms of functions		**************/

void ioname__(n,s)
int n;
char *s;
{
  strcpy(s,tabnames[n]);
  return;
}
void ioname_(vn,s)
int *vn;
char *s;
/*	"Return name (s) corresponding to variable number vn"		*/
{
  ioname__(post_removal_varlist[*vn],s);
  return;
}


int iovarlevel__(n)
int n;
{
  int i;
  for (i=maxlev;i>=0;i--)  if (n >= firstvarlevel[i]) return i;
    /*  Really an error, but see comment below & stay compatible ...	*/
  return 0;
}
int iovarlevel_(vn)
int *vn;
/*	"Return level corresponding to variable indexed by vn"		*/
/*	(returns maxlev for indices illegally big; 0 for indices 	*/
/*	illegally small)						*/
{
  return iovarlevel__(post_removal_varlist[*vn]);
}


int ioattrout__(n,str)
int n;
char *str;
{
  char *at;

	/* if there IS an attribute, find one and move next one to 	*/
	/* front of string */
  if (tabattributes[n][0] == '\0') return 0;
  else {
    at=strchr(tabattributes[n],ATTRIB_SEP);
    if(at == NULL){	/* this is the only attribute for variable *vn */
      strcpy(str,tabattributes[n]);
      if (strncmp(str,"width=",6) == 0) str = '\0'; /* don't show width attr */
      tabattributes[n][0]='\0';
    } else {		/* there is more than 1 attribute */
      *at = '\0';
      strcpy(str,tabattributes[n]);
      if (strncmp(str,"width=",6) == 0) str = '\0'; /* don't show width attr */
      strcpy(tabattributes[n],at+1);
    }

    return 1;
  }
}
int ioattrout_(vn,str)
int *vn;
char *str;
/*	"Output next attribute for variable indexed by vn.  0=none left"*/
/*	 Width attribute special - don't return it to the caller	*/
{
  return ioattrout__(post_removal_varlist[*vn],str);
}


void iovalreal__(n,f)
int n;
float *f;
/*	NB: defgb uses different "pointers" logic from def, hence	*/
/*	different-looking missing value logic				*/
{
  char *end_char_ptr;

  *f=strtod(tabvalues[n],&end_char_ptr);
    /*  Next line ignores possibility that tabvalues[i] is the empty	*/
    /*  string.  If it is, f will end up w/value 0 instead of "missing"	*/
  if (*end_char_ptr != '\0') *f= MISSING_VALUE_REAL;

  if (output_opts.iovalreal != 0) {
    output_opts.n_iovalreals++;
    if (output_opts.n_iovalreals == 1) 
      fprintf(*(diagout->stream_ptr),"iovalreal %d %f\n",n,f);
    if (output_opts.n_iovalreals == output_opts.iovalreal) 
      output_opts.n_iovalreals = 0;
  }
  return;
}
void iovalreal_(vn,f)
int *vn;
float *f;
/*	"Return real value (f) for variable indexed by vn. -9999"	*/
/*	"for strings"							*/
{
  iovalreal__(post_removal_varlist[*vn],f);
  return;
 }


void iovalstr__(n,tmp)
int n;
char *tmp;
/*	NB: defgb uses different "pointers" logic from def, hence	*/
/*	different-looking missing value logic				*/
{
  static char *s;

  s=tabvalues[n];
  s=s+strspn(s," ");
  strcpy(tmp,s);

  if (output_opts.iovalstr != 0) {
    output_opts.n_iovalstrs++;
    if (output_opts.n_iovalstrs == 1) 
      fprintf(*(diagout->stream_ptr),"iovalstr %d %s\n",n,tmp);
    if (output_opts.n_iovalstrs == output_opts.iovalstr) 
      output_opts.n_iovalstrs = 0;
  }
  return;
}
void iovalstr_(vn,tmp)
int *vn;
char *tmp;
/*	"Return string value (tmp) for variable indexed by vn."		*/
{
  iovalstr__(post_removal_varlist[*vn],tmp);
  return;
}


int iowidth__(n)
int n;
{
  return tabwidths[n];
}
int iowidth_(vn)
int *vn;
/*	"Return length of variable field indexed by vn"			*/
{
  return iowidth__(post_removal_varlist[*vn]);
}
/*									*/
/*********  End functions called with index of variable.  ***************/

void add_to_errbuf (errbuf_ptr,s,t,addend)
char **errbuf_ptr,*s,*t;
char addend;
  /*  s must be non-null; don't care about t				*/
  /*  Call lengthen_str(_nl) to add to error buffer.  Addend is really	*/
  /*  just a flag ('\n' means call lengthen_str_nl; otherwise don't)	*/
  /*  but calling code is easier to see w/ \n in it.			*/
  /*  Main point of this routine is error handling in case allocation	*/
  /*  fails-cannot call err!!						*/
{
#define ERRBUF_EXTEND_SIZE 800	/*  Approx 10 lines. 			*/
  char *buf;

  buf = *errbuf_ptr;

  if (addend == '\n') buf = lengthen_str_nl(buf,s,t,ERRBUF_EXTEND_SIZE,NULL);
  else buf = lengthen_str(buf,s,t,ERRBUF_EXTEND_SIZE,NULL);

  if (buf == NULL);  /* Put out what you can - still have ptr to original */
  else *errbuf_ptr = buf;

  return;
}

char *do_err(ss,tt,stream,error_level,maxscriptdiags)
char *ss,*tt;
FILE *stream;
int error_level,maxscriptdiags;
/*  Generate desired level of diagnostic output into a buffer & return	*/
/*  pointer to that buffer						*/
/*  See defgb.h and/or opt file doc for descrip of various levels	*/
{
#define JGOFS_PROTOCOL_ERR_PREFIX "&x "
  int ndiags,i,nopen_files,j;
  char empty[1] = {'\0'};	/* Shouldn't have null strings as input	*/
  char *s = empty, *t = empty;	/*  but be ready to repl with emtpy	*/
  char *ptr,*tmp;
  static char *errbuf = JGOFS_PROTOCOL_ERR_PREFIX;
  char intbuf[10];
  Logical got_remote_addr,got_remote_host;
  time_t timbuf;

  if (ss != NULL) s = ss;
  if (tt != NULL) t = tt;

  if (error_level >= ERROR_MESSAGE) {
      /*  If last char is newline, get rid of it to avoid blank line	*/
    ptr = (*t == '\0') ?  s : t;
    if ( *(ptr = ptr + strlen(ptr) - 1) == '\n' ) *ptr = '\0';
    add_to_errbuf(&errbuf,s,t,'\n');
  }

  if (error_level >= ID_PROBLEM_FILE) {
    for (i=MAXLEVELS-1; i>=0; i--)   if (datalev[i].open) break;
    if (i < 0) add_to_errbuf(&errbuf,"   No data files open\n",NULL,0);
    else {
      sprintf (intbuf,"%d\n",i);
      add_to_errbuf(&errbuf,"   Lowest level file open is at level ",intbuf,0);
      if (datalev[i].source_type == COMMAND_FILE) {
	add_to_errbuf(&errbuf,
		"   File is output of command\n   Command & params = ",
		datalev[i].source,  '\n');
        if (error_level >= GET_MORE_FROM_SCRIPT) {
	    /*  Script might be writing diagnostic info.  Copy it (but 	*/
	    /*  have sanity limit)					*/
	  tmp = datalev[i].buf;
	  ndiags = 0;
	  while ( (fgets(tmp,MAXREC,datalev[i].stream) != NULL) && 
		  (ndiags++ < maxscriptdiags)			   ) {
	      /*  If last char is newline, get rid of it		*/
	    if ( *(ptr = tmp + strlen(tmp) -1) == '\n' ) *ptr = '\0';
	    if (ndiags == 1)
	      add_to_errbuf(&errbuf,
			"   More diagnostic info from command(?) follows:\n   ",
			NULL,0);
	    add_to_errbuf(&errbuf,"   ",tmp,'\n');
	  }
	  if (ndiags == maxscriptdiags) 
	    if (fgets(tmp,MAXREC,datalev[i].stream) != NULL)
	      add_to_errbuf(&errbuf,"   *** too many diags\n",NULL,0);
	}
      } else if (datalev[i].source_type == JGOFS_OBJECT)
	  add_to_errbuf(&errbuf,"   File is JGOFS object.  Object name = ",
		datalev[i].source,'\n');
      else
	add_to_errbuf(&errbuf,"   Name = ",datalev[i].source,'\n');

      sprintf (intbuf,"%d\n",datalev[i].nrecs);
      if (datalev[i].source_type == JGOFS_OBJECT)
	add_to_errbuf(&errbuf,
		"   Number of calls to jdbread executed so far: ",intbuf,0);
      else {
	add_to_errbuf(&errbuf,"   Last record read was # ",intbuf,'\n');
	add_to_errbuf(&errbuf,"   (Count includes comments, blanks, etc; ",
		"excludes addl diag info, if any)\n",0);
      }
    }
  }

  if (error_level >= ID_ALL_OPEN_FILES) {
    for (j=i-1; j>=0; j--) 
      if (datalev[j].open) {
	sprintf (intbuf,"%d\n",j);
	add_to_errbuf(&errbuf,"   Data file open at level ",intbuf,0);
	switch (datalev[j].source_type) {
	  case COMMAND_FILE:
	    ptr = "   File is output of command\n   Command & params = ";
	    break;
	  case JGOFS_OBJECT:
	    ptr = "   File is JGOFS object\n   Object = ";
	    break;
	  default:
	    ptr = "   Name = ";
	    break;
	}
	add_to_errbuf(&errbuf,ptr,datalev[j].source,'\n');
      }

    if (indirect_file.open) {
      add_to_errbuf(&errbuf,"   Indirect file ",indirect_file.source,0);
      add_to_errbuf(&errbuf," open\n",NULL,0);
    }

    nopen_files=0;
    for (j=0; j<NFILETYPES; j++)
      if (files[j].open) {
	nopen_files++;
	add_to_errbuf(&errbuf,"   ",files[j].descrip,0);
	add_to_errbuf(&errbuf," optional file open\n   Name = ",
		files[j].source,'\n');
      }
    if (nopen_files == 0)
      add_to_errbuf(&errbuf,"   No optional files open\n",NULL,0);

    nopen_files=0;
    for (j=0; j<NUM_SINKS; j++)
      if ( *(output_opts.file[j].open_ptr) ) {
	nopen_files++;
	add_to_errbuf(&errbuf,"   ",output_opts.file[j].descrip,0);
	add_to_errbuf(&errbuf," output sink open\n   Name = ",
		output_opts.file[j].sink,'\n');
      }
    if (nopen_files == 0)
      add_to_errbuf(&errbuf,"   No output sinks open\n",NULL,0);
  }

  if (error_level >= ID_SESSION) {
    got_remote_host = ( (ptr=getenv("REMOTE_HOST")) != NULL );
    if (got_remote_host) got_remote_host = (*ptr != '\0');
    if (got_remote_host) {
      add_to_errbuf(&errbuf,"   REMOTE_HOST = ",ptr,0);
      got_remote_addr = FALSE;
    } else {
      got_remote_addr = ( (ptr=getenv("REMOTE_ADDR")) != NULL );
      if (got_remote_addr) got_remote_addr = (*ptr != '\0');
      if (got_remote_addr) add_to_errbuf(&errbuf,"   REMOTE_ADDR = ",ptr,0);
    }
    if (got_remote_host || got_remote_addr) {
      if ( (ptr=getenv("REMOTE_USER")) != NULL )
	if (*ptr != '\0') add_to_errbuf(&errbuf,";  REMOTE_USER = ",ptr,0);
    } else add_to_errbuf(&errbuf,"   No remote ID info",NULL,0);

    add_to_errbuf(&errbuf,"\n",NULL,0);

    time(&timbuf);
      /*  ctime includes a newline					*/
    add_to_errbuf(&errbuf,"   This msg issued ",ctime(&timbuf),0);
  }

  if (error_level >= ID_INNER) {
    add_to_errbuf(&errbuf,"   This msg from method ",METHOD_NAME,0);
    add_to_errbuf(&errbuf,".  Source: ",INNER_VERSION,'\n');
  }

  if (FALSE) ; /* if (stream is /dev/stdout) call outer_err(errbuf); */
  else fprintf(stream,errbuf);

  free_lengthened_str(errbuf);

  return errbuf;
}

err(s,t)
char *s,*t;
/*  Put out error message to the correct sink(s), if any		*/
{
  struct outfile *errout = &output_opts.file[ERROR_SINK];
  int errlev = output_opts.error_level;
  int maxscriptdiags = output_opts.maxscriptdiags;

    /*  Valid sink device guaranteed by configure_output, but we can	*/
    /*  get here before that's set up.  Even so, don't think sink ptr	*/
    /*  can end up NULL or sink can be null string, but why risk it?	*/
  if (  (errlev > NOERROR_OUTPUT)  &&	(errout->sink != NULL)  )
      if (*errout->sink != '\0')  {

      /*  We have output and a place to output to. If not open, open it	*/
    if ( ! *(errout->open_ptr) ) {
      if ( *(errout->mode_ptr) == NULL ) *(errout->mode_ptr) = "a";
	/*  Special-case /dev/stdout & /dev/stderr since they don't	*/
	/*  exist as "devices" on all systems.  This creates a problem	*/
	/*  with the meaning of the open bit.  It should be set if we	*/
	/*  opened the file, meaning we should close it.  On the other	*/
	/*  hand, we also use it as a test-if not set, open the thing	*/
	/*  What we do here will result in an attempt to close stdout	*/
	/*  & stderr, which presumably is OK				*/
      if (strcmp(errout->sink,STDOUT_DEVICE) == 0)
	*(errout->stream_ptr) = stdout;
      else if (strcmp(errout->sink,STDERR_DEVICE) == 0)
	*(errout->stream_ptr) = stderr;
      else *(errout->stream_ptr) = fopen(errout->sink,*(errout->mode_ptr));
      if (*errout->stream_ptr == NULL) {
        do_err ("Error info to stdout because cannot open error sink ",
	  errout->sink,ULTIMATE_ERROR_STREAM,ERROR_MESSAGE,0);
        do_err (s,t,ULTIMATE_ERROR_STREAM,errlev,maxscriptdiags);
      } else
	*(errout->open_ptr) = TRUE;
    }
      /*  If dup bit is set, send to stdout & whatever they spec;d	*/
      /*  Don't know why I didn't let them set both sinks, but this	*/
      /*   is what I documented, so be it!				*/
    if (errout->dup) {
      do_err(s,t,PRIMARY_ERROR_STREAM,errlev,maxscriptdiags);
      if (*(errout->open_ptr)) 
	do_err(s,t,*(errout->stream_ptr),
	  output_opts.dup_error_level,output_opts.dup_maxscriptdiags);
    } else 
      if (*(errout->open_ptr)) 
	do_err(s,t,*(errout->stream_ptr),errlev,maxscriptdiags);
  }

  ioclose_();
  exit(1);
}

errn(s,i)
char *s;
int i;
{
  char cbuf[10];

  sprintf(cbuf,"%d",i);
  err (s,cbuf);

}

void mark_missing(lev)
int lev;
/*  Put missing data indicators into all values of a level		*/
{
  int i;

  datalev[lev].lastvar = firstvarlevel[lev];
  for (i = firstvarlevel[lev]; i < firstvarlevel[lev+1]; i++)
    strcpy(tabvalues[i],MISSING_VALUE_STRING);
  return;
}

void do_diag_trace (limit,msg)
int limit;
char *msg;
{
  if (diagout->dup) {
    if (output_opts.trace_level >= limit) fprintf (PRIMARY_ERROR_STREAM,msg);
    if (output_opts.dup_trace_level >= limit)
      fprintf (*(diagout->stream_ptr),msg);
  } else 
    if (output_opts.trace_level >= limit) fprintf (*(diagout->stream_ptr),msg);

  return;
}

Logical ok_to_calc (var,this_level)
int var,this_level;
/*	Returns true if it's OK to calculate variable var.		*/
/*	It's OK if variable exists and is on this level (hence we need	*/
/*	present level as an input argument)				*/
{
  Logical ok;

  ok = (var >= 0);
  if (ok) ok = (iovarlevel__(var) == this_level);
  return ok;
}

Logical missing (var)
int var;
/*	Check datum corresponding to legal (specified in level 0	*/
/*	variable list) variable.					*/
{
  return (strcmp(MISSING_VALUE_STRING,tabvalues[var]) == 0);
}

Logical ok_to_use (var,this_level)
int var,this_level;
/*	Returns true if it's OK to use variable var.			*/
/*	It's OK if variable exists and is on or above this level (hence */
/*	we need present level as an input argument), and is not missing	*/
{
  Logical ok;

  ok = (var >= 0);
  if (ok) ok = (iovarlevel__(var) <= this_level);
  if (ok) ok = ( ! missing(var));
  return ok;
}

int lookup_lev0varlist (name)
char *name;
/*  See if argument name is in master variable list for this dataset	*/
/*  Return position if so; -1 if not					*/
/*  tabnames and its size, ncnt, are implicit input to this routine	*/
{
  int i;

  for (i=0;i<ncnt;i++) if (strcmp(name,tabnames[i]) == 0) break;
  if (i >= ncnt) i= -1;

  return i;
}

int transvar(synonym,max_len_synonym,variable)
char *variable,*synonym;
int max_len_synonym;
/*  Call extract_wjstbl with the variable translation list		*/
/*  Same returns as extract_wjstbl					*/
/*  Note: when used to look up variables during variable name transla-	*/
/*  tion, transvar may generally be called whether or not a translation	*/
/*  file was provided.  However, there is a difference if the same	*/
/*  name appears on both the pre & post translation lists; eg, start	*/
/*  with long and long1; translate long to lon and long1 to long	*/
{
  return extract_wjstbl(synonym,max_len_synonym,variable,trans_list);
}

char *pack_comment_into_buffer(buf_start,buf_end,comment,postfix,max_to_add)
char *buf_start,*buf_end,*comment,*postfix;
int max_to_add;
/*  Specialized routine for add_to_comment_stream since this stuff 	*/
/*  might need to be done twice.  Basic idea is to see if comment, 	*/
/*  which is known to fit in MAXCOMMENTLINE, will fit between buf_start	*/
/*  & buf_end.  Various alterations are attempted (we'd like to have	*/
/*  postfix, we insist on putting in truncation string if we can't fit	*/
/*  anything else, etc)							*/
/*  Returns pointer to logical end of buffer it worked on		*/
{
  int lencomment,len_to_add,lenpostfix;
  char *end_ptr,*buf_ptr;

    /*  Give up if we can't add at least 1 character of the comment,	*/
    /*  along with the indicator that we're truncating the comment	*/
  if (buf_start + strlen(COMM_TRUNC_IND) + 1   >   buf_end)
    err ("Comment buffer overflow attempting to add comment\n   Comment = ",
      comment);

  lencomment=strlen(comment);
  lenpostfix=strlen(postfix);

    /*  First force comment by itself onto a single line		*/
    /*  Neither len* nor MAXCOMMENTLINE includes newline char		*/
  len_to_add = lencomment;
  if (lencomment > MAXCOMMENTLINE) len_to_add = MAXCOMMENTLINE;

    /*  See if postfix will fit.  If so, add full desired line width	*/
    /*  since postfix will be left-justified.  max_to_add may		*/
    /*  differ from MAXCOMMENTLINE because of comment display issues	*/
    /*  The postfix is displayed only if it looks nice; a full 		*/
    /*  comment's worth of text is completly displayed, looks or not.	*/
    /*  This is an issue for the calling routine, however.		*/
  if (lenpostfix > 0)
    if (lencomment + lenpostfix <= max_to_add) 
	len_to_add = max_to_add;
    else lenpostfix = 0;

    /*  See if desired comment will fit in what's left of buffer	*/
    /*  If not, throw away postfix and see if that will fit		*/
    /*  If still not enough room, copy what will fit, truncating	*/
  end_ptr = buf_start+len_to_add;
    /*  + 1 in next line is for newline char				*/
  if (end_ptr+1 > buf_end) {
    lenpostfix = 0;
    len_to_add = lencomment;
    end_ptr = buf_start+len_to_add;
    if (end_ptr+1 > buf_end) {
      len_to_add = buf_end - buf_start;
      end_ptr = buf_end;
    }
  }

  if (lenpostfix == 0) {  	/* Comment only-might need truncation	*/
    strncpy(buf_start,comment,len_to_add);
    if (len_to_add < lencomment) 
      strcpy (end_ptr-strlen(COMM_TRUNC_IND),COMM_TRUNC_IND);
  } else {  /* Comment & right justified postfix both fit-we checked	*/
    strcpy(buf_start,comment);
    for (buf_ptr = buf_start + lencomment;
	 buf_ptr < end_ptr - lenpostfix;
	 buf_ptr++)
      *buf_ptr=' ';
    strcpy(end_ptr-lenpostfix,postfix);
  }

  *end_ptr++ = '\n';
  *end_ptr = '\0';

  return end_ptr;
}

void add_to_comment_stream (desired_postfix,comment)
char *desired_postfix,*comment;
/*	Adds comment and postfix strings to end of comments stream, 	*/
/*  checking for buffer overflow.  					*/
/*	If the output stream is going to stdout, we don't actually do	*/
/*  output.  Instead, we add the comment to tabcomments, to be 		*/
/*  processed by outer.  We make other decisions about what to output	*/
/*  based on parameters described in diagnostics optional file doc	*/
/*	If individual comment is too long, comment is truncated, with	*/
/*  last 4 legal characters replaced with " ..." (unless comment is	*/
/*  html tag).  							*/
/*	Individual comment size refers to size between newlines,	*/
/*  not necessarily size of comment string.  However, since we read	*/
/*  with fgets, we are guaranteed that "normal" comments (eg, those	*/
/*  not generated by the program) contain exactly one newline as the	*/
/*  last comment character.  Subr will add newline to comment if not	*/
/*  present.								*/
/*	comment normally does not begin with #.  Outer routines		*/
/*  supply a leading "# " before each comment line in html mode and 	*/
/*  supply no prefix in flat mode.  (Comments in a non-display mode are	*/
/*  ignored).  postfix is used to allow differentiation between 	*/
/*  comments, if desired.  Postfix is positioned at end of comment	*/
/*  line.  It is omitted if it will not fit in its entirety		*/
/*	tabcomments_ptr is implicit input; points to present end of 	*/
/*  comments string; initialized in ioopen_; altered in iocommout_	*/
/*	output_opts is also implicit input.  From it we get the output	*/
/*  destination as well as info about optional comment output		*/
{
  char *ptr,*postfix;
    /* +1, as always, for line terminator.  +1 for newline (not 	*/
    /*  included in MAXCOMMENTLINE					*/
  static char line[MAXCOMMENTLINE+2];
  int lencomment,lenpostfix,len_to_add,comment_sink;
  Logical inserted_line,add_to_buffer,write_to_file;
  struct outfile *commout;

  postfix=desired_postfix;

    /*  Empty postfix distinguishes comments from data files from other	*/
    /*  comments							*/
  lenpostfix = strlen(postfix);
  if (lenpostfix == 0) comment_sink = DATA_COMMENT_SINK;
  else {
      /*  See if we want the comment at all.  				*/
      /*  Inserted lines have postfix of {method name}.  		*/
    ptr=strrchr(postfix,*TAG_DELIM);
    if (ptr != NULL) {
      ptr=rem_delims(ptr,TAG_DELIM);
      inserted_line = (strcmp (ptr,METHOD_NAME) == 0);
        /*  rem_delims destroys closing delimiter.  Restore it		*/
      *(ptr+strlen(ptr)) = *(TAG_DELIM+1);
      if (  inserted_line && (! output_opts.inserted_comments)  ) return;
    }

    comment_sink = NON_DATA_COMMENT_SINK;

      /*  See if we want postfix.  Non-inserted lines that are non-	*/
      /*  data comments are (I hope!) comments from opt files		*/
    if (  (   inserted_line && (! output_opts.inserted_comment_id))  ||
	  ( ! inserted_line && (! output_opts.opt_file_comment_id))     )
      postfix = "";
  }
  commout = &output_opts.file[comment_sink];

    /*  Find out if we're adding to buffer and/or writing to file	*/
  write_to_file = (strcmp(commout->sink,ADD_TO_BUFFER_SINK) != 0);
  add_to_buffer = commout->dup  || (! write_to_file);

  lencomment=strlen(comment);
  ptr=strchr(comment,'\n');
  if (ptr != NULL) {
    if (ptr != comment + lencomment - 1) 
      err ("Comment contains embedded newline char\n   Bad comment = ",comment);
      /*  Remove newline.  Will add after postfix			*/
    *ptr = '\0';
    lencomment--;
  }

    /*  Add to the comment buffer					*/
  if (add_to_buffer) {
      /*  If line too long, must abort if an html tag because trun-	*/
      /*  cation could truncate tag, producing bad html effect.  By	*/
      /*  agreement (mtg Feb 96), comment is tag if first char is <	*/
      /*  This is only a problem if we're not writing comment to a file	*/
      /*    (= comment processed by outer, = we're adding to buffer)	*/
    if (  (lencomment > MAXCOMMENTLINE) && (*comment == HTML_TAG_START)  )
      err ("Comment line containing html tag too long\n   Comment = ",
	comment);
      /*  Restrict postfix display by display width.  Set pointer to	*/
      /*  logical end of buffer						*/
    tabcomments_ptr = 
      pack_comment_into_buffer (tabcomments_ptr,tabcomments+COMMENTSIZE,
        comment,postfix,EFFECTIVE_DISPLAY_WIDTH);
  }

    /*  Write to comment sink						*/
  if (write_to_file) {
    pack_comment_into_buffer (line, line+MAXCOMMENTLINE+1, /* +1 for NL	*/
      comment,postfix,MAXCOMMENTLINE);
    if ( ! *(commout->open_ptr) )
      if ( *(commout->mode_ptr) == NULL ) *(commout->mode_ptr) = "a";
      if (strcmp(commout->sink,STDOUT_DEVICE) == 0)
	*(commout->stream_ptr) = stdout;
      else if (strcmp(commout->sink,STDERR_DEVICE) == 0)
	*(commout->stream_ptr) = stderr;
      else *(commout->stream_ptr) = fopen(commout->sink,*(commout->mode_ptr));
      if (*(commout->stream_ptr) == NULL)
        err ("Cannot open comment sink\n   File = ",commout->sink);
      else *(commout->open_ptr) = TRUE;
    fprintf (*(commout->stream_ptr),"%s",line);
  }

  return;
}

int null_data(file)
struct fileinfo *file;
{
  file->eod = TRUE;

  if (strcmp(file->descrip,"datafile") == 0) {
    strcpy(file->buf,MISSING_VALUE_STRING);
    (file->nrecs)++;
    do_data_trace(file,file->buf,1,*(diagout->stream_ptr));
    return -1;
  } else
    return 0;
}

int getrec_proccomment (file,postfix)
char *postfix;
struct fileinfo *file;
/*  Does all reading for defgb						*/
/*	In cases where multiple "files" are coming from a single data	*/
/*  stream (eg; input is JGOFS object, or script that wants to provide	*/
/*  all data), this routine must be called in the "correct" order.	*/
/*  This is ioreadrec's problem.  It, in turn, depends on outer to do	*/
/*  the honors								*/
/*									*/
/*  Called in 2 modes-null or non-null postfix string			*/
/*	Non-null postfix corresponds to expected comments.  Called at	*/
/*  start of a level, with nothing in buf.  Read all comments into 	*/
/*  tabcomments.  Result is single string with embedded newline 	*/
/*  characters.  Add postfix argument to each comment line 		*/
/*	Null postfix corresponds to unexpected comments.  buf contains	*/
/*  potential comment.  Skip all comments				*/
/*	File's record counter is incremented after every successful 	*/
/*  read.  do_data_trace is called to copy the input line if set up to	*/
/*  do so via the diagnostics optional file.				*/
/*									*/
/*  Return values: -1, 0, 1						*/
/*	 1 means buffer contains data.  Any comments have been		*/
/*		processed as above.					*/
/*	 0 means that there was an error or an EOD has been encountered	*/
/*		If the latter, EOD bit is set.  If EOD was caused by	*/
/*		EOF, EOF bit is set					*/
/*	-1 is a special return for data files.  It means that there	*/
/*		were no data records in the file.  Any			*/
/*		comments have been processed as above.  EOD bit is	*/
/*		set, so next read will return 0.  If EOD was caused by	*/
/*		EOF, EOF bit is set					*/
/*  Implicit returns: EOD & EOF bits; count of all records read and	*/
/*	data records read.  -1 returns increment both counters for	*/
/*	data files (as if a line of "missing" indicators was in file).	*/
/*	For object input, count reflects number of jdbread_ calls	*/
/*									*/
/*  "Files" whose data does not correspond to an external source never	*/
/*	get their EOF bit set.  Therefore it is safe to close files	*/
/*	based on their EOF bits						*/
/*									*/
/*	Uses object global variables, others?				*/
{
  int len;
  int valsize = MAXOBJTOKEN+1;	/* See jdbreada_			*/
  char *buf;
  FILE *diag_stream;

    /*  Don't read beyond logical EOD.  This is on a logical, not	*/
    /*  physical file level, and is independent of file being open, etc	*/
  if (file->eod) return 0;

  buf = file->buf;
  diag_stream = *(diagout->stream_ptr);

  switch (file->source_type) {
      /*  Handle case where "file" doesn't exist.  Supply an "nd" for	*/
      /*  tracing purposes only.  We could have created a legit full	*/
      /*  line of "nd"s and let ioreadrec parse them, but easier to let	*/
      /*  ioreadrec just use the already-set-up "all vars missing" data	*/
    case CREATE_NULL_DATA:
      return null_data(file);

      /*  Handle case where "file" is just 1 saved record		*/
    case INDIRECT_FILE_LINE:
      (file->nrecs)++;
      len=strlen(file->source);
      if (   (len >= MAXREC) && ( *(file->source + len - 1) != '\n' )   )
	err ("Input record exceeds buffer size or no newline\n   Inp record = ",
	  file->source);
      strcpy(buf,file->source);
      do_data_trace(file,buf,1,diag_stream);
      file->eod = TRUE;

      if (buf[0] == COMMENT_CHAR) {
	add_to_comment_stream(postfix,buf+1);
	  /*  If only line is comment, we have a file w/no data in it	*/
	return null_data(file);
      } else
        return 1;

      /*  Handle case where file is object				*/
      /*  Note that since we are emulating "real data" mode, we get a	*/
      /*    new file structure per level even though it's all one	*/
      /*    object.  Thus we have new nrecs, objlevel, etc		*/
    case JGOFS_OBJECT:

      if (objeof) {
        file->eod = TRUE;
        return 0;
      }
	/*  Each read returns data from the "next" level to the max	*/
	/*  level so read each time level you want isn't in that range	*/
	/*  jdbread returns -1 for EOF, -999 for err, others??  Pos	*/
	/*  vals are (I think) lowest "new" level filled in		*/
	/*  See jdbread.c for more.					*/
      while  (file->objlevel  < jdblev) {
	jdblev = jdbreada_(&jdbunit,objvalues,&valsize);
	(file->nrecs)++;
	do_data_trace(file,objvalues,ncnt,diag_stream);
	objeof = (jdblev < 0);
	  /*  If level "goes back up" = no more data at this level =	*/
	  /*  data at some other level, we have EOD.  			*/
	  /*    Note if file->objlevel != jdblev+1, there is an error	*/
	  /*    in the structure as I understand it.  Also note I'm too	*/
	  /*    lazy/unsure to test...					*/
	if (  objeof || (file->objlevel > jdblev)  )  {
	  file->eod = TRUE;
	  return 0;
	}
      }
	/*  jdb routines' internal comment buffer is filled "during"	*/
	/*  first jdbread/jdbreada.  Emulate situation where comments	*/
	/*  preceded data in a "noheader" environment.			*/
	/*  Must wait until after a read so that comments get into	*/
	/*  buffer, but process before data is passed back since	*/
	/*  comments logically precede data				*/
      while (jdbcomments_(&jdbunit,buf) != 0)
	if (postfix != NULL) add_to_comment_stream(postfix,buf);

      jdblev++;		/* Mark this level as processed			*/
      return 1;

      /*    Reading from file or child process...			*/
      /*  Read until there's a record without a leading #		*/
      /*  If appropriate, save contents of records			*/
      /*  If string starts with error token, treat as error.  Requires	*/
      /*    coordination of tokens, which (v 2.3) is not yet 		*/
      /*    automatically done						*/
      /*  If immediate EOF, supply a record of missing values		*/
      /*  Also, count records and, if asked, print every so often	*/
  default:
    while (TRUE) {
      if (fgets(buf,MAXREC,file->stream) == NULL) {
	file->eof = TRUE;
	file->eod = TRUE;
	if (ferror(file->stream) != 0) err ("File read error ",file->source);

	  /*  If no data in a data file, supply a "missing value"	*/
	  /*  record and convert file source to CREATE_NULL_DATA so	*/
	  /*  that any followon levels will be handled correctly.	*/
	if (file->ndatarecs == 0) {
	  file->source_type = CREATE_NULL_DATA;
          return null_data(file);
        } else
	  return 0;
      }

      (file->nrecs)++;
      do_data_trace(file,buf,1,diag_stream);

      len=strlen(buf);

	/*  Skip "blank" lines & keep reading				*/
      if (strspn(buf,file->item_separators) != len) {
	if (strncmp(buf,ERR_PREFIX,strlen(ERR_PREFIX)) == 0)  err (buf,"");
	if (  (len >= MAXREC) && (buf[len-1] != '\n')  )
	  err ("Input record exceeds buffer size or no newline\n   \
Inp record begins with ",buf);

	  /*  Next line is how we get out of here!!			*/
	if (buf[0] != COMMENT_CHAR) break;

	  /*  +1 in line below is really +strlen(COMMENT_CHAR)		*/
	if (postfix != NULL) add_to_comment_stream(postfix,buf+1);
      }
    }

    return 1;
  }

  /*  Should never get here-each section of switch logically ends w/ a	*/
  /*  return (I hope)							*/
}

void scanheader_obj(lev)
int lev;
/*									*/
/*	    scanheader_obj processes the variable list of a JGOFS	*/
/*	object used as a data source against the master variable list	*/
/*	of the object to which it belongs.				*/
/*	    It notes expected variables missing				*/
/*	as well as noting where each expected variable is in this	*/
/*	subfile (variables need not occur in the same order as in the	*/
/*	master list).							*/
{
  int i,j,k;
  int objlevel;
  char varname[MAXVARNAMESIZE+1];
  char *tok;

  do_diag_trace (TRACE_PERFILE_ROUTINES,"scanheader_obj\n");

  mark_missing(lev);

  objlevel = datalev[lev].objlevel;

    /*  Loop for all variables in the input object at its level.  Note	*/
    /*  that this is not necessarily the same as the # of variables in	*/
    /*  the master level 0 list of variables at this level.		*/
  for (i=objfirstvarlevel[objlevel]; i<objfirstvarlevel[objlevel+1]; i++) {
    tok = objnames[i];
      /*  Translate variable name if necessary				*/
    if (datalev[lev].pre_trans)
      if (transvar(varname,MAXVARNAMESIZE,tok) == -1) 
        err ("Translated variable name too long\n   Name (pre-trans) = ",tok);
      else tok=varname;

      /*  Find token in table of names on this level.  If it can't 	*/
      /*  be found, or if it's found twice, error.  Otherwise, set	*/
      /*  its pointer to where it's found in this sublevel		*/
    for (k=firstvarlevel[lev]; k<firstvarlevel[lev+1]; k++) 
      if (strcmp(tabnames[k],tok)==0) break;
    if (k==firstvarlevel[lev+1]) err("New variable name in file\n   Name = ",tok);
      /*  Check if this variable matches another on this level	*/
    for (j=k+1; j<firstvarlevel[lev+1]; j++) 
      if (strcmp(tabnames[j],tok) == 0) 
	err ("Duplicate variable name (after translation, if any)\n   Name = ",
	 tok);
    pointers[datalev[lev].lastvar++]=k;
  }

  do_diag_trace (TRACE_PERFILE_ROUTINES,"end scanheader_obj\n");

  return;
}

/*****************    Begin scanheader   ********************************/
void scanheader(lev)
int lev;
/*									*/
/*	    scanheader reads the portion of a JGOFS-formatted data 	*/
/*	file that occurs before the actual data.  This portion includes	*/
/*	any comment lines, and the variable list for this data file	*/
/*	and any that occur below it.					*/
/*	    Data sets can consist of many data files.  The top-most	*/
/*	data file usually contains the master variable list and, if so,	*/
/*	is processed by routine scanheader0 - see doc for optional file	*/
/*	varlist.  If not, it is treated as described herein.		*/
/*	    Scanheader verifies the variable list of the file against	*/
/*	the master variable list.  It notes expected variables missing	*/
/*	as well as noting where each existing variable in this subfile	*/
/*	is located in the master list (variables need not occur in the	*/
/*	same order as in the master list).  It counts how many vari-	*/
/*	bles are present.  It creates a list of where each fixed field	*/
/*	variable begins if this level contains fixed field data.	*/
/*	    It then skips over the lists of variables for levels below	*/
/*	the one being processed.  There must be as many lines of	*/
/*	variable names as there are subfiles from this level and below.	*/

{
			
int i,k;
int inp_index;
char *attr;
static char varname[MAXVARNAMESIZE+1];
char *tok;
char *separators;

do_diag_trace (TRACE_PERFILE_ROUTINES,"scanheader_\n");

mark_missing(lev);

  /*  Haven't determined fixed/free status of this level yet		*/
inp_index = -1;		/* For fixed-field; position within data record	*/

  /*  On return, buffer contains first non-comment record, which is THE	*/
  /*  record containing variables at this level				*/
if (getrec_proccomment (&datalev[lev],"")==0) 
  err ("EOF/error at or before variable list","");

separators = datalev[lev].item_separators;
tok = strtok (datalev[lev].buf,separators);
while (tok != NULL) {

  tok = rem_delims (tok,"\"\"");

    /*  Remove attribute string, if any.				*/
    /*  Assumed that open delim precedes close delim			*/
  if ( (attr=strpbrk(tok,ATTR_DELIM)) != NULL) *attr='\0';

    /*	What's left is variable name.  Translate it if necessary	*/
  if (*tok == '\0')
    err ("Zero length variable name in record ",datalev[lev].buf);
  if (datalev[lev].pre_trans)
    if (transvar(varname,MAXVARNAMESIZE,tok) == -1) 
      err ("Translated variable name too long\n   Name (pre-trans) = ",tok);
    else tok=varname;

  if (*tok != LEVEL_CONTINUATION_CHAR) {
	/*  Find token in table of names on this level.  If it can't 	*/
	/*  be found, or if it's found twice, error.  Otherwise, set	*/
	/*  its pointer to where it's found				*/
    for (k = firstvarlevel[lev]; k < firstvarlevel[lev+1]; k++)
      if(strcmp(tabnames[k],tok)==0) break;
    if (k==firstvarlevel[lev+1])
      err("New variable name in file\n   Name = ",tok);
      /*  Check if this variable matches another on this level	*/
    for (i=k+1; i<firstvarlevel[lev]; i++) 
      if (strcmp(tabnames[i],tok) == 0) 
	err ("Duplicate variable name (after translation, if any)\n   Name = ",
	 tok);
    pointers[datalev[lev].lastvar++]=k;
	/*  Build a table of starting positions of fixed-format 	*/
	/*  variables if this is a fixed-format level.  Since 		*/
	/*  order of variables can change between levels, 		*/
	/*  starting columns can change					*/
    switch (inp_index) {
      case -1:
	  /*  First variable of this level				*/
	inpstarts[k] = 0;	   /*  In case data is fixed		*/
	inp_index = inpwidths[k];  /*  This is also fixed/free flag	*/
	break;
      case 0:
	  /*  Free-field level						*/
	if (inpwidths[k] != 0)
	  err ("Mixed fixed/free format input\n   Variable= ",tabnames[k]);
	break;
      default:
	  /*  Fixed-field level						*/
	if (inpwidths[k] == 0)
	  err ("Mixed fixed/free format input\n   Variable= ",tabnames[k]);
	else {
	  inpstarts[k]=inp_index;
	  inp_index += inpwidths[k];
	}
	break;
    }
  }
  tok=strtok(NULL,separators);
}

/*  All tokens processed, which means this level processed		*/
/*  Skip over records corresponding to the variable lists of lower	*/
/*	levels								*/
for (i=lev;i<maxlev;i++)
  if(getrec_proccomment(&datalev[lev],NULL) ==0)
    err ("EOF/error trying to read a variable list record","");

/*  Save largest possible length for records on this level.		*/
/*    Individual records can be variable length, in that fixed		*/
/*  fields beyond end are considered missing, but this is length if all	*/
/*  variables in this header show up.					*/
/*    0 means this is a free-field level				*/
datalev[lev].maxlenrec = inp_index;
  
do_diag_trace (TRACE_PERFILE_ROUTINES,"end scanheader_\n");

return;
}
/*									*/
/*****************      End scanheader   ********************************/

int get_int_from_string (string,min,max,delim,errmsg)
char *string,*errmsg,delim;
int min,max;
{
  int value;
  char *end_ptr;

  value = strtol (string,&end_ptr,10);
    /*  Check that scan was terminated by delimiter or end-of-string	*/
  if (  ! ((*end_ptr == '\0') || (*end_ptr == delim))  )
    err ("Non-numeric input ",errmsg);

  if (  (value < min) || (value > max)  )
    err ("Integer value too big or too small ",errmsg);

  return value;
}

char *get_int_from_keyword(value,keyword,wjstbl,min,max,wjstbl_id)
char *keyword,*wjstbl,*wjstbl_id;
int *value,min,max;
/*  wjstbl_id is for error messages					*/
/*  Returns start of where it found integer string; NULL if not found	*/
/*  Integer value goes into *value; 0 if key not found			*/
{
  char *keyval;

  keyval=lookup_wjstbl(keyword,wjstbl);
  if (keyval == NULL) *value = 0;
  else
    *value = get_int_from_string(keyval,min,max,wjstbl[strlen(wjstbl)-1],
      buildstring(wjstbl_id," keyword ",keyword,
	" building get_int_from_keyword msg"));

  return keyval;
}

void striptoken(p)
char *p;
{
  char *tp;
  int i;

	/* Strip any extending characters at end of string		*/
  i = strlen(p);
  while ( (tp = strrchr(p,W_EXTEND)) == p+i-1) {
     *tp = '\0';        /* shorten string by that one extend char */
     i = strlen(p);
  };
  return;
}

int getwidth_from_attr(ptr)
/* read the width from the string 'ptr' (an attribute that has
        been tested prior to coming here for containing the 
        string 'width=') and return it
*/
char *ptr;
{
  char *p,*end_ptr;
  int len;

  p = strchr(ptr,'=');

  len = strtol (p+1,&end_ptr,10);
    /*  Check that scan was terminated by attribute separator or	*/
    /*  end-of-string							*/
  if (!  ( (*end_ptr == '\0') || (*end_ptr == ATTRIB_SEP) )  ) len = -1;

  return len;
}

int make_and_save_width(ptr, attr, fixed_width, opt_width, pre_trans_width)
int fixed_width, opt_width, pre_trans_width;
char *ptr, attr[];
/*	Routine to determine output field width of a variable and save 	*/
/*	it as a data attribute and an integer.  There are 4 ways the 	*/
/*	width can be determined						*/
/*		1) Use value from dispwidths opt file, if any		*/
/*		2) Failing that, the user can have explicitly specified	*/
/*		   a "width=" data attribute.  Use that width.		*/
/*		3) Failing that, the user could have padded the		*/
/*		   variable name to the desired width with spacer 	*/
/*		   characters (defined by constant W_EXTEND).  Use	*/
/*		   that width.  This extension can be on pre- or post-	*/
/*		   translation name.  Use pre-translation width if it	*/
/*		   exceeds post-translation width			*/
/*		4) Failing that, we have no clues from the user		*/
/*		   Calculate the width of the post-translation variable	*/
/*		   name itself and use the max of that width and the	*/
/*		   input field width if input is fixed field.		*/
/*	Routine receives the title string (pointed to by 'ptr'), its	*/
/*	  attribute list, the fixed width of the field (0 for free 	*/
/*	  field input), the width for the field from any dispwidths	*/
/*	  file (0 if not in the dispwidths file) and the width of the	*/
/*	  field as padded by W_EXTEND characters(pre-translation) (0 if	*/
/*	  no padding done to pre-translation name)			*/
/*	An attribute beginning with 'width=' is constructed (or an	*/
/*	  existing one modified) to be saved in the calling routine.	*/
{
  int len,extended_width,explicit_width = 0;
  char attr_sep_string[1+1] = { ATTRIB_SEP, '\0' };
  char *end_ptr,*attr_ptr;

    /* Get len of (possibly) extended label (last char is W_EXTEND)	*/
    /* then strip off extenders.  Must do strip whether we use this	*/
    /* as the width source or not					*/
  extended_width = strlen(ptr);
  if (ptr[extended_width-1] == W_EXTEND) striptoken(ptr);
    /* Use pre-translation extended width if it's bigger...		*/
  if (pre_trans_width > extended_width) extended_width = pre_trans_width;

    /*  Copy attribute string without width= attrib.  If width= found	*/
    /*  get its value.  Could ALMOST use ioattrout_ for this, but, 	*/
    /*  among other things, it uses strtok, and this routine is		*/
    /*  called within a loop already using strtok...			*/
  attr_ptr = attr - 1;
  while ( attr_ptr++ != NULL) {
    if (strncmp(attr_ptr,"width=",6) == 0) {
	  /*  Get the width						*/
      if (  (explicit_width = getwidth_from_attr(attr_ptr)) <= 0  )
	 err ("0 length or non-numeric width attribute for variable ",ptr);
	  /*  Copy stuff after concluding ;, if anything, overwriting	*/
	  /*  width=.  If nothing, terminate string before width=.	*/
      if (  (end_ptr = strchr(attr_ptr,ATTRIB_SEP)) == NULL  ) *attr_ptr = '\0';
      else strcpy (attr_ptr,++end_ptr);  /* get beyond ; before copying	*/
      break;
    }
    attr_ptr = strchr(attr_ptr,ATTRIB_SEP);
  }
    /*  Make sure non-empty attr string ends w/ ; 			*/
  if (*attr != '\0')
    if (  attr[strlen(attr)-1] != ATTRIB_SEP  ) strcat (attr,attr_sep_string);

  len = strlen(ptr);				      /* Var name len	*/
  if (opt_width > 0) len = opt_width;		      /* From opt file	*/
  else if (explicit_width > 0) len = explicit_width;  /* width=		*/
  else if (extended_width > len) len = extended_width; /* Padded with _s */
  else if (fixed_width > len) len = fixed_width;      /* Fixed field len */

    /*  Add width to end of (possibly null) input attr string		*/
  sprintf( &attr[strlen(attr)], "width=%d", len);

  return len;
}

int strip_varname_addends(ptr,attrsav,delim)
char *ptr,*attrsav,*delim;
  /*  Variable names can be followed by extender characters indicating	*/
  /*    the width to be used when the data for this variable is dis-	*/
  /*	played.  This string can be followed by an attribute list	*/
  /*  This routine processes and removes the added strings		*/
  /*  It returns the extended field width (0 if no extender characters)	*/
  /*  Any attribute string, without its delimiters, is put into the 	*/
  /*    caller's buffer.  If no attribute, put null string in buffer	*/
  /*  If there are width extender characters, save the width of name +	*/
  /*	extender string							*/
{
  char *attr;
  int extended_width;

  if ( (attr=strchr(ptr,*delim)) == NULL) attrsav[0]='\0';
  else {
    attr = rem_delims (attr,delim);
    if (strlen(attr) > TOKEN) err ("Attribute too long\n   Attribute = ",attr);
    strcpy(attrsav,attr);
    *(attr-1)='\0';	/* Terminate variable name at site of [		*/
  }
    /* Get len of (possibly) extended label (last char is W_EXTEND)	*/
    /* then strip off extenders.  Must do strip whether we use this	*/
    /* as the width source or not					*/
  extended_width = strlen(ptr);
  if (ptr[extended_width-1] == W_EXTEND) {
    striptoken(ptr);
    return extended_width;
  } else return 0;

}

/*****************    Begin scanheader0   *******************************/
int scanheader0(fptr,total_number_variables)
struct fileinfo *fptr;
int *total_number_variables;
/*									*/
/*	    scanheader0 reads the master variable list for this object	*/
/*	This list defines what variable names can appear in the object,	*/
/*	as well as defining the subfile (level) structure of the object	*/
/*	The master variable list usually appears in the "level 0" data	*/
/*	file, but can also appear in a file of its own (see varlist	*/
/*	optional file doc).						*/
/*	    scanheader0 creates several lists.  It saves the list of	*/
/*	variables (translated if necessary-see transvar optional file	*/
/*	doc).  It saves the variables' attribute lists.  Special	*/
/*	attention is paid to the width attribute.  If not present, one	*/
/*	is calculated (see code in here, or dispwidths optional file	*/
/*	doc).  If it is present, it is a parameter in the calculation.	*/ 
/*	It also creates a list of data field widths (see inpwidths opt	*/
/*	file doc).
/*	    It creates a level split list; that is, it records the 	*/
/*	variable number of the first variable on each level.		*/
/*	    Finally, assuming that the master list is coming from a	*/
/*	data file, it does the scanheader chores for level 0 (simpli-	*/
/*	fied by the fact that there are no missing variables).  If in	*/
/*	fact the master list is coming from a different file, scan-	*/
/*	header will redo those chores when the level 0 file is read.	*/
/*	    scanheader0 returns the total number of variables in the	*/
/*	data set through its argument, and the number of levels in the	*/
/*	data set as its function value					*/

{
			
int i,j;
int pre_trans_extended_width;
char attrsav[TOKEN+1];
char *tok,*end_ptr;
char *separators;

do_diag_trace (TRACE_PERFILE_ROUTINES,"scanheader0\n");

  /*  On return, buffer in structure contains first non-comment record	*/
if (getrec_proccomment (fptr,"")==0) 
  err ("EOF/error at or before variable list","");

ncnt=0;		/* "Live" (global) count of variables processed so far	*/
maxlev=0;
separators = fptr->item_separators;

  /* Loop, reading records, until we find one that does not end with >	*/
while (TRUE) {

  tok=strtok(fptr->buf,separators);
  while (tok != NULL) {
    tok = rem_delims (tok,"\"\"");
    pre_trans_extended_width = strip_varname_addends(tok,attrsav,ATTR_DELIM);
      /*  What's left is variable name.  Store it permanently, trans-	*/
      /*  lating if necessary						*/
      /*  Didn't do it sooner because variable + attribute might be 	*/
      /*  too long while neither is too long by itself			*/
    if (*tok == '\0') err ("Zero length variable name in record ",fptr->buf);
    if (fptr->pre_trans) {
      if (transvar(tabnames[ncnt],MAXVARNAMESIZE,tok) == -1) 
        err ("Translated variable name too long\n   Name (pre-trans) = ",tok);
    } else {
      if (strlen(tok)>MAXVARNAMESIZE) 
	err ("Variable name too long.\n   Name = ",tok);
      strcpy(tabnames[ncnt], tok);
    }
    tok=tabnames[ncnt];

    if (lookup_lev0varlist(tok) >= 0)
      err ("Duplicate variable name (after translation, if any)\n   Name = ",
	tok);

      /*  Create list of widths of fixed format variables (if any) in	*/
      /*  the order they appear						*/
    get_int_from_keyword
      (&inpwidths[ncnt],tok,var_data_widths,0,MAXREC,"inpwidths");

      /*  Create "width=" attribute if necessary, and save name, 	*/
      /*  output width, and attributes of variable in tabxxx arrays	*/
      /*    Get width for this variable, if any, from dispwidths file	*/
    get_int_from_keyword (&i,tok,disp_data_widths,0,LONG_MAX,"dispwidths");
      /*    Have fun getting "actual" width!				*/
    tabwidths[ncnt] =
      make_and_save_width(tok,attrsav,inpwidths[ncnt],i,pre_trans_extended_width);
    strcpy(tabattributes[ncnt],attrsav);

    ncnt++;

    tok=strtok(NULL,separators);
  }

    /*  All tokens processed, which means this level processed		*/
    /*  If last variable was the new level character, don't count it 	*/
    /*    as a variable, but advance the level counter, save the number	*/
    /*    of variables found in the level just completed, and read next */
    /*    record							*/
    /*  If it wasn't, we're done.  Leave after saving number of 	*/
    /*    variables found in the lowest level 				*/
  if (tabnames[ncnt-1][0]==LEVEL_CONTINUATION_CHAR) {
    --ncnt;				/* Worked w/these 3 on same	*/
    firstvarlevel[maxlev+1]= ncnt;	/*   line, but see		*/
    maxlev++;				/*     pointers[ncnt] above	*/
    if (maxlev >= MAXLEVELS) 
      errn ("Too many data levels.  Allowed maximum = ",MAXLEVELS);
    if (getrec_proccomment(fptr,NULL) == 0)
      err ("EOF/error trying to read a variable list record","");
  } else {
    firstvarlevel[maxlev+1]=ncnt;
    break;
  }
}

  /*  At this point, we've finished processing all header lines		*/
if (ncnt == 0) err ("No variables found after scan of level 0 list","");
if (ncnt >= NVAR) 
  errn ("Too many variables found after scan of level 0 list.  Max = ",NVAR);
*total_number_variables=ncnt;

  /*  scanheader work for level 0					*/
  /*	Logically, scanheader0 is called for the "master list file",	*/
  /*	which is closed after use.  ioreadrec would then open the level	*/
  /*	0 file, and end up doing the work below.  That would avoid this	*/
  /*	wart, as well as the close file/don't close file wart in ioopen	*/
  /*	However, an extra open could have performance impact if what's	*/
  /*	being opened is not a file (assumes file opens have no impact!)	*/
datalev[0].lastvar = firstvarlevel[1];
for (j=0; j<firstvarlevel[1]; j++) pointers[j] = j;

  /*	Check that variables on this level are either all fixed width	*/
  /*	or none fixed width						*/
for (j=1; j<firstvarlevel[1]; j++) {
  if (    (  (inpwidths[j-1] == 0) && (inpwidths[j] != 0)  )   ||
	  (  (inpwidths[j-1] != 0) && (inpwidths[j] == 0)  )     )
	      err ("Mixed fixed/free format input\n   Variable= ",tabnames[j]);
}
if (inpwidths[0] == 0) datalev[0].maxlenrec = 0;
else {
  inpstarts[0] = 0;
  for (j=0; j<firstvarlevel[1]-1; j++)
    inpstarts[j+1] = inpstarts[j] + inpwidths[j];
  datalev[0].maxlenrec = inpstarts[j] + inpwidths[j];
}


do_diag_trace (TRACE_PERFILE_ROUTINES,"end scanheader0\n");

return maxlev;
}
/*									*/
/*****************      End scanheader0   *******************************/

int scanheader0_obj(fptr,total_number_variables)
int *total_number_variables;
struct fileinfo *fptr;
/*									*/
/*	    scanheader0_obj performs those portions of scanheader0	*/
/*	that are appropriate if the level 0 input comes from a JGOFS	*/
/*	object instead of a def-formatted input file.  Generally,	*/
/*	these portions are subsets of scanheader0, but there are some	*/
/*	things peculiar to object input.  Undoubtedly, we will have	*/
/*	future trouble keeping things parallel.  Sigh.			*/
/*	    See the jdbopen call in open_datafile to see what's		*/
/*	already been set up on entry here, as well as scanheader0	*/
/*	to see what machinations are done in the general case		*/

/*	Implicit input (all set up in jdbopen call):			*/
/*	  objmaxlev, objncnt (validity checked)				*/
/*	  objnames							*/
/*	ncnt is "live" count of variables processed so far		*/
{
			
int i,j;
char attrsav[TOKEN+1];
char *ptr,*end_attrsav;

do_diag_trace (TRACE_PERFILE_ROUTINES,"scanheader0_obj\n");

for (i=0; i<=objmaxlev+1; i++) firstvarlevel[i] = objfirstvarlevel[i];

ncnt = 0;

  /*  Loop per variable in object					*/
  /*    i is the "in-progress" var; ncnt (global) is the # processed...	*/
for (i=0; i<objncnt; i++) {
    /*  Rebuild attribute string from individual attribs		*/
  ptr = attrsav;
  end_attrsav = attrsav + TOKEN;
  while (jdbattributes_(&jdbunit,&i,ptr) != 0) {
      /*  Next test is too late, of course... (strict > is correct	*/
      /*  since buffer size is actually 1 bigger)			*/
    if (  (ptr += strlen(ptr)) > end_attrsav  )
      err ("Attribute too long\n   Attribute = ",attrsav);
    *(ptr++) = ATTRIB_SEP;
  }
  if (ptr != attrsav) ptr--;
  *ptr = '\0';

    /* Translate/copy variable & check for dups				*/
  if (transvar(tabnames[i],MAXVARNAMESIZE,objnames[i]) == -1) 
    err ("Translated variable name too long\n   Name (pre-trans) = ",
      objnames[i]);
  if (lookup_lev0varlist(tabnames[i]) >= 0)
    err ("Duplicate variable name (after translation, if any)\n   Name = ",
      tabnames[i]);

    /*  Create "width=" attribute if necessary, and save	 	*/
    /*  output width and attributes of variable in tabxxx arrays	*/
    /*    Get width for this variable, if any, from dispwidths file	*/
  get_int_from_keyword (&j,tabnames[i],disp_data_widths,0,LONG_MAX,"dispwidths");
  tabwidths[i] = make_and_save_width(tabnames[i],attrsav,0,j,0);
  strcpy(tabattributes[i],attrsav);
  ncnt++;
}

*total_number_variables=ncnt;

  /* scanheader work for level 0					*/
datalev[0].lastvar = firstvarlevel[1];
for (j=0; j<firstvarlevel[1]; j++) pointers[j] = j;

do_diag_trace (TRACE_PERFILE_ROUTINES,"end scanheader0_obj\n");

return objmaxlev;
}

void open_datafile(file)
struct fileinfo *file;
/*  open_datafile opens file as a datafile. This structure was init'ed	*/
/*  when we processed the "next level file" item from the level above	*/
/*  Should only return if open succeeded				*/
{
  char *tmp;
  char tmp2[2] = {'\0','\0'};
  int i,reqlevel;
  int varnamesize;

  if (max_trace_level >= TRACE_PERFILE_ROUTINES) {
    tmp = buildstring("open ",file->source,"\n", " building trace msg");
    do_diag_trace (TRACE_PERFILE_ROUTINES,tmp);
    free (tmp);
  }

  switch (file->source_type) {

    case COMMAND_FILE:
      if (READ_COMMANDS)
	  /*  startchild is not supposed to return unless successful	*/
	  /*    (Note that dummy startchild used on WJS for testing	*/
	  /*     DOES return even though it does nothing.  Blows up	*/
	  /*     when read fails and ferror gets a 0 stream ...)	*/
	startchild(file->source, &scriptstream, &file->stream);
      else
	err ("Command/script input requested but method not compiled with this \
capability\n   Desired command was ",file->source);
      break;


    case DATA_FILE:
      if (  (file->stream = fopen(file->source,"r"))  == NULL   )
        err("Missing file ",file->source);
      break;


    case CREATE_NULL_DATA:
      break;


    case JGOFS_OBJECT:
      if (READ_OBJECTS) {
	  /*  For values of next 2, see jdbopen_			*/
	objncnt = -NVAR;
	varnamesize = MAXOBJVARNAMESIZE + 1;
	objmaxlev = jdbopen_ (&jdbunit, file->source, objnames, 
	  &varnamesize, &objncnt);
	if (objmaxlev < 0) 
	  err("Failure to access JGOFS data object ",file->source);

	  /*  Check desired last level in this call to the method.	*/
	  /*  If less data needed than all levels of the object, re-	*/
	  /*  open object, only requesting needed data.  This is an	*/
	  /*  an efficiency item only, and uses a non-guaranteed way	*/
	  /*  of determining the last level.				*/
	  /*  Code derived from outerw.c (pre JGOFS 1.5 release) -	*/
	  /*    level is single digit after .html or .flat in PATH_INFO	*/
	  /*    environment variable					*/
	  /*		*** NB ***					*/
	  /*	It appears that because outer has already looked up	*/
	  /*  PATH_INFO, we get a pointer to its string.  Worse, outer	*/
	  /*  has altered the string, replacing the . with null.  Ergo	*/
	  /*  the weird code below. THIS INTERFACE SHOULD BE REPLACED	*/
	if (  (tmp=getenv("PATH_INFO")) != NULL  ) {
	    /*  Get beyond end of string.  Assume that if the 4 chars	*/
	    /*  after that are what we're looking for, they were part	*/
	    /*  of string, and that 5th char is level			*/
	  tmp += strlen(tmp) + 1;
	    /*  Hope next 4 addresses are legal!			*/
	  if (  (strncmp(tmp,"html",4) == 0) ||
		(strncmp(tmp,"flat",4) == 0)    )  {
	    reqlevel = *(tmp+4) - '0';
	      /*  reqlevel - file->level is the last level we need from	*/
	      /*  this JGOFS object.  If JGOFS object has more levels,	*/
	      /*  reopen object, selecting only variables at levels we	*/
	      /*  need. 						*/
	    if (objmaxlev > reqlevel - file->level)  {

	        /*  Add selection string to object spec.

	        /*    If obj spec doesn't have string, add one; else	*/
	        /*    prep spec to append to existing string		*/
	      if ( *(tmp = file->source + strlen(file->source) -1) ==
			OBJECT_PARAM_STRING_DELIM[1])
		  /*    Replace close paren with comma			*/
	        *tmp = OBJECT_PARAM_STRING_SEP;
	      else {
		  /*    Add comma to end of source string		*/
	        *tmp2 = OBJECT_PARAM_STRING_DELIM[0];
	        file->source = lengthen_str_and_free(file->source,tmp2,NULL,100,
				" building object selection string 1");
	      }

	      i = 0;
	      *tmp2 = OBJECT_PARAM_STRING_SEP;
	      while (jdblevel_(&jdbunit,&i) <= reqlevel - file->level)
	        file->source = lengthen_str_and_free(file->source,
					objnames[i++],tmp2,
					100,
					" building object selection string 2");
	        /*  Replace last comma with terminating close paren	*/
	      *(file->source + strlen(file->source) - 1) =
		OBJECT_PARAM_STRING_DELIM[1];

	        /*  Reopen object with selection in place		*/
	      jdbclose_(&jdbunit);
	      objncnt = -NVAR;
	      varnamesize = MAXOBJVARNAMESIZE + 1;
	      objmaxlev = jdbopen_ (&jdbunit, file->source, objnames, 
	        &varnamesize, &objncnt);
	      if (objmaxlev < 0) 
	        err("Failure to access JGOFS data object ",file->source);
	    }
	  }
	}

	if (objmaxlev >= MAXLEVELS) 
	  errn ("Too many data levels in JGOFS object.  Allowed maximum = ",
	    MAXLEVELS);
	if (  (objncnt > NVAR) || (objncnt <= 0)  )
	  err("0, negative or too many variables in JGOFS object ",
	    file->source);

	    /*  Build table of level splits				*/
	    /*    Assume jdblevel return is legit.  Returns -1 if i	*/
	    /*    too big but that should be OK.  Returns ? (0?) if	*/
	    /*    jdbunit "invalid", but 0 is a legit return, too...	*/
	for (i=0; i<=objmaxlev+1; i++) objfirstvarlevel[i]=0;
	    /*    Loop per variable in object, getting counts		*/
	for (i=0; i<objncnt; i++) objfirstvarlevel[jdblevel_(&jdbunit,&i)+1]++;
	    /*	  Change per-level count into "break points"		*/
	for (i=0; i<=objmaxlev; i++)
	  objfirstvarlevel[i+1] += objfirstvarlevel[i];

	    /*  Set up "present level" to force first read		*/
	jdblev = objmaxlev + 1;
	objeof = FALSE;		/*  Temp until indirect file->eof	*/

      } else
	err ("JGOFS object input requested but method not compiled with this \
capability\n   Desired object was ",file->source);
      break;

    default:
      tmp = buildstring(
		"Attempt to open illegal file type as data file\n   File type = ",
		file->descrip,
		"\n   File source type = ",
		" building open_datafile err string");
      *tmp2 = file->source_type;
      err (tmp, tmp2);
      free (tmp);
      break;
  }

  file->open=TRUE;
  file->eod=FALSE;
  file->eof=FALSE;
  file->nrecs=0;	/* A bit deceptive.  Counts between EODs.  If	*/
			/* >1 dataset comes from a single file, this is	*/
			/* NOT the count on the whole file		*/

  return;
}

/******************   Begin ioopen_	*********************************/
/*									*/
/*	"s[0..nparams-1]: parameter strings.  Inner sets s[j][0]=0"	*/
/*	"for any strings which it processes; others will be processed"	*/
/*	"by outer.  Thus selection/projections would normally be"	*/
/*	"ignored by inner."						*/
/*	"nparams: number of parameter strings"				*/
/*	"ntotal (returned): total number of variable names"		*/
/*	ioopen_ also handles the indirect input file, if any, and sets	*/
/*  up each option, which may do things now (like remove 		*/
/*  variables), or prepare for later work by scanheader* & ioreadrec_	*/

int ioopen_(s,nparams,ntotal)
char *s[];
int *nparams,*ntotal;

{
  Logical configure_output();		/*  diagnostics opt file	*/
  int create_wjstbl();			/*  make tbl from opt file	*/
  Logical get_datafield_options();	/*  data file opts opt file	*/
  void get_files();			/*  Indirect file 		*/
  Logical get_latlonparams();		/*  latlonparams opt file	*/
  Logical get_timedateparams();		/*  timedateparams opt file	*/
  Logical get_translation_table();	/*  transvar opt file		*/
  void init_outinfo ();
  void init_time_structs ();
  void init_file_structs ();
  Logical open_and_log_opt();		/*  general opt file opener	*/
  Logical remove_vars ();		/*  removals opt file handler	*/

  char tmp_commentbuf[COMMENTSIZE+1],postfix_buf[MAXCOMMENTLINE+1];
  char *start_lev0comments,*end_lev0comments;
  char *tok,*postfix,*ptr;
  char *source;
  char *separators;
  char *alt_separators;
  int i,len_lev0comments;
  Logical comments_before_lev0comments,comments_after_lev0comments;
  struct fileinfo *fptr;

    /*  Try to force version strings into executable.			*/
  ptr = NONCONFIGH_VERSION;
  ptr = DEFGBH_VERSION;

    /*  Defines debug switch for ioopen_ itself, so must be early	*/
  init_outinfo (&output_opts);

  if (output_opts.trace_level > output_opts.dup_trace_level) 
       max_trace_level = output_opts.trace_level;
  else max_trace_level = output_opts.dup_trace_level;
  if (max_trace_level >= TRACE_IOOPEN) {
    if ( ! *(diagout->open_ptr) )
	/*  mode_ptr init'ed to NULL & nothing's intervened, so change	*/
	/*  it.  If, at runtime, diagout is redirected, this file will 	*/
	/*  be closed and its structures re-init'ed (configure_output)	*/
      *(diagout->mode_ptr) = "a";
	/*  See errout->sink re STDOUT_DEVICE, etc			*/
      if (strcmp(diagout->sink,STDOUT_DEVICE) == 0)
	*(diagout->stream_ptr) = stdout;
      else if (strcmp(diagout->sink,STDERR_DEVICE) == 0)
	*(diagout->stream_ptr) = stderr;
      else *(diagout->stream_ptr) = fopen(diagout->sink,*(diagout->mode_ptr));
      if (*(diagout->stream_ptr) == NULL)
        err ("Cannot open diagnostic sink\n   File = ",	diagout->sink);
      else *(diagout->open_ptr) = TRUE;
    do_diag_trace(TRACE_IOOPEN,"ioopen_\n");
  }

    /*  Can't figure out how to do following in .h file			*/
  if (COMMENT_CHAR == *ERR_PREFIX)
    err (" Special strings may not begin with comment character","");

  tabcomments_ptr = tabcomments;

    /*  Init this, since when processing level 0 list, we'll be		*/
    /*  figuring the first var of level 1				*/
  firstvarlevel[0] = 0;

  init_file_structs (files,&indirect_file);
  init_time_structs (in_timedate,out_timedate,timedatefragbuflist);

  if (*nparams <= 0) errn ("Inner got no args from outer.  # args = ",*nparams);

    /*  Get names of level 0 data file and optional files, if any	*/
  if (s[0][0] == INDIRECT_FILE_CHAR) {
    get_files(files,s[0]+1,&indirect_file,s,*nparams);
    if (files[DATAFILE].source == NULL)
      err ("Level 0 input specifier not found in indirect file ",s[0]+1);
  } else {
    strdupl(&files[DATAFILE].source,s[0]," saving level 0 source info");
      /*  Use indirect file's separators because too lazy to set up	*/
      /*  .object file's separators... for now, anyway			*/
    analy_source(&files[DATAFILE],indirect_file.item_separators,NULL);
  }
    /*  Inner must indicate to outer that this parameter was processed	*/
  s[0][0] = '\0';

  configure_output (&files[DIAGNOSTICS],&output_opts,files);	
  if (output_opts.trace_level > output_opts.dup_trace_level) 
       max_trace_level = output_opts.trace_level;
  else max_trace_level = output_opts.dup_trace_level;
    /*  Open diagnostics stream if not already open  and if any diags	*/
    /*  are requested.  This might still result in an empty file (if	*/
    /*  no diags are produced) but much easier than opening before 	*/
    /*  first output							*/
  if ( ! *(diagout->open_ptr) ) {
    for (i=0; i<NFILETYPES; i++)
      if (files[i].print_lines > 0 || files[i].dup_print_lines > 0) break;
    if (  (i < NFILETYPES)			||
          (max_trace_level > NOTRACE)		||
	  (output_opts.iovalstr > 0)		||
	  (output_opts.dup_iovalstr > 0)	||
	  (output_opts.iovalreal > 0)		||
	  (output_opts.dup_iovalreal > 0)	   ) {
      if ( *(diagout->mode_ptr) == NULL ) *(diagout->mode_ptr) = "a";
	/*  See errout->sink re STDOUT_DEVICE, etc			*/
      if (strcmp(diagout->sink,STDOUT_DEVICE) == 0)
	*(diagout->stream_ptr) = stdout;
      else if (strcmp(diagout->sink,STDERR_DEVICE) == 0)
	*(diagout->stream_ptr) = stderr;
      else *(diagout->stream_ptr) = fopen(diagout->sink,*(diagout->mode_ptr));
      if ( *(diagout->stream_ptr) == NULL ) 
        err ("Cannot open diagnostic sink\n   File = ",	diagout->sink);
      else *diagout->open_ptr = TRUE;
    }
  }
    /*  Reprocess comments we already have stashed in tabcomments	*/
  strcpy(tmp_commentbuf,tabcomments);
  tabcomments_ptr = tabcomments;
  *tabcomments = '\0';
  tok = strtok(tmp_commentbuf,"\n");
    /*  Loop for each saved comment					*/
  while (tok != NULL) {
      /*  Must split postfix off any saved comment for correct		*/
      /*  processing.  Also, length of comment with postfix was 	*/
      /*  determined based on default sink-might now be different.	*/
      /*  Therefore, must strip off blanks before postfix since they	*/
      /*  could have been artificially added...				*/
    if (  (postfix=strrchr(tok,*TAG_DELIM)) == NULL  )  postfix = "";
    else
	/*  Take care of comment consisting entirely of postfix		*/
      if (postfix == tok) tok = "";
      else {
	  /*  Point to first blank after comment.  Use of blank here	*/
	  /*  assumes add_to_comment_stream pads w/blanks		*/
	for (i=postfix-tok-1; i>=0; i--)  if (tok[i] != ' ') break;
	i++;
	  /*  If comment runs right up to postfix, copy postfix so we	*/
	  /*  can terminate comment "on top of" original postfix	*/
	if (tok+i == postfix) postfix = strcpy(postfix_buf,postfix);
	tok[i] = '\0';
      }
    add_to_comment_stream(postfix,tok);
    tok = strtok(NULL,"\n");
  }

    /*    Level 0 data file includes info from opt files, so must be 	*/
    /*  initialized after get_files call.  It also includes diag info,	*/
    /*  so must be init'd after configure_output.			*/
    /*    Note some info applies only to level 0, while some applies	*/
    /*  to all data files.  Latter requires work at other data levels	*/
  datalev[0]=files[DATAFILE];
  datalev[0].level = 0;
  
    /*	Get directory string from full file spec of level 0 file	*/
  switch (datalev[0].source_type) {
    case DATA_FILE:  case COMMAND_FILE:
      strdupl(&dirstring,datalev[0].source,     " saving directory string");

	/*  If command w/parameters, truncate to its file spec portion	*/
	/*  to protect against a / in a parameter.  Assumes no		*/
	/*  SCRIPT_PARAM_SEP chars in a plain file spec			*/
      if (  (ptr = strchr(dirstring,SCRIPT_PARAM_SEP))  !=  NULL  )
	*ptr = '\0';

	/*  If there is a directory, split it from file spec		*/
	/*  after its trailing /					*/
      if (  (ptr = strrchr(dirstring,DIRSEP)) == NULL  )  {
	free (dirstring);
        dirstring = NULL;
      } else *(++ptr) = '\0';      /* Truncate after found /		*/

      break;

    default:
      dirstring = NULL;
      break;
  }

    /*  Must precede anything that might need variable translation	*/
  create_wjstbl(&files[TRANSVAR],trans_list,TRANS_LIST);

  create_wjstbl(&files[INPWIDTHS],var_data_widths,VAR_DATA_WIDTHS);
  create_wjstbl(&files[DISPWIDTHS],disp_data_widths,DISP_DATA_WIDTHS);

  get_datafield_options (
    &files[DATAFIELDOPTS],
    &data_field_trim,
    &significant_consec_separators,
    &significant_embedded_separators,
    &datalev[0].item_separators,
    datalev[0].item_alt_separators
  );

/*  Get & analyze variable list (see scanheader0)			*/
    /*  Use list in opt file if opt file provided; else use lev 0 file	*/
    /*  Logically, this is independent of opening level 0, 		*/
    /*    so could almost use same code.  In particular, closing lev 0	*/
    /*    does no logical harm, nor does accepting VARLIST from object	*/
  if (open_and_log_opt(&files[VARLIST])) {
      /*  Save start (here) and end (below) of level 0 file comments	*/
      /*  so they can be moved to precede any following opt file com-	*/
      /*  ments.  Done here because open_and_log_opt puts in a comment	*/
    start_lev0comments = tabcomments_ptr;
    maxlev = scanheader0(&files[VARLIST],ntotal);
      /*  Decision to close VARLIST does not depend on its eod or eof	*/
      /*  bits, since we are willing to close in the middle of a file	*/
      /*  We do test the open bit in case info does not come from file	*/
    if (files[VARLIST].open) {
      fclose(files[VARLIST].stream);
      files[VARLIST].open=FALSE;
    }
  } else {
      /*  Save start (here) and end (below) of level 0 file comments	*/
      /*  so they can be moved to precede any following opt file com-	*/
      /*  ments.  Note that because of side effects of open_and_log_opt	*/
      /*  the apparently repeated next line cannot be placed outside if	*/
    start_lev0comments = tabcomments_ptr;
    open_datafile(&datalev[0]);
    if (datalev[0].source_type == JGOFS_OBJECT) {
      datalev[0].objlevel = 0;  /* Structure represents object level 0 */
      maxlev = scanheader0_obj(&datalev[0],ntotal);
    } else maxlev = scanheader0(&datalev[0],ntotal);
  }
  end_lev0comments = tabcomments_ptr -1;

    /*  Following opt files need level 0 var list, so calls must follow	*/
    /*  scanheader0 call						*/
  get_timedateparams (&files[TIMEDATEPARAMS],out_timedate,in_timedate,
    timedatefragbuflist);
  get_latlonparams (&files[LATLONPARAMS],&outlatformat,&outlonformat,
    &inlatformat,&inlonformat);
  remove_vars(&files[REMOVALS],ntotal,post_removal_varlist,ncnt);

    /*  If there were any data file comments & also some opt file 	*/
    /*  comments preceding them, swap those comments			*/
  if (end_lev0comments > start_lev0comments) {
    comments_before_lev0comments = (start_lev0comments != tabcomments);
      /*  Next line from v 2.0.  Leaving it in case needed in future	*/
    comments_after_lev0comments = (end_lev0comments+1 != tabcomments_ptr);
    if (comments_before_lev0comments) {
	/*  Since we are just swapping portions of the string, no 	*/
	/*  length checking should be needed.  Also, tabcomments_ptr,	*/
	/*  before and after swap, points to null at end of comments	*/
	/*  buffer.  Said null should not be overwritten by anything,	*/
	/*  either							*/
	/*  Chars overwritten w/nulls are newlines, so need not save	*/
      *(start_lev0comments-1)='\0';
      *end_lev0comments='\0';
      len_lev0comments=end_lev0comments-start_lev0comments;

      strcpy(tmp_commentbuf,tabcomments);

      strcpy(tabcomments,start_lev0comments);
      *(tabcomments+len_lev0comments)='\n';

      strcpy(tabcomments+len_lev0comments+1,tmp_commentbuf);
      *end_lev0comments='\n';
    }
  }

  return maxlev;
}
/*									*/
/******************   End ioopen_	*********************************/

char *getfreedata (varlist,firstvar,fptr)
int varlist[],firstvar;
struct fileinfo *fptr;
/*  Gets free field data from buffer into tabvalues.  			*/
/*  Variables filled in are the string of variables in varlist starting	*/
/*    at firstvar & ending before fptr->lastvar				*/
/*  Returns pointer to string that spec's next level's file		*/
/*  Uses global variables tabvalues, significant_consec_separators	*/
{
  char *tok,*next;
  int i,j;

  next = fptr->buf;

    /*    Read no more than the number of variables expected		*/
  for (i=firstvar;  i < fptr->lastvar;  i++)  {
    tok = nxttok (next,
		  fptr->item_separators,
		  &next,
		  fptr->item_alt_separators,
		  significant_consec_separators,
		  FALSE);
    if (tok == NULL) break;
    if (strlen(tok) > TOKEN) err ("Token too long\n   Bad token = ",tok);
    if (*tok == '\0') strcpy(tabvalues[varlist[i]],MISSING_VALUE_STRING);
    else {
	/*  Tabs or returns almost guaranteed to cause trouble down	*/
	/*  the line in JGOFS processing, so kill it now		*/
      if (strpbrk(tok,REQUIRED_SEPARATORS) != NULL)
	err ("May not have tabs or returns in delimited field.  Field = ",tok);
      strcpy(tabvalues[varlist[i]],tok);
    }
  }

    /*	What's left should be only a subfile spec, pointer to which we	*/
    /*	are supposed to return.						*/
    /*	  Specs are parsed w/insignificant consecutive blanks and	*/
    /*	nested apostrophes (so apostrophe can be in command data)	*/
    /*    Before returning subfile, fill in missing data in cases where	*/
    /*  short records are allowed					*/
  if (i == fptr->lastvar)
    tok = nxttok (next,
		  fptr->item_separators,
		  &next,
		  fptr->item_alt_separators,
		  FALSE,
		  TRUE);
  else
    if (significant_consec_separators) {
      for (j = i;  j < fptr->lastvar;  j++)
	strcpy(tabvalues[varlist[j]],MISSING_VALUE_STRING);
      tok = NULL;
    } else err("Too few variables in data record.\n   Record = ",fptr->buf);

  return tok;
}

void getobjectdata (varlist,firstvar,fptr)
int varlist[],firstvar;
struct fileinfo *fptr;
/*  Copies data from an object into tabvalues.				*/
/*  Variables filled in are the string of variables in varlist starting	*/
/*    at firstvar & ending before fptr->lastvar.  In the input		*/
/*    object, these variables are stored sequentially beginning at	*/
/*    objfirstvarlevel[this data level's object level].  They are	*/
/*    scatterwritten into tabvalues at the appropriate spots (said	*/
/*    spots are those in varlist)					*/
/*  Uses global variables tabvalues, objfirstvarlevel & objvalues	*/
{
  int i,objvar;
  char *tok;

  objvar = objfirstvarlevel[fptr->objlevel];
  for (i=firstvar; i<fptr->lastvar; i++)  {
    tok = objvalues[objvar++];
    if (strlen(tok) > TOKEN) err ("Token too long\n   Bad token = ",tok);
    else strcpy(tabvalues[varlist[i]],tok);
  }
  return;
}

char *getfixeddata (varlist,firstvar,fptr)
int varlist[],firstvar;
struct fileinfo *fptr;
/*  Gets fixed field data from buffer into tabvalues.  			*/
/*  Variables filled in are the string of variables in varlist starting	*/
/*    at firstvar & ending before fptr->lastvar				*/
/*  Returns pointer to string that spec's next level's file		*/
/*  Uses global variables tabvalues, inpstarts, inpwidths,		*/
/*    significant_embedded_separators, data_field_trim,			*/
{
  int field_term_pos;
  int i,len_tmp,var;
  char save_char,*tok,*endtok,*ptr;
  char *tmp,*separators,*alt_separators;

  tmp = fptr->buf;
  separators = fptr->item_separators;
  alt_separators = fptr->item_alt_separators;

  len_tmp=strlen(tmp);
  for (i=firstvar; i<fptr->lastvar; i++)  {
    var = varlist[i];
      /*    The interaction between fixed field and separators found	*/
      /*  in that fixed field is a bit complex.  There can be		*/
      /*  strings of separators at the start of the string, the		*/
      /*  end of the string, and possibly embedded in the string	*/
      /*    The data_field_trim switch controls whether or not we	*/
      /*  strip off the separators at string start and string end.	*/
      /*  Regardless of this option, we find string start and		*/
      /*  string end and see if there is a separator in between.	*/
      /*  If so, the significant_embedded_separators switch		*/
      /*  determines whether this is an error condition.		*/
      /*    A field consisting entirely of separators is considered	*/
      /*  missing data provided we are trimming the field.  If we	*/
      /*  are not trimming, then we give a field of separators!		*/
    if (inpstarts[var] < len_tmp) {
      if (  (field_term_pos=inpstarts[var]+inpwidths[var]) > len_tmp  )
	field_term_pos = len_tmp;
      endtok = tmp + field_term_pos;
      save_char = *endtok;
      *endtok = '\0';
      tok = tmp + inpstarts[var];
      tok = tok + strspn(tok,separators);
      if (*tok == '\0') {
	  /*  Field consists entirely of separators			*/
	if (data_field_trim) tok = MISSING_VALUE_STRING;
      } else 
	if ( (ptr = strpbrk(tok,separators)) != NULL  ) {
	    /*  There is a separator between string start and field	*/
	    /*  end.  Find out if separator is embedded or trailing	*/
	    /*  by finding last non-separator and comparing		*/
	    /*  position to separator that put us here			*/
	  endtok = tmp + field_term_pos;
	  while (strchr(separators,*(--endtok)) != NULL)
	    ;
	  if (  (++endtok > ptr) && ! significant_embedded_separators  )
	    err("More than one datum in single fixed field.\n   Field = ",
	      tok);
	}
	  /*  Either trim end, or return to untrimmed start		*/
      if (data_field_trim) *endtok = '\0';
      else tok = tmp + inpstarts[var];

	/*  Tabs or returns almost guaranteed to cause trouble down	*/
	/*  the line in JGOFS processing, so kill it now		*/
      if (strpbrk(tok,REQUIRED_SEPARATORS) != NULL)
	err ("May not have tabs or returns in delimited field.  Field = ",tok);

      if (strlen(tok) > TOKEN) err ("Token too long\n   Bad token = ",tok);
      else strcpy(tabvalues[var],tok);

      tmp[field_term_pos] = save_char;
    }
    else strcpy(tabvalues[var],MISSING_VALUE_STRING);
  }
    /*  Get next token as free format.  This should ONLY be a subfile	*/
    /*  specification.  Must begin after full-width record; that is,	*/
    /*  there cannot be "missing fields at end", followed by subfile	*/
    /*  spec (else we'd consider the subfile spec to be a datum)	*/
    /*  Subfile specs are parsed w/insignificant consecutive blanks	*/
    /*  and nested apostrophes (so apostrophe can be in command data)	*/
  if (fptr->maxlenrec < len_tmp)
    endtok = nxttok(tmp+field_term_pos,
		    separators,
		    &ptr,
		    alt_separators,
		    FALSE,
		    TRUE);
  else endtok=NULL;

  return endtok;
}

void dataeod (lev)
int lev;
/*  Handle eof action for ioreadrec.  Amazingly enough, common to all	*/
/*  input types (maybe!)						*/
/*  Uses global variable datalev					*/
{
  if (max_trace_level >= TRACE_PERFILE_ROUTINES) {
    sprintf(trace_msg,"eod at level %d\n",lev);
    do_diag_trace(TRACE_PERFILE_ROUTINES,trace_msg);
  }
  if (datalev[lev].eof) {
    fclose(datalev[lev].stream);
    datalev[lev].open=FALSE;
  }
  return;
}

/******************   Begin ioreadrec_  *********************************/
/*									*/
/*	    ioreadrec is the routine most responsible for reading	*/
/*	and manipulating the data corresponding to the variables set	*/
/*	up in scanheader.						*/
/*	    ioreadrec also opens subfiles and calls scanheader to check	*/
/*	them and prepare the variable list for this particular level	*/
/*	(Subfiles need not contain all the variables specified at the	*/
/*	top level)							*/
/*	"Read record at appropriate level.  Return 0 if end at that"	*/
/*	"level.  Return 1 if ok."					*/

int ioreadrec_(level)
int *level;
{

void calc_timedate(),calc_latlon();

char *save_comments,*tok,*endtok,*ptr;
char *nextfile = NULL;
int *nparams,*ntotal;
int i,j,k;
int nitem;

if (max_trace_level >= TRACE_IOREADREC) {
  sprintf (trace_msg,"ioreadrec %d\n",*level);
  do_diag_trace(TRACE_IOREADREC,trace_msg);
}

k= *level;

  /*  By default, ignore any comments found by ioreadrec 		*/
save_comments=NULL;

  /*  Initialization for this level if first time through		*/
if (datalev[k].nrecs == 0) {
  if (! datalev[k].open) open_datafile(&datalev[k]);
  switch (datalev[k].source_type) {
    case CREATE_NULL_DATA:
      mark_missing(k);
      break;
    case JGOFS_OBJECT:
      scanheader_obj(k);
      break;
    default:
	/* Call scanheader if data files have variable lists.		*/
	/* If not, remember to set up to save any comments found at	*/
	/* top of file.  (Normally, this is done in scanheader)		*/
      if (datalev[k].scanheader) scanheader(k);
      else {
	save_comments="";                                              
	  /*  Can't have missing variables w/o a sublevel var list	*/
	for (i = firstvarlevel[k]; i < firstvarlevel[k+1]; i++) pointers[i]=i;
	datalev[k].lastvar = firstvarlevel[k+1];
      }
      break;
  }
}

  /*  Process data record						*/
switch (getrec_proccomment(&datalev[k],save_comments)) {
  case -1:		/*  Pretend we got line of "nd"s.  Process it	*/
    break;		/*   by ignoring it-tabvalues is already "nd"s	*/
  case 0:		/*  EOD						*/
    dataeod(k);
    return 0;
    break;
  default:		/*  Data!					*/
    if (datalev[k].source_type == JGOFS_OBJECT)
      getobjectdata (pointers,firstvarlevel[k],&datalev[k]);
    else
      if (datalev[k].maxlenrec == 0)
	nextfile = getfreedata (pointers,firstvarlevel[k],&datalev[k]);
      else if (datalev[k].maxlenrec > 0)
	nextfile = getfixeddata (pointers,firstvarlevel[k],&datalev[k]);
      else
	errn ("Fixed-field/free-field status not determined for level ",k);
    break;
}
datalev[k].ndatarecs++;

  /*  "Data line" processed.  See if we need to process another level	*/
if (k<maxlev) {
    /*  Create structure for new level.  Start w/this level,		*/
    /*  then adjust for fields that we know need adjustment,		*/
    /*  reinitialization, etc.						*/
    /*  New structure is copy of old, w/all its defaults, as well	*/
    /*  as things like its source string, open bit, eof bit & eod bit	*/
    /*  (EOD set)							*/
  datalev[k+1]=datalev[k];

  switch (datalev[k].source_type) {
    case JGOFS_OBJECT:  case CREATE_NULL_DATA:
	/*  Note that we won't reopen the object			*/
      datalev[k+1].objlevel = datalev[k].objlevel + 1;
      break;
    default:
	/*  Need source string and source type, then reset open bit to	*/
	/*  both force file open and get open_datafile's initiali-	*/
	/*  zations.  Note that new level must start off closed unless/	*/
	/*  until we put indirect file streams, eof bits, etc.  This	*/
	/*  means that multi-levels cannot come from same file at the	*/
	/*  moment (v 2.8)						*/
	/*    Set source to string at end of data record, then		*/
	/*    process it, getting source type.  (Note that we need to	*/
	/*    do analysis here, while we know the relevant separator	*/
	/*    characters.  Right now, all levels' are the same, but	*/
	/*    who knows?)						*/
      if (nextfile == NULL)
        err("Too few variables in data record.\n   Record = ",datalev[k].buf);
      strdupl(&datalev[k+1].source,nextfile," init of next data source");
      analy_source(&datalev[k+1],datalev[k].item_separators,dirstring);

      datalev[k+1].open = FALSE;

	/*  What's next on line? (shouldn't be anything...tested below	*/
      nextfile = strpbrk(nextfile+strlen(nextfile),datalev[k].item_separators);

      break;
  }

  datalev[k+1].level = k+1;
  datalev[k+1].nrecs = 0;
  datalev[k+1].ndatarecs = 0;
  datalev[k+1].eod = FALSE;

}

  /*  Should be no more data						*/
if (nextfile != NULL)
  err("Too many variables in data record\n   Extra var = ",nextfile);


  /*		Data processing for "special" variables			*/
calc_latlon(tabvalues,TOKEN,k,
	    &outlonformat,&inlonformat,&outlatformat,&inlatformat);

if (in_timedate[0].var >= 0)
  calc_timedate(tabvalues,TOKEN,k,in_timedate,out_timedate,timedatefragbuflist);

return 1;
}
/*									*/
/**************     End ioreadrec_     **********************************/

int iocommout_(str)
char *str;
/*	"Return next comment string. 0=none left."			*/
/*	Return -1 if comment string is NOT to be html-escaped by outer	*/
/*	  That happens if comment is itself a tag; which by convention	*/
/*	  (JGOFS) occurs if first comment character is one that opens a	*/
/*	  tag								*/
{
  char *at;

  if (*tabcomments == '\0') {
    tabcomments_ptr=tabcomments;
    return 0;
  }

  at=strchr(tabcomments,'\n');
  if (at == NULL) {	/*  Should not be possible. WJS Mar 96		*/
		/*  Therefore, reset pointer above! Duhh! WJS 10 Oct 96	*/
    strcpy(str,tabcomments);
    *tabcomments='\0';
    tabcomments_ptr=tabcomments;
  } else {
    *at = '\0';
    strcpy(str,tabcomments);
    strcpy(tabcomments,at+1);
    tabcomments_ptr=tabcomments+strlen(tabcomments);
  }
  if (*str == HTML_TAG_START) return -1;
  else return 1;
}

/*									*/
/************************  End defgb   **********************************/