      SUBROUTINE CONV17(T,QH,U,V,PCP,PCPS,PRESSG,TCV,PBLT,DEL,SHJ,
     1                 SHBJ, TF, WST, UTG, VTG, SHTJ, XH,
     2                 DQLDT,ZXQL,RGASV,HNO3ROW,NH3ROW,NH4ROW,
     3                 CO2ROW,O3ROW,SSO3ROW,SSHPROW,
     4                 SDO3ROW,SDHPROW, PHSROW, PHDROW,
     5                 CAPEROW, BCDROW, BCSROW, TCDROW, TCSROW,CDCBROW,
     6                 CSCBROW,DEPBROL, BCDROL, TCDROL,
     7                 WDD4ROW,WDD6ROW,WDS4ROW,WDS6ROW,
     8                 CLCVROW,SO4CROW,QFXROW,TFXROW,WDDDROW,
     9                 WDDBROW,WDDOROW,WDDSROW,WDSDROW,WDSBROW,WDSOROW,
     A                 WDSSROW,
     B                 CBMF,CQFXROW,CHFXROW,SCLF,SCDN,SLWC,
     C                 CVMCROW,DMCROW,SMCROW,DMCUROW,DMCDROW,CINHROW,
     D                 TTPM,TTPC,QTPM,QTPC,XTPM,XTPC,
     +                 CSCBROL, CDCBROL, DMCROL,
     E                 ILEV,ILEVM,LEV,ILG,IL1,IL2,
     F                 RGAS,GRAV,CPRES,DELT,ZTMST,JLAT,JLATPR,KOUNT,
     G                 ISVCHEM,ISVCONV,SAVERAD,IFIZCON,
     H                 NTRAC,ITRAC,ISULF,ITRPHS,ITRCCH,
     I                 ISO2,ISO4,IHPO,ISSA,ISSC,IDUA,IDUC,IBCO,IBCY,
     J                 IOCO,IOCY,IPAM)
C
C     * FEB 27/2017 - M.LAZARE.    NUPS removed.
C     * JUN 24/2013 - K.VONSALZEN/ New routine for gcm18:
C     *               M.LAZARE.    - GCROW removed (only was in call
C     *                              to TRANSC9).
C     *                            - Calls to new routines TRANSC10
C     *                              and CONTRA9.
C     * JUN 24/2013 - K.VONSALZEN/ Previous version CONV16 for gcm17:
C     *               M.LAZARE/    - PLA option added, resulting
C     *               M.NAMAZI.      in new called subroutines
C     *                              TRANSC9,CONTRA8,SCPRP7.
C     *                            - BUDCOR/sources/sinks now
C     *                              calculated for all tracers
C     *                              for both bulk and PLA aerosols,
C     *                              regardless of "ISVCHEM" setting.
C     *                              This results in new called
C     *                              subroutine TRANSC9, TDCAL6 and
C     *                              CONTRA8.
C     *                            - BC deposition calculated and
C     *                              passed out as DEPBROL.
C     * APR 30/2012 - M.LAZARE.    PREVIOUS VERSION CONV15 FOR GCM16:
C     *                            - CALLS NEW CONTRA7 AND CLOSUR10.
C     * APR 23/2010 - M.LAZARE/    PREVIOUS VERSION CONV14 FOR GCM15I:
C     *               K.VONSALZEN. - CALLS NEW CONTRA6,XTEND8.
C     *                            - REVISED DIAGNOSTIC FIELDS.
C     *                            - PHYSICS WORK ARRAY "CO2ROW" IN
C     *                              PPV NOW PASSED IN INSTEAD OF
C     *                              CONSTANT CO2_PPM (MORE GENERAL
C     *                              FOR CARBON CYCLE APPLICATIONS).
C     *                            - EXPLICT SOURCE/SINK CALCULATION
C     *                              FOR EACH TRACER (XSRC/XSNK).
C     * FEB 16/2009 - M.LAZARE/    PREVIOUS VERSION CONV13 FOR GCM15H:
C     *                            - BUGFIX TO USE GATHERED PRESSG FOR
C     *                              SHALLOW CONVECTION.
C     *                            - SET CLOUD BASE MASS FLUX (CBMF) TO
C     *                              ZERO OUTSIDE DEEP IN CASE THERE
C     *                              ARE LATITUDES WITHOUT POSITIVE CAPE.
C     *                            - INITIALIZE CHFX AND CQFX AT START
C     *                              BEFORE DEEP IN CASE THERE ARE
C     *                              LATITUDES WITHOUT POSITIVE CAPE.
C     *                            - TUNING OF C0FAC.
C     *                            - CALLS TO REVISED NEW ROUTINES:
C     *                              CLDPRPC, CONTRA5 AND
C     *                              TRANSC7/SCPRP5.
C     * DEC 18/2007 - M.LAZARE/    PREVIOUS VERSION CONV12 FOR GCM15G:
C     *               K.VONSALZEN. - ADD CALCULATIONS FOR DIAGNOSTIC
C     *                              FIELDS: WDS4,WDS6,WDD4.
C     *                            - PASS IN "ADELT" FROM PHYSICS AS
C     *                              ZTMST AND USE DIRECTLY, RATHER THAN
C     *                              PASSING IN DELT AND FORMING
C     *                              ZTMST=2.*DELT INSIDE.
C     *                            - CALLS NEW TDCAL4,CLOSUR9,CONTRA4.
C     * NOV 26/2006 - M.LAZARE/    PREVIOUS VERSION CONV11 FOR GCM15F:
C     *               K.VONSALZEN. - CALCULATE NEW DIAGNOSTIC FIELDS
C     *                              DMCROW AND SMCROW UNDER CONTROL
C     *                              OF "ISVCONV". THIS INCLUDES ADDING
C     *                              AN INTERNAL WORK ARRAY "SMCT" FOR
C     *                              INTERFACING WITH TRANSC5 TO CALCULATE
C     *                              THE SHALLOW PART.
C     * JUL 30/2006 - M.LAZARE.    - C0FAC NOW DEFINED IN DATA STATEMENT
C     *                              AND PASSED TO CLDPRPB AND CONTRA3,
C     *                              TO ENSURE CONSISTENT USEAGE.
C     * MAY 27/2006 - M.LAZARE.    - "ZERO","CLDCVM" DATA CONSTANTS
C     *                              ADDED AND USED IN CALLS TO
C     *                              INTRINSICS.
C     *                            - NOW USES INTERNAL WORK ARRAYS
C     *                              INSTEAD OF PASSED WORKSPACE.
C     *                            - CALLS TO OTHER SUBROUTINES NO
C     *                              LONGER USE THE INTERNAL WORKSPACE
C     *                              VA(IVA); RATHER THE CALLED ROUTINES
C     *                              ALSO USE INTERNAL WORKSPACE. THIS
C     *                              RESULTS IN NEW ROUTINES: TRANSC5,
C     *                              MOMENT2, EVALSC3, TQTEND2, CONTRA3,
C     *                              CLOSUR8, CLDPRPB, BUOYANA.
C     *                            - UNUSED COMMON BLOCK EPSICE REMOVED.
C     * MAY 04/2006 - M.LAZARE/    PREVIOUS VERSION CONV10 FOR GCM15E:
C     *               K.VONSALZEN. - CALLS NEW BUOYAN9,TRANSC4,CLDPRPA.
C     *                              THIS REQUIRES PASSING IN EPS2.
C     *                            - CALCULATION OF SATURATION VAPOUR
C     *                              PRESSURE MODIFIED TO WORK OVER
C     *                              COMPLETE VERTICAL DOMAIN, BY
C     *                              SPECIFYING LIMIT AS ES->P.
C     *                              THIS ELIMINATES THE NEED FOR
C     *                              "MSGPHYS" AND "MTOP", WHICH
C     *                              ARE REMOVED IN THE CALL, AND WE
C     *                              SET MSG=0 SO THAT WE DON'T HAVE TO
C     *                              MODIFY ALL THE SUBSEQUENT ROUTINES.
C     *                            - STORE MASS FLUX IN NEW PROGNOSTIC
C     *                              ARRAY "CVMC", TO BE USED
C     *                              SUBSEQUENTLY IN PROVIDING CONVECTIVE
C     *                              CONTRIBUTION TO CLOUD VARIANCE.
C     * DEC 14/2005 - K.VONSALZEN/ PREVIOUS VERSION CONV9 FOR GCM15D.
C     *               M.LAZARE.
C
C     * PERFORMS DEEP CONVECTIVE ADJUSTMENT BASED ON MASS-FLUX CLOSURE
C     * ALGORITHM.

C     ************************ INDEX OF VARIABLES **********************
C     *  I     => INPUT ARRAYS.
C     * I/O    => INPUT/OUTPUT ARRAYS.
C     *  W     => WORK ARRAYS.
C     *  WG    => WORK ARRAYS OPERATING ONLY ON GATHERED POINTS.
C     * IC     => INPUT DATA CONSTANTS.
C     *  C     => DATA CONSTANTS PERTAINING TO SUBROUTINE ITSELF.

C  WG * ACOR     CORRECTION FACTOR FOR CLOUD BASE MASS FLUX.
C  WG * ACORX    CORRECTION FACTOR FOR CLOUD BASE MASS FLUX FOR TRACERS.
C  WG * ALPHA    ARRAY OF VERTICAL DIFFERENCING USED (=1. FOR UPSTREAM).
C  WG * BETAD    DOWNWARD MASS FLUX AT CLOUD BASE.
C  WG * BETAU    UPWARD   MASS FLUX AT CLOUD BASE.
C  W  * CAPE     CONVECTIVE AVAILABLE POTENTIAL ENERGY.
C  WG * CAPEG    GATHERED CONVECTIVE AVAILABLE POTENTIAL ENERGY.
C  C  * CAPELMT  THRESHOLD VALUE FOR CAPE FOR DEEP CONVECTION.
C IC  * CPRES    SPECIFIC HEAT AT CONSTANT PRESSURE IN J/KG-DEGK.
C  O  * CHFXROW  FLUX OF LIQUID WATER STATIC ENERGY (POSITIVE UPWARD)
C     *          AT CLOUD BASE.
C  O  * CQFXROW  FLUX OF TOTAL WATER MIXING RATIO (POSITIVE UPWARD)
C     *          AT CLOUD BASE.
C  O  * CVMC     MASS-FLUX (SAVED AS OUTPUT FIELD FOR CLOUD VARIANCE).
C  I  * DEL      LOCAL SIGMA HALF-LEVEL THICKNESS (I.E. DSHJ).
C IC  * DELT     LENGTH OF MODEL TIME-STEP IN SECONDS.
C IC  * ZTMST    LENGTH OF MODEL ADVECTION TIME-STEP IN SECONDS.
C I/O * DMCROW   GRID SLICE OF DEEP MASS FLUX IN KG/M2-S (ISVCONV).
C I   * CO2ROW   GRID SLICE OF CO2 (PPV)
C I/O * DMCUROW  GRID SLICE OF UPWARD DEEP MASS FLUX IN KG/M2-S (ISVCONV).
C I/O * DMCDROW  GRID SLICE OF DOWNWD DEEP MASS FLUX IN KG/M2-S (ISVCONV).
C  WG * DP       LAYER THICKNESS IN MBS (BETWEEN UPPER/LOWER INTERFACE).
C  WG * DQDT     MIXING RATIO TENDENCY AT GATHERED POINTS.
C  WG * DSDT     DRY STATIC ENERGY ("TEMP") TENDENCY AT GATHERED POINTS.
C  WG * DSR      DENSITY RATIO RHO(AIR)/RHO(DRY_AIR). UNITS: KG/M**3.
C  WG * DUDT     U-WIND TENDENCY AT GATHERED POINTS.
C  WG * DVDT     V-WIND TENDENCY AT GATHERED POINTS.
C  WG * DXDT     TRACER TENDENCY AT GATHERED POINTS.
C  WG * DSUBCLD  LAYER THICKNESS IN MBS BETWEEN LCL AND MAXI.
C IC  * GRAV     ACCELERATION DUE TO GRAVITY IN M/SEC2.
C  WG * DU       DETRAINMENT IN UPDRAFT.
C  WG * ED       ENTRAINMENT IN DOWNDRAFT.
C  WG * EDO      ENTRAINMENT IN DOWNDRAFT (PASSED FROM CLDPRPB TO CONTRA3).
C  WG * EU       ENTRAINMENT IN UPDRAFT.
C  WG * HMN      MOIST STATIC ENERGY.
C  WG * HSAT     SATURATED MOIST STATIC ENERGY.
C  W  * IDEEP    HOLDS POSITION OF GATHERED POINTS VS LONGITUDE INDEX.
C IC  * ILEV     NUMBER OF MODEL LEVELS.
C IC  * ILEVM    ILEV-1.
C IC  * ILG      LON+2 = SIZE OF GRID SLICE.
C IC  * IL1,IL2  START AND END LONGITUDE INDICES FOR LATITUDE CIRCLE.
C IC  * ISVCHEM  SWITCH TO SAVE EXTRA CHEMISTRY  FIELDS (=1) OR NOT (=0).
C IC  * ISVCONV  SWITCH TO SAVE EXTRA CONVECTION FIELDS (=1) OR NOT (=0).
C  WG * J0       DETRAINMENT INITIATION LEVEL INDEX.
C  WG * JD       DOWNDRAFT   INITIATION LEVEL INDEX.
C IC  * JLAT     GAUSSIAN LATITUDE INDEX.
C IC  * JLATPR   GAUSSIAN LATITUDE INDEX FOR PRINTING GRIDS (IF NEEDED).
C  WG * JT       TOP  LEVEL INDEX OF DEEP CUMULUS CONVECTION.
C IC  * KOUNT    CURRENT MODEL TIMESTEP NUMBER.
C  W  * LCL      BASE LEVEL INDEX OF DEEP CUMULUS CONVECTION.
C  WG * LCLG     GATHERED VALUES OF LCL.
C  W  * LEL      INDEX OF HIGHEST THEORETICAL CONVECTIVE PLUME.
C  WG * LELG     GATHERED VALUES OF LEL.
C  W  * LON      INDEX OF ONSET LEVEL FOR DEEP CONVECTION.
C  WG * LONG     GATHERED VALUES OF LON.
C IC  * LEV      ILEV+1.
C  W  * MAXI     INDEX OF LEVEL WITH LARGEST MOIST STATIC ENERGY.
C  WG * MAXG     GATHERED VALUES OF MAXI.
C  WG * MB       CLOUD BASE MASS FLUX.
C  WG * MC       NET UPWARD (SCALED BY MB) CLOUD MASS FLUX.
C  WG * MD       DOWNWARD CLOUD MASS FLUX (POSITIVE UP).
C  WG * MU       UPWARD   CLOUD MASS FLUX (POSITIVE UP).
C  W  * P        GRID SLICE OF AMBIENT MID-LAYER PRESSURE IN MBS.
C  I  * PBLT     ROW OF PBL TOP INDICES.
C I/O * PCP      ROW OF PRECIPITABLE WATER IN METRES.
C  W  * PCPDH    SCALED SURFACE PRESSURE.
C  W  * PF       GRID SLICE OF AMBIENT INTERFACE PRESSURE IN MBS.
C  WG * PG       GRID SLICE OF GATHERED VALUES OF P.
C  I  * PRESSG   ROW OF SURFACE PRESSURE IN PA.
C  W  * Q        GRID SLICE OF MIXING RATIO.
C  WG * QD       GRID SLICE OF MIXING RATIO IN DOWNDRAFT.
C  WG * QDB      ROW OF QD AT CLOUD BASE.
C  WG * QG       GRID SLICE OF GATHERED VALUES OF Q.
C I/O * QH       GRID SLICE OF SPECIFIC HUMIDITY.
C  W  * QH0      GRID SLICE OF INITIAL SPECIFIC HUMIDITY.
C  WG * QHAT     GRID SLICE OF UPPER INTERFACE MIXING RATIO.
C  WG * QL       GRID SLICE OF CLOUD LIQUID WATER.
C  WG * QS       GRID SLICE OF SATURATION MIXING RATIO.
C  W  * QSTP     GRID SLICE OF PARCEL TEMP. SATURATION MIXING RATIO.
C  WG * QSTPG    GRID SLICE OF GATHERED VALUES OF QSTP.
C  WG * QU       GRID SLICE OF MIXING RATIO IN UPDRAFT.
C  IC * RGAS     TOTAL (WET) AIR GAS CONSTANT.
C  WG * RL       ROW OF LATENT HEAT OF VAPORIZATION.
C  W  * S        GRID SLICE OF SCALED DRY STATIC ENERGY (T+GZ/CP).
C  O  * SCDN     CLOUD DROPLET NUMBER CONCENTRATION IN 1/M3.
C  O  * SCLF     CLOUD FRACTION (0..1.)
C  WG * SD       GRID SLICE OF DRY STATIC ENERGY IN DOWNDRAFT.
C  WG * SDB      ROW OF SD AT CLOUD BASE.
C  WG * SG       GRID SLICE OF GATHERED VALUES OF S.
C  WG * SHAT     GRID SLICE OF UPPER INTERFACE DRY STATIC ENERGY.
C  I  * SHBJ     GRID SLICE OF LOCAL BOTTOM INTERFACE SIGMA VALUES.
C  I  * SHJ      GRID SLICE OF LOCAL HALF-LEVEL SIGMA VALUES.
C  I  * SHTJ     ROW OF LOCAL TOP INTERFACES OF FIRST LEVEL.
C  O  * SLWC     GRID-CELL MEAN CLOUD WATER CONTENT IN KG/KG.
C I/O * SMCROW   GRID SLICE OF SHALLOW MASS FLUX IN KG/M2-S (ISVCONV).
C  WG * SU       GRID SLICE OF DRY STATIC ENERGY IN UPDRAFT.
C  WG * SUMDQ    ROW OF VERTICALLY-INTEGRATED SCALED MIXING RATIO CHANGE.
C  WG * SUMDT    ROW OF VERTICALLY-INTEGRATED DRY STATIC ENERGY CHANGE.
C  WG * SUMDX    ROW OF VERTICALLY-INTEGRATED TRACER VALUES.
C  WG * SUMDX2   CHAINED-LATITUDE SUM OF VERTICALLY-INTEGRATED TRACER
C                VALUES (FOR CONSERVATION CHECK).
C  WG * SUMQ     ROW OF VERTICALLY-INTEGRATED MIXING RATIO CHANGE.
C I/O * T        GRID SLICE OF TEMPERATURE AT MID-LAYER.
C  O  * TCV      ROW OF TOP-OF-DEEP-CONVECTION INDICES PASSED OUT.
C  W  * TF       GRID SLICE OF TEMPERATURE AT INTERFACE.
C  WG * TG       GRID SLICE OF GATHERED VALUES OF T.
C  W  * TL       ROW OF PARCEL TEMPERATURE AT LCL.
C  WG * TLG      GRID SLICE OF GATHERED VALUES OF TL.
C  W  * TP       GRID SLICE OF PARCEL TEMPERATURES.
C  WG * TPG      GRID SLICE OF GATHERED VALUES OF TP.
C I/O * U        GRID SLICE OF U-WIND (REAL).
C  WG * UG       GRID SLICE OF GATHERED VALUES OF U.
C I/O * UTG      GRID SLICE OF U-WIND TENDENCY (REAL).
C I/O * V        GRID SLICE OF V-WIND (REAL).
C  WG * VG       GRID SLICE OF GATHERED VALUES OF V.
C I/O * VTG      GRID SLICE OF V-WIND TENDENCY (REAL).
C  I  * W        GRID SLICE OF DIAGNOSED LARGE-SCALE VERTICAL VELOCITY.
C  O  * WST      ROW OF WSTAR FROM SHALLOW CONVECTION.
C  W  * X        GRID SLICE OF TRACER MIXING RATIOS.
C  W  * XD       GRID SLICE OF CLOUD DOWNDRAFT TRACER VALUES.
C  W  * XG       GRID SLICE OF GATHERED TRACER VALUES.
C I/O * XH       GRID SLICE OF TRACERS (POSSIBLY NOT MIXING RATIO).
C  W  * XHAT     GRID SLICE OF UPPER INTERFACE TRACER VALUES.
C  W  * XU       GRID SLICE OF CLOUD UPDRAFT TRACER VALUES.
C  W  * Z        GRID SLICE OF AMBIENT MID-LAYER HEIGHT IN METRES.
C  W  * ZF       GRID SLICE OF AMBIENT INTERFACE HEIGHT IN METRES.
C  WG * ZFG      GRID SLICE OF GATHERED VALUES OF ZF.
C  WG * ZG       GRID SLICE OF GATHERED VALUES OF Z.
C     ******************************************************************
C
      IMPLICIT REAL   (A-H,O-Z),
     +INTEGER (I-N)

      PARAMETER (NTRACA=6)
      PARAMETER (NEQP=13 )
C
C     * GENERAL I/O FIELDS:
C
      REAL  , DIMENSION(ILG,LEV,NTRAC)   :: XH
      REAL  , DIMENSION(ILG,ILEV)        :: T,QH,U,V,UTG,VTG
      REAL  , DIMENSION(ILG,ILEV)        :: SCLF,SCDN,SLWC,ZXQL,DQLDT
      REAL  , DIMENSION(ILG,ILEV)        :: DEL,SHJ,SHBJ,TF,SO4CROW
      REAL  , DIMENSION(ILG)             :: PCP,PCPS,TCV,PRESSG,PBLT,
     1                                      WST,SHTJ,QFXROW,
     2                                      TFXROW,CBMF
      INTEGER,DIMENSION(NTRAC)           :: ITRPHS,ITRCCH
C
C     * PHYSICS TENDENCIES (ONLY IF IFIZCON.NE.0):
C
      REAL  , DIMENSION(ILG,ILEV,NTRAC)  :: XTPM,XTPC
      REAL  , DIMENSION(ILG,ILEV)        :: TTPM,TTPC,QTPM,QTPC
C
C     * CHEMISTRY CONSTITUENT INPUT FIELDS:
C
      REAL  , DIMENSION(ILG,ILEV)        :: HNO3ROW,NH3ROW,NH4ROW,
     1                                      CO2ROW,O3ROW
C
C     * OTHER OPTIONALLY-SAVED FIELDS:
C
      REAL  , DIMENSION(ILG,ILEV)        :: PHSROW,PHDROW,CDPHROW,
     3                                      CLCVROW,CVMCROW,
     4                                      DMCROW,SMCROW,
     5                                      DMCUROW,DMCDROW,DMCROL
      REAL  , DIMENSION(ILG)             :: SSHPROW,SSO3ROW,
     1                                      WDSDROW,WDSBROW,
     2                                      WDSOROW,WDSSROW,
     3                                      SCMTROW,WDS4ROW,
     4                                      WDS6ROW,SDHPROW,
     5                                      SDO3ROW,
     B                                      CAPEROW,BCDROW,BCSROW,
     C                                      TCDROW,TCSROW,CDCBROW,
     D                                      CSCBROW,CINHROW,WDD6ROW,
     E                                      CQFXROW,CHFXROW,
     F                                      WDDDROW,WDDBROW,
     G                                      WDDOROW,WDDSROW,
     G                                      WDD4ROW,DEPBROL,
     +                                      CSCBROL, CDCBROL,
     +                                      BCDROL,TCDROL
C
C***************************************************
C     * INTERNAL WORK FIELDS:
C***************************************************
C
C     * GENERAL WORK FIELDS:
C
      REAL  , DIMENSION(ILG,ILEV,NTRAC)  :: X
      REAL  , DIMENSION(ILG,ILEV,NTRACA) :: XGA
      REAL  , DIMENSION(ILG,NTRAC)       :: ACORX,XSRC,XSNK,XSRC1,XSRC2
      REAL  , DIMENSION(ILG,ILEV)        :: Q,P,Z,S,QH0,TP,ZF,PF,PFG,
     1                                      QSTP,DSR
      REAL  , DIMENSION(ILG)             :: CAPE,TL,SUMQ,PCPDH,RL,SUMDT,
     1                                      SUMDQ,WRK,ACOR
      INTEGER,DIMENSION(ILG)             :: LCL,LEL,LON,MAXI,IDEEP
C
C     * SELECTED GATHERED WORK FIELDS OF ABOVE:
C
      REAL  , DIMENSION(ILG,ILEV,NTRAC)  :: XG
      REAL  , DIMENSION(ILG,ILEV)        :: QG,PG,ZG,SG,TG,QSTPG,TPG,
     1                                      ZFG,UG,VG,DSRG
      REAL  , DIMENSION(ILG)             :: PRESSGG,CAPEG,TLG
      INTEGER,DIMENSION(ILG)             :: LCLG,LELG,LONG,MAXG
C
C     * WORK FIELDS ARISING FROM DEEP CONVECTION CALCULATIONS.
C
      REAL  , DIMENSION(ILG,ILEV,NTRAC)  :: XU,XD,XHAT,DXDT
      REAL  , DIMENSION(ILG,NTRAC)       :: SUMDX
      REAL  , DIMENSION(ILG,ILEV)        :: MU,EU,DQDT,DSDT,DU,MD,ED,
     1                                      ALPHA,SD,QD,MC,QHAT,QU,SU,
     2                                      QS,SHAT,DP,HMN,HSAT,QL,
     3                                      DQLDTG,DUO,MDO,EUO,EDO,DZO,
     4                                      CLDCV,DUDT,DVDT
      REAL  , DIMENSION(ILG)             :: BETAU,BETAD,QDB,SDB,
     1                                      DSUBCLD,MB,EPS0
      INTEGER,DIMENSION(ILG)             :: JT,J0,JD
      REAL  , DIMENSION(NTRAC)           :: SUMDX2
C
C     * WORK ARRAYS FOR SHALLOW CONVECTION ADJUSTMENT.
C
      REAL  , DIMENSION(ILG,ILEV,NTRAC)  :: DXFDT
      REAL  , DIMENSION(ILG,ILEV)        :: DZ,DSFDT,DQFDT,MCT,SMCT
      REAL  , DIMENSION(ILG)             :: CAPEP
      INTEGER,DIMENSION(ILG)             :: LPTMP,ICLOS,ISHALL,LPBL

      COMMON /ADJPCP/ HC,HF,HM,AA,DEPTH,LHEAT,MOIADJ,MOIFLX
      COMMON /EPS   / A,B,EPS1,EPS2
      COMMON /HTCP  / TFREEZ,T2S,AI,BI,AW,BW,SLP
C
C     * PARAMETERS USED IN NEW SATURATION VAPOUR PRESSURE FORMULATION.
C
      COMMON /ESTWI/ RW1,RW2,RW3,RI1,RI2,RI3

      LOGICAL MOMENTM
C
      PARAMETER ( RGOCP = 2./7. )
      PARAMETER ( RRL   = 2.501E+06 )
      PARAMETER ( TVFA  = 0.608 )
C
C     * STATEMENT FUNCTION TO CALCULATE SATURATION VAPOUR PRESSURE
C     * OVER WATER.
C
      ESW(TTT)    = EXP(RW1+RW2/TTT)*TTT**RW3

      DATA CAPELMT / 0.    /
      DATA MOMENTM /.FALSE./
      DATA ZERO    / 0.    /
      DATA CLDCVM  / 0.35  /
      DATA C0FAC   / 2.E-02/
C-----------------------------------------------------------------------
C     * INITIALIZE NECESSARY ARRAYS.
C
      IU = 1
      IV = IU+1
      INH3  = IV+1
      IHNO3 = INH3+1
      IO3   = IHNO3+1
      ICO2  = IO3+1
      DO 10 L=1,ILEV
      DO 10 IL=IL1,IL2
         DSR(IL,L)=1./(1.-QH(IL,L))
   10 CONTINUE
C
      DO 20 L=1,ILEV
      DO 20 IL=IL1,IL2
        MCT  (IL,L)=0.
        DSFDT(IL,L)=0.
        DQFDT(IL,L)=0.
   20 CONTINUE
C
      DO 40 N=1,NTRAC
      DO 40 L=1,ILEV
      DO 40 IL=IL1,IL2
         DXFDT(IL,L,N)=0.
         DXDT (IL,L,N)=0.
   40 CONTINUE
C
      DO 45 L=1,ILEV
        DO 45 IL=IL1,IL2
            TTPM(IL,L)=0.
            QTPM(IL,L)=0.
            TTPC(IL,L)=0.
            QTPC(IL,L)=0.
   45 CONTINUE
C
      IF(IFIZCON.NE.0)                                       THEN
         IF(ITRAC.NE.0)                                 THEN
            DO 47 N=1,NTRAC
            DO 47 L=1,ILEV
            DO 47 IL=IL1,IL2
               XTPC(IL,L,N)=0.
               XTPM(IL,L,N)=0.
   47       CONTINUE
         ENDIF
      ENDIF
C
      DO 50 IL=IL1,IL2
          PCP    (IL) = 0.
          DSUBCLD(IL) = 0.
          SUMQ   (IL) = 0.
          SUMDT  (IL) = 0.
          SUMDQ  (IL) = 0.
          PCPDH  (IL) = PRESSG(IL)*DEPTH
          TCV    (IL) = FLOAT(ILEV)
          CQFXROW(IL) = 0.
          CHFXROW(IL) = 0.
          CDCBROL(IL) = 0.0
          CSCBROL(IL) = 0.0
   50 CONTINUE
C
      IF(ITRAC.NE.0)        THEN
C
C       * COPY XH INTO THE WORK ARRAY. IT IS ASSUMED THAT XH IS IN UNITS
C       * OF KG-TRACER PER KG OF TOTAL (WET) AIR. IN THE FOLLOWING, THE
C       * TRACER MIXING RATIOS ARE IN UNITS OF KG-TRACER PER KG OF DRY AIR.
C
        DO 54 N=1,NTRAC
        DO 54 L=1,ILEV
        DO 54 IL=IL1,IL2
            X(IL,L,N)=XH(IL,L+1,N)*DSR(IL,L)
   54   CONTINUE
      ENDIF
C
C     * CALCULATE LOCAL PRESSURE (MBS) AND HEIGHT (M) FOR BOTH INTERFACE
C     * AND MID-LAYER LOCATIONS.
C
      DO 55 IL=IL1,IL2
        P (IL,1) = SHJ (IL,1) * PRESSG(IL) * 0.01
        PF(IL,1) = SHTJ(IL)   * PRESSG(IL) * 0.01
   55 CONTINUE
C
      DO 60 L=2,ILEV
      DO 60 IL=IL1,IL2
        P (IL,L)   = SHJ (IL,L)   * PRESSG(IL) * 0.01
        PF(IL,L)   = SHBJ(IL,L-1) * PRESSG(IL) * 0.01
   60 CONTINUE

      ROG=RGAS/GRAV
      DO 70 IL=IL1,IL2
        Z (IL,ILEV) = ROG*TF(IL,ILEV)*LOG(0.01*PRESSG(IL)/P (IL,ILEV))
        ZF(IL,ILEV) = ROG*T (IL,ILEV)*LOG(0.01*PRESSG(IL)/PF(IL,ILEV))
        DZ(IL,ILEV) = ZF(IL,ILEV)
   70 CONTINUE

      DO 80 L=ILEVM,1,-1
      DO 80 IL=IL1,IL2
        Z (IL,L) = Z (IL,L+1) + ROG*TF(IL,L)*LOG(P (IL,L+1)/P (IL,L))
        ZF(IL,L) = ZF(IL,L+1) + ROG*T (IL,L)*LOG(PF(IL,L+1)/PF(IL,L))
        DZ(IL,L) = ZF(IL,L)-ZF(IL,L+1)
   80 CONTINUE
C
      MSG=0
C
C    * STORE INCOMING SPECIFIC HUMIDITY FIELD FOR SUBSEQUENT CALCULATION
C    * OF PRECIPITATION (THROUGH CHANGE IN STORAGE).
C    * CONVERT FROM SPECIFIC HUMIDITY TO MIXING RATIO.
C    * DEFINE DRY STATIC ENERGY (NORMALIZED BY CP).
C
      DO 100 L=1,ILEV
      DO 100 IL=IL1,IL2
          QH0(IL,L)    = QH(IL,L)
          Q(IL,L)      = QH(IL,L)*DSR(IL,L)
          S(IL,L)      = T(IL,L) + (GRAV/CPRES)*Z(IL,L)
          DQLDT(IL,L)  = 0.
          ZXQL (IL,L)  = 0.
          CLCVROW(IL,L)= 0.
          CVMCROW(IL,L)= 0.
          TP(IL,L)     = T(IL,L)
          QSTP(IL,L)   = Q(IL,L)
  100 CONTINUE
C
C     * EVALUATE CONVECTIVE AVAILABLE POTENTIAL ENERGY (CAPE).
C
      CALL BUOYANA(Z,P,PF,T,Q,PRESSG,ILEV,ILEVM,ILG,IL1,IL2,
     1             MSG,RRL,GRAV,CPRES,EPS1,EPS2,A,B,RGAS,RGASV,
     2             TVFA,RGOCP,MAXI,LCL,LEL,LPBL,TL,CAPE,CAPEP,
     3             TP,QSTP,HMN,PBLT                                  )
C
C     *****************************************************************
C     * PERFORM DEEP CONVECTIVE ADJUSTMENT.
C     *****************************************************************
C
C     * DETERMINE WHETHER GRID POINTS WILL UNDERGO SOME DEEP CONVECTION
C     * (IDEEP=1) OR NOT (IDEEP=0), BASED ON VALUES OF CAPE,LCL,LEL
C     * (REQUIRE CAPE.GT.CAPELMT AS MINIMUM CONDITIONS).
C
      JYES = 0
      JNO  = IL2 - IL1 + 2
      DO 150 IL=IL1,IL2
        IF(CAPE(IL) .GT. CAPELMT)     THEN
           JYES        = JYES + 1
           IDEEP(JYES) = IL
        ELSE
           JNO         = JNO  - 1
           IDEEP(JNO)  = IL
        ENDIF
C
        IF(ISVCONV.NE.0)                             THEN
           CAPEROW(IL)=CAPEROW(IL)+CAPE(IL)*SAVERAD
           CINHROW(IL)=CINHROW(IL)+(CAPE(IL)-CAPEP(IL))*SAVERAD
        ENDIF
  150 CONTINUE
      LENGATH = JYES
      IF(LENGATH.EQ.0)                                         THEN
C
C        * SKIP TO SHALLOW CONVECTION.
C
         GO TO 500
      ENDIF
C
C     * OBTAIN GATHERED ARRAYS NECESSARY FOR ENSUING CALCULATIONS.
C
      DO 155 L=1,ILEV
      DO 155 K=1,LENGATH
        DP   (K,L) = 0.01 * PRESSG(IDEEP(K)) * DEL(IDEEP(K),L)
        QG   (K,L) = Q   (IDEEP(K),L)
        TG   (K,L) = T   (IDEEP(K),L)
        PG   (K,L) = P   (IDEEP(K),L)
        PFG  (K,L) = PF  (IDEEP(K),L)
        ZG   (K,L) = Z   (IDEEP(K),L)
        SG   (K,L) = S   (IDEEP(K),L)
        TPG  (K,L) = TP  (IDEEP(K),L)
        ZFG  (K,L) = ZF  (IDEEP(K),L)
        QSTPG(K,L) = QSTP(IDEEP(K),L)
        UG   (K,L) = U   (IDEEP(K),L)
        VG   (K,L) = V   (IDEEP(K),L)
        DSRG (K,L) = DSR (IDEEP(K),L)
  155 CONTINUE
C
      IF(ITRAC.NE.0) THEN
         DO 158  N=1,NTRAC
         DO 158  L=1,ILEV
         DO 158  K=1,LENGATH
              XG   (K,L,N) = X   (IDEEP(K),L,N)
  158     CONTINUE
      ENDIF
C
      DO 160 K=1,LENGATH
        PRESSGG(K) = PRESSG(IDEEP(K))
        CAPEG  (K) = CAPE  (IDEEP(K))
        LCLG   (K) = LCL   (IDEEP(K))
        LELG   (K) = LEL   (IDEEP(K))
        LONG   (K) = LON   (IDEEP(K))
        MAXG   (K) = MAXI  (IDEEP(K))
        TLG    (K) = TL    (IDEEP(K))
        MB     (K) = CBMF  (IDEEP(K))
  160 CONTINUE
C
C     * CALCULATE SUB-CLOUD LAYER PRESSURE "THICKNESS" FOR USE IN
C     * CLOSURE AND TENDENCY ROUTINES.
C
      DO 170 L=MSG+1,ILEV
      DO 170 K=1,LENGATH
        IF(L.EQ.MAXG(K))                                        THEN
          DSUBCLD(K) = DSUBCLD(K) + DP(K,L)/DSRG(K,L)
      ENDIF
  170 CONTINUE
C
C     * DEFINE ARRAY OF FACTORS (ALPHA) WHICH DEFINES INTERFACIAL
C     * VALUES, AS WELL AS INTERFACIAL VALUES FOR (Q,S) USED IN
C     * SUBSEQUENT ROUTINES.
C
      DO 175 L=MSG+2,ILEV
      DO 175 K=1,LENGATH
        ALPHA(K,L)=1.0
        SDIFR=0.
        QDIFR=0.
        IF(SG(K,L).GT.0. .OR. SG(K,L-1).GT. 0. )
     1     SDIFR=ABS((SG(K,L)-SG(K,L-1))/MAX(SG(K,L-1),SG(K,L)))
        IF(QG(K,L).GT.0. .OR. QG(K,L-1).GT. 0. )
     1     QDIFR=ABS((QG(K,L)-QG(K,L-1))/MAX(QG(K,L-1),QG(K,L)))
        IF(SDIFR .GT. 1.E-3)                             THEN
           SHAT(K,L)=LOG(SG(K,L-1)/SG(K,L))*SG(K,L-1)*SG(K,L)
     1               /(SG(K,L-1)-SG(K,L))
        ELSE
           SHAT(K,L)=0.5*(SG(K,L)+SG(K,L-1))
        ENDIF
        IF(QDIFR .GT. 1.E-3)                             THEN
           QHAT(K,L)=LOG(QG(K,L-1)/QG(K,L))*QG(K,L-1)*QG(K,L)
     1               /(QG(K,L-1)-QG(K,L))
        ELSE
           QHAT(K,L)=0.5*(QG(K,L)+QG(K,L-1))
        ENDIF
  175 CONTINUE
C
      IF(ITRAC.NE.0) THEN
         DO 177 N=1,NTRAC
         DO 177 L=MSG+2,ILEV
         DO 177 K=1,LENGATH
           XHAT(K,L,N)=0.5*(XG(K,L,N)+XG(K,L-1,N))
 177     CONTINUE
      ENDIF
C
C     * OBTAIN CLOUD PROPERTIES.
C
      CALL CLDPRPC(QG,TG,PG,ZG,SG,MU,EU,DU,MD,ED,SD,QD,MC,QU,SU,ZFG,QS,
     1             HMN,HSAT,ALPHA,SHAT,QL,
     2             EUO,EDO,DZO,DUO,MDO,EPS0,
     4             MAXG,LELG,JT,MAXG,J0,JD,WRK,ITRPHS,
     5             ILEV,ILG,1,LENGATH,C0FAC,RGAS,GRAV,CPRES,MSG       )
C
C     * DETERMINE CLOUD BASE MASS FLUX.
C
      DO 180 K=1,LENGATH
          QDB(K)=QD(K,MAXG(K))
          SDB(K)=SD(K,MAXG(K))
        BETAD(K)=MD(K,MAXG(K))
        BETAU(K)=MU(K,MAXG(K))
  180 CONTINUE
C
C     * CONVERT DETRAINMENT FROM UNITS OF "1/M" TO "1/MB".
C
      DO 185 L=MSG+1,ILEV-1
      DO 185 K=1,LENGATH
        DU(K,L)=DU(K,L)*(ZFG(K,L)-ZFG(K,L+1))*DSRG(K,L)/DP(K,L)
 185  CONTINUE
C
      DO 188 K=1,LENGATH
        DU(K,ILEV)=DU(K,ILEV)*ZFG(K,ILEV)*DSRG(K,ILEV)/DP(K,ILEV)
 188  CONTINUE
C
      CALL CLOSUR10(QG,TG,PG,ZG,SG,TPG,QS,QU,SU,MC,DU,MU,MD,QD,SD,ALPHA,
     1             QHAT,SHAT,DP,QSTPG,ZFG,QL,DSUBCLD,MB,QDB,SDB,DSRG,
     2             UG,VG,BETAU,BETAD,CAPEG,TLG,LCLG,LELG,JT,MAXG,J0,
     3             DELT,ILEV,ILG,1,LENGATH,RGAS,GRAV,CPRES,MSG,CAPELMT)
C
C     * LIMIT CLOUD BASE MASS FLUX TO THEORETICAL UPPER BOUND.
C     * NO DEEP IS DONE FOR PATHOLOGICAL CASE WHERE THE LIFTING
C     * CONDENSATION LEVEL IS AT OR ABOVE THE MINIMUM OF HSAT.
C
      DO 190 L=MSG+2,ILEV
      DO 190 K=1,LENGATH
        IF(MU(K,L).GT.0.)                                       THEN
          MB(K)=MIN( MB(K) , DP(K,L)/(ZTMST*MU(K,L)*DSRG(K,L)) )
        ENDIF
  190 CONTINUE
C
C     * FURTHER RESTRICTIONS ON MB.
C
      DO 192 K=1,LENGATH
          MB(K)=MAX( MB(K) , ZERO)
          IF(TG(K,JT(K)).GE.273. .OR. LCLG(K).LE.J0(K))    MB(K)=0.
  192 CONTINUE
C
      DO 200 L=MSG+1,ILEV
      DO 200 K=1,LENGATH
        MU(K,L)=MU(K,L)*MB(K)
        MD(K,L)=MD(K,L)*MB(K)
        MC(K,L)=MC(K,L)*MB(K)
        DU(K,L)=DU(K,L)*MB(K)
        EU(K,L)=EU(K,L)*MB(K)
        ED(K,L)=ED(K,L)*MB(K)
        DUDT(K,L)=0.
        DVDT(K,L)=0.
  200 CONTINUE

      DO 300 K=1,LENGATH
        BETAU(K)=BETAU(K)*MB(K)
        BETAD(K)=BETAD(K)*MB(K)
  300 CONTINUE
C
C     * FLUXES OF TOTAL WATER MIXING RATIO AND LIQUID WATER STATIC ENERGY
C     * AT CLOUD BASE. POSITIVE SIGN FOR UPWARD FLUXES.
C
      DO 305 K=1,LENGATH
        L=MAXG(K)
        CQFXROW(IDEEP(K))=MB(K)*100./GRAV
     1      *(MU(K,L)*(QL(K,L)+QU(K,L))+MD(K,L)*QD(K,L)
     2      -MC(K,L)*QG(K,L-1))
        CHFXROW(IDEEP(K))=MB(K)*100.*CPRES/GRAV
     1      *(MU(K,L)*(SU(K,L)-RRL*QL(K,L)/CPRES)+MD(K,L)*SD(K,L)
     2      -MC(K,L)*SG(K,L-1))
  305 CONTINUE
C
C     * COMPUTE TEMPERATURE AND MOISTURE CHANGES DUE TO CONVECTION.
C
      CALL TQTEND2(DQDT,DSDT,QG,SG,QS,QU,SU,MC,DU,QHAT,SHAT,DP,
     1             MU,MD,SD,QD,QL,DQLDTG,DSRG,
     2             DSUBCLD,MB,JT,MAXG,
     3             ZTMST,ILEV,ILG,1,LENGATH,CPRES,MSG           )
C
C     * DETERMINE CHANGE IN COLUMN STORAGE DUE TO DEEP CONVECTION.
C
      DO 310 L=MSG+1,ILEV
      DO 310 IL=1,LENGATH
        SUMQ(IL)  = SUMQ(IL) - DEL(IDEEP(IL),L)*DQDT(IL,L)*ZTMST
     1                                                     /DSRG(IL,L)
  310 CONTINUE
C
C     * OBTAIN FINAL PRECIPITATION RATE.
C
      DO 320 IL=1,LENGATH
        PCP(IDEEP(IL))  = PCP(IDEEP(IL)) + PCPDH(IDEEP(IL))
     1                                   * MAX(SUMQ(IL),ZERO)
  320 CONTINUE
C
      DO 330 L=MSG+1,ILEV
      DO 330 K=1,LENGATH
         ATEMPO=PCP(IDEEP(K))*1000.*86400./ZTMST
         CLDCV(K,L)=0.
         IF ( ATEMPO.GT.0. ) THEN
            CLDCV(K,L)=1.5*MIN(MAX(0.246+0.125*LOG(ATEMPO),ZERO),CLDCVM)
         END IF
  330 CONTINUE
C
      IF(ISVCONV.NE.0)                             THEN
        DO 340 K=1,LENGATH
          IF ( MB(K).GT.0. ) THEN
            CDCBROW(IDEEP(K))=CDCBROW(IDEEP(K)) + 1.*SAVERAD
             BCDROW(IDEEP(K))= BCDROW(IDEEP(K)) +
     1                         100.*PFG(K,LCLG(K))*SAVERAD
             TCDROW(IDEEP(K))= TCDROW(IDEEP(K)) +
     1                         100.*PFG(K,JT(K))*SAVERAD
          ENDIF
  340   CONTINUE
      ENDIF

      DO K=1,LENGATH
         IF ( MB(K).GT.0. ) THEN
            CDCBROL(IDEEP(K))=1.0
            BCDROL(IDEEP(K)) = 100.*PFG(K,LCLG(K))
            TCDROL(IDEEP(K)) = 100.*PFG(K,JT(K))
         ENDIF
      END DO ! K
C
C     * TRACER INITIALIZATIONS.
C
      IF(ITRAC.NE.0)                                                THEN
C
C       * ALL CHEMICAL SPECIES WHICH ARE NOT SUBJECT TO
C       * OTHER PROCESSES THAN CLOUD-CHEMICAL PROCESSES.
C       * CONVERSION FROM VMR TO KG-S/KG-AIR.
C
        ACONV=32.06/28.84
        DO 350 L=1,ILEV
        DO 350 K=1,LENGATH
           XGA(K,L,IU)=UG(K,L)
           XGA(K,L,IV)=VG(K,L)
           XGA(K,L,INH3 ) = ACONV*(NH3ROW(IDEEP(K),L)
     1                            +NH4ROW(IDEEP(K),L))
           XGA(K,L,IHNO3) = ACONV*HNO3ROW(IDEEP(K),L)
           XGA(K,L,IO3  ) = ACONV*O3ROW(IDEEP(K),L)
           XGA(K,L,ICO2 ) = ACONV*CO2ROW(IDEEP(K),L)
  350   CONTINUE
C
C       * DETERMINE UPDRAFT AND DOWNDRAFT PROPERTIES FOR COMPONENTS
C       * OF SULPHUR CYCLE.
C
        DO 360 N=1,NTRAC
        DO 360 K=1,LENGATH
          SUMDX(K,N)=0.
  360   CONTINUE
        CALL CONTRA9 (XG,XU,XD,DXDT,DUDT,DVDT,XGA,SUMDX,CLDCV,WRK,
     1                IDEEP,DUO,EUO,EDO,MU,MD,MDO,QL,QG,TG,PG,PFG,DZO,
     2                DP,PRESSGG,MB,EPS0,MAXG,JT,MAXG,JD,ITRPHS,ITRCCH,
     3                XSRC,XSNK,PHDROW,DSRG,NTRAC,
     4                NTRACA,IU,IV,INH3,IHNO3,
     6                IO3,ICO2,ISO2,ISO4,IHPO,ISSA,ISSC,IDUA,IDUC,
     7                C0FAC,EPS1,RGAS,GRAV,ROG,ILG,ILEV,1,LENGATH,
     8                MSG,ZTMST,NEQP,ISVCHEM,IPAM )
      ENDIF
C
C     * COMPUTE MOMENTUM CHANGES DUE TO CONVECTION, IF DESIRED (I.E
C     * IF LOGICAL SWITCH SET).
C
      IF(MOMENTM)                                                   THEN
        CALL MOMENT2(DUDT,DVDT,DU,ALPHA,DP,ED,EU,MC,MD,MU,
     1              PG,QD,QU,QHAT,SD,SU,SHAT,TG,UG,VG,ZG,ZFG,
     2              DSRG,DSUBCLD,MAXG,JD,JT,
     3              MSG,ZTMST,GRAV,CPRES,RGAS,ILEV,1,LENGATH,ILG,JLAT)
      ENDIF
C
C     * PRINT OUT QUANTITIES.
C
      IF(JLAT.EQ.JLATPR)                                       THEN
           CALL IPNTROW(IDEEP,'IDEEP','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(CAPEG,'CAPE','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(MB,'MB','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL IPNTROW(LONG,'LON','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL IPNTROW(MAXG,'MAX','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL IPNTROW(LCLG,'LCL','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL IPNTROW(LELG,'LEL','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL IPNTROW(JT,'JT','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL IPNTROW(J0,'J0','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL IPNTROW(JD,'JD','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(QG,'Q','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(TG,'T','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(PG,'P','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(ZG,'Z','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(ZFG,'ZF','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(UG,'U','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(VG,'V','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(TPG,'TP','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(QSTPG,'QSTP','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(MU,'MU','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(EU,'EU','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(DU,'DU','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(MD,'MD','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(ED,'ED','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(SD,'SD','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(QD,'QD','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(QU,'QU','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(SU,'SU','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(SG,'S','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(QL,'QL','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(QS,'QS','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(HMN,'HMN','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(HSAT,'HSAT','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(MC,'MC','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(QHAT,'QHAT','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(SHAT,'SHAT','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(DP,'DP','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(DSUBCLD,'DSUBCLD','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(QDB,'QDB','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(SDB,'SDB','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(BETAU,'BETAU','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(BETAD,'BETAD','INSIDE CONV9',1,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(DQDT,'DQDT','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(DSDT,'DSDT','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(DUDT,'DUDT','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           CALL PRNTROW(DVDT,'DVDT','INSIDE CONV9',ILEV,1,
     1                  ILG,1,LENGATH,JLAT)
           IF(ITRAC.NE.0) THEN
              DO 440 N=1,NTRAC
                 PRINT *,'DXDT FOR TRACER NO.: ',N
                 CALL PRNTROW(DXDT(1,1,N),'DXDT','INSIDE CONV9',ILEV,1,
     1                        ILG,1,LENGATH,JLAT)
 440          CONTINUE
           ENDIF
      ENDIF
C
      DO 450 L=MSG+1,ILEV
      DO 450 K=1,LENGATH
        U(IDEEP(K),L) = U(IDEEP(K),L) + ZTMST*DUDT(K,L)
        V(IDEEP(K),L) = V(IDEEP(K),L) + ZTMST*DVDT(K,L)
        UTG(IDEEP(K),L)=UTG(IDEEP(K),L)+DUDT(K,L)
        VTG(IDEEP(K),L)=VTG(IDEEP(K),L)+DVDT(K,L)
        CLCVROW(IDEEP(K),L)=CLDCV (K,L)
        CVMCROW(IDEEP(K),L)=MC    (K,L)*100./GRAV
        ZXQL   (IDEEP(K),L)=QL    (K,L)
        DQLDT  (IDEEP(K),L)=DQLDTG(K,L)
  450 CONTINUE
C
      DO 470 K=1,LENGATH
        TCV (IDEEP(K)) = FLOAT(JT(K))
        CBMF(IDEEP(K)) = MB(K)
  470 CONTINUE
C
C     * SET SPECIFIC HUMIDITY AND TEMPERATURE TENDENCIES.
C
      DO 480 L=MSG+1,ILEV
      DO 480 K=1,LENGATH
         MCT  (IDEEP(K),L)=100.*MU(K,L)
         DSFDT(IDEEP(K),L)=DSFDT(IDEEP(K),L)+DSDT(K,L)
         DQFDT(IDEEP(K),L)=DQFDT(IDEEP(K),L)+DQDT(K,L)
         QTPC(IDEEP(K),L) = DQDT(K,L)
         TTPC(IDEEP(K),L) = DSDT(K,L)
  480 CONTINUE
C
      IF(ISVCONV.NE.0)                             THEN
C
C       *** DIAGNOSTICS.
C
        DO 481 L=MSG+1,ILEV
        DO 481 K=1,LENGATH
          DMCROW (IDEEP(K),L) = DMCROW (IDEEP(K),L)
     1                        + MC(K,L)*100./GRAV*SAVERAD
          DMCUROW(IDEEP(K),L) = DMCUROW(IDEEP(K),L)
     1                        + MU(K,L)*100./GRAV*SAVERAD
          DMCDROW(IDEEP(K),L) = DMCDROW(IDEEP(K),L)
     1                        + MD(K,L)*100./GRAV*SAVERAD
  481   CONTINUE
      ENDIF

C INSTANT SAMPLE OF DMC
        DO L=MSG+1,ILEV
          DO K=1,LENGATH
            DMCROL (IDEEP(K),L) = MC(K,L)*100./GRAV
          END DO ! K
        END DO ! L
C
C     * SET TRACERS TENDENCIES.
C
      IF(ITRAC.NE.0 )                                            THEN
         DO 485 N=1,NTRAC
           IF(ITRPHS(N).GT.0)            THEN
             DO 483 L=MSG+1,ILEV
             DO 483 K=1,LENGATH
               DXFDT(IDEEP(K),L,N)=DXFDT(IDEEP(K),L,N)+DXDT(K,L,N)
               IF(IFIZCON.NE.0)                              THEN
                 XTPC(IDEEP(K),L,N) = DXDT(K,L,N)
               ENDIF
  483        CONTINUE
           ENDIF
  485    CONTINUE
      ENDIF
C
C     * DIAGNOSE RESIDUAL SOURCE/SINK TERMS.
C
      DO 488 N=1,NTRAC
        IF (ITRPHS(N).GT.0)                                      THEN
          DO 486 K=1,LENGATH
            SUMDX(K,N)=0.
  486     CONTINUE
C
          DO 487 L=MSG+1,ILEV
          DO 487 K=1,LENGATH
            SUMDX(K,N)=SUMDX(K,N)+DXDT(K,L,N)*DEL(IDEEP(K),L)
     1                           *PRESSG(IDEEP(K))/GRAV/DSRG(K,L)
  487     CONTINUE
        ENDIF
  488 CONTINUE
C
      XSRC1(1:LENGATH,:)=0.
      XSRC2(1:LENGATH,:)=0.
      IF (IPAM .EQ. 0)  THEN
        XSRC1(1:LENGATH,ISO4)=XSRC(1:LENGATH,ISO4)
     1                       +XSRC(1:LENGATH,IHPO)
        XSRC2(1:LENGATH,ISO4)=-XSRC(1:LENGATH,IHPO)
        XSRC1(1:LENGATH,ISO2)=-XSRC1(1:LENGATH,ISO4)
        XSRC2(1:LENGATH,ISO2)=-XSRC2(1:LENGATH,ISO4)
      ENDIF
      CALL BUDCOR(XSRC1,XSRC2,XSNK,SUMDX,1,LENGATH,ILG,NTRAC)
      XSRC1(1:LENGATH,:)=MAX(XSRC1(1:LENGATH,:),0.)
      XSRC2(1:LENGATH,:)=MAX(XSRC2(1:LENGATH,:),0.)
      XSNK (1:LENGATH,:)=MAX(XSNK (1:LENGATH,:),0.)
C
      IF(ISVCHEM.NE.0)                           THEN
        DO K=1,LENGATH
          IL=IDEEP(K)
          WDD4ROW(IL)=WDD4ROW(IL)+XSNK (K,ISO2)*SAVERAD
          IF ( IPAM.EQ.0 ) THEN
            SDO3ROW(IL)=SDO3ROW(IL)+XSRC1(K,ISO4)*SAVERAD
            SDHPROW(IL)=SDHPROW(IL)+XSRC2(K,ISO4)*SAVERAD
            WDD6ROW(IL)=WDD6ROW(IL)+XSNK (K,ISO4)*SAVERAD
            WDDDROW(IL)=WDDDROW(IL)+XSNK (K,IDUA)*SAVERAD
            WDDDROW(IL)=WDDDROW(IL)+XSNK (K,IDUC)*SAVERAD
            WDDBROW(IL)=WDDBROW(IL)+XSNK (K,IBCO)*SAVERAD
            WDDBROW(IL)=WDDBROW(IL)+XSNK (K,IBCY)*SAVERAD
            WDDOROW(IL)=WDDOROW(IL)+XSNK (K,IOCO)*SAVERAD
            WDDOROW(IL)=WDDOROW(IL)+XSNK (K,IOCY)*SAVERAD
            WDDSROW(IL)=WDDSROW(IL)+XSNK (K,ISSA)*SAVERAD
            WDDSROW(IL)=WDDSROW(IL)+XSNK (K,ISSC)*SAVERAD
          ENDIF
        ENDDO
      ENDIF
C
      IF ( IPAM.EQ.0 )THEN
        DO K=1,LENGATH
          IL=IDEEP(K)
          DEPBROL(IL)=DEPBROL(IL)+XSNK(K,IBCO)+XSNK(K,IBCY)
        ENDDO
      ENDIF
C
  500 CONTINUE
C
C     * SET CLOUD-BASE MASS FLUX TO ZERO WHEN NOT GATHERED.
C
      DO 501 K=LENGATH+1,IL2
         CBMF(IDEEP(K))=0.
  501 CONTINUE
C
C     * OBTAIN INITIAL PARCEL AND CLOUD BASE MASS FLUX.
C     * DEFINE GATHERED POINTS UPON WHICH SHALLOW WILL ACT.
C
      CALL EVALSC3(T,Q,Z,P,DZ,MB,QFXROW,TFXROW,MAXI,LPBL,
     1             ICLOS,ISHALL,ILG,ILGG,IL1,IL2,ILEV,MSG,GRAV,
     2             EPS1,RGAS,RGASV,RGOCP,TVFA,WST             )
C
C     * INITIALIZE FIELDS IN CASE NO SHALLOW POINTS AROUND CHAINED
C     * LATITUDE CIRCLE.
C
      DO 505 IL=IL1,IL2
        PCPS(IL)=0.
  505 CONTINUE
C
      IF(ISVCONV.NE.0)                             THEN
        DO 508 L=1,ILEV
        DO 508 IL=IL1,IL2
          SMCT   (IL,L)=0.
  508   CONTINUE
      ENDIF

C
      IF(ILGG.GT.0)                                              THEN
C
C       *****************************************************************
C       * PERFORM SHALLOW CONVECTIVE ADJUSTMENT.
C       *****************************************************************
C
        IF(JLAT.EQ.JLATPR) THEN
         PRINT*,'ILG = ',ILG,' ILGG = ',ILGG
         CALL IPNTROW(ISHALL,'ISHALL','INSIDE CONV9',1,1,
     1                 ILG,1,ILGG,JLAT)
         CALL IPNTROW(LPTMP,'LPTMP','INSIDE CONV9',1,1,
     1                  ILG,IL1,IL2,JLAT)
         CALL PRNTROW(QFXROW,'QFXROW','INSIDE CONV9',1,1,
     1                  ILG,IL1,IL2,JLAT)
         CALL PRNTROW(TFXROW,'TFXROW','INSIDE CONV9',1,1,
     1                  ILG,IL1,IL2,JLAT)
         CALL PRNTROW(PBLT,'PBLT','INSIDE CONV9',1,1,
     1                  ILG,IL1,IL2,JLAT)
         CALL PRNTROW(MB,'MB','INSIDE CONV9',1,1,
     1                  ILG,IL1,IL2,JLAT)
        ENDIF
C
C       *** ADDITIONAL TRACERS.
C
        IF ( ITRAC.NE.0 .AND. ISULF.NE.0 ) THEN
           DO 510 L=1,ILEV
           DO 510 IL=IL1,IL2
              XGA(IL,L,IU ) = 0.
              XGA(IL,L,IV ) = 0.
C
C           *** CONVERSION FROM VMR TO KG-S/KG-AIR.
C
              ACONV=32.06/28.84
              XGA(IL,L,INH3 ) = ACONV*(NH3ROW(IL,L)+NH4ROW(IL,L))
              XGA(IL,L,IHNO3) = ACONV*HNO3ROW(IL,L)
              XGA(IL,L,IO3  ) = ACONV*O3ROW(IL,L)
              XGA(IL,L,ICO2 ) = ACONV*CO2ROW(IL,L)
  510      CONTINUE
        END IF
C
C
        CALL TRANSC10(T,Q,X,XGA,P,PF,Z,ZF,DSDT,DQDT,DXDT,MCT,ISHALL,
     1               MAXI,MB,PRESSG,PCPS,ZTMST,RRL,A,B,EPS1,EPS2,
     2               GRAV,RGAS,RGASV,CPRES,ILEV,ILEVM,ILG,ILGG,
     3               IL1,IL2,MSG,MSGG,NTRAC,ITRAC,ISULF,NEQP,ITRPHS,
     4               NTRACA,INH3,IHNO3,IO3,ICO2,ISO2,ISO4,IHPO,ISSA,
     5               ISSC,IPAM,
     6               PHSROW,CSCBROW,CSCBROL,
     7               BCSROW,TCSROW,SO4CROW,
     8               CVMCROW,SMCT,CQFXROW,CHFXROW,SCLF,XSRC,XSNK,
     9               SCDN,SLWC,ISVCONV,ISVCHEM,ITRCCH,IDUA,IDUC,SAVERAD)
C
C       * CALCULATE CORRECTION FACTOR FOR SHALLOW TENDENCIES
C       * IN ORDER TO AVOID NEGATIVE VALUES IF IT HAPPENS THAT THE
C       * TOTAL TENDENCIES (DEEP+SHALLOW) ARE EXCESSIVE.
C
        AFS=0.999999999
        DO 520 IL=1,ILG
           ACOR (IL)=1.
  520   CONTINUE
        DO 522 N=1,NTRAC
        DO 522 IL=1,ILG
           ACORX(IL,N)=1.
  522   CONTINUE
        DO 525 L=MSG+1,ILEV
        DO 525 IL=1,ILGG
           DSDTMIN= -(AFS *(T(ISHALL(IL),L)
     1              +DSFDT(ISHALL(IL),L)*ZTMST))/ZTMST
           IF ( DSDT(IL,L).LT.DSDTMIN ) THEN
              ACORT=-(AFS*(T(ISHALL(IL),L)
     1             +DSFDT(ISHALL(IL),L)*ZTMST))/(DSDT(IL,L)*ZTMST)
              ACOR(IL)=MAX(MIN(ACOR(IL),ACORT),ZERO)
           END IF
           DQDTMIN=-(AFS*(Q(ISHALL(IL),L)
     1             +DQFDT(ISHALL(IL),L)*ZTMST))/ZTMST
           IF ( DQDT(IL,L).LT.DQDTMIN ) THEN
              ACORT=-(AFS*(Q(ISHALL(IL),L)
     1             +DQFDT(ISHALL(IL),L)*ZTMST))/(DQDT(IL,L)*ZTMST)
              ACOR(IL)=MAX(MIN(ACOR(IL),ACORT),ZERO)
           END IF
  525   CONTINUE
        IF(ITRAC.NE.0 )                                            THEN
          DO 527 N=1,NTRAC
            IF (ITRPHS(N).GT.0)                        THEN
             DO 526 L=MSG+1,ILEV
             DO 526 IL=1,ILGG
           DXDTMIN=-(AFS*(X(ISHALL(IL),L,N)
     1             +DXFDT(ISHALL(IL),L,N)*ZTMST))/ZTMST
           IF ( DXDT(IL,L,N).LT.DXDTMIN) THEN
                 ACORT=-(AFS*(X(ISHALL(IL),L,N)
     1                +DXFDT(ISHALL(IL),L,N)*ZTMST))
     2                 /(DXDT(IL,L,N)*ZTMST)
                 ACORX(IL,N)=MAX(MIN(ACORX(IL,N),ACORT),ZERO)
              END IF
  526        CONTINUE
            END IF
  527     CONTINUE
        END IF
C
C       * UPDATE SPECIFIC HUMIDITY AND TEMPERATURE TENDENCIES.
C
        DO 530 L=MSG+1,ILEV
        DO 530 IL=1,ILGG
           DSFDT(ISHALL(IL),L)=DSFDT(ISHALL(IL),L)+DSDT(IL,L)*ACOR(IL)
           DQFDT(ISHALL(IL),L)=DQFDT(ISHALL(IL),L)+DQDT(IL,L)*ACOR(IL)
  530   CONTINUE
C
        DO 533 IL=1,ILGG
           PCPS(ISHALL(IL))=PCPS(ISHALL(IL))*ACOR(IL)
  533   CONTINUE
C
        IF(ISVCONV.NE.0)                             THEN
C
C         *** DIAGNOSTICS.
C
          DO 535 L=MSG+1,ILEV
          DO 535 IL=1,ILGG
             SMCROW (ISHALL(IL),L)=SMCROW (ISHALL(IL),L)
     1                           +SMCT(ISHALL(IL),L)*ACOR(IL)*SAVERAD
  535     CONTINUE
C
        ENDIF
C
C       * UPDATE TRACERS TENDENCIES.
C
        IF(ITRAC.NE.0 )                                            THEN
          DO 540 N=1,NTRAC
            IF (ITRPHS(N).GT.0)                        THEN
             DO 538 L=MSG+1,ILEV
             DO 538 IL=1,ILGG
               DXFDT(ISHALL(IL),L,N)=DXFDT(ISHALL(IL),L,N)
     1                              +DXDT(IL,L,N)*ACORX(IL,N)
  538        CONTINUE
            ENDIF
  540     CONTINUE
        ENDIF
C
        SUMDX(1:ILGG,:)=0.
        DO 546 N=1,NTRAC
        DO 546 L=MSG+1,ILEV
        DO 546 K=1,ILGG
            SUMDX(K,N)=SUMDX(K,N)+DXDT(K,L,N)*ACORX(K,N)
     1                 *DEL(ISHALL(K),L)*PRESSG(ISHALL(K))/GRAV
     2                 /DSR(ISHALL(K),L)
  546   CONTINUE
C
        XSRC1(1:ILGG,:)=0.
        XSRC2(1:ILGG,:)=0.
        IF(IPAM.EQ.0)                                 THEN
          XSRC1(1:ILGG,ISO4)=(XSRC(1:ILGG,ISO4)
     1                      +XSRC(1:ILGG,IHPO))*ACORX(1:ILGG,ISO4)
          XSRC2(1:ILGG,ISO4)=-XSRC(1:ILGG,IHPO)*ACORX(1:ILGG,ISO4)
          XSRC1(1:ILGG,ISO2)=-XSRC1(1:ILGG,ISO4)*ACORX(1:ILGG,ISO2)
          XSRC2(1:ILGG,ISO2)=-XSRC2(1:ILGG,ISO4)*ACORX(1:ILGG,ISO2)
        ENDIF
        CALL BUDCOR(XSRC1,XSRC2,XSNK,SUMDX,1,ILGG,ILG,NTRAC)
        XSRC1(1:ILGG,:)=MAX(XSRC1(1:ILGG,:),0.)
        XSRC2(1:ILGG,:)=MAX(XSRC2(1:ILGG,:),0.)
        XSNK (1:ILGG,:)=MAX(XSNK (1:ILGG,:),0.)
C
        IF(ISVCHEM.NE.0)                           THEN
          DO K=1,ILGG
            IL=ISHALL(K)
            WDS4ROW(IL)=WDS4ROW(IL)+XSNK (K,ISO2)*SAVERAD
            IF(IPAM.EQ.0)                                 THEN
              SSO3ROW(IL)=SSO3ROW(IL)+XSRC1(K,ISO4)*SAVERAD
              SSHPROW(IL)=SSHPROW(IL)+XSRC2(K,ISO4)*SAVERAD
              WDS6ROW(IL)=WDS6ROW(IL)+XSNK (K,ISO4)*SAVERAD
              WDSDROW(IL)=WDSDROW(IL)+XSNK (K,IDUA)*SAVERAD
              WDSDROW(IL)=WDSDROW(IL)+XSNK (K,IDUC)*SAVERAD
              WDSBROW(IL)=WDSBROW(IL)+XSNK (K,IBCO)*SAVERAD
              WDSBROW(IL)=WDSBROW(IL)+XSNK (K,IBCY)*SAVERAD
              WDSOROW(IL)=WDSOROW(IL)+XSNK (K,IOCO)*SAVERAD
              WDSOROW(IL)=WDSOROW(IL)+XSNK (K,IOCY)*SAVERAD
              WDSSROW(IL)=WDSSROW(IL)+XSNK (K,ISSA)*SAVERAD
              WDSSROW(IL)=WDSSROW(IL)+XSNK (K,ISSC)*SAVERAD
            ENDIF
          ENDDO
        ENDIF
C
        IF(IPAM.EQ.0)                                           THEN
          DO K=1,ILGG
            IL=ISHALL(K)
            DEPBROL(IL)=DEPBROL(IL)+XSNK(K,IBCO)+XSNK(K,IBCY)
          ENDDO
        ENDIF
C
        IF(JLAT.EQ.JLATPR) THEN
         CALL PRNTROW(DSFDT,'DSFDT','INSIDE CONV9',ILEV,1,
     1                  ILG,IL1,IL2,JLAT)
         CALL PRNTROW(DQFDT,'DQFDT','INSIDE CONV9',ILEV,1,
     1                  ILG,IL1,IL2,JLAT)
        ENDIF
C
C       * UPDATE TENDENCIES IF IN "FIZ" MODE.
C
           DO 547 L=MSG+1,ILEV
           DO 547 IL=1,ILGG
              TTPM(ISHALL(IL),L)=DSDT(IL,L)*ACOR(IL)
              QTPM(ISHALL(IL),L)=DQDT(IL,L)*ACOR(IL)
  547      CONTINUE
C
        IF(IFIZCON.NE.0)                                       THEN
           IF(ITRAC.NE.0)                                 THEN
              DO 549 N=1,NTRAC
                IF (ITRPHS(N).GT.0)                               THEN
                  DO 548 L=MSG+1,ILEV
                  DO 548 IL=1,ILGG
                    XTPM(ISHALL(IL),L,N)=DXDT(IL,L,N)*ACORX(IL,N)
  548             CONTINUE
                ENDIF
  549         CONTINUE
           ENDIF
        ENDIF
      ENDIF
C
C    * CONVERT BACK TO SPECIFIC HUMIDITY FROM MIXING RATIO.
C    * TAKE INTO ACCOUNT ANY MOISTURE ADDED TO ENSURE POSITIVENESS
C    * OF SPECIFIC HUMIDITY AT START OF ROUTINE.
C
      DO 550 L=MSG+1,ILEV
      DO 550 IL=IL1,IL2
          T (IL,L) = T(IL,L) + ZTMST*DSFDT(IL,L)
          IF(DQFDT(IL,L).NE.0.)                             THEN
             Q (IL,L) = Q(IL,L) + ZTMST*DQFDT(IL,L)
             QH(IL,L) = Q(IL,L)/DSR(IL,L)
          ENDIF
  550 CONTINUE
C
      IF(ITRAC.NE.0) THEN
        DO 565 N=1,NTRAC
          IF (ITRPHS(N).GT.0)                        THEN
           DO 560 L=MSG+1,ILEV
           DO 560 IL=IL1,IL2
             X (IL,L,N)   = X(IL,L,N) + ZTMST*DXFDT(IL,L,N)
             XH(IL,L+1,N) = X(IL,L,N)/DSR(IL,L)
  560      CONTINUE
          ENDIF
  565   CONTINUE
      ENDIF
C
C     * CALCULATE CONSERVATION OF QUANTITIES.
C
      IF(JLAT.EQ.JLATPR)                                       THEN
        DO 800 L=MSG+1,ILEV
        DO 800 IL=IL1,IL2
          RL (IL)   = 2.501E6
          SUMDQ(IL) = SUMDQ(IL) + ZTMST*(RL(IL)/CPRES)*DEL(IL,L)*
     1                            DQFDT(IL,L)/DSR(IL,L)
          SUMDT(IL) = SUMDT(IL) + ZTMST*DEL(IL,L)*DSFDT(IL,L)
     1                                                      /DSR(IL,L)
  800   CONTINUE
C
        DO 900 IL=IL1,IL2
          WRK(IL) = SUMDT(IL) + SUMDQ(IL)
  900   CONTINUE

        CALL PRNTROW(  WRK,'  WRK','INSIDE CONV9',1,1,
     1               ILG,IL1,IL2,JLAT)
        CALL PRNTROW(SUMDT,'SUMDT','INSIDE CONV9',1,1,
     1               ILG,IL1,IL2,JLAT)
        CALL PRNTROW(SUMDQ,'SUMDQ','INSIDE CONV9',1,1,
     1               ILG,IL1,IL2,JLAT)
C
        IF(ITRAC.NE.0)        THEN
C
C         * INITIALIZE TRACER CONSERVATION FIELDS.
C
          DO 922 N=1,NTRAC
              SUMDX2(N)=0.
              DO 920 IL=IL1,IL2
                  SUMDX(IL,N)=0.
  920         CONTINUE
  922     CONTINUE
C
C         * DETERMINE ACCURACY OF CONSERVATION.
C
          DO 925 N=1,NTRAC
          DO 925 L=1,ILEV
          DO 925 IL=IL1,IL2
              SUMDX(IL,N)=SUMDX(IL,N)+ZTMST*DEL(IL,L)*DXFDT(IL,L,N)
     1                                                      /DSR(IL,L)
  925     CONTINUE
C
          DO 960 N=1,NTRAC
              DO 950 IL=IL1,IL2
                  SUMDX2(N)=SUMDX2(N)+SUMDX(IL,N)**2
  950         CONTINUE
              PRINT *, '0N,SUMDX2 = ',N,SUMDX2(N)
  960     CONTINUE
        ENDIF

      ENDIF
      RETURN
      END
