SUBROUTINE AER_PHY3 &
 &( KIDIA  , KFDIA  , KLON   , KTDIA  , KLEV , KSTART, KSTEP  , KTILES , &
 &  KTRAC  , KAERO  , &
 &  PRS1   , PRSF1  , PAEROP , PCAERO , PDZ  , PCEN  , PSCAV  ,&
 &  PFPLCL , PFPLCN , PFPLSL , PFPLSN , PGELAT,PGELAM, &
 &  PAP    , PIP    , PLP    , PLU    , PO3P  ,PQP   , PTP   , PTENC  , PCFLX  , &
 &  PAERDDP, PAERSDM, PAERSRC, PAERWS , PAERGUST     , PAERUST, PAERMAP, &  
 &  PALBP  , PTAUAER, PFRTI  , PLSM   , PSNS , PWND  , PWS1   , PAERFLX, PAERLIF , &
 &  PAERODDF,PTSPHY , PGFL, &
 &  PAERLISI )

!**** *AER_PHY3* - ROUTINE DEALING WITH THE FINAL AEROSOL COMPUTATIONS:
!                  SCAVENGING, MASS DIAGNOSTICS, AEROSOL-PERTURBED RADIANCES

!      JJ.MORCRETTE , ECMWF


!**   INTERFACE.
!     ----------
!          *AER_PHY3* IS CALLED FROM *CALLPAR*.

! INPUTS:
! -------

! OUTPUTS:
! --------

!     EXTERNALS.
!     ----------
!          *AER_CGROWTH*, *AER_SO2SO4*, *AER_SCAVIN*, *AER_SCAVBC*, 
!          *AER_BDGTMSS*, *AER_SIXS*

!     MODIFICATIONS.
!     -------------
!          Original: JJ.Morcrette, 20060220  
!          JJMorcrette 20080402 New diagnostics
!          JJMorcrette 20080508 Gas-to-particle conversion  (from Hunneus and Boucher)
!          PBechtold   20091007 Reorganize for Scavenging
!

!     SWITCHES.
!     --------

!     MODEL PARAMETERS
!     ----------------

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

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

USE YOEAERSRC, ONLY : NTYPAER, LAEROMIN
USE YOEAERATM, ONLY : LAERSCAV,LAER6SDIA,LAERHYGRO, &
 & LAERNGAT, LAERCLIMG, LAERCLIMZ, LAERGTOP, LAERLISI, NXT3DAER
USE YOEAERLID, ONLY : NWLID
USE YOM_YGFL , ONLY : YGFL, NAERO, NACTAERO, YAEROUT
USE YOEDBUG  , ONLY : KSTPDBG, NSTPDBG
USE YOERAD   , ONLY : NTSW
USE YOMCST   , ONLY : RD, RG, RPI
USE YOMCT3   , ONLY : NSTEP
USE YOMLUN   , ONLY : NULOUT, NULERR
USE YOMCT0   , ONLY: LIFSMIN, LIFSTRAJ
USE YOEPHY   , ONLY : LMFSCAV

IMPLICIT NONE

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

REAL(KIND=JPRB),INTENT(IN)    :: PRSF1(KLON,KLEV), PRS1(KLON,0:KLEV)
REAL(KIND=JPRB),INTENT(IN)    :: PAP(KLON,KLEV)  , PIP(KLON,KLEV)  , PLP(KLON,KLEV)    , PLU(KLON,KLEV)
REAL(KIND=JPRB),INTENT(IN)    :: PAEROP(KLON,KLEV,NACTAERO), PCAERO(KLON,KLEV,NACTAERO)
REAL(KIND=JPRB),INTENT(IN)    :: PCEN(KLON,KLEV,KTRAC), PCFLX(KLON,KTRAC), PSCAV(KTRAC)
REAL(KIND=JPRB),INTENT(IN)    :: PDZ(KLON,KLEV), PO3P(KLON,KLEV), PQP(KLON,KLEV), PTP(KLON,KLEV)
REAL(KIND=JPRB),INTENT(IN)    :: PFPLCL(KLON,0:KLEV),PFPLCN(KLON,0:KLEV),PFPLSL(KLON,0:KLEV),PFPLSN(KLON,0:KLEV)
REAL(KIND=JPRB),INTENT(IN)    :: PGELAT(KLON)    , PGELAM(KLON) 
REAL(KIND=JPRB),INTENT(IN)    :: PALBP(KLON,NTSW), PFRTI(KLON,KTILES)
REAL(KIND=JPRB),INTENT(IN)    :: PAERDDP(KLON,NACTAERO), PAERSDM(KLON,NACTAERO), PAERSRC(KLON,NACTAERO)
REAL(KIND=JPRB),INTENT(IN)    :: PAERWS(KLON), PAERGUST(KLON), PAERUST(KLON), PAERMAP(KLON,2)
REAL(KIND=JPRB),INTENT(IN)    :: PAERFLX(KLON,12,9), PAERLIF(KLON,9)
REAL(KIND=JPRB),INTENT(IN)    :: PLSM(KLON)  , PSNS(KLON)    , PWND(KLON)   , PWS1(KLON)
REAL(KIND=JPRB),INTENT(IN)    :: PTSPHY

REAL(KIND=JPRB),INTENT(INOUT) :: PTENC(KLON,KLEV,KTRAC)
REAL(KIND=JPRB),INTENT(OUT)   :: PAERODDF(KLON,NACTAERO,7)
REAL(KIND=JPRB),INTENT(OUT)   :: PTAUAER(KLON,KLEV,6)

REAL(KIND=JPRB), INTENT(INOUT)      :: PGFL(KLON,KLEV,YGFL%NDIM)

REAL(KIND=JPRB),INTENT(OUT)   :: PAERLISI(KLON,KLEV,6)

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

INTEGER(KIND=JPIM) :: JAER, JCOUNT, JDU, JK, JL, JMMD , JNEG, JWAVL
INTEGER(KIND=JPIM) :: IAER, IBINDD, IEX3D, IEX3DP, IWHERE
INTEGER(KIND=JPIM) :: IFLAG, IWHAT, INWAVL, ITWAVL(19)
INTEGER(KIND=JPIM) :: INBSS, INBDU, INBOM, INBBC, INBSU, INBST
INTEGER(KIND=JPIM) :: ISBC1, ISBC2, ISOM1, ISOM2, ISSO2, ISSO4, ISCAV
INTEGER(KIND=JPIM) :: IEXTR2,ISHIFT1, IKPAER, IKP
LOGICAL :: LLPRINT, LLSTOP

REAL(KIND=JPRB) :: ZAEROK(KLON,KLEV,NACTAERO), ZTAEROK(KLON,KLEV,NACTAERO)
!REAL(KIND=JPRB) :: ZAEROM(KLON,KLEV,NACTAERO)

REAL(KIND=JPRB) :: ZAER(KLON,KLEV) , ZAERNEG(KLON,KLEV),ZBETAB(KLON,KLEV), ZBETAI(KLON,KLEV)
REAL(KIND=JPRB) :: ZAP(KLON,KLEV)  , ZCLDWAT(KLON,KLEV)
REAL(KIND=JPRB) :: ZDP(KLON,KLEV)  , ZDZ(KLON,KLEV) 

REAL(KIND=JPRB) :: ZBCPHI(KLON,KLEV), ZBCPHO(KLON,KLEV), ZOMPHI(KLON,KLEV) , ZOMPHO(KLON,KLEV)
REAL(KIND=JPRB) :: ZTBCPHI(KLON,KLEV),ZTBCPHO(KLON,KLEV),ZTOMPHI(KLON,KLEV), ZTOMPHO(KLON,KLEV)
REAL(KIND=JPRB) :: ZITBCPHO(KLON,KLEV),ZITOMPHO(KLON,KLEV),ZITSO2(KLON,KLEV)
REAL(KIND=JPRB) :: ZSO2(KLON,KLEV)  ,  ZTSO2(KLON,KLEV)  , ZTSO4(KLON,KLEV)
  
REAL(KIND=JPRB) :: ZQSAT(KLON,KLEV), ZRHCL(KLON,KLEV), ZRHO(KLON,KLEV)
REAL(KIND=JPRB) :: ZTAER(KLON,KLEV), ZTAERI(KLON,KLEV)
REAL(KIND=JPRB) :: ZTAERO(KLON,KLEV,NACTAERO), ZTENV(KLON)
!REAL(KIND=JPRB) :: ZTYPDDP(KLON)   , ZTYPSDM(KLON)    , ZTYPSCC(KLON)    , ZTYPSCL(KLON)
!REAL(KIND=JPRB) :: ZTYPNGT(KLON)   , ZTYPMSS(KLON)    , ZTYPSRC(KLON)    , ZTYPTAU(KLON)

REAL(KIND=JPRB) :: ZVALUE(KLON,NACTAERO)

REAL(KIND=JPRB), ALLOCATABLE :: ZAERMSS(:,:,:),ZAERMSST(:,:), ZAERTAUO(:,:,:) ,&
  & ZAERTAU(:,:,:),ZAERTAUT(:,:,:),ZAERTAUI(:,:), ZAERTAUB(:,:,:), ZAERTAUA(:,:), ZAERTAUF(:,:),&
  & ZAERSCC(:,:)  ,ZAERSCL(:,:)   ,ZAERNGT(:,:) , ZAEROMGI(:,:)  , ZAERASYI(:,:) 
REAL(KIND=JPRB) :: ZLISIS(KLON,NWLID,0:KLEV), ZLISIT(KLON,NWLID,0:KLEV)

REAL(KIND=JPRB) :: ZCLWAT, ZDEGRAD, ZEPSCOV, ZEPSWAT, ZLATPB, ZLONPB, ZRWSAT, ZRWPWP

REAL(KIND=JPRB) :: ZAEROU1(KLON,KLEV), ZAEROU2(KLON,KLEV), ZAEROU3(KLON,KLEV), ZAEROU4(KLON,KLEV)
REAL(KIND=JPRB) :: ZAEROU5(KLON,KLEV), ZAEROU6(KLON,KLEV), ZAEROU7(KLON,KLEV), ZAEROU8(KLON,KLEV)
INTERFACE
#include "surf_inq.h"
END INTERFACE

#include "satur.intfb.h"
#include "aer_cgrowth.intfb.h"
#include "aer_so2so4.intfb.h"
#include "aer_scavin.intfb.h"
#include "aer_scavbc.intfb.h"
#include "aer_negat.intfb.h"
#include "aer_bdgtmss.intfb.h"
!#include "aer_sixs.intfb.h"

REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('AER_PHY3',0,ZHOOK_HANDLE)

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

!*         0.     PROGNOSTIC AEROSOLS - FINAL COMPUTATIONS
!                 ----------------------------------------

ZEPSCOV=1.E-03_JPRB
ZEPSWAT=1.E-18_JPRB
ZDEGRAD=180._JPRB/RPI
CALL SURF_INQ(PRWSAT=ZRWSAT)
CALL SURF_INQ(PRWPWP=ZRWPWP)
IBINDD=NTYPAER(2)
INWAVL=19


!*         0.1    SWITCHING ON POSSIBLE DEBUG PRINTS AND ALLOCATING MEMORY
!                 --------------------------------------------------------

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

ALLOCATE( ZAERMSS(KLON,KLEV,NACTAERO) )
ALLOCATE( ZAERMSST(KLON,NACTAERO) )
ALLOCATE( ZAERTAU(KLON,KLEV,NACTAERO) )
ALLOCATE( ZAERTAUT(KLON,NACTAERO,INWAVL)  )
ALLOCATE( ZAERTAUI(KLON,INWAVL) )
ALLOCATE( ZAEROMGI(KLON,INWAVL) )
ALLOCATE( ZAERASYI(KLON,INWAVL) )
ALLOCATE( ZAERTAUB(KLON,NACTAERO,INWAVL)  )
ALLOCATE( ZAERTAUA(KLON,INWAVL) )
ALLOCATE( ZAERTAUF(KLON,INWAVL) )
ALLOCATE( ZAERTAUO(KLON,KLEV,3) )
ALLOCATE( ZAERSCC(KLON,NACTAERO) )
ALLOCATE( ZAERSCL(KLON,NACTAERO) )
ALLOCATE( ZAERNGT(KLON,NACTAERO) )

ZAERMSS(KIDIA:KFDIA,1:KLEV,1:NACTAERO)=0._JPRB
ZAERMSST(KIDIA:KFDIA,1:NACTAERO)      =0._JPRB
ZAERTAU(KIDIA:KFDIA,1:KLEV,1:NACTAERO)=0._JPRB
ZAERTAUT(KIDIA:KFDIA,1:NACTAERO,1:INWAVL) =0._JPRB
ZAERTAUI(KIDIA:KFDIA,1:INWAVL)            =0._JPRB
ZAEROMGI(KIDIA:KFDIA,1:INWAVL)            =0._JPRB
ZAERASYI(KIDIA:KFDIA,1:INWAVL)            =0._JPRB
ZAERTAUB(KIDIA:KFDIA,1:NACTAERO,1:INWAVL) =0._JPRB
ZAERTAUA(KIDIA:KFDIA,1:INWAVL)            =0._JPRB
ZAERTAUF(KIDIA:KFDIA,1:INWAVL)            =0._JPRB
ZAERTAUO(KIDIA:KFDIA,1:KLEV,1:3)      =0._JPRB
ZAERSCC(KIDIA:KFDIA,1:NACTAERO)       =0._JPRB
ZAERSCL(KIDIA:KFDIA,1:NACTAERO)       =0._JPRB
ZAERNGT(KIDIA:KFDIA,1:NACTAERO)       =0._JPRB

DO JAER=1,NACTAERO
  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      ZAEROK(JL,JK,JAER) =PCEN (JL,JK,KAERO(JAER))
      ZTAEROK(JL,JK,JAER)=PTENC(JL,JK,KAERO(JAER))
    ENDDO
  ENDDO
ENDDO

IFLAG=2
CALL SATUR (KIDIA , KFDIA , KLON  , KTDIA , KLEV,&
  & PRSF1, PTP    , ZQSAT , IFLAG)  

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    ZRHO(JL,JK)=PRSF1(JL,JK)/(RD*PTP(JL,JK))
    ZDP(JL,JK)= PRS1(JL,JK) - PRS1(JL,JK-1)
    ZDZ(JL,JK)= ZDP(JL,JK) / (ZRHO(JL,JK)*RG)  
    ZRHCL(JL,JK)=PQP(JL,JK)/(MAX(1.E-30_JPRB, ZQSAT(JL,JK)))
  ENDDO
ENDDO

!-------------------------------------------------------------------------------
!** First batch of processes: Hygroscopicity on OM and BC, and Gas-to-particle 
!   conversion. As these processes are applied separately on individual aerosol 
!   types: successive addition of tendencies is done "outside"

!*         1.     HYGROSCOPY (APPLIED TO BC AND OM ONLY)
!                 --------------------------------------

IF (LAERHYGRO .AND. NTYPAER(3) /= 0) THEN
!IF (LLPRINT) WRITE(NULERR,FMT='(''aer_phy3 before hygroscopy'')')
!IF (LLPRINT) WRITE(NULOUT,FMT='(''aer_phy3 before hygroscopy'')')
  ISOM1=NTYPAER(1)+NTYPAER(2)+1
  ISOM2=ISOM1+1

  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      ZOMPHI(JL,JK)=PAEROP(JL,JK,ISOM1)
      ZOMPHO(JL,JK)=PAEROP(JL,JK,ISOM2)
      ZITOMPHO(JL,JK)=ZTAEROK(JL,JK,ISOM2)
    ENDDO
  ENDDO

  CALL AER_CGROWTH ( KIDIA, KFDIA, KLON, KLEV, &
    & ZOMPHO , &
    & ZTOMPHI, ZTOMPHO )

  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      ZTAEROK(JL,JK,ISOM1)=ZTAEROK(JL,JK,ISOM1)+ZTOMPHI(JL,JK)
      ZTAEROK(JL,JK,ISOM2)=ZTAEROK(JL,JK,ISOM2)+ZTOMPHO(JL,JK)
    ENDDO
  ENDDO
ENDIF

IF (LAERHYGRO .AND. NTYPAER(4) /= 0) THEN
  ISBC1=NTYPAER(1)+NTYPAER(2)+NTYPAER(3)+1
  ISBC2=ISBC1+1

  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      ZBCPHI(JL,JK)=PAEROP(JL,JK,ISBC1)
      ZBCPHO(JL,JK)=PAEROP(JL,JK,ISBC2)
      ZITBCPHO(JL,JK)=ZTAEROK(JL,JK,ISBC2)
    ENDDO
  ENDDO

  CALL AER_CGROWTH ( KIDIA, KFDIA, KLON, KLEV, &
    & ZBCPHO, &
    & ZTBCPHI, ZTBCPHO )

  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      ZTAEROK(JL,JK,ISBC1)=ZTAEROK(JL,JK,ISBC1)+ZTBCPHI(JL,JK)
      ZTAEROK(JL,JK,ISBC2)=ZTAEROK(JL,JK,ISBC2)+ZTBCPHO(JL,JK)
    ENDDO
  ENDDO
!  IF (LLPRINT) WRITE(NULERR,FMT='(''aer_phy3 after hygroscopy'')')
!  IF (LLPRINT) WRITE(NULOUT,FMT='(''aer_phy3 after hygroscopy'')')
ENDIF


!*         2.     GAS-TO-PARTICLE CONVERSION (SO2 -> SO4)
!                 ---------------------------------------

IF (NTYPAER(5) /= 0) THEN
  ISSO4=NTYPAER(1)+NTYPAER(2)+NTYPAER(3)+NTYPAER(4)+1
  ISSO2=ISSO4+1
  IF (LAERGTOP) THEN
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
!        ZSO2(JL,JK)=ZAEROK(JL,JK,ISSO2)
        ZSO2(JL,JK)=PAEROP(JL,JK,ISSO2)
        ZITSO2(JL,JK)=ZTAEROK(JL,JK,ISSO2)
      ENDDO
    ENDDO

    CALL AER_SO2SO4 (KIDIA , KFDIA, KLON, KLEV, &
      & ZSO2 , PGELAT, PTSPHY, &
      & ZTSO2, ZTSO4 )

    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        ZTAEROK(JL,JK,ISSO2)=ZTAEROK(JL,JK,ISSO2)+ZTSO2(JL,JK)
        ZTAEROK(JL,JK,ISSO4)=ZTAEROK(JL,JK,ISSO4)+ZTSO4(JL,JK)
     ENDDO
    ENDDO
  ENDIF
!  IF (LLPRINT) WRITE(NULERR,FMT='(''aer_phy3 after gas-to-particle conversion'')')
!  IF (LLPRINT) WRITE(NULOUT,FMT='(''aer_phy3 after gas-to-particle conversion'')')
ENDIF

!-------------------------------------------------------------------------------
!** Second batch of processes: Scavenging in- and below-cloud by large-scale, 
!   then convective precipitation. As these processes are applied 
!   systematically on all aerosol types: successive addition of tendencies is 
!   done "inside" the AER_SCAVIN and AER_SCAVBC routines

!*         3.     SCAVENGING OF PROGNOSTIC AEROSOLS FROM PRECIPITATION
!                 ----------------------------------------------------

IF (LAERSCAV) THEN
!  ISCAV = NTYPAER(1) + NTYPAER(2)
  ISCAV = NTYPAER(1) + NTYPAER(2) + NTYPAER(3) + NTYPAER(4) + NTYPAER(5) + NTYPAER(6) 
     
  DO JAER=1,ISCAV

!* USING CURRENT LARGE-SCALE PRECIPITATION FLUXES

    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        ZBETAI(JL,JK)=0._JPRB
        ZBETAB(JL,JK)=0._JPRB
        ZAER(JL,JK)  = PAEROP(JL,JK,JAER)
        ZTAERI(JL,JK)= ZTAEROK(JL,JK,JAER)
        ZTAER(JL,JK) =0._JPRB

        ZCLWAT = MAX(0._JPRB, PLP(JL,JK)+PIP(JL,JK))
        IF (ZCLWAT > ZEPSWAT .AND. PAP(JL,JK) > ZEPSCOV) THEN
          ZAP(JL,JK)    =PAP(JL,JK)
          ZCLDWAT(JL,JK)=ZCLWAT / PAP(JL,JK)
        ELSE
          ZAP(JL,JK)    =0.0_JPRB
          ZCLDWAT(JL,JK)=0.0_JPRB
        ENDIF
      ENDDO
    ENDDO
    DO JL=KIDIA,KFDIA
      ZTENV(JL)=0._JPRB
    ENDDO

!-- both SCAVIN and SCAVBC are entered with kg kg-1

    CALL AER_SCAVIN &
      &( KIDIA, KFDIA, KLON , KLEV  , JAER  , KSTART, KSTEP  , &
      &  ZDP  , ZDZ  , ZRHO , PFPLSL, PFPLSN, ZAP   , ZCLDWAT, ZAER  , ZTAERI, &
      &  PSCAV(KAERO(JAER)), PTSPHY, &
      &  ZTAER, ZTENV )

!    WRITE(NULERR,FMT='(''aer_phy3 after scavin large-scale'')')

    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        ZTAERI(JL,JK)=ZTAER(JL,JK)
        ZTAER(JL,JK)=0._JPRB
      ENDDO
    ENDDO
    DO JL=KIDIA,KFDIA
      ZAERSCL(JL,JAER)=ZTENV(JL)
    ENDDO

    CALL AER_SCAVBC &
      &( KIDIA , KFDIA  , KLON  , KLEV  , JAER , KSTEP , &
      &  PFPLSL, PFPLSN , ZAER  , ZTAERI, PTSPHY, &
      &  ZTAER )

!    WRITE(NULERR,FMT='(''aer_phy3 after scavbc large-scale'')')

    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        ZTAERO(JL,JK,JAER)=ZTAER(JL,JK)
      ENDDO
    ENDDO
    DO JL=KIDIA,KFDIA
      ZAERSCL(JL,JAER)=ZAERSCL(JL,JAER)+ZTENV(JL)
    ENDDO

 !IF(.NOT.LMFSCAV) THEN 
!* USING CURRENT CONVECTIVE PRECIPITATION FLUXES

    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        ZBETAI(JL,JK)=0._JPRB
        ZBETAB(JL,JK)=0._JPRB
        ZTAERI(JL,JK)=ZTAERO(JL,JK,JAER)
        ZTAER(JL,JK) =0._JPRB

        ZCLWAT = MAX(0._JPRB, PLU(JL,JK))
        IF (ZCLWAT > ZEPSWAT) THEN
          ZAP(JL,JK)    =0.05_JPRB
          ZCLDWAT(JL,JK)=ZCLWAT
        ELSE
          ZAP(JL,JK)    =0.0_JPRB
          ZCLDWAT(JL,JK)=0.0_JPRB
        ENDIF
      ENDDO
    ENDDO
    DO JL=KIDIA,KFDIA
      ZTENV(JL)=0._JPRB
    ENDDO

    CALL AER_SCAVIN &
      &( KIDIA, KFDIA, KLON , KLEV  , JAER  , KSTART, KSTEP  , &
      &  ZDP  , ZDZ  , ZRHO , PFPLCL, PFPLCN, ZAP   , ZCLDWAT, ZAER  , ZTAERI, &
      &  PSCAV(KAERO(JAER)), PTSPHY, &
      &  ZTAER, ZTENV )

!    WRITE(NULERR,FMT='(''aer_phy3 after scavin convective'')')

    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        ZTAERI(JL,JK)=ZTAER(JL,JK)
        ZTAER(JL,JK)=0._JPRB
      ENDDO
    ENDDO
    DO JL=KIDIA,KFDIA
      ZAERSCC(JL,JAER)=ZTENV(JL)
    ENDDO

    CALL AER_SCAVBC &
      &( KIDIA , KFDIA  , KLON  , KLEV  , JAER , KSTEP , &
      &  PFPLCL, PFPLCN , ZAER  , ZTAERI, PTSPHY, &
      &  ZTAER )

!    WRITE(NULERR,FMT='(''aer_phy3 after scavbc convective'')')

    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        ZTAERO(JL,JK,JAER)=ZTAER(JL,JK)
      ENDDO
    ENDDO
    DO JL=KIDIA,KFDIA
      ZAERSCC(JL,JAER)=ZAERSCC(JL,JAER)+ZTENV(JL)
    ENDDO

  !ENDIF

  ENDDO

 ENDIF

!-- put back all tendencies in the field for GEMS tendencies

PTENC(KIDIA:KFDIA,1:KLEV,KAERO(1):KAERO(NACTAERO)) = ZTAERO(KIDIA:KFDIA,1:KLEV,1:NACTAERO)
     
IF (LLPRINT .AND. (PCFLX(KIDIA,KAERO(1)) /= 0._JPRB .OR. PCFLX(KIDIA,KAERO(4)) /= 0._JPRB)) THEN
  DO JK=45,KLEV
    WRITE(UNIT=NULOUT,FMT='(1x,''CP6Scav'',3I3,(12E12.5))') KSTEP,JK,KIDIA,&
      & (PCEN(KIDIA,JK,KAERO(JAER)),PTENC(KIDIA,JK,KAERO(JAER)),JAER=1,ISCAV)
  ENDDO
ENDIF

!IF (LLPRINT .AND. (PCFLX(KIDIA,KAERO(1)) /= 0._JPRB .OR. PCFLX(KIDIA,KAERO(4)) /= 0._JPRB)) THEN
!  DO JK=45,KLEV
!    WRITE(UNIT=NULOUT,FMT='(1x,''CP6Scav'',3I3,(12E12.5))') KSTEP,JK,KIDIA,&
!      & (PCEN(KIDIA,JK,KAERO(JAER)),PTENC(KIDIA,JK,KAERO(JAER)),JAER=1,ISCAV)
!  ENDDO
!ENDIF


!*         7.2    ELIMINATION OF NEGATIVE PROGNOSTIC AEROSOL CONCENTRATIONS
!                 ---------------------------------------------------------

IF (LAERNGAT) THEN
  DO JAER=1,NACTAERO

      DO JK=1,KLEV
        DO JL=KIDIA,KFDIA
          ZAER(JL,JK)  =PAEROP(JL,JK,JAER)
          ZTAER(JL,JK)=PTENC(JL,JK,KAERO(JAER))
        ENDDO
      ENDDO

    CALL AER_NEGAT &
      & ( KIDIA   , KFDIA , KLON , KLEV, &
      &   PTSPHY  , &
      &   ZAER    , ZTAER, PRS1, &
      &   ZAERNEG )  

    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        ZTAERO(JL,JK,JAER)=ZTAER(JL,JK)
      ENDDO
    ENDDO
    DO JL=KIDIA,KFDIA
      ZAERNGT(JL,JAER)=ZAERNEG(JL,KLEV)
    ENDDO

  ENDDO

  PTENC(KIDIA:KFDIA,1:KLEV,KAERO(1):KAERO(NACTAERO)) = ZTAERO(KIDIA:KFDIA,1:KLEV,1:NACTAERO)

!  IF (LLPRINT) WRITE(NULERR,FMT='(''aer_phy3 after aer_negat'')')
!  IF (LLPRINT) WRITE(NULOUT,FMT='(''aer_phy3 after aer_negat'')')

!  IF (LLPRINT) THEN
!    DO JK=1,KLEV
!      DO JL=KIDIA,KFDIA
!        JNEG=0
!        DO JAER=1,NACTAERO
!          ZVALUE(JL,JAER)=PCEN(JL,JK,KAERO(JAER)) + PTSPHY * PTENC(JL,JK,KAERO(JAER))
!          IF ( (ZVALUE(JL,JAER) < 0._JPRB) .OR. ZVALUE(JL,JAER) > 1.E+20_JPRB) JNEG=1
!        ENDDO
!        IF (JNEG == 1) THEN
!          WRITE(NULOUT,FMT='("Neg STEP,JK,JL,LAT,LON ",I6,2I5,F8.3,(12E10.3))') &
!           & NSTEP,JK,JL,PGELAT(JL),(ZVALUE(JL,JAER),JAER=1,NACTAERO)
!        ENDIF
!      ENDDO
!    ENDDO
!  ENDIF
   
ENDIF



!*         2.      VERTICALLY INTEGRATED MASS AND TOTAL OPTICAL DEPTH
!                  -------------------------------------------------- 

INWAVL = 19
ITWAVL( 1)= 9   ! 550 nm
ITWAVL( 2)= 1   ! 340 nm
ITWAVL( 3)= 2   ! 355 nm 
ITWAVL( 4)= 3   ! 380 nm
ITWAVL( 5)= 4   ! 400 nm
ITWAVL( 6)= 5   ! 440 nm
ITWAVL( 7)= 6   ! 500 nm
ITWAVL( 8)= 7   ! 532 nm 
ITWAVL( 9)= 8   ! 550 nm
ITWAVL(10)=10   ! 645 nm
ITWAVL(11)=11   ! 670 nm
ITWAVL(12)=12   ! 800 nm
ITWAVL(13)=13   ! 858 nm                  
ITWAVL(14)=14   ! 856 nm
ITWAVL(15)=15   ! 1020 nm
ITWAVL(16)=16   ! 1064 nm
ITWAVL(17)=17   ! 1240 nm
ITWAVL(18)=18   ! 1640 nm
ITWAVL(19)=19   ! 2130 nm

IWHAT=0
IF (LAERCLIMG .OR. LAERCLIMZ) THEN
! BEN
  IWHAT=2
  INWAVL=1
ENDIF

!-- Caution: if prognostic aerosols are on, PAEROP is in kg kg-1 and  ZCAERO is in kg cm-3 
! optical thicknesses can be computed over the 17 following wavelengths:

!-- version INWAVL channels
! (340)355(380)400 440 469 500 532 550 645 670 800 858 865(1020)1064 1240 1640 2130 
!                   ---         ---     ---         ---      ---- ---- ---- MODIS
!           ***                             ***                             SEVIRI 
!  ---  ---     xxx     ---             xxx         xxx xxxx                AERONET
!      OOO                     000                               000                EARLINET/CALIPSO

CALL AER_BDGTMSS &
  & ( KIDIA, KFDIA , KLON  , KLEV, NACTAERO, IWHAT, INWAVL, ITWAVL, KSTART, KSTEP, &
  &   PRS1 , PAEROP, PCAERO, PDZ , PO3P    , ZRHCL   , PTP     , &
  &   ZAERMSS, ZAERMSST, ZAERTAU , ZAERTAUT, ZAERTAUI, ZAERTAUB, ZAERTAUA, ZAERTAUF, ZAERTAUO, &
  &   ZAEROMGI,ZAERASYI, ZLISIS  , ZLISIT )

!IF (LLPRINT) WRITE(NULERR,FMT='(''aer_phy3 after aer_bdgtmss'')')
!IF (LLPRINT) WRITE(NULOUT,FMT='(''aer_phy3 after aer_bdgtmss'')')

IF (LAERLISI) THEN
  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      PAERLISI(JL,JK,1)=ZLISIT(JL,1,JK)
      PAERLISI(JL,JK,2)=ZLISIT(JL,2,JK)
      PAERLISI(JL,JK,3)=ZLISIT(JL,3,JK)
      PAERLISI(JL,JK,4)=ZLISIS(JL,1,JK-1)
      PAERLISI(JL,JK,5)=ZLISIS(JL,2,JK-1)
      PAERLISI(JL,JK,6)=ZLISIS(JL,3,JK-1)
    ENDDO
  ENDDO
ENDIF


!*         3.      STORE VARIOUS AEROSOL DIAGNOSTICS AND SURFACE FIELDS
!                  ---------------------------------------------------- 

PTAUAER(KIDIA:KFDIA,1:KLEV,1:6)=0._JPRB

INBSS=NTYPAER(1)
INBDU=NTYPAER(1)+NTYPAER(2)
INBOM=NTYPAER(1)+NTYPAER(2)+NTYPAER(3)
INBBC=NTYPAER(1)+NTYPAER(2)+NTYPAER(3)+NTYPAER(4)
INBSU=NTYPAER(1)+NTYPAER(2)+NTYPAER(3)+NTYPAER(4)+NTYPAER(5)
INBST=NTYPAER(1)+NTYPAER(2)+NTYPAER(3)+NTYPAER(4)+NTYPAER(5)+NTYPAER(7)

IF (NTYPAER(1) /= 0) THEN
  DO IAER=1,INBSS 
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        PTAUAER(JL,JK,1)=PTAUAER(JL,JK,1)+ZAERTAU(JL,JK,IAER)
      ENDDO
    ENDDO
  ENDDO
ENDIF
IF (NTYPAER(2) /= 0) THEN
  DO IAER=INBSS+1,INBDU 
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        PTAUAER(JL,JK,2)=PTAUAER(JL,JK,2)+ZAERTAU(JL,JK,IAER)
      ENDDO
    ENDDO
  ENDDO
ENDIF
IF (NTYPAER(3) /= 0) THEN
  DO IAER=INBDU+1,INBOM 
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        PTAUAER(JL,JK,3)=PTAUAER(JL,JK,3)+ZAERTAU(JL,JK,IAER)
      ENDDO
    ENDDO
  ENDDO
ENDIF
IF (NTYPAER(4) /= 0) THEN
  DO IAER=INBOM+1,INBBC 
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        PTAUAER(JL,JK,4)=PTAUAER(JL,JK,4)+ZAERTAU(JL,JK,IAER)
      ENDDO
    ENDDO
  ENDDO
ENDIF
IF (NTYPAER(5) /= 0) THEN
  DO IAER=INBBC+1,INBSU 
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        PTAUAER(JL,JK,5)=PTAUAER(JL,JK,5)+ZAERTAU(JL,JK,IAER)
      ENDDO
    ENDDO
  ENDDO
ENDIF
IF (NTYPAER(7) /= 0) THEN
  DO IAER=INBSU+1,INBST 
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        PTAUAER(JL,JK,6)=PTAUAER(JL,JK,6)+ZAERTAU(JL,JK,IAER)
      ENDDO
    ENDDO
  ENDDO
ENDIF


LLSTOP=.FALSE.
IKP=0
IKPAER=0
!DO JL=KIDIA,KFDIA
!  DO JAER=1,NACTAERO
!    IF (ZAERTAUT(JL,JAER,1) > 100._JPRB) THEN
!      ZLONPB=PGELAM(JL)*ZDEGRAD
!      ZLATPB=PGELAT(JL)*ZDEGRAD
!      LLSTOP=.TRUE.
!      IKPAER=JAER
!      IKP=JL
!    ENDIF
!  ENDDO
!  IF (LLSTOP) THEN
!    WRITE(NULOUT,FMT='("phy3 tau > 100 ",3I5,2F8.3,12E12.4)') KSTEP,IKP,IKPAER,ZLATPB,ZLONPB,(ZAERTAUT(JL,JAER,1),JAER=1,NACTAERO)
!    LLSTOP=.FALSE.
!!    CALL ABOR1 ("aer_phy3: tau over 100")
!  ENDIF
!ENDDO

!------------------------------------------------------------------------------
!
!*         6.1     STORE IN AEROUT-1 AND AEROUT-2
!                  ------------------------------

! Initialize arrays for diagnostics
 ZAEROU1(:,:) = 0.0_JPRB
 ZAEROU2(:,:) = 0.0_JPRB
 ZAEROU3(:,:) = 0.0_JPRB
 ZAEROU4(:,:) = 0.0_JPRB
 ZAEROU5(:,:) = 0.0_JPRB
 ZAEROU6(:,:) = 0.0_JPRB
 ZAEROU7(:,:) = 0.0_JPRB
 ZAEROU8(:,:) = 0.0_JPRB

IEX3D = NXT3DAER+1
IEX3DP= IEX3D+1
DO JL=KIDIA,KFDIA
  ZAEROU1(JL,1)= ZAERTAUI(JL,1)
  ZAEROU2(JL,1)= ZAEROU2(JL,1) + ZAERTAUI(JL,1) * PTSPHY
ENDDO

ISHIFT1 = 1

!-- new storage of various aerosol sources, fluxes and optical thickness
!  NB: common to all vertical resolutions <= 91
! -- for complete configuration SS3+DU3+2OM+2BC+2SU = 12 aerosols * 8 diagnostics = 96 quantities
!    distributed over the first 48 levels of 2 extra 3D fields (aer_1 and aer_2)
!    NB: Instantaneous

DO JAER=1,NACTAERO
  IEXTR2 = ISHIFT1 + (JAER-1)*4
  DO JL=KIDIA,KFDIA
    ZAEROU1(JL,IEXTR2+1) = PAERSRC(JL,JAER)
    ZAEROU1(JL,IEXTR2+2) = PAERDDP(JL,JAER)
    ZAEROU1(JL,IEXTR2+3) = PAERSDM(JL,JAER)
    ZAEROU1(JL,IEXTR2+4) = ZAERSCL(JL,JAER)
!--
    ZAEROU2(JL,IEXTR2+1) = ZAERSCC(JL,JAER)
    ZAEROU2(JL,IEXTR2+2) = ZAERNGT(JL,JAER)
    ZAEROU2(JL,IEXTR2+3) = ZAERTAUT(JL,JAER,1)
    ZAEROU2(JL,IEXTR2+4) = ZAERMSST(JL,JAER)
  ENDDO
ENDDO

!------------------------------------------------------------------------------
!
!*         6.2     STORE IN AEROUT-3
!                  -----------------

!-- store total and absorption optical thicknesses over INWAVL shortwave channels in another 3D-extra field (aer_3)
!  from levels 1 to 57 (3x19)

ISHIFT1 = 0
IEX3D = IEX3DP+1

DO JL=KIDIA,KFDIA
  DO JWAVL=1,INWAVL    
    ZAEROU3(JL,ISHIFT1+JWAVL         )=ZAERTAUI(JL,JWAVL)
    ZAEROU3(JL,ISHIFT1+JWAVL  +INWAVL)=ZAERTAUA(JL,JWAVL)
    ZAEROU3(JL,ISHIFT1+JWAVL+2*INWAVL)=ZAERTAUF(JL,JWAVL)
  ENDDO
ENDDO

!------------------------------------------------------------------------------
!
!*         6.3     STORE IN AEROUT-4, -5, AND -6
!                  -----------------------------

!-- in 3 other 3D extra fields, store profiles of various optical thicknesses (aer_4 to aer_6) (NB: Instantaneous)

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    ZAEROU4(JL,JK)=ZAERTAUO(JL,JK,1)
    ZAEROU5(JL,JK)=ZAERTAUO(JL,JK,2)
    ZAEROU6(JL,JK)=ZAERTAUO(JL,JK,3)
  ENDDO
ENDDO

!------------------------------------------------------------------------------
!
!*         6.4     STORE IN AEROUT-7
!                  -----------------

!-- in another 3D extra field, store various 2D diagnostics (aer_7) (NB: Instantaneous)

IEX3D = IEX3D+4
DO JL=KIDIA,KFDIA
  ZAEROU7(JL,1) = PAERWS(JL)
  ZAEROU7(JL,2) = PAERGUST(JL)
  ZAEROU7(JL,3) = PAERUST(JL)
  ZAEROU7(JL,4) = PALBP(JL,1)
  ZAEROU7(JL,5) = PFRTI(JL,8)
  ZAEROU7(JL,6) = PWS1(JL)
  ZAEROU7(JL,7) = PAERMAP(JL,1)
  ZAEROU7(JL,8) = PAERMAP(JL,2)
  ZAEROU7(JL,9) = PWND(JL)
ENDDO

IF (IBINDD == 3) THEN
  IWHERE=9
! levels 10 to 12 are filled with LTS (aer_7) (NB: Instantaneous)

  DO JMMD=1,IBINDD
    DO JL=KIDIA,KFDIA
      ZAEROU7(JL,IWHERE+JMMD)=PAERLIF(JL,JMMD)
    ENDDO
  ENDDO
   
  IWHERE=12
! levels 13 to 48 are filled with the 3bins x 12 variants of the instantaneous DU emission fluxes (aer_7)
  DO JMMD=1,IBINDD
    IWHERE=12+(JMMD-1)*12
    DO JDU=1,12 
      DO JL=KIDIA,KFDIA
        ZAEROU7(JL,IWHERE+JDU) = ZAEROU7(JL,IWHERE+JDU) + PAERFLX(JL,JDU,JMMD) * PTSPHY
      ENDDO
ENDDO
  ENDDO
ENDIF

IWHERE=48
! levels 49 to 60 are filled with the instantaneous vertically integrated optical thickness
!  at 550 nm per aerosol bin/type
DO JAER=1,NACTAERO
  DO JL=KIDIA,KFDIA
    ZAEROU7(JL,IWHERE+JAER) = ZAEROU7(JL,IWHERE+JAER) + ZAERTAUT(JL,JAER,1) * PTSPHY
  ENDDO
ENDDO

DO JDU=1,60
  DO JL=KIDIA,KFDIA
    IF (ZAEROU7(JL,JDU) >= 1.E+10_JPRB) THEN
      WRITE(NULERR,FMT='("aer_phy3 ZAEROU7 JL JDU ",2I4,E15.7)') JL,JDU,ZAEROU7(JL,JDU)
    ENDIF
  ENDDO
ENDDO
!
!------------------------------------------------------------------------------
!
!*         6.5     STORE IN AEROUT-8
!                  -----------------

!-- in yet another 3d extra field, store profiles of total optical thickness, 
!   single scattering albedo and asymmetry factor (aer_8)
IEX3D = IEX3D+1
ISHIFT1=0
DO JL=KIDIA,KFDIA
  DO JWAVL=1,INWAVL    
    ZAEROU8(JL,ISHIFT1+JWAVL         )= ZAERTAUI(JL,JWAVL)
    ZAEROU8(JL,ISHIFT1+JWAVL  +INWAVL)= ZAEROMGI(JL,JWAVL)
    ZAEROU8(JL,ISHIFT1+JWAVL+2*INWAVL)= ZAERASYI(JL,JWAVL)
  ENDDO 
ENDDO

!------------------------------------------------------------------------------
!
!*         6.6     SET SOME FIELDS TO ZERO
!                  -----------------------


IF(.NOT.LIFSMIN .AND. .NOT. LIFSTRAJ) THEN
   PGFL(:,:,YAEROUT(1)%MP) = ZAEROU1(:,:)
   PGFL(:,:,YAEROUT(2)%MP) = ZAEROU2(:,:)
   PGFL(:,:,YAEROUT(3)%MP) = ZAEROU3(:,:)
   PGFL(:,:,YAEROUT(4)%MP) = ZAEROU4(:,:)
   PGFL(:,:,YAEROUT(5)%MP) = ZAEROU5(:,:)
   PGFL(:,:,YAEROUT(6)%MP) = ZAEROU6(:,:)
   PGFL(:,:,YAEROUT(7)%MP) = ZAEROU7(:,:)
   PGFL(:,:,YAEROUT(8)%MP) = ZAEROU8(:,:)
ENDIF


!------------------------------------------------------------------------------
!
!*         7.       STORE ALL AEROSOL VERTICALLY INTEGRATED FLUXES
!                   ----------------------------------------------

DO JAER=1,NACTAERO
  DO JL=KIDIA,KFDIA
    PAERODDF(JL,JAER,1)=PAERSRC(JL,JAER)
    PAERODDF(JL,JAER,2)=PAERDDP(JL,JAER)
    PAERODDF(JL,JAER,3)=PAERSDM(JL,JAER)
    PAERODDF(JL,JAER,4)=ZAERSCL(JL,JAER)
    PAERODDF(JL,JAER,5)=ZAERSCC(JL,JAER)
    PAERODDF(JL,JAER,6)=ZAERNGT(JL,JAER)
    PAERODDF(JL,JAER,7)=ZAERTAUT(JL,JAER,1)
  ENDDO
ENDDO

!------------------------------------------------------------------------------
!
!*         8.       RADIANCE DIAGNOSTICS WITH 6S SW RT CODE
!                   ---------------------------------------

IF (LAER6SDIA) THEN
!  CALL AER_SIXS
ENDIF

!------------------------------------------------------------------------------
!
!*         9.       RELEASE LOCAL MEMORY
!                   --------------------
 
DEALLOCATE( ZAERMSS )
DEALLOCATE( ZAERMSST )
DEALLOCATE( ZAERTAU )
DEALLOCATE( ZAERTAUT )
DEALLOCATE( ZAERTAUI ) 
DEALLOCATE( ZAEROMGI )
DEALLOCATE( ZAERASYI )
DEALLOCATE( ZAERTAUB )
DEALLOCATE( ZAERTAUA ) 
DEALLOCATE( ZAERTAUF ) 
DEALLOCATE( ZAERTAUO ) 
DEALLOCATE( ZAERSCC )
DEALLOCATE( ZAERSCL )
DEALLOCATE( ZAERNGT )

!IF (LLPRINT) WRITE(NULERR,FMT='(''aer_phy3 about to come out'')')
!IF (LLPRINT) WRITE(NULOUT,FMT='(''aer_phy3 about to come out'')')

!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('AER_PHY3',1,ZHOOK_HANDLE)
END SUBROUTINE AER_PHY3

