C**********************************************************                  DGRMLT.2     
C             SUBROUTINE DGRMLT                                              DGRMLT.3     
C**********************************************************                  DGRMLT.4     
      SUBROUTINE DGRMLT                                                      DGRMLT.5     
C                                                                            DGRMLT.6     
C     COMPUTE DIABATIC TENDENCIES IN GRID POINT SPACE FOR PRESENT LAT.       DGRMLT.7     
C     ACCUMULATE TIME AVERAGES FOR PRINTED OUTPUT AND HISTORY                DGRMLT.8     
C     ASSUMES OUTPUT AND HISTORY TIMESTEPS ARE SYNCHRONISED                  DGRMLT.9     
C                                                                            DGRMLT.10    
C     Full Physics                                                           DGRMLT.11    
C     Piers 6/2/97 Version 2.0                                               DGRMLT.12    
C     Water vapour (things beginning with Q have changed                     DGRMLT.13    
C     into tracer no 1)                                                      DGRMLT.14    
C     and converted from Volume mixing  ratio to Mass mixing ratio           DGRMLT.15    
C     As water vapour advection is now done in Flux form                     DGRMLT.16    
C                                                                            PARAM1.2     
C     Determines model resolution                                            PARAM1.3     
C                                                                            PARAM1.4     
      PARAMETER(NN=21,MM=21,NHEM=2,NL=5,MOCT=1,MG=64,JG=16,NWJ2=121          NETCDF.35    
     P         ,NCRAY=64,JGL=JG,NTRAC=1,NLEVRF=1)                            NETCDF.36    
                                                                             PARAM1.7     
C                                                                            PARAM1.8     
C                                                                            PARAM2.2     
C     Sets basic constants, especially those needed for array dimensions     PARAM2.3     
C                                                                            PARAM2.4     
      PARAMETER(MH=2,PI=3.14159265359,PI2=2.0*PI                             PARAM2.5     
     +,NNP=NN+1,MGPP=MG+2,JGP=JG+1,JGG=JG*NHEM,JGGP=JGG+1,MJP=NWJ2+NWJ2      PARAM2.6     
     +,NLM=NL-1,NLP=NL+1,NLPP=NL+2,NLA=NL+3,NLB=NL+4,NL2=NL*NL               PARAM2.7     
     +,IDA=(MG+MG+MG)/2+1,IDB=NWJ2*NL,IDC=IDB+IDB,IDD=MGPP*NL                PARAM2.8     
     +,IDE=NL2*NN,IDF=NCRAY*(MG+1),IDG=JG*NL,IDH=JG*MG                       PARAM2.9     
     +,IDI=NNP/2,IDJ=IDI*IDI,IDK=NL*IDI,IDL=MGPP/2,IDM=NNP/2,IDN=IDM*NL      PARAM2.10    
     +,NWW=1+(MM-1)/MOCT)                                                    PARAM2.11    
      PARAMETER(IGA=NWJ2*NHEM,IGB=IDB*NHEM,IGC=MGPP*NHEM,IGD=IDD*NHEM        PARAM2.12    
     +,IGG=IDG*NHEM,IGL=IDL*NHEM,IGM=IDM*NHEM,IGN=IDN*NHEM                   PARAM2.13    
     +,IGO=IGA+IGA,IGP=IGB+IGB,NFTWG=(5+NTRAC)*NL+3                          PARAM2.14    
     +,NFTGW=(6+3*NTRAC)*NL+2,NFTGD=(3+NTRAC)*NL,NLTR=NL*NTRAC)              PARAM2.15    
C     Number of 2D (surface) output fields. This value is                    PARAM2.16    
C     Doubled due to averaged and instantaneous fields.                      PARAM2.17    
      PARAMETER (N2DFLD=21,NGRPAD=N2DFLD*2*IGC)                              PARAM2.18    
C                                                                            PARAM2.19    
C                                                                            BLANK.2     
C     Basic planetary parameters for run plus information about              BLANK.3     
C     vertical grid structure                                                BLANK.4     
C                                                                            BLANK.5     
C     Note that RD and GASCON are identical and CPD is set from RD,AKAP.     BLANK.6     
      COMMON        SQ(NNP),RSQ(NNP),SIGMAH(NLM),SIGMA(NL)                   BLANK.7     
     +              ,T01S2(NLM),T0(NL),ALPHA(NL),DSIGMA(NL),RDSIG(NL)        BLANK.8     
     +              ,TKP(NL),C(NL2),SQH(NNP)                                 BLANK.9     
     +              ,MF,MFP,JZF,NF,NFP                                       BLANK.10    
     +              ,AKAP,GA,GASCON,RADEA,WW,P0,PFAC,EZ,AIOCT                BLANK.11    
     +              ,RD,RV,CPD,CLATNT                                        BLANK.12    
     +              ,LRSTRT,LSHORT,LTVEC,LSTRETCH                            BLANK.13    
     +              ,LFLUX                                                   BLANK.14    
     +              ,LBALAN,LRESTIJ                                          BLANK.15    
     +              ,LCLIM, LPERPET, L22L,LOROG ,LCSFCT                      BLANK.16    
     +              ,LNOISE                                                  BLANK.17    
      COMPLEX EZ,AIOCT                                                       BLANK.18    
      LOGICAL LRSTRT,LSHORT,LTVEC,LSTRETCH,LBALAN,LRESTIJ                    BLANK.19    
     +       ,LFLUX,LNOISE                                                   BLANK.20    
     +       ,LCLIM, LPERPET, L22L,LOROG,LCSFCT                              BLANK.21    
C                                                                            BLANK.22    
C                                                                            LEGAU.2     
C     Legendre polynomials and information about gaussian latitudes          LEGAU.3     
C                                                                            LEGAU.4     
      COMMON/LEGAU/ ALPJ(MJP),DALPJ(MJP)                                     LEGAU.5     
     +              ,ALP(NWJ2,2,JGL),DALP(NWJ2,2,JGL)                        LEGAU.6     
     +              ,RLP(NWJ2,2,JGL),RDLP(NWJ2,2,JGL)                        LEGAU.7     
     +              ,SI(JGG),CS(JGG),SISQ(JGG),CSSQ(JGG),SECSQ(JGG)          LEGAU.8     
     +              ,ALAT(JGG),GWT(JGG),AW(JGG),JH,JL,JINC                   LEGAU.9     
C                                                                            LEGAU.10    
C                                                                            OUTCON.2     
C     Switches counters and constants controlling type and frequency of      OUTCON.3     
C     model output                                                           OUTCON.4     
C                                                                            OUTCON.5     
      COMMON/OUTCON/RNTAPE,NCOEFF,NLAT,INLAT,INSPC                           OUTCON.6     
     +              ,RNTAPO                                                  OUTCON.7     
     +              ,KOUNTP,KOUNTE,KOUNTH,KOUNTR                             OUTCON.8     
     +              ,KOUTP,KOUTE,KOUTH,KOUTR,DAY                             OUTCON.9     
     +              ,SQR2,RSQR2,EAM1,EAM2,TOUT1,TOUT2,RMG                    OUTCON.10    
     +              ,LSPO(NL),LGPO(NL)                                       OUTCON.11    
     $              ,LSHIST,LMINIH                                           OUTCON.12    
      LOGICAL LSHIST,LMINIH                                                  OUTCON.13    
      LOGICAL LSPO,LGPO                                                      OUTCON.14    
C                                                                            OUTCON.15    
C                                                                            GRIDPP.2     
C     Array ordering in GRIDP must correspond to that in SPECTR.             GRIDPP.3     
C     Real arrays: multi-level arrays are 2-dimensional.                     GRIDPP.4     
C     the variables have been renamed to coincide with                       GRIDPP.5     
C     variable names in bgcm5 DGRMLT                                         GRIDPP.6     
C                                                                            GRIDPP.7     
C swapped round VLNG and UNLG to check                                       GRIDPP.8     
      COMMON/GRIDP/ CHIG(IGC,NL),SFG(IGC,NL),UG(IGC,NL),VG(IGC,NL)           GRIDPP.9     
     :              ,TTVD(IGC,NL),QTVD(IGC,NL),TG(IGC,NL)                    GRIDPP.10    
     :              ,TRAG(IGC,NL,NTRAC)                                      GRIDPP.11    
     :              ,PLG(IGC),TYBL(IGC),TXBL(IGC)                            GRIDPP.12    
     :              ,SPG(IGC),VPG(IGC),TTRD(IGC,NL)                          GRIDPP.13    
     :              ,TNLG(IGC,NL),TRANLG(IGC,NL,NTRAC),UNLG(IGC,NL)          GRIDPP.14    
     :              ,VNLG(IGC,NL),TTLR(IGC,NL),UTRAG(IGC,NL,NTRAC)           GRIDPP.15    
     :              ,TTCR(IGC,NL),VTRAG(IGC,NL,NTRAC)                        GRIDPP.16    
     :              ,UTVD(IGC,NL),VTVD(IGC,NL)                               GRIDPP.17    
     :         ,ASSBL(IGC),ASHBL(IGC),ASLBL(IGC),ARRCR(IGC),ARRLR(IGC)       GRIDPP.18    
     :         ,arflux(igc,6),asfld(igc,6),acld(igc,4)                       GRIDPP.19    
     :         ,SSBL(IGC),SHBL(IGC),SLBL(IGC),RRCR(IGC),RRLR(IGC)            GRIDPP.20    
     :         ,rflux(igc,6),sfld(igc,6),cld(igc,4)                          GRIDPP.21    
C                                                                            GRIDPP.22    
C                                                                            BATS.2     
C     Constant arrays and variables associated with time and vertical        BATS.3     
C     differencing. Also counters.                                           BATS.4     
C                                                                            BATS.5     
      COMMON/BATS/  BM1(IDE),AK(NNP),AQ(NL2),G(NL2),TAU(NL2)                 BATS.6     
     +              ,KOUNT,KITS,KSTART,KTOTAL,KRUN,BEGDAY,ITSPD              BATS.7     
     +              ,DELT,DELT2,CV,CG,CT,CQ,PNU,PNU2,PNU21                   BATS.8     
     +              ,NTRACO,CTRA(NTRAC),KOLOUR(NTRAC),RGG(NL2)               BATS.9     
     +              ,BEGDOY,DOY                                              BATS.10    
C                                                                            BATS.11    
      COMMON/PHYS/  LBL,LVD,LCR,LLR,LRD,LCUBM,LCBADJ                         PHYSCA.2     
     :              ,TSTAR(IGC,JG),QSTAR(IGC,JG),FRAD(JG,NHEM)               PHYSCA.3     
     :              ,TSTARO(IGC,JG),TDEEPO(IGC,JG),smstar(igc,jg)            PHYSCA.4     
     :              ,tdeep(igc,jg),hsnow(igc,jg),sqstar(igc,jg)              PHYSCA.5     
     :              ,SALB(IGC,JG),SBAL(IGC,JG),BLCD(IGC)                     PHYSCA.6     
     :              ,SVEGE(IGC,JG),CD,DRAG,BLVAD,BLA,BLRH,BLVB(IGC)          PHYSCA.7     
     :              ,AKVV,AKTV,AKQV,ESCONA,ESCONB,EPSIQ,CTQ,CCC              PHYSCA.8     
     : ,ctqi,sdsn,shcs,shcsp,shcsn,skse,sksn,slhf,sd1,sd2,sdw                PHYSCA.9     
     :        ,ssmc,sdsnd,LSL,sasnow,saice,shsstar,shsmax                    PHYSCA.10    
     :     ,LOC,SHCO,SHCI,LNOICE,LOLDBL,LCOND,LNNSK,ITSLL,ITSLO              PHYSCA.11    
     :              ,CCR,RCON,DTBUOY,TSLA,TSLB,TSLC,TSLD,CUT1,CUT2           PHYSCA.12    
     :              ,NLCR,NCUTOP,CURHM,AKTC,AKQC,CUBMT,CBADJT,CBADJP         PHYSCA.13    
     :              ,SKAP(NL),SK(NLM),FWS(NL),CLR(NL),FB(NLM)                PHYSCA.14    
     :              ,TTDC(NL),QTDC(NL),TTMC(NL),QTMC(NL),TC(NL),QC(NL)       PHYSCA.15    
     :              ,CTCR(NL,NHEM),CTLR(NL,NHEM),NAVRD,NAVWT,DELT2C          PHYSCA.16    
      LOGICAL LBL,LVD,LCR,LLR,LRD,LCUBM,LCBADJ,LSL,LOC                       PHYSCA.17    
     :       ,LNOICE,LOLDBL,LCOND,LNNSK                                      PHYSCA.18    
C                                                                            PHYSCA.19    
      COMMON/PTENDZ/UTVDZ(IGG),VTVDZ(IGG),TTVDZ(IGG),QTVDZ(IGG)              PTENDZ.2     
     :              ,TTCRZ(IGG),QTCRZ(IGG),TTLRZ(IGG),QTLRZ(IGG)             PTENDZ.3     
     :              ,TTRDZ(IGG),CTCRZ(IGG),CTLRZ(IGG)                        PTENDZ.4     
     :              ,UTBLZ(JGG),VTBLZ(JGG),TTBLZ(JGG),QTBLZ(JGG)             PTENDZ.5     
     :              ,AUTVDZ(IGG),AVTVDZ(IGG),ATTVDZ(IGG),AQTVDZ(IGG)         PTENDZ.6     
     :              ,ATTCRZ(IGG),AQTCRZ(IGG),ATTLRZ(IGG),AQTLRZ(IGG)         PTENDZ.7     
     :              ,ATTRDZ(IGG),ACTCRZ(IGG),ACTLRZ(IGG)                     PTENDZ.8     
     :              ,AUTBLZ(JGG),AVTBLZ(JGG),ATTBLZ(JGG),AQTBLZ(JGG)         PTENDZ.9     
C                                                                            PTENDZ.10    
      LOGICAL LSUM,LWRITE                                                    DGRMLT.26    
       COMMON/CPIERS/ICFLAG(IGC,5,2),CFRAC(IGC,5),PNET(IGC,JG)               CPIERS.2     
     :               ,SNET(IGC,JG),RRFLUX(IGC,JG,6)                          CPIERS.3     
     :               ,TTSW(IGC,NL),TTLW(IGC,NL)                              CPIERS.4     
      REAL UTBL(IGC),VTBL(IGC),TTBL(IGC),QTBL(IGC)                           DGRMLT.28    
       COMMON/GSG/GSG(IGC,JG)                                                OROG_G.2     
      INTEGER IFIRST                                                         DGRMLT.30    
      REAL TROPHT(MG,NHEM,JG)                                                DGRMLT.31    
c                                                                            GRIDSSS.2     
      common/gridsss/assbl1(igc,jg),ashbl1(igc,jg),aslbl1(igc,jg),           GRIDSSS.3     
     *               arrcr1(igc,jg),arrlr1(igc,jg),                          GRIDSSS.4     
     *               arflux1(igc,6,jg),asfld1(igc,6,jg),                     GRIDSSS.5     
     *               acld1(igc,4,jg)                                         GRIDSSS.6     
C                                                                            XTRAP.2     
C     Setup moisture variables by equivilencing them to                      XTRAP.3     
C     Tracer No. 1                                                           XTRAP.4     
C                                                                            XTRAP.5     
      REAL QG(IGC,NL),QNLG(IGC,NL),QTLR(IGC,NL),QTCR(IGC,NL)                 XTRAP.6     
      EQUIVALENCE (QG(1,1),TRAG(1,1,1)) , (QNLG(1,1),TRANLG(1,1,1))          XTRAP.7     
     *            ,(QTLR(1,1),UTRAG(1,1,1)),(QTCR(1,1),VTRAG(1,1,1))         XTRAP.8     
C                                                                            XTRAP.9     
      EQUIVALENCE (UTBL(1),UNLG(1,NL)),(VTBL(1),VNLG(1,NL))                  DGRMLT.34    
     :           ,(TTBL(1),TNLG(1,NL)),(QTBL(1),TRANLG(1,NL,1))              DGRMLT.35    
C                                                                            DGRMLT.36    
      SAVE IFIRST                                                            DGRMLT.37    
      DATA IFIRST/1/                                                         DGRMLT.38    
      LSUM=.FALSE.                                                           DGRMLT.39    
      LWRITE=.FALSE.                                                         DGRMLT.40    
      IF(KOUTH.GE.1.AND.KOUTH.LE.KOUNTH) LSUM=.TRUE.                         DGRMLT.41    
      IF(KOUTH.EQ.KOUNTH) LWRITE=.TRUE.                                      DGRMLT.42    
      RKP=1.0/KOUNTH                                                         DGRMLT.43    
      DELT2C=DELT2                                                           DGRMLT.44    
C                                                                            DGRMLT.45    
      IF(LSUM) THEN                                                          DGRMLT.46    
        IF(KOUTH.EQ.1) THEN                                                  DGRMLT.47    
         do k=1,6                                                            DGRMLT.48    
          do j=1,igc                                                         DGRMLT.49    
            arflux(j,k)=0.                                                   DGRMLT.50    
            asfld(j,k)=0.                                                    DGRMLT.51    
          enddo                                                              DGRMLT.52    
         enddo                                                               DGRMLT.53    
         do k=1,4                                                            DGRMLT.54    
          do j=1,igc                                                         DGRMLT.55    
            acld(j,k)=0.                                                     DGRMLT.56    
          enddo                                                              DGRMLT.57    
         enddo                                                               DGRMLT.58    
         DO 10 J=1,IGC                                                       DGRMLT.59    
           ASSBL(J)=0.0                                                      DGRMLT.60    
           ASHBL(J)=0.0                                                      DGRMLT.61    
           ASLBL(J)=0.0                                                      DGRMLT.62    
           ARRCR(J)=0.0                                                      DGRMLT.63    
           ARRLR(J)=0.0                                                      DGRMLT.64    
   10    CONTINUE                                                            DGRMLT.65    
        ELSE                                                                 DGRMLT.66    
         do i=1,igc                                                          DGRMLT.67    
           assbl(i)=assbl1(i,jh)                                             DGRMLT.68    
           ashbl(i)=ashbl1(i,jh)                                             DGRMLT.69    
           aslbl(i)=aslbl1(i,jh)                                             DGRMLT.70    
           arrcr(i)=arrcr1(i,jh)                                             DGRMLT.71    
           arrlr(i)=arrlr1(i,jh)                                             DGRMLT.72    
         end do                                                              DGRMLT.73    
         do k=1,6                                                            DGRMLT.74    
           do i=1,igc                                                        DGRMLT.75    
              arflux(i,k)=arflux1(i,k,jh)                                    DGRMLT.76    
              asfld(i,k)=asfld1(i,k,jh)                                      DGRMLT.77    
           end do                                                            DGRMLT.78    
         end do                                                              DGRMLT.79    
         do k=1,4                                                            DGRMLT.80    
           do i=1,igc                                                        DGRMLT.81    
              acld(i,k)=acld1(i,k,jh)                                        DGRMLT.82    
           end do                                                            DGRMLT.83    
         end do                                                              DGRMLT.84    
c                                                                            DGRMLT.85    
c        READ(NAVRD)ASSBL,ASHBL,ASLBL,ARRCR,ARRLR                            DGRMLT.86    
c     $        ,arflux,asfld,acld                                            DGRMLT.87    
c                                                                            DGRMLT.88    
        ENDIF                                                                DGRMLT.89    
      ENDIF                                                                  DGRMLT.90    
C                                                                            DGRMLT.91    
      DO 20 L=1,NL                                                           DGRMLT.92    
       DO 20 J=1,IGC                                                         DGRMLT.93    
        UNLG(J,L)=0.0                                                        DGRMLT.94    
        VNLG(J,L)=0.0                                                        DGRMLT.95    
        TNLG(J,L)=0.0                                                        DGRMLT.96    
        QNLG(J,L)=0.0                                                        DGRMLT.97    
        QTVD(J,L)=0.0                                                        DGRMLT.98    
        UTVD(J,L)=0.0                                                        DGRMLT.99    
        VTVD(J,L)=0.0                                                        DGRMLT.100   
        TTVD(J,L)=0.0                                                        DGRMLT.101   
        TTCR(J,L)=0.0                                                        DGRMLT.102   
        QTCR(J,L)=0.0                                                        DGRMLT.103   
        TTLR(J,L)=0.0                                                        DGRMLT.104   
        QTLR(J,L)=0.0                                                        DGRMLT.105   
        TTRD(J,L)=0.0                                                        DGRMLT.106   
        TG(J,L)=TG(J,L)+T0(L)                                                DGRMLT.107   
   20 CONTINUE                                                               DGRMLT.108   
      DO 30 J=1,IGC                                                          DGRMLT.109   
C sets ICFLAG and CFRAC to ZERO at each timestep                             DGRMLT.110   
        DO L=1,5                                                             DGRMLT.111   
C bottom level is complex for ICFLAG                                         DGRMLT.112   
C need to make sure that max and min commands in MORC.632                    DGRMLT.113   
C change things if cloud is there                                            DGRMLT.114   
C PMF bug fix 11-5-98                                                        DGRMLT.115   
           ICFLAG(J,L,1)=2                                                   DGRMLT.116   
           ICFLAG(J,L,2)=NLP                                                 DGRMLT.117   
           CFRAC(J,L)=0.0                                                    DGRMLT.118   
        ENDDO                                                                DGRMLT.119   
        TXBL(J)=0.0                                                          DGRMLT.120   
        TYBL(J)=0.0                                                          DGRMLT.121   
        SSBL(J)=0.0                                                          DGRMLT.122   
        SHBL(J)=0.0                                                          DGRMLT.123   
        SLBL(J)=0.0                                                          DGRMLT.124   
        RRCR(J)=0.0                                                          DGRMLT.125   
        RRLR(J)=0.0                                                          DGRMLT.126   
   30 CONTINUE                                                               DGRMLT.127   
      DO 60 IHEM=1,NHEM                                                      DGRMLT.128   
        DO 40 L=1,NL                                                         DGRMLT.129   
          CTCR(L,IHEM)=0.0                                                   DGRMLT.130   
   40   CTLR(L,IHEM)=0.0                                                     DGRMLT.131   
        IOFM=(IHEM-1)*MGPP                                                   DGRMLT.132   
        DO 50 I=1,MG                                                         DGRMLT.133   
          J=I+IOFM                                                           DGRMLT.134   
          PLG(J)=EXP(PLG(J))                                                 DGRMLT.135   
   50   CONTINUE                                                             DGRMLT.136   
        IF (LFLUX) THEN                                                      DGRMLT.137   
C  Convert from volume mixing ratio to mass mixing ratio.                    DGRMLT.138   
          DO 52 L=1,NL                                                       DGRMLT.139   
            DO 51 I=1,MG                                                     DGRMLT.140   
               J=I+IOFM                                                      DGRMLT.141   
               QG(J,L)=QG(J,L)/PLG(J)                                        DGRMLT.142   
   51       CONTINUE                                                         DGRMLT.143   
   52     CONTINUE                                                           DGRMLT.144   
        ENDIF                                                                DGRMLT.145   
   60 CONTINUE                                                               DGRMLT.146   
      IF (LCSFCT) THEN                                                       DGRMLT.147   
       IF (.NOT.LPERPET.OR.IFIRST.EQ.1)                                      DGRMLT.148   
     +       CALL SFCT(PLG,JH,IFIRST,TROPHT)                                 DGRMLT.149   
       IF (JH.EQ.JG) IFIRST=0                                                DGRMLT.150   
      ENDIF                                                                  DGRMLT.151   
C                                                                            DGRMLT.152   
      if (LOLDBL) then                                                       DGRMLT.153   
         if (LBL) call BLAYER                                                DGRMLT.154   
      else                                                                   DGRMLT.155   
         if (LBL) call BLSURF                                                DGRMLT.156   
      endif                                                                  DGRMLT.157   
      IF(LVD) CALL VDIFF                                                     DGRMLT.158   
      IF(LCR) CALL CONVEC                                                    DGRMLT.159   
      IF(LLR) CALL LSCRN                                                     DGRMLT.160   
      IF(LRD) CALL RADN(TROPHT)                                              DGRMLT.161   
      if (LBL.AND.(.NOT.LOLDBL)) CALL SURFM                                  DGRMLT.162   
C                                                                            DGRMLT.163   
      do j=1,igc                                                             DGRMLT.164   
         sfld(j,1)=salb(j,jh)                                                DGRMLT.165   
         sfld(j,2)=tstar(j,jh)                                               DGRMLT.166   
         sfld(j,3)=tdeep(j,jh)                                               DGRMLT.167   
         sfld(j,4)=qstar(j,jh)                                               DGRMLT.168   
         sfld(j,5)=smstar(j,jh)                                              DGRMLT.169   
         sfld(j,6)=hsnow(j,jh)                                               DGRMLT.170   
         cld(j,1)=cfrac(j,1)                                                 DGRMLT.171   
         cld(j,2)=cfrac(j,2)                                                 DGRMLT.172   
         cld(j,3)=cfrac(j,3)                                                 DGRMLT.173   
         cld(j,4)=cfrac(j,4)+cfrac(j,5)                                      DGRMLT.174   
         do k=1,6                                                            DGRMLT.175   
            rflux(j,k)=rrflux(j,jh,k)                                        DGRMLT.176   
         enddo                                                               DGRMLT.177   
C rflux(j,2) is +downwards surface flux Wm-2                                 DGRMLT.178   
        rflux(j,2)=rflux(j,1)-rflux(j,2)+rflux(j,3)-rflux(j,4)-              DGRMLT.179   
     :    CV*1.0E5*(shbl(j)+slbl(j))                                         DGRMLT.180   
      enddo                                                                  DGRMLT.181   
      IF(LSUM) THEN                                                          DGRMLT.182   
      do k=1,6                                                               DGRMLT.183   
         do j=1,igc                                                          DGRMLT.184   
            arflux(j,k)=arflux(j,k)+rflux(j,k)*RKP                           DGRMLT.185   
            asfld(j,k)=asfld(j,k)+sfld(j,k)*RKP                              DGRMLT.186   
         enddo                                                               DGRMLT.187   
      enddo                                                                  DGRMLT.188   
      do k=1,4                                                               DGRMLT.189   
         do j=1,igc                                                          DGRMLT.190   
            acld(j,k)=acld(j,k)+cld(j,k)*RKP                                 DGRMLT.191   
         enddo                                                               DGRMLT.192   
      enddo                                                                  DGRMLT.193   
      DO 100 J=1,IGC                                                         DGRMLT.194   
       SSBL(J)=SQRT(TXBL(J)*TXBL(J)+TYBL(J)*TYBL(J))                         DGRMLT.195   
       ASSBL(J)=ASSBL(J)+SSBL(J)*RKP                                         DGRMLT.196   
       ASHBL(J)=ASHBL(J)+SHBL(J)*RKP                                         DGRMLT.197   
       ASLBL(J)=ASLBL(J)+SLBL(J)*RKP                                         DGRMLT.198   
       ARRCR(J)=ARRCR(J)+RRCR(J)*RKP                                         DGRMLT.199   
       ARRLR(J)=ARRLR(J)+RRLR(J)*RKP                                         DGRMLT.200   
  100 CONTINUE                                                               DGRMLT.201   
      DO 140 IHEM=1,NHEM                                                     DGRMLT.202   
       IOF=(IHEM-1)*MGPP+1                                                   DGRMLT.203   
       K1=JH*(2-IHEM)+(JGG+1-JH)*(IHEM-1)                                    DGRMLT.204   
       K=K1                                                                  DGRMLT.205   
       DO 120 L=1,NL                                                         DGRMLT.206   
        UTVDZ(K)=SSUM(MG,UTVD(IOF,L),1)*RMG                                  DGRMLT.207   
        VTVDZ(K)=SSUM(MG,VTVD(IOF,L),1)*RMG                                  DGRMLT.208   
        TTVDZ(K)=SSUM(MG,TTVD(IOF,L),1)*RMG                                  DGRMLT.209   
        QTVDZ(K)=SSUM(MG,QTVD(IOF,L),1)*RMG                                  DGRMLT.210   
        TTCRZ(K)=SSUM(MG,TTCR(IOF,L),1)*RMG                                  DGRMLT.211   
        QTCRZ(K)=SSUM(MG,QTCR(IOF,L),1)*RMG                                  DGRMLT.212   
        TTLRZ(K)=SSUM(MG,TTLR(IOF,L),1)*RMG                                  DGRMLT.213   
        QTLRZ(K)=SSUM(MG,QTLR(IOF,L),1)*RMG                                  DGRMLT.214   
        TTRDZ(K)=SSUM(MG,TTRD(IOF,L),1)*RMG                                  DGRMLT.215   
        CTCRZ(K)=CTCR(L,IHEM)                                                DGRMLT.216   
        CTLRZ(K)=CTLR(L,IHEM)                                                DGRMLT.217   
  120  K=K+JGG                                                               DGRMLT.218   
       UTBLZ(K1)=SSUM(MG,UTBL(IOF),1)*RMG                                    DGRMLT.219   
       VTBLZ(K1)=SSUM(MG,VTBL(IOF),1)*RMG                                    DGRMLT.220   
       TTBLZ(K1)=SSUM(MG,TTBL(IOF),1)*RMG                                    DGRMLT.221   
       QTBLZ(K1)=SSUM(MG,QTBL(IOF),1)*RMG                                    DGRMLT.222   
  140 CONTINUE                                                               DGRMLT.223   
c      IF(LWRITE) THEN                                                       DGRMLT.224   
c        WRITE(NAVWT)ASSBL,ASHBL,ASLBL,ARRCR,ARRLR                           DGRMLT.225   
c     $        ,arflux,asfld,acld                                            DGRMLT.226   
c     :  ,SSBL,SHBL,SLBL,RRCR,RRLR                                           DGRMLT.227   
c     $        ,rflux,sfld,cld                                               DGRMLT.228   
c      ELSE                                                                  DGRMLT.229   
c        WRITE(NAVWT)ASSBL,ASHBL,ASLBL,ARRCR,ARRLR                           DGRMLT.230   
c     $        ,arflux,asfld,acld                                            DGRMLT.231   
c      ENDIF                                                                 DGRMLT.232   
c                                                                            DGRMLT.233   
      do i=1,igc                                                             DGRMLT.234   
         assbl1(i,jh)=assbl(i)                                               DGRMLT.235   
         ashbl1(i,jh)=ashbl(i)                                               DGRMLT.236   
         aslbl1(i,jh)=aslbl(i)                                               DGRMLT.237   
         arrcr1(i,jh)=arrcr(i)                                               DGRMLT.238   
         arrlr1(i,jh)=arrlr(i)                                               DGRMLT.239   
      end do                                                                 DGRMLT.240   
      do k=1,6                                                               DGRMLT.241   
         do i=1,igc                                                          DGRMLT.242   
            arflux1(i,k,jh)=arflux(i,k)                                      DGRMLT.243   
            asfld1(i,k,jh)=asfld(i,k)                                        DGRMLT.244   
         end do                                                              DGRMLT.245   
      end do                                                                 DGRMLT.246   
      do k=1,4                                                               DGRMLT.247   
         do i=1,igc                                                          DGRMLT.248   
            acld1(i,k,jh)=acld(i,k)                                          DGRMLT.249   
         end do                                                              DGRMLT.250   
      end do                                                                 DGRMLT.251   
      ENDIF ! IF(LSUM)                                                       DGRMLT.252   
C                                                                            DGRMLT.253   
      DO 200 L=1,NL                                                          DGRMLT.254   
       DO 200 J=1,IGC                                                        DGRMLT.255   
        UNLG(J,L)=UNLG(J,L)+UTVD(J,L)                                        DGRMLT.256   
        VNLG(J,L)=VNLG(J,L)+VTVD(J,L)                                        DGRMLT.257   
        TNLG(J,L)=TNLG(J,L)+TTVD(J,L)+TTCR(J,L)+TTLR(J,L)+TTRD(J,L)          DGRMLT.258   
        QNLG(J,L)=QNLG(J,L)+QTVD(J,L)+QTCR(J,L)+QTLR(J,L)                    DGRMLT.259   
  200 CONTINUE                                                               DGRMLT.260   
C                                                                            DGRMLT.261   
      IF (LFLUX) THEN                                                        DGRMLT.262   
C        Convert to volume mixing ratio from mass mixing ratio.              DGRMLT.263   
         DO 211 L=1,NL                                                       DGRMLT.264   
            DO 210 J=1,IGC                                                   DGRMLT.265   
               QNLG(J,L)=PLG(J)*QNLG(J,L)                                    DGRMLT.266   
  210       CONTINUE                                                         DGRMLT.267   
  211    CONTINUE                                                            DGRMLT.268   
      ENDIF                                                                  DGRMLT.269   
C                                                                            DGRMLT.270   
      RETURN                                                                 DGRMLT.271   
      END                                                                    DGRMLT.272   
