/* @(#)stda.fc 17.1.1.1 (ESO-DMD) 01/25/02 17:34:08 */ /*=========================================================================== 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 Massachusetts Ave, Cambridge, MA 02139, USA. Correspondence 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 ===========================================================================*/ /*++++++++++++++++++++++++ STDA.FC +++++++++++++++++++++++++++++++++++++++ .LANGUAGE C .IDENTIFICATION Module STDA.FC .COMMENTS Module contains layer between the descriptor related FORTRAN STxxxx interfaces and the SC_interfaces written in (hopefully independent) C .AUTHOR K. Banse ESO - Garching .KEYWORDS standard interfaces. .ENVIRONMENT FORTRAN and C standards .VERSION [1.00] 871207: created from SXFTOC.C .VERSION [1.80] 871210: add data type option .VERSION [1.90] 880125: take care of base address in 'vmr' .VERSION [2.10] 880208: make sure, that CHARACTER is used only for a single variable .VERSION [2.50] 880401: new version - split up numeric + character stuff ! .VERSION [2.60] 880411: modified new version - the last one .VERSION [3.00] 901213: Master file. CG. 000605 -----------------------------------------------------------------------------*/ #include #include SUBROUTINE STDCOP(from,to,mask,descr,status) fint2c *from; /* IN: no. of source frame */ fint2c *to; /* IN: no. of destination frame */ fint2c *mask; /* IN: copy_mask */ CHARACTER descr; /* IN: name of descr. to copy (if mask = 4) */ fint2c *status; { *status = SCDCOP(*from,*to,*mask,STRIPPED_STRING(descr)); } SUBROUTINE STDFND(no,descr,type,noelem,bytelem,status) fint2c *no; /* IN: no. of data frame */ CHARACTER descr; /* IN: descriptor name */ CHARACTER type; /* OUT: type of descr - I, R, C, D or ' ' */ fint2c *noelem; /* OUT: no. of elements */ fint2c *bytelem; /* OUT: no. of bytes per element */ fint2c *status; { *status = SCDFND(*no,STRIPPED_STRING(descr),CHAR_LOC(type),noelem,bytelem); } SUBROUTINE STDINF(no,npos,field,buf,numbuf,status) fint2c *no; /* IN: no. of data frame */ fint2c *npos; /* IN: position of descriptor, beginning with 1 */ fint2c *field; /* IN: specify info,1 = NAME, 2 = TYPE, 3 = SIZE */ CHARACTER buf; /* IN : buffer for character descriptor info */ fint2c *numbuf; /* IN : return buffer for numerical data */ fint2c *status; { int nn; char tbuf[84]; nn = *field; if (nn != 3) { CGN_FILL(tbuf,' ',80); *status = SCDINF(*no,*npos,*field,tbuf,79,numbuf); for (nn=0; nn<48; nn++) { if (tbuf[nn] == '\0') { tbuf[nn] = ' '; goto copy_it; } if (tbuf[nn] == ' ') goto copy_it; } nn = 47; copy_it: (void) strncpy(CHAR_LOC(buf),tbuf,nn+1); /* have a blank in the end */ } else *status = SCDINF(*no,*npos,3,tbuf,48,numbuf); } SUBROUTINE STDRDX(no,flag,descr,type,bytelm,noelm,hnc,status) fint2c *no; /* IN : no. of data frame */ fint2c *flag; /* IN : action flag */ CHARACTER descr; /* OUT : descriptor name */ CHARACTER type; /* OUT : descriptor type */ fint2c *bytelm; /* OUT : no. of bytes per element */ fint2c *noelm; /* OUT : no. of elements */ fint2c *hnc; /* OUT : no. of help text chars */ fint2c *status; { int nn; char tbuf[60]; CGN_FILL(tbuf,' ',60); *status = SCDRDX(*no,*flag,tbuf,CHAR_LOC(type),bytelm,noelm,hnc); for (nn=0; nn<48; nn++) { if (tbuf[nn] == '\0') { tbuf[nn] = ' '; goto copy_it; } if (tbuf[nn] == ' ') goto copy_it; } copy_it: (void) strncpy(CHAR_LOC(descr),tbuf,nn+1); /* have a blank in the end */ }