#define vmr	vmr_		/* parameter for Name Translation is l_ */
#define ROUTINE int
/* @(#)tbd.fc	17.1.1.1 (ES0-DMD) 01/25/02 17:34: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 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
===========================================================================*/

/*++++++++++++++
.IDENTIFICATION tbd.fc
.LANGUAGE       C
.AUTHOR         J.D. Ponz, F. Ochsenbein (ESO-IPG))
.KEYWORDS       Table system, FORTRAN interface
.ENVIRONMENT    
.VERSION  1.0  	1 Feb 1987     Creation
.VERSION  1.1  	1 Dec 1987     Modification of the calling seq.
.VERSION  1.2  	7 Apr 1988     Add length to the calling seq.
.VERSION  1.3   13-Dec-1990: Simplified
.COMMENTS       FORTRAN 77 to C interface layer.
---------------*/

#include <tbldef.h>
#include <tblsys.h>		/* To know the size of descriptors */
#include <ftoc.h>
#include <ftoc_log.h>		/* For LOGICAL	*/
#include <midas_def.h>		/* Just for TBL_ERRIMP */

static one  = 1;
static zero = 0;

#define TBBGET	tbbget_
ROUTINE TBBGET(tid,column,dtype,items,bytes,status)
/*++++++++++++++++
.PURPOSE F77 to C interface used to GET info about Binary storage
.RETURNS -
-----------------*/
fint2c	*tid;	 	/* IN : table identifier */
fint2c	*column;	/* IN : Column concerned */
fint2c	*dtype;		/* OUT: data type        */
fint2c	*items;		/* OUT: Array size	 */
fint2c	*bytes;		/* OUT: Storage in bytes */ 
fint2c	*status;	/* OUT: status return    */
{
  *status = TCBGET(*tid, *column, dtype, items, bytes);
}

#define TBDGET	tbdget_
ROUTINE TBDGET(tid,store,status)
/*++++++++++++++++
.PURPOSE F77 to C interface used to Get Info about Storage Format
.RETURNS -
-----------------*/
fint2c	*tid;	 	/* IN : table identifier */
fint2c	*store;		/* OUT: Physical format (0 for Columnwise) */
fint2c	*status;	/* OUT: status return    */
{
  *status = TCDGET(*tid, store);
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE TBFGET(tid,column,form,len,dtype,status)
/*++++++++++++++++
.PURPOSE F77 to C interface used to TCFGET (info about Edited column)
.RETURNS -
-----------------*/
fint2c	*tid;	 	/* IN : table identifier */
fint2c	*column;	/* IN : Column concerned */
CHARACTER form;		/* OUT: Column Format (C)*/
fint2c	*len;		/* OUT: Bytes required for edited element */
fint2c	*dtype;		/* OUT: data type        */
fint2c	*status;	/* OUT: status return    */
#else     /* ==== Generated Code === */
#define TBFGET	tbfget_
TBFGET(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */

	char fmt[TBL_FORLEN+1];	/* Returned format */  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */

  *PARAM(6,6,1,fint2c *) = TCFGET(*PARAM(1,6,0,fint2c *), *PARAM(2,6,0,fint2c *), fmt,PARAM(4,6,1,fint2c *),PARAM(5,6,1,fint2c *));
  STRFCOPY(3,6,0, fmt);
  ftoc_free(FORmark);    /* <forif> */
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE TBFPUT(tid,column,form,status)
/*++++++++++++++++
.PURPOSE F77 to C interface used to TCFPUT (Change Format)
.RETURNS -
-----------------*/
fint2c	*tid;	 	/* IN : table identifier */
fint2c	*column;	/* IN : Column concerned */
CHARACTER form;		/* IN : Column Format (C)*/
fint2c	*status;	/* OUT: status return    */
#else     /* ==== Generated Code === */
#define TBFPUT	tbfput_
TBFPUT(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */

  *PARAM(4,4,1,fint2c *) = TCFPUT(*PARAM(1,4,0,fint2c *), *PARAM(2,4,0,fint2c *), C_STRING(3,4,0));
  ftoc_free(FORmark);    /* <forif> */
}

#define TBFSET	tbfset_
ROUTINE TBFSET(status)
/*++++++++++++++++
.PURPOSE *** Obsolete Function ***
.RETURNS -
-----------------*/
fint2c	*status;	/* OUT: status return = ERR_TBLIMP */
{
  SCTPUT("**** TBFSET is an Obsolete Function ****");
  *status = ERR_TBLIMP;
}

#define TBIGET	tbiget_
ROUTINE TBIGET(tid,cols,rows,nsort,acols,arows,status)
/*++++++++++++++++
.PURPOSE F77 to C interface used to TCIGET (info about Table Sizes)
.RETURNS -
-----------------*/
fint2c	*tid;	 	/* IN : table identifier 	*/
fint2c	*cols;		/* OUT: Number of Columns 	*/
fint2c	*rows;		/* OUT: Number of Rows    	*/
fint2c	*nsort;		/* OUT: Sorted Column Number 	*/
fint2c	*acols;		/* OUT: Number of Alloc.Columns	*/
fint2c	*arows;		/* OUT: Number of Alloc. Rows  	*/
fint2c	*status;	/* OUT: status return    */
{
  *status = TCIGET(*tid, cols, rows, nsort, acols, arows);
}

#define TBIPUT	tbiput_
ROUTINE TBIPUT(tid,cols,rows,status)
/*++++++++++++++++
.PURPOSE F77 to C interface used to TCIPUT (Change Format)
.RETURNS -
.REMARKS This function SHOULD NOT BE USED !!!
-----------------*/
fint2c	*tid;	 	/* IN : table identifier */
fint2c	*cols;		/* IN : Number of cols	 */
fint2c	*rows;		/* IN : Number of rows	 */
fint2c	*status;	/* OUT: status return    */
{
  *status = TCIPUT(*tid, *cols, *rows);
}

#define TBKGET	tbkget_
ROUTINE TBKGET(tid,col,status)
/*++++++++++++++++
.PURPOSE F77 to C interface used to TCKGET (info about Reference Column)
.RETURNS -
-----------------*/
fint2c	*tid;	 	/* IN : table identifier 	*/
fint2c	*col;		/* OUT: Reference Column	*/
fint2c	*status;	/* OUT: status return    */
{
  *status = TCKGET(*tid, col);
}

#define TBKPUT	tbkput_
ROUTINE TBKPUT(tid,col,status)
/*++++++++++++++++
.PURPOSE F77 to C interface used to TCKPUT (Change Reference Column)
.RETURNS -
-----------------*/
fint2c	*tid;	 	/* IN : table identifier */
fint2c	*col;		/* IN :eference Column	 */
fint2c	*status;	/* OUT: status return    */
{
  *status = TCKPUT(*tid, *col);
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE TBLGET(tid,col,label,status)
/*++++++++++++++++
.PURPOSE F77 interface to TCLGET (Get Label)
.RETURNS -
-----------------*/
fint2c       *tid; 	/* IN : table identifier */
fint2c       *col; 	/* IN : Column connerned */
CHARACTER   label;	/* OUT: column label 	*/
fint2c       *status;	/* OUT: status return 	*/
#else     /* ==== Generated Code === */
#define TBLGET	tblget_
TBLGET(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */

	char mylabel[TBL_LABLEN+1];  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */

  *PARAM(4,4,1,fint2c *) = TCLGET(*PARAM(1,4,0,fint2c *),*PARAM(2,4,0,fint2c *),mylabel);
  STRFCOPY(3,4,0, mylabel);
  ftoc_free(FORmark);    /* <forif> */
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE TBLPUT(tid,col,label,status)
/*++++++++++++++++
.PURPOSE F77 interface to TCLPUT (Change Label)
.RETURNS -
-----------------*/
fint2c       *tid; 	/* IN : table identifier */
fint2c       *col; 	/* IN : Column connerned */
CHARACTER   label;	/* IN : new label     */
fint2c       *status;	/* OUT: status return */
#else     /* ==== Generated Code === */
#define TBLPUT	tblput_
TBLPUT(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */

  *PARAM(4,4,1,fint2c *) = TCLPUT(*PARAM(1,4,0,fint2c *),*PARAM(2,4,0,fint2c *),STRIPPED_STRING(3,4,0));
  ftoc_free(FORmark);    /* <forif> */
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE TBLSER(tid,label,col,status)
/*++++++++++++++++
.PURPOSE F77 interface to TCLSER (retrieve a column label)
.RETURNS -
-----------------*/
fint2c       *tid; 	/* IN : table identifier 	*/
CHARACTER   label;	/* IN: Label to look for	*/
fint2c       *col;	/* OUT: column number 		*/
fint2c       *status;	/* OUT: status return 		*/
#else     /* ==== Generated Code === */
#define TBLSER	tblser_
TBLSER(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */
 
  *PARAM(4,4,1,fint2c *) = TCLSER(*PARAM(1,4,0,fint2c *), STRIPPED_STRING(2,4,0),PARAM(3,4,1,fint2c *));
  ftoc_free(FORmark);    /* <forif> */
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE TBOGET(opname, value, status)
/*++++++++++++++++
.PURPOSE F77 interface to TCOGET (retrieve options)
.RETURNS -
-----------------*/
CHARACTER   opname;	/* IN: option to look for	*/
fint2c       *value;	/* OUT: current option value	*/
fint2c       *status;	/* OUT: status return 		*/
#else     /* ==== Generated Code === */
#define TBOGET	tboget_
TBOGET(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */
 
  *PARAM(3,3,1,fint2c *) = TCOGET(STRIPPED_STRING(1,3,0),PARAM(2,3,1,fint2c *));
  ftoc_free(FORmark);    /* <forif> */
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE TBOSET(opname, value, status)
/*++++++++++++++++
.PURPOSE F77 interface to TCOSET (set options)
.RETURNS -
-----------------*/
CHARACTER   opname;	/* IN: option to look for	*/
fint2c       *value;	/* IN: new option value		*/
fint2c       *status;	/* OUT: status return 		*/
#else     /* ==== Generated Code === */
#define TBOSET	tboset_
TBOSET(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */
 
  *PARAM(3,3,1,fint2c *) = TCOSET(STRIPPED_STRING(1,3,0), *PARAM(2,3,1,fint2c *));
  ftoc_free(FORmark);    /* <forif> */
}

#define TBSGET	tbsget_
ROUTINE TBSGET(tid, row, value, status)
/*++++++++++++++++
.PURPOSE F77 interface to TCSGET (Read Selection Flag)
.RETURNS -
-----------------*/
fint2c       *tid; 	/* IN : table identifier */
fint2c	   *row;	/* IN : Row concerned	 */
fint2c       *value;	/* OUT: Selection Flag   */
fint2c       *status;	/* OUT: status return 	 */
{ 
  *status = TCSGET(*tid, *row, value);
  *value = (*value ? F77TRUE : F77FALSE);
}

#define TBSPUT	tbsput_
ROUTINE TBSPUT(tid, row, value, status)
/*++++++++++++++++
.PURPOSE F77 interface to TCSPUT (Write Selection Flag)
.RETURNS -
-----------------*/
fint2c       *tid; 	/* IN : table identifier */
fint2c	   *row;	/* IN : Row concerned	 */
fint2c       *value;	/* IN : Selection Flag   */
fint2c       *status;	/* OUT: status return 	 */
{ 
  *status = TCSPUT(*tid, *row, *value == F77FALSE ? &zero : &one);
}

#define TBSCNT	tbscnt_
ROUTINE TBSCNT(tid, count, status)
/*++++++++++++++++
.PURPOSE F77 interface to TCSCNT (Count Selected Rows)
.RETURNS -
-----------------*/
fint2c       *tid; 	/* IN : table identifier */
fint2c       *count;	/* OUT: Number of selected entries */
fint2c       *status;	/* OUT: status return 	 */
{ 
  *status = TCSCNT(*tid, count);
}

#define TBSINI	tbsini_
ROUTINE TBSINI(tid, status)
/*++++++++++++++++
.PURPOSE F77 interface to TCSINI (Initialize Selection Flags)
.RETURNS -
-----------------*/
fint2c       *tid; 	/* IN : table identifier */
fint2c       *status;	/* OUT: status return 	 */
{ 
  *status = TCSINI(*tid);
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE TBSINF(tid, line, status)
/*++++++++++++++++
.PURPOSE F77 interface to TCSINF (Get Selection Information)
.RETURNS -
-----------------*/
fint2c       *tid; 	/* IN : table identifier */
CHARACTER   line;	/* OUT: The Selection Line */
fint2c       *status;	/* OUT: status return 	 */
#else     /* ==== Generated Code === */
#define TBSINF	tbsinf_
TBSINF(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
 
	char myline[TBL_Dselect_SIZE+1];  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */

  *PARAM(3,3,1,fint2c *) = TCSINF(*PARAM(1,3,0,fint2c *), myline);
  STRFCOPY(2,3,0, myline);
  ftoc_free(FORmark);    /* <forif> */
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE TBSSET(tid, line, status)
/*++++++++++++++++
.PURPOSE F77 interface to TCSSET (Set Selection Information)
.RETURNS -
-----------------*/
fint2c       *tid; 	/* IN : table identifier */
CHARACTER   line;	/* IN : The Selection Line */
fint2c       *status;	/* OUT: status return 	 */
#else     /* ==== Generated Code === */
#define TBSSET	tbsset_
TBSSET(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */
 
  *PARAM(3,3,1,fint2c *) = TCSSET(*PARAM(1,3,0,fint2c *), STRIPPED_STRING(2,3,0));
  ftoc_free(FORmark);    /* <forif> */
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE TBUGET(tid, col, unit, status)
/*++++++++++++++++
.PURPOSE F77 interface to TCUGET (Read Unit)
.RETURNS -
-----------------*/
fint2c       *tid; 	/* IN : table identifier */
fint2c	   *col;	/* IN : Column concerned */
CHARACTER   unit;	/* OUT: Unit of Column	 */
fint2c       *status;	/* OUT: status return 	 */
#else     /* ==== Generated Code === */
#define TBUGET	tbuget_
TBUGET(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
 
  char mybuf[TBL_UNILEN+1];  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */

  oscfill(mybuf,TBL_UNILEN+1,'\0');
  *PARAM(4,4,1,fint2c *) = TCUGET(*PARAM(1,4,0,fint2c *), *PARAM(2,4,0,fint2c *), mybuf);
  STRFCOPY(3,4,0, mybuf);
  ftoc_free(FORmark);    /* <forif> */
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE TBUPUT(tid, col, unit, status)
/*++++++++++++++++
.PURPOSE F77 interface to TCUPUT (Write Unit)
.RETURNS -
-----------------*/
fint2c       *tid; 	/* IN : table identifier */
fint2c	   *col;	/* IN : Column concerned */
CHARACTER   unit;	/* IN : Unit of Column	 */
fint2c       *status;	/* OUT: status return 	 */
#else     /* ==== Generated Code === */
#define TBUPUT	tbuput_
TBUPUT(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */
 
  *PARAM(4,4,1,fint2c *) = TCUPUT(*PARAM(1,4,0,fint2c *), *PARAM(2,4,0,fint2c *), STRIPPED_STRING(3,4,0));
  ftoc_free(FORmark);    /* <forif> */
}