* PACKAGE GINTF  !" GTOOL 実数精度変換インターフェース
*
*"  [HIS] 92/06/22(numaguti)
*
******************************************************************
      SUBROUTINE GZDBRD                 !" 精度・格子変換読み込み
     O         ( HHEAD , GDATA , IEOD  ,
     O           IT    , IDATE , ISTEP , ITDUR ,
     I           IFILE , HITSEL, IOMODE          )
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数，波数
      INCLUDE   (ZHDIM)                      !" 文字数
#else
#include        "zcdim.F"                    !" 格子点数，波数
#include        "zhdim.F"                    !" 文字数
#endif
*
*   [OUTPUT] 
      CHARACTER  HHEAD ( * )*(*)             !" ヘッダー
*
#ifdef AUTO_DBL
      REAL * 8   GDATA ( IDIM, JDIM, * )     !" データ
      REAL * 8   GDATAX( * )                 !" データ
#else
      REAL       GDATA ( IDIM, JDIM, * )     !" データ
      REAL       GDATAX( * )                 !" データ
#endif
      INTEGER    IEOD
*
*   [INPUT] 
      INTEGER    IT                          !" 通し時間
      INTEGER    IDATE ( * )                 !" 時刻：年月日時分秒
      INTEGER    ISTEP                       !" 通しステップ数
      INTEGER    ITDUR                       !" 代表時間
      INTEGER    IFILE                       !" 入力ファイル番号
      INTEGER    IOMODE                      !" 入出力モード
      INTEGER    NOEND                       !" ENDFILE間隔
      CHARACTER  HITSEL *(*)                 !" 選択するITEM
*
*   [ENTRY INPUT] 
      INTEGER    JFILE                       !" 出力ファイル番号
      CHARACTER  HDFMT  *(*)                 !" データフォーマット
*
*    [INTERNAL WORK]
      INTEGER    KDIMD
      PARAMETER (KDIMD=KMAX+1)
      REAL * 8   DDATA ( IMAX, JMAX, KDIMD )
      REAL * 4   SDATA ( IMAX, JMAX, KDIMD )
      REAL * 8   DDATAX( IMAX*JMAX*KDIMD )
      REAL * 4   SDATAX( IMAX*JMAX*KDIMD )
      EQUIVALENCE (DDATA,SDATA,DDATAX,SDATAX)
      CHARACTER  HDFMTI  *(NCC)              !" データフォーマット
      INTEGER    I, J, K, KLEVS, ISIZE
*
      INTEGER * 4 IDATEX ( 6 )               !" Sun 対応
      INTEGER     II
*
*
*" << RDFILE : 倍精度/単精度で読み込み >>
*
      CALL GFRDTS
     O            ( HHEAD , DDATA , IEOD  ,
     O              IT    , IDATEX, ISTEP , ITDUR,
     I              'ITEM', HITSEL, -1    ,
     I              IFILE , IOMODE                 )
*
      IF ( IEOD .EQ. 0 ) THEN
*
*" << CNVDBL : 精度変換 >>
*
         CALL GHCGET ( HHEAD, 'DFMT',  HDFMTI )
         CALL GHPGET ( HHEAD, 'AEND3', KLEVS )
*
         DO 1100 K = 1, KLEVS
            IF ( HDFMTI .EQ. 'UR8' ) THEN
               DO 1110 I = 1, IMAX
                  DO 1110 J = 1, JMAX
                     GDATA( I,J,K ) = DDATA( I,J,K )
 1110          CONTINUE
            ELSE
               DO 1120 I = 1, IMAX
                  DO 1120 J = 1, JMAX
                     GDATA( I,J,K ) = SDATA( I,J,K )
*                               equiv DDATA
 1120          CONTINUE
            ENDIF
 1100    CONTINUE
*     
         DO 2100 II = 1, 6
            IDATE( II ) = IDATEX( II )
 2100    CONTINUE
*
      ENDIF
*     
      RETURN
*------------------------------------------------------------------
      ENTRY      GZDBWT              !" 精度・格子変換書き込み
     I         ( HHEAD , GDATA ,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , IOMODE, NOEND , HDFMT   )
*
*
*" << CNVPRC : 精度変換 >>
*
      CALL GHPGET ( HHEAD, 'AEND3', KLEVS )
*
      DO 3100 K = 1, KLEVS
         IF ( HDFMT .EQ. 'UR8' ) THEN
            DO 3110 I = 1, IMAX
               DO 3110 J = 1, JMAX
                  DDATA( I,J,K ) = GDATA( I,J,K )
 3110       CONTINUE
         ELSE
            DO 3120 I = 1, IMAX
               DO 3120 J = 1, JMAX
                  SDATA( I,J,K ) = GDATA( I,J,K )
*                 equiv DDATA
 3120       CONTINUE
         ENDIF
 3100 CONTINUE
*
      DO 4100 II = 1, 6
         IDATEX( II ) = IDATE( II )
 4100 CONTINUE
*
*" << WRFILE : ファイル書き込み >>
*
      CALL GFWTTS
     O            ( HHEAD , DDATA ,
     O              IT    , IDATEX, ISTEP , ITDUR ,
     I              JFILE , IOMODE, NOEND          )
*
      RETURN
*------------------------------------------------------------
      ENTRY      GZDBRX              !" 精度変換読みこみ
     O         ( HHEAD , GDATAX, IEOD  ,
     O           IT    , IDATE , ISTEP , ITDUR ,
     I           IFILE , HITSEL, IOMODE          )
*
*" << RDFILX : 倍精度/単精度で読み込み >>
*
      CALL GFRDTS
     O            ( HHEAD , DDATAX, IEOD  ,
     O              IT    , IDATEX, ISTEP , ITDUR,
     I              'ITEM', HITSEL, -1    ,
     I              IFILE , IOMODE                 )
*
      IF ( IEOD .EQ. 0 ) THEN
*
*" << CNVPRX : 精度変換 >>
*
         CALL GHCGET ( HHEAD, 'DFMT',  HDFMTI )
         CALL GUQTSZ ( HHEAD, ISIZE )
*
         IF ( HDFMTI .EQ. 'UR8' ) THEN
            DO 5110 I = 1, ISIZE
               GDATAX( I ) = DDATAX( I )
 5110       CONTINUE
         ELSE
            DO 5120 I = 1, ISIZE
               GDATAX( I ) = SDATAX( I )
*                      equiv DDATAX
 5120       CONTINUE
         ENDIF
*
         DO 6100 II = 1, 6
            IDATE( II ) = IDATEX( II )
 6100    CONTINUE
*
      ENDIF
*
      RETURN
*------------------------------------------------------------
      ENTRY      GZDBWX              !" 精度変換書き込み
     I         ( HHEAD , GDATAX,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , IOMODE, NOEND , HDFMT   )
*
*
*" << CNVPRX : 精度変換 >>
*
      CALL GUQTSZ ( HHEAD, ISIZE )
*
      IF ( HDFMT .EQ. 'UR8' ) THEN
         DO 7110 I = 1, ISIZE
            DDATAX( I ) = GDATAX( I )
 7110    CONTINUE
      ELSE
         DO 7120 I = 1, ISIZE
            SDATAX( I ) = GDATAX( I )
*           equiv DDATAX
 7120    CONTINUE
      ENDIF
*
      DO 8100 II = 1, 6
         IDATEX( II ) = IDATE( II )
 8100 CONTINUE
*
*" << WRFILX : ファイル書き込み >>
*
      CALL GFWTTS
     O            ( HHEAD , DDATAX,
     O              IT    , IDATEX, ISTEP , ITDUR ,
     I              JFILE , IOMODE, NOEND          )
*
      RETURN
      END
********************************************************************
      SUBROUTINE GZDBCR          !" 実数を左よせで文字列化
     I         ( HFMT  , RVAL  ,
     O           HCHR  , NCHR   )
*
*   [INPUT] 
      CHARACTER  HFMT   *(*)             !" フォーマット
*
#ifdef AUTO_DBL
      REAL*8     RVAL                    !" 実数(単/倍精度)データ
#else
      REAL       RVAL                    !" 実数(単/倍精度)データ
#endif      
*
*   [OUTPUT] 
      CHARACTER  HCHR   *(*)             !" 文字列
      INTEGER    NCHR                    !" 文字列長
*
*   [INTERNAL WORK] 
      REAL * 4   SVAL
*
      SVAL = RVAL
*
      CALL GULCHR               !" 実数(単精度)を左よせで文字列化
     I         ( HFMT  , RVAL  ,
     O           HCHR  , NCHR   )
*
      RETURN
      END
*********************************************************************
      SUBROUTINE GZDBTR    !" 時間単位の変換 HUNIT → HUNITY: 実数
     I         ( KT    , HUNIT  , HUNITY, IDELT  ,
     O           RT                                )
*
*   [INPUT] 
      INTEGER    KT                !" 入力時刻：単位 HUNIT
      CHARACTER  HUNIT *(*)        !" 入力 KT の単位
      CHARACTER  HUNITY*(*)        !" 変換すべき単位
      INTEGER    IDELT             !" １ステップの秒数
*
*   [OUTPUT] 
#ifdef AUTO_DBL
      REAL * 8   RT                !" 出力時刻：単位 HUNITY(単/倍)
#else
      REAL       RT                !" 出力時刻：単位 HUNITY(単/倍)
#endif      
*
*   [INTERNAL WORK] 
      REAL * 4   ST
*
      CALL GUCT2R    !" 時間単位の変換 HUNIT → HUNITY: 単精度
     I         ( KT    , HUNIT  , HUNITY, IDELT  ,
     O           ST                                )
*
      RT = ST
*
      RETURN
      END
***********************************************************************
      SUBROUTINE GZDBHP                 !" 識別記述子のパック
     O         ( HHEAD ,
     I           HDSET , HITEM , IFNUM , IDNUM ,
     I           HTITL , HUNIT ,
     I           ITIME , HDATE , HUTIM , ITDUR ,
     I           HAITM1, IASTR1, IAEND1,
     I           HAITM2, IASTR2, IAEND2,
     I           HAITM3, IASTR3, IAEND3,
     I           HDFMT , VMISS ,
     I           DMIN  , DMAX  , DIVS  , DIVL  , ISTYP ,
     I           HCDATE, HCSIGN                         )
*
*   [OUTPUT] 
      CHARACTER  HHEAD ( * )*(*)
*
*   [INPUT] 
      CHARACTER  HDSET  *(*)             !" データセット名
      CHARACTER  HITEM  *(*)             !" 識別名称
      INTEGER    IFNUM                   !" ファイル番号
      INTEGER    IDNUM                   !" データ番号
      CHARACTER  HTITL  *(*)             !" タイトル
      CHARACTER  HUNIT  *(*)             !" 単位
      INTEGER    ITIME                   !" 時刻(通し)
      CHARACTER  HDATE  *(*)             !" 時刻(yyyymmddhhmmss)
      CHARACTER  HUTIM  *(*)             !" 時刻単位
      INTEGER    ITDUR                   !" 代表する時間
      CHARACTER  HAITM1 *(*)             !" 軸1の格子名称
      INTEGER    IASTR1                  !" 軸1の格子始め
      INTEGER    IAEND1                  !" 軸1の格子終り
      CHARACTER  HAITM2 *(*)             !" 軸2の格子名称
      INTEGER    IASTR2                  !" 軸2の格子始め
      INTEGER    IAEND2                  !" 軸2の格子終り
      CHARACTER  HAITM3 *(*)             !" 軸3の格子名称
      INTEGER    IASTR3                  !" 軸3の格子始め
      INTEGER    IAEND3                  !" 軸3の格子終り
      CHARACTER  HDFMT  *(*)             !" データフォーマット
      INTEGER    ISTYP                   !" スケーリングタイプ
      CHARACTER  HCDATE *(*)             !" データ作成日付
      CHARACTER  HCSIGN *(*)             !" データ作成者
*
#ifdef AUTO_DBL
      REAL * 8   VMISS                   !" 欠損値の値
      REAL * 8   DMIN                    !" レンジ(最小)
      REAL * 8   DMAX                    !" レンジ(最大)
      REAL * 8   DIVS                    !" 間隔(小)
      REAL * 8   DIVL                    !" 間隔(大)
#else
      REAL       VMISS                   !" 欠損値の値
      REAL       DMIN                    !" レンジ(最小)
      REAL       DMAX                    !" レンジ(最大)
      REAL       DIVS                    !" 間隔(小)
      REAL       DIVL                    !" 間隔(大)
#endif      
*        : 単/倍精度
*
*   [INTERNAL WORK] 
      REAL       SVMISS                   !" 欠損値の値
      REAL       SDMIN                    !" レンジ(最小)
      REAL       SDMAX                    !" レンジ(最大)
      REAL       SDIVS                    !" 間隔(小)
      REAL       SDIVL                    !" 間隔(大)
*        : 単精度
*
      SVMISS = VMISS
      SDMIN  = DMIN
      SDMAX  = DMAX
      SDIVS  = DIVS
      SDIVL  = DIVL
*
      CALL       GHPACK         !" 識別記述子のパック
     O         ( HHEAD ,
     I           HDSET , HITEM , IFNUM , IDNUM ,
     I           HTITL , HUNIT ,
     I           ITIME , HDATE , HUTIM , ITDUR ,
     I           HAITM1, IASTR1, IAEND1,
     I           HAITM2, IASTR2, IAEND2,
     I           HAITM3, IASTR3, IAEND3,
     I           HDFMT , SVMISS,
     I           SDMIN , SDMAX , SDIVS , SDIVL , ISTYP ,
     I           HCDATE, HCSIGN                         )
*
      RETURN
      END
***********************************************************************
      SUBROUTINE GZDBAP         !" 格子情報ヘッダーパック
     O         ( HHEADA,
     I           HKIND , HITEM ,
     I           HTITL , HUNIT ,
     I           IXDIM ,
     I           HDFMT , VMISS ,
     I           DMIN  , DMAX  , DIVS  , DIVL  , ISTYP  )
*
      CHARACTER  HHEADA ( * )*(*)        !" ヘッダー
      CHARACTER  HKIND       *(*)        !" 格子情報の種類
      CHARACTER  HITEM       *(*)        !" 格子識別名称
      CHARACTER  HTITL       *(*)        !" 軸タイトル
      CHARACTER  HUNIT       *(*)        !" 単位
      INTEGER    IXDIM                   !" 格子数
      CHARACTER  HDFMT       *(*)        !" データフォーマット
      INTEGER    ISTYP                   !" スケーリングタイプ
*
#ifdef AUTO_DBL
      REAL * 8   VMISS                   !" 欠損値の値
      REAL * 8   DMIN                    !" レンジ(最小)
      REAL * 8   DMAX                    !" レンジ(最大)
      REAL * 8   DIVS                    !" 間隔(小)
      REAL * 8   DIVL                    !" 間隔(大)
#else
      REAL       VMISS                   !" 欠損値の値
      REAL       DMIN                    !" レンジ(最小)
      REAL       DMAX                    !" レンジ(最大)
      REAL       DIVS                    !" 間隔(小)
      REAL       DIVL                    !" 間隔(大)
#endif      
*        : 単/倍精度
*
*   [INTERNAL WORK] 
      REAL       SVMISS                   !" 欠損値の値
      REAL       SDMIN                    !" レンジ(最小)
      REAL       SDMAX                    !" レンジ(最大)
      REAL       SDIVS                    !" 間隔(小)
      REAL       SDIVL                    !" 間隔(大)
*        : 単精度
*
      SVMISS = VMISS
      SDMIN  = DMIN
      SDMAX  = DMAX
      SDIVS  = DIVS
      SDIVL  = DIVL
*
      CALL       GHPACA         !" 格子情報ヘッダーパック
     O         ( HHEADA,
     I           HKIND , HITEM ,
     I           HTITL , HUNIT ,
     I           IXDIM ,
     I           HDFMT , SVMISS,
     I           SDMIN , SDMAX , SDIVS , SDIVL , ISTYP  )
*
      RETURN
      END
*********************************************************************
      SUBROUTINE GZDBGT      !" GTOOL 共通パラメータ（実数）を参照
     I         ( HP,
     O           RPARA )
*
*   [INPUT] 
      CHARACTER HP   *(*)                !" パラメーターの名前
*
*   [OUTPUT] 
#ifdef AUTO_DBL
      REAL * 8  RPARA                    !" 単/倍精度
#else
      REAL      RPARA                    !" 単/倍精度
#endif      

*
*   [INTERNAL WORK] 
      REAL * 4  SPARA                    !" 単精度
*
      CALL      GTPGET       !" GTOOL 共通パラメータ（単精度）を参照
     I         ( HP,
     O           SPARA )
*
      RPARA = SPARA
*
      RETURN
*=======================================================================
      ENTRY GZDBST           !" GTOOL 共通パラメータ（実数）を設定
     I         ( HP, RPARA )
*
      SPARA = RPARA
*
      CALL GTPSET           !" GTOOL 共通パラメータ（単精度）を設定
     I         ( HP, SPARA )
*
      RETURN
      END
