      SUBROUTINE XTEVOLC4(XEMIS,PRESSG,DSHJ,ZF,
     1                    ESCVROW,EHCVROW,ESEVROW,EHEVROW,ESVCROW,
     2                    ESVEROW,DSU,PSUEF,ISO2,SAVERAD,ISVCHEM,IPAM,
     3                    ILG,IL1,IL2,ILEV,LEV,NTRAC,ZTMST)
C
C     * JUN 18/2013 - K.VONSALZEN/ NEW VERSION FOR GCM17+:
C     *               M.LAZARE.    - ADD CONDITION TO SET WGT=1. FOR
C     *                              SPECIAL CASE WHERE HSO2=LSO2.
C     *                            - ADD SUPPORT FOR THE PLA OPTION
C     *                              "DOC" ARRAY, "IPAM" SWITCH NOW PASSED.
C     *                            - REMOVE "EHCVROW" AND "EHEVROW"
C     *                              FROM IF CONDITIONS.
C     * APR 28/2012 - K.VONSALZEN/ PREVIOUS VERSION XTEVOLC3 FOR GCM16:
C     *               M.LAZARE.    - INITIALIZE LSO2 AND HSO2 TO
C     *                              ILEV INSTEAD OF ZERO, TO
C     *                              AVOID POSSIBLE INVALID 
C     *                              MEMORY REFERENCES.
C     *                            - BUGFIX TO INCLUDE RATIO OF
C     *                              MOLECULAR WEIGHTS IN
C     *                              CALCULATION OF CONTINUOUS
C     *                              VOLCANIC EMISSIONS.
C     * APR 26/2010 - K.VONSALZEN/ PREVIOUS VERSION XTEVOLC2 FOR GCM15I:
C     *               M.LAZARE.    - ZF PASSED IN (CALCULATED IN
C     *                              PHYSICS) RATHER THAN CALCULATED
C     *                              INTERNALLY (NO NEED TO PASS IN
C     *                              T OR SHBJ).
C     *                            - EXPLOSIVE VOLCANOES NOT CONTROLLED
C     *                              BY PASSED-IN "IEXPLVOL" SWITCH;
C     *                              RATHER A NEW LOGICAL INTERNAL
C     *                              VARIABLE "VOLCEXP" IS USED 
C     *                              DEFAULT "OFF") WHICH CAN BE
C     *                              UPDATED TO BE ACTIVATED. WE 
C     *                              DO EXPLOSIVE VOLCANOES EXTERNALLY
C     *                              TO THIS ROUTINE GENERALLY NOW.
C     *                            - EMISSIONS NOW STORED INTO GENERAL
C     *                              "EMIS" ARRAY, INSTEAD OF UPDATING
C     *                              XROW AT THIS POINT.
C     *                            - BUGFIX TO VERTICAL LOOP 205 WHERE
C     *                              SHOULD START FROM "ILEV" AND NOT
C     *                              "LEV" (OTHERWISE MEMORY OUT OF
C     *                              BOUNDS).
C     *                            - MORE ACCURATE CALCULATION OF "WGT".
C     * FEB 07,2009 - K.VONSALZEN/ PREVIOUS ROUTINE XTEVOLC FOR GCM15H:
C     *               M.LAZARE:    - APPLY EMISSIONS FROM VOLCANOES.
C     *                              THIS USED TO BE IN OLD XTEAERO.
C     *               **NOTE**:      WE PASS IN AND USE INTEGER SWITCH
C     *                              "IEXPLVOL" TO CONTROL WHETHER
C     *                              EXPLOSIVE VOLCANO CODE IN THIS
C     *                              ROUTINE IS ACTIVATED (IEXPLVOL=0)
C     *                              OR IS HANDLED ELSEWHERE IN THE
C     *                              CODE (IEXPLVOL=1). 
C
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)
C
C     * I/O FIELDS.
C
      REAL XEMIS(ILG,ILEV,NTRAC)
      REAL DSHJ(ILG,ILEV),PRESSG(ILG)
      REAL, DIMENSION(ILG,ILEV)  :: ZF
      REAL DSU(ILG,ILEV)
C
      REAL ESCVROW(ILG),EHCVROW(ILG)
      REAL ESEVROW(ILG),EHEVROW(ILG)
C
      REAL ESVCROW(ILG),ESVEROW(ILG)
C
C     * INTERNAL WORK FIELDS.
C
      INTEGER, DIMENSION(ILG) ::  LSO2,HSO2
C
      REAL, PARAMETER :: WSO2    =64.059
      REAL, PARAMETER :: WH2SO4  =98.073
      REAL, PARAMETER :: WNH3    =17.030
      REAL, PARAMETER :: WAMSUL  =WH2SO4+2.*WNH3 
      REAL, PARAMETER :: WRAT    =WAMSUL/WSO2
      REAL, PARAMETER :: PSUEFT=0.
C
      COMMON /PARAMS/ WW,     TW,    A,     ASQ,  GRAV, RGAS,  RGOCP,
     1                RGOASQ, CPRES, RGASV, CPRESV
C
C     *         LOCAL FLAG TO CONTROL EXPLOSIVE CLIMATOLOGICAL
C     *         (NON-TRANSIENT) VOLCANOES.
C
      LOGICAL VOLCEXP
      DATA VOLCEXP /.FALSE./
C-------------------------------------------------------------------
C
C     * ESCV: CONTINOUS VOLCANIC EMISSIONS
C
      DO 200 IL=IL1,IL2
        LSO2(IL) = ILEV
        HSO2(IL) = ILEV
  200 CONTINUE
C
      DO 205 L=ILEV,1,-1
      DO 205 IL=IL1,IL2
       IF(ZF(IL,L) .LE. 0.67*EHCVROW(IL))   LSO2(IL)=L
       IF(ZF(IL,L) .LE. 1.00*EHCVROW(IL))   HSO2(IL)=L
  205 CONTINUE
C
      JT=ISO2
      DO 220 L=1,ILEV
      DO 220 IL=IL1,IL2
        IF(ESCVROW(IL).GT.0.) THEN
          ELCV=0.67*EHCVROW(IL)
          EUCV=1.00*EHCVROW(IL)
          FACT = ZTMST*GRAV/(DSHJ(IL,L)*PRESSG(IL))
          IF(L.EQ.HSO2(IL) .AND. L.EQ.LSO2(IL)) THEN
            WGT=1.
          ELSE IF(L.EQ.HSO2(IL)) THEN
            WGT=(EUCV-ZF(IL,L))/(EUCV-ELCV)
          ELSE IF(L.GT.HSO2(IL).AND.L.LT.LSO2(IL)) THEN
            WGT=(ZF(IL,L-1)-ZF(IL,L))/(EUCV-ELCV)
          ELSE IF(L.EQ.LSO2(IL)) THEN
            WGT=(ZF(IL,L-1)-ELCV)/(EUCV-ELCV)
          ELSE
            WGT=0.
          ENDIF
          XEMIS(IL,L,JT)=XEMIS(IL,L,JT)+WGT*ESCVROW(IL)*FACT
     1                                   *32.064/64.059*(1.-PSUEFT)
          IF ( IPAM .EQ. 1 ) DSU(IL,L)=DSU(IL,L)
     1                         +WGT*ESCVROW(IL)*FACT*WRAT*PSUEFT/ZTMST
          IF(ISVCHEM.GT.0)                          THEN
            ESVCROW(IL)=ESVCROW(IL)+WGT*ESCVROW(IL)
     1                                   *32.064/64.059*SAVERAD
          ENDIF
        ENDIF
  220 CONTINUE
C
C     * ESEV: ERUPTIVE VOLCANIC EMISSIONS
C     * NOTE! THESE ARE ONLY DONE IF THE LOCAL SWITCH "VOLCEXP" IS .TRUE.
C
      IF (VOLCEXP) THEN
        DO 300 IL=IL1,IL2
          LSO2(IL) = ILEV
          HSO2(IL) = ILEV
  300   CONTINUE
C
        DO 305 L=ILEV,1,-1
        DO 305 IL=IL1,IL2
          IF(ZF(IL,L) .LE. EHEVROW(IL)+500. )   LSO2(IL)=L
          IF(ZF(IL,L) .LE. EHEVROW(IL)+1500.)   HSO2(IL)=L
  305   CONTINUE
C
        DO 320 L=1,ILEV
        DO 320 IL=IL1,IL2
          IF(ESEVROW(IL).GT.0.) THEN
            ELEV=EHEVROW(IL)+500.
            EUEV=EHEVROW(IL)+1500.
            FACT = ZTMST*GRAV/(DSHJ(IL,L)*PRESSG(IL))
            IF(L.EQ.HSO2(IL) .AND. L.EQ.LSO2(IL)) THEN
              WGT=1.
            ELSE IF(L.EQ.HSO2(IL)) THEN
              WGT=(EUEV-ZF(IL,L))/(EUEV-ELEV)
            ELSE IF(L.GT.HSO2(IL).AND.L.LT.LSO2(IL)) THEN
              WGT=(ZF(IL,L-1)-ZF(IL,L))/(EUEV-ELEV)
            ELSE IF(L.EQ.LSO2(IL)) THEN
              WGT=(ZF(IL,L-1)-ELEV)/(EUEV-ELEV)
            ELSE
              WGT=0.
            ENDIF
            XEMIS(IL,L,JT)=XEMIS(IL,L,JT)+WGT*ESEVROW(IL)*FACT
     1                                   *32.064/64.059*(1.-PSUEFT)
            IF ( IPAM .EQ. 1 ) DSU(IL,L)=DSU(IL,L)
     1                         +WGT*ESEVROW(IL)*FACT*WRAT*PSUEFT/ZTMST
            IF(ISVCHEM.GT.0)                          THEN
              ESVEROW(IL)=ESVEROW(IL)+WGT*ESEVROW(IL)
     1                                     *32.064/64.059*SAVERAD
            ENDIF
          ENDIF
  320   CONTINUE
      ENDIF
C
      RETURN
      END
