C**********************************************************                  SETZT.2     
C             SUBROUTINE SETZT                                               SETZT.3     
C**********************************************************                  SETZT.4     
      SUBROUTINE SETZT                                                       SETZT.5     
C                                                                            SETZT.6     
C     This subroutine sets up restoration temperature field.                 SETZT.7     
C     The temperature at SIGMA = 1 is TGR, entered in Kelvin.                SETZT.8     
C     a lapse rate of ALR k/m is assumed under the tropopause and            SETZT.9     
C     zero above. The actual profile tends to this away from the             SETZT.10    
C     tropopause, with smooth interpolation depending on DTTRP               SETZT.11    
C     at the model tropopause. The height of                                 SETZT.12    
C     the tropopause is given as ZTROP m.                                    SETZT.13    
C                                                                            SETZT.14    
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                                                                            RESTIJ.2     
C     Restoration temperature field and constants which determine it,        RESTIJ.3     
C     also contains timescales                                               RESTIJ.4     
C                                                                            RESTIJ.5     
      COMMON/RESTIJ/TTRES(IGB)                                               RESTIJ.6     
     + ,DTNS,DTEP,DTTRP,FAC(NL),DDAMP(NL),TFRC(NL),YRLEN,TRS(NL)             RESTIJ.7     
     +  ,ALR,ZTROP,TGR                                                       RESTIJ.8     
      COMPLEX TTRES                                                          RESTIJ.9     
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    
      DO 100 I=1,IGB                                                         SETZT.20    
         TTRES(I)=(0.0,0.0)                                                  SETZT.21    
100   CONTINUE                                                               SETZT.22    
      DTTRP=DTTRP*CT                                                         SETZT.23    
      SIGPREV=1.                                                             SETZT.24    
      TPREV=TGR                                                              SETZT.25    
      ZPREV=0.                                                               SETZT.26    
      DO 150 L=NL,1,-1                                                       SETZT.27    
         ZP=ZPREV+(GASCON*TPREV/GA)*LOG(SIGPREV/SIGMA(L))                    SETZT.28    
         TP=TGR-ZTROP*ALR                                                    SETZT.29    
         TP=TP+SQRT((.5*ALR*(ZP-ZTROP))**2+DTTRP**2)                         SETZT.30    
         TP=TP-.5*ALR*(ZP-ZTROP)                                             SETZT.31    
         TPM=.5*(TPREV+TP)                                                   SETZT.32    
         ZPP=ZPREV+(GASCON*TPM/GA)*LOG(SIGPREV/SIGMA(L))                     SETZT.33    
         TPP=TGR-ZTROP*ALR                                                   SETZT.34    
         TPP=TPP+SQRT((.5*ALR*(ZPP-ZTROP))**2+DTTRP**2)                      SETZT.35    
         TPP=TPP-.5*ALR*(ZPP-ZTROP)                                          SETZT.36    
         TRS(L)=TPP                                                          SETZT.37    
         ZPREV=ZPREV+(.5*(TPP+TPREV)*GASCON/GA)*LOG(SIGPREV/SIGMA(L))        SETZT.38    
         TPREV=TPP                                                           SETZT.39    
         SIGPREV=SIGMA(L)                                                    SETZT.40    
150   CONTINUE                                                               SETZT.41    
C                                                                            SETZT.42    
      WRITE(2,2000)                                                          SETZT.43    
      WRITE(2,2010) TRS                                                      SETZT.44    
 2000 FORMAT(/' RESTORATION TEMPERATURE STRATIFICATION IN K ')               SETZT.45    
 2010 FORMAT(10F7.2)                                                         SETZT.46    
C                                                                            SETZT.47    
      DO 170 L=1,NL                                                          SETZT.48    
         TRS(L)=TRS(L)/CT                                                    SETZT.49    
 170  CONTINUE                                                               SETZT.50    
C                                                                            SETZT.51    
C     Now the latitudinal variation in TTRES is set up                       SETZT.52    
C     (this being in terms of a deviation from T0 which                      SETZT.53    
C     is usually constant with height)                                       SETZT.54    
C                                                                            SETZT.55    
      DO 200 L=1,NL                                                          SETZT.56    
         I=(L-1)*IGA                                                         SETZT.57    
         TTRES(I+1)=SQRT(2.)*(TRS(L)-T0(L))                                  SETZT.58    
         TTRES(I+2)=-2./3.*SQRT(0.4)*DTEP*FAC(L)                             SETZT.59    
         TTRES(I+NWJ2+1)=(1./SQRT(6.))*DTNS*FAC(L)                           SETZT.60    
200   CONTINUE                                                               SETZT.61    
      DTTRP=DTTRP/CT                                                         SETZT.62    
C                                                                            SETZT.63    
      END                                                                    SETZT.64    
