C**********************************************************                  CONVEC.2     
C             SUBROUTINE CONVEC                                              CONVEC.3     
C**********************************************************                  CONVEC.4     
      SUBROUTINE CONVEC                                                      CONVEC.5     
C                                                                            CONVEC.6     
C     CONVECTION SCHEME. THIS ROUTINE FINDS UNSTABLE LAYERS AND              CONVEC.7     
C     CALLS RELEVANT ROUTINES TO CALCULATE TENDENCIES ETC.                   CONVEC.8     
C                                                                            CONVEC.9     
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                                                                            CONVEC.16    
      LOGICAL LCDRY,LCWET                                                    CONVEC.17    
      REAL ESCON(NL),SIGMIN,TMIN                                             CONVEC.18    
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                                                                            CONVEC.20    
c 28-05-97 PMF Water vapour fix to stop too low values                       CONVEC.21    
c takes water vapour from level below                                        CONVEC.22    
c this produces a slight vertical advection of Q                             CONVEC.23    
c assumes no -ve water vapour in bottom layer                                CONVEC.24    
c                                                                            CONVEC.25    
      REAL QGO(NL)                                                           CONVEC.26    
c                                                                            CONVEC.27    
      PRESSMIN=0.20000  !  Minimum parcel pressure for                       CONVEC.28    
                        !  which moist convection is attempted.              CONVEC.29    
      TMIN=0.31000418   !  Minimum parcel temperature (dedim.) for           CONVEC.30    
                        !  which moist convection is attempted.              CONVEC.31    
      LTOP=NL-NLCR      !  NLCR gives highest level for which                CONVEC.32    
                        !  convection is attempted.                          CONVEC.33    
      DO 800 IHEM=1,NHEM                                                     CONVEC.34    
        IOFM=(IHEM-1)*MGPP                                                   CONVEC.35    
        DO 700 I=1,MG                                                        CONVEC.36    
          J=I+IOFM                                                           CONVEC.37    
C         IPH=J                                                              CONVEC.38    
          DO 10 L=1,NL                                                       CONVEC.39    
            TTDC(L)=0.0                                                      CONVEC.40    
            QTDC(L)=0.0                                                      CONVEC.41    
            TTMC(L)=0.0                                                      CONVEC.42    
            QTMC(L)=0.0                                                      CONVEC.43    
            ESCON(L)=1./(PLG(J)*SIGMA(L))                                    CONVEC.44    
            QGO(L)=QG(J,L)                                                   CONVEC.45    
   10     CONTINUE                                                           CONVEC.46    
c Water vapour fix                                                           CONVEC.47    
          IFL=0                                                              CONVEC.48    
          DO L=1,NL-1                                                        CONVEC.49    
            IF (QG(J,L).LT.1.0E-6) THEN                                      CONVEC.50    
              IFL=1                                                          CONVEC.51    
              QEXS=1.0E-6-QG(J,L)                                            CONVEC.52    
              IF (L.EQ.1) THEN                                               CONVEC.53    
                QEXS=QEXS*SIGMAH(1)                                          CONVEC.54    
              ELSE                                                           CONVEC.55    
                QEXS=QEXS*(SIGMAH(L)-SIGMAH(L-1))                            CONVEC.56    
              ENDIF                                                          CONVEC.57    
              IF (L.NE.NL-1) THEN                                            CONVEC.58    
                QEX=QEXS/(SIGMAH(L+1)-SIGMAH(L))                             CONVEC.59    
              ELSE                                                           CONVEC.60    
                QEX=QEXS/(1.0-SIGMAH(L))                                     CONVEC.61    
              ENDIF                                                          CONVEC.62    
c assumes no large scale rain here in layer                                  CONVEC.63    
              QTLR(J,L)=(1.0E-6-QGO(L))/DELT2C                               CONVEC.64    
              QTLR(J,L+1)=QTLR(J,L+1)-QEX/DELT2C                             CONVEC.65    
              QG(J,L)=1.0E-6                                                 CONVEC.66    
              QG(J,L+1)=QG(J,L+1)-QEX                                        CONVEC.67    
            ENDIF                                                            CONVEC.68    
          ENDDO                                                              CONVEC.69    
C                                                                            CONVEC.70    
C     DRY ADJUSTMENT                                                         CONVEC.71    
C                                                                            CONVEC.72    
          L=NL                                                               CONVEC.73    
C     BEGIN NEW PARCEL CURVE                                                 CONVEC.74    
   20     NCRB=L                                                             CONVEC.75    
          LCDRY=.FALSE.                                                      CONVEC.76    
          TCLP=TG(J,L)                                                       CONVEC.77    
          QCL=QG(J,L)                                                        CONVEC.78    
C     DRY ADIABAT TO NEXT LEVEL                                              CONVEC.79    
   30     L=L-1                                                              CONVEC.80    
          IF(L.LT.LTOP) GOTO 40                                              CONVEC.81    
          TCL=TCLP*SK(L)                                                     CONVEC.82    
          IF(TCL.LE.TG(J,L)) GOTO 40  !If stable layer                       CONVEC.83    
C     BUOYANT - IF SATURATED - MOIST CONVECTION - IGNORE                     CONVEC.84    
          QSL=ESCON(L)*PQSAT(TCL)                                            CONVEC.85    
          IF ( QCL.GE.QSL ) THEN   ! Is parcel supersaturated?               CONVEC.86    
            IF ( ( (SIGMA(NCRB)*PLG(J)).GE.PRESSMIN )                        CONVEC.87    
     :        .AND.( TG(J,NCRB).GE.TMIN ) ) GOTO 40                          CONVEC.88    
C If parcel is in stratosphere, do dry rather than moist convection          CONVEC.89    
C as the dry and moist adiabats are approximately parallel and               CONVEC.90    
C dry convection is a lot cheaper.                                           CONVEC.91    
          ENDIF                                                              CONVEC.92    
C     DRY CONVECTION - CONTINUE PARCEL CURVE UP                              CONVEC.93    
   35     LCDRY=.TRUE.                                                       CONVEC.94    
          TCLP=TCL                                                           CONVEC.95    
          GOTO 30                                                            CONVEC.96    
   40     CONTINUE                                                           CONVEC.97    
C     STABLE LAYER OR MODEL TOP - ADJUST ANY UNSTABLE LAYER BELOW            CONVEC.98    
          IF(LCDRY) THEN                                                     CONVEC.99    
            NCRT=L+1                                                         CONVEC.100   
            CALL DRYADJ(NCRB,NCRT,J,IHEM)                                    CONVEC.101   
          ENDIF                                                              CONVEC.102   
          IF(L.GT.LTOP) GOTO 20                                              CONVEC.103   
C                                                                            CONVEC.104   
C     MOIST CONVECTION                                                       CONVEC.105   
C                                                                            CONVEC.106   
          L=NL                                                               CONVEC.107   
C         BEGIN NEW PARCEL CURVE                                             CONVEC.108   
  100     NCRB=L                                                             CONVEC.109   
          LCWET=.FALSE.                                                      CONVEC.110   
          IF ( (SIGMA(NCRB)*PLG(J)).LT.PRESSMIN ) THEN                       CONVEC.111   
            L=LTOP                                                           CONVEC.112   
            GOTO 150                                                         CONVEC.113   
          ELSEIF ( TG(J,NCRB).LT.TMIN ) THEN                                 CONVEC.114   
            L=L-1                                                            CONVEC.115   
            GOTO 100                                                         CONVEC.116   
          ENDIF                                                              CONVEC.117   
          TC(L)=TG(J,L)                                                      CONVEC.118   
          QC(L)=QG(J,L)                                                      CONVEC.119   
C     UP ONE LEVEL - DRY ADIABAT AS FIRST GUESS                              CONVEC.120   
  110     LP=L                                                               CONVEC.121   
          L=L-1                                                              CONVEC.122   
          IF(L.LT.LTOP) GOTO 150                                             CONVEC.123   
          TC(L)=TC(LP)*SK(L)                                                 CONVEC.124   
          QC(L)=QC(LP)                                                       CONVEC.125   
          QSL=ESCON(L)*PQSAT(TC(L))                                          CONVEC.126   
C     IF SATURATED MAY BE MOIST CONVECTION                                   CONVEC.127   
          IF(QC(L).GE.QSL) GOTO 120                                          CONVEC.128   
C     TEST FOR DRY INSTABILITY (SHOULD BE STABLE)                            CONVEC.129   
          GOTO 150  !No moist convection                                     CONVEC.130   
C     POSSIBLE MOIST CONVECTION - ITERATE FOR THETAE (T,Q)                   CONVEC.131   
  120     NIT=0                                                              CONVEC.132   
  130     NIT=NIT+1                                                          CONVEC.133   
          DQN=QC(L)-QSL                                                      CONVEC.134   
          DQ=DQN/(1.0+CCC*QSL/(TC(L)*TC(L)))                                 CONVEC.135   
          QC(L)=QC(L)-DQ                                                     CONVEC.136   
          TC(L)=TC(L)+CTQ*DQ                                                 CONVEC.137   
          IF(ABS(DQN).LT.EPSIQ) GOTO 140                                     CONVEC.138   
          IF(NIT.GT.10) GOTO 140                                             CONVEC.139   
          QSL=ESCON(L)*PQSAT(TC(L))                                          CONVEC.140   
          GOTO 130                                                           CONVEC.141   
C     BUOYANCY TEST - IF STABLE GO TO 150                                    CONVEC.142   
  140     IF(TC(L).LT.TG(J,L)) GOTO 150                                      CONVEC.143   
C     MOIST CONVECTION - CONTINUE PARCEL CURVE UP                            CONVEC.144   
          LCWET=.TRUE.                                                       CONVEC.145   
          GOTO 110                                                           CONVEC.146   
  150     CONTINUE                                                           CONVEC.147   
C     STABLE LAYER OR MODEL TOP - ADJUST ANY UNSTABLE LAYER BELOW            CONVEC.148   
          IF(LCWET) THEN                                                     CONVEC.149   
            NCRT=LP                                                          CONVEC.150   
            IF(NCRT.LT.NCUTOP) THEN                                          CONVEC.151   
              IF(.NOT.LCBADJ) CALL CBCON(NCRB,NCRT,J,IHEM)                   CONVEC.152   
              IF(LCBADJ)      CALL CBADJ(NCRB,NCRT,J,IHEM)                   CONVEC.153   
            ELSE                                                             CONVEC.154   
              NCT=NCRT                                                       CONVEC.155   
              IF(.NOT.LCUBM)  CALL CUDIF(NCRB,NCT,J,IHEM)                    CONVEC.156   
              IF(LCUBM)       CALL CUBM (NCRB,NCT,J,IHEM)                    CONVEC.157   
            ENDIF                                                            CONVEC.158   
          ENDIF                                                              CONVEC.159   
          IF(L.GT.LTOP) GOTO 100                                             CONVEC.160   
C                                                                            CONVEC.161   
C     COLLECT TENDENCIES AND INCREMENT T,Q FOR MOIST CONVECTION              CONVEC.162   
C                                                                            CONVEC.163   
          DO 200 L=1,NL                                                      CONVEC.164   
            TTCR(J,L)=TTDC(L)+TTMC(L)                                        CONVEC.165   
            QTCR(J,L)=QTDC(L)+QTMC(L)+QTLR(J,L)                              CONVEC.166   
            QTLR(J,L)=0.0                                                    CONVEC.167   
  200     CONTINUE                                                           CONVEC.168   
  700   CONTINUE                                                             CONVEC.169   
  800 CONTINUE                                                               CONVEC.170   
C                                                                            CONVEC.171   
      RETURN                                                                 CONVEC.172   
      END                                                                    CONVEC.173   
