      SUBROUTINE ENERQX4(TWV,TWVX,QWF0,QSCAL,TTRAC,TTRACX,XWF0,
     1                   XSCAL,TRACG,ITRAC,NTRAC,ITRVAR,
     3                   QG,PRESSG,IMOIST,
     4                   DSHJ,IL1,IL2,ILG,ILEV,LONSL,
     5                   WJ)

C     * SEP 10/07 - M.LAZARE.    NEW VERSION FOR GCM15G:
C     *                          - WJ PASSED IN AND USED AS REAL*8
C     *                            FOR GREATER ACCURACY.
C     *                          - REMOVE LON FOR PLUG-COMPATABILITY.
C     * JUN 27/06 - M.LAZARE.    PREVIOUS VERSION ENERQX3 FOR GCM15F:
C     *                          - RATIONALIZATION OF REAL VS REAL*8.
C     *                          - WORK ARRAY "WX" NOW LOCAL.
C     *                          NOTE THAT UP TO NOW, ENERQX2 CALLED
C     *                          FROM BOTH PHYSICS AND SEMILAG 
C     *                          DYNAMICS. DUE TO REAL*8, REMOVAL OF
C     *                          PHYSICS "WRK" POINTERS AND PORTABLE
C     *                          PHYSICS, THIS POLICY NOW ABANDONED. 
C     * MAY 05/03 - K.VONSALZEN. PREVIOUS VERSION ENERQX2 UP TO GCM15E.
C
C     * THIS SUBROUTINE IS PURELY DIAGNOSTIC. 
C     * IN THE LATITUDE LOOP IT ACCUMULATES THE FOLLOWING:  
C     * 
C     * TWV    = TOTAL WATER VAPOUR, I.E. PRECIPITABLE WATER. 
C     * TWVX   = TOTAL MOISTURE SOURCES/SINKS.
C     * TTRAC  = TOTAL TRACER AMOUNT. 
C     * TTRACX = TOTAL TRACER SOURCE/SINKS.
C     *    
C     * WJ     = MULTIPLE-LATITUDE ARRAY OF GAUSSIAN WEIGHTS. 
C     * ILG    = FIRST DIMENSION OF REAL GRID ARRAYS. 
C     * LONSL  = NUMBER OF DISTINCT LONGITUDES IN A SINGLE LATITUDE. 
C     * IMOIST = MOISTURE VARIABLE SWITCH TO INDICATE WHETHER CODE
C     *          BEING ACTIVATED IN THIS ROUTINE USAGE (=1) OR NOT.
C     * ITRVAR = SAME AS ABOVE EXCEPT FOR TRACERS. 
C
      IMPLICIT REAL   (A-H,O-Z),
     +INTEGER (I-N)
C
C     * NATIVE TEMPORARY VARIABLES FOR MAX INTRINSIC.
C
      REAL   QWF0TMP,XWF0TMP
C
      REAL   DSHJ  (ILG,ILEV)
      REAL   QG    (ILG,ILEV)
      REAL   QWF0  (ILG,ILEV)
      REAL   TRACG (ILG,ILEV,NTRAC)
      REAL   XWF0  (ILG,ILEV,NTRAC)
      REAL   PRESSG(ILG)
      REAL*8 WJ    (ILG)  
C
C     * THE FOLLOWING ARE PASSED THROUGH THE PHYSICS CALL FROM THE
C     * CORE ROUTINES AND THUS ALWAYS MUST BE NATIVE REAL!
C
      REAL   TWV  (ILEV),      TWVX  (ILEV)      ,QSCAL(ILEV)
      REAL   TTRAC(ILEV,NTRAC),TTRACX(ILEV,NTRAC),XSCAL(ILEV,NTRAC)
C
C     * INTERNAL WORK ARRAY:
C
      REAL,  DIMENSION(ILG)  :: WX
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=IL1,IL2
         WX(IL)=.5*WJ(IL)/REAL(LONSL)
   50 CONTINUE     
C 
C     * ACCUMULATE THE ENERGETICS.
C 
      IF(IMOIST.EQ.1) THEN
        DO 200 L=1,ILEV 
        DO 200 IL=IL1,IL2 
          TWV  (L)=TWV  (L) + DSHJ(IL,L)* PRESSG(IL)*(WX(IL)/GRAV)*
     1                          QG(IL,L)
          TWVX (L)=TWVX (L) + DSHJ(IL,L)* PRESSG(IL)*(WX(IL)/GRAV)*
     1                        QWF0(IL,L)*QG(IL,L)
          QWF0TMP =QWF0(IL,L)
          QSCAL(L)=MAX(QSCAL(L),QWF0TMP)
  200   CONTINUE
      ENDIF  
C
      IF(ITRAC.NE.0 .AND. ITRVAR.EQ.1) THEN
C 
C        * ACCUMULATE THE MASS ASSOCIATED WITH EACH TRACER.
C 
         DO 210 N=1,NTRAC
         DO 210 L=1,ILEV 
         DO 210 IL=IL1,IL2
           TTRAC (L,N)=TTRAC (L,N)+DSHJ(IL,L)*PRESSG(IL)*(WX(IL)/GRAV)*
     1                 TRACG(IL,L,N) 
           TTRACX(L,N)=TTRACX(L,N)+DSHJ(IL,L)*PRESSG(IL)*(WX(IL)/GRAV)*
     1                 XWF0(IL,L,N)*TRACG(IL,L,N) 
           XWF0TMP    =XWF0(IL,L,N)
           XSCAL(L,N) =MAX(XSCAL(L,N),XWF0TMP)
  210    CONTINUE
      ENDIF
C 
      RETURN
C-----------------------------------------------------------------------
      END
