/* *******************************************************************
 *                                                                   *
 * Copyright (c) L-DGO/MIT/JGOFS                                     *
 *                                                                   *
 *                                                                   *
 * File             : lm.c                                           *
 *                                                                   *
 * Purpose          :                                                *         
 *                                                                   *
 * Version Number   :  1.6                                           *
 *                                                                   *
 * Revision History :                                                *
 *                                                                   *
 * Date                              Developer                       *
 * ----                              ---------                       *
 *                                                                   *
 * Sat Oct 17  1992 10.00           Glenn Flierl                     *
 * Oct 1993                         attr[][]                         *
 * July 1995                        Christine Hammond                *
 *        change to add field width determination based on width of  *
 *        the label in the data.  Preparer must determine max width  *
 *        of column from inspection of data column width.            *
 *        Ex:  event___ , sta__ ,bot                                 *
 *        will give lengths of 8, 5, and 3 for the respective cols   *
 *                                                                   *
 * January 1996                     Christine Hammond                * 
 *       'type' the functions that outer method calls to avoid       *
 *        warnings on ANSI compilers - void() used for functions     * 
 *        returning no value  (e.g., return;)                        * 
 *                                                                   *
 * March  1996                      Christine Hammond                * 
 *       fix proclabel (width sensing) to ignore attributes with a   *
 *       substring 'width=', ex: 'inpwidth=N', and to properly deal  *
 *       with a 'width=N' attr when it occurs after a ';', as in     *
 *       a series of attributes, ex: 'meters;color=pink;width=12'    *
 *                                                                   *
 * March  1996                      Warren Sass, Christine Hammond   * 
 *       use a .h include file to set sizes of buffers used          *
 *       NOTE:  'minbufsize.h' also included in outer.c, to achieve  *
 *       some correspondence.  User-specified include file allowed   *
 *       (see minbufsize.h) as a compile switch IOBUF_INCLUDE        * 
 *                                                                   *
 * May  1996                        Christine Hammond                * 
 *       change to iovalreal to accept data values that begin with   *
 *       one of more digits but contain alpha characters and are     *
 *       intended to be alpha variables.  old rule was 'first char   *
 *       determines variable type.'                                  *
 *                                                                   *
 * June 2005 wjs                                                     *
 *      add defn for error_ to avoid warning msg                     *
  ******************************************************************* */

#include <stdio.h>
#include <string.h>
#include OPTIONS
#include INNEROPTIONS

double strtod();
void error_();

/* #define DEBUG */
#define SEPARATOR " ,\n"
#define W_EXTEND '_'

#ifndef NVAR
#define NVAR 250
#endif

char names[NVAR][VARNAMESIZE];
char values[NVAR][DATUMSIZE];
char attr[NVAR][ATTRSIZE];
char comments[COMMENTSIZE];

int widths[NVAR];
int nvarlevel[6];
FILE *fl;
int maxlev,newlev;
int eofflag=0;
int ateq=0;

void ioclose_();
void in_getwidth();
void in_proclabel();
void in_striptoken();
void in_readheader();
void in_readnewheader();

/* * * * * *     end of declarations    * * * * * */

int ftok(fl,s)
FILE *fl;
char *s;
{
char *sp;
int ok,c;
sp=s;
ok=1;
while(ok){
  c=fgetc(fl);
  if(c==EOF) return EOF;
  if(c==' ' || c==',' || c=='\n'){
    if(ok==2)ok=0;
  } else {
    ok=2;
    *(sp++)=c;
  };
};
*sp = '\0';
return 0;
}

void in_proclabel(n, ptr)
int n;
char *ptr;
/* 
attr[] is the global array.
routine to determine the length of the title string indexed at 'n' and
pointed to by 'ptr', and based on the idea that the user preparing the
data has placed W_EXTEND characters to pad the title to the desired
width.  An attribute is constructed and saved in attr[], either by
appending to existing attr's or saving as the sole attribute, beginning
with 'width='.  Then, the W_EXTEND characters must be stripped from the
names.  Same name separators are used as before (space, tab, comma,
newline).  If an explicit 'width=' attribute is found, it is used.
*/

{
#define YES  0
#define NO   1

   int len, docalc, others;
   char attrib[ATTRSIZE], *attrptr;

/* default value for flag indicating attributes other than 'width=' */

   others = NO;

/* calculate a field width, if no attributes are present or, 
   if none of the attributes are exactly == 'width=N'       */

   docalc = YES;
   attrptr = attr[n];
   while (*attrptr) {
        others = YES;
        if (strncmp(attrptr,"width=",6) == 0) docalc = NO;
        (attrptr = strchr(attrptr,';')) == NULL ? attrptr : attrptr++; 
   }

   if (docalc == YES) {

     len = strlen(ptr);           /* length of (possibly) extended label */
     sprintf(attrib, "width=%d", len);
     if (others == YES) {         /* add to end of other attributes? */
        strcat(attr[n],";");
        strcat(attr[n],attrib);
     } else
        strcpy(attr[n],attrib);

  };   /* end docalc loop */
  
/* strip off the column extenders from the label */

  in_striptoken(ptr);

/* and save label name without the extra W_EXTEND characters */

  strcpy(names[n], ptr);
  return;
}

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

/* if there are extending characters at end of string, strip them */

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

void in_readheader()
{
/* INBUFSIZE was 82 when hardcoded */
char tmp[INBUFSIZE],*sp;
int ncnt,i;
maxlev= -1;
newlev=0;
nvarlevel[0]=0;
ncnt=0;
strcpy(tmp,"#");
while(tmp[0] == '#'){
  if(fgets(tmp,INBUFSIZE-1,fl) == NULL)
     error_("file structure","(1)");
  if(tmp[0]=='#')
     strcat(comments,tmp+1);
};
while(1) {
  if(tmp[0] == '='){
    maxlev++;
    while(1){
      if(ftok(fl,tmp) == EOF)
           error_("unexpected EOF","after ftok 1");
      if(tmp[0] == '.' || tmp[0] == '-')
           break;
/*      if(tmp[strlen(tmp)-1] == ',')tmp[strlen(tmp)-1]=0; */
      if(sp=strchr(tmp,'[')) {
        strcpy(attr[ncnt],sp+1);
	attr[ncnt][strlen(attr[ncnt])-1]='\0';
	*sp='\0';
      } else
        attr[ncnt][0]='\0';
/*    strcpy(names[ncnt++],tmp);  replaced by 2 lines below */
      in_proclabel(ncnt,tmp);
      ncnt++;
    };
    nvarlevel[maxlev+1]=ncnt;
  }
  if(tmp[0] == '-')
     return;
  for(i=nvarlevel[maxlev];i<nvarlevel[maxlev+1];i++) {
    if(ftok(fl,tmp) == EOF)
       error_("unexpected EOF","after ftok 2");
/*    if(tmp[strlen(tmp)-1] == ',')tmp[strlen(tmp)-1]=0; */
    strcpy(values[i],tmp);
  };
  if(ftok(fl,tmp) == EOF)error_("file structure","(2)");
 };
}


int ioopen_(s,nparams,ntotal)
char *s[];
int *nparams,*ntotal;
{
/* INBUFSIZE was 258 when hardcoded */
char tmp[INBUFSIZE],*tok;
int ncnt,i,j;
if((fl=fopen(s[0],"r")) == NULL)error_("file name ",s);
s[0][0] = 0;
*comments=0;
in_readheader();
*ntotal=nvarlevel[maxlev+1];
return maxlev;
}

void ioname_(vn,s)
int *vn;
char *s;
{
strcpy(s,names[*vn]);
}

int iovarlevel_(vn)
int *vn;
{
int i;
for(i=maxlev;i>=0;i--)if (*vn >= nvarlevel[i]) return i;
return 0;
}

int ioattrout_(vn,str)
int *vn;
char *str;
{
char *at;
int j;
j= *vn;
if (attr[j][0]){
  at=strchr(attr[j],';');
  if(at){
    *at = '\0';
    strcpy(str,attr[j]);
    if (strncmp(str,"width=",6) == 0) {   /* width attr, make widths array*/
      in_getwidth(&j,str);
    }
    strcpy(attr[j],at+1);
  } else {
    strcpy(str,attr[j]);
    if (strncmp(str,"width=",6) == 0) {
      in_getwidth(&j,str);
    }
    attr[j][0]='\0';
  };
  return 1;
} else return 0;
}

int iocommout_(str)
char *str;
{
char *at;
if (comments[0]){
  at=strchr(comments,'\n');
  if(at){
    *at = '\0';
    strcpy(str,comments);
    strcpy(comments,at+1);
  } else {
    strcpy(str,comments);
    comments[0]='\0';
  };
  return 1;
} else return 0;
}

void iovalreal_(vn,f)
int *vn;
float *f;
{
/* following line changed by clh, May 1996
if(strspn(values[i],"0123456789.+-"))
  to one below, to allow for strings that begin with digits
*/
int i;
char *end_char_ptr;

i= *vn;
if(i<0){*f= -9999.0;return;};
 
*f=strtod(values[i],&end_char_ptr);
if (*end_char_ptr != '\0')
   *f= -9999.0;

#ifdef DEBUG
printf("iovalreal %d %f\n",*vn,f);
#endif
return;
}

void iovalstr_(vn,tmp)
int *vn;
char *tmp;
{
static char *s;
int i;
i= *vn;
if(i<0){strcpy(tmp,"nd");return;};
s=values[i];
s=s+strspn(s," ");
strcpy(tmp,s);
#ifdef DEBUG
printf("iovalstr %d %s\n",*vn,tmp);
#endif
return;
}

void in_readnewheader()
{
/* INBUFSIZE was 82 when hardcoded */
char tmp[INBUFSIZE],*sp;
int i,clev,mlev;
if(!ateq){
  strcpy(tmp,"xx");
  while(tmp[0] != '='){
    if(ftok(fl,tmp)==EOF)error_("unexpected EOF","after ftok 3");
    if(tmp[0]=='*'){eofflag=1;newlev= -1;return;};
    }
}
else
  strcpy(tmp,"==");
ateq=0;
mlev=maxlev;
while(1) {
  if(tmp[0] == '='){
    clev= -1;
    while(1){
      if(clev >= 0)break;
      if(ftok(fl,tmp) == EOF)error_("unexpected EOF","after ftok 4");
      if(tmp[0] == '.' || tmp[0] == '-')break;
/*      if(tmp[strlen(tmp)-1] == ',')tmp[strlen(tmp)-1]=0; */
      if(sp=strchr(tmp,'['))*sp='\0';
      for(i=0;i<=maxlev;i++)
        if(!strcmp(tmp,names[nvarlevel[i]])) clev = i;
      };
    while(tmp[0] != '.' && tmp[0] != '-')
      if(ftok(fl,tmp) == EOF)error_("unexpected EOF","after ftok 5");
    if(clev<mlev) mlev=clev;
    };
  if(tmp[0] == '-') {newlev=mlev;return;};
  for(i=nvarlevel[clev];i<nvarlevel[clev+1];i++){
    if(ftok(fl,tmp) == EOF)error_("unexpected EOF","after ftok 6");
/*    if(tmp[strlen(tmp)-1] == ',')tmp[strlen(tmp)-1]=0; */
    strcpy(values[i],tmp);
    };
  if(ftok(fl,tmp) == EOF)error_("file structure","(3)");
  };
}

int ioreadrec_(level)
int *level;
{
int i;
/* INBUFSIZE was 82 when hardcoded */
char tmp[INBUFSIZE];
if(eofflag)return 0;
if(*level == newlev && newlev < maxlev){
  newlev++;
  return 1;
  };
if(*level > newlev)return 0;
if(*level == newlev && newlev == maxlev){
  for(i=nvarlevel[maxlev];i<nvarlevel[maxlev+1];i++){
    if(ftok(fl,tmp) == EOF)error_("unexpected EOF","after ftok 7");
    if(tmp[0]=='*'){eofflag=1;return 0;};
    if(tmp[0]=='='){ateq=1;return 0;};
    if(tmp[0]=='#'){return 0;};

/*    if(tmp[strlen(tmp)-1] == ',')tmp[strlen(tmp)-1]=0; */
    strcpy(values[i],tmp);
    };
  return 1;
  };
do {
  in_readnewheader();
  } while(newlev > *level);
if(newlev<*level)return 0;
newlev++;
return 1;
}

void ioclose_(maxlevel)
int *maxlevel;
{
fclose(fl);
}

int iowidth_(vn)
int *vn;
{
   int i;
   i = widths[*vn];
return i;
}

void in_getwidth(vn, ptr)
/* read the width from the string 'ptr' (an attribute that has
        been tested prior to coming here for containing the 
        string 'width=') and write it to the widths array
        element '*vn'
*/
int *vn;
char *ptr;
{
  char *p;
  int i,len;

  i = *vn;
  p = strchr(ptr,'=');

  sscanf(p+1,"%d", &len);

  widths[i] = len;
  return;
}