*"表題 ファイル読み込み GTOOL3(GFREAD)
*
*"履歴 90/08/15 沼口  敦
*"     92/06/18 沼口  敦               倍精度対応
*"     93/08/13 堀之内 武, 保坂 征宏   GFRDSL のバグフィックス
*"     96/09/03 竹広真一               GFREAD の倍精度対応
*"     97/02/04 竹広真一               GFREAD の倍精度対応ヘッダー変更
*"     97/02/14 竹広真一               GFREDZ を単/倍精度に分ける
*"     99/12/02 竹広真一               メッセージ出力番号を DCL より取得
*
**********************************************************************
*"      <<  GTOOL3標準フォーマットデータ読み込み >>
**********************************************************************
      SUBROUTINE GFREAD
     O         ( HHEAD , GDATA , IEOD  ,
     I           IFILE , MODE           )
*
#ifdef SYS_IBMS
      INCLUDE    (GTSINC)
      INCLUDE    (GZSIZE)
#else
#include         "gtsinc.F"
#include         "gzsize.F"
#endif
*
      CHARACTER  HHEAD ( * )*(*)         !" ヘッダー
      REAL       GDATA ( * )             !" データ
      INTEGER    IEOD                    !" データ存在フラグ
      INTEGER    IFILE                   !" 装置番号
      INTEGER    MODE                    !" モード(1なら表示ON)
*
      CHARACTER  HDFMTI  *(NCC)              !" データフォーマット
*
      REAL * 8   DDATA ( IJKDIM )
      REAL * 4   SDATA ( IJKDIM )
      EQUIVALENCE (DDATA,SDATA)
*
      INTEGER    IUNIT
*
      CALL GLIGET( 'MSGUNIT', IUNIT )
*
      CALL       GFRDSL
     O         ( HHEAD , DDATA , IEOD  ,
     I           '###' , '###' , -1    ,
     I           IFILE , MODE           )
*
      IF ( IEOD .EQ. 0 ) THEN
*
*" << CNVDBL : 精度変換 >>
*
         CALL GHCGET ( HHEAD, 'DFMT',  HDFMTI )
         CALL GUQTSZ ( HHEAD, IJKSIZ )
*
         IF ( HDFMTI .EQ. 'UR8' ) THEN
            DO 1110 IJK = 1, IJKSIZ
                  GDATA( IJK ) = DDATA( IJK )
 1110       CONTINUE
            CALL MSGDMP('W','GFREAD','PRECISION MODIFIED INTO UR4')
            CALL GHCSET( HHEAD, 'DFMT', 'UR4' )
         ELSE
            DO 1120 IJK = 1, IJKSIZ
                  GDATA( IJK ) = SDATA( IJK )
*                            equiv DDATA
 1120       CONTINUE
         ENDIF
      ENDIF

      RETURN
      END
**********************************************************************
*"      <<  GTOOL3標準フォーマットデータ読み込み: 限定つき
**********************************************************************
      SUBROUTINE GFRDSL
     O         ( HHEAD , GDATA , IEOD  ,
     I           HPSEL , HSEL  , ISEL  ,
     I           IFILE , MODE           )
*
      CHARACTER  HHEAD ( * )*(*)         !" ヘッダー
      REAL       GDATA ( * )             !" データ
      INTEGER    IEOD                    !" データ存在フラグ
      CHARACTER  HPSEL *(*)              !" 選択する欄
      CHARACTER  HSEL  *(*)              !" 選択するデータ(文字)
*"   (INTEGER)   ISEL                    ! 選択するデータ(数)
      INTEGER    IFILE                   !" ファイル番号
      INTEGER    MODE                    !" モード(1なら表示ON)
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
#else
#include         "gzsize.F"              !" NCC, NDC
#endif
      CHARACTER  HITEM *(NCC)
      INTEGER    ITIME
      CHARACTER  HX    *(NCC)
      CHARACTER  HFMT  *(NCC)
      CHARACTER  HDFMT *(NCC)
*"   (INTEGER)   IX                       !" 堀之内 93/08/13   
      INTEGER    ISTR  , IEND  , JSTR  , JEND  , KSTR  , KEND
*
      INTEGER    IUNIT
      REAL       VMISS                    !" 欠損値
      INTEGER    ISDEF
      DATA       ISDEF / -1 /
*
*"         < 1. ファイルの番号 FTXXF0YY の配列 >
*
      INTEGER   NFIN( 99 )
      LOGICAL   OFIRST
      DATA      OFIRST / .TRUE. /
      SAVE      NFIN, OFIRST, IUNIT
*
      IF (OFIRST) THEN
         OFIRST=.FALSE.
         DO 1100 JF = 1, 99
            NFIN (JF) = 1
 1100    CONTINUE
         CALL GLIGET( 'MSGUNIT', IUNIT )
      ENDIF
*
      IEOD  = 0
      IEOF  = 0
      IOS   = 0
*
      IF (  ( IFILE.LT.1 ).OR.( IFILE.GT.99 )  ) THEN
        IEOD = 1
        RETURN
      ENDIF
*
 2100 CONTINUE
*"                                       <------< LOOP <-------<
*"         < 2. ヘッダーを読む >
*
         READ ( IFILE,IOSTAT=IOS ) ( HHEAD( II ), II=1, NDC-1 )
*
         IF ( IOS.EQ.0 ) THEN
*
            IEOF  = 0
*
            IF ( HPSEL .NE. '###' ) THEN
               CALL GHPINQ ( HPSEL , HFMT  )
               IF ( HFMT(2:2) .NE. 'A' ) THEN
                  CALL GHPGET ( HHEAD , HPSEL , IX    )
               ELSE
                  IX = ISDEF              !" 堀之内 93/08/13   
               ENDIF
               CALL GHCGET ( HHEAD , HPSEL , HX    )
            ELSE
               IX = ISDEF                 !" 堀之内 93/08/13   
               HX = '###'
            ENDIF
*
            IF (    ( HSEL .EQ. HX   )
     &          .OR.( (HFMT(2:2).NE.'A').AND.( ISEL .EQ. IX ) )
     &          .OR.( (HSEL .EQ. '###').AND.(ISEL .EQ. ISDEF) )
     &          .OR.( HPSEL .EQ. '###' )                         ) THEN
*
*"             < 3. 大きさ >
*
               CALL GUQSIZ
     I            ( HHEAD ,
     O              ISTR  , IEND  , IDIM ,
     O              JSTR  , JEND  , JDIM ,
     O              KSTR  , KEND  , KDIM   )
*
*"             < 4. データ読み込み >
*
               IF      ( MODE .GE. 1 )   THEN
                  CALL GHCGET ( HHEAD, 'ITEM', HITEM )
                  CALL GHPGET ( HHEAD, 'TIME', ITIME )
                  WRITE (IUNIT,*) '** READ ',HITEM, ' T = ',ITIME
               ENDIF
*
               CALL GHPGET ( HHEAD, 'MISS'  , VMISS )
               CALL RSET0  ( GDATA, IDIM*JDIM*KDIM, 1, VMISS )
*
               CALL GHCGET ( HHEAD, 'DFMT', HDFMT )
               IF ( HDFMT .EQ. 'UR8' ) THEN
                  CALL GUSZCK ( HHEAD, IDIM*JDIM*KDIM*2  )
                  CALL GFRDZD             !" 倍精度読み込み
     O            ( GDATA , IEOD  ,
     I              IFILE , IDIM*JDIM*KDIM )
               ELSE
                  CALL GUSZCK ( HHEAD, IDIM*JDIM*KDIM  )
                  CALL GFRDZR             !" 単精度読み込み
     O            ( GDATA , IEOD  ,
     I              IFILE , IDIM*JDIM*KDIM )
               ENDIF
*
            ELSE
*
*"             < 5. 読みとばし >
*
               IF      ( MODE .EQ. 1 )   THEN
                  CALL GHCGET ( HHEAD, 'ITEM', HITEM )
                  CALL GHPGET ( HHEAD, 'TIME', ITIME )
                  WRITE (IUNIT,*) '** SKIP ',HITEM, ' T = ',ITIME
               ENDIF
*
               READ ( IFILE )
               GOTO 2100
*"                                >------> 次のデータ >------>
            ENDIF
*
*"         < 6. ファイルの終りの処理 >
*
         ELSE IF ( IEOF .NE. 0 ) THEN
*
            IEOD  = 1
            RETURN
*"                                /////// end of data //////
         ELSE
*
            IEOF = 1
            WRITE (IUNIT,6100) IFILE, NFIN( IFILE )
 6100       FORMAT ('#### END OF INPUT FILE FT', I2.2, 'F', I3.3 )
*
            NFIN( IFILE ) = NFIN( IFILE ) + 1
            GOTO 2100
*"                                >------> 次のファイル >------>
         ENDIF
*
      RETURN
*=====================================================================
*"      <<  GTOOL3標準フォーマットヘッダー読み込み >>
*=====================================================================
      ENTRY      GFRDHD
     O         ( HHEAD , IEOD  ,
     I           IFILE , MODE   )
*
*"         < 7. ファイルの番号 FTXXF0YY の配列 >
*
      IF (OFIRST) THEN
         OFIRST=.FALSE.
         DO 7100 JF = 1, 99
            NFIN (JF) = 1
 7100    CONTINUE
         CALL GLIGET( 'MSGUNIT', IUNIT )
      ENDIF
*
      IEOD  = 0
      IEOF  = 0
      IOS   = 0
*
      IF (  ( IFILE.LT.1 ).OR.( IFILE.GT.99 )  ) THEN
        IEOD = 1
        RETURN
      ENDIF
*
 8100 CONTINUE
*"                                       <------< LOOP <-------<
*"         < 8. ヘッダーを読む >
*
         READ ( IFILE,IOSTAT=IOS ) ( HHEAD( II ), II=1, NDC-1 )
*
         IF ( IOS.EQ.0 ) THEN
*
            IEOF  = 0
*
               IF      ( MODE .EQ. 1 )   THEN
                  CALL GHCGET ( HHEAD, 'ITEM', HITEM )
                  CALL GHPGET ( HHEAD, 'TIME', ITIME )
                  WRITE (IUNIT,*) '******* ',HITEM, ' T = ',ITIME
               ENDIF
*
               READ ( IFILE )
*
         ELSE IF ( IEOF .NE. 0 ) THEN
*
            IEOD  = 1
            RETURN
*"                                /////// end of data //////
         ELSE
*
            IEOF = 1
            WRITE (IUNIT,9600) IFILE, NFIN( IFILE )
 9600       FORMAT ('#### END OF INPUT FILE FT', I2.2, 'F', I3.3 )
*
            NFIN( IFILE ) = NFIN( IFILE ) + 1
            GOTO 8100
*"                                >------> 次のファイル >------>
         ENDIF
*
      RETURN
      END
************************************************************************
*"         << データ読み込み >>
************************************************************************
      SUBROUTINE GFRDZR                        !" 単精度データ
     O         ( GDATA , IEOD  ,
     I           IFILE , IJKDIM )
*
      REAL       GDATA ( IJKDIM )              !" データ
      INTEGER    IFILE                         !" ファイル番号
*
      READ  ( IFILE, END=9000 ) GDATA
      RETURN
*
 9000 CONTINUE
      CALL MSGDMP( 'W', 'GFRDZR', 'UNEXPECTED EOF' )
      IEOD = 1
*
      END
************************************************************************
      SUBROUTINE GFRDZD                        !" 倍精度データ
     O         ( GDATA , IEOD  ,
     I           IFILE , IJKDIM )
*
      REAL*8     GDATA ( IJKDIM )              !" データ
      INTEGER    IFILE                         !" ファイル番号
*
      READ  ( IFILE, END=9000 ) GDATA
      RETURN
*
 9000 CONTINUE
      CALL MSGDMP( 'W', 'GFRDZD', 'UNEXPECTED EOF' )
      IEOD = 1
*
      END
