C**********************************************************                  ENERGY.2     
C             SUBROUTINE ENERGY                                              ENERGY.3     
C**********************************************************                  ENERGY.4     
      SUBROUTINE ENERGY                                                      ENERGY.5     
C                                                                            ENERGY.6     
C     Calculates various global diagnostic quantities                        ENERGY.7     
C     every itstp timesteps.                                                 ENERGY.8     
C                                                                            ENERGY.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                                                                            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                                                                            OUTCON.2     
C     Switches counters and constants controlling type and frequency of      OUTCON.3     
C     model output                                                           OUTCON.4     
C                                                                            OUTCON.5     
      COMMON/OUTCON/RNTAPE,NCOEFF,NLAT,INLAT,INSPC                           OUTCON.6     
     +              ,RNTAPO                                                  OUTCON.7     
     +              ,KOUNTP,KOUNTE,KOUNTH,KOUNTR                             OUTCON.8     
     +              ,KOUTP,KOUTE,KOUTH,KOUTR,DAY                             OUTCON.9     
     +              ,SQR2,RSQR2,EAM1,EAM2,TOUT1,TOUT2,RMG                    OUTCON.10    
     +              ,LSPO(NL),LGPO(NL)                                       OUTCON.11    
     $              ,LSHIST,LMINIH                                           OUTCON.12    
      LOGICAL LSHIST,LMINIH                                                  OUTCON.13    
      LOGICAL LSPO,LGPO                                                      OUTCON.14    
C                                                                            OUTCON.15    
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    
      COMPLEX Q(IGB)                                                         ENERGY.16    
      EQUIVALENCE (Q(1),TRA(1,1))                                            ENERGY.17    
      COMPLEX TIG,SPIP,CTIG,CRGS                                             ENERGY.18    
      COMMON/STATS/GMSP0,GMSPMI,LMASCOR,LMASOLD,LMASPRT                      STATS.2     
      LOGICAL LMASCOR,LMASOLD,LMASPRT                                        STATS.3     
C                                                                            STATS.4     
C-----------------------------------------------------------------------     STATS.5     
C                                                                            ENERGY.20    
C     First remove planetary vorticity so Z contains relative vorticity      ENERGY.21    
C                                                                            ENERGY.22    
      I=1                                                                    ENERGY.23    
      DO 101 L=1,NL                                                          ENERGY.24    
         Z(I)=Z(I)-EZ                                                        ENERGY.25    
         I=I+IGA                                                             ENERGY.26    
  101 CONTINUE                                                               ENERGY.27    
C                                                                            ENERGY.28    
C     Calculate means - PSITOT RMS vorticity                                 ENERGY.29    
C                       CHITOT RMS divergence                                ENERGY.30    
C                       TMPTOT RMS temperature                               ENERGY.31    
C                       TOTP  IE+PE potential energy                         ENERGY.32    
C                       AMSP mean surface pressure                           ENERGY.33    
C                                                                            ENERGY.34    
      PSITOT=0.0                                                             ENERGY.35    
      CHITOT=0.0                                                             ENERGY.36    
      TMPTOT=0.0                                                             ENERGY.37    
      TOTP=0.0                                                               ENERGY.38    
      TOTI=0.0                                                               ENERGY.39    
      TOTQ=0.0 ! Total moisture diagnostic (as in BGCM5).                    ENERGY.40    
      AMQ=0.0  ! Accounts for the p0 term excluded from SPA(1) in MGRMLT.    ENERGY.41    
      IL=1                                                                   ENERGY.42    
      ST2B=0.                                                                ENERGY.43    
      ST=0.                                                                  ENERGY.44    
      IOFS=0                                                                 ENERGY.45    
      DO 800 IHEM=1,NHEM                                                     ENERGY.46    
         IG=IOFS                                                             ENERGY.47    
         DO 30 L=1,NL                                                        ENERGY.48    
            TPSITT=0.                                                        ENERGY.49    
            TCHITT=0.                                                        ENERGY.50    
            TTMPTT=0.                                                        ENERGY.51    
            TTOTI=0.                                                         ENERGY.52    
            TTOTQ=0.                                                         ENERGY.53    
            DSIG=DSIGMA(L)                                                   ENERGY.54    
            DSIGH=0.5*DSIG                                                   ENERGY.55    
            IP=IOFS                                                          ENERGY.56    
            DO 10 JP=1,NFP,MH                                                ENERGY.57    
               IG=IG+1                                                       ENERGY.58    
               IP=IP+1                                                       ENERGY.59    
               RTIG=REAL(T(IG))                                              ENERGY.60    
               RZIG=REAL(Z(IG))                                              ENERGY.61    
               RDIG=REAL(D(IG))                                              ENERGY.62    
               TPSITT=TPSITT+RZIG*RZIG                                       ENERGY.63    
               TCHITT=TCHITT+RDIG*RDIG                                       ENERGY.64    
               TTMPTT=TTMPTT+RTIG*RTIG                                       ENERGY.65    
               RSPIP=REAL(SPA(IP))                                           ENERGY.66    
               IF (L.EQ.1) THEN                                              ENERGY.67    
                  TOTP=TOTP+0.5*RSPIP*REAL(GS(IP))                           ENERGY.68    
               ENDIF                                                         ENERGY.69    
               TTOTI=TTOTI+RSPIP*RTIG                                        ENERGY.70    
               TTOTQ=TTOTQ+RSPIP*REAL(Q(IG))                                 ENERGY.71    
   10       CONTINUE                                                         ENERGY.72    
            PSITOT=PSITOT+DSIGH*TPSITT                                       ENERGY.73    
            CHITOT=CHITOT+DSIGH*TCHITT                                       ENERGY.74    
            TMPTOT=TMPTOT+DSIGH*TTMPTT                                       ENERGY.75    
            TOTI=TOTI+DSIGH*TTOTI                                            ENERGY.76    
            TOTQ=TOTQ+DSIGH*TTOTQ                                            ENERGY.77    
            TPSITT=0.                                                        ENERGY.78    
            TCHITT=0.                                                        ENERGY.79    
            TTMPTT=0.                                                        ENERGY.80    
            TTOTI=0.                                                         ENERGY.81    
            TTOTQ=0.                                                         ENERGY.82    
            DO 25 M=MOCT,MF,MOCT                                             ENERGY.83    
               DO 20 JP=M,NF,MH                                              ENERGY.84    
                  IG=IG+1                                                    ENERGY.85    
                  IP=IP+1                                                    ENERGY.86    
                  TIG=T(IG)                                                  ENERGY.87    
                  CTIG=CONJG(TIG)                                            ENERGY.88    
                  SPIP=SPA(IP)                                               ENERGY.89    
                  TPSITT=TPSITT+REAL(Z(IG)*CONJG(Z(IG)))                     ENERGY.90    
                  TCHITT=TCHITT+REAL(D(IG)*CONJG(D(IG)))                     ENERGY.91    
                  TTMPTT=TTMPTT+REAL(TIG*CTIG)                               ENERGY.92    
                  IF (L.EQ.1) THEN                                           ENERGY.93    
                     CRGS=CONJG(GS(IP))                                      ENERGY.94    
                     TOTP=TOTP+REAL(SPIP*CRGS)                               ENERGY.95    
                  ENDIF                                                      ENERGY.96    
                  TTOTI=TTOTI+REAL(SPIP*CTIG)                                ENERGY.97    
                  TTOTQ=TTOTQ+REAL(SPIP*CONJG(Q(IG)))                        ENERGY.98    
   20          CONTINUE                                                      ENERGY.99    
   25       CONTINUE                                                         ENERGY.100   
            PSITOT=PSITOT+DSIG*TPSITT                                        ENERGY.101   
            CHITOT=CHITOT+DSIG*TCHITT                                        ENERGY.102   
            TMPTOT=TMPTOT+DSIG*TTMPTT                                        ENERGY.103   
            TOTI=TOTI+DSIG*TTOTI                                             ENERGY.104   
            TOTQ=TOTQ+DSIG*TTOTQ                                             ENERGY.105   
            IF (IHEM.EQ.1) THEN                                              ENERGY.106   
               RTL=REAL(T(IL))                                               ENERGY.107   
               ST2B=ST2B+T0(L)*RTL*DSIG                                      ENERGY.108   
               ST=ST+RTL*DSIG                                                ENERGY.109   
               AMQ=AMQ+DSIG*REAL(Q(IL))                                      ENERGY.110   
               IL=IL+IGA                                                     ENERGY.111   
            ENDIF                                                            ENERGY.112   
            IG=IG+IGA-NWJ2                                                   ENERGY.113   
   30    CONTINUE                                                            ENERGY.114   
         IOFS=NWJ2                                                           ENERGY.115   
  800 CONTINUE                                                               ENERGY.116   
      AMSP=1.0+REAL(SPA(1))*RSQR2                                            ENERGY.117   
      AMQ=CQ*RSQR2*AMQ                                                       ENERGY.118   
      TOTQ=CQ*TOTQ+AMQ                                                       ENERGY.119   
      PSITOT=SQRT(PSITOT)                                                    ENERGY.120   
      CHITOT=SQRT(CHITOT)                                                    ENERGY.121   
      TMPTOT=SQRT(TMPTOT+TOUT2+ST2B*SQR2)                                    ENERGY.122   
      TOTP=TOTP+RSQR2*REAL(GS(1))+(AMSP*TOUT1+TOTI+RSQR2*ST)/AKAP            ENERGY.123   
C                                                                            ENERGY.124   
      IF (KOUNT .EQ. 0) WRITE(2,40)                                          ENERGY.125   
        IF (KOUTP.EQ.0) THEN                                                 ENERGY.126   
           WRITE (2,50) KOUNT,PSITOT,CHITOT,TMPTOT,TOTP,TOTQ,AMSP            ENERGY.127   
        ENDIF                                                                ENERGY.128   
   40 FORMAT(/3X,'KOUNT',3X,'RMSVORT',8X,'RMSDIV',8X,'RMSTEMP'               ENERGY.129   
     +       ,8X,'PE+IE',8X,'TOTQ',9X,'MSP')                                 ENERGY.130   
   50 FORMAT(I6,1X,4E15.6,2F13.10)                                           ENERGY.131   
C                                                                            ENERGY.132   
C     Restore Z to absolute vorticity                                        ENERGY.133   
C                                                                            ENERGY.134   
      I=1                                                                    ENERGY.135   
      DO 102 L=1,NL                                                          ENERGY.136   
         Z(I)=Z(I)+EZ                                                        ENERGY.137   
         I=I+IGA                                                             ENERGY.138   
  102 CONTINUE                                                               ENERGY.139   
C                                                                            ENERGY.140   
      RETURN                                                                 ENERGY.141   
      END                                                                    ENERGY.142   
