/* @(#)tce.c	17.1.1.1 (ES0-DMD) 01/25/02 17:36:44 */
/*===========================================================================
  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 Massachusetss Ave, Cambridge, 
  MA 02139, USA.
 
  Corresponding 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     	tce.c
.LANGUAGE  	C
.AUTHOR     	IPG-ESO Garching
.CATEGORY    	table interface.
.VERSION  1.0 	25-Mar-1987   Implementation J.D. Ponz
.VERSION  1.1 	21-Oct-1987   New calling sequence
.VERSION  1.2 	11-Apr-1988   New calling sequence
.VERSION  1.3 	26-Sep-1988   Use pointers for TCEWRx
.VERSION  1.4 	16-Jan-1989   Include record file organization
.VERSION  3.0 	01-Jul-1990   	New Version with Arrays / Elementary IO
.VERSION  3.1 	27-Sep-1990   	Added TCEUNM
.VERSION  3.2 	28-Oct-1990 Added TCEEDC (Edit, similar to TCERDC)
			and TCETRC (similar to TCEWRC)
.VERSION  3.3 	18-Dec-1990 FO: Take into account the number of selected rows.
.VERSION  3.4   05-Apr-1991 MP list out null values as * in TCERDC
                03-Feb-1992 modify TCERDC according to DANEt MP
                27-Jul-1992 correct TCETRC for EDIT/TAB and the character *
          3.5   07-Aug-1992 correct TCEWRC and TCERDC (take the real length of
                            the string)
.COMMENTS    
\begin{TeX}

This module contains the routines to handle table elements. 
Access to elements is done by column and row numbers. 
Elements in the table can be integer, float, double precision and
character string data types, as defined during the creation of the
columns. 
Implicit conversion of the element value is done automatically if the
input/output is done with a routine not corresponding to the data type.

The functions provided by this module are:

\begin{itemize}
\item Delete an element (TCEDEL),
\item read an element from the table (TCERDx),
\item map an element of the table (TCEMAP),
\item write an element into the table (TCEWRx),
\item search for an element value (TCESRx).
\item unmap an element of the table (TCEUNM),
\end{itemize}

Main arguments used by the routines are:
\begin{description}
\item[column] sequential column number. It is an integer number provided
           by the system when a new column is created, or it is defined by 
           the user for already existing columns.
\item[null] null flag. This value is 1 if the element is undefined,
           0 otherwise.
\item[row] sequential row number. It is an integer defining 
           the row number in the table or the symbols LAST, FIRST, NEXT 
           and PREVIOUS defined in the system file 'midas\_def.h' in the
           directory 'MID\_INCLUDE'. 
           The sequence number is the physical sequence number (by default)
           or the sequence corresponding to the index of the reference 
           column.
\item[tid] table identifier. It is an integer number provided by the
           system when the table is created or opened.
\item[value] element value. The type depends on the routine name.
           Implicit conversion is done if this type does not correspond
           to the column data type.
\end{description}

In case of arrays, {\bf only the first element} is returned for
non-character data.

\end{TeX}

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

#include <midas_def.h>		/* General MIDAS Symbols	*/
#include <tblsys.h>		/* Table System parameters	*/
#include <tbldef.h>		/* Symbols used for Tables	*/
#include <tblerr.h>		/* List of Table Errors		*/

#include <atype.h>		/* Character classification	*/
#include <macrogen.h>		/* Classical macros		*/

#include <math.h>		/* System Library		*/


	/* Mnemonics for some operations */
	

#define CheckRowPositive(row)	(row < 1 ? ERR_TBLROW : ERR_NORMAL)

#define CheckOverflow(tp,row)	(row <= tp->arows ? ERR_NORMAL :	\
				 TBL_ALLOROW(tid, row + row/5))
#define CheckArrayColumn(tp,col)	if (items > 1)			\
     TBL_errf(-1, 							\
     "Access to array column :%s restricted to FIRST element,          ",\
     ColumnLabel(tp, col))

/*=======================================================================
 *		Checking Routines
 *=======================================================================*/
#ifdef __STDC__
static int Icheck1 (int value)	
#else
static int Icheck1 (value)	
	int value;
#endif
{
  if ((value < -127) || (value > 255))
  	SCTPUT ("++++ Overflow I*1");
  return (value);
}

#ifdef __STDC__
static int Fcheck1 (double x)	
#else
static int Fcheck1 (x)	
	double x;
#endif
{
  int	value = NINT (x);
  return (Icheck1(value));
}

#ifdef __STDC__
static int Icheck2 (int value)	
#else
static int Icheck2 (value)	
	int value;
#endif
{
  if ((value < -32767) || (value > 0xffff))
  	SCTPUT ("++++ Overflow I*2");
  return (value);
}

#ifdef __STDC__
static int Fcheck2 (double x)	
#else
static int Fcheck2 (x)	
	double x;
#endif
{
  int	value = NINT (x);
  return (Icheck2(value));
}

/*=======================================================================
 *		Public Routines
 *=======================================================================*/

TCEDEL(tid, row, column)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE	Deletes  table element.
.ALGORITHM	Writes a NULL value in the table.
.RETURNS	status
-------------------------------------------------------------*/
	int	tid			/* IN : table id	*/;
	int	row			/* IN : row number 	*/;
	int	column			/* IN : column number	*/;
{
	TABLE	*tp;
  	int	dtype, status, ic;
	char	*x;

  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));
  if (status = CheckRow(tp, row))	return(TBL_errs(tid, status, row));


				/* read value with intrinsic type */

  dtype   = tp->dtypes[column-1];
  ic      = TBL_offset (tp, row, column);

				/* Write the NULL value		*/
  if_not(x = TBL_RDF (tp, ic, TBL_ElementSize(dtype), 1))
  	return(TBL_RDst());
  TBL_toNULL (dtype, x);

				/* Update used rows (MP)	*/
  if (row > tp->rows)         tp->selected = row, tp->rows = row;

  return (status);
}

TCEMAP(tid, row, column, address, null)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE  	Return the address of the element (which can be an array) 
		in the table.
.RETURNS	status
.REMARKS	The selection element cannot be mapped...
------------------------------------------------------------------*/
	int	tid			/* IN: table id number 		*/;
	int	row			/* IN: row    number		*/;
	int	column			/* IN: column number		*/;
	char	**address		/* OUT: element adress		*/;
	int	*null			/* OUT: 1 if element null	*/;
{
	TABLE	*tp;
	int	ic, nbytes, dtype, status;
	char	*x;

  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));
  if (status = CheckRow(tp, row))	return(TBL_errs(tid, status, row));

  nbytes  = tp->bytes[column-1];
  dtype   = tp->dtypes[column-1];
  ic      = TBL_offset (tp, row, column);

  if_not(x = TBL_RDF (tp, ic, nbytes, TBL__MAPPED)) 
  	return(TBL_RDst());
  *null = TBL_isNULL (dtype, (int *)x);

  *address = x; 
			/* Number of Rows was expanded ?? */
  if (row > tp->rows)         tp->selected = row, tp->rows = row;

  return (status);
}

TCEEDC(tid, abin, column, buffer)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE Read an element referred by abin. The function is similar to
	 TCERDC, but has the value in memory instead of in table.
.RETURNS status
.REMARKS No null flag here (null values have buffer[0] = 0).
	Output buffer assumed to be large enough (size is returned
	by TBFGET)
-------------------------------------------------------------*/
	int	tid;		/* IN : table id	*/
	char	*abin;		/* IN : value to edit	*/
	int	column;		/* IN : column number	*/
	char	*buffer;	/* OUT: edited value    */
{
	TABLE	*tp;
	int	status;
	int	dtype, dummy;
	char  	form[TBL_FORLEN+1];

  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));

				/* read value with intrinsic type */
  dtype   = tp->dtypes[column-1];
  if (TBL_isNULL(dtype, (int *)abin)) {
	*buffer = '\0';
	return (status);
  }

  if (status = TCFGET(tid, column, form, &dummy, &dummy)) return(status);
  TBL_ed (buffer, form, dtype, abin);

  return (status);
}

TCERDC(tid, row, column, value, null)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE	Reads table element as a character string.
.ALGORITHM	Finds the element position and convert data type
                if required.
                Arrays are edited with a comma between elements.
.RETURNS        status (error and non-selected)
-------------------------------------------------------------*/
	int	tid			/* IN : table id	*/;
	int	row			/* IN : row number 	*/;
	int	column			/* IN : column number	*/;
	char	*value			/* OUT: actual value    */;
	int	*null 			/* OUT: null flag	*/;
{
	TABLE	*tp;
	int	status, abytes;
	int	dtype, nbytes, ic, dummy, type;
	char  	form[TBL_FORLEN+1];
	char	*x;


  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));
  if (status = CheckRow(tp, row))	return(TBL_errs(tid, status, row));


				/* read value with intrinsic type */
  dtype   = tp->dtypes[column-1];
  nbytes  = tp->bytes[column-1];
  abytes  = tp->abytes[column-1];
  ic      = TBL_offset (tp, row, column);

  if_not(x = TBL_RD (tp, ic, nbytes))	return(TBL_RDst());

  if (status = TCFGET(tid, column, form, &dummy, &type)) return(status);

  if (*null = TBL_isNULL(dtype, (int *)x)) {
        oscfill(value,dummy,' ');
	if (dtype&(~TBL_D_MASK)) value[dummy-1] = '*';
        value[dummy] = '\0';
	return (status);
  }
  if (type == D_C_FORMAT) sprintf(form,"A%d",nbytes);   /* MP  070892 */
  TBL_ed (value, form, dtype, x);

  return (status);
}

TCERDD(tid,row,column,value,null)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE	Reads table element as a double precision variable.
.ALGORITHM	Finds the element position and convert data type
                if required.
                Only the FIRST value is got for arrays.
.RETURNS        status (error and non-selected)
-------------------------------------------------------------*/
	int	tid			/* IN : table id	*/;
	int	row			/* IN : row number 	*/;
	int	column			/* IN : column number	*/;
	double	*value			/* OUT: actual value    */;
	int	*null 			/* OUT: null flag	*/;
{
	TABLE	*tp;
	int	dtype, ic, nbytes, items;
	int	status;
	char	*x;


                       				/* checks arguments	*/
  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));
  if (status = CheckRow(tp, row))	return(TBL_errs(tid, status, row));


				/* read value with intrinsic type */
  dtype   = tp->dtypes[column-1];
  nbytes  = tp->bytes[column-1];
  ic      = TBL_offset (tp, row, column);
  if_not(x = TBL_RD (tp, ic, nbytes))	return(TBL_RDst());

  if (*null = TBL_isNULL(dtype, (int *)x))	return(status);

  items = TBL_Items (dtype);
  switch (TBL_ElementType(dtype)) {
    case TBL_D_A1:	
    	status = TBL_cv (x, "E15.6", (TBL_D_R8<<TBL_D_BITS)|1,(char *)value);
	items = 1;
    	break;
    case TBL_D_I1:	*value = *x;			break;
    case TBL_D_A2:    	*value = *(unsigned short *)x;	break;
    case TBL_D_I2:    	*value = *(short *)x;		break;
    case TBL_D_A4:    	*value = *(unsigned int *)x;	break;
    case TBL_D_I4:	*value = *(int *)x;	break;
    case TBL_D_R8:    	*value = *(double *)x;	break;
    case TBL_D_R4:	*value = *(float *)x;	break;
  }

  CheckArrayColumn(tp, column);
  return (status);
}

TCERDI(tid,row,column,value,null)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE	Reads table element as integer value.
.ALGORITHM	Finds the element position and convert data type
                if required.
                Only the FIRST value is got for arrays.
.RETURNS        status (error and non-selected)
-------------------------------------------------------------*/
	int	tid			/* IN : table id	*/;
	int	row			/* IN : row number 	*/;
	int	column			/* IN : column number	*/;
	int	*value			/* OUT: actual value    */;
	int	*null 			/* OUT: null flag	*/;
{
	TABLE	*tp;
	int	status;
	int	dtype, ic, items, nbytes;
	char	*x;

  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));
  if (status = CheckRow(tp, row))	return(TBL_errs(tid, status, row));


				/* read value with intrinsic type */
  ic      = TBL_offset (tp, row, column);

  dtype   = tp->dtypes[column-1];
  nbytes  = tp->bytes[column-1];

  if_not(x = TBL_RD (tp, ic, nbytes))	return(TBL_RDst());
  if (*null  = TBL_isNULL(dtype, (int *)x))	return(status);

  items = TBL_Items (dtype);
  switch (TBL_ElementType(dtype)) {
    case TBL_D_A1:	
    	status = TBL_cv (x, "I12", (TBL_D_I4<<TBL_D_BITS)|1, (char *)value);
	items  = 1;
    	break;
    case TBL_D_I1:	*value = *x;			break;
    case TBL_D_A2:	*value = *(unsigned short *)x;	break;
    case TBL_D_I2:	*value = *(short *)x;		break;
    case TBL_D_A4: 
    case TBL_D_I4: 	*value = *(int *)x;		break;
    case TBL_D_R8:	*value = NINT(*(double *)x);	break;
    case TBL_D_R4:	*value = NINT(*(float *)x);	break;
  }

  CheckArrayColumn(tp, column);
  return (status);
}

TCERDR(tid,row,column,value,null)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE	Reads table element as float.
.ALGORITHM	Finds the element position and convert data type
                if required.
                Only the FIRST value is got for arrays.
.RETURNS        status (error and non-selected)
-------------------------------------------------------------*/
	int	tid			/* IN : table id	*/;
	int	row			/* IN : row number 	*/;
	int	column			/* IN : column number	*/;
	float	*value			/* OUT: actual value    */;
	int	*null 			/* OUT: null flag	*/;
{
	TABLE	*tp;
	int	dtype, ic, items, nbytes;
	int	status;
	char	*x;


  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));
  if (status = CheckRow(tp, row))	return(TBL_errs(tid, status, row));


				/* read value with intrinsic type */
  dtype   = tp->dtypes[column-1];
  nbytes  = tp->bytes[column-1];
  ic      = TBL_offset (tp, row, column);
  if_not(x = TBL_RD (tp, ic, nbytes))	return(TBL_RDst());

  if (*null = TBL_isNULL(dtype, (int *)x))
  	return(status);

  items = TBL_Items (dtype);
  switch (TBL_ElementType(dtype)) {
    case TBL_D_A1:	
    	status = TBL_cv (x, "E15.6", (TBL_D_R4<<TBL_D_BITS)|1, (char *)value);
	items  = 1;
    	break;
    case TBL_D_I1:	*value = *x;			break;
    case TBL_D_A2:    	*value = *(unsigned short *)x;	break;
    case TBL_D_I2:    	*value = *(short *)x;		break;
    case TBL_D_A4:	*value = *(unsigned int *)x;	break;
    case TBL_D_I4:	*value = *(int *)x;		break;
    case TBL_D_R4:	*value = *(float *)x;		break;
    case TBL_D_R8:    	*value = *(double *)x;		break;
  }

  CheckArrayColumn(tp, column);
  return (status);
}


TCETRC(tid, abin, column, buffer)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE Interpret (TRanslate) the character value in buffer.
	 This function is similar to TCEWRC, but converts the
	 value to memory (no table access)
.RETURNS status
.REMARKS No null flag here (null values have buffer[0] = 0).
-------------------------------------------------------------*/
	int	tid;		/* IN : table id	*/
	char	*abin;		/* OUT: value to edit	*/
	int	column;		/* IN : column number	*/
	char	*buffer;	/* IN : edited value    */
{
	TABLE	*tp;
	int	status;
	int	dtype, dummy;
	char  	*p, form[TBL_FORLEN+1];

  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));

  dtype   = tp->dtypes[column-1];
						/* Check for a NULL 	*/
  p = buffer;
  if (dtype&(~TBL_D_MASK)) for (p = buffer; *p == ' '; p++) ;
  else p = buffer;
  if ((*p == '\0') || ((*p == '*') && (dtype&(~TBL_D_MASK))))	
 	TBL_toNULL (dtype, abin);
  else 	{
  	if (status = TCFGET(tid, column, form, &dummy, &dummy)) return(status);
  	status = TBL_cv (buffer, form, dtype, abin);
  }
  return (status);
}

TCEWRC(tid,row,column,value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE	Writes table element, caracter string format. 
.ALGORITHM	Finds the element position and convert data type
                if required.
                Element in an array must be separated by ,
.RETURNS	status
-------------------------------------------------------------*/
	int	tid			/* IN : table id	*/;
	int	row			/* IN : row number 	*/;
	int	column			/* IN : column number	*/;
	char	*value			/* IN : actual value    */;
{
	TABLE	*tp;
	int	status;
	int	ic, nbytes, dtype, dummy, type;
	char	*x, *p, form[1+TBL_FORLEN];

  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));
  if (status = CheckRowPositive(row))	return(TBL_errs(tid, status, row));

					/* check if row overflow */
  if (status = CheckOverflow(tp,row))	return(status);
  tp = TBL_ptr(tid);		/* Might be changed by overflow	*/
  if (row > tp->rows)         tp->selected = row, tp->rows = row;

				/* read value with intrinsic type */
  dtype   = tp->dtypes[column-1];
  nbytes  = tp->bytes[column-1];
  ic      = TBL_offset (tp, row, column);

  if_not(x = TBL_RDF (tp, ic, nbytes, 1))	return(TBL_RDst());

						/* Check for a NULL 	*/
/*  for (p = value; *p == ' '; p++) ;*/
  if (dtype&(~TBL_D_MASK)) for (p = value; *p == ' '; p++) ;
  else p = value;
  if ((*p == '\0') || ((*p == '*') && (dtype&(~TBL_D_MASK))))	
 	TBL_toNULL (dtype, x);
  else 	{
  	if (status = TCFGET(tid, column, form, &dummy, &type)) return(status);
   /*     if (type == D_C_FORMAT) sprintf(form,"A%d",nbytes); MP 070892 */
  	status = TBL_cv (value, form, dtype, x);
        if (status) TBL_errf(status,"Wrong Input");
  }

  return (status);
}

TCEWRD(tid,row,column,value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE	Writes table element, double precision argument.
.ALGORITHM	Finds the element position and convert data type
                if required.
                Only the FIRST value is written for arrays.
.RETURNS	status
-------------------------------------------------------------*/
	int	tid			/* IN : table id	*/;
	int	row			/* IN : row number 	*/;
	int	column			/* IN : column number	*/;
	double	*value			/* IN : actual value    */;
{
	TABLE	*tp;
  	int	status;
  	int	ic, nbytes, items, dtype;
	char	*x;
	char	form[10], edited[32];

  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));
  if (status = CheckRowPositive(row))	return(TBL_errs(tid, status, row));

					/* check if row overflow */
  if (status = CheckOverflow(tp,row))	return(status);
  tp = TBL_ptr(tid);		/* Might be changed by overflow	*/
  if (row > tp->rows)         tp->selected = row, tp->rows = row;

				/* read value with intrinsic type */
  dtype   = tp->dtypes[column-1];
  nbytes  = tp->bytes[column-1];
  ic      = TBL_offset (tp, row, column);

  if_not(x= TBL_RDF (tp, ic, nbytes, 1))	return(TBL_RDst());
  oscfill (x, nbytes, 0);

  items = TBL_Items (dtype);
  switch (TBL_ElementType(dtype)) {
    case TBL_D_A1:		  		 /* character string */
	form[0] = '%';
        form[1] = ' ';
	if (nbytes < 8)	
		form[1] = 'f', form[2] = '\0';
	else 	sprintf(form+1, "%d.%de", MIN(22,nbytes-1), MIN(15, nbytes-8));
	sprintf(edited, form, *value);
	status = TCEWRC (tid, row, column, edited);
	items  = 1;
  	break;
    case TBL_D_I1:	*x = Fcheck1(*value); 		break;
    case TBL_D_A2:
    case TBL_D_I2:	*(short *)x = Fcheck2(*value);	break;
    case TBL_D_A4:
    case TBL_D_I4:	*(int *)x = NINT(*value);		break;
    case TBL_D_R4:	*(float *)x = *value;			break;
    case TBL_D_R8:	*(double *)x = *value;			break;
  }

  CheckArrayColumn(tp, column);
  return (status);
}

TCEWRI(tid,row,column,value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE	Writes table element, integer variable as argument.
.ALGORITHM	Finds the element position and convert data type
                if required.
                Only the FIRST value is written for arrays.
.RETURNS	status
-------------------------------------------------------------*/
	int	tid			/* IN : table id	*/;
	int	row			/* IN : row number 	*/;
	int	column			/* IN : column number	*/;
	int	*value			/* IN : actual value    */;
{
	TABLE	*tp;
	int	status;
	int	ic, nbytes, items, dtype;
	char	*x;
	char	edited[16];

  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));
  if (status = CheckRowPositive(row))	return(TBL_errs(tid, status, row));

					/* check if row overflow */
  if (status = CheckOverflow(tp,row))	return(status);
  tp = TBL_ptr(tid);		/* Might be changed by overflow  */
  if (row > tp->rows)         tp->selected = row, tp->rows = row;

				/* read value with intrinsic type */
  ic      = TBL_offset (tp, row, column);
  dtype   = tp->dtypes[column-1];
  nbytes  = tp->bytes[column-1];
  if_not(x= TBL_RDF (tp, ic, nbytes, 1))	return(TBL_RDst());
  oscfill (x, nbytes, 0);

  items = TBL_Items (dtype);
  switch (TBL_ElementType(dtype)) {
    case TBL_D_A1:				 /* character string */
	sprintf(edited, "%d", *value);
	status = TCEWRC (tid, row, column, edited);
	items  = 1;
	break;
    case TBL_D_I1:	*x = Icheck1(*value); 		break;
    case TBL_D_A2:
    case TBL_D_I2:	*(short *)x = Icheck2(*value);	break;
    case TBL_D_A4:
    case TBL_D_I4:	*(int *)x = *value;		break;
    case TBL_D_R4:	*(float *)x = *value; 		break;
    case TBL_D_R8:	*(double *)x = *value;		break;
  }

  CheckArrayColumn(tp, column);
  return (status);
}

TCEWRR(tid,row,column,value)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE	Writes table element, float as input argument.
.ALGORITHM	Finds the element position and convert data type
                if required.
                Only the FIRST value is written for arrays.
.RETURNS	status
-------------------------------------------------------------*/
	int	tid			/* IN : table id	*/;
	int	row			/* IN : row number 	*/;
	int	column			/* IN : column number	*/;
	float	*value			/* IN : actual value    */;
{
	TABLE	*tp;
  	int	status;
  	int	ic, nbytes, items, dtype;
	char	*x;
	char	form[10], edited[32];

  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));
  if (status = CheckRowPositive(row))	return(TBL_errs(tid, status, row));

					/* check if row overflow */
  if (status = CheckOverflow(tp,row))	return(status);
  tp = TBL_ptr(tid);		/* Might be changed by overflow	*/
  if (row > tp->rows)         tp->selected = row, tp->rows = row;

				/* read value with intrinsic type */
  dtype   = tp->dtypes[column-1];
  nbytes  = tp->bytes[column-1];
  ic      = TBL_offset (tp, row, column);

  if_not(x= TBL_RDF (tp, ic, nbytes, 1))	return(TBL_RDst());
  oscfill (x, nbytes, 0);

  items = TBL_Items (dtype);
  switch (TBL_ElementType(dtype)) {
    case TBL_D_A1:					/* character string */
	form[0] = '%';
        form[1] = ' ';
	if (nbytes < 7)	
		form[1] = 'f', form[2] = '\0';
	else 	sprintf(form+2, "%d.%de", MIN(13,nbytes-1), MIN(6, nbytes-7));
	sprintf(edited, form, *value);
	status = TCEWRC (tid, row, column, edited);
	items  = 1;
  	break;
    case TBL_D_I1:	*x = Fcheck1(*value); 		break;
    case TBL_D_A2:
    case TBL_D_I2:	*(short *)x = Fcheck2(*value);	break;
    case TBL_D_A4:	*(unsigned int *)x = NINT(*value);	break;
    case TBL_D_I4:	*(int *)x = NINT(*value);		break;
    case TBL_D_R4:	*(float *)x = *value;			break;
    case TBL_D_R8:	*(double *)x = *value;			break;
  }

  CheckArrayColumn(tp, column);
  return (status);
}

TCESRC(tid, column, value, start, len, first, next)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE	Search element in character string format.
.ALGORITHM	Search element in the table,
                using binary or sequential search algorithm.

                Note: A zero value for error is used
                for location on non-character columns.
.RETURNS	status
-------------------------------------------------------------*/
	int	tid			/* IN : table id	*/;
	int	column			/* IN : column number	*/;
	char	*value			/* IN : value to search */;
        int    start                   /* IN : starting position in field */;
        int    len			/* IN : how many bytes to compare  */;
	int	first			/* IN : starting row 	*/;
	int	*next			/* OUT: found row number */;
{
	TABLE	*tp;
	char 	*x;
	int	status;
  	int	dtype, ic, incr, count, nbytes;
  	int	(*lower_routine)();
  	int	long_value, long_error;
  	double	double_value, double_error, atof();

  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));
  if (status = CheckTrueRow(tp, first))	return(TBL_errs(tid, status, first));

				/* search value according to intrinsic type */
  dtype   = tp->dtypes[column-1];
  nbytes  = tp->bytes[column-1];
  ic      = TBL_offset (tp, first, column);
  incr    = TBL_offset (tp, first+1, column) - ic;

  count   = tp->rows - first + 1;

  if_not(x = TBL_RD (tp, ic, nbytes + (count-1)*incr)) 	return(TBL_RDst());

  switch (TBL_ElementType(dtype)) {
    case TBL_D_A1:			  		/* character string */
  	lower_routine = TBL_BSC;
  	if (column == -tp->scol)	incr = -incr;
  	else if (column == tp->scol)	;
  	else 				lower_routine = TBL_SSC;
	*next = (*lower_routine)(x, value, start, len, count, incr);
	if (*next >= 0)	*next += first;
	break;
    case TBL_D_I1:
    case TBL_D_A2:
    case TBL_D_I2:				/* int*2	*/  
    case TBL_D_A4:
    case TBL_D_I4:				/* int*4	*/  
	long_error = 0;
	long_value = atoi(value);
	status = TCESRI (tid, column, long_value, long_error, first, next);
	break;

    case TBL_D_R4:				/* single precision */
    case TBL_D_R8:  				/* double  precision */  
	double_error = 0;
	double_value = atof(value);
	status = TCESRD (tid, column, double_value, double_error, first, next);
	break;
  } 

  return (status);
}

TCESRD(tid,column,value,verror,first,next)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE	Search element in double precision format.
.ALGORITHM	Search element in the table,
                using binary or sequential search algorithm.

                Note: The routine can be used only with columns
                containing numerical data, implicit conversion 
                of arguments is done if required.
.RETURNS	status
-------------------------------------------------------------*/
	int	tid			/* IN : table id	*/;
	int	column			/* IN : column number	*/;
	double	value			/* IN : value to search */;
	double	verror			/* IN : tolerance 	*/;
	int	first			/* IN : starting row number */;
	int	*next			/* OUT: found row number */;
{
	TABLE	*tp;
	char 	*x;
	int	status;
  	int	dtype, ic, incr, count, items, nbytes;
  	int	(*lower_routine)();
  	int	long_value, long_error;

  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));
  if (status = CheckTrueRow(tp, first))	return(TBL_errs(tid, status, first));

				/* search value according to intrinsic type */
  dtype   = tp->dtypes[column-1];
  nbytes  = tp->bytes[column-1];
  ic      = TBL_offset (tp, first, column);
  incr    = TBL_offset (tp, first+1, column) - ic;

  count   = tp->rows - first + 1;

  if_not(x = TBL_RD (tp, ic, nbytes + (count-1)*incr))	return(TBL_RDst());
  	
  items = TBL_Items (dtype);
  switch (TBL_ElementType(dtype)) {
    case TBL_D_A1:			  		/* character string */
	SCTPUT(" Can't search for real value on character string ");
	*next  = -1;
	status = ERR_TBLFMT; 
	break;
    case TBL_D_I1:
	lower_routine = TBL_BSI1;
	if      (column == -tp->scol)	incr = -incr;
	else if (column == tp->scol)	;
	else 				lower_routine = TBL_SSI1;
	goto case_integer;
    case TBL_D_A2:
    case TBL_D_I2:				/* int*2	*/  
	incr /= 2;
	lower_routine = TBL_BSI2;
	if      (column == -tp->scol)	incr = -incr;
	else if (column == tp->scol)	;
	else 				lower_routine = TBL_SSI2;
	goto case_integer;
    case TBL_D_A4:
    case TBL_D_I4:				/* int*4	*/  
	incr /= 4;
	lower_routine = TBL_BSI4;
	if      (column == -tp->scol)	incr = -incr;
	else if (column == tp->scol)	;
	else 				lower_routine = TBL_SSI4;
    case_integer:				/* INTEGER	*/
	long_value = NINT(value);
	long_error = NINT(verror);
	*next = (*lower_routine)(x, long_value, long_error, count, incr);
	if (*next >= 0)	*next += first;
	break;

    case TBL_D_R8:  				/* double  precision */  
	incr /= sizeof(double);
	lower_routine = TBL_BSD;
	if      (column == -tp->scol)	incr = -incr;
	else if (column ==  tp->scol)	;
	else 				lower_routine = TBL_SSD;
	goto case_float;
    case TBL_D_R4:				/* single precision */
	incr /= sizeof(float);
	lower_routine = TBL_BSR;
	if      (column == -tp->scol)	incr = -incr;
	else if (column ==  tp->scol)	;
	else 				lower_routine = TBL_SSR;
    case_float:					/* ALL FLOATING	*/
	*next = (*lower_routine)(x, value, verror, count, incr);
	if (*next >= 0)	*next += first;
	break;

  } 

  CheckArrayColumn(tp, column);
  return (status);
}

TCESRI(tid, column, value, verror, first, next)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE	Search element in integer format.
.ALGORITHM	Search element in the table,
                using binary or sequential search algorithm.

                Note: The routine can be used only with columns
                containing numerical data, implicit conversion 
                of arguments is done if required.
.RETURNS	status
-------------------------------------------------------------*/
	int	tid			/* IN : table id	*/;
	int	column			/* IN : column number	*/;
	int	value			/* IN : value to search	*/;
	int	verror			/* IN : tolerance	*/;
	int	first			/* IN : starting row number */;
	int	*next			/* OUT: found row number */;
{
	TABLE	*tp;
	char 	*x;
	int	status;
  	int	dtype, ic, incr, count, items, nbytes;
  	int	(*lower_routine)();
  	double	dble_value, dble_error;

  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));
  if (status = CheckTrueColumn(tp, column))
	  				return(TBL_errs(tid, status, column));
  if (status = CheckTrueRow(tp, first))	return(TBL_errs(tid, status, first));

				/* search value according to intrinsic type */
  dtype   = tp->dtypes[column-1];
  nbytes  = tp->bytes[column-1];
  ic      = TBL_offset (tp, first, column);
  incr    = TBL_offset (tp, first+1, column) - ic;

  count   = tp->rows - first + 1;

  if_not(x = TBL_RD (tp, ic, nbytes + (count-1)*incr))	return(TBL_RDst());

  items = TBL_Items (dtype);
  switch (TBL_ElementType(dtype)) {
    case TBL_D_A1:			  		/* character string */
	SCTPUT(" Can't search for integer value on character string ");
	*next  = -1;
	status = ERR_TBLFMT; 
	break;
    case TBL_D_I1:
	lower_routine = TBL_BSI1;
	if      (column == -tp->scol)	incr = -incr;
	else if (column == tp->scol)	;
	else 				lower_routine = TBL_SSI1;
	goto case_integer;
    case TBL_D_A2:	
    case TBL_D_I2:	
	incr /= 2;
	lower_routine = TBL_BSI2;
	if      (column == -tp->scol)	incr = -incr;
	else if (column == tp->scol)	;
	else 				lower_routine = TBL_SSI2;
	goto case_integer;
    case TBL_D_A4:
    case TBL_D_I4:				/* int*4	*/  
	incr /= 4;
	lower_routine = TBL_BSI4;
	if      (column == -tp->scol)	incr = -incr;
	else if (column == tp->scol)	;
	else 				lower_routine = TBL_SSI4;
    case_integer:				/* INTEGER	*/
	*next = (*lower_routine)(x, value, verror, count, incr);
	if (*next >= 0)	*next += first;
	break;

    case TBL_D_R8:  				/* double  precision */  
	incr /= sizeof(double);
	lower_routine = TBL_BSD;
	if      (column == -tp->scol)	incr = -incr;
	else if (column ==  tp->scol)	;
	else 				lower_routine = TBL_SSD;
	goto case_float;
    case TBL_D_R4:				/* single precision */
	incr /= sizeof(float);
	lower_routine = TBL_BSR;
	if      (column == -tp->scol)	incr = -incr;
	else if (column ==  tp->scol)	;
	else 				lower_routine = TBL_SSR;
    case_float:					/* ALL FLOATING	*/
	dble_value = value;
	dble_error = verror;
	*next = (*lower_routine)(x, dble_value, dble_error, count, incr);
	if (*next >= 0)	*next += first;
	break;

  } 

  CheckArrayColumn(tp, column);
  return (status);
}

#ifdef __STDC__
TCESRR(int tid, int column, float value, float verror, int first, int *next)
#else
TCESRR(tid, column, value, verror, first, next)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE	Search element, floating point format.
.ALGORITHM	Since, in C, argument in float is converted to double,
                this routine is identical to TCESRD.
.RETURNS	status
-------------------------------------------------------------*/
	int	tid			/* IN : table id	*/;
	int	column			/* IN : column number	*/;
	float	value			/* IN : value to search	*/;
	float	verror			/* IN : tolerance	*/;
	int	first			/* IN : starting row number*/;
	int	*next			/* OUT: found row number */;
#endif
{
  return(TCESRD(tid, column, value, verror, first, next));
}

TCEUNM(tid, address)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE	Unmap a part of the file that was mapped.
.ALGORITHM	
                this routine is identical to TCESRD.
.RETURNS	status (-1 if not mapped)
-------------------------------------------------------------*/
	int	tid			/* IN: table id number 		*/;
	char	*address		/* IN: column address           */;
{
	TABLE	*tp;
	int	status;
	
  tp = TBL_ptr(tid);
  if (status = CheckTable(tp))		return(TBL_errs(tid, status,0));

  return (TBL_UMAP(tp, address));
}