      SUBROUTINE ENER9 (TKINE,TCPT,TTOTE,TVOR2,TDIV2,TFICX,
     1                  TPHSX,XADD,XTG,XREF,ITRAC,NTRAC,ITRVAR,
     2                  TFICQ,QADD,
     3                  PG,CG,TG,UG,VG,PRESSG,MOIST,
     4                  DSGJ,DSHJ,ILG,LON,ILEV,LONSL,WJ,WX)
C
C     * APR 25/2010 - M.LAZARE. NEW VERSION FOR GCM15I:
C     *                         - PASSES IN XTG AND USES IT TO
C     *                           DO QUADRATURE FOR NEW OUTPUT
C     *                           FIELD TPHSX.
C     * DEC 07/2004 - M.LAZARE. PREVIOUS VERSION FOR GCM15C/D/E/F/G/H:
C     *                         - TFICQ,TFICX NOW DEFINED FOR EACH
C     *                           LEVEL (VERTICAL SUM NOW DONE IN
C     *                           NEW ENERSV9 LIKE OTHER FIELDS).
C     *                         - CALCULATION IS SAME NO MATTER
C     *                           WHAT CHOICE OF MOISTURE/TRACER
C     *                           VARIABLE (MUCH CLEANER).
C     * APR 01/2004 - M.LAZARE. PREVIOUS VERSION ENER7X FOR GCM15B.
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     * TFICQ  = TOTAL FICTITIOUS WATER VAPOUR ADDED TO FILL HOLES(Q) 
C     *        = TOTAL (E-P) (OTHERWISE). 
C     * TPHSX  = PHYSICS TRACER TENDENCIES.
C     * QADD   = FICTITIOUS WATER VAPOUR ADDED TO FILL HOLES(Q) 
C     *        = (E-P) (OTHERWISE). 
C     * WJ     = MULTIPLE-LATITUDE ARRAY OF GAUSSIAN WEIGHTS. 
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
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)
C 
      REAL DSGJ  (ILG,ILEV), DSHJ(ILG,ILEV), XREF(NTRAC)
      REAL QADD(ILG,ILEV), XADD(ILG,ILEV,NTRAC), XTG(ILG,ILEV,NTRAC)
      REAL TFICQ(ILEV),   TFICX(ILEV,NTRAC),  TPHSX(ILEV,NTRAC)
      REAL PG    (ILG,ILEV), CG    (ILG,ILEV),TG    (ILG,ILEV)
      REAL UG    (ILG,ILEV), VG    (ILG,ILEV)
      REAL PRESSG(ILG)
      REAL*8 WJ(ILG)
      REAL TKINE(ILEV), TCPT (ILEV), TTOTE(ILEV)
      REAL TVOR2(ILEV), TDIV2(ILEV)
C
C     * WORK ARRAY:
C
      REAL WX(ILG)
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)/REAL(LONSL)
   50 CONTINUE     
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
C 
C     * OBTAIN GLOBAL AVERAGE OF TFICQ (FOR EACH LEVEL).
C     * IF MOIST=4H   Q, THIS REPRESENTS FICTITIOUS MOISTURE SOURCE
C     * REQUIRED TO FILL HOLES. OTHERWISE, IT REPRESENTS PHYSICS 
C     * SOURCES/SINKS.
C 
      DO 330 L=1,ILEV
      DO 330 IL=1,LON 
          TFICQ(L) = TFICQ(L) + DSHJ(IL,L)* PRESSG(IL)*(WX(IL)/GRAV)*
     1                          QADD(IL,L)
  330 CONTINUE
C 
C     * OBTAIN GLOBAL AVERAGE OF TFICX AND TPHSX (FOR EACH LEVEL).
C  
      IF(ITRAC.NE.0)THEN
       DO 350 N=1,NTRAC 
       DO 350 L=1,ILEV
       DO 350 IL=1,LON
         TFICX(L,N) = TFICX(L,N) + DSHJ(IL,L)* PRESSG(IL)*(WX(IL)/GRAV)*
     1                             XADD(IL,L,N)
         TPHSX(L,N) = TPHSX(L,N) + DSHJ(IL,L)* PRESSG(IL)*(WX(IL)/GRAV)*
     1                             XTG (IL,L,N)
  350  CONTINUE 
      ENDIF
C 
      RETURN
C-----------------------------------------------------------------------
      END
