/* @(#)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 #include /* To know the size of descriptors */ #include #include /* For LOGICAL */ #include /* Just for TBL_ERRIMP */ static one = 1; static zero = 0; 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); } 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); } 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 */ { char fmt[TBL_FORLEN+1]; /* Returned format */ *status = TCFGET(*tid, *column, fmt, len, dtype); STRFCOPY(form, fmt); } 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 */ { *status = TCFPUT(*tid, *column, C_STRING(form)); } ROUTINE TBFSET(status) /*++++++++++++++++ .PURPOSE *** Obsolete Function *** .RETURNS - -----------------*/ fint2c *status; /* OUT: status return = ERR_TBLIMP */ { SCTPUT("**** TBFSET is an Obsolete Function ****"); *status = ERR_TBLIMP; } 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); } 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); } 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); } 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); } 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 */ { char mylabel[TBL_LABLEN+1]; *status = TCLGET(*tid,*col,mylabel); STRFCOPY(label, mylabel); } 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 */ { *status = TCLPUT(*tid,*col,STRIPPED_STRING(label)); } 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 */ { *status = TCLSER(*tid, STRIPPED_STRING(label), col); } 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 */ { *status = TCOGET(STRIPPED_STRING(opname), value); } 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 */ { *status = TCOSET(STRIPPED_STRING(opname), *value); } 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); } 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); } 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); } 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); } 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 */ { char myline[TBL_Dselect_SIZE+1]; *status = TCSINF(*tid, myline); STRFCOPY(line, myline); } 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 */ { *status = TCSSET(*tid, STRIPPED_STRING(line)); } 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 */ { char mybuf[TBL_UNILEN+1]; oscfill(mybuf,TBL_UNILEN+1,'\0'); *status = TCUGET(*tid, *col, mybuf); STRFCOPY(unit, mybuf); } 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 */ { *status = TCUPUT(*tid, *col, STRIPPED_STRING(unit)); }