C**********************************************************                  TBAL.2     
C             SUBROUTINE TBAL                                                TBAL.3     
C**********************************************************                  TBAL.4     
      SUBROUTINE TBAL                                                        TBAL.5     
C                                                                            TBAL.6     
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                                                                            SPECTR.2     
C     Array ordering in SPECTR must correspond to that in GRIDP.             SPECTR.3     
C                                                                            SPECTR.4     
      COMMON/SPECTR/Z(IGB),D(IGB),T(IGB),TRA(IGB,NTRAC),SP(IGA),GS(IGA)      SPECTR.5     
     :              ,SPA(IGA),VP(IGA),DTE(IGB),TT(IGB)                       SPECTR.6     
     :              ,TRAT(IGB,NTRAC),DT(IGB),ZT(IGB)                         SPECTR.7     
     :              ,ZMI(IGB),DMI(IGB),TMI(IGB)                              SPECTR.8     
     :              ,TRAMI(IGB,NTRAC),SPMI(IGA)                              SPECTR.9     
      COMPLEX Z,D,T,TRA,SP,GS,SPA,VP,DTE,TT,TRAT,DT,ZT                       SPECTR.10    
     :       ,ZMI,DMI,TMI,TRAMI,SPMI                                         SPECTR.11    
C                                                                            SPECTR.12    
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                                                                            BALAN.2     
C     Constants and arrays needed for balancing                              BALAN.3     
C                                                                            BALAN.4     
      COMMON/BALAN/BFILT(NL),RGT0(NL),RG(NL2),TMEAN(NL)                      BALAN.5     
     +            ,EP1(IGA),EP2(IGA),KBAL,MFTBAL,SRGT0,LTBAL                 BALAN.6     
      LOGICAL LTBAL                                                          BALAN.7     
C                                                                            BALAN.8     
      DIMENSION PMNRE(IDJ)                                                   TBAL.13    
      COMPLEX ERR(IDK),VPS,GSI1,TA,SRGT                                      TBAL.14    
C                                                                            TBAL.15    
C***********************************************************************     TBAL.16    
C     Note that this scheme does not converge if wavenumbers M are           TBAL.17    
C     present for which there are only a small number of modes in the        TBAL.18    
C     truncation. For a small number of iterations the problem is not        TBAL.19    
C     serious but it may be removed altogether by limiting the range of      TBAL.20    
C     the 20 and 80 loops. For a given M, 7 modes are sufficient and 3       TBAL.21    
C     are insufficient. The loop terminator MFTBAL is set in INITAL.         TBAL.22    
C***********************************************************************     TBAL.23    
C                                                                            TBAL.24    
      REWIND 99                                                              TBAL.25    
      I1=0                                                                   TBAL.26    
      DO 20 MP=1,MFTBAL,MOCT                                                 TBAL.27    
         J2=(NFP-MP)/2+1                                                     TBAL.28    
         J22=J2*J2                                                           TBAL.29    
         IJ=0                                                                TBAL.30    
         DO 3 IN=MP,NFP,MH                                                   TBAL.31    
            I1=I1+1                                                          TBAL.32    
            IF (IN.GT.1) THEN                                                TBAL.33    
               VPS=VP(I1)                                                    TBAL.34    
               K=I1                                                          TBAL.35    
               GSI1=GS(I1)                                                   TBAL.36    
               IL=0                                                          TBAL.37    
               DO 10 L=1,NL                                                  TBAL.38    
                  TA=(0.,0.)                                                 TBAL.39    
                  KK=I1                                                      TBAL.40    
                  SRGT=0.                                                    TBAL.41    
                  DO 9 M=1,NL                                                TBAL.42    
                     IL=IL+1                                                 TBAL.43    
                     TA=TA+G(IL)*TT(KK)                                      TBAL.44    
                     SRGT=SRGT+G(IL)*T(KK)                                   TBAL.45    
                     KK=KK+IGA                                               TBAL.46    
    9             CONTINUE                                                   TBAL.47    
                  IJ=IJ+1                                                    TBAL.48    
                  ERR(IJ)=-DT(K)-SQ(IN)*                                     TBAL.49    
     +                    (SRGT+GSI1+T0(L)*SP(I1)+DELT*(TA-T0(L)*VPS))       TBAL.50    
                  K=K+IGA                                                    TBAL.51    
   10          CONTINUE                                                      TBAL.52    
            ENDIF                                                            TBAL.53    
    3    CONTINUE                                                            TBAL.54    
         IF (MP.GT.1) THEN                                                   TBAL.55    
            READ(99) (PMNRE(I),I=1,J22)                                      TBAL.56    
            IJ=0                                                             TBAL.57    
            DO 24 J=1,J2                                                     TBAL.58    
               IZJ=IZJ+1                                                     TBAL.59    
               IZ=IZJ                                                        TBAL.60    
               DO 23 L=1,NL                                                  TBAL.61    
                  IK=L                                                       TBAL.62    
                  DO 22 K=1,J2                                               TBAL.63    
                     IJ=IJ+1                                                 TBAL.64    
                     Z(IZ)=Z(IZ)+PMNRE(IJ)*ERR(IK)                           TBAL.65    
                     IK=IK+NL                                                TBAL.66    
   22             CONTINUE                                                   TBAL.67    
                  IZ=IZ+IGA                                                  TBAL.68    
                  IJ=IJ-J2                                                   TBAL.69    
   23          CONTINUE                                                      TBAL.70    
               IJ=IJ+J2                                                      TBAL.71    
   24       CONTINUE                                                         TBAL.72    
         ELSE                                                                TBAL.73    
            IJS=(J2-2)*NL                                                    TBAL.74    
            IL=J2                                                            TBAL.75    
            DO 28 L=1,NL                                                     TBAL.76    
               IE=J2                                                         TBAL.77    
               IZ=IL                                                         TBAL.78    
               SRGT=0.                                                       TBAL.79    
               IJ=IJS+L                                                      TBAL.80    
               DO 26 J=2,J2                                                  TBAL.81    
                  SRGT=(ERR(IJ)-EP2(IE)*SRGT)/EP1(IE-1)                      TBAL.82    
                  IJ=IJ-NL                                                   TBAL.83    
                  IZ=IZ-1                                                    TBAL.84    
                  Z(IZ)=Z(IZ)+SRGT                                           TBAL.85    
                  IE=IE-1                                                    TBAL.86    
   26          CONTINUE                                                      TBAL.87    
               IL=IL+IGA                                                     TBAL.88    
   28       CONTINUE                                                         TBAL.89    
            IZJ=J2                                                           TBAL.90    
         ENDIF                                                               TBAL.91    
   20 CONTINUE                                                               TBAL.92    
C                                                                            TBAL.93    
      IF (NHEM.EQ.2) THEN                                                    TBAL.94    
         I1=NWJ2                                                             TBAL.95    
         DO 80 MP=1,MFTBAL,MOCT                                              TBAL.96    
            J2=(NFP-MP)/2+1                                                  TBAL.97    
            J2L=J2-1                                                         TBAL.98    
            J22L=J2*J2L                                                      TBAL.99    
            IJ=0                                                             TBAL.100   
            DO 60 IN=MP,NFP,MH                                               TBAL.101   
               I1=I1+1                                                       TBAL.102   
               VPS=VP(I1)                                                    TBAL.103   
               GSI1=GS(I1)                                                   TBAL.104   
               K=I1                                                          TBAL.105   
               IL=0                                                          TBAL.106   
               DO 58 L=1,NL                                                  TBAL.107   
                  TA=(0.0,0.0)                                               TBAL.108   
                  SRGT=(0.0,0.0)                                             TBAL.109   
                  KK=I1                                                      TBAL.110   
                  DO 56 M=1,NL                                               TBAL.111   
                     IL=IL+1                                                 TBAL.112   
                     TA=TA + G(IL)*TT(KK)                                    TBAL.113   
                     SRGT=SRGT + G(IL)*T(KK)                                 TBAL.114   
                     KK=KK+IGA                                               TBAL.115   
   56             CONTINUE                                                   TBAL.116   
                  IJ=IJ+1                                                    TBAL.117   
                  ERR(IJ)=-DT(K)-SQ(IN+1)*(SRGT+GSI1+T0(L)*SP(I1)+           TBAL.118   
     +                    DELT*(TA-T0(L)*VPS))                               TBAL.119   
                  K=K+IGA                                                    TBAL.120   
   58          CONTINUE                                                      TBAL.121   
   60       CONTINUE                                                         TBAL.122   
            IF (MP.EQ.1) THEN                                                TBAL.123   
               READ(99) (PMNRE(I),I=1,J22L)                                  TBAL.124   
               IZJ=1+NWJ2                                                    TBAL.125   
               IJ=0                                                          TBAL.126   
               DO 64 J=1,J2L                                                 TBAL.127   
                  IZJ=IZJ+1                                                  TBAL.128   
                  IZ=IZJ                                                     TBAL.129   
                  DO 63 L=1,NL                                               TBAL.130   
                     IK=L                                                    TBAL.131   
                     DO 62 K=1,J2                                            TBAL.132   
                        IJ=IJ+1                                              TBAL.133   
                        Z(IZ)=Z(IZ) + PMNRE(IJ)*ERR(IK)                      TBAL.134   
                        IK=IK+NL                                             TBAL.135   
   62                CONTINUE                                                TBAL.136   
                     IZ=IZ+IGA                                               TBAL.137   
                     IJ=IJ-J2                                                TBAL.138   
   63             CONTINUE                                                   TBAL.139   
                  IJ=IJ+J2                                                   TBAL.140   
   64          CONTINUE                                                      TBAL.141   
            ELSE                                                             TBAL.142   
               IJS=(J2-1)*NL                                                 TBAL.143   
               IL=I1                                                         TBAL.144   
               DO 78 L=1,NL                                                  TBAL.145   
                  IE=I1                                                      TBAL.146   
                  IZ=IL                                                      TBAL.147   
                  SRGT=(0.0,0.0)                                             TBAL.148   
                  IJ=IJS+L                                                   TBAL.149   
                  DO 76 J=1,J2                                               TBAL.150   
                     SRGT=(ERR(IJ)-EP2(IE)*SRGT)/EP1(IE)                     TBAL.151   
                     Z(IZ)=Z(IZ)+SRGT                                        TBAL.152   
                     IJ=IJ-NL                                                TBAL.153   
                     IZ=IZ-1                                                 TBAL.154   
                     IE=IE-1                                                 TBAL.155   
   76             CONTINUE                                                   TBAL.156   
                  IL=IL+IGA                                                  TBAL.157   
   78          CONTINUE                                                      TBAL.158   
            ENDIF                                                            TBAL.159   
   80    CONTINUE                                                            TBAL.160   
      ENDIF                                                                  TBAL.161   
C                                                                            TBAL.162   
      IF(KOUNT.EQ.0)THEN                                                     TBAL.163   
         DO 4 I=1,IGA                                                        TBAL.164   
            SPMI(I)=SP(I)                                                    TBAL.165   
    4    CONTINUE                                                            TBAL.166   
         DO 8 J=1,IGB                                                        TBAL.167   
            ZMI(J)=Z(J)                                                      TBAL.168   
            DMI(J)=D(J)                                                      TBAL.169   
            TMI(J)=T(J)                                                      TBAL.170   
    8    CONTINUE                                                            TBAL.171   
      ENDIF                                                                  TBAL.172   
C                                                                            TBAL.173   
      RETURN                                                                 TBAL.174   
      END                                                                    TBAL.175   
