C @(#)ftoc_commf.for 17.1.1.1 (ESO-DMD) 01/25/02 17:57:05 C=========================================================================== C Copyright (C) 1995 European Southern Observatory (ESO) C C This program is free software; you can redistribute it and/or C modify it under the terms of the GNU General Public License as C published by the Free Software Foundation; either version 2 of C the License, or (at your option) any later version. C C This program is distributed in the hope that it will be useful, C but WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General Public License for more details. C C You should have received a copy of the GNU General Public C License along with this program; if not, write to the Free C Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, C MA 02139, USA. C C Correspondence concerning ESO-MIDAS should be addressed as follows: C Internet e-mail: midas@eso.org C Postal address: European Southern Observatory C Data Management Division C Karl-Schwarzschild-Strasse 2 C D 85748 Garching bei Muenchen C GERMANY C=========================================================================== C C This FORTRAN code is in the file named "ftoc_commf.for" C and checks our MADRID concept for allocating memory in Fortran C C PROGRAM EXAMPLE C INTEGER MADRID(1) INTEGER VALUE(3) INTEGER*8 PNTR INTEGER STAT,MANY,NOPIX,NOBYT C COMMON/VMR/MADRID C C call a C-function which sets PNTR to an array start address CALL CSUB(PNTR) C VALUE(1)=MADRID(PNTR) VALUE(2)=MADRID(PNTR+1) VALUE(3)=MADRID(PNTR+2) C IF ((MADRID(PNTR).NE.10) .OR. (MADRID(PNTR+1).NE.50) + .OR. (MADRID(PNTR+2).NE.70)) GOTO 1000 C C assume 4 bytes for real data C and allocate space for 400 000 real values in a C-function C NOBYT = 4 NOPIX = 400000 MANY = NOPIX*NOBYT CALL FMAP(MANY,PNTR,STAT) IF (STAT.NE.0) GOTO 1010 C C now try to fill the allocated data with real values C in a Fortran subroutine C CALL RTST(MADRID(PNTR),NOPIX,STAT) IF (STAT.NE.0) GOTO 1020 C CALL FIN(0) C C the following are all exits for failed code C 1000 CALL FIN(1) C 1010 CALL FIN(2) C 1020 CALL FIN(3) C STOP END