      SUBROUTINE PRIAEM (PEDNDT,PEDMDT,PIDFDT,PIDNDT,PIDMDT,PIMAS,PIFRC, &
                         DOCEM1,DOCEM2,DOCEM3,DOCEM4, &
                         DBCEM1,DBCEM2,DBCEM3,DBCEM4, &
                         DSUEM1,DSUEM2,DSUEM3,DSUEM4,DT,ILGA,LEVA)
!-----------------------------------------------------------------------
!     PURPOSE:
!     --------
!     INSERT PRIMARY AEROSOL EMISSIONS.
!
!     HISTORY:
!     --------
!     * MAR  6/2009 - K.VONSALZEN   NEW
!
!-----------------------------------------------------------------------
!
      USE SDPARM
      USE SDEMI
!
      IMPLICIT REAL (A-H,O-Z), INTEGER (I-N)
!
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA,ISAEXT) :: PEDNDT,PEDMDT
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA,ISAINT) :: PIDNDT,PIDMDT
      REAL, INTENT(OUT), DIMENSION(ILGA,LEVA,ISAINT,KINT) :: PIDFDT
      REAL, INTENT(IN) :: DT
      REAL, INTENT(IN),  DIMENSION(ILGA,LEVA,ISAINT,KINT) :: PIFRC
      REAL, INTENT(IN),  DIMENSION(ILGA,LEVA,ISAINT) :: PIMAS
      REAL, INTENT(IN),  DIMENSION(ILGA,LEVA) :: &
                                           DOCEM1,DOCEM2,DOCEM3,DOCEM4, &
                                           DBCEM1,DBCEM2,DBCEM3,DBCEM4, &
                                           DSUEM1,DSUEM2,DSUEM3,DSUEM4
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: CIMAST
      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: CIMAF
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: CEOCN,CEOCM,CEBCN,CEBCM, &
                                             CESUN,CESUM
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: CIOCN,CIOCM,CIBCN,CIBCM, &
                                             CISUN,CISUM
!
!     * FRACTION OF BC EMISSIONS ASSIGNED TO INTERNALLY MIXED AEROSOL MODE.
!     * 1 - OPEN VEGETATION AND BIOFUEL BURNING
!     * 2 - FOSSIL FUEL BURNING
!     * 3 - AIRCRAFT
!     * 4 - SHIPPING
!     * (ALSO SEE SDPEMI).
!
      REAL, PARAMETER :: FINTBC1=1.
      REAL, PARAMETER :: FINTBC2=0.2
      REAL, PARAMETER :: FINTBC3=0.2
      REAL, PARAMETER :: FINTBC4=0.2
!
!     * THE SAME AS ABOVE FOR ORGANIC CARBON.
!
      REAL, PARAMETER :: FINTOC1=1.
      REAL, PARAMETER :: FINTOC2=0.5
      REAL, PARAMETER :: FINTOC3=0.5
      REAL, PARAMETER :: FINTOC4=0.5
!
!-----------------------------------------------------------------------
!     * ALLOCATE WORK ARRAYS.
!
      IF ( ISEXTOC > 0 ) THEN
        ALLOCATE (CEOCN(ILGA,LEVA,ISEXTOC))
        ALLOCATE (CEOCM(ILGA,LEVA,ISEXTOC))
      ENDIF
      IF ( ISEXTBC > 0 ) THEN
        ALLOCATE (CEBCN(ILGA,LEVA,ISEXTBC))
        ALLOCATE (CEBCM(ILGA,LEVA,ISEXTBC))
      ENDIF
      IF ( ISEXTSO4 > 0 ) THEN
        ALLOCATE (CESUN(ILGA,LEVA,ISEXTSO4))
        ALLOCATE (CESUM(ILGA,LEVA,ISEXTSO4))
      ENDIF
      IF ( ISINTOC > 0 ) THEN
        ALLOCATE (CIOCN(ILGA,LEVA,ISINTOC))
        ALLOCATE (CIOCM(ILGA,LEVA,ISINTOC))
      ENDIF
      IF ( ISINTBC > 0 ) THEN
        ALLOCATE (CIBCN(ILGA,LEVA,ISINTBC))
        ALLOCATE (CIBCM(ILGA,LEVA,ISINTBC))
      ENDIF
      IF ( ISINTSO4 > 0 ) THEN
        ALLOCATE (CISUN(ILGA,LEVA,ISINTSO4))
        ALLOCATE (CISUM(ILGA,LEVA,ISINTSO4))
      ENDIF
      IF ( ISAINT > 0 ) THEN
        ALLOCATE (CIMAST(ILGA,LEVA,ISAINT))
        ALLOCATE (CIMAF (ILGA,LEVA,ISAINT,KINT))
      ENDIF
!
!-----------------------------------------------------------------------
!     * CONVERT CHANGES IN BULK CONCENTRATIONS FOR OC, BC, AND SULPHATE
!     * TO CHANGES IN AEROSOL CONCENTRATIONS FOR NATURAL AND
!     * ANTHROPOGENIC EMISSIONS (UNITS: KG/KG). FOR EXTERNALLY MIXED
!     * TYPES OF AEROSOL. DIFFERENT TYPES OF EMISSIONS WITH DIFFERENT
!     * SIZE DISTRIBUTIONS AND TOTAL TRACER MASS FLUXES ARE CONSIDERED.
!
      IF ( KEXTOC > 0 ) THEN
        DO IS=1,ISEXTOC
          CEOCN(:,:,IS)=(PEOCT1%EFNUM(IS)*DOCEM1(:,:)*(1.-FINTOC1) &
                        +PEOCT2%EFNUM(IS)*DOCEM2(:,:)*(1.-FINTOC2) &
                        +PEOCT3%EFNUM(IS)*DOCEM3(:,:)*(1.-FINTOC3) &
                        +PEOCT4%EFNUM(IS)*DOCEM4(:,:)*(1.-FINTOC4))*DT
          CEOCM(:,:,IS)=(PEOCT1%EFMAS(IS)*DOCEM1(:,:)*(1.-FINTOC1) &
                        +PEOCT2%EFMAS(IS)*DOCEM2(:,:)*(1.-FINTOC2) &
                        +PEOCT3%EFMAS(IS)*DOCEM3(:,:)*(1.-FINTOC3) &
                        +PEOCT4%EFMAS(IS)*DOCEM4(:,:)*(1.-FINTOC4))*DT
        ENDDO
      ENDIF
      IF ( KEXTBC > 0 ) THEN
        DO IS=1,ISEXTBC
          CEBCN(:,:,IS)=(PEBCT1%EFNUM(IS)*DBCEM1(:,:)*(1.-FINTBC1) &
                        +PEBCT2%EFNUM(IS)*DBCEM2(:,:)*(1.-FINTBC2) &
                        +PEBCT3%EFNUM(IS)*DBCEM3(:,:)*(1.-FINTBC3) &
                        +PEBCT4%EFNUM(IS)*DBCEM4(:,:)*(1.-FINTBC4))*DT
          CEBCM(:,:,IS)=(PEBCT1%EFMAS(IS)*DBCEM1(:,:)*(1.-FINTBC1) &
                        +PEBCT2%EFMAS(IS)*DBCEM2(:,:)*(1.-FINTBC2) &
                        +PEBCT3%EFMAS(IS)*DBCEM3(:,:)*(1.-FINTBC3) &
                        +PEBCT4%EFMAS(IS)*DBCEM4(:,:)*(1.-FINTBC4))*DT
        ENDDO
      ENDIF
      IF ( KEXTSO4 > 0 ) THEN
        DO IS=1,ISEXTSO4
          CESUN(:,:,IS)=(PESUT1%EFNUM(IS)*DSUEM1(:,:) &
                        +PESUT2%EFNUM(IS)*DSUEM2(:,:) &
                        +PESUT3%EFNUM(IS)*DSUEM3(:,:) &
                        +PESUT4%EFNUM(IS)*DSUEM4(:,:))*DT
          CESUM(:,:,IS)=(PESUT1%EFMAS(IS)*DSUEM1(:,:) &
                        +PESUT2%EFMAS(IS)*DSUEM2(:,:) &
                        +PESUT3%EFMAS(IS)*DSUEM3(:,:) &
                        +PESUT4%EFMAS(IS)*DSUEM4(:,:))*DT
        ENDDO
      ENDIF
!
!     * THE SAME AS ABOVE FOR INTERNALLY MIXED TYPES OF AEROSOL.
!
      IF ( KINTOC > 0 ) THEN
        DO IS=1,ISINTOC
          CIOCN(:,:,IS)=(PIOCT1%EFNUM(IS)*DOCEM1(:,:)*FINTOC1 &
                        +PIOCT2%EFNUM(IS)*DOCEM2(:,:)*FINTOC2 &
                        +PIOCT3%EFNUM(IS)*DOCEM3(:,:)*FINTOC3 &
                        +PIOCT4%EFNUM(IS)*DOCEM4(:,:)*FINTOC4)*DT
          CIOCM(:,:,IS)=(PIOCT1%EFMAS(IS)*DOCEM1(:,:)*FINTOC1 &
                        +PIOCT2%EFMAS(IS)*DOCEM2(:,:)*FINTOC2 &
                        +PIOCT3%EFMAS(IS)*DOCEM3(:,:)*FINTOC3 &
                        +PIOCT4%EFMAS(IS)*DOCEM4(:,:)*FINTOC4)*DT
        ENDDO
      ENDIF
      IF ( KINTBC > 0 ) THEN
        DO IS=1,ISINTBC
          CIBCN(:,:,IS)=(PIBCT1%EFNUM(IS)*DBCEM1(:,:)*FINTBC1 &
                        +PIBCT2%EFNUM(IS)*DBCEM2(:,:)*FINTBC2 &
                        +PIBCT3%EFNUM(IS)*DBCEM3(:,:)*FINTBC3 &
                        +PIBCT4%EFNUM(IS)*DBCEM4(:,:)*FINTBC4)*DT
          CIBCM(:,:,IS)=(PIBCT1%EFMAS(IS)*DBCEM1(:,:)*FINTBC1 &
                        +PIBCT2%EFMAS(IS)*DBCEM2(:,:)*FINTBC2 &
                        +PIBCT3%EFMAS(IS)*DBCEM3(:,:)*FINTBC3 &
                        +PIBCT4%EFMAS(IS)*DBCEM4(:,:)*FINTBC4)*DT
        ENDDO
      ENDIF
      IF ( KINTSO4 > 0 ) THEN
        DO IS=1,ISINTSO4
          CISUN(:,:,IS)=(PISUT1%EFNUM(IS)*DSUEM1(:,:) &
                        +PISUT2%EFNUM(IS)*DSUEM2(:,:) &
                        +PISUT3%EFNUM(IS)*DSUEM3(:,:) &
                        +PISUT4%EFNUM(IS)*DSUEM4(:,:))*DT
          CISUM(:,:,IS)=(PISUT1%EFMAS(IS)*DSUEM1(:,:) &
                        +PISUT2%EFMAS(IS)*DSUEM2(:,:) &
                        +PISUT3%EFMAS(IS)*DSUEM3(:,:) &
                        +PISUT4%EFMAS(IS)*DSUEM4(:,:))*DT
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!     * MASS AND NUMBER TENDENCIES FOR EXTERNALLY MIXED AEROSOL.
!
      IF ( KEXT > 0 ) THEN
        PEDNDT=0.
        PEDMDT=0.
      ENDIF
      IF ( KEXTOC > 0 ) THEN
        DO IS=1,ISEXTOC
          PEDNDT(:,:,IEXOC(IS))=CEOCN(:,:,IS)/DT
          PEDMDT(:,:,IEXOC(IS))=CEOCM(:,:,IS)/DT
        ENDDO
      ENDIF
      IF ( KEXTBC > 0 ) THEN
        DO IS=1,ISEXTBC
          PEDNDT(:,:,IEXBC(IS))=PEDNDT(:,:,IEXBC(IS)) &
                               +CEBCN(:,:,IS)/DT
          PEDMDT(:,:,IEXBC(IS))=PEDMDT(:,:,IEXBC(IS)) &
                               +CEBCM(:,:,IS)/DT
        ENDDO
      ENDIF
      IF ( KEXTSO4 > 0 ) THEN
        DO IS=1,ISEXTSO4
          PEDNDT(:,:,IEXSO4(IS))=PEDNDT(:,:,IEXSO4(IS)) &
                                +CESUN(:,:,IS)/DT
          PEDMDT(:,:,IEXSO4(IS))=PEDMDT(:,:,IEXSO4(IS)) &
                                +CESUM(:,:,IS)/DT
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!     * TOTAL AEROSOL MASS AFTER ACCOUNTING FOR CHANGES FROM EMISSIONS
!     * FOR INTERNALLY MIXED TYPES OF AEROSOL.
!
      IF ( KINT > 0 ) THEN
        CIMAST=PIMAS
      ENDIF
      IF ( KINTOC > 0 ) THEN
        DO IS=1,ISINTOC
          CIMAST(:,:,IINOC(IS))=CIMAST(:,:,IINOC(IS)) &
                               +CIOCM(:,:,IS)
        ENDDO
      ENDIF
      IF ( KINTBC > 0 ) THEN
        DO IS=1,ISINTBC
          CIMAST(:,:,IINBC(IS))=CIMAST(:,:,IINBC(IS)) &
                               +CIBCM(:,:,IS)
        ENDDO
      ENDIF
      IF ( KINTSO4 > 0 ) THEN
        DO IS=1,ISINTSO4
          CIMAST(:,:,IINSO4(IS))=CIMAST(:,:,IINSO4(IS)) &
                                +CISUM(:,:,IS)
        ENDDO
      ENDIF
!
!     * NEW MASS FRACTIONS FOR INTERNALLY MIXED TYPES OF AEROSOL.
!
      IF ( KINT > 0 ) THEN
        DO IS=1,ISAINT
        DO L=1,LEVA
        DO IL=1,ILGA
          IF ( CIMAST(IL,L,IS) > YTINY ) THEN
            CIMAF(IL,L,IS,:)=PIFRC(IL,L,IS,:)*PIMAS(IL,L,IS) &
                            /CIMAST(IL,L,IS)
          ELSE
            CIMAF(IL,L,IS,:)=PIFRC(IL,L,IS,:)
          ENDIF
        ENDDO
        ENDDO
        ENDDO
      ENDIF
      IF ( KINTOC > 0 ) THEN
        DO IS=1,ISINTOC
        DO L=1,LEVA
        DO IL=1,ILGA
          IF ( CIMAST(IL,L,IINOC(IS)) > YTINY ) THEN
            CIMAF(IL,L,IINOC(IS),KINTOC)=CIMAF(IL,L,IINOC(IS),KINTOC) &
                                 +CIOCM(IL,L,IS)/CIMAST(IL,L,IINOC(IS))
          ENDIF
        ENDDO
        ENDDO
        ENDDO
      ENDIF
      IF ( KINTBC > 0 ) THEN
        DO IS=1,ISINTBC
        DO L=1,LEVA
        DO IL=1,ILGA
          IF ( CIMAST(IL,L,IINBC(IS)) > YTINY ) THEN
            CIMAF(IL,L,IINBC(IS),KINTBC)=CIMAF(IL,L,IINBC(IS),KINTBC) &
                                 +CIBCM(IL,L,IS)/CIMAST(IL,L,IINBC(IS))
          ENDIF
        ENDDO
        ENDDO
        ENDDO
      ENDIF
      IF ( KINTSO4 > 0 ) THEN
        DO IS=1,ISINTSO4
        DO L=1,LEVA
        DO IL=1,ILGA
          IF ( CIMAST(IL,L,IINSO4(IS)) > YTINY ) THEN
            CIMAF(IL,L,IINSO4(IS),KINTSO4)= &
                                         CIMAF(IL,L,IINSO4(IS),KINTSO4) &
                                +CISUM(IL,L,IS)/CIMAST(IL,L,IINSO4(IS))
          ENDIF
        ENDDO
        ENDDO
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!     * MASS, NUMBER, AND MASS FRACTION TENDENCIES FOR INTERNALLY
!     * MIXED TYPES OF AEROSOL.
!
      IF ( KINT > 0 ) THEN
        PIDNDT=0.
        PIDMDT=0.
        PIDFDT=(CIMAF-PIFRC)/DT
      ENDIF
      IF ( KINTOC > 0 ) THEN
        DO IS=1,ISINTOC
          PIDNDT(:,:,IINOC(IS))=CIOCN(:,:,IS)/DT
          PIDMDT(:,:,IINOC(IS))=CIOCM(:,:,IS)/DT
        ENDDO
      ENDIF
      IF ( KINTBC > 0 ) THEN
        DO IS=1,ISINTBC
          PIDNDT(:,:,IINBC(IS))=PIDNDT(:,:,IINBC(IS)) &
                               +CIBCN(:,:,IS)/DT
          PIDMDT(:,:,IINBC(IS))=PIDMDT(:,:,IINBC(IS)) &
                               +CIBCM(:,:,IS)/DT
        ENDDO
      ENDIF
      IF ( KINTSO4 > 0 ) THEN
        DO IS=1,ISINTSO4
          PIDNDT(:,:,IINSO4(IS))=PIDNDT(:,:,IINSO4(IS)) &
                                +CISUN(:,:,IS)/DT
          PIDMDT(:,:,IINSO4(IS))=PIDMDT(:,:,IINSO4(IS)) &
                                +CISUM(:,:,IS)/DT
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!     * DEALLOCATION.
!
      IF ( ISEXTOC > 0 ) THEN
        DEALLOCATE (CEOCN)
        DEALLOCATE (CEOCM)
      ENDIF
      IF ( ISEXTBC > 0 ) THEN
        DEALLOCATE (CEBCN)
        DEALLOCATE (CEBCM)
      ENDIF
      IF ( ISEXTSO4 > 0 ) THEN
        DEALLOCATE (CESUN)
        DEALLOCATE (CESUM)
      ENDIF
      IF ( ISINTOC > 0 ) THEN
        DEALLOCATE (CIOCN)
        DEALLOCATE (CIOCM)
      ENDIF
      IF ( ISINTBC > 0 ) THEN
        DEALLOCATE (CIBCN)
        DEALLOCATE (CIBCM)
      ENDIF
      IF ( ISINTSO4 > 0 ) THEN
        DEALLOCATE (CISUN)
        DEALLOCATE (CISUM)
      ENDIF
      IF ( ISAINT > 0 ) THEN
        DEALLOCATE (CIMAST)
        DEALLOCATE (CIMAF)
      ENDIF
!
      END SUBROUTINE PRIAEM
