* PACKAGE GINTF  
*
*"  [HIS] 1992/06/22(numaguti)
*"        2000/11/24(Takehiro)
*"        2001/12/10(Ishiwatari)
*
******************************************************************
      SUBROUTINE GZDBRD                 
     O         ( HHEAD , GDATA , IEOD  ,
     O           IT    , IDATE , ISTEP , ITDUR ,
     I           IFILE , HITSEL, IOMODE          )
*
*   [PARAM] 





* PACKAGE  ZXT10L32 !" 格子点数，波数 X-Z
*
      INTEGER     IMAX           !" 経度格子数
      INTEGER     JMAX           !" 緯度格子数
      INTEGER     IDIM           !" 経度配列サイズ
      INTEGER     JDIM           !" 緯度配列サイズ
      INTEGER     MMAX           !" 最大東西波数
      INTEGER     LMAX           !" 最大南北波数
      INTEGER     NMAX           !" 最大全波数
      INTEGER     MINT           !" 東西波数間隔
      INTEGER     KMAX           !" 鉛直層数
      INTEGER     KDIM           !" 鉛直配列サイズ
      INTEGER     NMDIM          !" 水平波数成分数
      INTEGER     JMXHF          !" JMAX/2+1
      INTEGER     NWORK          !" ワーク領域大きさ
*
      PARAMETER ( IMAX  = 32,     JMAX =  1,
     &            IDIM  = IMAX+1, JDIM = JMAX,
     &            MMAX  = 10,     LMAX =  0,    NMAX = MMAX, MINT = 1,
     &            KMAX  = 32,     KDIM = KMAX,
     &            NMDIM = (MMAX/MINT+1)*(2*(NMAX+1)-MMAX)
     &                  - (NMAX-LMAX)/MINT*(NMAX-LMAX+1),
     &            JMXHF = JMAX/2+1,
     &            NWORK = IDIM*JDIM*KMAX*12                       )

* PACKAGE ZHDIM  !" 文字列文字数 
*
*"  [HIS]  90/08/31(numaguti)
*
      INTEGER     NCC
      INTEGER     NDC
      INTEGER     NFILN
*
      PARAMETER ( NCC   = 16, NDC   = 64 ,
     &            NFILN = 38              )

*
*   [OUTPUT] 
      CHARACTER  HHEAD ( * )*(*)             
*

      ReaL * 8   GDATA ( IDIM, JDIM, * )     
      ReaL * 8   GDATAX( * )                 




      INTEGER    IEOD
*
*   [INPUT] 
      INTEGER    IT                          
      INTEGER    IDATE ( * )                 
      INTEGER    ISTEP                       
      INTEGER    ITDUR                       
      INTEGER    IFILE                       
      INTEGER    IOMODE                      
      INTEGER    NOEND                       
      CHARACTER  HITSEL *(*)                 
*
*   [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 )               
      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
     I            ( HHEAD , DDATA ,
     I              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
     I            ( HHEAD , DDATAX,
     I              IT    , IDATEX, ISTEP , ITDUR ,
     I              JFILE , IOMODE, NOEND          )
*
      RETURN
      END
********************************************************************
      SUBROUTINE GZDBCR          
     I         ( HFMT  , RVAL  ,
     O           HCHR  , NCHR   )
*
*   [INPUT] 
      CHARACTER  HFMT   *(*)             
*

      ReaL*8     RVAL                    



*
*   [OUTPUT] 
      CHARACTER  HCHR   *(*)             
      INTEGER    NCHR                    
*
*   [INTERNAL WORK] 
      ReaL * 4   SVAL
*
      SVAL = RVAL
*
      CALL GULCHR               
     I         ( HFMT  , SVAL  ,
     O           HCHR  , NCHR   )
*"                 debugged by Takehiro (2000/11/24) RVAL -> SVAL
*
      RETURN
      END
*********************************************************************
      SUBROUTINE GZDBTR    
     I         ( KT    , HUNIT  , HUNITY, IDELT  ,
     O           RT                                )
*
*   [INPUT] 
      INTEGER    KT                
      CHARACTER  HUNIT *(*)        
      CHARACTER  HUNITY*(*)        
      INTEGER    IDELT             
*
*   [OUTPUT] 

      ReaL * 8   RT                



*
*   [INTERNAL WORK] 
      ReaL * 4   ST
*
      CALL GUCT2R    
     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  *(*)             
      CHARACTER  HUTIM  *(*)             
      INTEGER    ITDUR                   
      CHARACTER  HAITM1 *(*)             
      INTEGER    IASTR1                  
      INTEGER    IAEND1                  
      CHARACTER  HAITM2 *(*)             
      INTEGER    IASTR2                  
      INTEGER    IAEND2                  
      CHARACTER  HAITM3 *(*)             
      INTEGER    IASTR3                  
      INTEGER    IAEND3                  
      CHARACTER  HDFMT  *(*)             
      INTEGER    ISTYP                   
      CHARACTER  HCDATE *(*)             
      CHARACTER  HCSIGN *(*)             
*

      ReaL * 8   VMISS                   
      ReaL * 8   DMIN                    
      ReaL * 8   DMAX                    
      ReaL * 8   DIVS                    
      ReaL * 8   DIVL                    







* 
*    gtool のための単精度変数
*
*   [INTERNAL WORK] 
      ReaL*4     SVMISS                   
      ReaL*4     SDMIN                    
      ReaL*4     SDMAX                    
      ReaL*4     SDIVS                    
      ReaL*4     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                   
*

      ReaL * 8   VMISS                   
      ReaL * 8   DMIN                    
      ReaL * 8   DMAX                    
      ReaL * 8   DIVS                    
      ReaL * 8   DIVL                    







*        : 単/倍精度
*
*   [INTERNAL WORK] 
      ReaL * 4    SVMISS                   
      ReaL * 4    SDMIN                    
      ReaL * 4    SDMAX                    
      ReaL * 4    SDIVS                    
      ReaL * 4    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      
     I         ( HP,
     O           RPARA )
*
*   [INPUT] 
      CHARACTER HP   *(*)                
*
*   [OUTPUT] 

      ReaL * 8  RPARA                    




*
*   [INTERNAL WORK] 
      ReaL * 4  SPARA                    
*
      CALL      GTPGET       
     I         ( HP,
     O           SPARA )
*
      RPARA = SPARA
*
      RETURN
*=======================================================================
      ENTRY GZDBST           
     I         ( HP, RPARA )
*
      SPARA = RPARA
*
      CALL GTPSET           
     I         ( HP, SPARA )
*
      RETURN
      END
