C**********************************************************                  BALANC.2     
C             SUBROUTINE BALANC                                              BALANC.3     
C**********************************************************                  BALANC.4     
      SUBROUTINE BALANC                                                      BALANC.5     
C                                                                            BALANC.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 GP(NL)                                                       BALANC.13    
      COMPLEX TA,GP,GSI1,VPS,TK,SRGT                                         BALANC.14    
C                                                                            BALANC.15    
C**********************************************************************      BALANC.16    
C     2-grid vertical temperature wave is not removed if orography           BALANC.17    
C     is included. Program aborts in INITAL if attempted.                    BALANC.18    
C**********************************************************************      BALANC.19    
C                                                                            BALANC.20    
      I1=0                                                                   BALANC.21    
      DO 800 IHEM=1,NHEM                                                     BALANC.22    
         DO 3 MP=1,MFP,MOCT                                                  BALANC.23    
            DO 4 IN=MP,NFP,MH                                                BALANC.24    
               I1=I1+1                                                       BALANC.25    
               INR=IN+IHEM-1                                                 BALANC.26    
               IF (INR.GT.1) THEN                                            BALANC.27    
                  VPS=VP(I1)                                                 BALANC.28    
                  K=I1                                                       BALANC.29    
                  GSI1=GS(I1)                                                BALANC.30    
                  IL=0                                                       BALANC.31    
                  DO 10 L=1,NL                                               BALANC.32    
                     TA=(0.,0.)                                              BALANC.33    
                     KK=I1                                                   BALANC.34    
                     DO 9 M=1,NL                                             BALANC.35    
                        IL=IL+1                                              BALANC.36    
                        TA=TA+G(IL)*TT(KK)                                   BALANC.37    
                        KK=KK+IGA                                            BALANC.38    
    9                CONTINUE                                                BALANC.39    
                     TA=(T0(L)*VPS-TA)*DELT - RSQ(INR)*DT(K)                 BALANC.40    
                     GP(L)=TA-GSI1                                           BALANC.41    
                     K=K+IGA                                                 BALANC.42    
   10             CONTINUE                                                   BALANC.43    
                  IL=0                                                       BALANC.44    
                  K=I1                                                       BALANC.45    
                  SRGT=(0.,0.)                                               BALANC.46    
                  DO 12 L=1,NL                                               BALANC.47    
                     TK=(0.,0.)                                              BALANC.48    
                     DO 11 M=1,NL                                            BALANC.49    
                        IL=IL+1                                              BALANC.50    
                        TK=TK+RG(IL)*GP(M)                                   BALANC.51    
   11                CONTINUE                                                BALANC.52    
                     T(K)=TK                                                 BALANC.53    
                     SRGT=SRGT+BFILT(L)*TK                                   BALANC.54    
                     K=K+IGA                                                 BALANC.55    
   12             CONTINUE                                                   BALANC.56    
                  SRGT=SRGT/SRGT0                                            BALANC.57    
                  SP(I1)=SRGT                                                BALANC.58    
                  K=I1                                                       BALANC.59    
                  DO 13 L=1,NL                                               BALANC.60    
                     T(K)=T(K)-RGT0(L)*SRGT                                  BALANC.61    
                     K=K+IGA                                                 BALANC.62    
   13             CONTINUE                                                   BALANC.63    
               ENDIF                                                         BALANC.64    
    4       CONTINUE                                                         BALANC.65    
    3    CONTINUE                                                            BALANC.66    
         I1=NWJ2                                                             BALANC.67    
  800 CONTINUE                                                               BALANC.68    
C                                                                            BALANC.69    
      IF (KOUNT.EQ.0) THEN                                                   BALANC.70    
         DO 2 I=1,IGA                                                        BALANC.71    
            SPMI(I)=SP(I)                                                    BALANC.72    
    2    CONTINUE                                                            BALANC.73    
         DO 5 J=1,IGB                                                        BALANC.74    
            ZMI(J)=Z(J)                                                      BALANC.75    
            DMI(J)=D(J)                                                      BALANC.76    
            TMI(J)=T(J)                                                      BALANC.77    
    5    CONTINUE                                                            BALANC.78    
      ENDIF                                                                  BALANC.79    
C                                                                            BALANC.80    
      RETURN                                                                 BALANC.81    
      END                                                                    BALANC.82    
