SUBROUTINE AER_SRC &
 &( KIDIA, KFDIA, KLON , KTDIA, KLEV, KTILES, KSTART, KSTEP , KSW , &
 &  KTRAC, KAERO, KBINSS, KBINDD, &
 &  PALB , PALBP ,PALUVP, &
 &  PAERDEP, PAERLTS, PAERSCC, PAERGUST, &
 &  PBCBF, PBCFF, PBCGF,POMBF  , POMFF , POMGF , PSO2L , PSO2H , PSOGF, PSOA, &
 &  PAPH , PAP  , PCI  , PGELAM, PGEMU , PFRTI , PHSDFOR, &
 &  PLSM , PQ   , PSNS , PT    , PTS   ,  &
 &  PWIND, PWS1 , &
 &  PAERFLX, PAERLIF, PAERMAP , PCFLX , PCEN  , PTENC &
 & )

!*** * AER_SRC* - SOURCE TERMS FOR TEST AEROSOLS

!**   INTERFACE.
!     ----------
!          *AER_SRC* IS CALLED FROM *AER_PHY2*

!     AUTHOR.
!     -------
!        JEAN-JACQUES MORCRETTE  *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 2004-04-27

!-----------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMLUN    ,ONLY : NULOUT, NULERR
USE YOM_YGFL  ,ONLY : NAERO, NACTAERO, LAERODIU, LFIRE

USE YOMCST    ,ONLY : RPI, RDAY
USE YOMRIP    ,ONLY : RHGMT

USE YOEPHY    ,ONLY : LVDFTRAC, LE4ALB
USE YOEAERATM ,ONLY : LAERCLIST
USE YOEAERMAP ,ONLY : RDDUAER
!USE YOEAERSRC ,ONLY : NTYPAER ,NAERWND, RGEMUV ,RDGMUV , &
! & RCLONV, RSLONV, RDCLONV, RDSLONV, NDDUST, NSSALT, &
! & RBCPHIL, RBCPHOB, ROMPHIL, ROMPHOB, RSSLIM, RFCTSS, RFCTDU  
USE YOEAERSRC ,ONLY : NTYPAER ,NAERWND, NAERDUT, &
 & NDDUST, NSSALT, &
 & RBCPHIL, RBCPHOB, ROMPHIL, ROMPHOB, RFCTSS, RFCTDU, RAERDUB
USE YOEAERSNK ,ONLY : RMMD_DD
!USE YOEDBUG   ,ONLY : KSTPDBG, NSTPDBG

IMPLICIT NONE

!-----------------------------------------------------------------------

!*       0.1   ARGUMENTS
!              ---------

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON, KIDIA, KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV, KTDIA
INTEGER(KIND=JPIM),INTENT(IN)    :: KTILES
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTEP, KSTART
INTEGER(KIND=JPIM),INTENT(IN)    :: KSW
INTEGER(KIND=JPIM),INTENT(IN)    :: KTRAC
INTEGER(KIND=JPIM),INTENT(IN)    :: KBINSS, KBINDD
INTEGER(KIND=JPIM),INTENT(IN)    :: KAERO(NAERO)

REAL(KIND=JPRB)   ,INTENT(IN)    :: PALB(KLON), PALBP(KLON,KSW) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAERDEP(KLON), PAERLTS(KLON), PAERSCC(KLON), PALUVP(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBCBF(KLON), PBCFF(KLON), PBCGF(KLON), POMBF(KLON), POMFF(KLON), POMGF(KLON)
REAL(KIND=JPRB),   INTENT(IN)    :: PAERGUST(KLON), PHSDFOR(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSO2L(KLON), PSO2H(KLON), PSOGF(KLON), PSOA(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV), PAPH(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGELAM(KLON), PGEMU(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFRTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCI(KLON), PLSM(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV), PSNS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWIND(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWS1(KLON)

REAL(KIND=JPRB)   ,INTENT(INOUT)   :: PAERMAP(KLON,2), PAERFLX(KLON,12,9), PAERLIF(KLON,9)
REAL(KIND=JPRB)   ,INTENT(INOUT)   :: PCFLX(KLON,KTRAC)

REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCEN(KLON,KLEV,KTRAC)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTENC(KLON,KLEV,KTRAC)


!*       0.5   LOCAL VARIABLES
!              ---------------

INTEGER(KIND=JPIM) :: JAER, JK, JL, JSS 
INTEGER(KIND=JPIM) :: IFLAG, INBAER, IHTST, ITEST, IWAVL
!INTEGER(KIND=JPIM) :: JS

LOGICAL ::  LLDUST(KLON,12), LLPRINT, LLDUEMIS1(KLON), LLDUEMIS2(KLON), LLDUEMIS3(KLON)
!LOGICAL :: LLDVOL(KLON)

REAL(KIND=JPRB) :: ZFAERO(KLON,NACTAERO)     , ZAEROCLIS(KLON,KLEV,2) 
REAL(KIND=JPRB) :: ZAEROK(KLON,KLEV,NACTAERO), ZTAEROK(KLON,KLEV,NACTAERO)

REAL(KIND=JPRB) :: ZGLAT(KLON), ZGLON(KLON)
REAL(KIND=JPRB) :: ZHDD, ZHSS
REAL(KIND=JPRB) :: ZDETAH(KLON,KLEV), ZETA(KLON,KLEV) , ZETAH(KLON,0:KLEV)
REAL(KIND=JPRB) :: ZQSAT(KLON,KLEV) , ZRHCL(KLON,KLEV), ZTH(KLON,0:KLEV)

!-- temporary: as long as various alternate sources can be tested
REAL(KIND=JPRB) :: ZFLX_SDUST(KLON,9,12), ZFLX_SSALT(KLON,9,3)
REAL(KIND=JPRB) :: ZLOCALTIM   , ZDIURN(KLON)
REAL(KIND=JPRB) :: ZSCC1(KLON) , ZDEP1(KLON) , ZLTS1(KLON)
REAL(KIND=JPRB) :: ZSCC2(KLON) , ZDEP2(KLON) , ZLTS2(KLON)
REAL(KIND=JPRB) :: ZBCGF(KLON) , ZOMGF(KLON) , ZSOGF(KLON) , ZSO2L(KLON) , ZSO2H(KLON)
REAL(KIND=JPRB) :: ZWNDDU(KLON), ZWNDSS(KLON), ZWND3(KLON) , ZWS1(KLON)
REAL(KIND=JPRB) :: ZBCSOURC, ZOMSOURC, ZSO2SOURC
REAL(KIND=JPRB) :: ZDEGRAD , ZFSWET , ZSWETN
REAL(KIND=JPRB) :: ZRWPWP , ZRWSAT , ZWND1, ZSO2MSS
REAL(KIND=JPRB) :: ZEPSISS, ZEPSIDD, ZEPSIRA
!REAL(KIND=JPRB) :: ZHVO

!-- map 
INTEGER(KIND=JPIM) :: IFF
REAL(KIND=JPRB) :: ZBNDA, ZBNDB, ZBNDC, ZBNDD, ZBNDE, ZBNDF, ZBNDG, ZBNDH, ZBNDI, &
  & ZBNDJ, ZBNDK, ZBNDL, ZBNDM
REAL(KIND=JPRB) :: ZINCLAT, ZLAT, ZLON, ZLONE, ZLONGB, ZLONW

REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTERFACE
#include "surf_inq.h"
END INTERFACE

#include "aer_ssalt.intfb.h"
#include "aer_ssalt_ms.intfb.h"
!#include "aer_sdust.intfb.h"
#include "satur.intfb.h"
#include "aer_stratcl.intfb.h"
!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('AER_SRC',0,ZHOOK_HANDLE)

! N.B.: In ECMWF model conventions, flux going upward from the surface 
! are negative
! All surface fluxes PCFLUX in kg m-2 s-1

!-----------------------------------------------------------------------

! N.B.: Security parameters
ZEPSISS=1.E-09_JPRB
ZEPSIDD=1.E-09_JPRB
ZEPSIRA=1.E-06_JPRB
ZEPSISS=0.E+00_JPRB
ZEPSIDD=0.E+00_JPRB
ZEPSIRA=0.E+00_JPRB

ZSO2MSS=64.058E-03_JPRB

LLPRINT=.FALSE.
!DO JL=1,NSTPDBG
!  IF (KSTEP == KSTART .OR. KSTEP == KSTPDBG(JL)) THEN
!    LLPRINT=.TRUE.
!  ENDIF
!ENDDO

IF (LLPRINT) WRITE(NULOUT,9001)
9001 format(1x,'just entering AER_SRC')
!-----------------------------------------------------------------------

!*       0.5   CONSTANTS AND ACCESS TO DATA
!              ----------------------------

CALL SURF_INQ(PRWPWP=ZRWPWP)
CALL SURF_INQ(PRWSAT=ZRWSAT)

IHTST=20

! WRITE(UNIT=NULERR,FMT='(1X,''aer_src_1'',18I3)') (KAERO(JAER),JAER=1,NACTAERO),NACTAERO, KBINSS, KBINDD


DO JAER=1,NACTAERO
  DO JL=KIDIA,KFDIA
    PCFLX(JL,KAERO(JAER))=0._JPRB
  ENDDO
ENDDO

ZETAH(KIDIA:KFDIA,0)=0._JPRB
DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    ZETA(JL,JK) =PAP(JL,JK) /PAPH(JL,KLEV)
    ZETAH(JL,JK)=PAPH(JL,JK)/PAPH(JL,KLEV)
  ENDDO
ENDDO

ITEST=0
ZDEGRAD=180._JPRB/RPI
DO JL=KIDIA,KFDIA
  ZGLON(JL)=PGELAM(JL)*ZDEGRAD
  ZGLAT(JL)=ASIN(PGEMU(JL))*ZDEGRAD
  ZLOCALTIM =RHGMT + ZGLON(JL)/360._JPRB*RDAY
  ZDIURN(JL)=COS( ((ZLOCALTIM-54000._JPRB)/RDAY) * 2._JPRB*RPI)+1._JPRB
  IF (LLPRINT) WRITE(UNIT=NULOUT,FMT=9000) JL,ZDEGRAD,PGEMU(JL),ZGLAT(JL),PGELAM(JL),ZGLON(JL)
9000 FORMAT(1X,'aer_src Geo0',I4,5E12.5)
ENDDO
IF (.NOT.LAERODIU) THEN
  ZDIURN(KIDIA:KFDIA)=1.0_JPRB
ENDIF

IF (LLPRINT) THEN
  WRITE(UNIT=NULOUT,FMT=9011) (ZGLAT(JL),ZGLON(JL),ZDIURN(JL),JL=KIDIA,KFDIA)
9011 FORMAT(1X,'aer_src Geo1',15(3F6.1))
ENDIF  



!*       0.6   EMPIRICAL EFFICIENCY FACTORS FOR SOURCES
!              ----------------------------------------

PAERMAP(KIDIA:KFDIA,1:2) = 0._JPRB
DO JL=KIDIA,KFDIA
  ZLAT=ZGLAT(JL)
  ZLON=ZGLON(JL) 
  zbnda= 30._JPRB+(36._JPRB -zlat)*14._JPRB/24._JPRB
  zbndb= 30._JPRB+(36._JPRB -zlat)*40._JPRB/16._JPRB
  zbndc= 38._JPRB+(zlon-124._JPRB)*12._JPRB/29._JPRB
  zbndd= 32._JPRB-(zlon-243._JPRB)* 6._JPRB/21._JPRB

!-- Eastern border Canada/USA
  zbnde= 49._JPRB
  if (zlon > 268._JPRB .and. zlon < 277._JPRB) then
    zbnde= 49._JPRB-(zlon-268._JPRB)*7._JPRB/9._JPRB
  elseif (zlon >= 277._JPRB .and. zlon < 285._JPRB) then
    zbnde= 42._JPRB+(zlon-277._JPRB)*2._JPRB/8._JPRB
  elseif (zlon >= 285._JPRB .and. zlon < 310._JPRB) then
    zbnde= 44._JPRB+(zlon-285._JPRB)*3._JPRB/25._JPRB
  endif

!-- limits Britain
  zlongb=-9999._JPRB
  if (zlon > 354._JPRB .and. zlon < 360._JPRB) then
    zlongb=zlon
  elseif (zlon >= 0._JPRB .and. zlon < 3._JPRB) then
    zlongb=zlon+360._JPRB
  endif
  zbndf= 47._JPRB+(zlongb-349._JPRB)*4.5_JPRB/14._JPRB

!-- limits Ireland
  zbndg= 61._JPRB-(zlon-349._JPRB)*7._JPRB/6._JPRB
  zbndh= 45._JPRB+(zlon-349._JPRB)*9._JPRB/6._JPRB

!-- Western border Brazil
  if (zlat <= 4._JPRB .and. zlat > 2._JPRB) then
    zbndi= 296._JPRB
  elseif (zlat <= 2._JPRB .and. zlat > -4._JPRB) then
    zbndi= 290._JPRB
  elseif (zlat <= -4._JPRB .and. zlat > -7._JPRB) then
    zbndi= 290._JPRB-(-4._JPRB-zlat)*4._JPRB/3._JPRB
  elseif (zlat <= -7._JPRB .and. zlat > -11._JPRB) then
    zbndi= 286._JPRB+(-7._JPRB-zlat)*4._JPRB/4._JPRB
  endif

  if (zlat <= -11._JPRB .and. zlat > -18._JPRB) then
    zbndj= 294._JPRB+(-11._JPRB-zlat)*8._JPRB/7._JPRB
  elseif (zlat <= -18._JPRB .and. zlat > -27._JPRB) then
    zbndj= 302._JPRB+(-18._JPRB-zlat)*4._JPRB/9._JPRB
  elseif (zlat <= -27._JPRB .and. zlat > -30._JPRB) then
    zbndj= 306._JPRB-(-27._JPRB-zlat)*3._JPRB/3._JPRB
  elseif (zlat <= -30._JPRB .and. zlat >= -34._JPRB) then
    zbndj= 303._JPRB+(-30._JPRB-zlat)*4._JPRB/4._JPRB
  endif

!-- Northern border India
  if (zlon > 70._JPRB .and. zlon <= 90._JPRB) then
    zbndk= 35._JPRB-(zlon-70._JPRB)*0.5_JPRB
  endif

!-- South border of Asian deserts
  if (zlon > 90._JPRB .and. zlon <= 135._JPRB) then
    zbndl= 25._JPRB+(zlon-90._JPRB)*15._JPRB/45._JPRB
  endif

!-- North limit of the Argentinian pampas
  if (zlon > 285._JPRB .and. zlon <= 297._JPRB) then
    zbndm= -42._JPRB+(zlon-285._JPRB)*6._JPRB/12._JPRB 
  endif

  iff=0
 
!-- North America
!----- Canada
  if ( zlat >= zbnde .and. &
    &      (zlon > 190._JPRB .and. zlon < 330._JPRB) ) then
    iff=1
!----- USA
  elseif ( (zlat >= zbndd .and. zlat < zbnde ) &
    & .and. (zlon > 190._JPRB .and. zlon < 330._JPRB) ) then
    iff=3
  endif
!-- Alaska
  if ( (zlat < 72._JPRB .and. zlat > 52._JPRB) &
    & .and. (zlon > 190._JPRB .and. zlon <= 219._JPRB) ) then
    iff=2
  endif

!-- Central America
  if (zlat < zbndd .and.   &
    &     (zlon > 190._JPRB .and. zlon < 330._JPRB) ) then
    iff=4
  endif

!-- South America
  if ( zlat < 12._JPRB .and.    &
    &      (zlon > 190._JPRB .and. zlon < 330._JPRB) ) then
    iff=5
  endif
!-- Brazil
  if ( (zlat <= 4._JPRB .and. zlat > 2._JPRB)  &
    &      .and. (zlon >= 296._JPRB .and. zlon <= 300._JPRB) ) then
    iff=6 
  endif
  if ( (zlat <= 2._JPRB .and. zlat > -11._JPRB)   &
    &     .and. (zlon >= zbndi .and. zlon < 330._JPRB) ) then
    iff=6
  endif
  if ( (zlat <= -11._JPRB .and. zlat >= -34._JPRB)  &
    &     .and. (zlon >= zbndj .and. zlon < 330._JPRB) ) then
    iff=6
  endif

!-- Western Europe
  if ( zlat > 36._JPRB .and. ( zlon >= 330._JPRB .or. zlon <= 30._JPRB) ) then
    iff=10
  endif

!----- Iceland
  if ( (zlat < 67._JPRB .and. zlat > 63._JPRB)   &
    &      .and. ( zlon > 335._JPRB .and. zlon < 353._JPRB) ) then
    iff=7
  endif
!----- Britain  
  if ( (zlat < 63._JPRB .and. zlat > zbndf)  &
    &      .and. ( zlon > 354._JPRB .or. zlon < 3._JPRB) ) then
    iff=9
  endif
!----- Ireland
  if ( (zlat < zbndg .and. zlat > zbndh) &
    &      .and. ( zlon > 349._JPRB .and. zlon < 355._JPRB) ) then
    iff=8
  endif


!-- Russia to Urals
  if ( zlon > 30._JPRB .and. zlon <= 70._JPRB ) then
    if ( zlat > 51._JPRB ) then
      iff=11
    elseif ( zlat > 36._JPRB ) then
      iff=12
    endif
  endif


!-- Northern Sahara
!  if ( ( zlat <= 36._JPRB .and. zlat >= 21._JPRB) &
!    & .and. ( zlon >= 330._JPRB .or. zlon <= zbnda) ) then
!    iff=13
!-- Northern Sahara (West)
  if ( ( zlat <= 36._JPRB .and. zlat >= 21._JPRB) &
    & .and. ( zlon >= 330._JPRB .or. zlon < 4._JPRB) ) then
    iff=36
!-- Northern Sahara (East)
  elseif ( ( zlat <= 36._JPRB .and. zlat >= 21._JPRB) &
    & .and. ( zlon >= 4._JPRB .or. zlon <= zbnda) ) then
    iff=37
!-- Southern Sahara (West)
  elseif ( ( zlat < 21._JPRB .and. zlat >= 12._JPRB) &
    & .and. ( zlon >= 330._JPRB .or. zlon < 15._JPRB) ) then
    iff=34
!-- Southern Sahara (East)
  elseif ( ( zlat < 21._JPRB .and. zlat >= 12._JPRB) &
    & .and. ( zlon >= 15._JPRB .and. zlon <= zbnda) ) then
    iff=35
!-- Central Africa
  elseif ( ( zlat < 12._JPRB .and. zlat >= -12._JPRB) &
    &      .and. ( zlon >= 330._JPRB .or. zlon <= 60._JPRB) ) then
    iff=14
!-- Southern Africa
  elseif ( zlat < -12._JPRB .and. zlat >= -60._JPRB &
    &      .and. ( zlon >= 330._JPRB .or. zlon <= 60._JPRB) ) then
    iff=15
  endif


!-- Australasia
  if (zlon > 70._JPRB .and. zlon <= 190._JPRB) then
    iff=26

!-- Siberia
    if (zlat <= 90._JPRB .and. zlat > 51._JPRB) then
      iff=16

!-- South Australasia
!---- Tropical Pacific Islands
    elseif ( zlat > -10.5_JPRB) then
      iff=27
!---- Australia
    elseif ( zlat <= -10.5_JPRB .and. zlat >= -60._JPRB) then
      iff=28
    endif
  endif

!-- Asian deserts
  if ((zlon > 90._JPRB .and. zlon <= 135._JPRB) &
    & .and. (zlat <= 51._JPRB .and. zlat > zbndl)) then
      iff=17
  endif

!-- Saudi Arabia
  if ((zlat <= 36._JPRB .and. zlat >= 12._JPRB) &
    & .and.( zlon > zbnda .and. zlon < zbndb) ) then
    iff=18
  endif
!-- Irak, Iran, Pakistan
  if ((zlat <= 36._JPRB   .and. zlat >= 20._JPRB) &
    & .and.( zlon > zbndb .and. zlon < 70._JPRB) ) then
    iff=19
  endif

!-- Central Asia and India
  if ( zlon > 70._JPRB .and. zlon <= 90._JPRB) then
!----- Central Asia: Taklamakan
    if (zlat <= 43._JPRB .and. zlat >= zbndk) then
      iff=20
!----- India
    elseif (zlat <= zbndk .and. zlat > 7._JPRB) then
      iff=21
    endif
  endif
!-- other Gobi(s) in South Mongolia and Central China
  if ( zlat <= 49._JPRB .and. zlat > 35._JPRB) then
    if (zlon > 90._JPRB .and. zlon <= 110._JPRB)  then
      iff=22
    elseif (zlon > 110._JPRB .and. zlon <= 125._JPRB) then
      iff=23
    endif
  endif

!-- South China  
  if ( (zlon > 90._JPRB .and. zlon <= 135._JPRB) .and. &
    & (zlat <= zbndl .and. zlat > 7._JPRB) ) then
      iff=24
  endif



!-- Japan and S.Korea
  if ( (zlon > 124._JPRB .and. zlon < 153._JPRB) &
    & .and. (zlat > 24._JPRB .and. zlat < zbndc) ) then
    iff=25
  endif

!-- Greenland
  if (zlat > 50._JPRB) then
    zinclat=(90._JPRB-zlat)/40._JPRB*45._JPRB
    zlonw=270._JPRB +zinclat
    zlone=360._JPRB -zinclat
    if ( zlon > zlonw .and. zlon <  zlone ) then
      iff=29
    endif
  endif

!-- Antarctica
  if (zlat < -60._JPRB) then
    iff=30
  endif

!-- awaiting a proper recoding, new areas are set between iff=31 and 35

  if ( zlon > 285._JPRB .and. zlon < 295._JPRB) then
!- Atacama desert and Salar de Uyuni
    if ( zlat < -16._JPRB  .and. zlat > -28._JPRB) then
      iff=31
    endif
!- Salar de Pipanaco and other small ones
    if ( zlat <= -28._JPRB .and. zlat > zbndm) then
      iff=32
    endif
  endif
!- Argentianian pampas
  if ( (zlon > 285._JPRB .and. zlon < 297._JPRB) &
    & .and. zlat <= zbndm ) then
    iff=33
  endif
       
  IF (IFF /= 0) THEN
    PAERMAP(JL,1)=iff*PLSM(JL)                  ! area index
    PAERMAP(JL,2)=RDDUAER(iff)*PLSM(JL)         ! dust emission potential factor
  ELSE
    WRITE(NULOUT,FMT='(''aer_src: Unassigned grid for Lat,Lon='',2F8.2)') ZLAT,ZLON
    PAERMAP(JL,:)=0._JPRB
  ENDIF
ENDDO
!  print 9012, ZGLAT(KIDIA),(PAERMAP(JL,2),JL=KIDIA,KFDIA,10)
9012    format(F5.0,36F5.0)


 
! WRITE(UNIT=NULERR,FMT=9003) NACTAERO,(KAERO(JAER),JAER=1,NACTAERO)
9003 FORMAT(1X,'aer_src_2 ',15I6)

ZFAERO (KIDIA:KFDIA,         1:NACTAERO) = 0.0_JPRB
ZAEROK (KIDIA:KFDIA, 1:KLEV, 1:NACTAERO) = PCEN (KIDIA:KFDIA, 1:KLEV, KAERO(1):KAERO(NACTAERO)) 
ZTAEROK(KIDIA:KFDIA, 1:KLEV, 1:NACTAERO) = PTENC(KIDIA:KFDIA, 1:KLEV, KAERO(1):KAERO(NACTAERO))

INBAER=0

! WRITE(NULERR,FMT='(1X,''aer_src_3'')')
!-----------------------------------------------------------------------

!*       0.3   SURFACE WIND VARIABLE RELEVANT FOR SS AND DU EMISSIONS
!              ------------------------------------------------------

IF (NAERWND == 0) THEN
!-- no gust accounted for
  ZWNDDU(KIDIA:KFDIA) = PWIND(KIDIA:KFDIA)
  ZWNDSS(KIDIA:KFDIA) = PWIND(KIDIA:KFDIA)
ELSEIF (NAERWND == 1) THEN
!-- gust only for SS, 10-m wind for DU
  ZWNDDU(KIDIA:KFDIA) = PWIND(KIDIA:KFDIA)
  ZWNDSS(KIDIA:KFDIA) = PAERGUST(KIDIA:KFDIA)
ELSEIF (NAERWND == 2) THEN
!-- gust only for DU, 10-m wind for SS
  ZWNDDU(KIDIA:KFDIA) = PAERGUST(KIDIA:KFDIA)
  ZWNDSS(KIDIA:KFDIA) = PWIND(KIDIA:KFDIA)
ELSEIF (NAERWND == 3) THEN
!-- gust for both SS and DU
  ZWNDDU(KIDIA:KFDIA) = PAERGUST(KIDIA:KFDIA)
  ZWNDSS(KIDIA:KFDIA) = PAERGUST(KIDIA:KFDIA)
ENDIF

!-----------------------------------------------------------------------

!*       1.0   SEA SALT
!              --------

!- Simplistic lifting from surface based on 10-m wind and land-sea mask
ZHSS=MAX(1.0_JPRB,8434._JPRB/1000._JPRB)

IF (NTYPAER(1) /= 0) THEN

!- ECMWF sea salt fluxes come in either 3- or 10-size bins
! 0.03 - 0.50 - 5.0 - 20.
! 0.03 - 0.06 - 0.12 - 0.24 - 0.48 - 0.96 - 1.92 - 3.84 - 7.68 - 15.36 - 30.72

! ZFLX_SSALT is positive in kg m-2 s-1 out of AER_SSALT, 
! but ECMWF conventions have PCFLX as a negative upward flux

  ZFLX_SSALT(KIDIA:KFDIA,1:9,1:3)=0.0_JPRB

  CALL AER_SSALT (KIDIA, KFDIA, KLON, KBINSS, &
    & PCI, PLSM, ZWNDSS, ZFLX_SSALT(:,:,1) &
    &)

  CALL AER_SSALT_MS (KIDIA, KFDIA, KLON, &
    & PCI, PLSM, ZWNDSS, ZFLX_SSALT(:,:,2) &
    &)

!  WRITE(NULERR,FMT='(1X,''aer_src_4'')')

  DO JAER=1,KBINSS
    INBAER=INBAER+1
    DO JSS=1,3
      DO JL=KIDIA,KFDIA
        ZFLX_SSALT(JL,JAER,JSS)=RFCTSS * MAX(ZFLX_SSALT(JL,JAER,JSS), ZEPSISS)
      ENDDO
    ENDDO
    DO JL=KIDIA,KFDIA
      PCFLX(JL,KAERO(INBAER))=-ZFLX_SSALT(JL,JAER,NSSALT)*1.E+00_JPRB
    ENDDO
!    IF (LLPRINT .AND. PLSM(KIDIA) < 0.5) THEN
!      WRITE(UNIT=NULOUT,FMT='(1x,''src SS'',I1,E10.3,(20E10.3))') INBAER,(PCFLX(JL,KAERO(INBAER)),JL=KIDIA,KFDIA,10)
!    ENDIF

!-- if no vertical diffusion, distribute the flux in layers with scale height
!-- between half-levels IHTST-1 and KLEV
    IF (.NOT.LVDFTRAC) THEN
      DO JK=IHTST,KLEV
        DO JL=KIDIA,KFDIA
          ZDETAH(JL,JK) = ZETAH(JL,JK)**ZHSS - ZETAH(JL,JK-1)**ZHSS
          PTENC(JL,JK,KAERO(INBAER)) = PTENC(JL,JK,KAERO(INBAER))+ZFLX_SSALT(JL,JAER,NSSALT)*ZDETAH(JL,JK)
        ENDDO
      ENDDO
    ENDIF
  ENDDO

!  WRITE(NULERR,FMT='(1X,''aer_src_5'')')

ENDIF

!-----------------------------------------------------------------------

!*       2.0   DESERT DUST
!              -----------

!- Simplistic lifting from surface based on 10-m wind and surface albedo
ZHDD=MAX(1.0_JPRB,8434._JPRB/1000._JPRB)

PAERLIF(KIDIA:KFDIA,1:9)=-999._JPRB
PAERFLX(KIDIA:KFDIA,1:12,1:9)=0._JPRB
ZFLX_SDUST(KIDIA:KFDIA,1:9,1:12)=0._JPRB

IF (NTYPAER(2) /= 0) THEN

!-- DEFINE CONDITIONAL TESTS
  LLDUEMIS1(:)=.FALSE.
  LLDUEMIS2(:)=.FALSE.
  LLDUEMIS3(:)=.FALSE.
  DO JL=KIDIA,KFDIA
    IF (PLSM(JL) >= 0.99_JPRB .AND. PSNS(JL) == 0.0_JPRB .AND. PWS1(JL) <= 2._JPRB * ZRWPWP) THEN
      LLDUEMIS1(JL)=.TRUE.
      IF (LE4ALB .AND. (PALB(JL) < 0.5_JPRB .AND. PALBP(JL,1) >= 0.08_JPRB .AND. PALBP(JL,1) < 0.55_JPRB) ) THEN
        LLDUEMIS2(JL)=.TRUE.
      ENDIF
      IF (PWS1(JL) > 0._JPRB .AND. PWS1(JL) <= 0.2_JPRB .AND. PHSDFOR(JL) <= 50._JPRB ) THEN
        LLDUEMIS3(JL)=.TRUE.
      ENDIF
    ENDIF
  ENDDO

!  WRITE(NULERR,FMT='(1X,''aer_src_6'')')

!- ECMWF dust emission fluxes come in either 3- or 10-size bins
! 0.03 - 0.55 - 0.9 - 20.
! 0.03 - 0.06 - 0.12 - 0.24 - 0.48 - 0.96 - 1.92 - 3.84 - 7.68 - 15.36 - 30.72

! ZFLX_SDUST is positive in kg m-2 s-1
! but ECMWF conventions have PCFLX as a negative upward flux
! input parameters from climatology are:
!  -- soil clay content        (%)
!     dust emission potential  (kg s2 m-5)
!     lifting thereshold speed (m s-1)
!     
  DO JAER=1,KBINDD

    ZDEP1(KIDIA:KFDIA)=0._JPRB
    ZLTS1(KIDIA:KFDIA)=0._JPRB
    ZSCC1(KIDIA:KFDIA)=0._JPRB

    ZSCC2(KIDIA:KFDIA)=0._JPRB
    ZDEP2(KIDIA:KFDIA)=0._JPRB
    ZLTS2(KIDIA:KFDIA)=999._JPRB 

!-- PRELIMINARY FOR TESTING

!-- surface source of dust is assumed if fraction of bare soil is > 0.1 and/or UVis albedo > 0.11
!                                        10m wind > threshold = f(soil wetness, particle radius)
!                                        no snow, and below the wilting point (0.171)
    DO JL=KIDIA,KFDIA
      LLDUST(JL,:)=.FALSE.
      ZWS1(JL)=0._JPRB
      ZFLX_SDUST(JL,JAER,1:12)=0._JPRB

!---------------------------------------------------------------------
!-- LSCE formulation

!-- select land points, snow-free

      IF (PLSM(JL) >= 0.99_JPRB .AND. PSNS(JL) == 0.0_JPRB ) THEN
        ZDEP1(JL)=PAERDEP(JL)
        ZLTS1(JL)=PAERLTS(JL)
        ZSCC1(JL)=PAERSCC(JL)
        IF (ZWNDDU(JL) >= ZLTS1(JL) .AND. ZSCC1(JL) > 0.001_JPRB ) THEN
!          IF (LLPRINT) WRITE(UNIT=NULOUT,FMT=9123) JL,ZLTS1(JL),ZSCC1(JL),ZDEP1(JL),PWIND(JL) 
9123      FORMAT(1X,'DU LSCE:',I3,4E12.5)
          ZWND1 = MAX(0._JPRB, (ZWNDDU(JL)-ZLTS1(JL)) *ZWNDDU(JL)*ZWNDDU(JL) )
          LLDUST(JL,1)=.TRUE.  
          ZFLX_SDUST(JL,JAER,1)= ZDEP1(JL)*PLSM(JL)*ZWND1
          PAERFLX(JL,1,JAER)=ZFLX_SDUST(JL,JAER,1)
        ENDIF
      ENDIF
!      WRITE(NULERR,FMT='(1X,''aer_src_6'')')

!---------------------------------------------------------------------
!-- ECMWF formulations

!--------------------------------------------------------------------
!-- possible final one!

!-- select land points, snow-free, and below the wilting point
      IF (LLDUEMIS1(JL)) THEN
        ZDEP2(JL)= RAERDUB * PAERMAP(JL,2)
        ZLTS2(JL)= 5._JPRB

!-- use a formula of threshold wind velocity modified from Ginoux et al., 2001
!   based on 1st layer soil wetness and bin particle radius

        ZSWETN = MIN(1._JPRB, MAX(0.001_JPRB, (PWS1(JL)-ZRWPWP)/(ZRWSAT-ZRWPWP) ) )
        ZFSWET = 1.2_JPRB+0.2_JPRB*LOG10(ZSWETN)
        IF (NAERDUT /= 1) THEN
          ZLTS2(JL) = 1.5_JPRB * ZFSWET * (RMMD_DD(JAER)/0.15_JPRB)**0.25_JPRB
        ELSE
          ZLTS2(JL) = 7.5_JPRB * ZFSWET * (RMMD_DD(JAER)/0.15_JPRB)**0.25_JPRB
        ENDIF
        PAERLIF(JL,JAER)=ZLTS2(JL)

!- compare surface 10-m wind with threshold wind velocity
        IF (ZWNDDU(JL) > ZLTS2(JL)) THEN
          ZWND3(JL) = MAX(0._JPRB, (ZWNDDU(JL)-ZLTS2(JL)) *ZWNDDU(JL)*ZWNDDU(JL) )
!- Both area and flux are based on UVis_Alb (0.3-0.7 um) (LLDUEMIS2) and soil moisture in first (surface) layer
!- Area further depends on standard deviation of the subgrid orography
          IF (LLDUEMIS2(JL) .AND. LLDUEMIS3(JL)) THEN
            LLDUST(JL,11)=.TRUE.
            ZFLX_SDUST(JL,JAER,11)= ZDEP2(JL) * RFCTDU * PALBP(JL,1) * (1._JPRB - PWS1(JL))/0.8_JPRB * ZWND3(JL)
            PAERFLX(JL,11,JAER)=ZFLX_SDUST(JL,JAER,11)
          ENDIF
        ENDIF
      ENDIF
!---------------------------------------------------------------------

!-- select land points, snow-free, and below the wilting point

      IF (PLSM(JL) >= 0.99_JPRB .AND. PSNS(JL) == 0.0_JPRB .AND. PWS1(JL) <= 2._JPRB * ZRWPWP) THEN
        ZDEP2(JL)= RAERDUB * PAERMAP(JL,2)
        ZLTS2(JL)= 5._JPRB
        ZSCC2(JL)= 20._JPRB
        ZWS1(JL) = PWS1(JL)

!-- for preliminary testing, use a formula of threshold wind velocity modified from Ginoux et al., 2001
!   based on 1st layer soil wetness and bin particle radius

        ZSWETN = MIN(1._JPRB, MAX(0.001_JPRB, (PWS1(JL)-ZRWPWP)/(ZRWSAT-ZRWPWP) ) )
        ZFSWET = 1.2_JPRB+0.2_JPRB*LOG10(ZSWETN)
        IF (NAERDUT /= 1) THEN
          ZLTS2(JL) = 1.5_JPRB * ZFSWET * (RMMD_DD(JAER)/0.15_JPRB)**0.25_JPRB
        ELSE
          ZLTS2(JL) = 7.5_JPRB * ZFSWET * (RMMD_DD(JAER)/0.15_JPRB)**0.25_JPRB
        ENDIF
        PAERLIF(JL,JAER)=ZLTS2(JL)

!- compare surface 10-m wind with threshold wind velocity

        IF (ZWNDDU(JL) >= ZLTS2(JL)) THEN
          ZWND3(JL) = MAX(0._JPRB, (ZWNDDU(JL)-ZLTS2(JL)) *ZWNDDU(JL)*ZWNDDU(JL) )

!- first approach: area and flux are based on fraction of bare soil
          IF (PFRTI(JL,8) >= 0.10_JPRB) THEN
            LLDUST(JL,2)=.TRUE.  
            ZFLX_SDUST(JL,JAER,2)= ZDEP2(JL) * PFRTI(JL,8) * ZWND3(JL) 
            PAERFLX(JL,2,JAER)=ZFLX_SDUST(JL,JAER,2)
          ENDIF

!          WRITE(NULERR,FMT='(1X,''aer_src_7'')')
          IF (LE4ALB .AND. PHSDFOR(JL) <= 50._JPRB) THEN
!- second approach: area and flux are based on UVis_Alb (0.3-0.7 um) 
            IF (PALB(JL) < 0.5_JPRB .AND. PALBP(JL,1) >= 0.08_JPRB .AND. PALBP(JL,1) < 0.55_JPRB ) THEN
              LLDUST(JL,3)=.TRUE.
              ZFLX_SDUST(JL,JAER,3)= ZDEP2(JL) * PALBP(JL,1) * ZWND3(JL)
              PAERFLX(JL,3,JAER)=ZFLX_SDUST(JL,JAER,3)

!- third approach: area as above, but flux from fraction of bare soil
              LLDUST(JL,4)=.TRUE.
              ZFLX_SDUST(JL,JAER,4)= ZDEP2(JL) * PFRTI(JL,8) * ZWND3(JL) 
              PAERFLX(JL,4,JAER)=ZFLX_SDUST(JL,JAER,4)

!- with wind+gust at 10-m
              IF (ZWS1(JL) > 0._JPRB .AND. ZWS1(JL) <= 0.2_JPRB ) THEN
                LLDUST(JL,9)=.TRUE.
                ZFLX_SDUST(JL,JAER,9)= ZDEP2(JL) * RFCTDU * (1._JPRB - ZWS1(JL)) * ZWND3(JL)
                PAERFLX(JL,9,JAER)=ZFLX_SDUST(JL,JAER,9)

                LLDUST(JL,10)=.TRUE.
                ZFLX_SDUST(JL,JAER,10)= ZDEP2(JL) * RFCTDU * PALBP(JL,1) * (1._JPRB - ZWS1(JL)) * ZWND3(JL)
                PAERFLX(JL,10,JAER)=ZFLX_SDUST(JL,JAER,10)
              ENDIF

            ENDIF

            IF (ZSCC1(JL) > 0.001_JPRB) THEN
!- fifth approach: proportional to UV albedo over LSCE "clay" areas 
              LLDUST(JL,5)=.TRUE.
              ZFLX_SDUST(JL,JAER,5)= ZDEP2(JL) * PALBP(JL,1) * ZWND3(JL) 
              PAERFLX(JL,5,JAER)=ZFLX_SDUST(JL,JAER,5)
!- sixth approach: proportional to fraction of bare soil over LSCE "clay" areas 
              LLDUST(JL,6)=.TRUE.
              ZFLX_SDUST(JL,JAER,6)= ZDEP2(JL) * PFRTI(JL,8) * ZWND3(JL) 
              PAERFLX(JL,6,JAER)=ZFLX_SDUST(JL,JAER,6)
            ENDIF

            IF (ZWS1(JL) > 0._JPRB .AND. ZWS1(JL) <= 0.2_JPRB ) THEN
!- with wind+gust at 10-m, filter only based on soil humidity
              LLDUST(JL,7)=.TRUE.
              ZFLX_SDUST(JL,JAER,7)= ZDEP2(JL) * RFCTDU * (1._JPRB - ZWS1(JL)) * ZWND3(JL)
              PAERFLX(JL,7,JAER)=ZFLX_SDUST(JL,JAER,7)
              LLDUST(JL,8)=.TRUE.
              ZFLX_SDUST(JL,JAER,8)= ZDEP2(JL) * 1.0_JPRB * (1._JPRB - ZWS1(JL)) * ZWND3(JL)
              PAERFLX(JL,8,JAER)=ZFLX_SDUST(JL,JAER,8)
            ENDIF

          ENDIF
        ENDIF

      ENDIF

!      WRITE(NULERR,FMT='(1X,''aer_src_8'')')

    ENDDO
  ENDDO

!      PCFLX in kg m-2 s-1

  DO JAER=1,KBINDD
    INBAER=INBAER+1
    DO JL=KIDIA,KFDIA
      IF (LLDUST(JL,NDDUST)) THEN
        ZFLX_SDUST(JL,JAER,NDDUST)=MAX(ZFLX_SDUST(JL,JAER,NDDUST), ZEPSIDD)
      ENDIF
      PCFLX(JL,KAERO(INBAER))=-ZFLX_SDUST(JL,JAER,NDDUST) * 1.E+00_JPRB
    ENDDO


!-- if no vertical diffusion, distribute the flux in layers with scale height
!-- between half-levels IHTST-1 and KLEV
    IF (.NOT.LVDFTRAC) THEN
      DO JK=IHTST,KLEV
        DO JL=KIDIA,KFDIA
          ZDETAH(JL,JK) = ZETAH(JL,JK)**ZHDD - ZETAH(JL,JK-1)**ZHDD
          PTENC(JL,JK,KAERO(INBAER)) = PTENC(JL,JK,KAERO(INBAER))+PCFLX(JL,KAERO(INBAER))*ZDETAH(JL,JK)
        ENDDO
      ENDDO
    ENDIF
  ENDDO

ENDIF

!-----------------------------------------------------------------------

!*       3.0   ORGANIC MATTER (ORGANIC CARBON, POM, SECONDARY ORGANIC MATTER)
!              --------------------------------------------------------------

IF (LLPRINT) WRITE(NULERR,FMT='(1X,''aer_src_10'')')
IF (NTYPAER(3) /= 0) THEN
  DO JL=KIDIA,KFDIA
    ZOMSOURC=(POMBF(JL)*ZDIURN(JL)+POMFF(JL)+PSOA(JL))
    IF (LFIRE) THEN
      IF (POMGF(JL) < 0._JPRB) THEN
        ZOMGF(JL) = -POMGF(JL)
      ELSE
        ZOMGF(JL) = POMGF(JL)
      ENDIF
      ZOMSOURC=ZOMSOURC+ZOMGF(JL)
    ENDIF
    PCFLX(JL,KAERO(INBAER+1))= -ZOMSOURC * ROMPHIL
    PCFLX(JL,KAERO(INBAER+2))= -ZOMSOURC * ROMPHOB 
  ENDDO
  INBAER=INBAER+2
ENDIF

!-----------------------------------------------------------------------

!*       4.0   BLACK CARBON
!              ------------

IF (LLPRINT) WRITE(NULERR,FMT='(1X,''aer_src_12'')')
IF (NTYPAER(4) /= 0) THEN
  DO JL=KIDIA,KFDIA    
    ZBCSOURC=(PBCBF(JL)*ZDIURN(JL)+PBCFF(JL))
    IF (LFIRE) THEN
      IF (PBCGF(JL) < 0._JPRB) THEN
        ZBCGF(JL) = -PBCGF(JL)
      ELSE
        ZBCGF(JL) = PBCGF(JL)
      ENDIF 
      ZBCSOURC=ZBCSOURC+ZBCGF(JL)
    ENDIF
    PCFLX(JL,KAERO(INBAER+1))= -ZBCSOURC * RBCPHIL
    PCFLX(JL,KAERO(INBAER+2))= -ZBCSOURC * RBCPHOB 
  ENDDO
  INBAER=INBAER+2
ENDIF

!-----------------------------------------------------------------------

!*       5.0   SURFACE SULFATE (SO2 --> SO4)
!              -----------------------------

IF (LLPRINT) WRITE(NULERR,FMT='(1X,''aer_src_14'')')
IF (NTYPAER(5) /= 0) THEN
  DO JL=KIDIA,KFDIA    
! renormalise by the mass of SO2
    ZSO2L(JL)=PSO2L(JL)*ZSO2MSS
    ZSO2H(JL)=PSO2H(JL)*ZSO2MSS
    ZSO2SOURC=(ZSO2L(JL)*ZDIURN(JL)+ZSO2H(JL))
    IF (LFIRE) THEN
      IF (PSOGF(JL) < 0._JPRB) THEN
        ZSOGF(JL) = -PSOGF(JL)
      ELSE
        ZSOGF(JL) = PSOGF(JL)
      ENDIF
      ZSOGF(JL)=ZSOGF(JL)*ZSO2MSS
      ZSO2SOURC=ZSO2SOURC+ZSOGF(JL)
    ENDIF
    PCFLX(JL,KAERO(INBAER+2))= -ZSO2SOURC
    PCFLX(JL,KAERO(INBAER+1))= 0._JPRB
  ENDDO
  INBAER=INBAER+2
ENDIF
!-----------------------------------------------------------------------

!*       6.0   FLY ASH
!              -------

IF (NTYPAER(6) /= 0) THEN
! surface flux is set to zero as concentrations are already there
  DO JL=KIDIA,KFDIA
    PCFLX(JL,KAERO(INBAER+1))=0._JPRB
  ENDDO
  INBAER=INBAER+1
!  IF (LLPRINT) WRITE(NULERR,FMT='(1X,''aer_src_16'')')
ENDIF
!-----------------------------------------------------------------------

!*       7.0 / 8.0  PSEUDO-STRATOSPHERIC BACKAGROUND AND VOLCANIC AEROSOLS
!                   ------------------------------------------------------

!-- preliminary configuration: on the first time-step, climatological 
!   stratospheric background and volcanic aerosol optical thicknesses 
!   at 0.55 um are used as initial conditions; they are translated 
!   into mass mixing ratios then advected by the model

IF (KSTEP > KSTART) LAERCLIST = .FALSE.
IF (LAERCLIST .AND. KSTEP == KSTART .AND. (NTYPAER(7) /= 0 .OR. NTYPAER(8) /= 0)) THEN
  IFLAG=2
  CALL SATUR (KIDIA, KFDIA, KLON  , KTDIA, KLEV,&
    & PAP, PT   , ZQSAT, IFLAG )  

  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      ZRHCL(JL,JK)=PQ(JL,JK)/ZQSAT(JL,JK)
    ENDDO
  ENDDO
  DO JK=1,KLEV-1
    DO JL=KIDIA,KFDIA
      ZTH(JL,JK)=(PT(JL,JK)*PAP(JL,JK)&
       & *(PAP(JL,JK+1)-PAPH(JL,JK+1))&
       & +PT(JL,JK+1)*PAP(JL,JK+1)*(PAPH(JL,JK+1)-PAP(JL,JK)))&
       & *(1.0_JPRB/(PAPH(JL,JK+1)*(PAP(JL,JK+1)-PAP(JL,JK))))  
    ENDDO
  ENDDO
  DO JL=KIDIA,KFDIA
    ZTH(JL,0)=PT(JL,1)-PAP(JL,1)*(PT(JL,1)-ZTH(JL,1))&
     & /(PAP(JL,1)-PAPH(JL,1)) 
    ZTH(JL,KLEV)=PTS(JL)  
  ENDDO

!-- location of reference wavelength 0.55 um
  IWAVL= 8

  CALL AER_STRATCL &
    &( KIDIA, KFDIA, KLON  , KLEV , IWAVL, &
    &  PAPH , PGEMU, ZRHCL, ZTH, &
    &  ZAEROCLIS )

!-- filling up relevant arrays depending on required aerosol

!-- stratospheric background aerosols
  IF (NTYPAER(7) /= 0) THEN
    DO JL=KIDIA,KFDIA
      PCFLX(JL,KAERO(INBAER+1))=0._JPRB
    ENDDO
!- atmospheric concentration 
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        PCEN(JL,JK,KAERO(INBAER+1)) = PCEN(JL,JK,KAERO(INBAER+1)) + ZAEROCLIS(JL,JK,1)
      ENDDO
    ENDDO
    INBAER=INBAER+1
  ENDIF

!-- volcanic background aerosols  
  IF (NTYPAER(8) /= 0) THEN
    DO JL=KIDIA,KFDIA
      PCFLX(JL,KAERO(INBAER+1))=0._JPRB
    ENDDO
!- atmospheric concentration 
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        PCEN(JL,JK,KAERO(INBAER+1)) = PCEN(JL,JK,KAERO(INBAER+1)) + ZAEROCLIS(JL,JK,2)
      ENDDO
    ENDDO
    INBAER=INBAER+1
  ENDIF
!  IF (LLPRINT) WRITE(NULERR,FMT='(1X,''aer_src_17'')')
ENDIF

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------

!*       9.0   VOLCANIC AEROSOLS
!              -----------------

!-- THIS WHOLE THING SHOULD DISAPPEAR

!- Simplistic lifting from surface based on 10-m wind and surface albedo
!ZHVO=MAX(1.0_JPRB,8434._JPRB/1000._JPRB)

!IF (NTYPAER(9xxx) /= 0) THEN
!!-- surface flux is set to zero as aerosols are injected in above tropopause above volcano  
!  DO JL=KIDIA,KFDIA     
!    PCFLX(JL,KAERO(INBAER+1))=0._JPRB
!  ENDDO
!  INBAER=INBAER+1

!!-- define tropopause level (approximately: to be revised)
!  DO JK=KLEV,1,-1
!    DO JL=KIDIA,KFDIA
!      IF (PAP(JL,JK) < 4000._JPRB .AND. PT(JL,JK) < PT(JL,JK+1) ) THEN          
!        PTENC(JL,JK,KAERO(INBAER)) = PTENC(JL,JK,KAERO(INBAER)) + PVOLC(JL) / PDZ(JL,JK)
!      EXIT
!      ENDIF
!    ENDDO
!  ENDDO
!ENDIF

!IF (LLPRINT) THEN
!  DO JL=KIDIA,KFDIA
!    IF (PLSM(JL) /= 0._JPRB) THEN
!      WRITE(UNIT=NULOUT,FMT=9011) (PCFLX(JL,KAERO(JAER)),JAER=1,NACTAERO)
!    ENDIF
!9011 FORMAT(1x,'SRC-sflx',(24E10.3))
!  ENDDO
!  WRITE(NULERR,FMT='(1X,''aer_src_going_out'')')
!ENDIF

IF (LLPRINT) WRITE(NULOUT,9002)
9002 format(1x,'just about to come out of AER_SRC')
!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('AER_SRC',1,ZHOOK_HANDLE)
END SUBROUTINE AER_SRC

