* PACKAGE GTINT1   !" int 1 ->gtool3
************************************************************************
      PROGRAM GTINT1
*
#ifdef SYS_IBMS
      INCLUDE    (GTSINC)
      INCLUDE    (GZSIZE)
#else
#include         "gtsinc.F"
#include         "gzsize.F"
#endif
      COMMON     /GMWORK/ MWORK
      REAL       MWORK  ( IJKDIM )
*
      CHARACTER  HHEAD ( NDC )*(NCC)
      REAL       GDATA ( IJKDIM )
      CHARACTER  HFNAME *(NCC)
*
      CHARACTER  HFILE( 1 )        *(NFILN)
      DATA       HFILE / '-' /
      DATA       IFILE / 50 /
      DATA       JFILE / 60 /
      CHARACTER  OUT    *(NFILN)
      DATA       OUT    / '$GTTMPDIR/gtool.out' /
      LOGICAL    APND
      DATA       APND   / .FALSE. /
      REAL       FACT
      DATA       FACT / 1. /
      LOGICAL    HELP
      DATA       HELP  / .FALSE. /
*
      NAMELIST  /OPTION/ OUT, APND, FACT, HFILE, HELP
*
      CALL OPTARG ( 91, 'OPTION', 'HFILE', NOPT, NFILE )
      READ (91,OPTION,IOSTAT=IOS)
      CLOSE(91)
      IF ( IOS.NE.0 .OR. HELP ) THEN
         WRITE(6,OPTION)
         STOP
      ENDIF
*
      CALL GTOPEN
      CALL GTSIZE ( HHEAD , IJKDIM )
      CALL GMSIZE ( IJKDIM  )
      CALL GHPCLR ( HHEAD )
*
      CALL GURNTF ( HFILE( 1 ), OUT  , '$GTTMPDIR/gtool.txt' )
*
      IF ( HFILE(1) .EQ. '-' ) THEN
         IFILE = 5
      ELSE
         OPEN ( IFILE, FILE=HFILE(1), 
     &          ACCESS='SEQUENTIAL',FORM='FORMATTED' )
      ENDIF
      CALL GFOOPN ( JFILE, OUT , APND )
*
      II = 0
 1100 CONTINUE
         II = II + 1
*
         CALL RDTXTH
     I            ( IFILE ,
     M              HHEAD ,
     O              IEOD  )
*
         IF ( IEOD .EQ. 0 ) THEN
            CALL GUQSIZ 
     I         ( HHEAD ,
     O           IXSTR , IXEND , IXDIM ,
     O           IYSTR , IYEND , IYDIM ,
     O           IZSTR , IZEND , IZDIM  )
*     
            CALL GHCGET ( HHEAD, 'ETTL1', HFNAME )
*         
            CALL RDINT1
     O         ( GDATA ,
     I           IXDIM , IYDIM , IZDIM  ,
     I           HFNAME                   )
*
           IF ( FACT .NE. 1.0 ) THEN
              CALL GMFFCT
     I        ( HHEAD , GDATA , FACT  ,
     I          '  '  , '  '           )
           ENDIF
*     
            CALL GFWRIT
     I         ( HHEAD , GDATA ,
     I           JFILE , 1     , 0       )
*
            GOTO 1100            
         ENDIF
*
 1900 CONTINUE
*
      STOP
      END
***********************************************************************
      SUBROUTINE RDTXTH
     I         ( IFILE ,
     M           HHEAD ,
     O           IEOD  )
*
      CHARACTER  HHEAD ( * )*(*)
*
      
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)
#else
#include         "gzsize.F"
#endif
      PARAMETER (NBUF=255)
      CHARACTER  HBUF*(NBUF), HXX*(NBUF)
      CHARACTER  HP*(NCC), HX*(NCC)
      CHARACTER  HFMT*(NCC)
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
      LOGICAL    LCHRN
*
  100 CONTINUE 
      READ ( IFILE,'(A)',IOSTAT=IEOS ) HBUF
      IF ( IEOS .NE. 0 ) THEN
         IEOD = 1
         RETURN
      ENDIF
      IF ( HBUF(1:1) .EQ. '#' ) THEN
         GOTO 100
      ENDIF
*
      IDX = 0
*
 1100 CONTINUE
*
         IL   = LENB(HBUF)
         LENH = LEN(HBUF)
         IF ( .NOT.LCHRN(HBUF(IL+1:IL+1)) ) THEN
*
            IC = INDEX(HBUF,':')
            IF ( IC.GT.IL .AND. IC.LT.LENH ) THEN
               HP  = HBUF(IL+1:IC-1)
               ILX = LENB(HBUF(IC+1:LENH))+IC
               HXX = HBUF(ILX+1:LENH)
               HX  = HXX
               IF ( HP .EQ. 'TITLE' ) THEN
                  CALL GHCSTS(HHEAD,'TITL',HXX)
               ELSE IF ( HP .NE. 'SIZE' ) THEN
                  CALL GHPINQ(HP,HFMT)
                  IF ( HFMT .NE. '(A)' ) THEN
                     CALL CRADJ(HX)
                  ENDIF
                  CALL GHCSET(HHEAD,HP,HX)
               ENDIF
            ENDIF
*
 1200       CONTINUE 
               READ ( IFILE,'(A)',END=9000 ) HBUF
            IF ( HBUF(1:1) .EQ. '#' ) THEN
               GOTO 1200
            ENDIF
*
      GOTO 1100
         ENDIF
*
 9000 CONTINUE 
*
      CALL GUQTSZ( HHEAD,ISIZE )
      CALL GHPSET( HHEAD, 'SIZE', ISIZE )
      IEOD = 0
*
      RETURN
      END
********************************************************************
      LOGICAL FUNCTION   LCHRN(C)
      CHARACTER  C
      LOGICAL    LCHRD
*
      LCHRN = LCHRD(C) .OR. (C.EQ.'-') .OR. (C.EQ.'.')
*
      RETURN
      END
********************************************************************
      SUBROUTINE RDINT1
     O         ( GDATA ,
     I           NLO   , NLA   , KDIM  ,
     I           HFNAME                   )
*
      PARAMETER   (NLOMX=1025)
      CHARACTER    HDATA(NLOMX)
      REAL         GDATA(NLO,NLA)
      CHARACTER    HFNAME *(*)
*
      IF ( NLO .GT. NLOMX ) CALL MSGDMP('E','RDINT2','NLO TOO LARGE')
*
      OPEN (UNIT=1,FILE=HFNAME,STATUS='OLD',
     &      ACCESS='DIRECT',FORM='UNFORMATTED',RECL=NLO)
*
      DO 1000 K = 1, KDIM
         DO 1000 LA = 1, NLA
            READ(1,REC=LA) (HDATA(LO),LO=1,NLO)
            DO 800 LO = 1, NLO
               GDATA(LO,LA) = ICHAR(HDATA(LO))
  800       CONTINUE
 1000 CONTINUE
*
      RETURN
      END