! $Id: convect2.F90 2346 2015-08-21 15:13:46Z emillour $

    q1, qs1, u1, v1, gz1, tv1, tp1, tvp1, clw1, h1, lv1, cpn1, p1, ph1, ft1, &

    cpd, cpv, cl, rv, rd, lv0, g, sigs, sigd, elcrit, tlcrit, omtsnow, dtmax, &

    damp, alpha, entp, coeffs, coeffr, omtrain, cu, ma)

  ! .............................START PROLOGUE............................

  ! SCCS IDENTIFICATION:  @(#)convect2.f	1.2 05/18/00

  ! 22:06:22 /h/cm/library/nogaps4/src/sub/fcst/convect2.f_v

  ! CONFIGURATION IDENTIFICATION:  None

  ! MODULE NAME:  convect2

  ! DESCRIPTION:

  ! convect1     The Emanuel Cumulus Convection Scheme - compute tendencies

  ! CONTRACT NUMBER AND TITLE:  None

  ! REFERENCES: Programmers  K. Emanuel (MIT), Timothy F. Hogan, M. Peng

  ! (NRL)

  ! CLASSIFICATION:  Unclassified

  ! RESTRICTIONS: None

  ! COMPILER DEPENDENCIES: FORTRAN 77, FORTRAN 90

  ! COMPILE OPTIONS: Fortran 77: -Zu -Wf"-ei -o aggress"

  ! Fortran 90: -O vector3,scalar3,task1,aggress,overindex  -ei -r 2

  ! LIBRARIES OF RESIDENCE: /a/ops/lib/libfcst159.a

  ! USAGE: call convect2(ncum,idcum,len,nd,nl,minorig,

  ! &                 nk1,icb1,

  ! &                 t1,q1,qs1,u1,v1,gz1,tv1,tp1,tvp1,clw1,h1,

  ! &                 lv1,cpn1,p1,ph1,ft1,fq1,fu1,fv1,

  ! &                 tnk1,qnk1,gznk1,plcl1,

  ! &                 precip1,cbmf1,iflag1,

  ! &                 delt,cpd,cpv,cl,rv,rd,lv0,g,

  ! &                 sigs,sigd,elcrit,tlcrit,omtsnow,dtmax,damp,

  ! &                 alpha,entp,coeffs,coeffr,omtrain,cu)

  ! PARAMETERS:

  ! Name            Type         Usage            Description

  ! ----------      ----------     -------  ----------------------------

  ! ncum          Integer        Input        number of cumulus points

  ! idcum         Integer        Input        index of cumulus point

  ! len           Integer        Input        first dimension

  ! nd            Integer        Input        total vertical dimension

  ! ndp1          Integer        Input        nd + 1

  ! nl            Integer        Input        vertical dimension for

  ! convection

  ! minorig       Integer        Input        First level where convection is

  ! allow to begin

  ! nk1           Integer        Input        First level of convection

  ! ncb1          Integer        Input        Level of free convection

  ! t1            Real           Input        temperature

  ! q1            Real           Input        specific hum

  ! qs1           Real           Input        sat specific hum

  ! u1            Real           Input        u-wind

  ! v1            Real           Input        v-wind

  ! gz1           Real           Inout        geop

  ! tv1           Real           Input        virtual temp

  ! tp1           Real           Input

  ! clw1          Real           Inout        cloud liquid water

  ! h1            Real           Inout

  ! lv1           Real           Inout

  ! cpn1          Real           Inout

  ! p1            Real           Input        full level pressure

  ! ph1           Real           Input        half level pressure

  ! ft1           Real           Output       temp tend

  ! fq1           Real           Output       spec hum tend

  ! fu1           Real           Output       u-wind tend

  ! fv1           Real           Output       v-wind tend

  ! precip1       Real           Output       prec

  ! cbmf1         Real           In/Out       cumulus mass flux

  ! iflag1        Integer        Output       iflag on latitude strip

  ! delt          Real           Input        time step

  ! cpd           Integer        Input        See description below

  ! cpv           Integer        Input        See description below

  ! cl            Integer        Input        See description below

  ! rv            Integer        Input        See description below

  ! rd            Integer        Input        See description below

  ! lv0           Integer        Input        See description below

  ! g             Integer        Input        See description below

  ! sigs          Integer        Input        See description below

  ! sigd          Integer        Input        See description below

  ! elcrit        Integer        Input        See description below

  ! tlcrit        Integer        Input        See description below

  ! omtsnow       Integer        Input        See description below

  ! dtmax         Integer        Input        See description below

  ! damp          Integer        Input        See description below

  ! alpha         Integer        Input        See description below

  ! ent           Integer        Input        See description below

  ! coeffs        Integer        Input        See description below

  ! coeffr        Integer        Input        See description below

  ! omtrain       Integer        Input        See description below

  ! cu            Integer        Input        See description below

  ! COMMON BLOCKS:

  ! Block      Name     Type    Usage              Notes

  ! --------  --------   ----    ------   ------------------------

  ! FILES: None

  ! DATA BASES: None

  ! NON-FILE INPUT/OUTPUT: None

  ! ERROR CONDITIONS: None

  ! ADDITIONAL COMMENTS: None

  ! .................MAINTENANCE SECTION................................

  ! MODULES CALLED:

  ! Name           Description

  ! zilch        Zero out an array

  ! -------     ----------------------

  ! LOCAL VARIABLES AND

  ! STRUCTURES:

  ! Name     Type    Description

  ! -------  ------  -----------

  ! See Comments Below

  ! i        Integer loop index

  ! k        Integer loop index

  ! METHOD:

  ! See Emanuel, K. and M. Zivkovic-Rothman, 2000: Development and evaluation

  ! of a

  ! convective scheme for use in climate models.

  ! FILES: None

  ! INCLUDE FILES: None

  ! MAKEFILE: /a/ops/met/nogaps/src/sub/fcst/fcst159lib.mak

  ! ..............................END PROLOGUE.............................

  USE dimphy

  IMPLICIT NONE

  INTEGER kmax2, imax2, kmin2, imin2

  REAL ftmax2, ftmin2

  INTEGER kmax, imax, kmin, imin

  REAL ftmax, ftmin

  INTEGER ncum

  INTEGER len

  INTEGER idcum(len)

  INTEGER nd

  INTEGER ndp1

  INTEGER nl

  INTEGER minorig

  INTEGER nk1(len)

  INTEGER icb1(len)

  REAL t1(len, nd)

  REAL q1(len, nd)

  REAL qs1(len, nd)

  REAL u1(len, nd)

  REAL v1(len, nd)

  REAL gz1(len, nd)

  REAL tv1(len, nd)

  REAL tp1(len, nd)

  REAL tvp1(len, nd)

  REAL clw1(len, nd)

  REAL h1(len, nd)

  REAL lv1(len, nd)

  REAL cpn1(len, nd)

  REAL p1(len, nd)

  REAL ph1(len, ndp1)

  REAL ft1(len, nd)

  REAL fq1(len, nd)

  REAL fu1(len, nd)

  REAL fv1(len, nd)

  REAL tnk1(len)

  REAL qnk1(len)

  REAL gznk1(len)

  REAL precip1(len)

  REAL cbmf1(len)

  REAL plcl1(len)

  INTEGER iflag1(len)

  REAL delt

  REAL cpd

  REAL cpv

  REAL cl

  REAL rv

  REAL rd

  REAL lv0

  REAL g

  REAL sigs ! SIGS IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE

  REAL sigd ! SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT

  REAL elcrit ! ELCRIT IS THE AUTOCONVERSION THERSHOLD WATER CONTENT (gm/gm)

  REAL tlcrit ! TLCRIT IS CRITICAL TEMPERATURE BELOW WHICH THE AUTO-

  ! CONVERSION THRESHOLD IS ASSUMED TO BE ZERO

  REAL omtsnow ! OMTSNOW IS THE ASSUMED FALL SPEED (P/s) OF SNOW

  REAL dtmax ! DTMAX IS THE MAXIMUM NEGATIVE TEMPERATURE PERTURBATION

  ! A LIFTED PARCEL IS ALLOWED TO HAVE BELOW ITS LFC.

  REAL damp

  REAL alpha

  REAL entp ! ENTP IS THE COEFFICIENT OF MIXING IN THE ENTRAINMENT FORMULATION

  REAL coeffs ! COEFFS IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION OF

  ! SNOW

  REAL coeffr ! COEFFR IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION OF

  ! RAIN

  REAL omtrain ! OMTRAIN IS THE ASSUMED FALL SPEED (P/s) OF RAIN

  REAL cu ! CU IS THE COEFFICIENT GOVERNING CONVECTIVE MOMENTUM TRANSPORT

  REAL ma(len, nd)

  ! *** ELCRIT IS THE AUTOCONVERSION THERSHOLD WATER CONTENT (gm/gm) ***

  ! ***  TLCRIT IS CRITICAL TEMPERATURE BELOW WHICH THE AUTO-        ***

  ! ***       CONVERSION THRESHOLD IS ASSUMED TO BE ZERO             ***

  ! ***     (THE AUTOCONVERSION THRESHOLD VARIES LINEARLY            ***

  ! ***               BETWEEN 0 C AND TLCRIT)                        ***

  ! ***   ENTP IS THE COEFFICIENT OF MIXING IN THE ENTRAINMENT       ***

  ! ***                       FORMULATION                            ***

  ! ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***

  ! ***  SIGS IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE       ***

  ! ***                        OF CLOUD                              ***

  ! ***        OMTRAIN IS THE ASSUMED FALL SPEED (P/s) OF RAIN       ***

  ! ***     OMTSNOW IS THE ASSUMED FALL SPEED (P/s) OF SNOW          ***

  ! ***  COEFFR IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***

  ! ***                          OF RAIN                             ***

  ! ***  COEFFS IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***

  ! ***                          OF SNOW                             ***

  ! ***     CU IS THE COEFFICIENT GOVERNING CONVECTIVE MOMENTUM      ***

  ! ***                         TRANSPORT                            ***

  ! ***    DTMAX IS THE MAXIMUM NEGATIVE TEMPERATURE PERTURBATION    ***

  ! ***        A LIFTED PARCEL IS ALLOWED TO HAVE BELOW ITS LFC      ***

  ! ***    ALPHA AND DAMP ARE PARAMETERS THAT CONTROL THE RATE OF    ***

  ! ***                 APPROACH TO QUASI-EQUILIBRIUM                ***

  ! ***   (THEIR STANDARD VALUES ARE  0.20 AND 0.1, RESPECTIVELY)    ***

  ! ***                   (DAMP MUST BE LESS THAN 1)                 ***

  ! Local arrays.

  ! real det(ncum,klev)

  ! real wd(ncum)

  ! real tprime(ncum)

  ! real qprime(ncum)

  REAL qti

  REAL w3d(ncum, klev)

  INTEGER nn, i, k, n, icbmax, nlp, j

  INTEGER ij

  INTEGER nn2, nn3

  REAL clmcpv

  REAL clmcpd

  REAL cpdmcp

  REAL cpvmcpd

  REAL eps

  REAL epsi

  REAL epsim1

  REAL tg, qg, s, alv, tc, ahg, denom, es, rg, ginv, rowl

  REAL delti

  REAL tca, elacrit

  REAL by, defrac

  ! real byp

  REAL dbo

  REAL bf2, anum, dei, altem, cwat, stemp

  REAL alt, qp1, smid, sjmax, sjmin

  REAL delp, delm

  REAL awat, coeff, afac, revap, dhdp, fac, qstm, rat

  REAL qsm, sigt, b6, c6

  REAL dpinv, cpinv

  REAL fqold, ftold, fuold, fvold

  ! real amp1,ad

  INTEGER num1, num2

  ! print*,'cpd en entree de convect2 ',cpd

  rowl = 1000.0

  ! Define some thermodynamic variables.

  cpdmcp = cpd - cpv

  cpvmcpd = cpv - cpd

  epsim1 = epsi - 1.0

  ! Compress the fields.

    nn = 0

      END IF

    END DO

    ! print*,'100 ncum,nn',ncum,nn

  END DO

  nn = 0

    END IF

  END DO

  ! print*,'150 ncum,nn',ncum,nn

  ! Initialize the tendencies, det, wd, tprime, qprime.

      ! det(i,k)=0.0

    END DO

  END DO

    ! wd(i)=0.0

    ! tprime(i)=0.0

    ! qprime(i)=0.0

  END DO

  ! Compute icbmax.

  icbmax = 2

  END DO

  ! =====================================================================

  ! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES

  ! =====================================================================

  ! ---       The procedure is to solve the equation.

  ! cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.

  ! ***  Calculate certain parcel quantities, including static energy   ***

    ah0(i) = (cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i) + qnk(i)*(lv0-clmcpv*(tnk(i)- &

  END DO

  ! ***  Find lifted parcel quantities above cloud base    ***

        ! First iteration.

        ELSE

        END IF

        ! Second iteration.

        ELSE

        END IF

        alv = lv0 - clmcpv*(t(i,k)-273.15)

        ! print*,'cpd dans convect2 ',cpd

        ! print*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'

        ! print*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd

        ! if (.not.cpd.gt.1000.) then

        ! print*,'CPD=',cpd

        ! stop

        ! endif

      END IF

    END DO

  END DO

  ! =====================================================================

  ! --- SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF

  ! --- PRECIPITATION FALLING OUTSIDE OF CLOUD

  ! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)

  ! =====================================================================

        ELSE

        END IF

      END IF

    END DO

  END DO

  ! =====================================================================

  ! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL

  ! --- VIRTUAL TEMPERATURE

  ! =====================================================================

        ! print*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'

        ! print*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)

      END IF

    END DO

  END DO

  END DO

  ! =====================================================================

  ! --- NOW INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS

  ! =====================================================================

    ! if(.not.cpn(i,1).gt.900.) then

    ! print*,'i,lv(i,1),cpn(i,1)'

    ! print*, i,lv(i,1),cpn(i,1)

    ! k=(i-1)/ncum+1

    ! print*,'i,k',mod(i,ncum),k,'  cpn',cpn(mod(i,ncum),k)

    ! stop

    ! endif

  END DO

  END DO

      END DO

    END DO

  END DO

  END DO

    END DO

  END DO

  ! =====================================================================

  ! --- FIND THE FIRST MODEL LEVEL (INB1) ABOVE THE PARCEL'S

  ! --- HIGHEST LEVEL OF NEUTRAL BUOYANCY

  ! --- AND THE HIGHEST LEVEL OF POSITIVE CAPE (INB)

  ! =====================================================================

  END DO

  ! Originial Code

  ! do 530 k=minorig+1,nl-1

  ! do 520 i=1,ncum

  ! if(k.ge.(icb(i)+1))then

  ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)

  ! byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)

  ! cape(i)=cape(i)+by

  ! if(by.ge.0.0)inb1(i)=k+1

  ! if(cape(i).gt.0.0)then

  ! inb(i)=k+1

  ! capem(i)=cape(i)

  ! endif

  ! endif

  ! 520    continue

  ! 530  continue

  ! do 540 i=1,ncum

  ! byp=(tvp(i,nl)-tv(i,nl))*dph(i,nl)/p(i,nl)

  ! cape(i)=capem(i)+byp

  ! defrac=capem(i)-cape(i)

  ! defrac=max(defrac,0.001)

  ! frac(i)=-cape(i)/defrac

  ! frac(i)=min(frac(i),1.0)

  ! frac(i)=max(frac(i),0.0)

  ! 540   continue

  ! K Emanuel fix

  ! call zilch(byp,ncum)

  ! do 530 k=minorig+1,nl-1

  ! do 520 i=1,ncum

  ! if(k.ge.(icb(i)+1))then

  ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)

  ! cape(i)=cape(i)+by

  ! if(by.ge.0.0)inb1(i)=k+1

  ! if(cape(i).gt.0.0)then

  ! inb(i)=k+1

  ! capem(i)=cape(i)

  ! byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)

  ! endif

  ! endif

  ! 520    continue

  ! 530  continue

  ! do 540 i=1,ncum

  ! inb(i)=max(inb(i),inb1(i))

  ! cape(i)=capem(i)+byp(i)

  ! defrac=capem(i)-cape(i)

  ! defrac=max(defrac,0.001)

  ! frac(i)=-cape(i)/defrac

  ! frac(i)=min(frac(i),1.0)

  ! frac(i)=max(frac(i),0.0)

  ! 540   continue

  ! J Teixeira fix

  END DO

        END IF

      END IF

    END DO

  END DO

  END DO

  ! =====================================================================

  ! ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL

  ! =====================================================================

        hp(i, k) = h(i, nk(i)) + (lv(i,k)+(cpd-cpv)*t(i,k))*ep(i, k)*clw(i, k &

      END IF

    END DO

  END DO

  ! =====================================================================

  ! ---  CALCULATE CLOUD BASE MASS FLUX AND RATES OF MIXING, M(I),

  ! --- AT EACH MODEL LEVEL

  ! =====================================================================

  ! tvpplcl = parcel temperature lifted adiabatically from level

  ! icb-1 to the LCL.

  ! tvaplcl = virtual temperature at the LCL.

    tvpplcl(i) = tvp(i, icb(i)-1) - rd*tvp(i, icb(i)-1)*(p(i,icb(i)-1)-plcl(i &

    tvaplcl(i) = tv(i, icb(i)) + (tvp(i,icb(i))-tvp(i,icb(i)+1))*(plcl(i)-p(i &

  END DO

  ! -------------------------------------------------------------------

  ! --- Interpolate difference between lifted parcel and

  ! --- environmental temperatures to lifted condensation level

  ! -------------------------------------------------------------------

  ! dtpbl = average of tvp-tv in the PBL (k=nk to icb-1).

      END IF

    END DO

  END DO

  END DO

  ! -------------------------------------------------------------------

  ! --- Adjust cloud base mass flux

  ! -------------------------------------------------------------------

    END IF

  END DO

  ! -------------------------------------------------------------------

  ! --- Calculate rates of mixing,  m(i)

  ! -------------------------------------------------------------------

        dbo = abs(tv(i,k+1)-tvp(i,k+1)-tv(i,k-1)+tvp(i,k-1)) + &

      END IF

    END DO

  END DO

      END IF

    END DO

  END DO

  ! =====================================================================

  ! --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING

  ! --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING

  ! --- FRACTION (sij)

  ! =====================================================================

          dei = denom

          stemp = sij(ij, i, j)

          END IF

            uent(ij, i, j) = sij(ij, i, j)*u(ij, i) + &

            vent(ij, i, j) = sij(ij, i, j)*v(ij, i) + &

            elij(ij, i, j) = altem

          END IF

        END IF

      END DO

    END DO

    ! ***   If no air can entrain at level i assume that updraft detrains

    ! ***

    ! ***   at that level and calculate detrained air flux and properties

    ! ***

      END IF

    END DO

  END DO

  END DO

  ! =====================================================================

  ! ---  NORMALIZE ENTRAINED AIR MASS FLUXES

  ! ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING

  ! =====================================================================

  END DO

    num1 = 0

    END DO

      END IF

    END DO

      num2 = 0

        IF ((i>=icb(ij)+1) .AND. (i<=inb(ij)) .AND. (j>=icb( &

      END DO

        IF ((i>=icb(ij)+1) .AND. (i<=inb(ij)) .AND. (j>=icb( &

              sjmax = smid

              sjmin = smid

              END IF

            ELSE

              sjmin = 0.0

            END IF

          END IF

        END IF

      END DO

      END IF

    END DO

        IF ((i>=icb(ij)+1) .AND. (i<=inb(ij)) .AND. (j>=icb( &

        END IF

      END DO

    END DO

      IF ((i>=icb(ij)+1) .AND. (i<=inb(ij)) .AND. (bsum(ij, &

      END IF

    END DO

  ! =====================================================================

  ! --- PRECIPITATING DOWNDRAFT CALCULATION

  ! =====================================================================

  ! ***  Check whether ep(inb)=0, if so, skip precipitating    ***

  ! ***             downdraft calculation                      ***

  ! ***  Integrate liquid water equation to find condensed water   ***

  ! ***                and condensed water flux                    ***

    ELSE

    END IF

  END DO

  ! ***                    Begin downdraft loop                    ***