#define vmr vmr_ /* parameter for Name Translation is l_ */ #define ROUTINE int /* @(#)ftoc_test.fc 17.1.1.1 (ES0-DMD) 01/25/02 17:57:06 */ /*=========================================================================== 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 ftoc_test.cf .LANGUAGE C .AUTHOR Francois Ochsenbein .ENVIRONMENT Any .KEYWORDS Fortran to C interface .VERSION 1.0 16-Oct-1990 .COMMENTS This subroutine is called from fortest.f ---------------*/ #include #ifndef VOIDSIG #define VOIDSIG void #endif /*========================================================================== * We just define here exception routines, in case this fails... *==========================================================================*/ #include #ifndef NSIG #define NSIG 32 #endif static VOIDSIG exception(s) int s; { char msg[80]; sprintf(msg, "**** Error (%d)\n", s); osdwrite (2, msg, strlen(msg)); ospexit(1); } /*==========================================================================*/ #if 0 /* ==== Original Code ==== */ SUBROUTINE SSP(s1, n1, s2, n2, n3, s3) /*++++++++++++++++ .PURPOSE Check Fortran to C Interface .RETURNS 0 (All OK) / -1 (Error) -----------------*/ CHARACTER s1; /* String*81 */ CHARACTER s2; /* String*162*/ CHARACTER s3; /* String*3 */ INT n1; /* -1 */ INT n2; /* -2 */ INT n3; /* 3 */ #else /* ==== Generated Code === */ #define SSP ssp_ SSP(va_alist) va_dcl { va_list Cargs; #endif /* ======================= */ int FORmark; /* */ static char Cs1[] = "s1<01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ>"; static char Cs2[] = "s2<01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ>"; static char Cs3[] = "s3."; int k, stat; va_start(Cargs); /* */ FORmark = ftoc_mark(); /* */ for (k = 1; k <= NSIG; k++) signal (k, exception); stat = 0; /* Check the Length */ if (CHAR_LEN(1,6,0) != 81) stat += 1; if (CHAR_LEN(3,6,1) != 162) stat += 2; if (CHAR_LEN(6,6,2) != (3)) stat += 4; if (stat) { puts("**** String length not recognized ****"); ospexit(1); } /* Check Numbers */ if (*PARAM(2,6,1,int *) != (-1)) stat |= 0x100; if (*PARAM(4,6,2,int *) != (-2)) stat |= 0x200; if (*PARAM(5,6,2,int *) != (3)) stat |= 0x400; if (stat) { puts("**** Order of parameters modified ****"); ospexit(1); } /* Check Strings */ if (strcmp(STRIPPED_STRING(1,6,0), Cs1)) stat |= 0x10; if (strcmp(STRIPPED_STRING(3,6,1), Cs2)) stat |= 0x20; if (strcmp(STRIPPED_STRING(6,6,2), Cs3)) stat |= 0x40; if (stat) { puts("**** String(s) not recognized ****"); ospexit(1); } ftoc_free(FORmark); /* */return (stat); }