* PACKAGE DHYDR       
*
***********************************************************************
      SUBROUTINE WHYDRO     
     O         ( WDPHI ,
     I           WDT    )
*
*"                 Arakawa & Suarez 鉛直差分 σ座標
*
*   [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  !" 標準物理定数(common)  
*
*"  [HIS]  90/08/31(numaguti)
*
      ReaL*8       ER             !" 地球半径
      ReaL*8       GRAV                        !" 重力加速度
      ReaL*8       CP                          !" 大気定圧比熱
      ReaL*8       RAIR                        !" 大気気体定数
      ReaL*8       EL                          !" 水の凝結の潜熱
      ReaL*8       CPVAP                       !" 水蒸気定圧比熱
      ReaL*8       RVAP                        !" 水蒸気気体定数
      ReaL*8       DH2O                        !" 水の密度
      ReaL*8       EPSV                        !" 水と大気の分子量比ε
      ReaL*8       ES0                         !" ０℃飽和蒸気圧：Ｐａ
      ReaL*8       STB                         !" Stefan-Boltzman
      ReaL*8       FKARM                       !" Karman 定数
      ReaL*8       EPSVT                       !" 1/ε-1
*
      COMMON   /COMCON/
     &          ER    , GRAV  ,
     &          CP    , RAIR  ,
     &          EL    , CPVAP , RVAP  , DH2O  , EPSV  , ES0   ,
     &          STB   , FKARM , EPSVT

*
*   [OUTPUT] 
      ReaL*8       WDPHI ( NMDIM, KMAX )       
      ReaL*8       WDT   ( NMDIM , KMAX     )  
*
*   [INPUT] 
      ReaL*8       GDPHI ( IDIM*JDIM, KMAX )   
      ReaL*8       GDT   ( IDIM*JDIM, KMAX )   
*
      ReaL*8       SALPHA( KMAX )              
      ReaL*8       SBETA ( KMAX )              
*
*   [ENTRY INPUT] 
      ReaL*8       SIG   ( KMAX )              
      ReaL*8       SIGM  ( KMAX+1 )            
*
*   [INTERNAL SAVE] 
      ReaL*8       SALPHZ( KMAX )              
      ReaL*8       SBETZ ( KMAX )              
      LOGICAL    OSET                        
      DATA       OSET / .FALSE. /
      SAVE       SALPHZ , SBETZ, OSET
*   [INTERNAL WORK] 
      INTEGER    IJ, K, NM
      ReaL*8       AKAPPA
*
      IF ( .NOT. OSET ) THEN
         CALL MSGDMP( 'E','WHYDRO','CONSTANTS ARE NOT SET.')
      ENDIF
*
*"         < 1. スペクトル空間での積み上げ >
*
      DO 1100 NM = 1, NMDIM
            WDPHI ( NM,1 ) = CP * SALPHZ( 1 ) * WDT ( NM,1 )
 1100 CONTINUE
*
      DO 1200 K = 2, KMAX
         DO 1200 NM = 1, NMDIM
            WDPHI ( NM,K ) = WDPHI( NM,K-1 )
     &                          + CP * SALPHZ( K   ) * WDT ( NM,K   )
     &                          + CP * SBETZ ( K-1 ) * WDT ( NM,K-1 )
 1200 CONTINUE
*
      RETURN
*======================================================================
      ENTRY      GHYDRO     
     O         ( GDPHI ,
     I           GDT     )
*
      IF ( .NOT. OSET ) THEN
         CALL MSGDMP( 'E','GHYDRO','CONSTANTS ARE NOT SET.')
      ENDIF
*
*"         < 2. 格子空間での積み上げ >
*
      DO 2100 IJ = 1, IDIM*JDIM
            GDPHI ( IJ,1 ) = CP * SALPHZ( 1   ) * GDT ( IJ,1 )
 2100 CONTINUE
*
      DO 2200 K = 2, KMAX
         DO 2200 IJ = 1, IDIM*JDIM
            GDPHI ( IJ,K ) = GDPHI( IJ,K-1 )
     &                     + CP * SALPHZ( K   ) * GDT ( IJ,K   )
     &                     + CP * SBETZ ( K-1 ) * GDT ( IJ,K-1 )
 2200 CONTINUE
*
      RETURN
*======================================================================
      ENTRY      HYDROS         
     I         ( SIG   , SIGM  )
*
      AKAPPA = RAIR / CP
      DO 3100 K = 1, KMAX
         SALPHZ( K ) =        ( SIGM( K   )/SIG ( K ) )**AKAPPA - 1.  
         SBETZ ( K ) = 1.   - ( SIGM( K+1 )/SIG ( K ) )**AKAPPA
 3100 CONTINUE
*
      OSET = .TRUE.
*
      RETURN
*===================================================================
      ENTRY      HYDROQ       
     O         ( SALPHA, SBETA )
*
      CALL COPY ( SALPHA, SALPHZ, KMAX )
      CALL COPY ( SBETA , SBETZ , KMAX )
*
      RETURN
      END
