C**********************************************************                  PVCR.2     
C             SUBROUTINE PVCR                                                PVCR.3     
C**********************************************************                  PVCR.4     
      SUBROUTINE PVCR(TFIELD,TTYPE)                                          PVCR.5     
C                                                                            PVCR.6     
C     Calculate potential temperature and Ertel potential vorticity          PVCR.7     
C     on model levels.                                                       PVCR.8     
C                                                                            PVCR.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    
      COMMON/COMGRM/DUDLSG(IGC,NL),DVDLSG(IGC,NL),DTDLSG(IGC,NL)             COMGRM.2     
C                                                                            COMGRM.3     
C                                                                            GRIDP2.2     
C     Array ordering in GRIDP must correspond to that in SPECTR.             GRIDP2.3     
C     Real arrays: multi-level arrays are 2-dimensional.                     GRIDP2.4     
C                                                                            GRIDP2.5     
      COMMON/GRIDP/ CHIG(IGC,NL),SFG(IGC,NL),UG(IGC,NL),VG(IGC,NL)           GRIDP2.6     
     :              ,ZG(IGC,NL),DG(IGC,NL),TG(IGC,NL)                        GRIDP2.7     
     :              ,TRAG(IGC,NL,NTRAC)                                      GRIDP2.8     
     :              ,PLG(IGC),PJG(IGC),PMG(IGC)                              GRIDP2.9     
     :              ,SPG(IGC),VPG(IGC),EG(IGC,NL)                            GRIDP2.10    
     :              ,TNLG(IGC,NL),TRANLG(IGC,NL,NTRAC),FUG(IGC,NL)           GRIDP2.11    
     :              ,FVG(IGC,NL),UTG(IGC,NL),UTRAG(IGC,NL,NTRAC)             GRIDP2.12    
     :              ,VTG(IGC,NL),VTRAG(IGC,NL,NTRAC)                         GRIDP2.13    
     :              ,FVGT(IGC,NL),FUGT(IGC,NL)                               GRIDP2.14    
     :              ,GRPAD(NGRPAD)                                           GRIDP2.15    
C                                                                            GRIDP2.16    
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    
      REAL PSG(IGC,NL),TFIELD(IGC,NL)                                        PVCR.16    
      INTEGER TTYPE                                                          PVCR.17    
C                                                                            PVCR.18    
C     Calculate pressure on model levels.                                    PVCR.19    
C                                                                            PVCR.20    
      DO 10 L=1,NL                                                           PVCR.21    
         DO 11 II=1,IGC                                                      PVCR.22    
            PSG(II,L)=SIGMA(L)*PLG(II)                                       PVCR.23    
 11      CONTINUE                                                            PVCR.24    
 10   CONTINUE                                                               PVCR.25    
C                                                                            PVCR.26    
      DO 100 IHEM=1,NHEM                                                     PVCR.27    
         IOF=(IHEM-1)*MGPP                                                   PVCR.28    
C                                                                            PVCR.29    
C     Calculate potential temperature and PV on model levels.                PVCR.30    
C     Generalised formula using array of model level pressures is used       PVCR.31    
C     to calculate potential temperature.  But note that the reference       PVCR.32    
C     pressure for adiabatic processes is assumed to be P0, the non-         PVCR.33    
C     dimensionalising pressure.                                             PVCR.34    
C                                                                            PVCR.35    
C     TFIELD is the tracer field to be initialised.                          PVCR.36    
C     TTYPE=1   : Initialise tracer as potential temperature.                PVCR.37    
C     TTYPE=2   : Initialise tracer as Ertel PV.                             PVCR.38    
C                                                                            PVCR.39    
C     Remember that at this point:-                                          PVCR.40    
C     CHIG contains the x-derivative of T.                                   PVCR.41    
C     SFG  contains the y-derivative of T.                                   PVCR.42    
C                                                                            PVCR.43    
         DO 20 L=1,NL                                                        PVCR.44    
            DO 30 I=1,MG                                                     PVCR.45    
               II=I+IOF                                                      PVCR.46    
               PMKG=PSG(II,L)**(-AKAP)                                       PVCR.47    
               PM1KG=PMKG/PSG(II,L)                                          PVCR.48    
               AKT=AKAP*TG(II,L)                                             PVCR.49    
               TXP=CHIG(II,L)-AKT*PMG(II)                                    PVCR.50    
               TYP=SFG(II,L)-AKT*PJG(II)                                     PVCR.51    
               IF(TTYPE.EQ.1) THEN                                           PVCR.52    
                  TFIELD(II,L)=TG(II,L)*PMKG                                 PVCR.53    
               ELSE                                                          PVCR.54    
                  TFIELD(II,L)=PM1KG*(ZG(II,L)*(-DTDLSG(II,L)+AKT)           PVCR.55    
     :                 +SECSQ(JH)*(-DUDLSG(II,L)*TYP+DVDLSG(II,L)*TXP))      PVCR.56    
               ENDIF                                                         PVCR.57    
 30         CONTINUE                                                         PVCR.58    
 20      CONTINUE                                                            PVCR.59    
 100  CONTINUE                                                               PVCR.60    
C                                                                            PVCR.61    
      RETURN                                                                 PVCR.62    
      END                                                                    PVCR.63    
