      SUBROUTINE DUSTEM (PEDNDT,PEDMDT,PIDFDT,PIDNDT,PIDMDT,PIMAS, &
                         PEDPHI0,PEPHIS0,PIDPHI0,PIPHIS0, &
                         PIFRC,DPA,DT,GRAV,ILGA,LEVA, &
                         FLND,GT,SMFR,FN,ZSPD,USTARD, &
                         SUZ0,SLAI,SPOT,ST02,ST03,ST04,ST06, &
                         ST13,ST14,ST15,ST16,ST17, &
                         ISVDUST,DEFA,DEFC, &
                         FALL,FA10,FA2,FA1, &
                         DUWD,DUST,DUTH,USMK, &
                         DIAGMAS,DIAGNUM,ISDUST,DESIZE,DEFLUX,DEFNUM, &
                         ISDIAG)

!-----------------------------------------------------------------------
!     PURPOSE:
!     --------
!     MINERAL DUST EMISSIONS.
!
!     HISTORY:
!     --------
!     * FEB 05/2015 - M.LAZARE/     NEW VERSION FOR GCM18:
!     *               K.VONSALZEN.  - FLND PASSED IN INSTEAD OF {GC,MASK},
!     *                               FOR FRACTIONAL LAND MASK SUPPORT.
!     *                             - {ZSPD,USTARD} PASSED IN INSTEAD OF {SFCU,SFCV,GUST}
!     *                               BECAUSE THIS SCREEN-LEVEL QUANTITY
!     *                               ALREADY CALCULATED IN EARLIER ROUTINES.
!     *                               THIS CHANGES AND SIMPLIFIES THE CALCULATION OF
!     *                               USTAR.
!     *                             - ADJUST TOTAL CONCENTRATIONS AFTER EMISSION OF
!     *                               MIN. DUST TO ACCOUNT FOR LACK OF EMISSIONS FROM
!     *                               NON-LAND FRACTION OF GRID CELL. EMISSIONS ARE
!     *                               DONE ONLY OVER THE LAND FRACTION OF THE GRID SQUARE.
!     * AUG 25/2009 - K.VONSALZEN   MODIFIED FOR AEROCOM SIZE PARAMETERS
!                                   AND EMISSION FLUX FROM BULK SCHEME.
!     * JUN 14/2007 - K.VONSALZEN   NEW
!
!-----------------------------------------------------------------------
!
      USE SDPARM
      USE DUPARM1
!
      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(OUT), DIMENSION(ILGA,ISDUST*2) :: DIAGMAS,DIAGNUM
      REAL, INTENT(OUT), DIMENSION(ILGA,ISDIAG) :: DESIZE,DEFLUX, &
                                                   DEFNUM
      REAL, INTENT(IN) :: DT,GRAV
      REAL, INTENT(IN),  DIMENSION(ILGA) :: FLND,GT,SMFR,FN, &
                                            ZSPD,USTARD,SUZ0,SLAI, &
                                            SPOT,ST02,ST03,ST04,ST06, &
                                            ST13,ST14,ST15,ST16,ST17
      REAL, INTENT(IN),  DIMENSION(ILGA,LEVA) :: DPA
      REAL, INTENT(IN),  DIMENSION(ILGA,LEVA,ISAEXT) :: &
                                                 PEDPHI0,PEPHIS0
      REAL, INTENT(IN),  DIMENSION(ILGA,LEVA,ISAINT) :: &
                                                 PIDPHI0,PIPHIS0
      REAL, INTENT(IN),  DIMENSION(ILGA,LEVA,ISAINT,KINT) :: PIFRC
      REAL, INTENT(IN),  DIMENSION(ILGA,LEVA,ISAINT) :: PIMAS
      REAL, ALLOCATABLE, DIMENSION(:) :: FEDPHIS,FEPHISS,FEDDNS
      REAL, ALLOCATABLE, DIMENSION(:) :: FIDPHIS,FIPHISS,FIDDNS
      REAL, ALLOCATABLE, DIMENSION(:,:) :: AEPHI0,AEN0,AEPSI
      REAL, ALLOCATABLE, DIMENSION(:,:) :: AIPHI0,AIN0,AIPSI
      REAL, ALLOCATABLE, DIMENSION(:,:) :: CIMAST
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FEPHI0,FEN0,FEPSI,FEDDN, &
                                             FEDPHI0,FEPHIS0,FENUM, &
                                             FEMAS,CENUM,CEMAS
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FIPHI0,FIN0,FIPSI,FIDDN, &
                                             FIDPHI0,FIPHIS0,FINUM, &
                                             FIMAS,CINUM,CIMAS, &
                                             CIMAF
!
      REAL, INTENT(OUT), DIMENSION(ILGA) :: DEFA,DEFC, &
                               FALL,FA10,FA2,FA1, &
                               DUWD,DUST,DUTH,USMK
!
!-----------------------------------------------------------------------
!     * ALLOCATION OF WORK ARRAYS.
!
      IF ( ISEXTMD > 0 ) THEN
        ALLOCATE (FEDPHIS(ISEXTMD))
        ALLOCATE (FEPHISS(ISEXTMD))
        ALLOCATE (FEDDNS (ISEXTMD))
        ALLOCATE (AEPHI0 (ILGA,ISEXTMD))
        ALLOCATE (AEN0   (ILGA,ISEXTMD))
        ALLOCATE (AEPSI  (ILGA,ISEXTMD))
        ALLOCATE (FEPHI0 (ILGA,1,ISEXTMD))
        ALLOCATE (FEN0   (ILGA,1,ISEXTMD))
        ALLOCATE (FEPSI  (ILGA,1,ISEXTMD))
        ALLOCATE (FEDDN  (ILGA,1,ISEXTMD))
        ALLOCATE (FEDPHI0(ILGA,1,ISEXTMD))
        ALLOCATE (FEPHIS0(ILGA,1,ISEXTMD))
        ALLOCATE (FENUM  (ILGA,1,ISEXTMD))
        ALLOCATE (FEMAS  (ILGA,1,ISEXTMD))
        ALLOCATE (CENUM  (ILGA,1,ISEXTMD))
        ALLOCATE (CEMAS  (ILGA,1,ISEXTMD))
      ENDIF
      IF ( ISINTMD > 0 ) THEN
        ALLOCATE (FIDPHIS(ISINTMD))
        ALLOCATE (FIPHISS(ISINTMD))
        ALLOCATE (FIDDNS (ISINTMD))
        ALLOCATE (AIPHI0 (ILGA,ISINTMD))
        ALLOCATE (AIN0   (ILGA,ISINTMD))
        ALLOCATE (AIPSI  (ILGA,ISINTMD))
        ALLOCATE (FIPHI0 (ILGA,1,ISINTMD))
        ALLOCATE (FIN0   (ILGA,1,ISINTMD))
        ALLOCATE (FIPSI  (ILGA,1,ISINTMD))
        ALLOCATE (FIDDN  (ILGA,1,ISINTMD))
        ALLOCATE (FIDPHI0(ILGA,1,ISINTMD))
        ALLOCATE (FIPHIS0(ILGA,1,ISINTMD))
        ALLOCATE (FINUM  (ILGA,1,ISINTMD))
        ALLOCATE (FIMAS  (ILGA,1,ISINTMD))
        ALLOCATE (CINUM  (ILGA,1,ISINTMD))
        ALLOCATE (CIMAS  (ILGA,1,ISINTMD))
        ALLOCATE (CIMAST (ILGA,ISINTMD))
      ENDIF
      IF ( ISAINT > 0 ) THEN
        ALLOCATE (CIMAF  (ILGA,ISAINT,KINT))
      ENDIF
!
!     * PLA SECTION INFORMATION.
!
      IF ( KEXTMD > 0 ) THEN
        DO IS=1,ISEXTMD
          FEDPHI0(:,1,IS)=PEDPHI0(:,LEVA,IEXMD(IS))
          FEPHIS0(:,1,IS)=PEPHIS0(:,LEVA,IEXMD(IS))
          FEDPHIS(IS)=PEDPHIS(IEXMD(IS))
          FEPHISS(IS)=PEPHISS(IEXMD(IS))
          FEDDNS (IS)=AEXTF%TP(KEXTMD)%DENS
        ENDDO
      ENDIF
      IF ( KINTMD > 0 ) THEN
        DO IS=1,ISINTMD
          FIDPHI0(:,1,IS)=PIDPHI0(:,LEVA,IINMD(IS))
          FIPHIS0(:,1,IS)=PIPHIS0(:,LEVA,IINMD(IS))
          FIDPHIS(IS)=PIDPHIS(IINMD(IS))
          FIPHISS(IS)=PIPHISS(IINMD(IS))
          FIDDNS (IS)=AINTF%TP(KINTMD)%DENS
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!     * MINERAL DUST FLUX IN TERMS OF PLA PARAMETERS.
!
      IF ( KEXTMD > 0 ) THEN
       CALL DUSTP(AEN0,AEPHI0,AEPSI,ILGA,ISEXTMD, &
                  FLND,GT,SMFR,FN,ZSPD,USTARD, &
                  SUZ0,SLAI,SPOT,ST02,ST03,ST04,ST06, &
                  ST13,ST14,ST15,ST16,ST17, &
                  ISVDUST,DEFA,DEFC, &
                  FALL,FA10,FA2,FA1, &
                  DUWD,DUST,DUTH,USMK, &
                  DIAGMAS,DIAGNUM,ISDUST)

      ENDIF
      IF ( KINTMD > 0 ) THEN
       CALL DUSTP(AIN0,AIPHI0,AIPSI,ILGA,ISINTMD, &
                  FLND,GT,SMFR,FN,ZSPD,USTARD, &
                  SUZ0,SLAI,SPOT,ST02,ST03,ST04,ST06, &
                  ST13,ST14,ST15,ST16,ST17, &
                  ISVDUST,DEFA,DEFC, &
                  FALL,FA10,FA2,FA1, &
                  DUWD,DUST,DUTH,USMK, &
                  DIAGMAS,DIAGNUM,ISDUST)
      ENDIF
!
!     * SCALE DIAGNOSTIC OUTPUT ARRAYS BY FRACTION OF LAND.
!
      DO IL=1,ILGA
        DIAGMAS(IL,:)=FLND(IL)*DIAGMAS(IL,:)
        DIAGNUM(IL,:)=FLND(IL)*DIAGNUM(IL,:)
      ENDDO
!
!-----------------------------------------------------------------------
!     * CONVERT RESULTS IN PREPARATION OF CONVERSION FROM
!     * PLA PARAMETERS TO AEROSOL NUMBER AND MASS CONCENTRATIONS.
!
      IF ( KEXTMD > 0 ) THEN
        FEN0   (:,1,:)=AEN0 (:,:)
        FEPHI0 (:,1,:)=AEPHI0(:,:)
        FEPSI  (:,1,:)=AEPSI (:,:)
        DO IS=1,ISEXTMD
          FEDDN(:,1,IS)=AEXTF%TP(KEXTMD)%DENS
        ENDDO
!
        IF (ISVDUST.GT.0) THEN
         CALL DPLAOUT(FEN0,FEPHI0,FEPSI,FEDDN, &
                      ISDIAG,ILGA,DESIZE,DEFLUX,DEFNUM)
        ENDIF
!
      ENDIF
      IF ( KINTMD > 0 ) THEN
        FIN0   (:,1,:)=AIN0 (:,:)
        FIPHI0 (:,1,:)=AIPHI0(:,:)
        FIPSI  (:,1,:)=AIPSI (:,:)
        DO IS=1,ISINTMD
          FIDDN(:,1,IS)=AINTF%TP(KINTMD)%DENS
        ENDDO
      ENDIF
!
!     * MASS AND NUMBER FLUXES (KG/M2/SEC, RESP. 1/M2/SEC).
!
      IF ( KEXTMD > 0 ) THEN
        CALL PLA2NM(FENUM,FEMAS,FEN0,FEPHI0,FEPSI,FEPHIS0,FEDPHI0, &
                    FEDDN,ILGA,1,ISEXTMD)
      ENDIF
      IF ( KINTMD > 0 ) THEN
        CALL PLA2NM(FINUM,FIMAS,FIN0,FIPHI0,FIPSI,FIPHIS0,FIDPHI0, &
                    FIDDN,ILGA,1,ISINTMD)
      ENDIF
!
!     * CONVERT FLUXES TO CHANGE IN CONCENTRATIONS IN FIRST MODEL
!     * LAYER.
!
      IF ( KEXTMD > 0 ) THEN
        DO IS=1,ISEXTMD
          WHERE (      ABS(FENUM(:,1,IS)-YNA) > YTINY &
                 .AND. ABS(FEMAS(:,1,IS)-YNA) > YTINY )
            CENUM(:,1,IS)=FENUM(:,1,IS)*GRAV*DT/DPA(:,LEVA)
            CEMAS(:,1,IS)=FEMAS(:,1,IS)*GRAV*DT/DPA(:,LEVA)
          ELSEWHERE
            CENUM(:,1,IS)=0.
            CEMAS(:,1,IS)=0.
          ENDWHERE
        ENDDO
      ENDIF
      IF ( KINTMD > 0 ) THEN
        DO IS=1,ISINTMD
          WHERE (      ABS(FINUM(:,1,IS)-YNA) > YTINY &
                 .AND. ABS(FIMAS(:,1,IS)-YNA) > YTINY )
            CINUM(:,1,IS)=FINUM(:,1,IS)*GRAV*DT/DPA(:,LEVA)
            CIMAS(:,1,IS)=FIMAS(:,1,IS)*GRAV*DT/DPA(:,LEVA)
          ELSEWHERE
            CINUM(:,1,IS)=0.
            CIMAS(:,1,IS)=0.
          ENDWHERE
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!     * MASS AND NUMBER TENDENCIES FOR EXTERNALLY MIXED AEROSOL.
!
      IF ( ISAEXT > 0 ) THEN
        PEDNDT=0.
        PEDMDT=0.
      ENDIF
      DO IS=1,ISEXTMD
        PEDNDT(:,LEVA,IEXMD(IS))=CENUM(:,1,IS)/DT
        PEDMDT(:,LEVA,IEXMD(IS))=CEMAS(:,1,IS)/DT
      ENDDO
!
!     * SCALE OUTPUT ARRAYS FOR EXTERNALLY MIXED AEROSOLS
!     * BY FRACTION OF LAND.
!
      DO IL=1,ILGA
        PEDNDT(IL,:,:)=FLND(IL)*PEDNDT(IL,:,:)
        PEDMDT(IL,:,:)=FLND(IL)*PEDMDT(IL,:,:)
      ENDDO
!
!-----------------------------------------------------------------------
!
!     * ADJUST TOTAL CONCENTRATIONS AFTER EMISSION OF MIN. DUST TO
!     * ACCOUNT FOR LACK OF EMISSIONS FROM NON-LAND FRACTION OF GRID CELL.
!
      IF ( KINTMD > 0 ) THEN
        DO IS=1,ISINTMD
          CIMAST(:,IS)=PIMAS(:,LEVA,IINMD(IS))+FLND(:)*CIMAS(:,1,IS)
        ENDDO
      ENDIF
!
!     * NEW MINERAL DUST FRACTION FOR INTERNALLY MIXED TYPES OF
!     * AEROSOL.
!
      IF ( KINT > 0 ) THEN
        CIMAF=PIFRC(:,LEVA,:,:)
      ENDIF
      IF ( KINTMD > 0 ) THEN
        DO IS=1,ISINTMD
        DO IL=1,ILGA
          IF ( CIMAST(IL,IS) > YTINY ) THEN
            CIMAF(IL,IINMD(IS),:)=CIMAF(IL,IINMD(IS),:) &
                                *PIMAS(IL,LEVA,IINMD(IS))/CIMAST(IL,IS)
            CIMAF(IL,IINMD(IS),KINTMD)=CIMAF(IL,IINMD(IS),KINTMD) &
                                 +FLND(IL)*CIMAS(IL,1,IS)/CIMAST(IL,IS)
          ELSE
            CIMAF(IL,IINMD(IS),:)=PIFRC(IL,LEVA,IINMD(IS),:)
          ENDIF
        ENDDO
        ENDDO
      ENDIF
!
!     * MASS, NUMBER, AND MASS FRACTION TENDENCIES FOR INTERNALLY
!     * MIXED TYPES OF AEROSOL.
!
      IF ( ISAINT > 0 ) THEN
        PIDNDT=0.
        PIDMDT=0.
        PIDFDT=0.
      ENDIF
      IF ( KINT > 0 ) THEN
        PIDFDT(:,LEVA,:,:)=(CIMAF-PIFRC(:,LEVA,:,:))/DT
      ENDIF
      IF ( KINTMD > 0 ) THEN
        DO IS=1,ISINTMD
          PIDNDT(:,LEVA,IINMD(IS))=CINUM(:,1,IS)/DT
          PIDMDT(:,LEVA,IINMD(IS))=CIMAS(:,1,IS)/DT
        ENDDO
      ENDIF
!
!     * SCALE OUTPUT ARRAYS FOR INERNALLY MIXED AEROSOLS
!     * BY FRACTION OF LAND.
!
      DO IL=1,ILGA
        PIDNDT(IL,:,:)=FLND(IL)*PIDNDT(IL,:,:)
        PIDMDT(IL,:,:)=FLND(IL)*PIDMDT(IL,:,:)
      ENDDO
!
!-----------------------------------------------------------------------
!     * DEALLOCATION.
!
      IF ( ISEXTMD > 0 ) THEN
        DEALLOCATE (FEDPHIS)
        DEALLOCATE (FEPHISS)
        DEALLOCATE (FEDDNS )
        DEALLOCATE (AEPHI0 )
        DEALLOCATE (AEN0   )
        DEALLOCATE (AEPSI  )
        DEALLOCATE (FEPHI0 )
        DEALLOCATE (FEN0   )
        DEALLOCATE (FEPSI  )
        DEALLOCATE (FEDDN  )
        DEALLOCATE (FEDPHI0)
        DEALLOCATE (FEPHIS0)
        DEALLOCATE (FENUM  )
        DEALLOCATE (FEMAS  )
        DEALLOCATE (CENUM  )
        DEALLOCATE (CEMAS  )
      ENDIF
      IF ( ISINTMD > 0 ) THEN
        DEALLOCATE (FIDPHIS)
        DEALLOCATE (FIPHISS)
        DEALLOCATE (FIDDNS )
        DEALLOCATE (AIPHI0 )
        DEALLOCATE (AIN0   )
        DEALLOCATE (AIPSI  )
        DEALLOCATE (FIPHI0 )
        DEALLOCATE (FIN0   )
        DEALLOCATE (FIPSI  )
        DEALLOCATE (FIDDN  )
        DEALLOCATE (FIDPHI0)
        DEALLOCATE (FIPHIS0)
        DEALLOCATE (FINUM  )
        DEALLOCATE (FIMAS  )
        DEALLOCATE (CINUM  )
        DEALLOCATE (CIMAS  )
        DEALLOCATE (CIMAST )
      ENDIF
      IF ( ISAINT > 0 ) THEN
        DEALLOCATE (CIMAF  )
      ENDIF
!
      END SUBROUTINE DUSTEM
