!  Differentiation of rt6s_gems in forward (tangent) mode:
!   variations  of output variables: preflet
!   with respect to input variables: ptaer_vertin phasel_in piz_in

SUBROUTINE RT6S_GEMS_TL(pdiffang, psolang, pvieang, pwl, phasel_in, &
&  phasel_ind, piz_in, piz_ind, ptray550_vertin, ptaer_vertin, &
&  ptaer_vertind, proc, preflet, prefletd)


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

USE rt6svalues

  IMPLICIT NONE
!****RT6S_GEMS*** MAIN CALLING ROUTINE OF THE RADIATIVE TRANSFER CODE

!  THIS CORRESPONDS TO A MODIFIED VERSION OF THE 6S RADIATIVE TRANSFER 
! MODEL DEVELLOPED AT LOA. FEATURES SUCH AS AIRPLANE MEASUREMENTS, MULTIPLE CHOICE 
! IN  THE AEROSOL MODELS, ATMOSPHERIC CONDITIONS, SURFACE MODEL FOR THE COMPUTING OF 
! SURFACE REFLECTANCE ARE ELIMINATED. THE MODEL IS ADAPTED IN ORDER TO FIT THE NEEDS
! OF GEMS PROJECT, THIS IS TO COMPUTE THE REFLECTANCE AT MULTIPLE WAVELENGTH (KWL)
! FOR A SINGLE AEROSOL MODEL WITH A GIVEN VERTICAL DISTRIBUTION.

!     INTERFACE
!     ---------
!           RT6S_GEMS IS CALLED BY ECMWF MODEL

!     INPUTS
!     ------
! PDIFFANG(KLON)    : DIFFERENCE IN AZIMUTAL ANGLE [RAD]
! PSOLANG(KLON)     : COSINE OF SOLAR ZENITH ANGLE
! PVIEANG(KLON)     : COSINE OF VIEWING ZENITH ANGLE
! PWL(KWL)                     : Wavelengths at which the calculations are done (m).
! PTRAY550_VERTIN(KLON,KLEV)   : Molecular optical thickness profile at 0.55e-6 m.
! PTAER_VERTIN(KLON,KLEV,KWL)  : Aerosol optical thickness profile.
! PHASEL_IN(KLON,KLEV,KWL,KMU) : Aerosol phase function profile.
! PIZ_IN(KLON,KLEV,KWL)        : Aerosol single scattering albedo profile.
! PROC(KLON,KWL)               : TARGET SURFACE REFLECTANCE

!     OUTPUTS
!     -------
! REFLET(KLON,KWL) = APPARENT REFLECTANCE AT KWL WAVELENGTH

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

!     MODIFICATIONS.
!     -------------
!          N.HUNEEUS 02.05.2007

!     SOURCE
!     ------
! ADAPTED FROM MAIN CALLING ROUTINE IN ORIGINAL 6S CODE, SEE VERMOTE ET AL. (1997)

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

  REAL(KIND=JPRB), INTENT(IN) :: pwl(kwl), pdiffang(klon), psolang(klon&
&  ), pvieang(klon)
  REAL(KIND=JPRB), INTENT(IN) :: ptray550_vertin(klon, 0:klev), &
&  ptaer_vertin(klon, 0:klev, kwl)
  REAL(KIND=JPRB), INTENT(IN) :: ptaer_vertind(klon, 0:klev, kwl)
  REAL(KIND=JPRB), INTENT(IN) :: phasel_in(klon, 0:klev, kwl, knbmu), &
&  piz_in(klon, 0:klev, kwl)
  REAL(KIND=JPRB), INTENT(IN) :: phasel_ind(klon, 0:klev, kwl, knbmu), &
&  piz_ind(klon, 0:klev, kwl)
  REAL(KIND=JPRB), INTENT(IN) :: proc(klon, kwl)
  REAL(KIND=JPRB), INTENT(OUT) :: preflet(klon, kwl)
  REAL(KIND=JPRB), INTENT(OUT) :: prefletd(klon, kwl)
! LOCAL VARIABLES
! ---------------
!INTEGER(KIND=JPIM),PARAMETER  :: KMU=25, KMU2=48, KNP=49, KNANG=80, KNBMU=83, KNT=20
!INTEGER(KIND=JPIM),PARAMETER  :: KWL =1 !!!!!! This value is totally invented. CHECK WITH NICOLAS.
!INTEGER(KIND=JPIM),PARAMETER  :: KLON =1, KLEV = 60 
  INTEGER(KIND=JPIM) :: jlev, jwl, jlon, jnbmu
!GAUSS WHEIGHTS AND ANGLES
  REAL(KIND=JPRB) :: zrp(knp), zgp(knp)
  REAL(KIND=JPRB) :: zrmu(knbmu), zga(knbmu)
  REAL(KIND=JPRB) :: zrm(-kmu:kmu), zgb(-kmu:kmu)
  REAL(KIND=JPRB) :: zrmd(-kmu:kmu)
  REAL(KIND=JPRB) :: zrm_aux(klon, -kmu:kmu)
! VERTICAL DISCRETIZATION                                  
  REAL(KIND=JPRB) :: ztaer_vert(klon, 0:knt, kwl), ztray_vert(klon, 0:&
&  knt, kwl)
  REAL(KIND=JPRB) :: ztaer_vertd(klon, 0:knt, kwl)
  REAL(KIND=JPRB) :: zphasel(klon, 0:knt, kwl, knbmu), zpiz(klon, 0:knt, &
&  kwl)
  REAL(KIND=JPRB) :: zphaseld(klon, 0:knt, kwl, knbmu), zpizd(klon, 0:knt&
&  , kwl)
! DISCOM VARIABLES
  REAL(KIND=JPRB) :: zphirad, z_pxmus, zxmuv
  REAL(KIND=JPRB) :: ztaer(0:knt), z_ptray(0:knt), z_pomega(0:knt), zphasef(&
&  0:knt, knbmu)
  REAL(KIND=JPRB) :: ztaerd(0:knt), z_ptrayd(0:knt), zomegad(0:knt), &
&  zphasefd(0:knt, knbmu)
  REAL(KIND=JPRB) :: zroatm, zdtdir, zdtdif, zutdir, zutdif, zsphal
  REAL(KIND=JPRB) :: zroatmd, zdtdird, zdtdifd, zutdird, zutdifd, &
&  zsphald
  REAL(KIND=JPRB) :: zpl(knbmu, -1:knang+1),zaux1, zaux2
! KERNEL VARIABLE
  REAL(KIND=JPRB) :: zpsl(0:knang, -1:knang, -kmu:kmu)
  REAL(KIND=JPRB) :: zpsld(0:knang, -1:knang, -kmu:kmu)
  REAL(KIND=JPRB) :: zpsl_aux(klon, 0:knang, -1:knang, -kmu:kmu)
! SURFACE REFLECTANCE
  REAL(KIND=JPRB) :: zsurfref
  REAL(KIND=JPRB) :: zsurfrefd
  INTRINSIC COS

  REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "discom_gems_tl.intfb.h"
#include "pre_calc.intfb.h"
#include "vertdisc_tl.intfb.h"

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

  prefletd(:, :) = 0.0_JPRB
  preflet(:, :) = 0.0_JPRB

! CALCULATION OF GAUSS WEIGHTS AND ANGLES
! ---------------------------------------

  CALL PRE_CALC(pvieang, psolang, zrp, zgp, zrm_aux, zgb, zrmu, zga, zpl, &
&           zpsl_aux)

! CONVERTING VERTICAL DISCRETIZATION INTO ONE WITH ISO-OD LAYERS
! --------------------------------------------------------------

  CALL VERTDISC_TL(pwl, ptray550_vertin, ptaer_vertin, ptaer_vertind, &
&            phasel_in, phasel_ind, piz_in, piz_ind, ztaer_vert, &
&            ztaer_vertd, ztray_vert, zphasel, zphaseld, zpiz, zpizd)

  zaux1 = 0.0_JPRB
  zaux2 = 0.0_JPRB
  DO jlev=0,knt
    zaux1 = zaux1 + ztaer_vert(1, jlev, 1)
    zaux2 = zaux2 + ztray_vert(1, jlev, 1)
  ENDDO
  prefletd(1:klon, 1:kwl) = 0._JPRB
  zomegad(0:knt) = 0._JPRB
  ztaerd(0:knt) = 0._JPRB
  zphasefd(0:knt, 1:knbmu) = 0._JPRB

! TRUNCATION OF THE PHASE FUNCTION
! --------------------------------

  DO jlon=1,klon
    zphirad = pdiffang(jlon)
    z_pxmus = COS(psolang(jlon)*zpi/180._JPRB)
    zxmuv = COS(pvieang(jlon)*zpi/180._JPRB)
    zrmd(:) = 0._JPRB
    zrm(:) = zrm_aux(jlon, :)
    zpsld(:, :, :) = 0._JPRB
    zpsl(:, :, :) = zpsl_aux(jlon, :, :, :)
    DO jwl=1,kwl

! ONLY THE VERTICAL IS PASSED FROM NOW ON
! ---------------------------------------

      DO jlev=0,knt
        ztaerd(jlev) = ztaer_vertd(jlon, jlev, jwl)
        ztaer(jlev) = ztaer_vert(jlon, jlev, jwl)
        z_ptrayd(jlev) = 0._JPRB
        z_ptray(jlev) = ztray_vert(jlon, jlev, jwl)
        zomegad(jlev) = zpizd(jlon, jlev, jwl)
        z_pomega(jlev) = zpiz(jlon, jlev, jwl)
        DO jnbmu=1,knbmu
          zphasefd(jlev, jnbmu) = zphaseld(jlon, jlev, jwl, jnbmu)
          zphasef(jlev, jnbmu) = zphasel(jlon, jlev, jwl, jnbmu)
        ENDDO
      ENDDO

!****************************************************************************************************
!                   COMPUTATION OF ATMOSPHERIC REFLECTANCE AND TRANSMITTANCE
!                   --------------------------------------------------------
!****************************************************************************************************

      CALL DISCOM_GEMS_TL(zphirad, z_pxmus, zxmuv, zrm, zgb, zrp, zrmu, zga,&
&                   ztaer, ztaerd, z_ptray, z_pomega, zomegad, zphasef, &
&                   zphasefd, zpl, zpsl, zroatm, zroatmd, zdtdir, zdtdird,&
&                   zdtdif, zdtdifd, zutdir, zutdird, zutdif, zutdifd,&
&                   zsphal, zsphald)

!****************************************************************************************************
!                           COMPUTATION OF THE SURFACE REFLECTANCE
!                           --------------------------------------
!****************************************************************************************************

      zsurfrefd = (proc(jlon, jwl)*((zdtdird+zdtdifd)*(zutdir+zutdif)+(&
&        zdtdir+zdtdif)*(zutdird+zutdifd))*(1.-proc(jlon, jwl)*zsphal)+&
&        proc(jlon, jwl)**2*(zdtdir+zdtdif)*(zutdir+zutdif)*zsphald)/(1.&
&        -proc(jlon, jwl)*zsphal)**2
      zsurfref = proc(jlon, jwl)*(zdtdir+zdtdif)*(zutdir+zutdif)/(1.-&
&        proc(jlon, jwl)*zsphal)

!****************************************************************************************************
!                               FINAL CALCULATION OF REFLECTANCE
!                               --------------------------------
!****************************************************************************************************

      prefletd(jlon, jwl) = zroatmd + zsurfrefd
      preflet(jlon, jwl) = zroatm + zsurfref

    ENDDO
  ENDDO
! LOOP ON WAVELENGTH
! LOOP ON KLON

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