* PACKAGE P2MLSC  !" 湿妄册镍(2) 络惮滔杜冯
*
**********************************************************************
      SUBROUTINE LSCOND      !" 络惮滔杜冯
     M         ( GDT   , GDQ   ,
     M           GQPR  , GQLSC , GSLSC ,
     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 )   !" 补刨  Ｔ
      REAL       GDQ   ( IDIM*JDIM, KMAX )   !" 孺季  ｑ
      REAL       GQPR  ( IDIM*JDIM       )   !" 惯垮翁
      REAL       GQLSC ( IDIM*JDIM, KMAX )   !" 杜冯裁钱唯
      REAL       GSLSC ( IDIM*JDIM, KMAX )   !" 杜冯孺季恃步
*
*   [INPUT]
      REAL       GDP    ( IDIM*JDIM, KMAX )  !" 丹暗  Ｐ
      REAL       GDPM   ( IDIM*JDIM, KMAX+1 )!" 丹暗∈染腊眶∷
      REAL       DELTA                       !" 2Δt
*
*   [INTERNAL PARM]
      REAL       RCRITL                      !" 巫肠陵滦季刨
      DATA       RCRITL / 1.0   /
      NAMELIST  /NMMLSC/ RCRITL
      SAVE       RCRITL
*
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
      SAVE       OFIRST
*
*   [INTERNAL WORK]
      COMMON    /COMWRK/
     &           GDQB
      REAL       GDQB  ( IDIM*JDIM, KMAX )   !" 拇泪涟の孺季
*
      INTEGER    IJ, K
      INTEGER    IFPAR, JFPAR
      REAL       ELF
      REAL       QSAT, DQSAT, QEXE, DT, DQ
*
#ifdef SYS_IBMS
      INCLUDE   (ZQSAT)                      !" 税下垮绝丹暗
#else
#include        "zqsat.F"                    !" 税下垮绝丹暗
#endif
*
*   [ONCE]
      IF ( OFIRST ) THEN
         WRITE ( 6,* ) ' LARGE SCALE CONDENSATION P2.1 DATE=90/09/12'
         OFIRST = .FALSE.
*
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMMLSC, END=190 )
  190    WRITE  ( JFPAR, NMMLSC )
      ENDIF
*
      ELF = EL / CP
*
      DO 200 K = 1, KMAX
         DO 200 IJ = 1, IDIM*JDIM
            GDQB ( IJ,K ) = GDQ ( IJ,K )
  200 CONTINUE
*
*"         < 1. 拇泪 >
*
      DO 1000 K = KMAX, 1, -1
         DO 1000 IJ = 1, IDIM*JDIM
*
            QSAT   = FQSAT ( GDT( IJ,K ), GDP( IJ,K ) )
*
            IF ( GDQ ( IJ,K )/QSAT .GE. RCRITL ) THEN
*"                                                [ 税下 ]
*
               DQSAT  = FDQSAT( GDT( IJ,K   ), QSAT  )
*
               QEXE   = GDQ ( IJ,K ) - QSAT
               DT     = ELF * QEXE / ( 1. + ELF * DQSAT )
               DQ     = DQSAT * DT
*
               GDT   ( IJ,K ) = GDT( IJ,K ) + DT
               GDQ   ( IJ,K ) = QSAT + DQ
*
               GQLSC ( IJ,K ) = GQLSC( IJ,K ) + DT / DELTA
               GQPR  ( IJ )   = GQPR( IJ )
     &                        + DT * CP / DELTA
     &                          * ( GDPM( IJ,K )-GDPM( IJ,K+1 ) )/GRAV
*
*"             ------------- iteration (1) ----------------------------
*
               QSAT   = FQSAT ( GDT( IJ,K ), GDP( IJ,K ) )
               DQSAT  = FDQSAT( GDT( IJ,K ), QSAT  )
*
               QEXE   = GDQ ( IJ,K ) - QSAT
               DT     = ELF * QEXE / ( 1. + ELF * DQSAT )
               DQ     = DQSAT * DT
*
               GDT   ( IJ,K ) = GDT( IJ,K ) + DT
               GDQ   ( IJ,K ) = QSAT + DQ
*
               GQLSC ( IJ,K ) = GQLSC( IJ,K ) + DT / DELTA
               GQPR  ( IJ )   = GQPR( IJ )
     &                        + DT * CP / DELTA
     &                          * ( GDPM( IJ,K )-GDPM( IJ,K+1 ) )/GRAV
*
*"             ------------- iteration (2) ----------------------------
*
               QSAT   = FQSAT ( GDT( IJ,K ), GDP( IJ,K ) )
               DQSAT  = FDQSAT( GDT( IJ,K ), QSAT  )
*
               QEXE   = GDQ ( IJ,K ) - QSAT
               DT     = ELF * QEXE / ( 1. + ELF * DQSAT )
               DQ     = DQSAT * DT
*
               GDT   ( IJ,K ) = GDT( IJ,K ) + DT
               GDQ   ( IJ,K ) = QSAT + DQ
*
               GQLSC ( IJ,K ) = GQLSC( IJ,K ) + DT / DELTA
               GQPR  ( IJ )   = GQPR( IJ )
     &                        + DT * CP / DELTA
     &                          * ( GDPM( IJ,K )-GDPM( IJ,K+1 ) )/GRAV
*
               GSLSC ( IJ,K ) = GSLSC( IJ,K )
     &                        + ( GDQ( IJ,K ) - GDQB( IJ,K ) )/DELTA
*
            ENDIF
 1000 CONTINUE
*
      RETURN
      END