C @(#)tdmemory.for	17.1.1.1 (ESO-DMD) 01/25/02 17:47:15
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++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory,
C                                         all rights reserved
C
C.VERSION: 1.0  ESO-FORTRAN Conversion, AA  19:55 - 11 DEC 1987
C
C.LANGUAGE: F77+ESOext
C
C.AUTHOR: J.D.PONZ
C.IDENTIFICATION        TDMEMORY.FOR
C.KEYWORDS           TABLE, APPLICATIONS
C.ENVIRONMENT  MIDAS
C.PURPOSE
C   Map and unmap virtual memory from FORTRAN.
C   It uses STFMAP temporarily.
C
C  010621               last modif
C
C------------------------------------------------------------------
C 
      SUBROUTINE TDMGET(SIZE,IPOINT,ISTAT)
C
C    get virtual memory (system dependent)
C
      IMPLICIT NONE
C
      INTEGER SIZE,ISTAT
      INTEGER PSIZE,IAC,IND,FID(16)
C
      INTEGER*8  IPOINT
      INTEGER*8  MADDR(16)
C 
      CHARACTER*8  NAME(16)
C 
      INCLUDE 'MID_INCLUDE:ST_DEF.INC'
C
      COMMON/TVM1/ IND,FID
      COMMON/TVM2/ MADDR
C
      INCLUDE 'MID_INCLUDE:ST_DAT.INC'
      DATA   IND  /0/               !initial value
      DATA NAME/'VMDUMM01','VMDUMM02','VMDUMM03','VMDUMM04',
     -          'VMDUMM05','VMDUMM06','VMDUMM07','VMDUMM08',
     -          'VMDUMM09','VMDUMM10','VMDUMM11','VMDUMM12',
     -          'VMDUMM13','VMDUMM14','VMDUMM15','VMDUMM16'/
C
      IF (IND.LT.16) THEN
        IND = IND + 1
      ELSE
        IND = 1
      ENDIF
      PSIZE = SIZE/4
      CALL STFCRE(NAME(IND),D_R4_FORMAT,F_X_MODE,
     +            1,PSIZE,FID(IND),ISTAT)
      CALL STFMAP(FID(IND),F_X_MODE,1,PSIZE,IAC,IPOINT,ISTAT)
      MADDR(IND) = IPOINT
      RETURN
      END

      SUBROUTINE TDMFRE(SIZE,IPOINT,ISTAT)
C
C     free virtual memory
C 
      IMPLICIT NONE
C
      INTEGER SIZE,ISTAT
      INTEGER I,IND,FID(16)
C
      INTEGER*8  IPOINT
      INTEGER*8  MADDR(16)
C
      COMMON/TVM1/ IND,FID
      COMMON/TVM2/ MADDR
C
C 
      DO 10, I=1,16
         IF (IPOINT.EQ.MADDR(I)) GOTO 20
10    CONTINUE
      ISTAT  = 1
      RETURN
C 
20    CALL STFCLO(FID(I),ISTAT)
      MADDR(I) = -1
      RETURN
      END