
/************************************************************************
 *                LIB.DAT                                               *
 ************************************************************************/
/*The source code Library File for BASCY                                *
 *            Version 1.0                                               *
 *(c)Copyright 2001 - S. Narasimhan, No.11, Sathya Nagar                *
 *                    MADURAI - 625018. INDIA.                          *
 *                   email: narasimhan_s_@hotmail.com                   *
 ************************************************************************
 * This program is free software; you can redistribute it and/or modify *
 * it under the terms of the GNU General Public License as published by *
 * the Free Software Foundation; either version 2 of the License, or    *
 * (at your option) any later version.                                  *
 *                                                                      *
 * This program is distributed in the hope that it will be useful,      *
 * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the        *
 * GNU General Public License for more details.                         *
 *                                                                      *
 * You should have received a copy of the GNU General Public License    *
 * along with this program; if not, write to the Free Software          *
 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.            *
 *                                                                      *
 ************************************************************************/
ÿ2ÿ
double ATN(double x)
/* Computes(in radians) the arc tan of x */
{
   double a0,b0, a1,b1, prev, cur;
   int i;
   a0 = 1 / SQR(1 + x * x);
   b0 = 1.0;
   a1 = 0.5 * (a0 + b0);
   cur = x /(SQR(1 + x * x) * a1);
   do{
      prev = cur;
      b1 = SQR(a1 * b0);
      a0 = a1; b0 = b1;
      a1 = 0.5 * (a0 + b0);
      cur = x /(SQR(1 + x * x) * a1);
   }while(ABS(cur - prev) > ERRLIMIT);
   return(cur);
}ÿ3ÿ
double COS(double x)
{
#define M_PI   3.141592653589793227020265931059839203954
#define M_2PI  (M_PI * 2)
#define M_PIOVER2   (M_PI / 2)
    int n, n2;
    double p,c,s;
    while(x < -M_2PI) x += M_2PI;
    while(x > M_2PI) x -= M_2PI;
    if(x < 0) x = -x;
    if(x > 3 * M_PIOVER2) x = M_2PI - x;
    n = 1;
    s = c = 1.0;
    do{
       p = c;
       n2 = n + n;
       c = -p * x * x / ((double)((n2 - 1) * n2));
       s += c;
       ++n;
    }while(ABS(c) > ERRLIMIT);
#undef M_PI
#undef M_2PI
#undef M_PIOVER2
   return(s);
}ÿ4ÿ
double  EXP(double x)
{
   int n = 1;
   double p,c,s;
   s = c = 1.0;
   do{
     p = c; c = p * x /((double)n);
     s += c;  ++n;
   }while(ABS(c) > ERRLIMIT);
   return(s);
}ÿ5ÿ
double INT(double x)
{
   long n;
   n = (long)x;
   if((double)n == x)  /* x is already integer */
      return((double)n);
   if(x < 0.0) x = x - 1.0;
      n = (long)x;
   return((double)n);
}ÿ6ÿ
double LOG(double x)
{
   unsigned m,k;
   long n;
   double u,y,z,zsqr,s,pn,cn;
   if(x <= 0.0) {
     fprintf(stderr,"\nLOG(): Domain Error");
     return 0.0;
   }
   if(x == 1.0)  return ((double) 0);
   if(x == 2.0) return ((double) LN2);
   for(m = 0, n = 1; ((double)n) <= x; m++)
     n <<= 1;  /* n = 2 * n  */
   y =  x / ((double)n);
   z = (1.0 - y) / (1.0 + y);
   zsqr = z * z;
   s = cn = z;
   k = 1;
   do{
     k++;
     pn = cn;
     cn = pn * zsqr;
     u = cn / (double)(k+k-1);
     s += u;
   }while(u > ERRLIMIT*0.01);
   return (((double)m) * LN2 - s - s);
}ÿ7ÿ
double LOG10(double x)
{
   double r;
   if(x <= 0.0) {
     fprintf(stderr,"\nLOG10(): Domain Error");
     return 0.0;
   }
   if(x == 1.0)  return ((double) 0);
   if(x == 10.0) return ((double) 1);
   r = LOG(x) / LN10;
   return(r);
}ÿ8ÿ
double RND(double x)
{
   double r;
   if(x < 0.0) /* reseed the random no. generator */
     srand((int) (-x));
   if(x == 0.0 && prand != -1.0) return(prand);
   r = (double) rand() / (double) ((unsigned)RAND_MAX + 1);
   if(r < 0.0) r = -r;
   prand = r;
   return(r);
}ÿ10ÿ
double SIN(double x)
{
#define M_PI   3.141592653589793227020265931059839203954
#define M_2PI  (M_PI * 2)
#define M_PIOVER2   (M_PI / 2)
    int n, n2;
    double p,c,s;
    while(x < -M_PIOVER2) x += M_2PI;
    while(x > 3 * M_PIOVER2) x -= M_2PI;
    n = 1;
    s = c = x;
    do{
       p = c;
       n2 = n + n;
       c = -p * x * x / ((double)((n2+1) * n2));
       s += c;
       ++n;
    }while(ABS(c) > ERRLIMIT);
#undef M_PI
#undef M_2PI
#undef M_PIOVER2
   return(s);
}ÿ11ÿ
double SQR(double x)
{
   double prev, present;
   if(x < 0.0) {
     fprintf(stderr,"\nSQR(): Domain Error");
     return 0.0;
   }
   if(x == 0.0 || x == 1.0) return(x);
   present = 0.5 * x;
   do{
      prev = present;
      present = (prev * prev + x) / (prev + prev);
   }while(ABS(present - prev) > ERRLIMIT);
   return(present);
}ÿ12ÿ
double TAN(double x)
{
    double y, yp, xsqr;
    xsqr = x * x;
    yp = 21.0;
    for(y = 19.0; y >= 1.0; y -= 2.0)
        yp = y  - xsqr/yp;
    return (x / yp);
}ÿ13ÿ
double ASC(char *s)
{
   return((double)(long) *s);
}ÿ14ÿ
char *CHR_(double x)
{
   char *s;
   s = strdup("  ");
   if(x < 0.0 || x > 255.0)
      fprintf(stderr,"\nCHR$: Argument out of range");
   else { s[0] = (char)(x+0.5);
          s[1] = '\0';}
   return(s);
}ÿ15ÿ
char *LEFT_(char *s, double x)
{
   char *t;
   int  i;
   long n;
   double frac;
   if(x < 0) {
     fprintf(stderr,"\nLEFT$: Argument out of domain");
     t = strdup("");
   }
   if(x == 0)
     t = strdup("");
   if(x > 0){
     n = (long) x;
     frac = x - (double)(long) x;
     if(frac > 0.5) n++;
     else if(frac == 0.5)
          if(n % 2 == 1) n++;
     i = strlen(s);
     if(n > i) n = i;
     t =(char *) malloc(n + 1);
     if(t == 0) {
       fprintf(stderr,"\nLEFT$:Out of memory");
       t = strdup("");
     }
     else{
       for(i = 0; i < n; i++)
         t[i] = s[i];
       t[i] = '\0';
     }
   }
   return(t);
}ÿ16ÿ
char *MID_(char *s, double b, double c)
{
   int i, n, last;
   long lb, lc;
   double frac;
   char *t, *v;
   if(b <= 0){
     fprintf(stderr, "\nMID$: Argument out of domain");
     return(strdup(""));
   }
   if(c < 0){
     fprintf(stderr, "\nMID$: Argument out of domain");
     return(strdup(""));
   }
   lb = (long) b;
   lc = (long) c;
   frac = b - (double)(long) b;
   if(frac > 0.5) lb++;
   else if(frac == 0.5)
         if(lb % 2 == 1) lb++;
   frac = c - (double)(long) c;
   if(frac > 0.5) lc++;
   else if(frac == 0.5)
         if(lc % 2 == 1) lc++;
   n = strlen(s);
   if(lb > n)
      return(strdup(""));
   last = lb + lc - 1;
   if(last > n) last = n;
   t = (char *) malloc(last - lb + 2);
   if(t == 0){
     fprintf(stderr,"\nMID$: Out of memory");
     return(strdup(""));}
   v = t;
   for(i = lb; i <= last; i++)
      *t++ = s[i-1];
   *t = '\0';
   return(v);
}ÿ17ÿ
char *RIGHT_(char *s, double x)
{
   char *t;
   int  i;
   long n;
   double frac;
   if(x < 0) {
     fprintf(stderr,"\nRIGHT$: Argument out of domain");
     t = strdup("");
   }
   if(x == 0)
     t = strdup("");
   if(x > 0) {
     n = (long) x;
     frac = x - (double)(long) x;
     if(frac > 0.5) n++;
     else if(frac == 0.5)
          if(n % 2 == 1) n++;
     i = strlen(s);
     if(n > i) n = i;
     i = i - n;
     t = strdup(s+i);
   }
   return(t);
}ÿ18ÿ
char *SPACE_(double x)
{
   char *s;
   if(x < 0.0 || x > 255.0)
      fprintf(stderr,"\nSPACE$: Argument out of range");
   else {
      int n;
      n = (int)(x+0.5);
      if((s = (char *) malloc(n+1)) == NULL){;
        fprintf(stderr,"\nOut of memory");
        exit(1);}
      s[n--] = '\0';
      while(n >= 0) s[n--] = ' ';
   }
   return(s);
}ÿ19ÿ
char *STR_(double x)
{
   char s[25];
   char *p;
   long n;
   double frac,sign;
   int i,j,len;
   i = 0;
   if(x == 0.0) { p = strdup("0"); return(p); }
   if((sign = x) < 0.0){
     x = -x;
   }
   if(x <= MAXFLOAT && x >= MINFLOAT) {
     n = (long) x;
     frac = x - (double)n;
     do{
       s[i++] = n % 10 + '0';
     }while((n /= 10) > 0);
     if(sign < 0.0) s[i++] = '-';
     len = i ;
     for(j = 0, i = len - 1; j < i; j++, i--) {
       char c;
       c = s[j]; s[j] = s[i]; s[i] = c;
     }
     i = len ;
     if(frac > 0.0){
        double f1;long d;
        s[i++] = '.';
        for (j = 1; j < 11; j++) {
          f1 = frac * 10.0;
          d = (long)(f1);
          s[i++] = d + '0';
          frac = f1 -(double)d;
          if(frac < 1.0E-10) break;
        }
        d = (long)(frac * 10 + 0.5);
        if(d == 10) d = 9;
        s[i++] = d + '0';
     }
     s[i] = '\0';
   }
   else {
     int exponent = 0;
     int dig;
     if(x >= 10.0){
       do{
          x /= 10.0; exponent++;
       }while(x >= 10.0);
     }
     else{
       while(x < 1.0) {
         x *= 10.0; exponent--;
       }
     }
     if(x+0.5E-10 >= 10.0){
       x += 0.5E-10;
       x /= 10.0; exponent++;
     }
     dig = (int)x;
     if(sign < 0.0) s[i++] = '-';
     s[i++] = dig + '0';
     s[i++] = '.';
     for(j = 1; j < 10; j++) {
       x = 10 * (x - (double)dig);
       dig = (int) x;
       s[i++] = dig + '0';
     }
     x = 10 * (x - (double)dig);
     dig = (int) (0.5+x);
     if(dig == 10) dig = 9;
     s[i++] = dig + '0';
     s[i++] = 'E';
     if(exponent >= 0)
       s[i++] = '+';
     else{
       s[i++] = '-'; exponent = -exponent;}
     if(exponent > 99) {
        fprintf(stderr,"\nSTR$: Floating Point Overflow");
        exponent = 99;
     }
     {
       int d1, d2;
       d2 = exponent % 10;
       d1 = (exponent / 10) % 10;
       s[i++] = d1 + '0';
       s[i++] = d2 + '0';
     }
     s[i] = '\0';
   }
   p = strdup(s);
   return(p);
}ÿ20ÿ
LEN(char *s)
{
 int i;
 for(i=0; *s != '\0';s++,i++)
        ;
 return i;
}ÿ21ÿ
double VAL(char *s)
{
   double x;
   x = str2num(s);
   _err = 0;
   return(x);
}ÿ22ÿ
getstr(FILE *fp, char *s)   /*Get next string from FILE fp */
{
 int c;
  int quoteseen = 0;
  s[0] = '\0';
 while((c=getc(fp)) == ' ' || c == '\t')
      ;
 if(c == '\r' || c == '\n'){
     _err = 0; return 0;}
 if(c == EOF) { _err = 1; return 0;}
 if(c == ',') { _err = 2; return 0;}
 quoteseen = ((c=='"')? 1 : 0);
 if(c != '"')
     *s++ = c;
 while((c=getc(fp))!='\r' && c!='\n' && c!='"' && c!=EOF){
   if(c==',' && quoteseen == 0) break;
   *s++ = c;}
 *s = '\0';
 if(c == '"')
   while((c=getc(fp)) == ' ' || c == '\t')
        ;
 if(c!='\r' && c!= '\n' && c!=',' && c!=EOF) {
    _err = 1; return 0; }
 if(c == ',') { _err = 2; return 0;}
  _err = 0;
 return 0;
}ÿ23ÿ
double getnum(FILE *fp) /*get next number from FILE fp */
{
  int c, sign;
  double val, power;
  char ns[MAXSTRLEN+1], *s, *t;
  t = s = &ns[0];
  while((c=getc(fp)) == ' '||c=='\t')
     ;
  if(c == '\r' || c == '\n'){
     _err = 0; return 0;}
  if(c == EOF) { _err = 1; return 0;}
  if(c == ',') { _err = 2; return 0;}
  *s++ = c;
  while((c=getc(fp)) != '\r' && c!='\n' && c!=',' && c!=EOF && c!= ' ' && c!='\t')
     *s++ = c;
  *s = '\0';
  if(c == ' ' || c == '\t')
    while((c=getc(fp)) == ' ' || c == '\t')
       ;
  if(c!='\r' && c!='\n' && c!=',' && c!=EOF){
    _err = 1; return 0;}
  if(c == ',') _err = 2;
  else  _err = 0;
  c = *t;
  sign = 1;
  if(c=='+'|| c=='-') { sign=(c=='+')?1:-1; c = *++t;}
  for(val=0; c != '\0' ; c = *++t){
     if(c < '0' || c > '9') break;
     val = 10.0 * val + (double)(c - '0');}
  power = 1.0;
  if(c == '.') {
   for(c = *++t; c != '\0' ; c = *++t){
       if(c < '0' || c > '9'){ _err = 1; return 0;}
       power *= 10.0;
       val = 10.0 * val + (double)(c - '0');
   }
  }
  if(c != '\0'){ _err = 1; return 0;}
  return(sign * val / power);
 }ÿ24ÿ
double idiv(double d1, double d2)
/*Integer division-returns quotient of d1/d2 */
{
   long n1, n2, q;
   d1 += ((d1 >= 0) ? 0.5 : -0.5);
   d2 += ((d2 >= 0) ? 0.5 : -0.5);
   n1 = (long)d1;
   n2 = (long)d2;
   q = (long)(n1/n2);
   return((double)q);
}
double mod(double d1, double d2)
/*Integer division-returns remainder of d1/d2 */
{
   long n1, n2, q, r;
   q = idiv(d1,d2);
   d1 += ((d1 >= 0) ? 0.5 : -0.5);
   d2 += ((d2 >= 0) ? 0.5 : -0.5);
   n1 = (long)d1;
   n2 = (long)d2;
   r = n1 - (long)q * n2;
   return((double)r);
}ÿ25ÿ
double power(double a, double b)
/* Returns a ^ b */
{
   double p;
   long n;
   int negpow;
   n = (long)b;
   if((double)n == b) { /* b is integer */
      long i;
      if(n < 0) {
         n = -n; negpow = 1;}
      else   negpow = 0;
      for(i = 0, p = 1.0; i < n; i++)
          p *= a;
      if(negpow) p = ((double)1) / p;
   }
   else{
       if(a > 0.0)
         p = EXP(b * LOG(a));
       else{
         fprintf(stderr,"\npower:%lf out of domain",a);
         p = 0.0;
       }
   }
   return(p);
}ÿ26ÿ
double CINT(double x)
{
     long n, sign;
     double frac;
     if(x < 0){
       sign = -1; x = -x;
     }
     else sign = 1;
     n = (long) x;
     frac = x - (double)(long) x;
     if(frac > 0.5) n++;
     else if(frac == 0.5)
        if(n % 2 == 1) n++;
     return((double)(long)(sign * n));
}ÿ27ÿ
double FIX(double x)
{
   return((double)(long)x);
}ÿ28ÿ
double SIND(double x)
{
  while(x < -90) x += 360;
  while(x > 270) x -= 360;
  return(SIN(DEGRAD * x));
}ÿ29ÿ
double COSD(double x)
{
  while(x < -360) x += 360;
  while(x > 360) x -= 360;
  if(x < 0) x = -x;
  if(x > 270) x = 360 -x;
  return(COS(DEGRAD * x));
}ÿ30ÿ
double str2num(char *s) /*convert the numeric str.s into number */
{
 int c, sign;
  double val, power;
 while((c=*s++) == ' '||c=='\t')
     ;
 sign = 1;
if(c=='+'|| c=='-') { sign=(c=='+')?1:-1; c=*s++;}
for(val=0; c >= '0' && c <= '9' ; c=*s++)
     val = 10 * val + c - '0';
power = 1;
 if(c == '.') {
   for(c=*s++;c >= '0' && c <= '9' ; c=*s++){
       power *= 10;
       val = 10 * val + c - '0';
   }
  }
 if(c!='\0')
    _err = 1;
 else
    _err = 0;
 return(sign * val / power);
 }ÿ31ÿ
char *LTRIM_(char *s)
{
   char *p;
   while(*s == ' ' && *s != '\0')
       s++;
   p = strdup(s);
   return(p);
}ÿ32ÿ
char *RTRIM_(char *s)
{
   char *p, *t;
   if(*s == '\0') return s;
   p = strdup(s);
   t = p;
   while(*p != '\0')
      p++;
   p--;
   while(p >= t && *p == ' ')
      p--;
   p++;
   *p = '\0';
   return(t);
}ÿ33ÿ
char *LCASE_(char *s)
{
   char *p, *t;
   p = strdup(s);
   t = p;
   while(*p != '\0'){
      *p = ((*p >= 'A' && *p <= 'Z') ? *p - 'A' + 'a' : *p);
      p++;}
   return(t);
}ÿ34ÿ
char *UCASE_(char *s)
{
   char *p, *t;
   p = strdup(s);
   t = p;
   while(*p != '\0'){
      *p = ((*p >= 'a' && *p <= 'z') ? *p - 'a' + 'A' : *p);
      p++;}
   return(t);
}ÿ35ÿ
char *TRIM_(char *s)
{
   char *p, *t;
   while(*s == ' ' && *s != '\0')
       s++;
   p = strdup(s);
   if(*p == '\0') return p;
   t = p;
   while(*p != '\0')
      p++;
   p--;
   while(p >= t && *p == ' ')
      p--;
   p++;
   *p = '\0';
   return(t);
}ÿ36ÿ
double TAND(double x)
{
  return(TAN(DEGRAD * x));
}ÿ37ÿ
getline(FILE *fp, char *s)
{
   int c, n;
   n = 1;
   while((c = getc(fp)) != '\r' && c != '\n' && c != EOF) {
     *s++ = c; n++;
     if(n > MAXSTRLEN) break;
   }
   *s = '\0';
}ÿ38ÿ
char *HEX_(double x)
{
   double frac;
   unsigned long  n,n1, limit;
   int i, j;
   char s[9], *t;
   limit = ~((unsigned long)0)>>1;
   n  = (long) x;
   n1 = n;
   if(x < 0) n1 = -n;
   frac = x - (double)(long) x;
   if(frac < 0){
      frac = -frac;
      if(frac > 0.5) n--;
      else if(frac == 0.5)
        if(n % 2 == 1) n--;
   }
   else {
      if(frac > 0.5) n++;
      else if(frac == 0.5)
        if(n % 2 == 1) n++;
   }
   if(n1 > limit) { printf("\nOverflow"); return(strdup(""));}
   i = 0;
   do {
      int r;
      r = n % 16;
      if( r < 10) s[i++] = r + '0';
      else s[i++] = r - 10 + 'A';
   } while((n /= 16) > 0);
   s[i] = '\0';
   for(i = 0, j = strlen(s) - 1 ; i < j; i++, j--) {
     int c;
     c = s[i]; s[i] = s[j]; s[j] = c;
   }
   t = strdup(s);
   return(t);
}ÿ39ÿ
char *OCT_(double x)
{
   double frac;
   unsigned long  n,n1, limit;
   int i, j;
   char s[17], *t;
   limit = ~((unsigned long)0)>>1;
   n  = (long) x;
   n1 = n;
   if(x < 0) n1 = -n;
   frac = x - (double)(long) x;
   if(frac < 0){
      frac = -frac;
      if(frac > 0.5) n--;
      else if(frac == 0.5)
        if(n % 2 == 1) n--;
   }
   else {
      if(frac > 0.5) n++;
      else if(frac == 0.5)
        if(n % 2 == 1) n++;
   }
   if(n1 > limit) { printf("\nOverflow"); return(strdup(""));}
   i = 0;
   do {
      s[i++] = n % 8 + '0';
   } while((n /= 8) > 0);
   s[i] = '\0';
   for(i = 0, j = strlen(s) - 1 ; i < j; i++, j--) {
     int c;
     c = s[i]; s[i] = s[j]; s[j] = c;
   }
   t = strdup(s);
   return(t);
}ÿ40ÿ
char *EnvN_(double x)
{
   char *s;
   double frac;
   long n;
   if(x <= 0) {
      fprintf(stderr,"\nEnvN$: Invalid Argument");
      return(strdup(""));
   }
   n = (long) x;
   frac = x - (double)(long) x;
   if(frac > 0.5) n++;
   else if(frac == 0.5)
           if(n % 2 == 1) n++;
   if(n == 0) {
      fprintf(stderr,"\nEnvN$: Invalid Argument");
      return(strdup(""));
   }
   s = strdup(environ[--n]);
   return(s);
}
char *EnvS_(char *t)
{
   char *s;
   s = strdup(getenv(t));
   return(s);
}ÿ41ÿ
char *STRING_(double n, double c)
{
   long ln, lc;
   double frac;
   char *s, *t;
   if(n < 0){
     fprintf(stderr,"\nSTRING$: Argument out of domain");
     return(strdup(""));
   }
   while(c < 0)  c += 256;
   ln = (long) n;
   lc = (long) c;
   frac = n - (double)(long) n;
   if(frac > 0.5) ln++;
   else if(frac == 0.5)
       if(ln % 2 == 1) ln++;
   frac = c - (double)(long) c;
   if(frac > 0.5) lc++;
   else if(frac == 0.5)
       if(lc % 2 == 1) lc++;
   lc %= 256;
   s = (char *) malloc(ln + 1);
   if(s == 0){
      fprintf(stderr, "\nSTRING$: Out of memory");
      return(strdup(""));
   }
   t = s;
   while(ln > 0){
       *s++ = lc;
       ln--;
   }
   *s = '\0';
   return(t);
}ÿ42ÿ
INSTR(double b, char *s1, char *s2)
{
   int  i, j,n1, n2;
   long lb;
   double frac;
   char *s, *t;
   if(b <= 0) {
     fprintf(stderr,"\nINSTR: Argument out of domain");
     return 0;
   }
   lb = (long) b;
   frac = b - (double)(long) b;
   if(frac > 0.5) lb++;
   else if(frac == 0.5)
        if(lb % 2 == 1) lb++;
   n1 = strlen(s1);
   n2 = strlen(s2);
   s = (char *) malloc(n2 + 1);
   if(s == 0){
      fprintf(stderr,"\nINSTR: Out of memory");
      return 0;
   }
   for(i = lb-1, t= &s1[i]; i < n1 - n2 + 1; i++, t = &s1[i]){
     for(j = 0; j < n2; j++)
       s[j] = *t++;
     s[j] = '\0';
     if(strcmp(s,s2) == 0){
       free(s);
       return (i+1);
     }
   }
   free(s);
   return 0;
}ÿ43ÿ
double DOW(double d, double m, double y)
{
   int id, im, iy, jd, n_days;
   id = (int) d; im = (int) m; iy = (int) y;
   if(iy <= 0) {
     fprintf(stderr,"\nDOW:Invalid Year");
     return 0;
   }
   if(im <= 0 || im > 12) {
     fprintf(stderr,"\nDOW:Invalid Month");
     return 0;
   }
   if(im == 2) {
     if(iy % 4 == 0 && iy % 100 != 0 || iy % 400 == 0)
        n_days = 29;
     else  n_days = 28;
   }
   else if(im == 4 || im == 6 || im == 9 || im == 11)
       n_days = 30;
   else n_days = 31;
   if(id <= 0 || id > n_days) {
     fprintf(stderr,"\nDOW:Invalid Date");
     return 0;
   }
   if(im <= 2) {
     --iy; im += 12;
   }
   jd = id + im + im + (3 * im + 3) / 5 + iy + iy / 4 + iy / 400 - iy / 100 + 1;
   return((double)(jd % 7 + 1));
}ÿ44ÿ
char *DATE_(double x)
{
#define UNIT(x)  ((x) % 10) + '0'
#define TENS(x)  ((x) / 10) + '0'
   int dd,mm,yy,cent,yr;
   time_t  tim;
   struct tm *t;
   char s[11];
   if(x == 1)
     s[2] = s[5] = '-';
   else
     s[2] = s[5] = '/';
   s[10] = '\0';
   tim = time(0);
   t = localtime(&tim);
   dd = t->tm_mday;
   mm = t->tm_mon + 1;
   yy = t->tm_year + 1900;
   cent = yy / 100; yr = yy % 100;
   s[0] = TENS(dd); s[1] = UNIT(dd);
   s[3] = TENS(mm); s[4] = UNIT(mm);
   s[6] = TENS(cent); s[7] = UNIT(cent);
   s[8] = TENS(yr); s[9] = UNIT(yr);
#undef UNIT
#undef TENS
   return(strdup(s));
}ÿ45ÿ
char *TIME_(double x)
{
#define UNIT(x)  ((x) % 10) + '0'
#define TENS(x)  ((x) / 10) + '0'
   int hh,mm,ss;
   time_t  tim;
   struct tm *t;
   char s[9];
   if(x == 1)
     s[2] = s[5] = ':';
   else
     s[2] = s[5] = '.';
   s[8] = '\0';
   tim = time(0);
   t = localtime(&tim);
   hh = t->tm_hour;
   mm = t->tm_min;
   ss = t->tm_sec;
   s[0] = TENS(hh); s[1] = UNIT(hh);
   s[3] = TENS(mm); s[4] = UNIT(mm);
   s[6] = TENS(ss); s[7] = UNIT(ss);
#undef UNIT
#undef TENS
   return(strdup(s));
}ÿ46ÿ
double TIMER(double x)
{
   time_t now;
   struct tm *t;
   long hh,mm,ss;
   long SecinDay;
   now = time(0);
   t = localtime(&now);
   hh = t->tm_hour;
   mm = t->tm_min;
   ss = t->tm_sec;
   SecinDay = hh * 3600 + mm * 60 + ss + x - x;
   return ((double) SecinDay);
}ÿ47ÿ
eof(double x)
{
   long n;
   n = (long)(x+0.5);
   if(n < 1 || n > (int)MAXFILENUM || fdList[n-1] == 0) {
     fprintf(stderr,"\nEOF : Bad File Number(%ld)",n);
     exit(1);}
   return(feof(fdList[n-1]) ? 1 : 0);
}ÿ48ÿ
double LOF(double x)
{
  FILE *fp;
  long n, pos, filsize;
  n = (long) (x + 0.5);
  if(n < 1 || n > (int)MAXFILENUM || (fp=fdList[n-1]) == 0){
     fprintf(stderr,"\nLOF: Bad File Number(%ld)",n);
     exit(1);}
  if((pos=ftell(fp)) == -1L){
    fprintf(stderr,"\nLOF failed");
    return ((double) 0);}
  fseek(fp, 0L, SEEK_END);
  if((filsize=ftell(fp)) == -1L){
    fprintf(stderr,"\nLOF failed");
    return ((double) 0);}
  fsetpos(fp, &pos);
  return((double) filsize);
}ÿ49ÿ
double FREEFILE(double x)
{
   int i;
   for(i = 0; i < (int)MAXFILENUM; i++) {
      if(fdList[i] == NULL) return((double)(i + 1)+x-x);
   }
}
