      SUBROUTINE ENER5(TKINE,TCPT,TTOTE,TWV,TVOR2,TDIV2,TWVA,TTRAC, 
     1                 TFICX,XADD,TRACG,ITRAC,NTRAC,ITRVAR,
     2                 TFICQ,QADD,QREFL,QREFU,
     3                 PG,CG,TG,UG,VG,QG,PRESSG,MOIST,DOPHYS, 
     4                 DSGJ,DSHJ,ILG,LON,ILEV,LEVS,LONSL,
     5                 WJ,JLAT,SHUMREF,WX)

C     * OCT 14/92 - M.LAZARE.  LIKE PREVIOUS VERSION ENER4 EXCEPT:
C     *                        - SINJ REMOVED (NOT USED).
C     *                        - MULTIPLE-LATITUDE FORMULATION WITH
C     *                          WJ "ROW" NOW PASSED INSTEAD OF "WL".
C     *                        - WORK SPACE "WX" PASSED TO STORE
C     *                          VECTOR OF EFFECTIVE WEIGHTS. 
C     * SEP 28/92 - M.LAZARE.  PREVIOUS VERSION ENER4.
C 
C     * THIS SUBROUTINE IS PURELY DIAGNOSTIC. 
C     * IN THE LATITUDE LOOP IT ACCUMULATES THE FOLLOWING:  
C     * 
C     * TKINE  = KINETIC ENERGY.
C     * TCPT   = CP*T, WILL FORM POTENTIAL ENERGY ONCE PHIS ADDED TO IT.
C     * TTOTE  = (UNUSED HERE). 
C     * TVOR2  = VORTICITY  SQUARED /2. 
C     * TDIV2  = DIVERGENCE SQUARED /2. 
C     * TWV    = TOTAL WATER VAPOUR, I.E. PRECIPITABLE WATER. 
C     * TWVA   = TOTAL WATER VAPOUR INVOLVING VALUES OF SPECIFIC
C     *          HUMIDITY IN EXCESS OF LOWER BOUND QREFL BUT BELOW
C     *          REFERENCE UPPER BOUND QREFU. 
C     * TTRAC  = TOTAL TRACER AMOUNT. 
C     * TFICQ  = TOTAL FICTITIOUS WATER VAPOUR ADDED TO FILL HOLES(Q) 
C     *        = TOTAL (E-P) (OTHERWISE). 
C     * QADD   = FICTITIOUS WATER VAPOUR ADDED TO FILL HOLES(Q) 
C     *        = (E-P) (OTHERWISE). 
C     * WJ     = MULTIPLE-LATITUDE ARRAY OF GAUSSIAN WEIGHTS. 
C     * DOPHYS = LOGICAL SWITCH TO INDICATE WHETHER PHYSICS IS CALLED.
C     * ILG    = FIRST DIMENSION OF REAL GRID ARRAYS. 
C     * LON    = NUMBER OF DISTINCT LONGITUDES. 
C     * LONSL  = NUMBER OF DISTINCT LONGITUDES IN A SINGLE LATITUDE. 
C     * JLAT   = INDEX OF CURRENT LATITUDE(S).
C     * MOIST  = MOISTURE VARIABLE. 
C     * QREFL  = SPECIFIC HUMIDITY LOWER BOUND REFERENCE VALUE FOR
C     *          MOISTURE CONSERVATION SCHEME, I.E. CORRECTED FOR VALUES
C     *          OF Q ABOVE THIS THRESHOLD. 
C     * QREFU  = SPECIFIC HUMIDITY UPPER BOUND REFERENCE VALUE FOR
C     *          MOISTURE CONSERVATION SCHEME, I.E. CORRECTED FOR VALUES
C     *          OF Q BELOW THIS THRESHOLD. 
C     * SHUMREF= "REFERENCE" SPECIFIC HUMIDITY FOR HYBRID MOISTURE
C     *          VARIABLE.
C 
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)

      REAL DSGJ  (ILG,ILEV), DSHJ  (ILG,ILEV),QADD  (ILG) 
      REAL XADD  (ILG,NTRAC)
      REAL PG    (ILG,ILEV), CG    (ILG,ILEV),TG    (ILG,ILEV)
      REAL UG    (ILG,ILEV), VG    (ILG,ILEV),QG    (ILG,ILEV)
      REAL TRACG(ILG,ILEV,NTRAC)
      REAL PRESSG(ILG)
      REAL*8 WJ(ILG)
      REAL TKINE(ILEV), TCPT (ILEV), TTOTE(ILEV)
      REAL TVOR2(ILEV), TDIV2(ILEV), TWV  (ILEV), TWVA (ILEV) 
      REAL TTRAC(ILEV,NTRAC), TFICX(NTRAC)
C
C     * WORK ARRAY:
C
      REAL WX(ILG)
C 
      LOGICAL DOPHYS
C 
      COMMON /PARAMS/ WW,TW,A,ASQ,GRAV,RGAS,RGOCP,RGOASQ,CPRES
      COMMON /PARAMS/ RGASV,CPRESV
C-----------------------------------------------------------------------
C     * SET UP ARRAY OF "EFFECTIVE" WEIGHTS USED IN QUADRATURE.
C
      DO 50 IL=1,LON
         WX(IL)=.5*WJ(IL)/FLOAT(LONSL)
   50 CONTINUE     
C 
C     * INITIALIZE THE FIELDS AT FIRST LATITUDE.
C 
      IF(JLAT.EQ.1)THEN 
         DO 100 L=1,ILEV
            TKINE  (L)=0. 
            TCPT   (L)=0. 
            TTOTE  (L)=0. 
            TVOR2  (L)=0. 
            TDIV2  (L)=0. 
            TWV    (L)=0. 
            TWVA   (L)=0. 
  100    CONTINUE 
  
         IF(ITRAC.NE.0) THEN
            DO 110 N=1,NTRAC
            DO 110 L=1,ILEV 
               TTRAC(L,N)=0.
  110       CONTINUE
         ENDIF
      ENDIF 
C 
C     * ACCUMULATE THE ENERGETICS.
C 
      DO 200 L=1,ILEV 
      DO 200 IL=1,LON 
         TKINE(L)=TKINE(L) + DSGJ(IL,L)* PRESSG(IL)*(WX(IL)/GRAV)* 
     1                        (UG(IL,L)**2+VG(IL,L)**2)*0.5 
         TCPT (L)=TCPT (L) + DSHJ(IL,L)* PRESSG(IL)*(WX(IL)/GRAV)* 
     1                         TG(IL,L)*CPRES 
         TVOR2(L)=TVOR2(L) + DSGJ(IL,L)* PRESSG(IL)*(WX(IL)/GRAV)* 
     1                        (PG(IL,L)**2)*0.5 
         TDIV2(L)=TDIV2(L) + DSGJ(IL,L)* PRESSG(IL)*(WX(IL)/GRAV)* 
     1                        (CG(IL,L)**2)*0.5 
  200 CONTINUE
         IF(ITRAC.NE.0) THEN
C 
C     * ACCUMULATE THE MASS ASSOCIATED WITH EACH TRACER.
C 
      IF(ITRAC.NE.0)THEN
         IF(ITRVAR.EQ.NC4TO8("   Q")) THEN
            DO 210 N=1,NTRAC
            DO 210 L=1,ILEV 
            DO 210 IL=1,LON 
              TTRAC(L,N)=TTRAC(L,N)+DSHJ(IL,L)*PRESSG(IL)*(WX(IL)/GRAV)*
     1                   TRACG(IL,L,N) 
  210       CONTINUE
         ELSEIF(ITRVAR.EQ.NC4TO8("RLNQ")) THEN
            DO 220 N=1,NTRAC
            DO 220 L=1,ILEV 
            DO 220 IL=1,LON 
              TTRAC(L,N)=TTRAC(L,N)+DSHJ(IL,L)*PRESSG(IL)*(WX(IL)/GRAV)*
     1                   EXP(-1./TRACG(IL,L,N))
  220       CONTINUE
         ELSEIF(ITRVAR.EQ.NC4TO8(" LNQ")) THEN
            DO 230 N=1,NTRAC
            DO 230 L=1,ILEV 
            DO 230 IL=1,LON 
              TTRAC(L,N)=TTRAC(L,N)+DSHJ(IL,L)*PRESSG(IL)*(WX(IL)/GRAV)*
     1                   EXP(TRACG(IL,L,N))
  230       CONTINUE
         ELSE 
            CALL XIT('ENER5',-90) 
         ENDIF
      ENDIF 
         ENDIF
C 
      DO 310 L=1,ILEV 
         DO 300 IL=1,LON
            TWV  (L)=TWV  (L) + DSHJ(IL,L)* PRESSG(IL)*(WX(IL)/GRAV)*
     1                          QG(IL,L)
            IF(DOPHYS) THEN 
               TWVA (L)=TWVA (L) + DSHJ(IL,L)* PRESSG(IL)*(WX(IL)/GRAV)*
     1                             MAX(QG(IL,L)-QREFL, 0.)* 
     2                             MAX(QREFU-QG(IL,L), 0.)
            ENDIF 
  300    CONTINUE 
  310 CONTINUE
C 
C     * OBTAIN GLOBAL AVERAGE OF TFICQ BASED ON CHOICE OF MOISTURE
C     * VARIABLE. IF MOIST=4H   Q, PART OF VERTICAL INTEGRAL HAS
C     * BEEN DONE IN PHYSICS (MULTIPLYING BY DSHJ) AND FICTITIOUS 
C     * MOISTURE SOURCE ADDED TO FILE "HOLES" MUST STILL BE MULTIPLIED
C     * BY PS/G. OTHERWISE, QADD REPRESENTS (E-P) AND NO SUCH SCALING 
C     * IS REQUIRED.
C 
C     * DON'T DO THIS CALCULATION IF PHYSICS NOT CALLED SINCE "QADD"
C     * WILL NOT HAVE BEEN DEFINED (TFICQ WILL MAINTAIN INITIAL VALUE OF
C     * ZERO).
C 
      IF(DOPHYS) THEN 
         IF(MOIST.EQ.NC4TO8("   Q")) THEN
            DO 330 IL=1,LON 
               TFICQ = TFICQ + PRESSG(IL) * (WX(IL)/GRAV) * QADD(IL) 
  330       CONTINUE
         ELSE 
            DO 340 IL=1,LON 
               TFICQ = TFICQ + WX(IL) * QADD(IL) 
  340       CONTINUE
         ENDIF
      ENDIF 
C 
C     * OBTAIN GLOBAL AVERAGE OF TFICX BASED ON CHOICE OF TRACER
C     * VARIABLE. 
  
      IF(ITRAC.NE.0)THEN
         IF(DOPHYS) THEN
            IF(ITRVAR.EQ.NC4TO8("   Q")) THEN
               DO 350 N=1,NTRAC 
               DO 350 IL=1,LON
                  TFICX(N) = TFICX(N) + PRESSG(IL) * (WX(IL)/GRAV) * 
     1                       XADD(IL,N) 
  350          CONTINUE 
            ELSE
               DO 360 N=1,NTRAC 
               DO 360 IL=1,LON
                  TFICX(N) = TFICX(N) + WX(IL) * XADD(IL,N)
  360          CONTINUE 
            ENDIF 
         ENDIF
      ENDIF 
C 
      RETURN
C-----------------------------------------------------------------------
      END
