!OPTIONS XOPT(HSFUN)
SUBROUTINE AER_CLIST &
 &( KIDIA , KFDIA, KLON , KLEV , KAERO, &
 &  PAPRS , PSIN , PCLON, PSLON, PTH  , &
 &  PAERCLIS  &
 &)  

!***********************************************************************
! CAUTION: THIS ROUTINE WORKS ONLY ON A NON-ROTATED, UNSTRETCHED GRID
!***********************************************************************

!**** *AER_CLIST - STRATOSPHERIC BACKGROUND AEROSOLS
!                  ADAPTED FROM *RADACT*

!     PURPOSE.
!     --------

!**   INTERFACE.
!     ----------
!        CALL *AER_CLIST* FROM *CALLPAR*

!        EXPLICIT ARGUMENTS :
!        --------------------
!     ==== INPUTS ===
!     ==== OUTPUTS ===

!        IMPLICIT ARGUMENTS :   NONE
!        --------------------

!     METHOD.
!     -------

!     EXTERNALS.
!     ----------

!          NONE

!     REFERENCE.
!     ----------

!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S"

!     AUTHOR.
!     -------
!     J.-J. MORCRETTE  E.C.M.W.F.    20/04/2005

!     MODIFICATIONS.
!     --------------
!     J.-J. MORCRETTE  E.C.M.W.F.    93/03/15   OPERATIONAL CLIMATOLOGY
!     JJMorcrette 98-12-21 GISS volcanic aerosol climatology
!     JJMorcrette 99-09    monthly climatology of tropospheric aerosols
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!-----------------------------------------------------------------------

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

USE YOMCST   , ONLY :         RPI
USE YOEAERD  , ONLY : RCVOBGA, RCTRPT  
USE YOEAERSRC ,ONLY : NTYPAER
USE YOERAD   , ONLY : LHVOLCA
USE YOEAERC  , ONLY : RTAEVO  
USE YOMDIM   , ONLY : NFLEVG
USE YOMGEM   , ONLY : VBH      ,VAH      ,VP00

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KAERO
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRS(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSIN(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLON(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLON(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTH(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PAERCLIS(KLON,KLEV,2) 
!     -----------------------------------------------------------------

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

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

!*       0.2   LOCAL ARRAYS.
!              -------------

INTEGER(KIND=JPIM) :: IRINT, ISHIFT, ICF 

REAL(KIND=JPRB) :: ZAERVO(KLON)

REAL(KIND=JPRB) :: ZAETRN(KLON),ZAETRO(KLON)
REAL(KIND=JPRB) :: ZSTRDEP(KLON)
REAL(KIND=JPRB) :: ZAER1(KLON,KLEV), ZAER2(KLON,KLEV)
!REAL(KIND=JPRB) :: ZAER3(KLON,KLEV), ZAER4(KLON,KLEV), ZAER5(KLON,KLEV), ZAER6(KLON,KLEV)   

REAL(KIND=JPRB) :: ZDPN(KLON)  , ZDPO(KLON)
REAL(KIND=JPRB) :: ZGRTH(KLON)

REAL(KIND=JPRB) :: ZSILAT(KLON), ZSINR(46)    , ZGELAM(KLON)

INTEGER(KIND=JPIM) :: INLA, &
 & JK, JL, JLR, &
 & I_NLATR, IAER 

REAL(KIND=JPRB) :: ZAETR, ZDPNMO, ZGRIDR, ZLATR, &
 & ZSIN 
REAL(KIND=JPRB) :: ZCLO, ZSLO, ZEPSAER

!-- security related quantities
REAL(KIND=JPRB) :: ZEPSBGA, ZCTRBGA, ZCSTBGA
REAL(KIND=JPRB) :: ZETAC(KLEV)    , ZETAHC(0:KLEV)    , ZDPRC(KLEV)
REAL(KIND=JPRB) :: ZPRES(KLEV)    , ZPRESH(0:KLEV)    , ZEPSBG(KLEV)

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
!#include "legtri.intfb.h"
#include "gppre.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('AER_CLIST',0,ZHOOK_HANDLE)

!*         0.     SECURITY BACKGROUND AEROSOLS

ZEPSBGA=0.001_JPRB/101325._JPRB
ZCTRBGA=0.03_JPRB/(101325._JPRB-19330._JPRB)
ZCSTBGA=0.045_JPRB/19330._JPRB
ZPRESH(KLEV)=VP00

CALL GPPRE ( 1, 1, 1, NFLEVG, VAH, VBH, ZPRESH, ZPRES )

DO JK=0,KLEV
  ZETAHC(JK)=ZPRESH(JK)/ZPRESH(KLEV)
ENDDO
DO JK=1,KLEV
  ZETAC(JK)=ZPRES(JK)/ZPRESH(KLEV)
  ZDPRC(JK)=ZPRES(JK)-ZPRES(JK-1)
  ZEPSBG(JK)=ZDPRC(JK)*ZEPSBGA
ENDDO
DO JL=KIDIA,KFDIA
 ZCLO=PCLON(JL)
 ZSLO=PSLON(JL)
 ZGELAM(JL) = SIGN(1.0_JPRB,ZCLO) * ASIN(ZSLO) - RPI *&
       & ( MIN(SIGN(1.0_JPRB,ZCLO),0.0_JPRB) + MIN(SIGN(2.0_JPRB,ZSLO),0.0_JPRB)&
       & +MIN(SIGN(1.0_JPRB,ZCLO),0.0_JPRB) * MIN(SIGN(2.0_JPRB,ZSLO),0.0_JPRB) )  
ENDDO

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

!*         1.     "NEW AEROSOL DISTRIBUTION" PARAMETERS COMPUTATIONS
!                 --------------------------------------------------

!*         1.1    VOLCANIC AEROSOL DISTRIBUTION PARAMETERS
!                 ----------------------------------------

!                 GISS CLIMATOLOGY, APPLIED TO SULPHATE AEROSOLS
!                 ----------------------------------------------

IRINT=1
ISHIFT=0
ICF=0

IF (LHVOLCA) THEN
  I_NLATR=46
  ZGRIDR=180._JPRB/(I_NLATR-1)
  DO JLR=1,I_NLATR
    ZLATR=90._JPRB-(JLR-1)*ZGRIDR
    ZSINR(JLR)=SIN(ZLATR*RPI/180._JPRB)
  ENDDO

  DO JL=KIDIA,KFDIA
    INLA=0
    ZSILAT(JL)=-9999._JPRB
    ZSIN=PSIN(JL)
    DO JLR=1,I_NLATR-1
      IF (ZSIN <= ZSINR(JLR) .AND. ZSIN > ZSINR(JLR+1)) THEN
        INLA=JLR
        ZSILAT(JL)=(ZSIN-ZSINR(INLA))/(ZSINR(INLA+1)-ZSINR(INLA))
        ZAERVO(JL)=RTAEVO(INLA)+ZSILAT(JL)*(RTAEVO(INLA+1)-RTAEVO(INLA))
      ENDIF
    ENDDO
    IF (ZSIN <= ZSINR(I_NLATR-1) .AND. ZSIN >= ZSINR(I_NLATR))THEN
      INLA=I_NLATR
      ZSILAT(JL)=(ZSIN-ZSINR(INLA-1))/(ZSINR(INLA)-ZSINR(INLA-1))
      ZAERVO(JL)=RTAEVO(INLA-1)&
       & +ZSILAT(JL)*(RTAEVO(INLA)-RTAEVO(INLA-1))  
    ENDIF
    IF (INLA == 0) THEN
      CALL ABOR1(' Problem with lat. interpolation in radact!')
    ENDIF
    ZDPO(JL)=PAPRS(JL,1)
    ZAETRO(JL)=1.0_JPRB
    ZSTRDEP(JL)=0.0_JPRB
  ENDDO

!-- define how thick the stratosphere is in pressure units
  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      ZDPN(JL)=PAPRS(JL,JK+1)
      IF (0.5_JPRB*(PAPRS(JL,JK)+PAPRS(JL,JK+1)) < 999._JPRB) THEN
! for models with top above 10hPa
        ZAETRN(JL)=1.0_JPRB
        ZAETRO(JL)=1.0_JPRB
      ELSE
        ZAETRN(JL)=ZAETRO(JL)*(MIN(1.0_JPRB,PTH(JL,JK)/PTH(JL,JK+1)))**RCTRPT
      ENDIF
      ZAETR=SQRT(ZAETRN(JL)*ZAETRO(JL))
      ZDPNMO=ZDPN(JL)-ZDPO(JL)
      ZSTRDEP(JL)=ZSTRDEP(JL)+ZAETR*ZDPNMO
    ENDDO
    DO JL=KIDIA,KFDIA
      ZDPO(JL)  =ZDPN(JL)
      ZAETRO(JL)=ZAETRN(JL)
    ENDDO
  ENDDO
!--
  DO JL=KIDIA,KFDIA
    ZAERVO(JL)=ZAERVO(JL)/ZSTRDEP(JL)
  ENDDO

!                 TANRE ET AL. CLIMATOLOGY 
!                 ------------------------

ELSE
  DO JL=KIDIA,KFDIA
    ZAERVO(JL)=ZCSTBGA
  ENDDO
ENDIF

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

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

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

!*       4.      VERTICAL DISTRIBUTION
!*               ---------------------

DO JL=KIDIA,KFDIA
  ZDPO(JL)=PAPRS (JL,1)
  ZAETRO(JL)=1.0_JPRB
ENDDO

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    PAERCLIS(JL,JK,1) = 0._JPRB
    PAERCLIS(JL,JK,2) = 0._JPRB
    ZGRTH(JL)= PTH(JL,JK)/PTH(JL,JK+1)
    ZDPN(JL)=PAPRS (JL,JK+1)

    IF (0.5_JPRB*(PAPRS(JL,JK)+PAPRS(JL,JK+1)) < 999._JPRB) THEN
! for models with top above 10hPa
      ZAETRN(JL)=1.0_JPRB
      ZAETRO(JL)=1.0_JPRB
      ZEPSAER=ZEPSBG(JK)
    ELSE
      ZAETRN(JL)=ZAETRO(JL)*(MIN(1.0_JPRB, ZGRTH(JL) ))**RCTRPT
      ZEPSAER=1.E-10_JPRB
      ZEPSAER=ZEPSBG(JK)
    ENDIF

    ZAETR=SQRT  (ZAETRN(JL)*ZAETRO(JL))
    ZDPNMO    =ZDPN(JL)-ZDPO(JL)
! stratospheric sulphate aerosols
    ZAER1(JL,JK)=   ZAETR * ZAERVO(JL)*ZDPNMO
! time variation applied to volcanic sulphate aerosols only - ash is background value
    ZAER2(JL,JK)=   ZAETR * RCVOBGA * ZDPNMO
  ENDDO
  DO JL=KIDIA,KFDIA
    ZDPO(JL)  =ZDPN(JL)
    ZAETRO(JL)=ZAETRN(JL)
  ENDDO
  
!-- filling up the output arrays with the climatological optical thicknesses
  IAER=0
  IF (NTYPAER(7) /= 0) THEN
! stratospheric background
    IAER=IAER+1
    DO JL=KIDIA,KFDIA
      PAERCLIS(JL,JK,1)=MAX(ZEPSAER, ZAER1(JL,JK))
    ENDDO
  ENDIF
  IF (NTYPAER(8) /= 0) THEN
!old-type volcanic aerosols 
    IAER=IAER+1
    DO JL=KIDIA,KFDIA
      PAERCLIS(JL,JK,2)=MAX(ZEPSAER, ZAER2(JL,JK))
    ENDDO
  ENDIF

ENDDO

!-- transform the optical thickness in mass mixing ratio

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
  ENDDO
ENDDO

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

IF (LHOOK) CALL DR_HOOK('AER_CLIST',1,ZHOOK_HANDLE)
END SUBROUTINE AER_CLIST

