      SUBROUTINE XTTEMIP(XEMIS,DOCEM1,DOCEM2,DOCEM3,DOCEM4,DBCEM1,
     1                   DBCEM2,DBCEM3,DBCEM4,DSUEM1,DSUEM2,DSUEM3,
     2                   DSUEM4,PSUEF1,PSUEF2,PSUEF3,PSUEF4,
     3                   SAIRROW,SSFCROW,SBIOROW,SSHIROW,
     4                   SSTKROW,SFIRROW,BAIRROW,BSFCROW,BBIOROW,
     5                   BSHIROW,BSTKROW,BFIRROW,OAIRROW,OSFCROW,
     6                   OBIOROW,OSHIROW,OSTKROW,OFIRROW,FBBCROW,
     7                   FAIRROW,PRESSG,DSHJ,ZF,ZFS,ZTMST,LEVWF,
     8                   LEVAIR,ISO2,IL1,IL2,LEV,ILG,ILEV,NTRAC)
C
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N) 
C
      REAL, INTENT(IN) :: PSUEF1,PSUEF2,PSUEF3
      REAL, INTENT(IN), DIMENSION(ILG) :: PRESSG
      REAL, INTENT(IN), DIMENSION(ILG,ILEV)  :: DSHJ,ZF
      REAL, INTENT(IN), DIMENSION(ILG,ILEV+1):: ZFS
      REAL, INTENT(IN), DIMENSION(ILG,LEVWF) :: FBBCROW
      REAL, INTENT(IN), DIMENSION(ILG,LEVAIR):: FAIRROW
      REAL, INTENT(IN), DIMENSION(ILG) :: 
     1              SAIRROW,SSFCROW,SBIOROW,SSHIROW,SSTKROW,SFIRROW,
     2              BAIRROW,BSFCROW,BBIOROW,BSHIROW,BSTKROW,BFIRROW,
     3              OAIRROW,OSFCROW,OBIOROW,OSHIROW,OSTKROW,OFIRROW
      REAL, INTENT(OUT), DIMENSION(ILG,ILEV) :: 
     1                                   DOCEM1,DOCEM2,DOCEM3,DOCEM4,
     2                                   DBCEM1,DBCEM2,DBCEM3,DBCEM4,
     3                                   DSUEM1,DSUEM2,DSUEM3,DSUEM4
      REAL, INTENT(OUT), DIMENSION(ILG,ILEV,NTRAC) :: XEMIS
C
      INTEGER, DIMENSION(ILG) ::  LLOW,LHGH
      REAL, PARAMETER :: WS      =32.064
      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 :: OC2POM  =1.4
      REAL, DIMENSION(6) :: ZWF
      DATA ZWF /100., 500., 1000., 2000., 3000., 6000./
      REAL, DIMENSION(25) :: ZAIR
      DATA ZAIR / 610., 1220., 1830., 2440., 3050., 3660., 4270., 
     1           4880., 5490., 6100., 6710., 7320., 7930., 8540.,
     2           9150., 9760.,10370.,10980.,11590.,12200.,12810.,
     3          13420.,14030.,14640.,15250. /
C
      COMMON /PARAMS/ WW,     TW,    A,     ASQ,  GRAV, RGAS,  RGOCP,
     1                RGOASQ, CPRES, RGASV, CPRESV
C
C-------------------------------------------------------------------
C     * CHECK DIMENSIONS.
C
      IF ( LEVWF  /= 6  ) CALL XIT("XTTEMI",-1)
      IF ( LEVAIR /= 25 ) CALL XIT("XTTEMI",-2)
C
C-------------------------------------------------------------------
C     * SURFACE EMISSIONS. INSERT 2D EMISSIONS INTO FIRST MODEL 
C     * LAYER ABOVE GROUND.
C
      DO IL=IL1,IL2
        FACT = ZTMST*GRAV/(DSHJ(IL,ILEV)*PRESSG(IL))
C
C       * FOSSIL-FUEL SURFACE EMISSIONS.
C
        SFFE=MAX(SSFCROW(IL)-SBIOROW(IL)-SSHIROW(IL),0.)
        BFFE=MAX(BSFCROW(IL)-BBIOROW(IL)-BSHIROW(IL),0.)
        OFFE=MAX(OSFCROW(IL)-OBIOROW(IL)-OSHIROW(IL),0.)
        XEMIS(IL,ILEV,ISO2)=XEMIS(IL,ILEV,ISO2)+FACT*SFFE*(1.-PSUEF2)
        DSUEM2(IL,ILEV)=DSUEM2(IL,ILEV)+SFFE*FACT/ZTMST
     1                                                *PSUEF2*WAMSUL/WS
        DBCEM2(IL,ILEV)=DBCEM2(IL,ILEV)+BFFE*FACT/ZTMST
        DOCEM2(IL,ILEV)=DOCEM2(IL,ILEV)+OFFE*FACT/ZTMST*OC2POM
C
C       * BIOMASS/BIOFUEL BURNING EMISSIONS.
C
        SBBE=SBIOROW(IL)
        BBBE=BBIOROW(IL)
        OBBE=OBIOROW(IL)
        XEMIS(IL,ILEV,ISO2)=XEMIS(IL,ILEV,ISO2)+FACT*SBBE*(1.-PSUEF1)
        DSUEM1(IL,ILEV)=DSUEM1(IL,ILEV)+SBBE*FACT/ZTMST
     1                                                *PSUEF1*WAMSUL/WS
        DBCEM1(IL,ILEV)=DBCEM1(IL,ILEV)+BBBE*FACT/ZTMST
        DOCEM1(IL,ILEV)=DOCEM1(IL,ILEV)+OBBE*FACT/ZTMST*OC2POM
C
C       * SHIPPING SURFACE EMISSIONS.
C
        SBBE=SSHIROW(IL)
        BBBE=BSHIROW(IL)
        OBBE=OSHIROW(IL)
        XEMIS(IL,ILEV,ISO2)=XEMIS(IL,ILEV,ISO2)+FACT*SBBE*(1.-PSUEF4)
        DSUEM4(IL,ILEV)=DSUEM4(IL,ILEV)+SBBE*FACT/ZTMST
     1                                                *PSUEF4*WAMSUL/WS
        DBCEM4(IL,ILEV)=DBCEM4(IL,ILEV)+BBBE*FACT/ZTMST
        DOCEM4(IL,ILEV)=DOCEM4(IL,ILEV)+OBBE*FACT/ZTMST*OC2POM
      ENDDO
C
C-------------------------------------------------------------------
C     * DETERMINE LAYER CORRESPONDING TO STACK EMISSIONS (100-300M).
C
      ZMIN=100.
      ZMAX=300.
      DZ=ZMAX-ZMIN
      LLOW(IL1:IL2) = 0
      LHGH(IL1:IL2) = 0
      DO L=ILEV,1,-1
      DO IL=IL1,IL2
        IF(ZF(IL,L) .LE. ZMIN) LLOW(IL)=L
        IF(ZF(IL,L) .LE. ZMAX) LHGH(IL)=L
      ENDDO
      ENDDO
C
C     * FOSSIL-FUEL STACK EMISSIONS.
C
      DO L=1,ILEV
      DO IL=IL1,IL2
        FACT = ZTMST*GRAV/(DSHJ(IL,L)*PRESSG(IL))
        IF ( L.EQ.LLOW(IL) .AND. L.EQ.LHGH(IL) ) THEN
          WGT=1.
        ELSE IF ( L.EQ.LHGH(IL) ) THEN
          WGT=(ZMAX-ZF(IL,L))/DZ
        ELSE IF ( L.GT.LHGH(IL) .AND. L.LT.LLOW(L) .AND. L.GT.1 ) THEN
          WGT=(ZF(IL,L-1)-ZF(IL,L))/DZ
        ELSE IF ( L.EQ.LLOW(IL) .AND. L.GT. 1 ) THEN
          WGT=(ZF(IL,L-1)-ZMIN)/DZ
        ELSE
          WGT=0.
        ENDIF
        XEMIS(IL,L,ISO2)=XEMIS(IL,L,ISO2)+WGT*SSTKROW(IL)*FACT
     1                                 *(1.-PSUEF2)
        DSUEM2(IL,L)=DSUEM2(IL,L)+WGT*SSTKROW(IL)*FACT/ZTMST
     1                                                *PSUEF2*WAMSUL/WS
        DBCEM2(IL,L)=DBCEM2(IL,L)+WGT*BSTKROW(IL)*FACT/ZTMST
        DOCEM2(IL,L)=DOCEM2(IL,L)+WGT*OSTKROW(IL)*FACT/ZTMST*OC2POM
      ENDDO
      ENDDO
C
C-------------------------------------------------------------------
C     * OPEN VEGETATION BURNING EMISSIONS.
C
      DO K=1,LEVWF
        RUH = ZWF(K)
        IF(K.EQ.1) THEN
          RLH = 0.
        ELSE
          RLH = ZWF(K-1)
        ENDIF
        DUL = RUH-RLH
C
C       * DETERMINE LAYER CORRESPONDING TO EMISSIONS.
C
        LLOW(IL1:IL2) = 0
        LHGH(IL1:IL2) = 0
C
        DO L=ILEV,1,-1
        DO IL=IL1,IL2
          IF( ZF(IL,L) .LE. RLH)   LLOW(IL)=L
          IF( ZF(IL,L) .LE. RUH)   LHGH(IL)=L
          IF( RLH.LE.0.)           LLOW(IL)=ILEV
        ENDDO
        ENDDO
        DO L=1,ILEV
        DO IL=IL1,IL2
          FACT=ZTMST*GRAV/(DSHJ(IL,L)*PRESSG(IL))
          IF ( L.EQ.LLOW(IL) .AND. L.EQ.LHGH(IL) ) THEN
            WGT=1.
          ELSE IF( L.EQ.LHGH(IL) ) THEN
            WGT=( RUH-ZF(IL,L) )/DUL
          ELSE IF( L.GT.LHGH(IL) .AND. L.LT.LLOW(L) .AND. L.GT.1 ) THEN
            WGT=(ZF(IL,L-1)-ZF(IL,L))/DUL
          ELSE IF( L.EQ.LLOW(IL) .AND. L.GT.1 ) THEN
            WGT=( ZF(IL,L-1)-RLH )/DUL
          ELSE
            WGT=0.
          ENDIF
          XEMIS(IL,L,ISO2)=XEMIS(IL,L,ISO2)+WGT*SFIRROW(IL)*FACT
     1                                 *FBBCROW(IL,K)*(1.-PSUEF1)
          DSUEM1(IL,L)=DSUEM1(IL,L)+WGT*SFIRROW(IL)*FACT*FBBCROW(IL,K)
     1                                          /ZTMST*PSUEF1*WAMSUL/WS
          DBCEM1(IL,L)=DBCEM1(IL,L)+WGT*BFIRROW(IL)*FACT*FBBCROW(IL,K)
     1                                                           /ZTMST
          DOCEM1(IL,L)=DOCEM1(IL,L)+WGT*OFIRROW(IL)*FACT*FBBCROW(IL,K)
     1                                                    /ZTMST*OC2POM
        ENDDO
        ENDDO
      ENDDO
C
C-------------------------------------------------------------------
C     * AIRCRAFT EMISSIONS.
C
      DO K=1,LEVAIR
        RUH = ZAIR(K)
        IF(K.EQ.1) THEN
          RLH = 0.
        ELSE
          RLH = ZAIR(K-1)
        ENDIF
        DUL = RUH-RLH
C
C       * DETERMINE LAYER CORRESPONDING TO EMISSIONS.
C
        LLOW(IL1:IL2) = 0
        LHGH(IL1:IL2) = 0
C
        DO L=ILEV+1,1,-1
        DO IL=IL1,IL2
          IF( ZFS(IL,L) .LE. RLH)   LLOW(IL)=L
          IF( ZFS(IL,L) .LE. RUH)   LHGH(IL)=L
          IF( RLH.LE.0.)           LLOW(IL)=ILEV
        ENDDO
        ENDDO
        DO L=1,ILEV
        DO IL=IL1,IL2
          FACT=ZTMST*GRAV/(DSHJ(IL,L)*PRESSG(IL))
          IF ( L.EQ.LLOW(IL) .AND. L.EQ.LHGH(IL) ) THEN
            WGT=1.
          ELSE IF( L.EQ.LHGH(IL) ) THEN
            WGT=( RUH-ZFS(IL,L) )/DUL
          ELSE IF( L.GT.LHGH(IL) .AND. L.LT.LLOW(L) .AND. L.GT.1 ) THEN
            WGT=(ZFS(IL,L-1)-ZFS(IL,L))/DUL
          ELSE IF( L.EQ.LLOW(IL) .AND. L.GT.1 ) THEN
            WGT=( ZFS(IL,L-1)-RLH )/DUL
          ELSE
            WGT=0.
          ENDIF
          XEMIS(IL,L,ISO2)=XEMIS(IL,L,ISO2)+WGT*SAIRROW(IL)*FACT
     1                                 *FAIRROW(IL,K)*(1.-PSUEF3)
          DSUEM3(IL,L)=DSUEM3(IL,L)+WGT*SAIRROW(IL)*FACT*FAIRROW(IL,K)
     1                                          /ZTMST*PSUEF3*WAMSUL/WS
          DBCEM3(IL,L)=DBCEM3(IL,L)+WGT*BAIRROW(IL)*FACT*FAIRROW(IL,K)
     1                                                           /ZTMST
          DOCEM3(IL,L)=DOCEM3(IL,L)+WGT*OAIRROW(IL)*FACT*FAIRROW(IL,K)
     1                                                    /ZTMST*OC2POM
        ENDDO
        ENDDO
      ENDDO
C
      RETURN
      END
