#define vmr vmr_ /* parameter for Name Translation is l_ */ #define ROUTINE int /* @(#)tbt.fc 17.1.1.1 (ESO-IPG) 01/25/02 17:34:11 */ /*=========================================================================== 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 tbt.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 16-Oct-1990: Simplified .COMMENTS FORTRAN 77 to C interface layer. ---------------*/ #include #include #include /* VMR common */ #include #define TBTCLO tbtclo_ ROUTINE TBTCLO(tid, status) /*++++++++++++++++ .PURPOSE F77 to C interface to TCTCLO: Close Table .RETURNS - -----------------*/ fint2c *tid; /* IN : table identifier */ fint2c *status; /* OUT: status return */ { *status = TCTCLO(*tid); } #define TBTUNM tbtunm_ ROUTINE TBTUNM(tid, status) /*++++++++++++++++ .PURPOSE F77 interface to TCTUNM (Read in Character) .RETURNS - -----------------*/ fint2c *tid; /* IN : table identifier */ fint2c *status; /* OUT: status return */ { *status = TCTUNM(*tid); } #if 0 /* ==== Original Code ==== */ SUBROUTINE TBTID(name, tid) /*++++++++++++++++ .PURPOSE F77 interface to TCTID (Find ID from Name) .RETURNS - -----------------*/ CHARACTER name; /* IN : Table Name */ fint2c *tid; /* OUT: table identifier */ #else /* ==== Generated Code === */ #define TBTID tbtid_ TBTID(va_alist) va_dcl { va_list Cargs; #endif /* ======================= */ int FORmark; /* */ va_start(Cargs); /* */ FORmark = ftoc_mark(); /* */ *PARAM(2,2,1,fint2c *) = TCTID (STRIPPED_STRING(1,2,0)); ftoc_free(FORmark); /* */ } #if 0 /* ==== Original Code ==== */ SUBROUTINE TBTINI(name, storage, mode, allcols, allrows, tid, status) /*++++++++++++++++ .PURPOSE F77 interface to TCTINI (Create a new Table) .RETURNS - -----------------*/ CHARACTER name; /* IN : Table Name */ fint2c *storage; /* IN : 0 for Transposed */ fint2c *mode; /* IN : Opening Mode */ fint2c *allcols; /* IN : Columns to allocate */ fint2c *allrows; /* IN : Rows to allocate */ fint2c *tid; /* OUT: table identifier */ fint2c *status; /* OUT: status return */ #else /* ==== Generated Code === */ #define TBTINI tbtini_ TBTINI(va_alist) va_dcl { va_list Cargs; #endif /* ======================= */ int FORmark; /* */ va_start(Cargs); /* */ FORmark = ftoc_mark(); /* */ *PARAM(7,7,1,fint2c *) = TCTINI(STRIPPED_STRING(1,7,0), *PARAM(2,7,1,fint2c *), *PARAM(3,7,1,fint2c *), *PARAM(4,7,1,fint2c *), *PARAM(5,7,1,fint2c *),PARAM(6,7,1,fint2c *)); ftoc_free(FORmark); /* */ } #define TBTMAP tbtmap_ ROUTINE TBTMAP(tid, index, status) /*++++++++++++++++ .PURPOSE F77 interface to map a Table. .RETURNS - -----------------*/ fint2c *tid; /* IN : table identifier */ flong2c *index; /* OUT: Table address in VMR */ fint2c *status; /* OUT: status return */ { char *mypntr; *status = TCTMAP(*tid, &mypntr); *index = COMMON_INDEX(mypntr); /* Convert to VMR index */ } #if 0 /* ==== Original Code ==== */ SUBROUTINE TBTOPN(name, mode, tid, status) /*++++++++++++++++ .PURPOSE F77 interface to Open a Table. .RETURNS - -----------------*/ CHARACTER name; /* IN : Table Name */ fint2c *mode; /* IN : Opening Mode */ fint2c *tid; /* OUT: table identifier */ fint2c *status; /* OUT: status return */ #else /* ==== Generated Code === */ #define TBTOPN tbtopn_ TBTOPN(va_alist) va_dcl { va_list Cargs; #endif /* ======================= */ int FORmark; /* */ va_start(Cargs); /* */ FORmark = ftoc_mark(); /* */ *PARAM(4,4,1,fint2c *) = TCTOPN(STRIPPED_STRING(1,4,0), *PARAM(2,4,1,fint2c *),PARAM(3,4,1,fint2c *)); ftoc_free(FORmark); /* */ } #if 0 /* ==== Original Code ==== */ SUBROUTINE TBFNAM(name) /*++++++++++++++++ .PURPOSE F77 interface to TCTID (Retrieve Number from Name)_ .RETURNS Corresponding Number -----------------*/ CHARACTER name; /* IN : Table Name */ #else /* ==== Generated Code === */ #define TBFNAM tbfnam_ TBFNAM(va_alist) va_dcl { va_list Cargs; #endif /* ======================= */ int FORmark; /* */ int tid; va_start(Cargs); /* */ FORmark = ftoc_mark(); /* */ tid = TCTID(STRIPPED_STRING(1,1,0)); if (tid < 0) SCTPUT("**** Bad Table Name ****"); ftoc_free(FORmark); /* */return(tid); }