/* @(#)ostcrea.c	17.1.1.1 (ESO-DMD) 01/25/02 17:50:05 */
/*===========================================================================
  Copyright (C) 1995 European Southern Observatory (ESO)
 
  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 Massachusetts Ave, Cambridge, 
  MA 02139, USA.
 
  Correspondence concerning ESO-MIDAS should be addressed as follows:
	Internet e-mail: midas@eso.org
	Postal address: European Southern Observatory
			Data Management Division 
			Karl-Schwarzschild-Strasse 2
			D 85748 Garching bei Muenchen 
			GERMANY
===========================================================================*/

/*---------------------------------------------------------------------
.TYPE        Module
.NAME        ostcrea.c
.LANGUAGE    C
.AUTHOR      IPG-ESO Garching
.CATEGORY    Data Organizer utilities
.COMMENTS       This module implements the following Midas commands:
\begin{TeX}
\begin{enumerate}
\item
\end{enumerate}
\end{TeX}

.VERSION  1.0   15-Mar-1993   Definition     M. Peron

 010116		last modif

-------------------------------------------------------------------*/

#ifndef vms		/* dirent.h does not exist on vms */
#include <sys/types.h>
#include <dirent.h>
#include <sys/stat.h>
#endif
#include <atype.h>
#include <tbldef.h>
#include <tblsys.h>
#include <tblerr.h>
#include <fitsfmt.h>
#include <fitsdef.h>
#include <midas_def.h>
#include <macrogen.h>
#include <stdio.h>
#include <osparms.h>
#include <osfile.h>
#include <computer.h>

#define  NM 61
#define  NT 6
#define  SLEN 256
#define  NLAB 17
#define    MXLIST     64
char *getnext() ;

static  int          lno = -1;          /* no.  to current list range   */
static  struct {                        /* structure with list of no's  */
                 int    first;          /* first no. in range           */
                 int     last;          /* last no. of in range         */
               } list[MXLIST];

/*
#ifndef vms
struct dirent *oslread();
#endif
*/

char *getnext();
unsigned long ccitt32_updcrc();
double otimetomjd();
int listtype,no,tidtemp,colfile,nenttemp,lname;
int kuni;
char cext[4];
char   finame[128],diname[128];

/*

*/

int ostcrea(flist,pfix,intable,outable,flag)
char flist[128],intable[60],outable[60],flag[4],pfix[5];

{
int   htype,ktype,mfd,nll,err,nchar,knewtype,nent,newnoelem;
int   dummy,dummy1,i,j,k,l,n, nocat,notrue,fd,newtab,nsel,sel ;
int   status,tid,nrow,kcol,fcol,otid,ormf,nb,imno ;
int   pcol,kncol,tcol,incr;
int   noelem[SLEN], noelembis,ocol[SLEN],colf;
int   *ipos,ontype,poss,*keyival[256], unit;
int   null, nl, fin,dfmt,flen;
int   one,zero,loc,size,upda;
int   naxis,npix[3],ocolmjd,ocolmean,ocolsigma,ocolmprime,ocolsigprime;
int   ocolaz,ocolal,ocoldate,close;
int   fid;		/* file descr. returned by dopen. CG 3/6/98 */
int   MxMdb;		/* now the no. of used entries in mdbuf (KB) */
unsigned long crc;

float  ms[2],*keyrval[256],fac,zeroi,*image, min, max;
float sparam[8];

double start[3],step[3],dval,mjd,date,time,ra,dec,lst,*keydval[256];
double azimuth,altitude,mydate;

char   fmt,hist,*valc,*buffer;
char   filename[80],dinewname[128];
char   *line,incata[60],cpos[4];
char   *cdummy, type,*nfn,devt;
char   form[1+TBL_FORLEN],*temp, *otype,*oform;
char   *keyname,*label,*area,defaul[5];
char   *keyword = "key_iname";
char   *mylabel;
char   *keycval[256],fflist[128];
 
BFDEF  *bfdef,*hdr_init();
KWORD  kw;
MDBUF  *mdbuf,*mdb_init();
ADEF   *ad;




status = TCTOPN(intable,F_I_MODE,&tid)  ;
status = TCIGET(tid,&dummy,&nrow,&dummy,&dummy,&dummy);
status = TCSCNT(tid,&nsel);
for (i=0; i<256; i++) {
    keycval[i] = (char *)0;
    keyival[i] =  (int *) 0;
    keydval[i] = (double *) 0;
    keyrval[i] = (float *) 0;
   }
ormf = 0;
l =0;
no = 1;
listtype = 0;
close = 0;
strcpy(fflist,flist);
for (i=0; i<SLEN; i++) ocol[i] = -1;
if (flist[0] == '+') nent = 200;
else if (stuindex(flist,".tbl") != strlen(flist)) {
     listtype = 2;
     TCTOPN(flist,F_I_MODE,&tidtemp);
     status = TCIGET(tidtemp,&dummy,&nenttemp,&dummy,&dummy,&dummy);
     TCLSER(tidtemp,"FILE",&colfile);
     TCBGET(tidtemp,colfile,&dummy,&dummy1,&lname);
     nent = nenttemp;
     }
else if (flist[strloc(flist,'*')] || pfix[0] == '+' ) {
     listtype = 1;
     decomp(fflist,diname,finame);
     nent = oslopen(diname,finame);
     if (!nent) {
	  if (close) oslclose();
	  TCTCLO(tid);
	  return(-1);
	  }
     close = 1;
     }
else {
    nent = openlist(flist);                       /* initiate file list */
    if (flag[0] == 'F' || flag[0] == 'f') strcpy(cext,".mt");
    else strcpy(cext,".bdf");
    }
if (flag[1] == 'C' || flag[1] == 'c') {
  status = TCTINI(outable,F_TRANS,F_IO_MODE,nsel+2,nent,&otid);
  status = TCCINI(otid,D_C_FORMAT,80L,"A16"," ","FILENAME",&colf);
  status = TCCINI(otid,D_R8_FORMAT,1L,"D24.17"," ","MJD",&ocolmjd);
  status = TCCINI(otid,D_R8_FORMAT,1L,"T20.6"," ","DATE",&ocoldate);
  if (flag[2] == 'F' || flag[2] == 'F') {
     TCCINI(otid,D_R4_FORMAT,1,"E15.6"," ","MEAN",&ocolmean);
     TCCINI(otid,D_R4_FORMAT,1,"E15.6"," ","SIGMA",&ocolsigma);
     TCCINI(otid,D_R4_FORMAT,1,"E15.6"," ","MPRIME",&ocolmprime);
     TCCINI(otid,D_R4_FORMAT,1,"E15.6"," ","SIGPRIME",&ocolsigprime);
   }
  newtab = 1;
  notrue = 0;
}
else {
  status = TCTOPN(outable,F_IO_MODE,&otid);
  status = TCIGET(otid,&dummy,&notrue,&dummy,&dummy,&dummy);
  status = TCLSER(otid,"FILENAME",&colf);
  status = TCLSER(otid,"MJD",&ocolmjd);
  status = TCLSER(otid,"DATE",&ocoldate);
   if (flag[2] == 'F' || flag[2] == 'F') {
    status = TCLSER(otid,"MEAN",&ocolmean);
    status = TCLSER(otid,"SIGMA",&ocolsigma);
    status = TCLSER(otid,"MPRIME",&ocolmprime);
    status = TCLSER(otid,"SIGPRIME",&ocolsigprime);
   }
  newtab = 0;
  }
status = TCCSER(tid,":descr_iname",&kcol);
if (kcol == -1) {
   SCTPUT("Column descr_iname not found");
   SCSEPI();
   }
status = TCCSER(tid,":ipos",&pcol);
if (pcol == -1) {
   SCTPUT("Column ipos not found");
   SCSEPI();
   }
status = TCCSER(tid,":descr_oname",&kncol);
if (kncol == -1) {
   SCTPUT("Column descr_oname not found");
   SCSEPI();
   }
status = TCCSER(tid,":otype",&tcol);
if (tcol == -1) {
   SCTPUT("Column otype not found");
   SCSEPI();
   }
status = TCCSER(tid,":OFORM",&fcol);
keyname = osmmget(NM*nrow);
oscfill(keyname,'\0',NM*nrow);
otype = osmmget(NT*nrow);
if (fcol != -1) {
       TCBGET(tid,fcol,&dummy,&dummy1,&flen);
       oform = osmmget(nrow* (flen+1));
       }
line = osmmget(129);
/*buffer = osmmget(2880);*/
nl = TBL_LABLEN+1;
label = osmmget(nrow*nl);
mylabel = osmmget(nl);
ipos = (int *)osmmget(nrow*sizeof(int));
valc = osmmget(SLEN);
nsel = 0;
for (i=0; i<nrow; i++) {
    TCSGET(tid,i+1,&sel);
    if (!sel) continue;
    TCERDC(tid,i+1,kcol,keyname+nsel*NM,&null);
    loc = strloc(keyname+nsel*NM,' ');
    if (keyname[nsel*NM+loc]) keyname[nsel*NM+loc] = '\0';
    if (null) continue;
    TCERDC(tid,i+1,tcol,otype+nsel*NT,&null);
    if (null) {
         noelem[nsel] = 1;
         *(otype+nsel*NT) = '\0';
         }
    else {
	 temp = otype+nsel*NT + strskip(otype+nsel*NT,' ');
	 noelem[nsel] = 1;
         if ((temp[0] == 'C') || (temp[0] == 'c')) 
	     if (temp[1] == '*') noelem[nsel] = atoi(temp+2); 
         }
    TCERDI(tid,i+1,pcol,ipos+nsel,&null);
    if (null) *(ipos+nsel) = 1;
    TCERDC(tid,i+1,kncol,label+nsel*nl,&null);
    if (null) *(label+nsel*nl) = '\0';
    if (fcol != -1) TCERDC(tid,i+1,fcol,oform+nsel*flen,&null);
    if (*(otype+nsel*NT)) {
       switch (temp[0]) {
	  case 'C': case 'c': 
		  ontype = D_C_FORMAT; 
                  if (fcol != -1 && !null) strcpy(form,oform+nsel*flen);
                  else sprintf(form,"A%d",noelem[nsel]);
		  break;
	  case 'I': case 'i': 
		  ontype = D_I4_FORMAT; 
                  if (fcol != -1  && !null) strcpy(form,oform+nsel*flen);
		  else strcpy(form,"I8");
		  break;
	  case 'R': case 'r': 
		  ontype = D_R4_FORMAT; 
                  if (fcol != -1 && !null) strcpy(form,oform+nsel*flen);
		  else strcpy(form,"E12.6");
		  break;
	  case 'D': case 'd': 
		  ontype = D_R8_FORMAT; 
                  if (fcol != -1 && !null) strcpy(form,oform+nsel*flen);
		  else strcpy(form,"D24.17");
		  break;
          }
    }
    if (!*(label+nsel*nl)) strncpy(label+nsel*nl,keyname+nsel*NM,nl);
    if (newtab == 1) {
      if (!*(label+nsel*nl)); 
      else
        TCCINI(otid,ontype,noelem[nsel],form," ",label+nsel*nl,&ocol[nsel]);
      }    
     else {
      TCLSER(otid,label+i*nl,&ocol[nsel]);
      if (ocol[nsel] == -1) {
          SCTPUT ("Input Column not found");
          SCSEPI();
         }
       }
nsel++;
}
filename[0] = '\0';
if (flag[0] == 'F' || flag[0] == 'f' || flag[0] == 'H' || flag[0] == 'h') {
  htype = NOFITS; ktype =1; knewtype=1;
  mfd = -1; nll = 0;
  fmt = 'Y'; hist = 'Y';
  one = 1;
  zero = 0;
  devt = 'S';
  while ((nfn = getnext(pfix)) != NULL) {
   if (flag[0] == 'F' || flag[0] == 'f') {
     if ((fid = dopen(nfn,READ,devt,0)) == -1)  {
        printf("Error opening FITS file %s \n",nfn);
        TCTCLO(otid);
        TCTCLO(tid);
        return(-1);
        }
   }
   else {
        if ((fd = osaopen(nfn,F_I_MODE)) == -1) {
          printf("Error opening FITS file %s \n",nfn);
          TCTCLO(otid);
          TCTCLO(tid);
          return(-1);
         }
        }
   if (flag[0] == 'F' || flag[0] == 'f') drinit();
   bfdef = hdr_init();
   mdbuf = mdb_init();
   nb = 0;
   fin = 0;
   crc = -1;
   if (flag[0] == 'F' || flag[0] == 'f') {
     while (!fin)  {
      nchar = dread(&buffer,2880);
      if (nchar == 0 ) continue;
      for (j=0; j< 36; j++) {
        strncpy(line,buffer+j*80,80);
        crc = ccitt32_updcrc(crc, buffer, nchar);
        if (*line && stuindex(line,"END") ==0  ) { fin = 1; break;}
        nb++;
        if (0<ktype){ 
          nll++;
          if (err = fitsrkw(line, &kw))  continue;
          if (nll<5 && ((htype=fitsthd(nll, &kw))<FBFITS)) {
	       dclose(fid);
	       if (close) oslclose();	
	       TCTCLO(otid);
               TCTCLO(tid);
               return(-2);
           }
          knewtype = fitsckww(mfd, bfdef, htype, &kw, fmt, hist);
      }
   }
  } 
}
else {
  while ((nchar = osaread(fd,line,128)) >= 0) {
      if (nchar == 0 ) continue;
      if (0<ktype){
          nl++;
          if (err = fitsrkw(line, &kw)) {
               continue;
          }
          if (nl<5 && ((htype=fitsthd(nll, &kw))<FBFITS)) {
               SCTPUT("Error: not valid FITS format");
	       osaclose(fd);
	       TCTCLO(tid);
	       if (close) oslclose();	
               return(-2);
           }
          ktype = fitsckww(mfd, bfdef, htype, &kw, fmt, hist);
      }
   }
}
   notrue++;
/*   decomp(nfn,dinewname,finame);*/
   TCEWRC(otid,notrue,1L,nfn);
/* check for Midas standard keywords */

   for (i=0; i<nsel; i++) {
      if (stucomp("NAXIS",keyname + i * NM) == 0) {
                if (ocol[i] == -1) {
                    ontype = D_I4_FORMAT;
                    noelem[i] = 1;
	            strcpy(form,"I8");
                    strcpy(mylabel,label+i*NLAB);
                    if (*(ipos+i) != 1){
                      sprintf(cpos,"_%d",*(ipos+i));
                      strcat(mylabel,cpos);
                     }
                    TCCINI(otid,ontype,noelem[i],form," ",
                          mylabel,&ocol[i]);
                    }
                TCEWRI(otid,notrue,ocol[i],&bfdef->naxis);
                }
      if (stucomp("NPIX",keyname + i * NM) == 0) { 
                if (ocol[i] == -1) {
                    ontype = D_I4_FORMAT;
                    noelem[i] = 1;
	            strcpy(form,"I8");
                    strcpy(mylabel,label+i*NLAB);
                    if (*(ipos+i) != 1){
                      sprintf(cpos,"_%d",*(ipos+i));
                      strcat(mylabel,cpos);
                     }
                    TCCINI(otid,ontype,noelem[i],form," ",
                          mylabel,&ocol[i]);
                    }
                TCEWRI(otid,notrue,ocol[i],&bfdef->data[ipos[i]-1].naxis);
                }
      if (stucomp("START",keyname + i * NM) == 0) { 
                if (ocol[i] == -1) {
                      ontype = D_R8_FORMAT;
                      noelem[i] = 1;
                      strcpy(form,"E24.17");
                      strcpy(mylabel,label+i*NLAB);
                      if (*(ipos+i) != 1){
                        sprintf(cpos,"_%d",*(ipos+i));
                        strcat(mylabel,cpos);
                       }
                      TCCINI(otid,ontype,noelem[i],form," ",
                            mylabel,&ocol[i]);
                }
                ad = &bfdef->data[ipos[i]];
                dval =  ad->crval - (ad->crpix-1.0) * ad->cdelt;
                TCEWRD(otid,notrue,ocol[i],&dval);
                }
      if (stucomp("IDENT",keyname + i * NM) == 0){
                if (ocol[i] == -1) {
                    ontype = D_C_FORMAT;
                    noelem[i] = 72;
                    sprintf(form,"A%d",noelem[i]);
                    TCCINI(otid,ontype,noelem[i],form," ",
                           label+i*NLAB,&ocol[i]);
                    }
                TCEWRC(otid,notrue,ocol[i],bfdef->ident);
                }
   }
   
  mjd = ra = dec = time = 0;

  MxMdb = mdb_size();			/* get no. of used entries in mdbuf */

  for (i=0; i<MxMdb; i++)
      {
      if (mdbuf[i].idx == 0) mdbuf[i].idx = 1;
      if (stucomp(mdbuf[i].desc,"O_TIME") == 0 & mdbuf[i].idx == 1)
	 date = *mdbuf[i].val.d;
      else if (stucomp(mdbuf[i].desc,"O_TIME") == 0 & mdbuf[i].idx == 4)
	 mjd = *mdbuf[i].val.d;
      else if (stucomp(mdbuf[i].desc,"O_TIME") == 0 & mdbuf[i].idx == 5)
	 time = *mdbuf[i].val.d;
      else if (stucomp(mdbuf[i].desc,"O_POS") == 0 && mdbuf[i].idx == 1)
         ra  = *mdbuf[i].val.d;
      else if (stucomp(mdbuf[i].desc,"O_POS") == 0 && mdbuf[i].idx == 2)
         dec  = *mdbuf[i].val.d;
      else if (stucomp(mdbuf[i].desc,"_EGE_LST") == 0 )
         lst  = *mdbuf[i].val.d;
      }
   TCEWRD(otid,notrue,ocolmjd,&mjd);
   mydate = mjd+2400000.5;
   TCEWRD(otid,notrue,ocoldate,&mydate);
   for (i=0; i<SLEN; i++) valc[i] = '\0';

   for (i=0; i<MxMdb; i++) {
      j = 0;
      while (j < nsel && *(keyname+j * NM)) {
	  poss =  strloc(keyname +j *NM,'*');
	  if ((keyname +j *NM)[poss]) {
	      if (!amatch(mdbuf[i].desc,keyname +j *NM) &&
	             (mdbuf[i].idx == ipos[j])) {
			 if (*valc) strcat(valc,"/");
			 strcat(valc,mdbuf[i].val.pc);
			 valc[strbskip(valc,' ')+1] = '\0';
			 TCEWRC(otid,notrue,ocol[j],valc);
		 }
	      }
          else {
              if ((stucomp(keyname +j *NM, mdbuf[i].desc) == 0) && 
                         (mdbuf[i].idx == ipos[j]))  {
                 switch (mdbuf[i].type) {
                    case 'S':
                        if (ocol[j] == -1) {
                           ontype = D_C_FORMAT;
                           noelem[j] = strlen(mdbuf[i].val.pc);
                           sprintf(form,"A%d",noelem[j]);
                           strcpy(mylabel,label+j*NLAB);
                           TCCINI(otid,ontype,noelem[j],form," ",
                              mylabel,&ocol[j]);
                        }
                        TCEWRC(otid,notrue,ocol[j],mdbuf[i].val.pc);
                        break;
                    case 'I':
                        if (ocol[j] == -1) {
                           ontype = D_I4_FORMAT;
                           noelem[j] = 1;
		           strcpy(form,"I8");
                           strcpy(mylabel,label+j*NLAB);
                           if (*(ipos+j) != 1){
                           sprintf(cpos,"_%d",*(ipos+j));
                           strcat(mylabel,cpos);
                            }
                           TCCINI(otid,ontype,noelem[j],form," ",
                              mylabel,&ocol[j]);
                         }       
                        TCEWRI(otid,notrue,ocol[j],&mdbuf[i].val.i);
                        break;
                    case 'R':
                        if (ocol[j] == -1) {
                           ontype = D_R4_FORMAT;
                           noelem[j] = 1;
                           strcpy(form,"E12.6");
                           strcpy(mylabel,label+j*NLAB);
                           if (*(ipos+j) != 1){
                           sprintf(cpos,"_%d",*(ipos+j));
                           strcat(mylabel,cpos);
                            }
                           TCCINI(otid,ontype,noelem[j],form," ",
                              mylabel,&ocol[j]);
                         }
                    case 'D':
                        if (ocol[j] == -1) {
                           ontype = D_R8_FORMAT;
                           noelem[j] = 1;
                           strcpy(form,"E24.17");
                           strcpy(mylabel,label+j*NLAB);
                           if (*(ipos+j) != 1){
                           sprintf(cpos,"_%d",*(ipos+j));
                           strcat(mylabel,cpos);
                            }
                           TCCINI(otid,ontype,noelem[j],form," ",
                              mylabel,&ocol[j]);
                         }
                        TCEWRD(otid,notrue,ocol[j],mdbuf[i].val.d);
                        break;
                    }
                 break;
                 }
	     }
      j++;
      }
  
   } 
if ( flag[2] == 'f' || flag[2] == 'F' ) 
  {
  size = bfdef->data[0].naxis * bfdef->data[1].naxis * bfdef->bitpix / 8;
  size = ABSOLUTE(size);
  image = (float *) osmmget(bfdef->data[0].naxis * bfdef->data[1].naxis * 4);
  i=0;
  min = MAXFLOAT;
  max = -1E+38;
  n=0;
  incr = 0;
  while (0<size) {
       if ((n=dread(&buffer,FITSLR)) != FITSLR) {
                SCTPUT("Error: unexpected EOF");
           }
       if (size<n) n = size;
       transfer(bfdef,buffer,image,n,&incr);
       i++;
       size -= n;
       }
  size = bfdef->data[0].naxis * bfdef->data[1].naxis ;
  npix[0] = bfdef->data[0].naxis;
  npix[1] = bfdef->data[1].naxis;
  dfmt = bfdef->bitpix;
  fac = bfdef->bscale;
  zero = bfdef->bzero;
/*for (i=0; i<size; i++) {
    if (*(image+i) < min) min = *(image+i);
    if (*(image+i) > max) max = *(image+i);
    }
printf("min:%f, max:%f\n",min,max);
crc = ccitt32_updcrc(crc, image, size);
printf("crc:%d\n", crc); */
  cstat(image,npix,sparam);
  if (flag[2] == 'S' || flag[2] == 's') {
     TCEWRR(otid,notrue,ocolmean,&sparam[0]);
     TCEWRR(otid,notrue,ocolsigma,&sparam[1]);
     }
  else {
     TCEWRR(otid,notrue,ocolmean,&sparam[0]);
     TCEWRR(otid,notrue,ocolsigma,&sparam[1]);
     TCEWRR(otid,notrue,ocolmprime,&sparam[4]);
     TCEWRR(otid,notrue,ocolsigprime,&sparam[5]);
     }
  osmmfree((char *)image);
}
 if (flag[0] == 'F' || flag[0] == 'f') dclose(fid);
 else osaclose(fd);
}
}
else {
  while ((nfn = getnext(pfix)) != NULL) {
     SCFOPN(nfn,D_R4_FORMAT,F_I_MODE,F_IMA_TYPE,&imno);
     notrue++;
     TCEWRC(otid,notrue,colf,nfn);
     for (i=0; i<nsel; i++) {
     SCDRDD(imno,"O_TIME",4,1L,&dummy,&mjd,&unit,&null);
     TCEWRD(otid,notrue,ocolmjd,&mjd);
     mydate = mjd+2400000.5;
     TCEWRD(otid,notrue,ocoldate,&mydate);
     SCDFND(imno,keyname+i*NM,&type,&newnoelem,&dummy);
     switch(type) {
      case 'C':
        if (ocol[i] == -1) {
           noelem[i] = newnoelem;
           sprintf(form,"A%d",noelem[i]);
           TCCINI(otid,ontype,noelem[i],form," ",
                 label+i*NLAB,&ocol[i]);
        }
        keycval[i] = osmmget(noelem[i]+1);
        SCDRDC(imno,keyname+i*NM,1L,1L,noelem[i],&dummy,
                     keycval[i],&unit,&null);
        *(keycval[i]+dummy) = '\0';
        TCEWRC(otid,notrue,ocol[i],keycval[i]);
        break;
      case 'I':
        if (ocol[i] == -1) {
           ontype = D_I4_FORMAT;
           noelem[i] = 1;
           strcpy(form,"I8");
           TCCINI(otid,ontype,noelem[i],form," ",
             label+i*NLAB,&ocol[i]);
           }
        keyival[i] = (int *)osmmget(sizeof(int));
        SCDRDI(imno,keyname+i*NM,*(ipos+i),1L,&dummy,keyival[i],&unit,&null);
        TCEWRI(otid,notrue,ocol[i],keyival[i]);
        break;
      case 'R':
          keyrval[i] = (float *)osmmget(sizeof(float));
          SCDRDR(imno,keyname+i*NM,*(ipos+i),1L,&dummy,keyrval[i],&unit,&null);
          TCEWRR(otid,notrue,ocol[i],keyrval[i]);
          break;
      case 'D':
          keydval[i] = (double *)osmmget(sizeof(double));
          SCDRDD(imno,keyname+i*NM,*(ipos+i),1L,&dummy,keydval[i],&unit,&null);
          TCEWRD(otid,notrue,ocol[i],keydval[i]);
          break;
      }
    }
  SCFCLO(imno);
  }
}
/*status = tbl_hist(otid); */
upda = 0;
if (close) oslclose();
osmmfree(keyname);
osmmfree(otype);
if (fcol != -1) osmmfree(oform);
osmmfree(label);
osmmfree(mylabel);
osmmfree(line);
osmmfree(ipos);
osmmfree(valc);
for (i=0; i<256; i++) {
    if (keycval[i]) osmmfree(keycval[i]);
    if (keyival[i]) osmmfree(keyival[i]);
    if (keydval[i]) osmmfree(keydval[i]);
    if (keyrval[i]) osmmfree(keyrval[i]);
   }
status = SCDWRI(otid,"HISTORY_UPDA",&upda,1,1,&kuni);
status = SCDWRC(otid,"table_descr",1,intable,1,60,&kuni);
status = TCTCLO(otid);
status = TCTCLO(tid);
return(0);
}


double otimetomjd(date, hrs)
/*+++
.PURPOSE Transform MIDAS O_TIME(1) and O_TIME(5) into Modified Julian Day
.RETURNS MJD equivalence
.REMARKS	
---*/
     double date;	/* IN: fractional date (eg 1991.75681)  */
     double hrs;	/* IN: UT in fractional hrs		*/
{
	int jm, j, y, days;
	double MJD,dayd;

  y = (int)date;
  if (y <= -4712)
  {	j = 1 + (y + 4712)/400;   	/* Number of 400-yr cycles */
  	jm = -j * 146097L;
	j  = y + 400*j;
  }
  else	jm = 0, j = y;


  if( (y % 4 == 0 && y % 100 != 0) || y % 400 == 0 ) 
    dayd = (date - y)*366.0;
  else  
    dayd = (date - y)*365.0;
   dayd = NINT(dayd);
   days = (int) dayd;

  jm += (1461L* ( j + 4712L))/4 + days 
	- (3* ((j + 4900L)/100))/4 - 2399962;

  MJD = jm + (hrs/24.0);

  return(MJD);
}

char *getnext(pfix)
char pfix[5];
{
static char *fname;
static int nel = 1;
static char *oname ;
struct dirent *dirp;
struct filestatus mystatus;
int res,itisdir,null;
if (!oname) oname = osmmget(128);
if (listtype == 0) {
   res = getnlist(&no);
   if (res) {
/*   if (getnlist(&no)) { */
      outname(pfix,no);
      if (!fname) fname = osmmget(80);
      fname = newfn('I',cext);
      return(fname);
      }
   else return(NULL);
   }
else if (listtype == 2) {
   if (!fname) fname = osmmget(lname+1);
   if (nel > nenttemp) return(NULL);
   else {
      TCERDC(tidtemp,nel,colfile,fname,&null);
      nel++;
      return(fname);
      }
   } 
else
   { 
#ifndef vms
   itisdir = 0;
   while (!itisdir) {
     if ((dirp = oslread()) == NULL) return(NULL);
     else {
      if (diname[0] =='.' && diname[1] == '/') strcpy(oname,dirp->d_name);
      else
        {
        strcpy(oname,diname);
        strcat(oname,dirp->d_name);
        }
      osfinfo(oname,&mystatus); 
      if (S_ISDIR(mystatus.protection)) continue;  
      else return(oname);
     }
   }
#else
   return(NULL);
#endif
   }  
} 
int openlist(plist)
char     *plist;                       /* pointer to list specification */
{
  char   c;
  int    l,ldig,n,nelem;

  nelem = 0;
  lno = -1;
  for (n=0; n<MXLIST; n++) list[n].first = -1;  /* reset internal list  */

  n = 0; l = 0; ldig = 0;
  while ((c = *plist++) && c!=' ') {            /* go through list      */
    if (c == ',' && ldig) {
       if (list[l].first<0) list[l].first = n;
       list[l].last = (n<list[l].first) ? list[l].first : n;
       nelem += list[l].last-list[l].first+1;
       l++;
       if (MXLIST<=l) { lno = 0; return 1; }
    }
    else if (c == '-' && ldig) list[l].first = n;
    else if (c == '.' && ldig) {
            if (*plist++ != '.') return -1;
            list[l].first = n;
    }
    else if (c<'0' || '9'<c) return -1;

    if (ldig = ('0' <= c && c <= '9')) n = 10 * n + (c - '0');
    else n = 0;
  }
  if (ldig) {
     if (list[l].first<0) list[l].first = n;
     list[l].last = (n<list[l].first) ? list[l].first : n;
     nelem += list[l].last-list[l].first+1;
   }
   else return -1;

  lno = 0;
  return nelem;
}

int getnlist(pno)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE       get next no. in list previously defined. The no. is
               return through the parameter.
.RETURN        status, 1:valid no., 0:no number return
------------------------------------------------------------------------*/
int        *pno;               /* pointer to var. with next no. in list */
{
  if (lno<0) return 0;                   /* return if list empty        */
  if (list[lno].first<0) {
     lno = -1; return 0;
  }
  *pno = list[lno].first++;                  /* get next no. in list    */
  if (list[lno].last<list[lno].first) {      /* check if range finished */
     list[lno++].first = -1;
     if (MXLIST<=lno) lno = -1;
  } 

  return 1;
}
int decomp(flist,dirname,filename)
char *flist;
char *dirname,*filename;
{
register char *p;
char *dummy;
dummy = osmmget(128);
oscfill(dummy,'\0',128);
p = flist+strlen(flist);
while (p != flist && *--p == '/');

while (p != flist) 
      if (*--p == '/') {
            strcpy(filename,p+1);
            *p ='\0';
            strcpy(dummy,flist);
            break;
            } 
if (*dummy == '\0') {
   strcpy(dummy,".");
   strcpy(filename,p);
}
if (*dummy == '$') {
  osfphname(dummy+1,dirname);
  }
else strcpy(dirname,dummy);
strcat(dirname,"/");
osmmfree(dummy);
}