* PACKAGE P2KUOC  !" 物理過程(2) Kuoパラメタリゼーション
*
**********************************************************************
      SUBROUTINE CUMADJ        !" Kuoパラメタリゼーション
     M         ( GDT   , GDQ   ,
     M           GQPR  , GQCNV , GSCNV ,
     I           GDP   , GDPM  , GDZ   , DELTA  )
*
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !' 格子点数，波数
      INCLUDE   (ZCCOM)                      !' 標準物理定数
#else
#include        "zcdim.F"                    !" 格子点数，波数
#include        "zccom.F"                    !" 標準物理定数
#endif
*
*   [MODIFY] 
      REAL       GDT   ( IDIM*JDIM, KMAX )   !' 温度  Ｔ
      REAL       GDQ   ( IDIM*JDIM, KMAX )   !' 比湿  ｑ
      REAL       GQPR  ( IDIM*JDIM       )   !' 降水量
      REAL       GQCNV ( IDIM*JDIM, KMAX )   !' 凝結調節加熱率
      REAL       GSCNV ( IDIM*JDIM, KMAX )   !' 凝結調節比湿変化
*
*   [INPUT] 
      REAL       GDP   ( IDIM*JDIM, KMAX )   !' 気圧  Ｐ
      REAL       GDPM  ( IDIM*JDIM, KMAX+1 ) !' 気圧（半整数）
      REAL       GDZ   ( IDIM*JDIM, KMAX )   !' 高度
      REAL       DELTA                       !' 2Δt
*
*   [INTERNAL PARM] 
      REAL       QR0                         !' ｂパラメータ湿度
      REAL       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       GDQOLD( IDIM*JDIM, KMAX )   !' 比湿の古い値
      REAL       GDTC  ( IDIM*JDIM, KMAX )   !' 雲の温度
      REAL       GDQC  ( IDIM*JDIM, KMAX )   !' 雲の比湿
      INTEGER    KBTM  ( IDIM*JDIM )         !' 雲底レベル
      INTEGER    KTOP  ( IDIM*JDIM )         !' 雲頂レベル
      REAL       QSUM  ( IDIM*JDIM )         !' 比湿積分値
      REAL       QSSUM ( IDIM*JDIM )         !' 飽和比湿積分値
      REAL       QCONV ( IDIM*JDIM )         !' 水蒸気収束
      REAL       DTSUM ( IDIM*JDIM )         !' 温度差積分値
      REAL       DQSUM ( IDIM*JDIM )         !' 比湿差積分値
      REAL       BFAC  ( IDIM*JDIM )         !' ｂパラメーター
      REAL       ADIAF ( IDIM*JDIM, KMAX )   !' 乾燥断熱降温率
      REAL       DELP  ( IDIM*JDIM, KMAX )   !' Δｐ
      REAL       GDQB  ( IDIM*JDIM, KMAX )   !' 調節前の比湿
*
      INTEGER    IJ, K, IFPAR, JFPAR
      INTEGER    IREUSE
      REAL       ELF, QR, GMOIS, GHEAT
*
*   [INTERNAL FUNC] 
#ifdef SYS_IBMS
      INCLUDE   (ZQSAT)                      !' 飽和水蒸気圧
#else
#include        "zqsat.F"                    !" 飽和水蒸気圧
#endif
*
      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
