/* *******************************************************************
 *                                                                   *
 * Copyright (c) L-DGO/MIT/JGOFS                                     *
 *                                                                   *
 *                                                                   *
 * File             : defgb.c                                        *
 *                                                                   *
 * Purpose          : Enhanced def method for globec purposes.	     *
 *								     *
 *	Incompatibilities with def 1.7 (JGOFS 1.5 release)	     *
 *        1) Ignore embedded comments anywhere			     *
 *	  2) Apostrophe is special character (unless changed w/	     *
 *		datafieldopts optional file)			     *
 *	  3) Tab & newline characters must be data separators	     *
 *	  4) Data lines cannot begin with &x (unless recompiled w/   *
 *		different ERR_PREFIX string)			     *
 *                                                                   *
 * Version Number   : 3.0	                                     *
 *                                                                   *
 * Revision History :                                                *
 *                                                                   *
 * Date                              Developer                       *
 * ----                              ---------                       */
#define INNER_VERSION "defgb  version 3.0a  9 Aug 1997"
/*   9 Aug 97 v 3.0a 		    WJS				     *
 *	Change makefiles; reflect upgraded path_info_routines;	     *
 *	  set up for anticipated bug fixes to 3.0.		     *
 *	  Try NOT to add functionality				     *
 *	    [Needs defgb.h 3.5 (which includes old _nonconfig.h)]    *
 *	    [Needs ioopen_routines 1.9]				     *
 *	    [Needs ioreadrec_routines 1.2]			     *
 *	    [Needs path_info_routines 1.0 or later (.c & .h)]	     *
 *	    [Needs defgb_utils 1.2]				     *
 *	    [Begin 3.0a]					     *
 *  28 Jul 97 v 3.0 		    WJS				     *
 *	Change level logic within JGOFS protocol handling now that   *
 *	  outer preserves PATH_INFO string.			     *
 *	    [Put into globec "official" JGOFS 1.5 test 31 Jul 97]    *
 *	    [Needs path_info_routines 1.0 (.c & .h)]		     *
 *  20 Jun 97 v 3.0 		    WJS				     *
 *	Bug fix: too many input tokens not diagnosed in data for     *
 *	  levels other than furthest from 0			     *
 *   5 Jun 97 v 3.0 		    WJS				     *
 *	No more _nonconfig.h					     *
 *      Bug fix: Missing {}s in code opening sinks		     *
 *	Move do_data_trace routines back here from defgb_utils	     *
 *	Mods for outer 1.5					     *
 *  26 Apr 97 v 3.0 		    WJS				     *
 *	Bug fix: trace output was going to ERROR_STREAM-should be    *
 *	  DEBUG_STREAM						     *
 *	    [Needs defgb.h 3.5 (which includes old _nonconfig.h)]    *
 *	    [Needs ioopen_routines 1.9]				     *
 *	    [Needs ioreadrec_routines 1.2]			     *
 *	    [Needs defgb_utils 1.2]				     *
 *	    [Begin 3.0]						     *
 *  26 Apr 97 v 2.9 		    WJS				     *
 *	Change err to build one string (anticipation of outer 1.5)   *
 *	Allow null strings to err				     *
 *	Time zone conversion; time rounding bug fix (see ioreadrec)  *
 *	    [Put on globec for real 29 Apr 97]			     *
 *	    [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]						     *
 * [Comments about versions 1.1->2.8c moved to defgb_revision.doc ]  *
 * [  8 Aug 97			WJS				  ]  *
 *      From defw.c vers 1.2; itself from def.c date unknown	     *
 *      Comments in quotation marks in the body of defgb come from   *
 *	outer-url 2.5's descriptions of inner routines.  outer-url   *
 *	2.5 was released as the outer of JGOFS release 1.5, May 1997 *
 ******************************************************************* */

#include "defgb.h"

  /*  outer routine							*/
void error_();

  /*  defgb_utils routines						*/
void analy_source();
char *buildstring();
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();

  /*  PATH_INFO routines						*/
int get_level();
char *get_protocol();
char *make_PATH_INFO_putenv_string();

  /*  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];

    /* PATH_INFO pieces and strings					*/
char *PATH_INFO_orig_putenv;	/* "PATH_INFO=" + getenv("PATH_INFO")	*/
int defgb_reqlevel;		/* level from getenv("PATH_INFO")	*/
char *PATH_INFO_jgof_putenv;	/* "PATH_INFO=" + getenv("PATH_INFO") 	*/
				/*  w/ protocol = "jgof"		*/
				/*  Used w/ object input		*/
char *PATH_INFO_none_putenv;	/*  Same as PATH_INFO_jgof_putenv but	*/
				/*  with protocol = "none"		*/

    /* Miscellaneous info about what to output & where			*/
struct outinfo output_opts;
    /*    Next defns for convenience, since stuff on right so long	*/
struct outfile *primary_diagout = &output_opts.file[PRIMARY_DIAG_SINK];
struct outfile *diagout = &output_opts.file[DIAG_SINK];
    /*    Next var convenient if unwanted trace message would have to	*/
    /*    built.							*/
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];

    /* Need single char -> string buffer.  Also need an empty string -	*/
    /* use pointer to terminating null of this string			*/
char one_char_buf[2] = {'\0','\0'};
/*									*/
/************************************************************************/
/*									*/

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;
    }
    /*  Don't close stdout or stderr.  Still not sure of unix rules	*/
    /*  about this.  However, "everybody" agrees that calls to exit	*/
    /*  will close all open streams.  Both inner and outer call exit,	*/
    /*  so should be covered one way or the other			*/
  for (i=0;i<NUM_SINKS;i++)
    if (output_opts.outsink_open_flags[i]) {
      if (  (output_opts.outsink_streams[i] != stdout) &&
	    (output_opts.outsink_streams[i] != stderr)	   )
	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;
  }

  return;
}

/*********	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]);
      tabattributes[n][0]='\0';
    } else {		/* there is more than 1 attribute */
      *at = '\0';
      strcpy(str,tabattributes[n]);
      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"*/
{
  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 += 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.  ***************/

Logical open_sink(sink)
struct outfile *sink;
  /*  Open diagnostic/error sinks.					*/
  /*  Special-case /dev/stdout & /dev/stderr since they don't exist as	*/
  /*    "devices" on all systems.					*/
  /*  Don't open them, either.  Not sure of consequences of		*/
  /*    this, but latest thoughts (May 97) say this is correct		*/
  /*  Do NOT call err from this routine, since it is called by err	*/
{
  if (strcmp(sink->sink,STDOUT_DEVICE) == 0)
    *(sink->stream_ptr) = stdout;
  else if (strcmp(sink->sink,STDERR_DEVICE) == 0)
    *(sink->stream_ptr) = stderr;
  else {
    if ( *(sink->mode_ptr) == NULL ) *(sink->mode_ptr) = "a";
    *(sink->stream_ptr) = fopen(sink->sink,*(sink->mode_ptr));
  }

  if (*(sink->stream_ptr) == NULL) return FALSE;
  else *(sink->open_ptr) = TRUE;

  return TRUE;
}

char *add_to_errbuf (errbuf_ptr,s,t,addend)
char **errbuf_ptr,*s,*t;
char addend;
  /*    errbuf_ptr = NULL asks only for status				*/
  /*    s must be non-null; don't care about t				*/
  /*    If previous call failed, return NULL.  Otherwise,		*/
  /*  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.		*/
  /*    Buffer pack either succeeds or not.  If it succeeds, alter	*/
  /*  input pointer and return it.  If it does NOT succeed, leave input	*/
  /*  pointer alone and return NULL.  Save last return.			*/
  /*    Main point of this routine is error handling in case allocation	*/
  /*  fails-cannot call err!!						*/
{
#define ERRBUF_EXTEND_SIZE 800		/*  Approx 10 lines. 		*/
  static char *buf = one_char_buf + 1;	/*  Anything non-NULL		*/

  if (  (errbuf_ptr == NULL) || (buf == NULL)  ) return 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) *errbuf_ptr = buf;

  return buf;
}

char *build_err(errbuf,ss,tt,error_level,maxscriptdiags)
char *ss,*tt;
char **errbuf;
int error_level,maxscriptdiags;
/*  Generate desired level of diagnostic output into a buffer & return	*/
/*  pointer to that buffer.  Return is both via arg list and function	*/
/*  return.  Difference is that function return can also be NULL, in-	*/
/*  dicating failure to build complete error message.  If this occurs	*/
/*  arg list pointer points to some valid string (possibly empty)	*/
/*  See defgb.h and/or opt file doc for descrip of various levels	*/
{
  int ndiags,i,nopen_files,j;
    /*  Shouldn't have null strings as input but be ready to repl with	*/
    /*  empty strings							*/
  char *s = one_char_buf+1, *t = one_char_buf+1;
  char *ptr;
  char intbuf[10],end_of_string;
  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) {
      /*  Check last char for newline to ensure we don't add blank line	*/
    ptr = (*t == '\0') ?  s : t;
    end_of_string = ( *(ptr + strlen(ptr) - 1) == '\n' ) ? '\0' : '\n';
    add_to_errbuf(&errbuf,s,t,end_of_string);
  }

  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)					*/
	  ptr = datalev[i].buf;
	  ndiags = 0;
	  while ( (fgets(ptr,MAXREC,datalev[i].stream) != NULL) && 
		  (ndiags++ < maxscriptdiags)			   ) {
	    if (ndiags == 1)
	      add_to_errbuf(&errbuf,
			"   More diagnostic info from command(?) follows:\n",
			NULL,'\0');
	      /*  Make sure message ends w/exactly 1 newline		*/
	    end_of_string = ( *(ptr + strlen(ptr) - 1) == '\n' ) ? '\0' : '\n';
	    add_to_errbuf(&errbuf,"   ",ptr,end_of_string);
	  }
	  if (ndiags == maxscriptdiags) 
	    if (fgets(ptr,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');
  }

  return add_to_errbuf(NULL,NULL,NULL,'\0');
}

Logical write_err(errout,s,t)
char *s,*t;
struct outfile *errout;
{

  FILE **stream;

  stream = errout->stream_ptr;

  if (errout->sink != NULL) 
    if (strcmp(errout->sink,JGOFS_ERROR_FILE) == 0) {
	/*  error_ will call ioclose_ but will not return to inner	*/
	/*  However, stick in return just in case...			*/
      error_(s,t);
      return FALSE;
    } else {
      if ( ! *(errout->open_ptr) )
	if (! open_sink(errout)) return FALSE;
      fprintf (*stream,"%s %s\n",s,t);
    }

  return TRUE;
}

char *build_and_write_err(errsink,s,t,errlev,maxs,err_doing_errmsg)
struct outfile *errsink;
char *s,*t;
char *err_doing_errmsg;
int errlev,maxs;
{
  char *errmsg = NULL;
  char **errmsg_ptr = &errmsg;

    /*  If did not build whole error message, check to see if what was	*/
    /*  built at least includes s & t.  If so, write incomplete msg	*/
    /*  along w/msg that it is incomplete.  If not, write s & t		*/
  if (  (errmsg = build_err(errmsg_ptr,s,t,errlev,maxs)) == NULL) {
    errmsg = *errmsg_ptr;
    if (  (strstr(errmsg,s) == NULL) || (strstr(errmsg,t) == NULL)  ) {
      errmsg = s;
      err_doing_errmsg = t;
    } else
      err_doing_errmsg = 
	" (Preceding message is truncated due to memory allocation failure)\n";
  }

    /*  Write to sink.  In general, that will be outer's sink, which	*/
    /*  will cause a call to outer's error_, which will not return here	*/
    /*  However, if we had a 2nd sink (or 1st sink not outer's), we	*/
    /*  will come back here, and we might find that there was an error	*/
    /*  writing to the first sink.  In that case, try writing someplace	*/
    /*  else, as well as adding that info for 2nd sink, if any.  If	*/
    /*  err_doing_errmsg was already set, drop that info.  Don't want	*/
    /*  to try building strings at this point, since presumably that's	*/
    /*  already gotten us into trouble.  Of course, presumably fprintf	*/
    /*  needs to do dynamic allocation...				*/
  if ( ! write_err(errsink,errmsg,err_doing_errmsg)) {
    err_doing_errmsg = 
      " (Could not write preceding message to error sink)\n";
    fprintf(ULTIMATE_ERROR_STREAM,"%s%s Error sink = %s\n",
      errmsg,err_doing_errmsg,errsink->sink);
  }

  if (err_doing_errmsg == t)
    err_doing_errmsg = 
      " (Preceding message truncated when written to previous sink)\n";

  return err_doing_errmsg;
}

err(s,t)
char *s,*t;
/*  Put out error message to the correct sink(s), if any		*/
{
    /*  one_char_buf+1 is an emtpy string				*/
  char *errmsg = one_char_buf+1, *err_doing_errmsg = one_char_buf+1;
  struct outfile *sink1, *sink2 = NULL;
  int errlev1, errlev2, maxs1, maxs2 = 0;

    /*  Generate sink/level/scriptdiags triplets for each error sink	*/
    /*  User spec's 1, and may spec "addl-".  If former, trio is	*/
    /*		ERROR_SINK/.error_level/.maxscriptdiags			*/
    /*  If latter, primary trio	is					*/
    /*		PRIMARY_ERROR_SINK/.error_level/.maxscriptdiags 	*/
    /*	and secondary trio is 						*/
    /*		ERROR_SINK/.dup_error_level/0				*/
  sink1 = &output_opts.file[ERROR_SINK];
  errlev1 = output_opts.error_level;
  maxs1 = output_opts.maxscriptdiags;
    /*  Because using outer's error sink does not come back to us, be	*/
    /*  sure that if there is more than one sink, and if either is	*/
    /*  outer's, that one is last (PRIMARY_ERROR_FILE is where 2nd	*/
    /*  output stream goes - as of v 3.0, defined as JGOFS_ERROR_FILE)	*/
  if (  sink1->dup  &&  (strcmp(sink1->sink,PRIMARY_ERROR_FILE) != 0)  ) {
    if (strcmp(PRIMARY_ERROR_FILE,JGOFS_ERROR_FILE) == 0) {
      sink2 = &output_opts.file[PRIMARY_ERROR_SINK];
      maxs2 = maxs1;	/* Script diagnostics can only go to 1 sink, &	*/
      maxs1 = 0;	/*  if 2, we chose PRIMARY.  See param1 doc	*/
      errlev2 = errlev1;
      errlev1 = output_opts.dup_error_level;
    } else {
      sink2 = sink1;
      errlev2 = output_opts.dup_error_level;
      sink1 = &output_opts.file[PRIMARY_ERROR_SINK];
    }
  }

  if (errlev1 > NOERROR_OUTPUT)
    err_doing_errmsg = 
      build_and_write_err(sink1,s,t,errlev1,maxs1,err_doing_errmsg);
  if (  (sink2 != NULL) && (errlev2 > NOERROR_OUTPUT)  )
    build_and_write_err(sink2,s,t,errlev2,maxs2,err_doing_errmsg);

  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 print_data_trace(stream,f,bufs,nbufs)
struct fileinfo *f;
FILE *stream;
char *bufs;
int nbufs;
/*  bufs can be either string or array of strings.  Assume string if	*/
/*  nbufs = 1.  (No check that nbufs >= 1)				*/
/*    If array, print out as tab-separated string.  Idea is		*/
/*  that arrays are data "lines" that came directly from data objects.	*/
/*  Most likely they "came across" as tab-separated strings.		*/
/*    If datafile, ID with file spec; else ID with opt file description	*/
{
  int i;
  char *ptr;

  if (strcmp((ptr = f->descrip),"datafile") == 0)  ptr = f->source;

  if (nbufs == 1)  fprintf (stream,"%s rec %-4d : %s\n", ptr, f->nrecs, bufs);
  else {
    fprintf (stream, "%s rec %-4d : %s", ptr, f->nrecs, bufs[0]);
    for (i=1; i<nbufs; i++) fprintf (stream, "\t%s", bufs[i]);
    fprintf (stream,"\n");
  }

  return;
}

Logical print_it(rec_number,print_every)
int rec_number,print_every;
/*  See if rec_number is 1 mod print_every; eg, if you want to print	*/
/*  every 4th rec, return true when rec_number is 1, 5, 9, etc		*/
{
  switch (print_every) {
    case 0:
      return FALSE;
    case 1:
      return TRUE;
    default:
      return (rec_number%print_every == 1);
  }
}

void do_data_trace (f,bufs,nbufs)
struct fileinfo *f;
char *bufs;
int nbufs;
/*  Log every "print_line"th line to the diags stream.  Play the dup-	*/
/*  game, too (if dup-counter non-zero, "dup-counter"th line goes to	*/
/*  diags stream; "counter"th line to stderr)				*/
{
  FILE *primary_stream = NULL;
  FILE *addl_stream = NULL;

  if (f->dup_print_lines == 0) {
    if (print_it (f->nrecs,f->print_lines))
      primary_stream = *(diagout->stream_ptr);
  } else {
    if (print_it(f->nrecs,f->dup_print_lines)) 
      addl_stream = *(diagout->stream_ptr);
    if (print_it(f->nrecs,f->print_lines)) 
      primary_stream = *(primary_diagout->stream_ptr);
  }

  if (primary_stream != NULL) print_data_trace(primary_stream,f,bufs,nbufs);
  if (addl_stream != NULL) print_data_trace(addl_stream,f,bufs,nbufs);

  return;
}

void do_diag_trace (limit,msg)
int limit;
char *msg;
{
  if (diagout->dup) {
    if (output_opts.trace_level >= limit)
      fprintf (*(primary_diagout->stream_ptr),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.  Note	*/
/*  that comments about optional files come here before output_opts is	*/
/*  set up according to the diagnostics optional file.  These comments	*/
/*  go to the compile-time sink.  If this sink causes the comments	*/
/*  to be buffered instead of output, they will eventually be output	*/
/*  to the run-time sink						*/
{
  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_FILE) != 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, should abort if an html tag because trun-	*/
      /*  cation could truncate tag, producing bad html effect.		*/
      /*  However, as of JGOFS release 1.5, tag can appear anywhere in	*/
      /*  line (Feb 96 agreement was that it could appear only at start)*/
      /*  which is too tough to parse for here				*/

      /*  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 ( ! open_sink(commout))
        err ("Cannot open comment sink\n   File = ",commout->sink);
    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);
    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;

    /*  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;

  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);
      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);
	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);

      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;
  int i;
  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) {
	  /*  If a method is run by the command file, it will look	*/
	  /*  at the PATH_INFO string.  Ideally, the command file it-	*/
	  /*  self would set PATH_INFO appropriately.  However,		*/
	  /*  we sometimes have a command itself, not a command file.	*/
	  /*  Tough choice, since presumably command file might want	*/
	  /*  to know PATH_INFO, but replace proto string with "none"	*/
	  /*  (and drop options - see ioopen_ where none_putenv string	*/
	  /*  is made).  My decision at this point... none has no	*/
	  /*  meaning to system.					*/
	if (PATH_INFO_none_putenv != NULL) 
	  if (  (i = putenv(PATH_INFO_none_putenv)) != 0  )
	    errn ("putenv failure for PATH_INFO.  Return code = ",i);

	  /*  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);

	    /*  Restore original PATH_INFO if we changed it		*/
	if (PATH_INFO_none_putenv != NULL) 
	  if (  (i = putenv(PATH_INFO_orig_putenv)) != 0  )
	    errn ("putenv failure restoring PATH_INFO.  Return code = ",i);

      } 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) {

	  /*  Must be sure that methods down the line produce JGOFS	*/
	  /*  protocol (or whatever jdbopen requires), and not html,	*/
	  /*  flat, or whatever.  Do this by replacing proto string	*/
	  /*  with "jgof" (my decision at this point... jgof has no	*/
	  /*  meaning to system).					*/
	if (PATH_INFO_jgof_putenv != NULL) 
	  if (  (i = putenv(PATH_INFO_jgof_putenv)) != 0  )
	    errn ("putenv failure for PATH_INFO.  Return code = ",i);

	  /*  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					*/
	if (defgb_reqlevel >= 0)

	    /*  defgb_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 > defgb_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			*/
	      *one_char_buf = OBJECT_PARAM_STRING_DELIM[0];
	      file->source = lengthen_str_and_free(
				file->source,
				one_char_buf,
				NULL,
				100,
				" building object selection string 1");
	    }

	    i = 0;
	    *one_char_buf = OBJECT_PARAM_STRING_SEP;
	    while (jdblevel_(&jdbunit,&i) <= defgb_reqlevel - file->level)
	      file->source = lengthen_str_and_free(
				file->source,
				objnames[i++],
				one_char_buf,
				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	*/

	    /*  Restore original PATH_INFO if we changed it		*/
	if (PATH_INFO_jgof_putenv != NULL) 
	  if (  (i = putenv(PATH_INFO_orig_putenv)) != 0  )
	    errn ("putenv failure restoring PATH_INFO.  Return code = ",i);

      } 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");
      *one_char_buf = file->source_type;
      err (tmp, one_char_buf);
      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 string into executable.			*/
  ptr = DEFGBH_VERSION;

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

    /*  Open diag stream(s).  Level test is only to try to avoid	*/
    /*  opening file if nothing is going to be written...		*/
    /*  If, at runtime, diag output is redirected, these files will 	*/
    /*  be closed and their structures re-init'ed (configure_output)	*/
  if (output_opts.trace_level >= TRACE_IOOPEN)
    if ( ! *(diagout->open_ptr) )
      if ( ! open_sink(&diagout))
	err ("Cannot open diagnostic sink\n   File = ",diagout->sink);
  if (output_opts.dup_trace_level >= TRACE_IOOPEN)
    if ( ! *(primary_diagout->open_ptr) )
      if ( ! open_sink(&primary_diagout))
	err ("Cannot open diagnostic sink\n   File = ",primary_diagout->sink);
  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;

    /*  Get level out of PATH_INFO.					*/
    /*  Make 3 strings for putenv.  1 sets up existing PATH_INFO; the	*/
    /*    others set up PATH_INFO with different protocols.  See	*/
    /*    open_datafile							*/
  if (  (ptr = getenv(PATH_INFO_ENV_VAR)) == NULL  ) {
    defgb_reqlevel = LEVEL_NOT_SPECIFIED;
    PATH_INFO_orig_putenv = NULL;
    PATH_INFO_jgof_putenv = NULL;
    PATH_INFO_none_putenv = NULL;
  } else {
    *one_char_buf = ENV_VAR_DEFN_CHAR;
    PATH_INFO_orig_putenv = 
      buildstring(PATH_INFO_ENV_VAR,one_char_buf,ptr," saving PATH_INFO");
    defgb_reqlevel = get_level(ptr);
    PATH_INFO_jgof_putenv = 
      make_PATH_INFO_putenv_string(NULL,ptr,NULL,"jgof",defgb_reqlevel,NULL);
    if (PATH_INFO_jgof_putenv == NULL)
      errn ("Cannot make PATH_INFO value from jgof & ",defgb_reqlevel);
    PATH_INFO_none_putenv = 
      make_PATH_INFO_putenv_string(NULL,ptr,NULL,"none",defgb_reqlevel,NULL);
    if (PATH_INFO_none_putenv == NULL)
      errn ("Cannot make PATH_INFO value from none & ",defgb_reqlevel);
  }

    /*  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);	
    /*  Open diagnostics streams 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) break;
    if (  (i < NFILETYPES)			||
          (output_opts.trace_level  > NOTRACE)	||
	  (output_opts.iovalstr > 0)		||
	  (output_opts.iovalreal > 0)		   )
      if ( ! open_sink(&diagout))
        err ("Cannot open diagnostic sink\n   File = ",	diagout->sink);
  }
  if ( ! *(primary_diagout->open_ptr) ) {
    for (i=0; i<NFILETYPES; i++) if (files[i].dup_print_lines > 0) break;
    if (  (i < NFILETYPES)			  ||
          (output_opts.dup_trace_level > NOTRACE) ||
	  (output_opts.dup_iovalstr > 0)	  ||
	  (output_opts.dup_iovalreal > 0)	     )
      if ( ! open_sink(&primary_diagout))
        err ("Cannot open diagnostic sink\n   File = ",	primary_diagout->sink);
  }
  max_trace_level = (output_opts.trace_level > output_opts.dup_trace_level) ?
		     output_opts.trace_level : output_opts.dup_trace_level   ;

    /*  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,more_string)
int varlist[],firstvar;
struct fileinfo *fptr;
char **more_string;
/*  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		*/
/*    Also returns flag as to whether buffer was completely processed	*/
/*  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);

  *more_string = next;
  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,more_string)
int varlist[],firstvar;
struct fileinfo *fptr;
char **more_string;
/*  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		*/
/*    Also returns pointer to unprocessed buffer (if any)		*/
/*  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;
  char *tmp,*separators,*alt_separators;
  char *ptr = NULL;

  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;

  *more_string = ptr;
  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;
char *unprocessed_input_ptr;
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],
			       &unprocessed_input_ptr);
      else if (datalev[k].maxlenrec > 0)
	nextfile = getfixeddata (pointers,firstvarlevel[k],&datalev[k],
			       &unprocessed_input_ptr);
      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)	*/
	/*  unprocessed_input_ptr tells us if there's something after	*/
	/*    the next level's file, but it could just be blanks	*/
      if (  (nextfile = unprocessed_input_ptr) != NULL  ) {
        nextfile += strspn(nextfile,datalev[k].item_separators);
	if (*nextfile == '\0') nextfile=NULL;
      }

      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.			*/
/*				    -1=next comment contains a URL"	*/
/*	Actually, outer will handle URLs of the format			*/
/*		<xxxx> .... </xxxx>					*/
/*  so don't need to return -1 for those...				*/
/*									*/
{
  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);
  }

  return 1;
}

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