/* @(#)tba.fc 17.1.1.1 (ESO-IPG) 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 tba.fc .LANGUAGE C .AUTHOR M. Peron (ESO-IPG)) .KEYWORDS Table system, FORTRAN interface .ENVIRONMENT .VERSION 1.0 22-dec-1992: first version .COMMENTS FORTRAN 77 to C interface layer. ---------------*/ #include #include #include /* VMR common */ #include /* LOGICAL */ #include ROUTINE TBAMAP(tid,row,col,index,status) /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE Return the address of the COMPLETE element array .RETURNS status ------------------------------------------------------------------*/ fint2c *tid; fint2c *row; fint2c *col; flong2c *index; fint2c *status; { char *mypntr; *status = TCAMAP(*tid,*row,*col,&mypntr); *index = COMMON_INDEX(mypntr); } ROUTINE TBAUNM(tid,index,status) /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE Unmap a part of the file that was mapped. .RETURNS status (-1 if not mapped) -------------------------------------------------------------*/ fint2c *tid; fint2c *index; fint2c *status; { *status = TCAUNM(*tid,(char *)&((&vmr.addr)[*index-1])); } ROUTINE TBADEL(tid,row,col,index,items,status) /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE Deletes table elements. .METHOD Writes a NULL value in the table. .RETURNS status -------------------------------------------------------------*/ fint2c *tid; fint2c *row; fint2c *col; fint2c *index; fint2c *items; fint2c *status; { *status = TCADEL(*tid,*row,*col,*index,*items); } SUBROUTINE TBAWRC(tid, row, col, index, items, value,status) /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE Writes table element, character string format. .RETURNS status -------------------------------------------------------------*/ fint2c *tid; fint2c *row; fint2c *col; fint2c *index; fint2c *items; CHARACTER value; fint2c *status; { *status = TCAWRC(*tid,*row,*col,*index,*items,C_STRING(value)); } ROUTINE TBAWRD(tid, row, col, index, items, value,status) /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE Writes table element, double precision argument. .RETURNS status -------------------------------------------------------------*/ fint2c *tid; fint2c *row; fint2c *col; fint2c *index; fint2c *items; double *value; fint2c *status; { *status = TCAWRD(*tid,*row,*col,*index,*items,value); } ROUTINE TBAWRI(tid, row, col, index, items, value,status) /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE Writes table element, double precision argument. .RETURNS status -------------------------------------------------------------*/ fint2c *tid; fint2c *row; fint2c *col; fint2c *index; fint2c *items; fint2c *value; fint2c *status; { *status = TCAWRI(*tid,*row,*col,*index,*items,value); } ROUTINE TBAWRR(tid, row, col, index, items, value,status) /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE Writes table element, double precision argument. .RETURNS status -------------------------------------------------------------*/ fint2c *tid; fint2c *row; fint2c *col; fint2c *index; fint2c *items; float *value; fint2c *status; { *status = TCAWRR(*tid,*row,*col,*index,*items,value); } SUBROUTINE TBARDC(tid, row, col, index, items, value,status) /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE Reads table element as a character string. Arrays are edited with a comma between elements. .RETURNS status (error and non-selected) -------------------------------------------------------------*/ fint2c *tid; fint2c *row; fint2c *col; fint2c *index; fint2c *items; CHARACTER value; fint2c *status; { char myvalue[TBL_ROWLEN+1]; *status = TCARDC(*tid,*row,*col,*index,*items,myvalue); STRFCOPY(value, myvalue); } ROUTINE TBARDD(tid, row, col, index, items, value,status) /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE Reads table element as a double precision number. Arrays are edited with a comma between elements. .RETURNS status (error and non-selected) -------------------------------------------------------------*/ fint2c *tid; fint2c *row; fint2c *col; fint2c *index; fint2c *items; double *value; fint2c *status; { *status = TCARDD(*tid,*row,*col,*index,*items,value); } ROUTINE TBARDI(tid, row, col, index, items, value,status) /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE Reads table element as an integer Arrays are edited with a comma between elements. .RETURNS status (error and non-selected) -------------------------------------------------------------*/ fint2c *tid; fint2c *row; fint2c *col; fint2c *index; fint2c *items; fint2c *value; fint2c *status; { *status = TCARDI(*tid,*row,*col,*index,*items,value); } ROUTINE TBARDR(tid, row, col, index, items, value,status) /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE Reads table element as a floating point number Arrays are edited with a comma between elements. .RETURNS status (error and non-selected) -------------------------------------------------------------*/ fint2c *tid; fint2c *row; fint2c *col; fint2c *index; fint2c *items; float *value; fint2c *status; { *status = TCARDR(*tid,*row,*col,*index,*items,value); } SUBROUTINE TBASCC(tid,row,col,index,items,value,next,status) /*++++++++++++++++++ .PURPOSE F77 interface to TCASRC (search in character) .RETURNS - -------------------*/ fint2c *tid; fint2c *row; fint2c *col; fint2c *index; fint2c *items; CHARACTER value; fint2c *next; fint2c *status; { *status = TCASRC(*tid,*row,*col,*index,*items,C_STRING(value),next); } ROUTINE TBASCD(tid,row,col,index,items,value,next,status) /*++++++++++++++++++ .PURPOSE F77 interface to TCASRD .RETURNS - -------------------*/ fint2c *tid; fint2c *row; fint2c *col; fint2c *index; fint2c *items; double *value; fint2c *next; fint2c *status; { *status = TCASRD(*tid,*row,*col,*index,*items,value,next); } ROUTINE TBASCI(tid,row,col,index,items,value,next,status) /*++++++++++++++++++ .PURPOSE F77 interface to TCASRI .RETURNS - -------------------*/ fint2c *tid; fint2c *row; fint2c *col; fint2c *index; fint2c *items; fint2c *value; fint2c *next; fint2c *status; { *status = TCASRI(*tid,*row,*col,*index,*items,value,next); } ROUTINE TBASCR(tid,row,col,index,items,value,next,status) /*++++++++++++++++++ .PURPOSE F77 interface to TCASRR .RETURNS - -------------------*/ fint2c *tid; fint2c *row; fint2c *col; fint2c *index; fint2c *items; float *value; fint2c *next; fint2c *status; { *status = TCASRR(*tid,*row,*col,*index,*items,value,next); }