/* *******************************************************************
 *                                                                   *
 * Copyright (c) L-DGO/MIT/JGOFS                                     *
 *                                                                   *
 *                                                                   *
 * File             : math.c                                         *
 *                                                                   *
 ******************************************************************* */
char math_id[] = "math  version 2.2b 11 Jan 99";
/*
  11 Jan 99.  v 2.2b.  WJS
	Remove need for PARSAVSIZE via dynamic memory allocation
	Define HP & IBM if not explicity defined (avoids compile-time
    warnings from some compilers)
	Add iovaldouble_ entry.
	[Needs mathex v 2.2a]
	[Needs jgmath.h v 1.3]
	[Begin 2.2b]
  12 Nov 98.  v 2.2a.  WJS
	Close a comment properly
	Incorporate mathex 2.2a bug fix.
	[Needs mathex v 2.2a]
	[Needs jgmath.h v 1.2]
	[Begin 2.2a]
   5 May 98.  v 2.2.  WJS
	Use := as equation separator
	Let parsex call error_ directly
	[Needs mathex v 2.2]
	[Needs jgmath.h v 1.2]
	[Begin 2.2]
  28 Apr 98.  v 2.1.  WJS
	Switch pcode arrays to union of signed & unsigned char so we can
    remove architecture references
	Parametrize PCODE_LEN.
	Switch variable number in pcode from 7 bits to 15.
	[Needs mathex v 2.1]
	[Needs jgmath.h v 1.1]
	[Never used]
	[Begin 2.1]
   2 Apr 98.  v 2.0.  WJS
	[Needs mathex v 2.0]
	[Needs jgmath.h v 1.0]
	[Put in globec's /optserver dir 14 Apr 98]
  ???    98   v 2.0   CLH
	Begin jgofs 1.5 mods to math.  Also, add width sensing
	[Comment by WJS]
  ?? May 96   v ???   CLH
	Make iovalreal do string/number decision on all chars of string
  17 Oct 92   v 1.1   GRF
*/

#include "jgmath.h"

#ifndef HP
#define HP FALSE
#endif
#ifndef IBM
#define IBM FALSE
#endif

#if HP || IBM
#define jdbopen_ jdbopen
#define jdbreada_ jdbreada
#define jdbread_ jdbread
#define jdbclose_ jdbclose
#define jdbcomments_ jdbcomments
#define jdblevel_ jdblevel
#define jdbattributes_ jdbattributes
#endif
/* #define DEBUG */

  /*  jdb functions							*/
int jdbopen_();
int jdbreada_();
int jdbread_();
int jdbclose_();
int jdbcomments_();
int jdblevel_();
int jdbattributes_();
  /*  mathex functions							*/
void parsex();
void execute();
  /*  outer functions							*/
void error_();

int nlevels;
int firstvar[MAXLEVELS+1];
int lev[NVAR],vpntr[NVAR];
int fldwidths[NVAR];

int name_array_size=VARNAMESIZE+1;
char names[NVAR][VARNAMESIZE+1];

int value_array_size=DATUMSIZE+1;
char values[NVAR][DATUMSIZE+1];

int handle;
int minlevelread;
int ncrit;

  /*    Each pstring is a copy of an equation (from a parameter		*/
  /*  on the command line).  It used to be parsed into a 255 char temp	*/
  /*  array by parsex, and then copied over the original equation, but	*/
  /*  we've made another array here and eliminated the temp array.  2	*/
  /*  arrays needed one way or the other, since there's no guarantee	*/
  /*  that pcode string is at all times smaller than the equation (esp	*/
  /*  since we increased the coded size of a variable number from 1 to	*/
  /*  2 bytes.								*/
  /*    Max len	of pcode was hardcoded at 255 chars in parsex.  Equa-	*/
  /*  tion size has always exceeded 255.  Pcode size was never tested.	*/
  /*  We parametrize but still don't test				*/
unsigned char pcode[MAX_EQUATIONS][PCODE_LEN+1];
char pstrings[MAX_EQUATIONS][INBUFSIZE+1+1];	/* Extra +1 for parsex	*/
						/* which adds a $	*/
int npstrings;

char newvar_attrs[MAX_NEW_VARS][TOTATTRSIZE+1];
int n_newvars = 0;

char comments[COMMENTSIZE+1];

void docalc()
{
  int i;

  for (i=0; i<npstrings; i++)
    execute (pcode[i],values);

  return;
}

void doinit0(nparams,s,s0)
char *s[];
char s0[];
int *nparams;
  /*  s is a list of the parameters passed to math			*/
  /*    s[0] is the object math is going to work on.			*/
  /*    s[1]...s[nparams] are a mix of selections/projections and	*/
  /*	  equation strings						*/
  /*  s0 is a copy of the object specifier, which we alter		*/
  /*									*/
  /*  Separate the equations from the projections and selections.	*/
  /*  Separate the selections into those that apply to variables in	*/
  /*    original object and those that apply to newly generated vars	*/
{
  int i,j,k;
  char *sp;
  char *tmp;

  for (i=1; i<*nparams; i++)
    if (strstr(s[i],EQUATION_ID) != NULL) {
      strcat(comments,s[i]);
      strcat(comments,"\n");
      if (npstrings == MAX_EQUATIONS) error_("Too many equation strings","");
	/*  Rest of parsing depends on var=rest format, so replace all	*/
	/*  EQUATION_ID strings with =s					*/
      strcpy (pstrings[npstrings],s[i]);
      j = strlen(EQUATION_ID);
      sp = pstrings[npstrings++] - 1;
      while (  (sp = strstr(++sp,EQUATION_ID)) != NULL  ) {
        *sp = '=';
	strcpy(sp+1,sp+j);
      }
      s[i][0]='\0';
    }

    /*  Get buffer big enough to hold any s[i]				*/
  j = 0;
  for (i=1; i<*nparams; i++)
    if ( (k = strlen(s[i]) + 1) > j ) j=k;
  if ( (tmp = (char *)malloc(j)) == NULL )
    error_ (math_id,"Could not get memory for tmp buffer in doinit0");

  for (i=1; i<*nparams; i++)
    if (s[i][0] != '\0') {

      strcpy(tmp,s[i]);

      if ( (sp=strpbrk(tmp,"<=>")) != NULL  )  {
	  /* Process selection						*/
        *(sp++) = '=';
        *sp = '\0';
        j = strlen(tmp);
        for (k=0; k<npstrings; k++)
	  if (strncmp(pstrings[k],tmp,j) == 0) break;
        if (k == npstrings) {
	    /*  Not found in equations, so this is an "old" variable	*/
	    /*  Tack it onto list to be passed to object's method	*/
	    /*  s0 is object spec					*/
          j = strlen(s0);
          if (s0[j-1] == ')') s0[j-1]=',';
	  else strcat(s0,"(");
          strcat(s0,s[i]);
          strcat(s0,")");
	    /*  Mark this selection so math's outer doesn't process it	*/
          s[i][0]='\0';
        }
      }
    }

  free (tmp);
  return;
}
      

void doinit1()
{
int i,j,k,m;
unsigned char *sp;

for (i=0; i<npstrings; i++) {
  parsex(pcode[i],pstrings[i],
			names,firstvar+nlevels+1,newvar_attrs,&n_newvars);
  sp = pcode[i];
  k = 0;
  while (*sp) {
    if (*sp == 3) {
	/*  Variable # is 15 bits following "128" bit.			*/
      m = 256*((int)*(sp+1)-128) + (int)*(sp+2);
      sp += 3;
    } else if (*sp > 127) {
	/*  Variable # is 15 bits following "128" bit.			*/
      j = 256*((int)*sp-128) + (int)*(sp+1);
      j = lev[j];
      if (j > k) k=j;
      sp += 2;
    } else
      sp++;

    if ((*sp == ',') || (*sp == 0))  {
      lev[m] = k;
      if (k > ncrit) ncrit = k;
    }
  }
}
}

int ioreadrec_(level)
int *level;
{
  /*
     printf("** level %d  minlevelread %d \n",*level,minlevelread);
  */
  
  if (*level == minlevelread) {
    minlevelread= *level+1;
    return 1;
  } else if (*level > minlevelread) return 0;

  while (  *level <
		(minlevelread = jdbreada_(&handle,values,&value_array_size))  ) 
    ;

  if (minlevelread <= ncrit) docalc();
 
  if (*level == minlevelread) {
    minlevelread++;
    return 1;
  } else return 0;

}


void ioclose_()
{
  jdbclose_(&handle);
  return;
}

int ioopen_(s,nparams,ntotal)
char *s[];
int *nparams;
int *ntotal;
{
  char tmp[INBUFSIZE],*sp;
  int i,j,k,m,maxclev,nread;
  
  strcpy(tmp,s[0]);
  npstrings=0;
  doinit0(nparams,s,tmp);

  for (i=0;i<NVAR;i++)lev[i]= -1;
  nread = -NVAR;
  maxclev=jdbopen_(&handle,tmp,names,&name_array_size,&nread);
  if (maxclev<0) error_("Bad Object returned from jdbopen ",s[0]);
  s[0][0]=0;
  *comments=0;
  while(jdbcomments_(&handle,tmp)) {
    strcat(comments,tmp);
    strcat(comments,"\n");
  }
  nlevels=0;
  firstvar[nlevels]=0;
  for(i=0;i<nread;i++){
    lev[i]=jdblevel_(&handle,&i);
    if (lev[i] > firstvar[nlevels]) firstvar[++nlevels]=lev[i];
  }
  firstvar[nlevels+1]=nread;

  ncrit=0;
  doinit1();

  k=0;
  *ntotal=firstvar[nlevels+1];
  for (i=0; i <= nlevels; i++)
    for (j=0; j < *ntotal; j++) if (lev[j]==i) vpntr[k++]=j;
  minlevelread = nlevels+1;
  return nlevels;
}

int iovarlevel_(vn)
int *vn;
{
  return lev[vpntr[*vn]];
}

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 fldwidths array
        element '*vn'
*/
int *vn;
char *ptr;
{
  char *p;
  int len;
  p = strchr(ptr,'=');
 
  sscanf(p+1,"%d", &len);
 
  fldwidths[*vn] = len;
  return;
}

int ioattrout_(vn,str)
int *vn;
char *str;
{
   int j,newvar_number;
   char *ptr;
 
   j = vpntr[*vn];
     /*  Calculate position of var in sequence				*/
     /*    n_newvars...*ntotal, where position 0 = *ntotal-n_newvars	*/
     /*  This is position "at the end" of the variable list, where the	*/
     /*  new variables got added.  Before this position, vars are in	*/
     /*  object, and attrs come from jdbattributes.  After, attrs were	*/
     /*  entered when user entered equation defining variable		*/
   newvar_number = j - (firstvar[nlevels+1] - n_newvars);
 
   if (newvar_number < 0) {
     if (jdbattributes_(&handle,&j,str) == 0) return 0;
   } else {
     if (newvar_attrs[newvar_number][0] == '\0') return 0;
     ptr = strchr(newvar_attrs[newvar_number],ATTRIB_SEP);
     if (ptr == NULL) {		/*  only attribute left for this var	*/
       strcpy(str,newvar_attrs[newvar_number]);
       newvar_attrs[newvar_number][0] = '\0';
     } else {			/*  more than 1 attribute		*/
       *ptr = '\0';
       strcpy(str,newvar_attrs[newvar_number]);
       strcpy(newvar_attrs[newvar_number],ptr+1);
    }
  }

  if (strncmp(str,"width=",6) == 0) in_getwidth(&j,str);

  return 1;
}

void iovaldouble_(vn,f)
int *vn;
double *f;
{
  int i;
  char *end_char_ptr;
 
  i=vpntr[*vn];
  if (i < 0) {
    *f=-9999.0;
    return;
  }
 
/* following line changed by clh, May 1996
  if(strspn(values[vpntr[*vn]],"0123456789.+-"))
  to one below, to allow for strings that begin with digits
*/
 
  *f = strtod(values[i],&end_char_ptr);
  if (*end_char_ptr != '\0') *f= -9999.0;

  return;
}

void iovalreal_(vn,f)
int *vn;
float *f;
{
  double df;

  iovaldouble_(vn,&df);
  *f = df;

  return;
}

void iovalstr_(vn,tmp)
int *vn;
char *tmp;
{
  char *s;
  s=values[vpntr[*vn]];
  s=s+strspn(s," ");
  strcpy(tmp,s);

  return;
}

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

int iocommout_(str)
char *str;
{
  char *at;

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

}

int iowidth_(vn)
int *vn;
{
   return fldwidths[vpntr[*vn]];
}