/* @(#)tbcomsel.c	17.1.1.1 (ESO-IPG) 01/25/02 17:47:10 */
/*===========================================================================
  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        tbcompute.c
.LANGUAGE    C
.AUTHOR      IPG-ESO Garching
.CATEGORY    table utilities
.COMMENTS    This module implements the following Midas commands:
\begin{TeX}
\begin{enumerate}
\item {\tt SELECT/TABLE} table column expresion
\item {\tt COMPUTE/TABLE} table column = expression
\end{enumerate}
\end{TeX}
.VERSION 1.0    7-may-1992   Definition     M. Peron

 010329		last modif

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

#include <stdlib.h>
#include <atype.h>
#include <tbldef.h>
#include <tblsys.h>
#include <tblerr.h>
#include <midas_def.h>
#include <macrogen.h>
#include <computer.h>
#include <proto_tbl.h>
#define PARLEN 256 
#define STRINGLEN 256 
#define CRITLEN 8000			/* from 512 before */
#define TBL_tmp "MIDDUMcom.tbl"
#define BUFM 30				/* from 15  */
#define BUFK 2000
#define DEGREE 0.01745329251994329576923
#define INT(x)    (x <  0 ) ? (int) (x-0.5) : (int) (x+0.5)
#define issign(c)               ((c == '+') || (c == '-'))
char *functions[] = {
                    "SQRT","LN","LOG10","EXP","SIN","COS",
                    "TAN","ASIN","ACOS","ATAN","SINH","COSH",
                    "TANH","ABS","INT","FRAC","MIN","MAX","MOD",
		    "TOLOWER","TOUPPER","CONCAT","COLLAPSE","TOCHAR"
                    }; 
char *delim = "+-*/(),";
char *opera[] = {
		"LE","LT","GE","GT","EQ","NE",
		 "AND","OR","NOT"
		 };  
int get_token(),readata(),writedata(),arithm1(),arithm2();
int calfun(),constfun(),stucmp(), logchar();
int level1(),level2(),level3(),level4(),level5(),level6();
char *line,*token;
int token_type,action,refrow,*rownumber,number_of_rows,associate;
int first,otype,oitem,exist,nochar,colitem;
double tdtrue,tdfalse;
int tmno[BUFM],tmnoc[BUFM],what[BUFM];
char oform[TBL_FORLEN+1];
char outcol[1+TBL_LABLEN];
double fmod();
#ifdef NO_FMOD
double fmod(x,y)
double x,y;
{
double res;
res = x - y* ((int) (x/y));
return res;
}
#endif

tbl_comp()
/*++++++++++++++++++
.PURPOSE compute table column
.RETURNS Status
------------------*/
{
int i,status;
int dummy, nline, end;
int ibuf[7],tid, width, nconst[BUFM];
int ocol,nrow,nrall,ncol,inull,nitem,dunit,ipos;
char intable[82],type;
float tblsel;
double *data[BUFM],consta[BUFM];
char *string[BUFM], *cdata[BUFM],history[80];
char *linesave, *mline;


/* get machine characteristics*/
TCMCON(&tblsel,&tdtrue,&tdfalse);
action = 0;
associate = 0;

token = osmmget(PARLEN);
mline = osmmget(STRINGLEN+2);
line = mline;
linesave = osmmget(STRINGLEN+2);
oscfill(line,STRINGLEN+2,'\0');
for (i=0 ; i<BUFM; i++)
   {
   data[i] = (double *)0;
   cdata[i] = (char *)0;
   string[i] = (char *)0;
   } 

(void) SCKGETC("IN_A",1,80,&dummy,intable);
(void) SCKGETC("STRING",1,256,&dummy,line); 
nline = (int) strlen(line);
i = strloc(line,'=');
strncpy(outcol,line,i);
if (outcol[0] == '\0') {
   SCTPUT("Output Column missing");
   return(-1);
   }
outcol[i++] = '\0';
line +=i;
strcpy(linesave, line);
status = TCTOPN(intable,F_IO_MODE,&tid);
        if (status != ERR_NORMAL) {
                SCTPUT("Error opening input  table");
                osmmfree(mline);
                osmmfree(linesave);
                osmmfree(token);
                return(-1); 
        }
ibuf[0] = tid;
status = TCCSER(ibuf[0],outcol,&ocol);
if (ocol <= 0) {
        otype = -1;
        exist = -1;
        nitem = 0;
        }
else status = TCBGET(ibuf[0],ocol,&dummy,&nitem,&dummy);
status = TCIGET(ibuf[0],&ncol,&nrow,&dummy,&dummy,&nrall);
if (nrow <= 0) {
         SCDFND(tid,"HISTORY",&type,&dummy,&dummy);
         if (type != ' ') {
            ipos = 0;
            SCDRDC(tid,"HISTORY",1,11,80,&dummy,history,&dunit,&inull);
            ipos = strskip(history,' ');
            ipos += strloc(history+ipos,' '); 
            ipos += strskip(history+ipos,' ');
            ipos += strloc(history+ipos,' '); 
            nrow = atoi(&history[ipos+1]);
            }
         }


/* We now have to create an intermediate table */


ibuf[2] = nrow;     /* number of rows */
ibuf[3] = -1;       /* number of used buffers */
ibuf[4] = -1;        /* number of used characters strings */
ibuf[5] = -1;        /* number of used constants */
ibuf[6] = -1;       /* number of character buffers */
colitem = 1;
oitem = end = 0;
while (!end){
   get_token();
   level00(ibuf,data,cdata,consta,nconst,string); 
   if (otype == D_C_FORMAT) 
        {
        nitem = 1;
        }
   else if (!nitem) 
        {
        if (oitem) nitem = oitem;
        else nitem = 1;
        }        
   else if ((nitem != oitem) && oitem) 
        {
        SCTPUT("Input and Output columns have different widths");
        SCSEPI();
        }
   if (exist == -1) 
        {
        if (otype == D_R8_FORMAT) 
	    strcpy(oform,"D24.17");
        else if (otype == D_R4_FORMAT) 
	    strcpy(oform,"E12.6");
        else if (otype == D_C_FORMAT) 
	    {
            if  (ibuf[6] != -1) 
	        (void) sprintf(oform,"A%d", nconst[ibuf[6]]);
            else 
	        (void) sprintf(oform,"A%d", (int) strlen(string[ibuf[4]]));
            }
    	else  
	    (void) strcpy(oform,"I11");
    	if (otype == D_C_FORMAT) 
            {
            if  (ibuf[6] != -1)   
	        width = nconst[ibuf[6]] ;
            else 
	        width = (int) strlen(string[ibuf[4]]);
            }
    	else 
	    width = nitem;
    	status = TCCINI(ibuf[0],otype,width,oform," ",outcol,&ocol);
    	exist = 0;
    	}
   if ((ibuf[4] != -1) || (ibuf[6] != -1))
         writechar(ocol,ibuf,cdata, string, nconst[ibuf[6]]);
   else 
         writedata(ocol,ibuf,data,consta,nconst);
for (i=0; i<=ibuf[4]; i++) osmmfree(string[i]);
ibuf[3] = -1;       /* number of used buffers */
ibuf[4] = -1;        /* number of used characters strings */
ibuf[5] = -1;        /* number of used constants */
ibuf[6] = -1;       /* number of character buffers */
if (colitem == nitem) {
    end = 1;
    line -= nline;
    }
else {
    colitem++;
    line -= nline;
    (void) strcpy(line,linesave);
    nline = (int) strlen(line);
    }
}/* end of while loop */

osmmfree(mline);
osmmfree(linesave);
osmmfree(token);
for (i=0; i<=ibuf[4]; i++) osmmfree(string[i]);
status = TCSINI(ibuf[0]);
if (status == ERR_NORMAL) CGN_DSCUPD(ibuf[0],ibuf[0]," ");
return(status);
}

tbl_select()
/*++++++++++++++++++
.PURPOSE select table rows 
.RETURNS Status
------------------*/
{
 int i,status;
 int dummy;
 int ibuf[7],tid,tidview;
 int ocol,nrow,nrall,ncol,nline;
 int nsel,nconst[BUFM];
 int *isel, msel;
 int dunit,cdummy;
 int unit,null;

 char intable[84];
 char *string[BUFM],seldes[64],viewname[60];
 char text[80], *cdata[BUFM];
 char *mline;

 float tblsel;

 double *data[BUFM],consta[BUFM];

/* get machine characteristics*/
 TCMCON(&tblsel,&tdtrue,&tdfalse);
 refrow = 10;
 associate = 0;
 action = 1;
 mline = osmmget(STRINGLEN+2);
 line = mline;
 token = osmmget(PARLEN);

 for (i=0 ; i<BUFM; i++) 
    {
    data[i] = (double *)0;
    cdata[i] = (char *)0;
    string[i] = (char *)0;
    }
 (void) SCKGETC("IN_A",1,80,&dummy,intable);
 (void) SCKGETC("STRING",1,256,&dummy,line); 
 (void) SCKRDI("MID$MSEL",1,1,&dummy,&msel,&unit,&null); 

 isel = (int*) malloc( (msel+1)*sizeof(int) );
 if (isel != 0x0) 
    (void) SCKRDI("MID$SELIDX",1,msel,&dummy,isel,&unit,&null);
 else
    {
    SCTPUT("WARNING: Not enough memory to create INDEX array!");
    msel = 0;
    }
 
 nline = (int) strlen(line);
 strncpy(seldes,line,64);
 status = TCTOPN(intable,F_IO_MODE,&tid);
 if (status != ERR_NORMAL) 
    {
    SCTPUT("Error opening input  table");
    osmmfree(mline);
    osmmfree(token);
    free(isel);
    return(-1); 
    }

 ibuf[0] = tid;
 status = TCIGET(ibuf[0],&ncol,&nrow,&dummy,&dummy,&nrall);
 if (nrow <= 0) 
    {
    SCTPUT("Selected subtable is empty");
    nsel = 0;
    status = SCKWRI("OUTPUTI",&nsel,1,1,&cdummy);
    dscwrite(ibuf,data,nsel,tid);		/* and fill also descr. */
    osmmfree(mline);
    osmmfree(token);
    free(isel);
    return(0);
    }

 ibuf[2] = nrow;      /* number of rows */
 ibuf[3] = -1;        /* number of used buffers */
 ibuf[4] = -1;        /* number of used character strings */
 ibuf[5] = -1;        /* number of used constants */
 ibuf[6] = -1;        /* number of used character buffers */

 for (i=0; i< BUFM; i++) 
    {
    tmno[i] = -1;
    tmnoc[i] = -1;
    } 

 if (stumatch(line,"all") == 3)                  /* all rows selected */
    {
    status = TCSINI(ibuf[0]);
    				/* outputi(1) has to be set to nsel = nrow */
    status = SCKWRI("OUTPUTI",&nrow,1,1,&cdummy);
    nsel = -1;
    dscwrite(ibuf,data,nsel,tid);		/* and fill also descr. */
    }

 else                           
    {
    get_token();              
    level00(ibuf,data,cdata,consta,nconst,string); 
    writesele(ibuf,data,&nsel,isel,msel);	/* set selection flag + key */
    dscwrite(ibuf,data,nsel,tid);		/* and fill also descr. */

    if (TCTVIS(tid,viewname)) 
       {
       status = SCFOPN(viewname,D_R4_FORMAT,F_O_MODE,F_TBL_TYPE, &tidview);
       status = SCDWRC(tidview,TBL_Dselect,1,seldes,1,64,&dunit); 
       status = SCFCLO(tidview);
       }
    else 
       status = SCDWRC(tid,TBL_Dselect,1,seldes,1,64,&dunit); 

    if (nsel == 0) 
        SCTPUT("Selected subtable is empty");
    else 
       {
       (void) sprintf(text,"No. of selections:     %d",nsel);
       SCTPUT(text);
       if (msel>0) status = SCKWRI("MID$SELIDX",isel,1,msel,&unit);
       }
    status = SCKWRI("OUTPUTI",&nsel,1,1,&cdummy);
    line -= nline;
    }

 osmmfree(mline);
 osmmfree(token);
 free(isel);

 for (i=0; i<BUFM;i++) 
    {
    if (tmno[i] != -1) SCFCLO(tmno[i]);
    if (tmnoc[i] != -1 ) SCFCLO(tmnoc[i]); 
    if (string[i] != (char *) 0) osmmfree(string[i]);
    }

 status = TCTCLO(tid);	

 return(status);			/* end of tbl_select() */
}

/*

*/

/*++++++++++++++++++++++++++++++++++++++++++++++*/
/*                                              */
/*                                              */
/* Modules used in tbl_select() and tbl_comp(): */
/*                                              */
/*                                              */
/*++++++++++++++++++++++++++++++++++++++++++++++*/

int get_token()
/*-----------*/
/* reads selection parameters */
{
char *temp;
char text[80];
int i,j,n,len, len1;
line += strskip(line,' ' );
temp = token;
token_type = 0;
if (!*line) *token = '\0';
else if (*line == '"') {
    token_type = 6;
    *line++;
    i = strloc(line,'\\');
    j = strloc(line,'"');
    if (line[i] && line[i+1] == '"' && (i < j)) 
    {
       while (i--) *temp++ = *line++;
       line++;
       *temp++ = *line++;
    }
    i = strloc(line,'"');
    while (i--) *temp++ = *line++;
    *temp = '\0';
    line++;
    }
else if (find_string(line,delim)) {  
    token_type = 1;
    *temp++ = *line++;
    if (( *token == '*') && (*line == '*')) {
        token[0] = '^';
        line++;
        if (line[0] == '-') {
            SCTPUT (" Missing parenthesis, replace **-xxx by **(-xxx)");
            SCSEPI();
            } 
        }
    *temp = '\0'; 
}
else if (find_string(line,"#:")) {
    token_type = 2;
    while (!sdelim(line) && *line != ' ' ) *temp++ = *line++;        
    *temp = '\0';
}
else if ((len=stsnum(line))>0) {
      n = len;
      token_type = 3; 
      while (n--) *temp++ = *line++;
      *temp = '\0';
    }
else if (*line == '.') {
     *line ++;
     while (!sdelim(line)) *temp++ = *line++;
     *temp = '\0';
     for (i=0; i<9 ;i++)
     if ((n = stucmp(token,opera[i])) == 0 ){
             (void) sprintf(token,"%d",i);
             token_type = 5;
             break;
      }
     if (n != 0) {
           if (token[strloc(token,' ')]) token[strloc(token,' ')] = '\0';
           (void) sprintf(text,"Unknown operator : %s",token);
           SCTPUT(text);
           SCSEPI();
           }
     *line++;
     }
else {
    while (!sdelim(line)) *temp++ = *line++;
    *temp = '\0';
    if (stuindex(token,"null") == 0) {
      token_type = 3;
      *token = 'N';
    }
    else if ((stuindex(token,"seq") == 0) || (stuindex(token,"sel") == 0)) {
        token_type = 2;
        *token = toupper(token[2]);
        }
    else if ((n = stucmp(token,"REFVAL")) == 0) {
        token_type = 7;
        line++;
        temp = token;
        while (!sdelim(line) && *line != ' ' ) *temp++ = *line++;
        *temp = '\0';
        line++;
        }
    else {
        for (i=0; i<24 ;i++) 
        if ((n = stucmp(token,functions[i])) == 0 ){
                token_type = 4;
                (void) sprintf(token,"%d",i);
                break;
         }
         if (n != 0) {
         if (token[strloc(token,' ')]) token[strloc(token,' ')] = '\0';
         (void) sprintf(text,"Unknown function : %s",token);
         SCTPUT(text);
         SCSEPI();
         }
     } 
    }
}


int level00(ibuf,data,cdata,consta,nconst,string)
int ibuf[7],nconst[];
double *data[],consta[];
char *string[], *cdata[];

{
char newstring[1];
register int ope,ct;
register int sens,sensc,s1,s2;


level0(ibuf,data,cdata,consta,nconst,string);
/*if (token_type !=0 && token_type !=5) {
        SCTPUT("Missing Operand"); 
        SCSEPI();
        }*/
while ((token_type == 5) && ((ope = atoi(token)) >= 6)) {
    sens = ibuf[3];
    sensc = first;
    get_token();
    ct = token_type;
    s2 = ibuf[4];
    s1 = ibuf[6];
    level0(ibuf,data,cdata,consta,nconst,string);
    sens = sens-ibuf[3];
    s1 = s1-ibuf[6];
    s2 = s2-ibuf[4];
    if (sens < 0 && sensc ==0 ) {
	logic2(ope,data[ibuf[3]-1],data[ibuf[3]],ibuf[2]);
        ibuf[3] = ibuf[3]-1;
        }
    else {
	logic1(ope,data[ibuf[3]],ibuf[2],consta[ibuf[5]],sens);
	ibuf[5] = ibuf[5]-1;
	first=0;
	}
    }
}

int level0(ibuf,data,cdata,consta,nconst,string)
int ibuf[7],nconst[];
double *data[],consta[];
char *string[], *cdata[];

{
register int ope,ct;
register int sens,sensc,s1,s2;
char newstring[1];


level1(ibuf,data,cdata,consta,nconst,string);
while ((token_type == 5) && ((ope = atoi(token)) < 6)) { 
    sens = ibuf[3];
    sensc = first;
    ope = atoi(token);
    get_token();
    ct = token_type;
    s1 = ibuf[6];
    s2 = ibuf[4];
    level1(ibuf,data,cdata,consta,nconst,string);
    sens = sens-ibuf[3];
    s1 = s1-ibuf[6];
    s2 = s2-ibuf[4];
    if (ct == 6 || (ct == 7 && s2 < 0)) 
	logchar(ope,data,cdata,string[ibuf[4]],nconst,ibuf,0);
    else if (s1 != 0 && s2 == 0 ) { 
	newstring[0] = '\0';
	logchar(ope,data,cdata,newstring,nconst,ibuf,1);
	}
    else if (sens < 0 && sensc ==0 ) {
	logic2(ope,data[ibuf[3]-1],data[ibuf[3]],ibuf[2]);
        ibuf[3] = ibuf[3]-1;
        }
    else {
	logic1(ope,data[ibuf[3]],ibuf[2],consta[ibuf[5]],sens);
	ibuf[5] = ibuf[5]-1;
	first=0;
	}
    }
}

int level1(ibuf,data,cdata,consta,nconst,string)
int ibuf[7],nconst[];
double *data[],consta[];
char *string[], *cdata[];

{
register char op;
register int sens,sensc;
char text[80];

level2(ibuf,data,cdata,consta,nconst,string);
/* holds the addition and subtraction */

while((op = *token) == '+' || op == '-'){
  sens = ibuf[3];
  sensc = first;
  get_token();
  if (token_type == 0 || (token_type == 1  && *token != '+' && *token!= '-') &&
          *token != '(') {
        SCTPUT("Missing Operand"); 
        SCSEPI();
        }
  level2(ibuf,data,cdata,consta,nconst,string);
  sens = sens-ibuf[3];
  if ( sens == 0 && sensc == 1 ) {
        arithm0(op,&consta[ibuf[5]-1],&consta[ibuf[5]]);
        ibuf[5] = ibuf[5]-1;
       }
  else if (sens < 0 && sensc ==0 ) {
        arithm2(op,data[ibuf[3]-1],data[ibuf[3]],ibuf[2]);
        ibuf[3] = ibuf[3]-1;
       }
  else {
        arithm1(op,data[ibuf[3]],ibuf[2],consta[ibuf[5]],sens);
	ibuf[5] = ibuf[5]-1;
	first = 0;
       }
}
}

int level2(ibuf,data,cdata,consta,nconst,string)
int ibuf[7],nconst[];
double *data[],consta[];
char *string[], *cdata[];

{
register char op;
register int sens,sensc; 
char text[80];


level3(ibuf,data,cdata,consta,nconst,string);

/* holds the multiplication and division */

while((op = *token) == '*' || op == '/'){
  get_token();
  if (token_type == 0 || (token_type == 1  && *token != '+' && *token!= '-') &&
          *token != '(') {
        SCTPUT("Missing Operand"); 
        SCSEPI();
        }
  sens = ibuf[3];
  sensc = first;
  level3(ibuf,data,cdata,consta,nconst,string);
  sens = sens-ibuf[3];
  if ( sens == 0 && sensc == 1 ) {
        arithm0(op,&consta[ibuf[5]-1],&consta[ibuf[5]]);
        ibuf[5] = ibuf[5]-1;
       }
  else if (sens < 0 && sensc ==0 ) {
        arithm2(op,data[ibuf[3]-1],data[ibuf[3]],ibuf[2]);
        ibuf[3] = ibuf[3]-1;
       }
  else {
        arithm1(op,data[ibuf[3]],ibuf[2],consta[ibuf[5]],sens);
	ibuf[5] = ibuf[5]-1;
	first = 0;
       }
  }
}

int level4(ibuf,data,cdata,consta,nconst,string)
int ibuf[7],nconst[];
double *data[],consta[];
char *string[], *cdata[];

{

/* holds the exponent*/

register char op;
register int sens,sensc;
char text[80];
level5(ibuf,data,cdata,consta,nconst,string);
if (*token== '^') {
    get_token();
  if (token_type == 0 || (token_type == 1  && *token != '+' && *token!= '-') &&
          *token != '(') {
        SCTPUT("Missing Operand"); 
        SCSEPI();
        }
    sens = ibuf[3];
    sensc = first;
    level4(ibuf,data,cdata,consta,nconst,string);
    sens = sens-ibuf[3];
    if ( sens == 0 && sensc == 1 ) {
        arithm0('^',&consta[ibuf[5]-1],&consta[ibuf[5]]);
        ibuf[5] = ibuf[5]-1;
       }
    else if (sens < 0 && sensc ==0 ) {
        arithm2('^',data[ibuf[3]-1],data[ibuf[3]],ibuf[2]);
        ibuf[3] = ibuf[3]-1;
       }
    else {
        arithm1('^',data[ibuf[3]],ibuf[2],consta[ibuf[5]],sens);
	ibuf[5] = ibuf[5]-1;
	first = 0;
       }
    } 
}

int level3(ibuf,data,cdata,consta,nconst,string)
int ibuf[7],nconst[];
double *data[],consta[];
char *string[], *cdata[];		/* handles the unary operation */

{
register char op;
int sens;


op = 0;
if ( (*token == '-' || *token == '+') && token_type != 6){
     sens = ibuf[3];
     op = *token;
     get_token();
     } 
     level4(ibuf,data,cdata,consta,nconst,string);
if (op) 
if (sens == ibuf[3] && op == '-' ) consta[ibuf[5]] = -consta[ibuf[5]];
else unary(op,data[ibuf[3]],ibuf[2]);
}

int level5(ibuf,data,cdata,consta,nconst,string)
int ibuf[7],nconst[];
double *data[],consta[];
char *string[], *cdata[];	/* handles the functions */

{
register int fu;
int sens;


if (token_type == 4){
  fu = atoi(token);
  get_token();
  if (*token != '(') {
        SCTPUT("Missing parenthesis"); 
        SCSEPI();
        }
  sens = ibuf[3];
  level6(ibuf,data,cdata,consta,nconst,string);
  if (fu == 23) convchar(cdata,data,nconst,ibuf);
  else if (fu > 18) {
	       charfun(fu,cdata,nconst,string,ibuf);
	       }
  else if (sens == ibuf[3]) {
	          constfun(fu,data[ibuf[3]],&consta[ibuf[5]],ibuf[2]);
		  }
  else if (fu > 15) {
		 if (ibuf[3]-sens == 2) {
	         calfun(fu,data[ibuf[3]-1],data[ibuf[3]],ibuf[2]);
	         ibuf[3] = ibuf[3]-1;
	         }
		 else {
		 constfun(fu,data[ibuf[3]],&consta[ibuf[5]],ibuf[2]);
		 ibuf[5] = ibuf[5]-1;
		 first = 0;
		 }
		 }
  else calfun(fu,data[ibuf[3]],data[ibuf[3]],ibuf[2]);
}
else level6(ibuf,data,cdata,consta,nconst,string);
}


int level6(ibuf,data,cdata,consta,nconst,string)
int ibuf[7],nconst[];
double *data[],consta[];
char *string[], *cdata[];

{
if ((token_type == 5) && (*token == '8')) {
    get_token();
    level7(ibuf,data,cdata,consta,nconst,string);
    logic1(8,data[ibuf[3]],ibuf[2],consta[ibuf[5]],0);
    }
else level7(ibuf,data,cdata,consta,nconst,string);
}


int level7(ibuf,data,cdata,consta,nconst,string)
int ibuf[7],nconst[];
double *data[],consta[];
char *string[], *cdata[];

{

if (*token == '(') {
    get_token();
    level00(ibuf,data,cdata,consta,nconst,string);
    nochar = ibuf[4];
    if (*token == ',') {
           get_token();
           level1(ibuf,data,cdata,consta,nconst,string);
	   nochar = nochar-ibuf[4];
           } 
    if (*token != ')' ) {
          SCTPUT("Unbalanced parenthesis");
          SCSEPI();
          }
    }
else readata(ibuf,data,cdata,consta,nconst,string);
if (token_type == 3) first = 1;
else if (token_type != 1) first = 0;
get_token();
}

int find_string(ch,s)
char *ch,*s;
{
    while (*s) if (*s++==*ch) return 1;
    return 0;
}

int sdelim(s)
char *s;
{
if (find_string(s,"+-/*(),.") || *s==9 || *s=='\r' || *s==0) 
    return 1;
   return 0;
}

int stsnum(s)
char    *s;     /* IN: String to scan */
{
char    *p, x,y;
p = s;
if    (issign(*p))    p++;
while (isdigit(*p))   p++;
if (*p == '.') { 
   x = toupper(*(p+1));
/*   if (x != '\0' && !isdigit(x)) return(0);*/
   y = toupper(*(p+2));
   if (( x == 'G') || (x == 'L') || (x == 'N') || (x == 'A') || 
   (x == 'O'))
       return (p-s);
   else if ((x == 'E') && (y == 'Q')) return (p-s);
   else {
        for (++p; isdigit(*p); p++) ;
        x = toupper(*p);
        if ( (x == 'E') || (x == 'D'))        /* Look for Exponent */
        {     p++;
	      if    (issign(*p))      p++;
              while (isdigit(*p))     p++;
	}
        }
 }  
else {
   x=toupper(*p);  
   if ((x == 'E') || (x == 'D')) {
         if (issign(*(p+1)) || isdigit(*(p+1))) {
           p++;
           if    (issign(*p))      p++;
           while (isdigit(*p))     p++;
           }
  }   
}
    
return (p-s);
}

int arithm2(op,x,y,nrow)
     char op;
     double *x,*y;
     int nrow;
{
int i;
double pow();
switch (op) {
       case '+':
           for (i=0; i<nrow;i++)
               if (isNULLD(x+i) || isNULLD(y+i)) toNULLD(x+i) ;
               else   *(x+i) = *(x+i) + *(y+i);
           break;
       case '-':
           for (i=0; i<nrow;i++)
               if (isNULLD(x+i) || isNULLD(y+i)) toNULLD(x+i) ;
               else   *(x+i) = *(x+i) - *(y+i);
           break;
       case '*':
           for (i=0; i<nrow;i++)
               if (isNULLD(x+i) || isNULLD(y+i)) toNULLD(x+i) ;
               else   *(x+i) = *(x+i) * *(y+i);
           break;
       case '/':
           for (i=0; i<nrow;i++)
               if ( isNULLD(x+i) || isNULLD(y+i) || 
                       (*(y+i) == 0)) toNULLD(x+i) ;
               else   *(x+i) = *(x+i) / *(y+i);
           break;
       case '^':
           for (i=0; i<nrow;i++)
               if ( isNULLD(x+i) || isNULLD(y+i) || 
                       ((*(x+i) == 0) && (*(y+i) <0)) ||
                       ((*(x+i) <0) && (INT(*(y+i)) != *(y+i))))
                       toNULLD(x+i) ;
               else   *(x+i) = pow(*(x+i),*(y+i));
           break; 
       }
}

int arithm1(op,x,nrow,co,sens)
     char op;
     double *x;
     int nrow,sens;
     double co;
{
int i;
double pow();
switch (op) {
       case '+':
           for (i=0; i<nrow ;i++)
               if (!isNULLD(x+i)) *(x+i) = *(x+i) + co;
           break;
       case '-':
           for (i=0; i<nrow;i++)
               if(!isNULLD(x+i)) if (sens == 0)  *(x+i) = *(x+i) - co;
               else *(x+i) = co - *(x+i);
           break;
       case '*':
           for (i=0; i<nrow;i++)
               if(!isNULLD(x+i))  *(x+i) = *(x+i) * co;
           break;
       case '/':
           for (i=0; i<nrow;i++)
               if (!isNULLD(x+i)) { 
                 if (sens == 0) {
                       if (co== 0) toNULLD(x+i) ;
                       else *(x+i) = *(x+i) / co;
                       }
                 else {
                       if (*(x+i) == 0) toNULLD(x+i) ;
                       else  *(x+i) = co/(*(x+i));
                    }
               }
           break;
       case '^':
           for (i=0; i<nrow;i++)
               if (!isNULLD(x+i)) {
                 if (sens == 0) {
                       if (((*(x+i) == 0) && (co <0)) || 
                           ((*(x+i) < 0) && (INT(co) != co)))
                              toNULLD(x+i) ;
                       else *(x+i) = pow(*(x+i),co);
                       }
                 else {
                       if ((( co == 0) && (*(x+i) < 0)) ||
                           (( co < 0) && (INT(*(x+i)) != *(x+i))))
                              toNULLD(x+i) ;
                       else *(x+i) = pow(co,*(x+i));
                       }
                }
           break;

       }
}


int arithm0(op,const1,const2)
     char op;
     double *const1,*const2;
{
int i;
double pow();
switch (op) {
       case '+':
               *const1 = (*const1) + (*const2); 
           break;
       case '-':
               *const1 = (*const1) - (*const2);
           break;
       case '*':
               *const1 = (*const1) * (*const2);
           break;
       case '/':
               if (*const2 == 0) toNULLD(const1);
               else *const1 = (*const1) / (*const2);
           break;
       case '^':
               if (((*const1 == 0) && (*const2 <=0)) ||
                  ((*const1 <0) && (INT((*const2)) != *const2)))
                     toNULLD(const1);
               else *const1 = pow(*const1,*const2);
           break;

       }
}

int calfun(fu,x,y,nrow)
     int fu;
     double *x,*y;
{
int i;
double sqrt(),log(),log10(),exp(),sin(),cos(),tan();
double asin(),acos(),atan(),sinh(),cosh(),tanh(),frac();
switch (fu) {
       case 0:                                    /* sqrt */
           for (i=0; i<nrow;i++) 
             if (!isNULLD(x+i))
             if ( *(x+i) <0 ) toNULLD(x+i) ;
             else  *(x+i) = sqrt(*(x+i));
           break;
       case 1:                                   /* Ln   */
           for (i=0; i<nrow;i++) 
             if (!isNULLD(x+i))
             if ( *(x+i) <=0 )  toNULLD(x+i) ;
             else *(x+i) = log(*(x+i));
           break;
       case 2:                                  /* log10 */
           for (i=0; i<nrow;i++)        
             if (!isNULLD(x+i))
             if ( *(x+i) <=0 ) toNULLD(x+i) ;
             else *(x+i) = log10(*(x+i));
           break;
       case 3:                                 /*  exp  */
           for (i=0; i<nrow;i++) 
             if (!isNULLD(x+i)) *(x+i) = exp(*(x+i));
           break;
       case 4:                                 /*  sin */
           for (i=0; i<nrow;i++)
             if (!isNULLD(x+i))  *(x+i) = sin(*(x+i) * DEGREE);
           break;
       case 5:                                 /*  cos */
           for (i=0; i<nrow;i++) 
             if (!isNULLD(x+i))  *(x+i) = cos(*(x+i) * DEGREE);
           break;
       case 6:
           for (i=0; i<nrow;i++)              /*  tan */
             if (!isNULLD(x+i))  *(x+i) = tan(*(x+i) * DEGREE);
           break;
       case 7:
           for (i=0; i<nrow;i++)              /* asin */
             if (!isNULLD(x+i))
             if ( ABSOLUTE(*(x+i)) > 1 ) toNULLD(x+i) ;
             else  *(x+i) = asin(*(x+i))/DEGREE;
           break;
       case 8:
           for (i=0; i<nrow;i++)             /* acos */
             if (!isNULLD(x+i))
             if ( ABSOLUTE(*(x+i)) > 1 ) toNULLD(x+i) ;
             else  *(x+i) = acos(*(x+i))/DEGREE;
           break;
       case 9:                              /*  atan */
           for (i=0; i<nrow;i++)
             if (!isNULLD(x+i))  *(x+i) = atan(*(x+i))/DEGREE;
           break;
       case 10:                             /*  sinh */
           for (i=0; i<nrow;i++) 
             if (!isNULLD(x+i)) *(x+i) = sinh(*(x+i));
           break;
       case 11:
           for (i=0; i<nrow;i++)            /*  cosh */
             if (!isNULLD(x+i)) *(x+i) = cosh(*(x+i));
           break;
       case 12:                             /*  tanh */ 
           for (i=0; i<nrow;i++)
             if (!isNULLD(x+i))  *(x+i) = tanh(*(x+i));
           break;
       case 13:                             /*  ABS  */
           for (i=0; i<nrow; i++)
             if (!isNULLD(x+i))  *(x+i) = ABSOLUTE(*(x+i));
           break;
       case 14:                             /*  int */
           for (i=0; i<nrow; i++)
             if (isNULLD(x+i) || (*(x+i) > MAXLONG)) toNULLD(x+i);
             else *(x+i) = INT(*(x+i));
           break;
       case 15:                            /*frac*/
           for (i=0; i<nrow; i++)
             if ( isNULLD(x+i)) toNULLD(x+i) ;
             else *(x+i) =  *(x+i) - (int) (*(x+i));
           break;
       case 16:                             /*  min */
           for (i=0; i<nrow; i++)
             if ( isNULLD(x+i) || isNULLD(y+i) ) toNULLD(x+i);
             else *(x+i) = MIN(*(x+i),*(y+i));
           break; 
       case 17:                             /*  max */
           for (i=0; i<nrow; i++)
             if ( isNULLD(x+i)  || isNULLD(y+i) ) toNULLD(x+i) ;
             else *(x+i) = MAX(*(x+i),*(y+i));
           break;
       case 18:
           for (i=0; i<nrow; i++)
             if ( isNULLD(x+i)  || isNULLD(y+i) || (*(y+i)==0))
                  toNULLD(x+i) ;
             else *(x+i) = fmod(*(x+i),*(y+i));
           break;
       }
}


int constfun(fu,x,dvar,nrow)
     int fu;
     int nrow;
     double *dvar,*x;
{
int i;
double sqrt(),log(),log10(),exp(),sin(),cos(),tan();
double asin(),acos(),atan(),sinh(),cosh(),tanh();
switch (fu) {
       case 0:
           if(!isNULLD(dvar)) *dvar = sqrt(*dvar);
           break;
       case 1:
           if ( isNULLD(dvar) || (*dvar <=0 )) toNULLD(dvar) ;     
           else *dvar = log(*dvar);
           break;
       case 2:
           if ( isNULLD(dvar) || (*dvar <=0 )) toNULLD(dvar) ;     
           else *dvar = log10(*dvar);
           break;
       case 3:
           if(!isNULLD(dvar)) *dvar = exp(*dvar);
           break;
       case 4:
           if(!isNULLD(dvar)) *dvar = sin(*dvar * DEGREE);
           break;
       case 5:
           if(!isNULLD(dvar)) *dvar = cos(*dvar * DEGREE);
           break;
       case 6:
           if(!isNULLD(dvar)) *dvar = tan(*dvar * DEGREE);
           break;
       case 7:
           if ( !isNULLD(dvar)  || (ABSOLUTE(*dvar) > 1 )) toNULLD(dvar) ;     
           else *dvar = asin(*dvar)/DEGREE;
           break;
       case 8:
           if ( isNULLD(dvar) || (ABSOLUTE(*dvar) > 1 )) toNULLD(dvar) ;     
           else *dvar = acos(*dvar)/DEGREE;
           break;
       case 9:
           if(!isNULLD(dvar)) *dvar = atan(*dvar)/DEGREE;
           break;
       case 10:
           if(!isNULLD(dvar)) *dvar = sinh(*dvar);
           break;
       case 11:
           if(!isNULLD(dvar)) *dvar = cosh(*dvar);
       case 12:
           if(!isNULLD(dvar)) *dvar = tanh(*dvar);
           break;
       case 13:
	   if(!isNULLD(dvar)) *dvar = ABSOLUTE(*dvar);
           break;
       case 14:
           if(!isNULLD(dvar)) *dvar = INT(*dvar);
           break;
       case 15:
           if(!isNULLD(dvar)) *dvar = *dvar - (int) (*dvar);
           break;
       case 16:
           for (i=0; i<nrow; i++)
             if (isNULLD(x+i) || isNULLD(dvar) ) toNULLD(x+i);
             else  *(x+i) = MIN(*(x+i),*dvar);
           break; 
       case 17:
           for (i=0; i<nrow; i++)
             if (isNULLD(x+i) || isNULLD(dvar) ) toNULLD(x+i);
             else *(x+i) = MAX(*(x+i),*dvar);
           break;
       case 18:
           for (i=0; i<nrow; i++)
             if (isNULLD(x+i) || isNULLD(dvar) || dvar==0 ) toNULLD(x+i);
             else *(x+i) = fmod(*(x+i),*dvar);
           break;

       }
}


int unary(op,x,nrow)
char op;
double *x;
int nrow;
{
int i;

if (op == '-')
   for (i=0; i<nrow; i++)
        if (!isNULLD(x+i)) *(x+i) = -(*(x+i));
}

int readata(ibuf,data,cdata,consta,nconst,string)
int ibuf[7],nconst[];
double *data[],consta[];
char *string[], *cdata[];

{
char iform[1+TBL_FORLEN];
char name[6];
int i,j,status;
int null,column,sel,dummy,dumtype;
int ilen,itype,const_type,items,nchar,myitem;
int act;
double dval,atof();



if (token_type == 3) {
    ibuf[5] = ibuf[5]+1;
    if (*token == 'N') toNULLD(&consta[ibuf[5]]);
    else {
       if (token[stuloc(token,'D')]) token[stuloc(token,'D')] = 'E'; 
       consta[ibuf[5]] = atof(token);  
       }
    if (exist == -1) {
       i = stuloc(token,'D');
       if (token[stuloc(token,'D')]) const_type = D_R8_FORMAT;
       else if (token[stuloc(token,'E')]) const_type = D_R4_FORMAT;
       else if (token[stuloc(token,'.')]) const_type = D_R4_FORMAT;
       else   const_type = D_I4_FORMAT;
       otype = MAX(otype,const_type);
       }
    }
else if (token_type== 6) {
     if (exist == -1) otype = D_C_FORMAT;
     ibuf[4] = ibuf[4]+1;
     what[ibuf[4]+ibuf[6]+1] = 0;
     string[ibuf[4]] = osmmget((int) strlen(token)+1);
     strcpy(string[ibuf[4]],token);
     }
else if (token_type ==7) {
     ibuf[5] = ibuf[5]+1;
     status =  TCCSER(ibuf[0],token,&column);
     status =  TCFGET(ibuf[0],column,iform,&ilen,&itype);
     if (itype != D_C_FORMAT) {
       ibuf[5] = ibuf[5]+1;
       status =  TCERDD(ibuf[0],refrow,column,&consta[ibuf[5]],&null);
       if (null) toNULLD(&consta[ibuf[5]]); 
       }
     else {
       ibuf[4] = ibuf[4]+1;
       what[ibuf[4]+ibuf[6]+1] = 0;
       status =  TCBGET(ibuf[0],column,&dumtype,&dummy,&nchar);
       string[ibuf[4]] = osmmget(nchar+1);
       status = TCERDC(ibuf[0],refrow,column,string[ibuf[4]],&null);
       if (null) oscfill(string[ibuf[4]],nchar+1,'\0');
       /* if (null) strcpy(string[ibuf[4]],"\0");	*/
       }
     }
else if (token_type == 2){
    if (*token == 'Q') {
	 ibuf[3] = ibuf[3]+1;
         if (!data[ibuf[3]]) {
           (void) sprintf(name,"TEMP%02d",ibuf[3]);
           SCFCRE(name,D_R8_FORMAT,F_X_MODE,F_IMA_TYPE,ibuf[2],&tmno[ibuf[3]]);
	   SCFMAP(tmno[ibuf[3]],F_X_MODE,1,ibuf[2],&act,(char **)&data[ibuf[3]]); 
	 }
         for (i=0; i<ibuf[2]; i++) *(data[ibuf[3]]+i) = i+1;
         if (exist == -1) otype = MAX(otype,D_R4_FORMAT);
         }
    else if (*token == 'L') {
	 ibuf[3] = ibuf[3]+1;
         if (!data[ibuf[3]]) {
            (void) sprintf(name,"TEMP%02d",ibuf[3]);
            SCFCRE(name,D_R8_FORMAT,F_X_MODE,F_IMA_TYPE,ibuf[2],&tmno[ibuf[3]]);
	    SCFMAP(tmno[ibuf[3]],F_X_MODE,1,ibuf[2],&act,(char **)&data[ibuf[3]]); 
	 }
         for (i=0; i<ibuf[2]; i++) { 
             TCSGET(ibuf[0],i+1,&sel);
             if (sel) *(data[ibuf[3]]+i) = 1; else *(data[ibuf[3]]+i) = 0;
         }
         if (exist == -1) otype = MAX(otype,D_R4_FORMAT);
         }
    else {
         status =  TCCSER(ibuf[0],token,&column);
         if (column < 0) {
             SCTPUT("Input column not found");
             SCSEPI();
          }
         TCFGET(ibuf[0],column,iform,&ilen,&itype);
         TCBGET(ibuf[0],column,&dummy,&myitem,&dummy); 
	 if (exist == -1) otype = MAX(otype,itype) ;
         if (!action && itype != D_C_FORMAT){
           if (!oitem) oitem = myitem;
           else {
            if (oitem!= myitem) {
               SCTPUT("Input Columns have different depths");
               SCSEPI();
               }   
           }
         }
         if (itype == D_C_FORMAT) {
	   ibuf[1] = column;
	   if (action == 1) {  /* only for select */
	   ibuf[3] = ibuf[3]+1;
	   if (!data[ibuf[3]]) {
            (void) sprintf(name,"TEMP%02d",ibuf[3]);
            SCFCRE(name,D_R8_FORMAT,F_X_MODE,F_IMA_TYPE,ibuf[2],&tmno[ibuf[3]]);
            SCFMAP(tmno[ibuf[3]],F_X_MODE,1,ibuf[2],&act,(char **)&data[ibuf[3]]);
	    }
	   }
           ibuf[6] = ibuf[6]+1;
           what[ibuf[4]+ibuf[6]+1] = 1;
           if (!cdata[ibuf[6]]) {
	   TCBGET(ibuf[0],column,&dumtype,&dummy,&nchar);
           (void) sprintf(name,"TMPC%02d",ibuf[6]);
	   nconst[ibuf[6]] = nchar;
	   items = nchar * ibuf[2] + 1 ;
           SCFCRE(name,D_I1_FORMAT,F_X_MODE,F_IMA_TYPE,items,&tmnoc[ibuf[6]]);
	   SCFMAP(tmnoc[ibuf[6]],F_X_MODE,1,items,&act,(char **)&cdata[ibuf[6]]); 
          } 
	   for (i=0; i<ibuf[2]; i++) {
	     j = i * nchar;
             if (associate)
               status = TCERDC(ibuf[0],*(rownumber+i),column,cdata[ibuf[6]]+j,
                               &null);
             else
	     status = TCERDC(ibuf[0],i+1,column,cdata[ibuf[6]]+j,&null);
             if (null) *(cdata[ibuf[6]]+j) = '\0';
	     }
	    }
         else {
	   ibuf[1] = column;
           ibuf[3] = ibuf[3]+1;
           if (!data[ibuf[3]]) {
           (void) sprintf(name,"TEMP%02d",ibuf[3]);
           SCFCRE(name,D_R8_FORMAT,F_X_MODE,F_IMA_TYPE,ibuf[2],&tmno[ibuf[3]]);
	   SCFMAP(tmno[ibuf[3]],F_X_MODE,1,ibuf[2],&act,(char **)&data[ibuf[3]]); 
	   }
            if (associate) {
                for (i=0; i<ibuf[2]; i++) 
                TCARDD(ibuf[0],*(rownumber+i),column,colitem,1,data[ibuf[3]]+i);
                }
            else {
	        for (i=0; i<ibuf[2]; i++) {
                TCARDD(ibuf[0],i+1,column,colitem,1,data[ibuf[3]]+i);
                }
	    /*if (null == 1) toNULLD(data[ibuf[3]]+i); */
	    }
	   }
     }
 }
}

/*

*/

int writesele(ibuf,data,nsel,isel,msel)
double *data[];
int ibuf[7],*nsel,*isel,msel;

{				/* version of S. Wolf to fill keyword */
int status,i,j;
int sel;



*nsel = 0;
for (i=0,j=0; i<ibuf[2]; i++) {
     *nsel = *nsel + *(data[0]+i);
     sel = *(data[0]+i);
     if ((sel == 1) && (j<msel)) 
         isel[j++] = i+1;
     status = TCSPUT(ibuf[0],i+1,&sel);
     }
}

int dscwrite(ibuf,data,nsel,tid)
double *data[];
int ibuf[7], nsel, tid;

{
int i,j;
int sel;
int *isele;

char  helptext[28];


sel = 0;
(void) SCKRDI("MONITPAR",14,1,&i,&sel,&i,&j);
if (sel == 0) return 0;


(void) strcpy(helptext,"NoSel, selected rows ...");

if (nsel <= 0)			/* ALL rows selected... */
   {
   i = nsel;
   j = 0;					/* no unit yet */
   (void) SCDWRI(tid,"SELIDX",&i,1,1,&j);
   (void) SCDWRH(tid,"SELIDX",helptext,1,(int)strlen(helptext));
   return 0;
   }



/* we know the no. of selected rows + can create the index array */

isele = (int*) malloc( (nsel+1)*sizeof(int) );
if (isele != 0x0)
   {
   j = 0;
   isele[j++] = nsel;
   for (i=0; i<ibuf[2]; i++)
      {
      sel = *(data[0]+i);                  /* selec_flag = 0 or 1 */
      if (sel == 1) isele[j++] = i+1;
      }

   j = 0;					/* no unit yet */
   (void) SCDWRI(tid,"SELIDX",isele,1,(nsel+1),&j);
   (void) SCDWRH(tid,"SELIDX",helptext,1,(int)strlen(helptext));
   free (isele);
   }

else
   SCTPUT("WARNING: Not enough memory to create descr array!");

return 0;
}


/*
int writesele(ibuf,data,nsel)
double *data[];
int ibuf[7],*nsel;

{                       // OLD version of writesele() //
int status,i;
int sel;


*nsel = 0;
for (i=0; i<ibuf[2]; i++) {
     *nsel = *nsel + *(data[0]+i);
     sel = *(data[0]+i);
     status = TCSPUT(ibuf[0],i+1,&sel);
     }
}
*/

/*  */
char*  readsel(ibuf,data,nsel)
double *data[];
int ibuf[7],*nsel;

{
int status,i,j, fcol,null;
char* filelist;


*nsel = 0;
for (i=0; i<ibuf[2]; i++) {
     *nsel = *nsel + *(data[0]+i);
     }
if (*nsel == 0 ) filelist = (char *) 0;
else filelist = osmmget(*nsel*81);
for (j=0; j<*nsel*81; j++) filelist[j] = '\0';
TCLSER(ibuf[0],"FILENAME",&fcol);
j = 0;
for (i=0; i<ibuf[2]; i++) {
    if (*(data[0]+i)) {
       TCERDC(ibuf[0],i+1,fcol, filelist+j,&null);
       j = (int) strlen(filelist);
       filelist[j++] = ' ';
    }
}
return(filelist);
}

int stucmp(s1,s2)
/* compare two character strings, case insensitive*/
char *s1;
char *s2;
{
int i;

for (i=0; toupper(s1[i]) == toupper(s2[i]); i++)
    if (s1[i] == '\0')
        return 0;
return s1[i] - s2[i];
}

int logic1(ope,x,nrow,co,sens)
     int ope;
     double *x;
     int nrow,sens;
     double co;
{
int i;
switch (ope) {
       case 0: 
	    for (i=0; i<nrow ;i++)
		if ( isNULLD(x+i) || isNULLD(&co) ) *(x+i) = tdfalse;
		else if (sens == 0) 
		   if (*(x+i) <= co) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
                else
		   if (co <= *(x+i)) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 1:
	    for (i=0; i<nrow ;i++)
		if ( isNULLD(x+i) || isNULLD(&co) ) *(x+i) = tdfalse;
		else if (sens == 0) 
		   if (*(x+i) < co) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
                else
		   if (co < *(x+i)) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 2:
	    for (i=0; i<nrow ;i++)
		if ( isNULLD(x+i) || isNULLD(&co) ) *(x+i) = tdfalse;
		else if (sens == 0) 
		   if (*(x+i) >= co) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
                else
		   if (co >= *(x+i)) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 3:
	    for (i=0; i<nrow ;i++)
		if ( isNULLD(x+i) || isNULLD(&co) ) *(x+i) = tdfalse;
		else if (sens == 0) 
		   if (*(x+i) > co) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
                else
		   if (co > *(x+i)) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 4:
	    for (i=0; i<nrow ;i++)
		   if (isNULLD(&co))   
		      if (isNULLD(x+i)) *(x+i) = tdtrue;
			  else *(x+i) = tdfalse;
		   else if (isNULLD(x+i))  *(x+i) = tdfalse;
		   else if ( *(x+i) == co) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 5:
	    for (i=0; i<nrow ;i++)
                   if (isNULLD(x+i)) *(x+i) = tdfalse;
		   else if (*(x+i) != co) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 6:
	    for (i=0; i<nrow ; i++)
        	   if (isNULLD(x+i)) *(x+i) = tdfalse;
		   else if
		  (*(x+i) == tdtrue && co == tdtrue) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 7:
	    for (i=0; i<nrow ; i++)
        	   if (isNULLD(x+i)) *(x+i) = tdfalse;
		   else if
		  (*(x+i) == tdtrue || co == tdtrue) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 8:
	    for (i=0; i<nrow ; i++)
        	   if (isNULLD(x+i)  || *(x+i) == tdtrue) *(x+i) = tdfalse;
		   else *(x+i) = tdtrue;
            break;
       }
}


int logic2(ope,x,y,nrow)
     int ope;
     double *x,*y;
     int nrow;
{
int i;
switch (ope) {
       case 0:
	    for (i=0; i<nrow ;i++)
		   if (isNULLD(x+i) || isNULLD(y+i) ) *(x+i) = tdfalse;
		   else if (*(x+i) <= *(y+i)) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 1:
	    for (i=0; i<nrow ;i++)
		   if (isNULLD(x+i) || isNULLD(y+i) ) *(x+i) = tdfalse;
		   else if (*(x+i) < *(y+i)) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 2:
	    for (i=0; i<nrow ;i++)
		   if (isNULLD(x+i) || isNULLD(y+i) ) *(x+i) = tdfalse;
		   else if (*(x+i) >= *(y+i)) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 3:
	    for (i=0; i<nrow ;i++)
		   if (isNULLD(x+i) || isNULLD(y+i) ) *(x+i) = tdfalse;
		   else if (*(x+i) > *(y+i)) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 4:
	    for (i=0; i<nrow ;i++)
		   if (isNULLD(x+i) || isNULLD(y+i) ) *(x+i) = tdfalse;
		   else if (*(x+i) == *(y+i)) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 5:
	    for (i=0; i<nrow ;i++)
		   if (isNULLD(x+i) || isNULLD(y+i) ) *(x+i) = tdfalse;
		   else if (*(x+i) != *(y+i)) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 6:
	    for (i=0; i<nrow ;i++)
		   if (isNULLD(x+i) || isNULLD(y+i) ) *(x+i) = tdfalse;
		   else if 
		      (*(x+i) == tdtrue && *(y+i) == tdtrue) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       case 7:
	    for (i=0; i<nrow ;i++)
		   if (isNULLD(x+i) || isNULLD(y+i) ) *(x+i) = tdfalse;
		   else if
		      (*(x+i) == tdtrue || *(y+i) == tdtrue) *(x+i) = tdtrue;
		   else *(x+i) = tdfalse;
            break;
       }
}

int writedata(ocol,ibuf,data,consta)
int ocol;
double *data[],consta[];
int ibuf[7];

{
int status,i;


if(!data[0]) 
if (isNULLD(&consta[ibuf[5]])) for (i=0;i<ibuf[2];i++) 
                                 TCADEL(ibuf[0],i+1,ocol,colitem,1);
else for (i=0; i<ibuf[2]; i++) 
                        TCAWRD(ibuf[0],i+1,ocol,colitem,1,&consta[ibuf[5]]);
else {
   for (i=0; i<ibuf[2]; i++) 
   if (isNULLD(data[0]+i)) TCADEL(ibuf[0],i+1,ocol,colitem,1); 
   else status = TCAWRD(ibuf[0],i+1,ocol,colitem,1,data[0]+i) ;
   }
}



int writechar(ocol,ibuf,cdata,string,nchar)
int ocol,ibuf[7],nchar;
char *cdata[], *string[];

{
int i,j,k,status;
char cval[256];


if (!cdata[0]) for (i=0; i<ibuf[2]; i++)
TCEWRC(ibuf[0],i+1,ocol,string[ibuf[4]]);
else for (i=0; i<ibuf[2]; i++){
       j = i * nchar;
       for (k=0; k<nchar; k++) cval[k] = *(cdata[ibuf[6]]+j+k);
       cval[k] = '\0';
       status = TCEWRC(ibuf[0],i+1,ocol,cval);
       }
}

/*

*/

char*  tbl_select_ima(intable,criteria,myrefrow)
/*  */
char intable[],criteria[];
int myrefrow;
 
{
int i,status;
int dummy;
int ibuf[7],tid,tidview;
int ocol,nrow,nrall,ncol,nline;
int nsel,nconst[BUFK],null;
float tblsel;
double *data[BUFK],consta[BUFK];
char *string[BUFM];
char *cdata[BUFK];
int unit,dunit,cdummy;
char *mline,*filelist;


TCMCON(&tblsel,&tdtrue,&tdfalse);
associate = 0;
action = 1;
refrow = myrefrow;
mline = osmmget(CRITLEN+2);
line = mline;
token = osmmget(PARLEN);

for (i=0 ; i<BUFM; i++)
      string[i] = (char *)0;

for (i=0 ; i<BUFK; i++)
      {
      data[i] = (double *)0;
      cdata[i] = (char *)0;
      }

strncpy(line,criteria,CRITLEN);
nline = (int) strlen(line);
status = TCTOPN(intable,F_I_MODE,&tid);
ibuf[0] = tid;
status = TCIGET(ibuf[0],&ncol,&nrow,&dummy,&dummy,&nrall);
ibuf[2] = nrow;     
ibuf[3] = -1;     
ibuf[4] = -1;        
ibuf[5] = -1;     
ibuf[6] = -1;    
for (i=0; i< BUFM; i++) 
        {
        tmno[i] = -1;
        tmnoc[i] = -1;
        } 
if (stumatch(line,"all") == 3)
     {
     status = TCSINI(ibuf[0]);
     /* nsel = nrow has to be written into outputi(1) */
     status = SCKWRI("OUTPUTI",&nrow,1,1,&cdummy);
     }
else 
     {
     get_token();
     level00(ibuf,data,cdata,consta,nconst,string); 
     filelist = readsel(ibuf,data,&nsel);
     line -= nline;
     }
osmmfree(mline);
osmmfree(token);
TCTCLO(tid);
for (i=0; i<BUFM;i++) 
   {
   if (tmno[i] != -1) SCFCLO(tmno[i]);
   if (tmnoc[i] != -1 ) SCFCLO(tmnoc[i]); 
   }
for (i=0; i<ibuf[4]; i++)
   {
   if (string[i]) osmmfree(string[i]);
   }

return(filelist);
}