C**********************************************************                  CUDIF.2     
C             SUBROUTINE CUDIF                                               CUDIF.3     
C**********************************************************                  CUDIF.4     
      SUBROUTINE CUDIF(NCRB,NCT,J,IHEM)                                      CUDIF.5     
C                                                                            CUDIF.6     
C     NON-PRECIPITATING CONVECTION. DIFFUSION TOWARDS MIXING-LINE THETA      CUDIF.7     
C     AND CONSTANT Q. CLOUD-TOP FLUXES AND VARIABLE K'S WHEN SHALLOW.        CUDIF.8     
C     OPTIONAL RAINOUT OVER A SPECIFIED REL-HUM.                             CUDIF.9     
C                                                                            CUDIF.10    
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                                                                            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    
      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    
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    
C                                                                            CUDIF.18    
      REAL PL(NL),PFK(NL),TR(NL)                                             CUDIF.19    
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     
C                                                                            CUDIF.21    
 2001 FORMAT(' CUDIF QMIN APPLIED AT BAS: I,J,NCRB,NCRT,QG =',5I5,F10.4)     CUDIF.22    
 2002 FORMAT(' CUDIF QMIN APPLIED FOR QM: I,J,NCRB,NCRT,QM =',4I5,F10.4)     CUDIF.23    
 2004 FORMAT(' CUDIF MID LEVEL SWAP IGNORED: I,J,NCRB,NCRT =',4I5)           CUDIF.24    
 2103 FORMAT(' CUBM LAPSE RATE LIMIT IMPOSED: I,J,NCRB,NCRT = ',4I5)         CUDIF.25    
 2104 FORMAT(' CUBM LAPSE RATE LIMIT IMPOSED: I,J,NCRB,NCRT,TLIM             CUDIF.26    
     +                                                     = ',4I5,F7.4)     CUDIF.27    
C                                                                            CUDIF.28    
                                                                             CUDIF.29    
C                                                                            CUDIF.30    
      FTSL(T,Q,P)=TSLA+TSLB/(TSLC*LOG(T)-LOG(Q*P)+TSLD)                      CUDIF.31    
C                                                                            CUDIF.32    
C     Minimum moisture for mixing line calculations.                         CUDIF.33    
      QGMIN=1.E-6                                                            CUDIF.34    
C Stable limit to mixing line slope d(theta)/dp=-10^-3 K/Pa                  CUDIF.35    
      TLIM=-1.0E-3*P0/CT                                                     CUDIF.36    
C                                                                            CUDIF.37    
      ESCON=1./PLG(J)                                                        CUDIF.38    
      IF(NCT.GE.NCUTOP) THEN                                                 CUDIF.39    
        IF(BLVB(J).EQ.0.0)RETURN                                             CUDIF.40    
        NCRT=NCT-1                                                           CUDIF.41    
        AKTCU=BLVB(J)*BLCD(J)*CUT2/CUT1                                      CUDIF.42    
      ELSE IF (NCRB.GE.NCUTOP) THEN                                          CUDIF.43    
C        Limit the convective top for swap points to the maximum             CUDIF.44    
C        height of shallow convection.                                       CUDIF.45    
C        Note that NCRT includes the level above cloud top.                  CUDIF.46    
         NCRT=NCUTOP-1                                                       CUDIF.47    
         AKTCU=AKTC                                                          CUDIF.48    
      ELSE                                                                   CUDIF.49    
C        No adjustment for mid-level swap points.                            CUDIF.50    
C         WRITE(2,2004) J,JH,NCRB,NCT                                        CUDIF.51    
         RETURN                                                              CUDIF.52    
      ENDIF                                                                  CUDIF.53    
      AKQCU=AKTCU*AKQC/AKTC                                                  CUDIF.54    
      NLEV=1+NCRB-NCRT                                                       CUDIF.55    
      NCRTP=NCRT+1                                                           CUDIF.56    
      NCRBM=NCRB-1                                                           CUDIF.57    
C                                                                            CUDIF.58    
      RKAP=1.0/AKAP                                                          CUDIF.59    
      DO 50 L=NCRT,NCRB                                                      CUDIF.60    
        PL(L)=SIGMA(L)*PLG(J)                                                CUDIF.61    
        PFK(L)=PL(L)**AKAP                                                   CUDIF.62    
   50 CONTINUE                                                               CUDIF.63    
      THB=TG(J,NCRB)/PFK(NCRB)                                               CUDIF.64    
      IF (QG(J,NCRB).LT.QGMIN) THEN                                          CUDIF.65    
         WRITE(2,2001) J,JH,L,NCRB,NCRT,CQ*QG(J,NCRB)                        CUDIF.66    
      ENDIF                                                                  CUDIF.67    
C  Apply a consistent minimum moisture criterion in the mixing line          CUDIF.68    
C  calculations.                                                             CUDIF.69    
      QQG=MAX(QG(J,NCRB),QGMIN)                                              CUDIF.70    
      TSB=FTSL(TG(J,NCRB),QQG,PL(NCRB))                                      CUDIF.71    
      PSLB=PL(NCRB)*(TSB/TG(J,NCRB))**RKAP                                   CUDIF.72    
      THM=0.5*(THB+TG(J,NCRT)/PFK(NCRT))                                     CUDIF.73    
      QM =0.5*(QG(J,NCRB)+QG(J,NCRT))                                        CUDIF.74    
      IF (QM.LT.QGMIN) THEN                                                  CUDIF.75    
         WRITE(2,2002) J,JH,NCRB,NCRT,CQ*QM                                  CUDIF.76    
      ENDIF                                                                  CUDIF.77    
      QM=MAX(QM,QGMIN)                                                       CUDIF.78    
      TMT=THM*PFK(NCRT)                                                      CUDIF.79    
      TSLM=FTSL(TMT,QM,PL(NCRT))                                             CUDIF.80    
      PSLM=PL(NCRT)*(TSLM/TMT)**RKAP                                         CUDIF.81    
      TLAPSM=(THM-THB)/(PSLM-PSLB)                                           CUDIF.82    
      TLAPSM=MAX(TLAPSM,TLIM) ! limit stability                              CUDIF.83    
      TLAPSM=MIN(TLAPSM,0.0) ! prevents instability                          CUDIF.84    
      IF (TLAPSM.GT.0.0) THEN                                                CUDIF.85    
         WRITE(2,2103) J,JH,NCRB,NCRT                                        CUDIF.86    
      ELSEIF (TLAPSM.LT.TLIM)THEN                                            CUDIF.87    
         WRITE(2,2104) J,JH,NCRB,NCRT,TLIM                                   CUDIF.88    
      ENDIF                                                                  CUDIF.89    
                                                                             CUDIF.90    
      DO 60 L=NCRT,NCRB                                                      CUDIF.91    
        THRL=THB+(PL(L)-PL(NCRB))*TLAPSM                                     CUDIF.92    
        TR(L)=THRL*PFK(L)                                                    CUDIF.93    
   60 CONTINUE                                                               CUDIF.94    
C                                                                            CUDIF.95    
      TLPH=TG(J,NCRT)+TG(J,NCRTP)                                            CUDIF.96    
      FPH=FB(NCRT)/(TLPH*TLPH)                                               CUDIF.97    
      DQPH=QG(J,NCRTP)-QG(J,NCRT)                                            CUDIF.98    
      DTPH=SK(NCRT)*(TG(J,NCRTP)-TR(NCRTP))-(TG(J,NCRT)-TR(NCRT))            CUDIF.99    
      TTMC(NCRT)=AKTCU*FPH*DTPH/DSIGMA(NCRT)                                 CUDIF.100   
      QTMC(NCRT)=AKQCU*FPH*DQPH/DSIGMA(NCRT)                                 CUDIF.101   
C                                                                            CUDIF.102   
      IF(NLEV.GT.2) THEN                                                     CUDIF.103   
        DO 10 L=NCRTP,NCRBM                                                  CUDIF.104   
          LP=L+1                                                             CUDIF.105   
          FMH=FPH                                                            CUDIF.106   
          DQMH=DQPH                                                          CUDIF.107   
          DTMH=DTPH/SK(L-1)                                                  CUDIF.108   
          TLPH=TG(J,LP)+TG(J,L)                                              CUDIF.109   
          FPH=FB(L)/(TLPH*TLPH)                                              CUDIF.110   
          DQPH=QG(J,LP)-QG(J,L)                                              CUDIF.111   
          DTPH=SK(L)*(TG(J,LP)-TR(LP))-(TG(J,L)-TR(L))                       CUDIF.112   
          TTMC(L)=AKTCU*(FPH*DTPH-FMH*DTMH)/DSIGMA(L)                        CUDIF.113   
          QTMC(L)=AKQCU*(FPH*DQPH-FMH*DQMH)/DSIGMA(L)                        CUDIF.114   
          CTCR(L,IHEM)=CTCR(L,IHEM)+1.0                                      CUDIF.115   
   10   CONTINUE                                                             CUDIF.116   
      ENDIF                                                                  CUDIF.117   
C                                                                            CUDIF.118   
      TTMC(NCRB)=-AKTCU*FPH*DTPH/(SK(NCRBM)*DSIGMA(NCRB))                    CUDIF.119   
      QTMC(NCRB)=-AKQCU*FPH*DQPH/DSIGMA(NCRB)                                CUDIF.120   
C                                                                            CUDIF.121   
      SINT=SSUM(NLEV,DSIGMA(NCRT),1)                                         CUDIF.122   
      TTCOR=SDOT(NLEV,TTMC(NCRT),1,DSIGMA(NCRT),1)/SINT                      CUDIF.123   
      DO 20 L=NCRT,NCRB                                                      CUDIF.124   
   20 TTMC(L)=TTMC(L)-TTCOR                                                  CUDIF.125   
C                                                                            CUDIF.126   
      IF(CURHM.LT.1.00001) THEN                                              CUDIF.127   
        DO 30 L=NCRT,NCRB                                                    CUDIF.128   
          TGP=TG(J,L)+DELT2C*TTMC(L)                                         CUDIF.129   
          QGP=QG(J,L)+DELT2C*QTMC(L)                                         CUDIF.130   
          QS=CURHM*ESCON*PQSAT(TGP)/SIGMA(L)                                 CUDIF.131   
          QEXS=QGP-QS                                                        CUDIF.132   
          QEX=QEXS/(1.0+CTQ*QS*ESCONB/(TGP*TGP))                             CUDIF.133   
          IF (QEXS.LT.0.0) THEN                                              CUDIF.134   
            QEX=0.0                                                          CUDIF.135   
          END IF                                                             CUDIF.136   
          QTCOR=-QEX/DELT2C                                                  CUDIF.137   
          TTMC(L)=TTMC(L)-CTQ*QTCOR                                          CUDIF.138   
          QTMC(L)=QTMC(L)+QTCOR                                              CUDIF.139   
          RRCR(J)=RRCR(J)-QTCOR*CLR(L)*PLG(J)                                CUDIF.140   
   30   CONTINUE                                                             CUDIF.141   
      ENDIF                                                                  CUDIF.142   
C                                                                            CUDIF.143   
      DO 70 L=NCRT,NCRB                                                      CUDIF.144   
        TG(J,L)=TG(J,L)+DELT2C*TTMC(L)                                       CUDIF.145   
        QG(J,L)=QG(J,L)+DELT2C*QTMC(L)                                       CUDIF.146   
   70 CONTINUE                                                               CUDIF.147   
C                                                                            CUDIF.148   
      RETURN                                                                 CUDIF.149   
      END                                                                    CUDIF.150   
