C @(#)tdtypchk.for	17.1.1.1 (ES0-DMD) 01/25/02 17:36:45
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 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding 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
C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory,
C                                         all rights reserved
C
C.VERSION: 1.0  ESO-FORTRAN Conversion, AA  19:59 - 11 DEC 1987
C
C.LANGUAGE: F77+ESOext
C
C.AUTHOR: J.D.PONZ
C
C.IDENTIFICATION        TDTYPCHK.FOR
C.KEYWORDS           TABLE, APPLICATIONS
C.ENVIRONMENT  MIDAS
C.PURPOSE
C
C CHECK EXTERNAL DATA TYP AND GENERATE INTERNAL CODE
C MODIFICATION OF GENTYP ROUTINE TO ALLOW FOR TABLE CODES
C
C
C------------------------------------------------------------------
      SUBROUTINE TDTCHK(INTYP,OUTYP,BYTELE)
C
      IMPLICIT NONE
      CHARACTER*(*) INTYP  ! IN : external type (I*4, R*4, R*8, C*N)
      CHARACTER*1 OUTYP    ! OUT: internal type as I, R, R, C or ' ' (invalid)
      INTEGER BYTELE       ! OUT: code -4 real or integer, -8 double, >0 char
C
      INTEGER LL, LL1, LEN, INDEX
      CHARACTER*80 SDUM
C
C ... CHECK FOR LIMITS
C
      LL     = INDEX(INTYP,'*')
      IF (LL.EQ.0) THEN
          BYTELE = 0
          IF (INTYP(1:1).EQ.'C') THEN
              OUTYP  = 'C'
          ELSE
              OUTYP  = ' '
          END IF
          RETURN
      END IF
C
C ... GET LENGTH
C
      SDUM   = INTYP//' '
      OUTYP  = INTYP(1:1)
      LL1    = INDEX(SDUM,' ') - 1
      LEN    = LL1 - LL
      IF (LEN.GT.0) THEN
          READ (INTYP(LL+1:LL1),9000,ERR=10) BYTELE
          IF (OUTYP.EQ.'I' .OR. OUTYP.EQ.'R') THEN
              BYTELE = -BYTELE
          ELSE IF (OUTYP.NE.'C') THEN
              BYTELE = 0
              OUTYP  = ' '
          END IF
      ELSE
          BYTELE = 0
          IF (OUTYP.NE.'C') OUTYP  = ' '
      END IF
      RETURN
   10 BYTELE = 0
      OUTYP  = ' '
      RETURN
C1000 FORMAT(I<LEN>)
 9000 FORMAT (I6)
      END

      SUBROUTINE TDTYP1(ETYPE,DTYPE,NOELEM)
C
C     Transform data type from external (I*4, R*4, R*8, C*n) into
C     internal code
C
      IMPLICIT NONE
      CHARACTER*(*) ETYPE  ! IN : external type 
      INTEGER       DTYPE  ! OUT: data type code
      INTEGER       NOELEM ! OUT: no of elements
C
      INTEGER       LL, INDEX, LL1
      CHARACTER*20  SDUM
C
      INCLUDE       'MID_INCLUDE:TABLES.INC'
      INCLUDE       'MID_INCLUDE:TABLED.INC'
C
      LL     = INDEX(ETYPE,'*')
C
C ... character string
C
      IF (ETYPE(1:1) .EQ. 'C' .OR. ETYPE(1:1) .EQ. 'c') THEN
          DTYPE  = D_C_FORMAT
          SDUM   = ETYPE//' '
          LL1    = INDEX(SDUM,' ') - 1
          READ (SDUM(LL+1:LL1),9000,ERR=10) NOELEM
          RETURN
      ENDIF
      NOELEM = 1                                
      DTYPE  = 0
      IF (ETYPE(1:3).EQ.'I*4'.OR.ETYPE(1:3).EQ.'i*4') 
     .   DTYPE=D_I4_FORMAT
      IF (ETYPE(1:3).EQ.'R*4'.OR.ETYPE(1:3).EQ.'r*4') 
     .   DTYPE=D_R4_FORMAT
      IF (ETYPE(1:3).EQ.'R*8'.OR.ETYPE(1:3).EQ.'r*8') 
     .   DTYPE=D_R8_FORMAT
      RETURN
   10 NOELEM = 0
      RETURN
 9000 FORMAT (I3)
      END

      SUBROUTINE TDTYP2(DTYPE,NOELEM,ETYPE)
C
C     Transform data type from internal into external 
C     (I*4, R*4, R*8, C*n) code
C
      IMPLICIT NONE
      INTEGER       DTYPE  ! IN : data type code
      INTEGER       NOELEM ! IN : no of elements
      CHARACTER*(*) ETYPE  ! OUT: external type 
C
      INCLUDE       'MID_INCLUDE:TABLES.INC'
      INCLUDE       'MID_INCLUDE:TABLED.INC'
C
      IF(DTYPE.EQ.D_I4_FORMAT) ETYPE = 'I*4'
      IF(DTYPE.EQ.D_R4_FORMAT) ETYPE = 'R*4'
      IF(DTYPE.EQ.D_R8_FORMAT) ETYPE = 'R*8'
      IF(DTYPE.EQ.D_C_FORMAT) WRITE(ETYPE,9000,ERR=10) NOELEM
      RETURN
   10 ETYPE = ' '
      RETURN
 9000 FORMAT ('C',I3.3)
      END