* PACKAGE P2DADJ      !" 物理過程(2) 乾燥対流調節
*
*"  [HIS] 90/05/19(numaguti)
*
**********************************************************************
      SUBROUTINE DADJST   !" 乾燥対流調節
     M         ( GDT   ,
     I           GDP   , GDPM  , DELTA  )
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数，波数
      INCLUDE   (ZCCOM)                      !" 標準物理定数
#else
#include        "zcdim.F"                    !" 格子点数，波数
#include        "zccom.F"                    !" 標準物理定数
#endif
*
*   [MODIFY] 
      REAL       GDT   ( IDIM*JDIM, KMAX )   !" 温度  Ｔ
*
*   [INPUT] 
      REAL       GDP   ( IDIM*JDIM, KMAX )   !" 気圧  Ｐ
      REAL       GDPM  ( IDIM*JDIM, KMAX+1 ) !" 気圧（半整数）
      REAL       DELTA                       !" 2 Δt
*
*   [INTERNAL PARM] 
      INTEGER    ITRMAX
      PARAMETER (ITRMAX=10)
      REAL       EPST ( ITRMAX )             !" 不安定の許容誤差
      DATA       EPST / 0.01  , 0.02  , 0.02  , 0.05  , 0.05  ,
     &                  0.10  , 0.10  , 0.20  , 0.20  , 0.40    /
*
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
      SAVE
*
*   [INTERNAL WORK] 
      COMMON    /COMWRK/
     &           ADJDA , ADJDB ,
     &           DELP  , DPDP  , DPPMK
      REAL       ADJDA ( IDIM*JDIM )         !" 前回調節されたか否か
      REAL       ADJDB ( IDIM*JDIM )         !" 今回調節されたか否か
      REAL       DELP  ( IDIM*JDIM, KMAX )   !" ΔＰ
      REAL       DPDP  ( IDIM*JDIM, KMAX )   !" ファクター
      REAL       DPPMK ( IDIM*JDIM, KMAX )   !" ファクター
      INTEGER    I, J, IJ, K, ITR
      REAL       ST, DT, ADJPTS
*
*   [ONCE] 
      IF ( OFIRST ) THEN
         WRITE ( 6,* ) ' DRY CONVENCIVE ADJUSTMENT P2.1 DATE=90/08/31'
         OFIRST = .FALSE.
      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
*
      DO 1200 K = 2, KMAX
         DO 1200 IJ = 1, IDIM*JDIM
            DPDP  ( IJ,K ) = DELP( IJ,K ) / DELP( IJ,K-1 )
            DPPMK ( IJ,K ) = RAIR / CP
     &                       * ( GDP ( IJ,K-1 ) - GDP ( IJ,K   ) )
     &                       / ( DELP( IJ,K-1 ) + DELP( IJ,K   ) )
     &                       /   GDPM( IJ,K   )
 1200 CONTINUE
*
*"      < 2. 調節 >
*
      CALL RESET ( ADJDB,  IDIM*JDIM )
      DO 2000 I = 1, IMAX
         DO 2000 J = 1, JMAX
            ADJDB( IDIM*(J-1)+I ) = 1.  
 2000 CONTINUE
*
*"          < イテレーション >
*
      DO 2100 ITR = 1, ITRMAX
*
         CALL RESET ( ADJDA, IDIM*JDIM )
*
         DO 2120 K = 2, KMAX
*
            DO 2130 IJ = 1, IDIM*JDIM
*
               IF ( ADJDB( IJ ) .GT. 0.9   ) THEN
                  ST   =   GDT ( IJ,K-1 ) - GDT ( IJ,K )
     &                   - DPPMK ( IJ,K )
     &                     * (  DELP( IJ,K-1 ) * GDT ( IJ,K-1 )
     &                        + DELP( IJ,K   ) * GDT ( IJ,K   ) )
*
                  IF ( ST .GT. EPST( ITR ) ) THEN
                     DT = ST / ( 1. + DPDP( IJ,K ) )
                     GDT  ( IJ,K   ) = GDT( IJ,K   ) + DT
                     GDT  ( IJ,K-1 ) = GDT( IJ,K-1 ) - DT * DPDP( IJ,K )
                     ADJDA( IJ )     = 1.  
                  ENDIF
*
               ENDIF
 2130       CONTINUE
*
 2120    CONTINUE
*
         ADJPTS = 0.
         DO 2140 IJ = 1, IDIM*JDIM
            ADJDB( IJ ) = ADJDA( IJ )
            ADJPTS = ADJPTS + ADJDA( IJ )
 2140    CONTINUE
*
         IF ( ADJPTS .LT. 1. ) GOTO 2200
*"                                  exit
*
 2100 CONTINUE
*
 2200 CONTINUE
*
      RETURN
      END
