! $Header$

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

  ! SCCS IDENTIFICATION:  @(#)convect1.f	1.1 04/21/00

  ! 19:40:52 /h/cm/library/nogaps4/src/sub/fcst/convect1.f_v

  ! CONFIGURATION IDENTIFICATION:  None

  ! MODULE NAME:  convect1

  ! DESCRIPTION:

  ! convect1     The Emanuel Cumulus Convection Scheme

  ! 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 convect1(len,nd,noff,minorig,

  ! &                   t,q,qs,u,v,

  ! &                   p,ph,iflag,ft,

  ! &                   fq,fu,fv,precip,cbmf,delt)

  ! PARAMETERS:

  ! Name            Type         Usage            Description

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

  ! len           Integer        Input        first (i) dimension

  ! nd            Integer        Input        vertical (k) dimension

  ! ndp1          Integer        Input        nd + 1

  ! noff          Integer        Input        integer limit for convection

  ! (nd-noff)

  ! minorig       Integer        Input        First level of convection

  ! t             Real           Input        temperature

  ! q             Real           Input        specific hum

  ! qs            Real           Input        sat specific hum

  ! u             Real           Input        u-wind

  ! v             Real           Input        v-wind

  ! p             Real           Input        full level pressure

  ! ph            Real           Input        half level pressure

  ! iflag         Integer        Output       iflag on latitude strip

  ! ft            Real           Output       temp tend

  ! fq            Real           Output       spec hum tend

  ! fu            Real           Output       u-wind tend

  ! fv            Real           Output       v-wind tend

  ! cbmf          Real           In/Out       cumulus mass flux

  ! delt          Real           Input        time step

  ! iflag         Integer        Output       integer flag for Emanuel

  ! conditions

  ! 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

  ! convect2        Emanuel cumulus convection tendency calculations

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

  ! 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 len

  INTEGER nd

  INTEGER ndp1

  INTEGER noff

  REAL t(len, nd)

  REAL q(len, nd)

  REAL qs(len, nd)

  REAL u(len, nd)

  REAL v(len, nd)

  REAL p(len, nd)

  REAL ph(len, ndp1)

  INTEGER iflag(len)

  REAL ft(len, nd)

  REAL fq(len, nd)

  REAL fu(len, nd)

  REAL fv(len, nd)

  REAL precip(len)

  REAL cbmf(len)

  REAL ma(len, nd)

  INTEGER minorig

  REAL delt, cpd, cpv, cl, rv, rd, lv0, g

  REAL sigs, sigd, elcrit, tlcrit, omtsnow, dtmax, damp

  REAL alpha, entp, coeffs, coeffr, omtrain, cu

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

  ! --- ARGUMENTS

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

  ! --- On input:

  ! t:   Array of absolute temperature (K) of dimension ND, with first

  ! index corresponding to lowest model level. Note that this array

  ! will be altered by the subroutine if dry convective adjustment

  ! occurs and if IPBL is not equal to 0.

  ! q:   Array of specific humidity (gm/gm) of dimension ND, with first

  ! index corresponding to lowest model level. Must be defined

  ! at same grid levels as T. Note that this array will be altered

  ! if dry convective adjustment occurs and if IPBL is not equal to 0.

  ! qs:  Array of saturation specific humidity of dimension ND, with first

  ! index corresponding to lowest model level. Must be defined

  ! at same grid levels as T. Note that this array will be altered

  ! if dry convective adjustment occurs and if IPBL is not equal to 0.

  ! u:   Array of zonal wind velocity (m/s) of dimension ND, witth first

  ! index corresponding with the lowest model level. Defined at

  ! same levels as T. Note that this array will be altered if

  ! dry convective adjustment occurs and if IPBL is not equal to 0.

  ! v:   Same as u but for meridional velocity.

  ! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),

  ! where NTRA is the number of different tracers. If no

  ! convective tracer transport is needed, define a dummy

  ! input array of dimension (ND,1). Tracers are defined at

  ! same vertical levels as T. Note that this array will be altered

  ! if dry convective adjustment occurs and if IPBL is not equal to 0.

  ! p:   Array of pressure (mb) of dimension ND, with first

  ! index corresponding to lowest model level. Must be defined

  ! at same grid levels as T.

  ! ph:  Array of pressure (mb) of dimension ND+1, with first index

  ! corresponding to lowest level. These pressures are defined at

  ! levels intermediate between those of P, T, Q and QS. The first

  ! value of PH should be greater than (i.e. at a lower level than)

  ! the first value of the array P.

  ! nl:  The maximum number of levels to which convection can penetrate, plus

  ! 1.

  ! NL MUST be less than or equal to ND-1.

  ! delt: The model time step (sec) between calls to CONVECT

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

  ! ---   On Output:

  ! iflag: An output integer whose value denotes the following:

  ! VALUE   INTERPRETATION

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

  ! 0     Moist convection occurs.

  ! 1     Moist convection occurs, but a CFL condition

  ! on the subsidence warming is violated. This

  ! does not cause the scheme to terminate.

  ! 2     Moist convection, but no precip because ep(inb) lt 0.0001

  ! 3     No moist convection because new cbmf is 0 and old cbmf is 0.

  ! 4     No moist convection; atmosphere is not

  ! unstable

  ! 6     No moist convection because ihmin le minorig.

  ! 7     No moist convection because unreasonable

  ! parcel level temperature or specific humidity.

  ! 8     No moist convection: lifted condensation

  ! level is above the 200 mb level.

  ! 9     No moist convection: cloud base is higher

  ! then the level NL-1.

  ! ft:   Array of temperature tendency (K/s) of dimension ND, defined at

  ! same

  ! grid levels as T, Q, QS and P.

  ! fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,

  ! defined at same grid levels as T, Q, QS and P.

  ! fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,

  ! defined at same grid levels as T.

  ! fv:   Same as FU, but for forcing of meridional velocity.

  ! ftra: Array of forcing of tracer content, in tracer mixing ratio per

  ! second, defined at same levels as T. Dimensioned (ND,NTRA).

  ! precip: Scalar convective precipitation rate (mm/day).

  ! wd:   A convective downdraft velocity scale. For use in surface

  ! flux parameterizations. See convect.ps file for details.

  ! tprime: A convective downdraft temperature perturbation scale (K).

  ! For use in surface flux parameterizations. See convect.ps

  ! file for details.

  ! qprime: A convective downdraft specific humidity

  ! perturbation scale (gm/gm).

  ! For use in surface flux parameterizations. See convect.ps

  ! file for details.

  ! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST

  ! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT

  ! ITS NEXT CALL. That is, the value of CBMF must be "remembered"

  ! by the calling program between calls to CONVECT.

  ! det:   Array of detrainment mass flux of dimension ND.

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

  ! Local arrays

  INTEGER nl

  INTEGER nlp

  INTEGER nlm

  INTEGER i, k, n

  REAL delti

  REAL rowl

  REAL clmcpv

  REAL clmcpd

  REAL cpdmcp

  REAL cpvmcpd

  REAL eps

  REAL epsi

  REAL epsim1

  REAL ginv

  REAL hrd

  REAL prccon1

  INTEGER icbmax

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

  INTEGER ncum

  ! *** 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)                 ***

  damp = 0.1

  ! Define nl, nlp, nlm, and delti

  delti = 1.0/delt

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

  ! --- SET CONSTANTS

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

  rowl = 1000.0

  clmcpv = cl - cpv

  clmcpd = cl - cpd

  cpdmcp = cpd - cpv

  cpvmcpd = cpv - cpd

  eps = rd/rv

  epsi = 1.0/eps

  epsim1 = epsi - 1.0

  ginv = 1.0/g

  hrd = 0.5*rd

  prccon1 = 86400.0*1000.0/(rowl*g)

  ! dtmax is the maximum negative temperature perturbation.

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

  ! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS

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

    END DO

  END DO

  END DO

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

  ! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY

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

    END DO

  END DO

  ! gz = phi at the full levels (same as p).

  END DO

      gz(i, k) = gz(i, k-1) + hrd*(tv(i,k-1)+tv(i,k))*(p(i,k-1)-p(i,k))/ph(i, &

    END DO

  END DO

  ! h  = phi + cpT (dry static energy).

  ! hm = phi + cp(T-Tbase)+Lq

    END DO

  END DO

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

  ! --- Find level of minimum moist static energy

  ! --- If level of minimum moist static energy coincides with

  ! --- or is lower than minimum allowable parcel origin level,

  ! --- set iflag to 6.

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

  END DO

      END IF

    END DO

  END DO

    END IF

  END DO

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

  ! --- Find that model level below the level of minimum moist static

  ! --- energy that has the maximum value of moist static energy

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

  END DO

      END IF

    END DO

  END DO

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

  ! --- Check whether parcel level temperature and specific humidity

  ! --- are reasonable

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

    IF (((t(i,nk(i))<250.0) .OR. (q(i,nk(i))<=0.0) .OR. (p(i,ihmin(i))< &

  END DO

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

  ! --- Calculate lifted condensation level of air at parcel origin level

  ! --- (Within 0.2% of formula of Bolton, MON. WEA. REV.,1980)

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

  END DO

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

  ! --- Calculate first level above lcl (=icb)

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

  END DO

    END DO

  END DO

  END DO

  ! Compute icbmax.

  icbmax = 2

  END DO

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

  ! --- Calculates the lifted parcel virtual temperature at nk,

  ! --- the actual temperature, and the adiabatic

  ! --- liquid water content. The procedure is to solve the equation.

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

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

  END DO

  ! ***  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

  ! ***   Calculate lifted parcel quantities below cloud base   ***

    END DO

  END DO

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

    ! First iteration.

    ELSE

    END IF

    ! Second iteration.

    ELSE

    END IF

    alv = lv0 - clmcpv*(ticb(i)-273.15)

  END DO

    END DO

  END DO

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

  ! --- Test for instability.

  ! --- If there was no convection at last time step and parcel

  ! --- is stable at icb, then set iflag to 4.

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

  END DO

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

  ! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY

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

    END IF

  END DO

  ! Call convect2, which compresses the points and computes the heating,

  ! moistening, velocity mixing, and precipiation.

  ! print*,'cpd avant convect2 ',cpd

    CALL convect2(ncum, idcum, len, nd, ndp1, nl, minorig, nk, icb, t, q, qs, &

      u, v, gz, tv, tp, tvp, clw, h, lv, cpn, p, ph, ft, fq, fu, fv, tnk, &

      qnk, gznk, plcl, precip, cbmf, iflag, delt, cpd, cpv, cl, rv, rd, lv0, &

      g, sigs, sigd, elcrit, tlcrit, omtsnow, dtmax, damp, alpha, entp, &

  END IF

END SUBROUTINE convect1