* PACKAGE P2KUOC  
*
**********************************************************************
      SUBROUTINE CUMADJ        
     M         ( GDT   , GDQ   ,
     M           GQPR  , GQCNV , GSCNV ,
     I           GDP   , GDPM  , GDZ   , DELTA  )
*





* 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

*
*   [MODIFY] 
      ReaL*8       GDT   ( IDIM*JDIM, KMAX )   !' 温度  Ｔ
      ReaL*8       GDQ   ( IDIM*JDIM, KMAX )   !' 比湿  ｑ
      ReaL*8       GQPR  ( IDIM*JDIM       )   !' 降水量
      ReaL*8       GQCNV ( IDIM*JDIM, KMAX )   !' 凝結調節加熱率
      ReaL*8       GSCNV ( IDIM*JDIM, KMAX )   !' 凝結調節比湿変化
*
*   [INPUT] 
      ReaL*8       GDP   ( IDIM*JDIM, KMAX )   !' 気圧  Ｐ
      ReaL*8       GDPM  ( IDIM*JDIM, KMAX+1 ) !' 気圧（半整数）
      ReaL*8       GDZ   ( IDIM*JDIM, KMAX )   !' 高度
      ReaL*8       DELTA                       !' 2Δt
*
*   [INTERNAL PARM] 
      ReaL*8       QR0                         !' ｂパラメータ湿度
      ReaL*8       QR1                         !' ｂパラメータ湿度
      DATA       QR0    / 0.80   /
      DATA       QR1    / 0.90   /
      NAMELIST  /NMKUOC/  QR0  , QR1
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
      SAVE
*
*   [INTERNAL WORK]
      COMMON    /COMWRK/
     &           GDQOLD, GDTC  , GDQC  ,
     &           KBTM  , KTOP  ,
     &           QSUM  , QSSUM , QCONV ,
     &           DTSUM , DQSUM , BFAC  ,
     &           ADIAF , DELP  , GDQB
      ReaL*8       GDQOLD( IDIM*JDIM, KMAX )   !' 比湿の古い値
      ReaL*8       GDTC  ( IDIM*JDIM, KMAX )   !' 雲の温度
      ReaL*8       GDQC  ( IDIM*JDIM, KMAX )   !' 雲の比湿
      INTEGER    KBTM  ( IDIM*JDIM )         !' 雲底レベル
      INTEGER    KTOP  ( IDIM*JDIM )         !' 雲頂レベル
      ReaL*8       QSUM  ( IDIM*JDIM )         !' 比湿積分値
      ReaL*8       QSSUM ( IDIM*JDIM )         !' 飽和比湿積分値
      ReaL*8       QCONV ( IDIM*JDIM )         !' 水蒸気収束
      ReaL*8       DTSUM ( IDIM*JDIM )         !' 温度差積分値
      ReaL*8       DQSUM ( IDIM*JDIM )         !' 比湿差積分値
      ReaL*8       BFAC  ( IDIM*JDIM )         !' ｂパラメーター
      ReaL*8       ADIAF ( IDIM*JDIM, KMAX )   !' 乾燥断熱降温率
      ReaL*8       DELP  ( IDIM*JDIM, KMAX )   !' Δｐ
      ReaL*8       GDQB  ( IDIM*JDIM, KMAX )   !' 調節前の比湿
*
      INTEGER    IJ, K, IFPAR, JFPAR
      INTEGER    IREUSE
      ReaL*8       ELF, QR, GMOIS, GHEAT
*
*   [INTERNAL FUNC] 




* PACKAGE ZQSAT     !" Clausis-Clapeyron の式(文関数)
*
*"    QSAT:  saturation water vapour mixing ratio
*"    DQSAT: d(QSAT)/d(T)
*
      ReaL*8       FQSAT
      ReaL*8       FDQSAT
      ReaL*8       T, P, QS
*
c$$$      FQSAT ( T,P )    = EPSV * ES0
c$$$     &                   * EXP( EL/RVAP *( 1./273. - 1./T ) )
c$$$     &                   / P
      FQSAT ( T,P )    = EPSV
     &                   * 1.4E+11* EXP( - 5250.87/T )
     &                   / P
*"         <---------  Nakajima version
      FDQSAT( T,QS )   = EL * QS / ( RVAP * T*T )

*
      IF ( OFIRST ) THEN
         WRITE ( 6,* ) ' KUO CUMULUS PARAM. P2.2 DATE=91/01/12'
         OFIRST = .FALSE.
*
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMKUOC, END=390 )
  390    WRITE  ( JFPAR, NMKUOC )
      ENDIF
*
*"         < 1. ファクター計算 >
*
      DO 1100 K = 1, KMAX
         DO 1100 IJ = 1, IDIM*JDIM
            DELP  ( IJ,K ) = GDPM( IJ,K   ) - GDPM( IJ,K+1 )
 1100 CONTINUE
*
      ELF    = EL / CP
*
*"         < 2. 初期設定 >
*
      CALL       LOADGQ
     O         ( GDQOLD )
*
      DO 2000 K = 1, KMAX
         DO 2000 IJ = 1, IDIM*JDIM
            GDQB ( IJ,K ) = GDQ ( IJ,K )
 2000 CONTINUE
*
      CALL RESET ( QSUM , IDIM*JDIM )
      CALL RESET ( QSSUM, IDIM*JDIM )
      CALL RESET ( QCONV, IDIM*JDIM )
      CALL RESET ( DTSUM, IDIM*JDIM )
      CALL RESET ( DQSUM, IDIM*JDIM )
*
*"         < 3. 雲層のチェック >
*
      IREUSE = 0
*
      CALL       CCLLEV
     O         ( GDTC  , GDQC  , KBTM  , KTOP  ,
     I           GDT   , GDQ   , GDP   , GDZ   ,
     I           IREUSE,
     W           ADIAF                          )
*
*"         < 4. 雲内の収束，相対湿度 >
*
      DO 4100 K = 1, KMAX
         DO 4110 IJ = 1, IDIM*JDIM
*
            IF (     ( KBTM( IJ ) .GT. 0   )
     &          .AND.( K .GE. KBTM( IJ )   )
     &          .AND.( K. LE. KTOP( IJ )   )  ) THEN
*
               QSUM ( IJ ) = QSUM ( IJ )
     &                        + GDQ ( IJ,K )
     &                         * DELP( IJ,K )
               QSSUM( IJ ) = QSSUM( IJ )
     &                        + FQSAT( GDT( IJ,K ), GDP( IJ,K ) )
     &                         * DELP( IJ,K )
               QCONV( IJ ) = QCONV( IJ )
     &                       + ( GDQ ( IJ,K )  - GDQOLD( IJ,K ) )
     &                         * DELP( IJ,K )
               DTSUM( IJ ) = DTSUM( IJ )
     &                       + ( GDTC( IJ,K ) - GDT( IJ,K ) )
     &                         * DELP( IJ,K )
               DQSUM( IJ ) = DQSUM( IJ )
     &                       + ( GDQC( IJ,K ) - GDQ( IJ,K ) )
     &                         * DELP( IJ,K )
*
            ENDIF
*
 4110    CONTINUE
 4100 CONTINUE
*
*"         < 5. ｂパラメータ >
*
      DO 5100 IJ = 1, IDIM*JDIM
         IF ( QSSUM( IJ ) .GT. 0. ) THEN
            QR         = QSUM( IJ ) / QSSUM( IJ )
            BFAC( IJ ) = 1. -  ( QR-QR0 )/( QR1-QR0 )
            BFAC( IJ ) = MAX( MIN( BFAC( IJ ),1.0 ), 0.0 )
         ENDIF
 5100 CONTINUE
*
*"         < 6. 調節 >
*
      DO 6100 K = 1, KMAX
         DO 6110 IJ = 1, IDIM*JDIM
*
            IF (     ( QCONV( IJ ) .GT. 0.  )
     &          .AND.( KBTM( IJ )  .GT. 0   )
     &          .AND.( K .GE. KBTM( IJ )    )
     &          .AND.( K. LE. KTOP( IJ )    )  ) THEN
*
               GHEAT = ( 1. - BFAC( IJ ) ) * QCONV( IJ ) * ELF
     &                 * ( GDTC( IJ,K ) - GDT( IJ,K ) )
     &                 / DTSUM ( IJ )
*
               GMOIS = BFAC( IJ ) * QCONV( IJ )
     &                 * ( GDQC( IJ,K ) - GDQ( IJ,K ) )
     &                 / DQSUM ( IJ )
*
               GDT  ( IJ,K ) = GDT   ( IJ,K ) + GHEAT
               GDQ  ( IJ,K ) = GDQOLD( IJ,K ) + GMOIS
*
               GQCNV( IJ,K ) = GQCNV ( IJ,K )
     &                       + GHEAT / DELTA
*
               GSCNV( IJ,K ) = GSCNV ( IJ,K )
     &                       + ( GDQ( IJ,K ) - GDQB( IJ,K ) )/DELTA
*
               GQPR ( IJ )   = GQPR( IJ )
     &                       + GHEAT * CP / DELTA * DELP( IJ,K )/GRAV
*
            ENDIF
*
 6110    CONTINUE
 6100 CONTINUE
*
      RETURN
      END
