    SUBROUTINE GSCOND
!     ******************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:    GSCOND      GRID SCALE CONDENSATION AND EVAPORATION
!   PRGRMMR: ZHAO            ORG: W/NP22     DATE: ??-??-??

! ABSTRACT:
!     GSCOND COMPUTES THE GRID SCALE EVAPORATION AND CONDENSATION

! PROGRAM HISTORY LOG:
!   94-??-??  ZHAO       - ORIGINATOR
!   95-03-25  BLACK      - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
!   95-03-28  BLACK      - ADDED EXTERNAL EDGE
!   98-11-02  BLACK      - MODIFIED FOR DISTRIBUTED MEMORY

! USAGE: CALL GSCOND FROM MAIN PROGRAM EBU

!   INPUT ARGUMENT LIST:
!       NONE

!   OUTPUT ARGUMENT LIST:
!     NONE

!   OUTPUT FILES:
!     NONE

!   SUBPROGRAMS CALLED:

!     UNIQUE: NONE

!     LIBRARY: NONE

!   COMMON BLOCKS: CTLBLK
!                  LOOPS
!                  MASKS
!                  PHYS
!                  VRBLS
!                  CLDWTR
!                  TEMPV
!                  PVRBLS
!                  ACMCLH

! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM SP
!$$$
!***********************************************************************
    PARAMETER &
    (A1=610.78,A2=17.2693882,A3=273.16,A4=35.86 &
    , PQ0=379.90516,TRESH=.95 &
    , CP=1004.6,ELWV=2.50E6,ELIV=2.834E6,ROW=1.E3,G=9.8 &
    , EPSQ=2.E-12,DLDT=2274.0,TM10=263.16,R=287.04 &
    , CPR=CP*R,RCPR=1./(CPR))
    PARAMETER &
    (ARCP=A2*(A3-A4)/CP,RCP=1./CP,PQ0C=PQ0*TRESH,RROG=1./(ROW*G))
!----------------------------------------------------------------------
    INCLUDE "parmeta.f90"
    INCLUDE "parm.tbl.f90"
    INCLUDE "mpp.h"
#include "sp.h"
!----------------------------------------------------------------------
    PARAMETER &
    (IMJM=IM*JM-JM/2,JAM=6+2*(JM-10) &
    , LP1=LM+1,LTOP=1,LBOT=LM)

    PARAMETER &
    (LDA=(IDIM2-IDIM1+1)*(JDIM2-JDIM1+1))
!-----------------------------------------------------------------------
    LOGICAL :: &
    RUN,FIRST,RESTRT,SIGMA,NOZ
!----------------------------------------------------------------------
    INCLUDE "COMM_CTLBLK.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_LOOPS.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_MASKS.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_PHYS.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_VRBLS.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_CLDWTR.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_TEMPV.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_PVRBLS.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_ACMCLH.f90"
!-----------------------------------------------------------------------
    DIMENSION &
    IW(LM) &
    ,PDSL(IDIM1:IDIM2,JDIM1:JDIM2) &
    ,T_T(LM,IDIM1:IDIM2,JDIM1:JDIM2) &
    ,T0_T(LM,IDIM1:IDIM2,JDIM1:JDIM2) &
    ,Q_T(LM,IDIM1:IDIM2,JDIM1:JDIM2) &
    ,Q0_T(LM,IDIM1:IDIM2,JDIM1:JDIM2) &
    ,TRAIN_T(LM,IDIM1:IDIM2,JDIM1:JDIM2) &
    ,CWM_T(LM,IDIM1:IDIM2,JDIM1:JDIM2) &
    ,HTM_T(LM,IDIM1:IDIM2,JDIM1:JDIM2)
!----------------------------------------------------------------------
    REAL :: &
    MR,KE,INIT
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!--------------PREPARATORY CALCULATIONS---------------------------------
    DTPH =NPHS*DT
    RDTPH=1./DTPH
    TWODT=DTPH
    RTWODT=1./TWODT
    C0=1.5E-4
    C1=300.
    C2=0.5
    MR=3.0E-4
    KE=2.0E-5
    US=1.
    EPS=0.622
    CCLIMIT=1.0E-3
    CLIMIT =1.0E-20
!-----------------------------------------------------------------------
!------------------PADDING SPECIFIC HUMIDITY & CWM IF TOO SMALL---------
!-----------------------------------------------------------------------
! omp parallel do
    DO 30 L=1,LM
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                IF(Q(I,J,L) < EPSQ)Q(I,J,L)=EPSQ*HTM(I,J,L)
                IF(CWM(I,J,L) < CLIMIT)CWM(I,J,L)=CLIMIT*HTM(I,J,L)
            ENDDO
        ENDDO
    30 END DO

    DO J=MYJS,MYJE
        DO I=MYIS,MYIE
            PDSL(I,J)=RES(I,J)*PD(I,J)
        ENDDO
    ENDDO

    IW(1)=0
    UTIM=1.

!-----------------------------------------------------------------------
!*************BEGINNING OF GRID-SCALE CONDENSATION/EVAP. LOOP***********
!-----------------------------------------------------------------------
!***
!***  TRANSPOSE ARRAYS
!***
!       if(mype.eq.1) then
!       print*,'lda=',lda
!       do l=1,lm
!        print*,'before transpose, t=',l,t(25,33,l)
!       enddo
!       endif
! omp parallel sections
! omp section
    CALL SGETMO(T,LDA,LDA,LM,T_T,LM)
    CALL SGETMO(Q,LDA,LDA,LM,Q_T,LM)
    CALL SGETMO(HTM,LDA,LDA,LM,HTM_T,LM)
    CALL SGETMO(CWM,LDA,LDA,LM,CWM_T,LM)
! omp section
    CALL SGETMO(T0,LDA,LDA,LM,T0_T,LM)
    CALL SGETMO(Q0,LDA,LDA,LM,Q0_T,LM)
    CALL SGETMO(TRAIN,LDA,LDA,LM,TRAIN_T,LM)
! omp end parallel sections
!       if(mype.eq.1) then
!       do l=1,lm
!        print*,'after transpose, t=',l,t_t(l,25,33)
!       enddo
!       endif

!-----------------------------------------------------------------------
!------------------QW, QI AND QINT--------------------------------------
!-----------------------------------------------------------------------
! omp parallel do
! omp& private(aa,ab,ac,ad,ae,af,ag,ai,ap,aq,at,bi,ccr,ccrkl,
! omp&         ccrkl1,cond,condk,cone0,cwmkl,e0,ec,elv,fi,fiw,
! omp&         hbm2ij,hh,iwkl,lmhij,lml,p0ij,pdslij,pp,pp0,
! omp&         qc,qi,qint,qkl,qtemp,qw,resij,rqkl,rqkll,rqtmp,
! omp&         thh,tkl,tmt0,tmt15,u00ij,u00kl,us00)
! omp& firstprivate(iw)

    if(mype == 1) then
        print*,'myis,myie,myjs2,myje2=',myis,myie,myjs2,myje2
    endif
    DO 100 J=MYJS2,MYJE2
        DO 100 I=MYIS,MYIE
        !-----------------------------------------------------------------------
        
            LMHIJ=LMH(I,J)
            HBM2IJ=HBM2(I,J)
            U00IJ=U00(I,J)
            P0IJ=P0(I,J)
            RESIJ=RES(I,J)
            PDSLIJ=PDSL(I,J)
        
            DO 90 L=2,LM
            
                TKL=T_T(L,I,J)
                QKL=Q_T(L,I,J)
                CWMKL=CWM_T(L,I,J)
            
                COND=0.
                E0=0.
                LML=LM-LMHIJ
                HH=HTM_T(L,I,J)*HBM2IJ
                TMT0=(TKL-273.16)*HH
                TMT15=AMIN1(TMT0,-15.)*HH
                AI=0.008855
                BI=1.
            
                IF(TMT0 < -20.)THEN
                    AI=0.007225
                    BI=0.9674
                ENDIF
            
                QW=HH*PQ0/(PDSLIJ*AETA(L)+PT) &
                *EXP(HH*A2*(T(I,J,L)-A3)/(T(I,J,L)-A4))
                QI=QW*(BI+AI*AMIN1(TMT0,0.))
                QINT=QW*(1.-0.00032*TMT15*(TMT15+15.))
                IF(TMT0 <= -40.)QINT=QI
            !-----------------------------------------------------------------------
            !-------------------ICE-WATER ID NUMBER IW------------------------------
            !-----------------------------------------------------------------------
                IF(TMT0 < -15.)THEN
                    U00KL=U00IJ+UL(L+LML)*(0.95-U00IJ)*UTIM
                    FI=Q(I,J,L)-U00KL*QI
                    IF(FI > 0. .OR. CWMKL > CLIMIT)THEN
                        IW(L)=1
                    ELSE
                        IW(L)=0
                    ENDIF
                ENDIF
            
                IF(TMT0 >= 0.)THEN
                    IW(L)=0
                ENDIF
            
                IF(TMT0 < 0.0 .AND. TMT0 >= -15.)THEN
                    IW(L)=0
                    IF(IW(L-1) == 1 .AND. CWMKL > CLIMIT)IW(L)=1
                ENDIF
            !-----------------------------------------------------------------------
            !--------------CONDENSATION AND EVAPORATION OF CLOUD--------------------
            !------------------------AT, AQ AND DP/DT-------------------------------
            !-----------------------------------------------------------------------
                THH=TWODT*HH
                PP=PDSLIJ*AETA(L)+PT
                PP0=P0IJ*RESIJ*AETA(L)+PT
                AT=(TKL-T0_T(L,I,J))*RTWODT
                AQ=(QKL-Q0_T(L,I,J))*RTWODT
                AP=(PP-PP0)*RTWODT
                IWKL=IW(L)
                U00KL=U00IJ+UL(L+LML)*(0.95-U00IJ)*UTIM
            !-----------------------------------------------------------------------
            !----------------THE SATUATION SPECIFIC HUMIDITY------------------------
            !-----------------------------------------------------------------------
                FIW=FLOAT(IWKL)
                ELV=(1.-FIW)*ELWV+FIW*ELIV
                QC =(1.-FIW)*QINT+FIW*QI
            !-----------------------------------------------------------------------
            !----------------THE RELATIVE HUMIDITY----------------------------------
            !-----------------------------------------------------------------------
                IF(QC <= 0.)THEN
                    RQKL=0.
                ELSE
                    RQKL=QKL/QC
                ENDIF
            !-----------------------------------------------------------------------
            !----------------CLOUD COVER RATIO CCR----------------------------------
            !-----------------------------------------------------------------------
                IF(RQKL <= U00KL)THEN
                    CCR=0.
                ELSE
                    RQKLL=AMIN1(US,RQKL)
                    CCR=1.-SQRT((US-RQKLL)/(US-U00KL))
                ENDIF
            !-----------------------------------------------------------------------
            !-----------CORRECT CCR IF IT IS TOO SMALL IN LARGE CWM REGIONS--------
            !-----------------------------------------------------------------------
                IF(CCR >= 0.01 .AND. CCR <= 0.2 .AND. CWMKL >= 0.2E-3)THEN
                    CCR=AMIN1(1.,CWMKL*1.E3)
                ENDIF
            
                CCRKL=CCR
            !-----------------------------------------------------------------------
            !-------GIVE UP THIS POINT  IF NO CLOUD NOR CONDENSATION EXIST---------
            !-----------------------------------------------------------------------
                IF(CCRKL <= CCLIMIT .AND. CWMKL <= CLIMIT)GO TO 90
            !-----------------------------------------------------------------------
            !----------------EVAPORATION OF CLOUD WATER-----------------------------
            !-----------------------------------------------------------------------
                EC=0.
                IF(CCRKL <= CCLIMIT .AND. CWMKL > CLIMIT)THEN
                    EC=QC*(U00KL-RQKL)*RTWODT
                    E0=AMAX1(EC,0.0)
                    E0=AMIN1(CWMKL*RTWODT,E0)*HH
                    E0=AMAX1(0.,E0)
                ENDIF
            !-----------------------------------------------------------------------
            !----------------CONDENSATION OF CLOUD----------------------------------
            !-----------------------------------------------------------------------
                IF(CCRKL <= 0.20 .OR. QC <= EPSQ)THEN
                !     IF(CCRKL.LE.CCLIMIT.OR.QC.LE.EPSQ)THEN
                    COND=0.
                    GO TO 80
                ENDIF
            !-----------------------------------------------------------------------
            !-----------THE EQS. FOR COND. HAS BEEN REORGANIZED TO REDUCE CPU------
            !-----------------------------------------------------------------------
                US00=US-U00KL
                CCRKL1=1.-CCRKL
                AA=EPS*ELV*PP*QKL
                AB=CCRKL*CCRKL1*QC*US00
                AC=AB+0.5*CWMKL
                AD=AB*CCRKL1
                AE=CPR*TKL*TKL
                AF=AE*PP
                AG=AA*ELV
                AI=CP*AA
                COND=(AC-AD)*(AF*AQ-AI*AT+AE*QKL*AP)/(AC*(AF+AG))
            !-----------------------------------------------------------------------
            !-----------CHECK & CORRECT IF OVER CONDENSATION OCCURS-----------------
            !-----------------------------------------------------------------------
                CONDK=(QKL-U00KL*QC*0.1)*RTWODT
            !     CONDK=(QKL-U00KL*QC*0.6)*RTWODT
                IF(COND > CONDK)THEN
                    COND=CONDK
                ENDIF
            !-----------------------------------------------------------------------
            !----------CHECK & CORRECT IF SUPERSATUATION IS TOO HIGH----------------
            !-----------------------------------------------------------------------
                QTEMP=QKL-AMAX1(0.,(COND-E0))*THH
                RQTMP=QTEMP/QC
                IF(RQTMP >= 1.10)THEN
                    COND=(QKL-1.10*QC)*RTWODT
                ENDIF
            !-----------------------------------------------------------------------
                IF(COND < 0.)THEN
                    COND=0.
                ENDIF
            !-----------------------------------------------------------------------
            !-------------------UPDATE OF T, Q AND CWM------------------------------
            !-----------------------------------------------------------------------
                80 CONTINUE
                if(mype == 1 .AND. i == 25 .AND. j == 31 .AND. l == 31) then
                    print*,'cond,e0=',cond,e0
                endif
                CONE0=COND-E0
                CWM_T(L,I,J)=CONE0*THH+CWMKL
            
            !-----------------------------------------------------------------------
            !     ACCUMULATE LATENT HEATING DUE TO GRID-SCALE PRECIP/EVAP.
            !     SCALE BY THE RECIPROCAL OF THE PERIOD AT WHICH THIS ROUTINE
            !     IS CALLED.  THIS PERIOD IS THE PHYSICS TIMESTEP.
            !-----------------------------------------------------------------------
            
            !     if(mype.eq.1.and.i.eq.25.and.j.eq.31) then
            !     print*,'elv,rcp,cone0,thh,tkl=',l,i,j,elv,rcp,cone0,thh,tkl
            !     print*,'t_t(ELV*RCP*CONE0*THH+TKL)=',ELV*RCP*CONE0*THH+TKL
            !     print*,'q_t(-CONE0*THH+QKL)=',-CONE0*THH+QKL
            !     endif
                T_T(L,I,J)=ELV*RCP*CONE0*THH+TKL
                TRAIN_T(L,I,J)=ELV*RCP*CONE0*THH*RDTPH+TRAIN_T(L,I,J)
                Q_T(L,I,J)=-CONE0*THH+QKL
                IF(CWM_T(L,I,J) <= 0.)CWM_T(L,I,J)=0.
            
            90 END DO
        
    100 END DO
!       if(mype.eq.1) then
!       print*,'lda=',lda
!       do l=1,lm
!        print*,'before transpose, t=',l,t_t(l,25,33)
!       enddo
!       endif
!-----------------------------------------------------------------------
!-------------------SAVE T, Q AND P FOR THIS STEP-----------------------
!-----------------------------------------------------------------------
!***
!***  TRANSPOSE BACK THE NEEDED ARRAYS
!***
! omp parallel sections
! omp section
    CALL SGETMO(T_T,LM,LM,LDA,T,LDA)
    CALL SGETMO(Q_T,LM,LM,LDA,Q,LDA)
! omp section
    CALL SGETMO(TRAIN_T,LM,LM,LDA,TRAIN,LDA)
    CALL SGETMO(CWM_T,LM,LM,LDA,CWM,LDA)
! omp end parallel sections

! omp parallel do
    DO 125 L=1,LM
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
            !     if(mype.eq.1.and.i.eq.25.and.j.eq.33) then
            !       print*,'i,j,l,t(i,j,l)=',i,j,l,t(i,j,l)
            !      endif
                Q0(I,J,L)=Q(I,J,L)
                T0(I,J,L)=T(I,J,L)
            ENDDO
        ENDDO
    125 END DO

    DO J=MYJS,MYJE
        DO I=MYIS,MYIE
            P0(I,J)=PD(I,J)
        ENDDO
    ENDDO
!-----------------------------------------------------------------------
    RETURN
    END SUBROUTINE GSCOND
