!  Differentiation of os_gems in forward (tangent) mode:
!   variations  of output variables: pxl
!   with respect to input variables: pizmoy pbetal ptamoy

SUBROUTINE OS_GEMS_TL(ptamoy, ptamoyd, ptray, pizmoy, pizmoyd, phirad, &
&  pbetal, pbetald, prm, pgb, prp, ppsl, ptodaer, ptodray, pxl, pxld)

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

USE rt6svalues

  IMPLICIT NONE
!  IF ((Z <= 0.001_JPRB).OR.(JPLEG >= IPLEG)) THEN
!    EXIT
!  ENDIF
!  JPLEG=JPLEG+1
!****OS*** COMPUTES ATMOSPHERIC INTRINSIC REFLECTANCE


!     INTERFACE
!     ---------
! OS IS CALLED BY ATMREF

!     INPUTS
!     ------

! PHIRAD              : DIFFERENCE IN AZIMUTAL ANGLE [RAD]
! PRP(KNP)            : GAUSSIAN ANGLES FOR AZIMUTH
! PRM(-KMU:KMU)       : GAUSSIAN ANGLES FOR THE ZENITH
! PGB(-KMU:KMU)       : GAUSSIAN WEIGHTS FOR THE ZENITH
! PTAMOY(KNT)         : TRUNCATED AEROSOL OPTICAL THICKNESS PROFILE.
! PTRAY(KNT)          : MOLECULAR OPTICAL THICKNESS PROFILE.
! PIZMOY(KNT)         : TRUNCATED AEROSOL SINGLE SCATTERING ALBEDO PROFILE.
! PBETAL(KNT,KNANG+1) : COEFFICIENTS OF LEGENDRE POLYNOM
! PPSL(0:KNANG,-1:KNANG,-KMU:KMU)
! PTODAER               : TOTAL AEROSOL OPTICAL THICKNESS
! PTODRAY               : TOTAL MOLECULAR OPTICAL THICKNESS

!     OUTPUTS
!     -------

! PXL(-KMU:KMU,KNP) : ATMOSPHERIC REFLECTANCE OF MIXTURE

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

!     MODIFICATIONS.
!     -------------

!     SOURCE
!     ------
! ADAPTED FROM OS.f FROM ORIGINAL 6S CODE, SEE VERMOTTE ET AL. (1997)

!     REMARKS
!     -------
! KNT=0 CORRESPONDS TO TOP OF THE ATMOSPHERE
! VARIABLES WITH DIMENSION FROM -KMU TO KMU, THE ELEMENTES CORRESPONDING TO NEGATIVE 
! INDEX CORRESPOND TO THE DOWNWARD DIRECTION AND WITH POSITIVE INDEX TO THE UPWARD
! DIRECTION. EXCEPT FOR THE ELEMENTS WITH INDEX -KMU, KMU AND 0. ELEMENTS WITH THE 
! INDEX -KMU & KMU CORRESPOND TO THE SATELLITE CASE. THEY SHOULD HAVE THE SAME VALUE 
!--------------------------------------------------------------------------------------
! DIFFERENCE IN AZIMUTAL ANGLE [RAD]
  REAL(KIND=JPRB), INTENT(IN) :: phirad
! GAUSSIAN ANGLES FOR AZIMUTH
  REAL(KIND=JPRB), INTENT(IN) :: prp(knp)
! GAUSSIAN ANGLES FOR THE ZENITH
  REAL(KIND=JPRB), INTENT(IN) :: prm(-kmu:kmu)
! GAUSSIAN WEIGHTS FOR THE ZENITH
  REAL(KIND=JPRB), INTENT(IN) :: pgb(-kmu:kmu)
! TRUNCATED AEROSOL OPTICAL THICKNESS PROFILE.
  REAL(KIND=JPRB), INTENT(IN) :: ptamoy(0:knt)
  REAL(KIND=JPRB), INTENT(IN) :: ptamoyd(0:knt)
! MOLECULAR OPTICAL THICKNESS PROFILE.
  REAL(KIND=JPRB), INTENT(IN) :: ptray(0:knt)
! TRUNCATED AEROSOL SINGLE SCATTERING ALBEDO PROFILE.
  REAL(KIND=JPRB), INTENT(IN) :: pizmoy(0:knt)
  REAL(KIND=JPRB), INTENT(IN) :: pizmoyd(0:knt)
  REAL(KIND=JPRB), INTENT(IN) :: pbetal(0:knt, 0:knang), ptodaer, &
&  ptodray
  REAL(KIND=JPRB), INTENT(IN) :: pbetald(0:knt, 0:knang)
  REAL(KIND=JPRB), INTENT(IN) :: ppsl(0:knang, -1:knang, -kmu:kmu)
  REAL(KIND=JPRB), INTENT(OUT) :: pxl(-kmu:kmu, knp)
  REAL(KIND=JPRB), INTENT(OUT) :: pxld(-kmu:kmu, knp)

! LOCAL VARIABLES
! ---------------
!INTEGER(KIND=JPIM),PARAMETER  :: KMU=25, KMU2=48, KNP=49, KNANG=80, KNBMU=83, KNT=20
  INTEGER(KIND=JPIM) :: jlev, jpleg, jmu, ipleg, jmu2, jmum1, ig, jnp, j
  REAL(KIND=JPRB) :: zh(0:knt), zch(0:knt), zydel(0:knt), zxdel(0:knt)
  REAL(KIND=JPRB) :: zhd(0:knt), zchd(0:knt), zydeld(0:knt), zxdeld(0:&
&  knt)
  REAL(KIND=JPRB) :: zxmus, zaaa, zron, zbeta0, zbeta2
! AEROSOL PHASE FUNCTION
  REAL(KIND=JPRB) :: zsa2(0:knt)
  REAL(KIND=JPRB) :: zsa2d(0:knt)
  REAL(KIND=JPRB) :: zi1(0:knt, -kmu:kmu), zi2(0:knt, -kmu:kmu)
  REAL(KIND=JPRB) :: zi1d(0:knt, -kmu:kmu), zi2d(0:knt, -kmu:kmu)
  REAL(KIND=JPRB) :: zi3(-kmu:kmu), zi4(-kmu:kmu)
  REAL(KIND=JPRB) :: zi3d(-kmu:kmu)
  REAL(KIND=JPRB) :: zinm1(-kmu:kmu), zinm2(-kmu:kmu)
  REAL(KIND=JPRB) :: zinm1d(-kmu:kmu)
  REAL(KIND=JPRB) :: zin(-kmu:kmu)
  REAL(KIND=JPRB) :: zind(-kmu:kmu)
  REAL(KIND=JPRB) :: zii1, zii2, zbpjk, zbpjmk, zxi1, zxi2, zxdb
  REAL(KIND=JPRB) :: zii1d, zii2d, zbpjkd, zbpjmkd, zxi1d, zxi2d, zxdbd
  REAL(KIND=JPRB) :: zspl, z, zx, zxx, zsa1, zxpk, zy, zyy
  REAL(KIND=JPRB) :: zxd, zxxd, zyd
  REAL(KIND=JPRB) :: za1, zd1, zg1, zy1, z_delta0s, za, zb, zc, zd, zf, &
&  zzi1
  REAL(KIND=JPRB) :: zd1d, zg1d, zy1d, zad, zbd, zcd, zdd, zfd, zzi1d
  REAL(KIND=JPRB) :: zypk, zxpj, zphi, zro, zro0, zro1, zro2, zaux&
&  , zaux2
  REAL(KIND=JPRB) :: zauxd
! OUTPUT OF KERNEL
  REAL(KIND=JPRB) :: z_pxpl(-kmu:kmu)
  REAL(KIND=JPRB) :: z_pbp(0:knt, 0:kmu, -kmu:kmu)
  REAL(KIND=JPRB) :: z_pbpd(0:knt, 0:kmu, -kmu:kmu)

  REAL(KIND=JPRB) :: z_aux_aer, z_aux_ray
  REAL(KIND=JPRB) :: z_arg1
  INTRINSIC COS
  INTRINSIC EXP
  INTRINSIC MAX
  INTRINSIC abs
  INTRINSIC DBLE
  REAL(KIND=JPRB) :: z_abs7
  REAL(KIND=JPRB) :: z_abs6
  REAL(KIND=JPRB) :: z_abs5
  REAL(KIND=JPRB) :: z_abs4
  REAL(KIND=JPRB) :: z_abs3
  REAL(KIND=JPRB) :: z_abs2
  REAL(KIND=JPRB) :: z_abs1

  REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "kernel_pbp_tl.intfb.h"

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

! VARIABLE INITIALIZATION 
  zind(:) = 0._JPRB
  zin(:) = 0.0_JPRB
  zi4(:) = 0.0_JPRB
  zi3(:) = 0.0_JPRB
  zi1d(:, :) = 0._JPRB
  zi1(:, :) = 0.0_JPRB
  zi2d(:, :) = 0._JPRB
  zi2(:, :) = 0.0_JPRB
  zinm1d(:) = 0._JPRB
  zinm1(:) = 0.0_JPRB
  zinm2(:) = 0.0_JPRB
  pxld(:, :) = 0._JPRB
  pxl(:, :) = 0.0_JPRB
  zxmus = -prm(0)

! COMPUTATION OF TRANSMISSION (CH), TOTAL OPTICAL THICKNESS (ZH) AND PROFILE OF SINGLE
! SCATTERING ALBEDO OF MOLECULES (YDEL) AND AEROSOLS (XDEL) FOR THREE CASES

! CASE 1: PURE RAYLEIGH
! -------

  IF (ptodaer  <=  accu2 .AND. ptodray  >   ptodaer) THEN
    zaux = 0.0_JPRB
! JLEV=0 CORRESPONDS TO TOP OF THE ATMOSPHERE
    DO jlev=0,knt
      zaux = zaux + ptray(jlev)
      zhd(jlev) = 0._JPRB
      zh(jlev) = zaux
      zchd(jlev) = 0._JPRB
      zch(jlev) = EXP(-(zh(jlev)/zxmus))/2.0_JPRB
      zydeld(jlev) = 0._JPRB
      zydel(jlev) = 1.0_JPRB
      zxdeld(jlev) = 0._JPRB
      zxdel(jlev) = 0.0_JPRB
    ENDDO
  ENDIF

! CASE 2: PURE AEROSOL
! -------

  IF (ptodray  <=  accu2 .AND. ptodaer  >   ptodray) THEN
    zaux = 0.0_JPRB
    zchd(0:knt) = 0._JPRB
    zxdeld(0:knt) = 0._JPRB
    zauxd = 0._JPRB
    zhd(0:knt) = 0._JPRB
    DO jlev=0,knt
      zauxd = zauxd + ptamoyd(jlev)
      zaux = zaux + ptamoy(jlev)
      zhd(jlev) = zauxd
      zh(jlev) = zaux
      zchd(jlev) = (-(zhd(jlev)*EXP(-(zh(jlev)/zxmus))/zxmus))/2.0_JPRB
      zch(jlev) = EXP(-(zh(jlev)/zxmus))/2.0_JPRB
      zydeld(jlev) = 0._JPRB
      zydel(jlev) = 0.0_JPRB
      zxdeld(jlev) = pizmoyd(jlev)
      zxdel(jlev) = pizmoy(jlev)
    ENDDO
  ELSE
    zchd(0:knt) = 0._JPRB
    zxdeld(0:knt) = 0._JPRB
    zhd(0:knt) = 0._JPRB
  ENDIF

! CASE 3: MIXTURE
! -------

  IF (ptodray  >   accu2 .AND. ptodaer  >   accu2) THEN
    zaux = 0.0_JPRB
    z_aux_aer = 0.0_JPRB
    z_aux_ray = 0.0_JPRB
    zydeld(0:knt) = 0._JPRB
    zauxd = 0._JPRB
    DO jlev=0,knt
      zauxd = zauxd + ptamoyd(jlev)
      zaux = zaux + ptamoy(jlev) + ptray(jlev)
      z_aux_aer = z_aux_aer + ptamoy(jlev)
      z_aux_ray = z_aux_ray + ptray(jlev)
      zhd(jlev) = zauxd
      zh(jlev) = zaux
      zchd(jlev) = (-(zhd(jlev)*EXP(-(zh(jlev)/zxmus))/zxmus))/2.0_JPRB
      zch(jlev) = EXP(-(zh(jlev)/zxmus))/2.0_JPRB
      zxdeld(jlev) = ((pizmoyd(jlev)*ptamoy(jlev)+pizmoy(jlev)*ptamoyd(&
&        jlev))*(ptamoy(jlev)+ptray(jlev))-pizmoy(jlev)*ptamoy(jlev)*&
&        ptamoyd(jlev))/(ptamoy(jlev)+ptray(jlev))**2
      zxdel(jlev) = pizmoy(jlev)*ptamoy(jlev)/(ptamoy(jlev)+ptray(jlev))
      zydeld(jlev) = -(ptray(jlev)*ptamoyd(jlev)/(ptamoy(jlev)+ptray(&
&        jlev))**2)
      zydel(jlev) = ptray(jlev)/(ptamoy(jlev)+ptray(jlev))
    ENDDO
  ELSE
    zydeld(0:knt) = 0._JPRB
  ENDIF

! INCIDENT ANGLE MU_S

  zaaa = delta/(2.0_JPRB-delta)
  zron = (1.0_JPRB-zaaa)/(1.0_JPRB+2.0_JPRB*zaaa)

! RAYLEIGH PHASE FUNCTION

  zbeta0 = 1.0_JPRB
  zbeta2 = 0.5_JPRB*zron
  IF (zxmus - 1.0_JPRB  >=  0.) THEN
    z_abs1 = zxmus - 1.0_JPRB
  ELSE
    z_abs1 = -(zxmus-1.0_JPRB)
  ENDIF

! FOURIER DECOMPOSITION

  IF (z_abs1  <   accu3) THEN
    ipleg = 0
  ELSE
    ipleg = knang
  ENDIF
  jpleg = 0
  pxld(-kmu:kmu, 1:knp) = 0._JPRB
  zind(-kmu:kmu) = 0._JPRB
  zi1d(0:knt, -kmu:kmu) = 0._JPRB
  zi2d(0:knt, -kmu:kmu) = 0._JPRB
  zinm1d(-kmu:kmu) = 0._JPRB
  zsa2d(0:knt) = 0._JPRB
! LOOP ON S, TERM IN THE FOURIER SERIES
  DO jpleg=0,nfour

! PRIMARY SCATTERING

    zro2 = 0.0_JPRB
    zro1 = 0.0_JPRB
    zro0 = 0.0_JPRB
    zro = 0.0_JPRB
    zi3d(:) = 0._JPRB
    zi3(:) = 0.0_JPRB

! KERNEL COMPUTATIONS

    CALL KERNEL_PBP_TL(jpleg, ppsl, pbetal, pbetald, z_pxpl, z_pbp, z_pbpd)
    IF (jpleg  >   0) zbeta0 = 0.0_JPRB
    DO jmu=-kmu,kmu
      IF (jpleg - 2  <=  0) THEN
        zspl = z_pxpl(0)
! RAYLEIGH PHASE FUNCTION
        zsa1 = zbeta0 + zbeta2*z_pxpl(jmu)*zspl
      ELSE
        zsa1 = 0.0_JPRB
      ENDIF
      DO jlev=0,knt
        zsa2d(jlev) = z_pbpd(jlev, 0, jmu)
        zsa2(jlev) = z_pbp(jlev, 0, jmu)
        zi2d(jlev, jmu) = zchd(jlev)*(zsa2(jlev)*zxdel(jlev)+zsa1*zydel(&
&          jlev)) + zch(jlev)*(zsa2d(jlev)*zxdel(jlev)+zsa2(jlev)*zxdeld&
&          (jlev)+zsa1*zydeld(jlev))
        zi2(jlev, jmu) = zch(jlev)*(zsa2(jlev)*zxdel(jlev)+zsa1*zydel(&
&          jlev))
      ENDDO
    ENDDO

! VERTICAL INTEGRATION, PRIMARY UPWARD RADIATION

    DO jmu=1,kmu
      zi1d(knt, jmu) = 0._JPRB
      zi1(knt, jmu) = 0.0_JPRB
      zzi1d = zi1d(knt, jmu)
      zzi1 = zi1(knt, jmu)
      zy = prm(jmu)
      DO jlev=knt-1,0,-1
        zfd = zhd(jlev+1) - zhd(jlev)
        zf = zh(jlev+1) - zh(jlev)
        zad = ((zi2d(jlev+1, jmu)-zi2d(jlev, jmu))*zf-(zi2(jlev+1, jmu)-&
&          zi2(jlev, jmu))*zfd)/zf**2
        za = (zi2(jlev+1, jmu)-zi2(jlev, jmu))/zf
        zbd = zi2d(jlev, jmu) - zad*zh(jlev) - za*zhd(jlev)
        zb = zi2(jlev, jmu) - za*zh(jlev)
        zcd = -(zfd*EXP(-(zf/zy))/zy)
        zc = EXP(-(zf/zy))
        zdd = -zcd
        zd = 1.0_JPRB - zc
        zxd = zhd(jlev) - zhd(jlev+1)*zc - zh(jlev+1)*zcd
        zx = zh(jlev) - zh(jlev+1)*zc
        zzi1d = zcd*zzi1 + zc*zzi1d + 0.5_JPRB*(zdd*(zb+za*zy)+zd*(zbd+zy*&
&          zad)+zad*zx+za*zxd)
        zzi1 = zc*zzi1 + (zd*(zb+za*zy)+za*zx)*0.5_JPRB
        zi1d(jlev, jmu) = zzi1d
        zi1(jlev, jmu) = zzi1
      ENDDO
    ENDDO

! VERTICAL INTEGRATION, PRIMARY DOWNWARD RADIATION

    DO jmu=-kmu,-1
      zi1d(0, jmu) = 0._JPRB
      zi1(0, jmu) = 0.0_JPRB
      zzi1d = zi1d(0, jmu)
      zzi1 = zi1(0, jmu)
      zy = prm(jmu)
      DO jlev=1,knt
        zfd = zhd(jlev) - zhd(jlev-1)
        zf = zh(jlev) - zh(jlev-1)
        zcd = zfd*EXP(zf/zy)/zy
        zc = EXP(zf/zy)
        zdd = -zcd
        zd = 1.0_JPRB - zc
        zad = ((zi2d(jlev, jmu)-zi2d(jlev-1, jmu))*zf-(zi2(jlev, jmu)-&
&          zi2(jlev-1, jmu))*zfd)/zf**2
        za = (zi2(jlev, jmu)-zi2(jlev-1, jmu))/zf
        zbd = zi2d(jlev, jmu) - zad*zh(jlev) - za*zhd(jlev)
        zb = zi2(jlev, jmu) - za*zh(jlev)
        zxd = zhd(jlev) - zhd(jlev-1)*zc - zh(jlev-1)*zcd
        zx = zh(jlev) - zh(jlev-1)*zc
        zzi1d = zcd*zzi1 + zc*zzi1d + 0.5_JPRB*(zdd*(zb+za*zy)+zd*(zbd+zy*&
&          zad)+zad*zx+za*zxd)
        zzi1 = zc*zzi1 + (zd*(zb+za*zy)+za*zx)*0.5_JPRB
        zi1d(jlev, jmu) = zzi1d
        zi1(jlev, jmu) = zzi1
      ENDDO
    ENDDO
    zi3d(-kmu:kmu) = 0._JPRB

! ZINM2 IS INITIALIZED WITH SCATTERING COMPUTED AT N-2
! I3 IS INITIALIZED WITH PRIMARY SCATTERING

    DO jmu=-kmu,-1
      zinm1d(jmu) = zi1d(knt, jmu)
      zinm1(jmu) = zi1(knt, jmu)
      zinm2(jmu) = zi1(knt, jmu)
      zi3d(jmu) = zi1d(knt, jmu)
      zi3(jmu) = zi1(knt, jmu)
    ENDDO
    DO jmu=1,kmu
      zinm1d(jmu) = zi1d(0, jmu)
      zinm1(jmu) = zi1(0, jmu)
      zinm2(jmu) = zi1(0, jmu)
      zi3d(jmu) = zi1d(0, jmu)
      zi3(jmu) = zi1(0, jmu)
    ENDDO
    zro2 = zi1(0, kmu)
    zro = zi1(0, kmu)

! LOOP ON SUCCESSIVE ORDER

! PRIMARY SCATTERING
    ig = 1
    DO ig=2,nord

! SUCCESSIVE ORDERS

! MULTIPLE SCATTERING SOURCE FUNCTION AT EVERY LEVEL WITHIN THE LAYER

! IF JPLEG <= 2 KERNELS ARE MIXING OF AEROSOLS AND MOLECULES
! IF JPLEG >  2 AEROSOL KERNEL ONLY

      IF (jpleg - 2  <=  0) THEN
        DO jmu=1,kmu
          zxpk = z_pxpl(jmu)
          zypk = z_pxpl(-jmu)
          DO jlev=0,knt
            zii1 = 0.0_JPRB
            zii2 = 0.0_JPRB
            zxd = zxdeld(jlev)
            zx = zxdel(jlev)
            zyd = zydeld(jlev)
            zy = zydel(jlev)
            zii1d = 0._JPRB
            zii2d = 0._JPRB
            DO jmu2=1,kmu
              zxpj = z_pxpl(jmu2)
              zaux2 = pgb(jmu2)
              zxi1d = zi1d(jlev, jmu2)
              zxi1 = zi1(jlev, jmu2)
              zxi2d = zi1d(jlev, -jmu2)
              zxi2 = zi1(jlev, -jmu2)
              zbpjkd = z_pbpd(jlev, jmu2, jmu)*zx + z_pbp(jlev, jmu2, jmu)*&
&                zxd + (zbeta0+zbeta2*zxpj*zxpk)*zyd
              zbpjk = z_pbp(jlev, jmu2, jmu)*zx + zy*(zbeta0+zbeta2*zxpj*&
&                zxpk)
              zbpjmkd = z_pbpd(jlev, jmu2, -jmu)*zx + z_pbp(jlev, jmu2, -jmu&
&                )*zxd + (zbeta0+zbeta2*zxpj*zypk)*zyd
              zbpjmk = z_pbp(jlev, jmu2, -jmu)*zx + zy*(zbeta0+zbeta2*zxpj&
&                *zypk)
              zxdbd = zaux2*(zxi1d*zbpjk+zxi1*zbpjkd+zxi2d*zbpjmk+zxi2*&
&                zbpjmkd)
              zxdb = zaux2*(zxi1*zbpjk+zxi2*zbpjmk)
              zii2d = zii2d + zxdbd
              zii2 = zii2 + zxdb
              zxdbd = zaux2*(zxi1d*zbpjmk+zxi1*zbpjmkd+zxi2d*zbpjk+zxi2*&
&                zbpjkd)
              zxdb = zaux2*(zxi1*zbpjmk+zxi2*zbpjk)
              zii1d = zii1d + zxdbd
              zii1 = zii1 + zxdb
            ENDDO
            zi2d(jlev, jmu) = zii2d
            zi2(jlev, jmu) = zii2
            zi2d(jlev, -jmu) = zii1d
            zi2(jlev, -jmu) = zii1
          ENDDO
        ENDDO
        WHERE (zi2(:, :)  <   zeps) 
          zi2d(:, :) = 0._JPRB
          zi2(:, :) = 0.0_JPRB
        ENDWHERE
      ELSEIF (jpleg - 2  >   0) THEN
        DO jmu=1,kmu
          DO jlev=0,knt
            zii1 = 0.0_JPRB
            zii2 = 0.0_JPRB
            zxd = zxdeld(jlev)
            zx = zxdel(jlev)
            zii1d = 0._JPRB
            zii2d = 0._JPRB
            DO jmu2=1,kmu
              zaux2 = pgb(jmu2)
              zxi1d = zi1d(jlev, jmu2)
              zxi1 = zi1(jlev, jmu2)
              zxi2d = zi1d(jlev, -jmu2)
              zxi2 = zi1(jlev, -jmu2)
              zbpjkd = z_pbpd(jlev, jmu2, jmu)*zx + z_pbp(jlev, jmu2, jmu)*&
&                zxd
              zbpjk = z_pbp(jlev, jmu2, jmu)*zx
              zbpjmkd = z_pbpd(jlev, jmu2, -jmu)*zx + z_pbp(jlev, jmu2, -jmu&
&                )*zxd
              zbpjmk = z_pbp(jlev, jmu2, -jmu)*zx
              zxdbd = zaux2*(zxi1d*zbpjk+zxi1*zbpjkd+zxi2d*zbpjmk+zxi2*&
&                zbpjmkd)
              zxdb = zaux2*(zxi1*zbpjk+zxi2*zbpjmk)
              zii2d = zii2d + zxdbd
              zii2 = zii2 + zxdb
              zxdbd = zaux2*(zxi1d*zbpjmk+zxi1*zbpjmkd+zxi2d*zbpjk+zxi2*&
&                zbpjkd)
              zxdb = zaux2*(zxi1*zbpjmk+zxi2*zbpjk)
              zii1d = zii1d + zxdbd
              zii1 = zii1 + zxdb
            ENDDO
            zi2d(jlev, jmu) = zii2d
            zi2(jlev, jmu) = zii2
            zi2d(jlev, -jmu) = zii1d
            zi2(jlev, -jmu) = zii1
          ENDDO
        ENDDO
        WHERE (zi2(:, :)  <   zeps) 
          zi2d(:, :) = 0._JPRB
          zi2(:, :) = 0.0_JPRB
        ENDWHERE
      ENDIF

! VERTICAL INTEGRATION, UPWARD RADIATION

      DO jmu=1,kmu
        zi1d(knt, jmu) = 0._JPRB
        zi1(knt, jmu) = 0.0_JPRB
        zzi1d = zi1d(knt, jmu)
        zzi1 = zi1(knt, jmu)
        zyy = prm(jmu)
        DO jlev=knt-1,0,-1
          zfd = zhd(jlev+1) - zhd(jlev)
          zf = zh(jlev+1) - zh(jlev)
          zad = ((zi2d(jlev+1, jmu)-zi2d(jlev, jmu))*zf-(zi2(jlev+1, jmu&
&            )-zi2(jlev, jmu))*zfd)/zf**2
          za = (zi2(jlev+1, jmu)-zi2(jlev, jmu))/zf
          zbd = zi2d(jlev, jmu) - zad*zh(jlev) - za*zhd(jlev)
          zb = zi2(jlev, jmu) - za*zh(jlev)
          zcd = -(zfd*EXP(-(zf/zyy))/zyy)
          zc = EXP(-(zf/zyy))
          zdd = -zcd
          zd = 1.d+00 - zc
          zxxd = zhd(jlev) - zhd(jlev+1)*zc - zh(jlev+1)*zcd
          zxx = zh(jlev) - zh(jlev+1)*zc
          zzi1d = zcd*zzi1 + zc*zzi1d + 0.5_JPRB*(zdd*(zb+za*zyy)+zd*(zbd+&
&            zyy*zad)+zad*zxx+za*zxxd)
          zzi1 = zc*zzi1 + (zd*(zb+za*zyy)+za*zxx)*0.5_JPRB
          IF (zzi1  >=  0.) THEN
            z_abs2 = zzi1
          ELSE
            z_abs2 = -zzi1
          ENDIF
          IF (z_abs2  <   accu) THEN
            zzi1 = 0.0_JPRB
            zzi1d = 0._JPRB
          ENDIF
          zi1d(jlev, jmu) = zzi1d
          zi1(jlev, jmu) = zzi1
        ENDDO
      ENDDO

! VERTICAL INTEGRATION, DOWNWARD RADIATION

      DO jmu=-kmu,-1
        zi1d(0, jmu) = 0._JPRB
        zi1(0, jmu) = 0.0_JPRB
        zzi1d = zi1d(0, jmu)
        zzi1 = zi1(0, jmu)
        zyy = prm(jmu)
        DO jlev=1,knt
          zfd = zhd(jlev) - zhd(jlev-1)
          zf = zh(jlev) - zh(jlev-1)
          zcd = zfd*EXP(zf/zyy)/zyy
          zc = EXP(zf/zyy)
          zdd = -zcd
          zd = 1.d+00 - zc
          zad = ((zi2d(jlev, jmu)-zi2d(jlev-1, jmu))*zf-(zi2(jlev, jmu)-&
&            zi2(jlev-1, jmu))*zfd)/zf**2
          za = (zi2(jlev, jmu)-zi2(jlev-1, jmu))/zf
          zbd = zi2d(jlev, jmu) - zad*zh(jlev) - za*zhd(jlev)
          zb = zi2(jlev, jmu) - za*zh(jlev)
          zxxd = zhd(jlev) - zhd(jlev-1)*zc - zh(jlev-1)*zcd
          zxx = zh(jlev) - zh(jlev-1)*zc
          zzi1d = zcd*zzi1 + zc*zzi1d + 0.5_JPRB*(zdd*(zb+za*zyy)+zd*(zbd+&
&            zyy*zad)+zad*zxx+za*zxxd)
          zzi1 = zc*zzi1 + (zd*(zb+za*zyy)+za*zxx)*0.5_JPRB
          IF (zzi1  >=  0.) THEN
            z_abs3 = zzi1
          ELSE
            z_abs3 = -zzi1
          ENDIF
          IF (z_abs3  <   accu) THEN
            zzi1 = 0.0_JPRB
            zzi1d = 0._JPRB
          ENDIF
          zi1d(jlev, jmu) = zzi1d
          zi1(jlev, jmu) = zzi1
        ENDDO
      ENDDO

! IN IS THE Nieme SCATTERING ORDER

      DO jmu=-kmu,-1
        zind(jmu) = zi1d(knt, jmu)
        zin(jmu) = zi1(knt, jmu)
      ENDDO
      DO jmu=1,kmu
        zind(jmu) = zi1d(0, jmu)
        zin(jmu) = zi1(0, jmu)
      ENDDO
      zro0 = zi1(0, kmu)

! CONVERGENCE TEST (GEOMETRICAL SERIE)

      IF (ig  >   2) THEN
        z = 0.0_JPRB
        za1 = zro2
        zd1 = zro1
        zg1 = zro0
        IF (za1  >=  accu .AND. zd1  >=  accu .AND. zro  >=  accu) THEN
          zy = (zg1/zd1-zd1/za1)/(1.0_JPRB-zg1/zd1)**2*(zg1/zro)
          IF (zy  >=  0.) THEN
            zy = zy
          ELSE
            zy = -zy
          ENDIF
          IF (z  <   zy) THEN
            z = zy
          ELSE
            z = z
          ENDIF
        ENDIF
        DO jmu=-kmu,-1
          za1 = zinm2(jmu)
          zd1 = zinm1(jmu)
          zg1 = zin(jmu)
          IF (za1  >   accu .AND. zd1  >   accu .AND. zi3(jmu)  >   accu&
&          ) THEN
            zy = (zg1/zd1-zd1/za1)/(1.0_JPRB-zg1/zd1)**2*(zg1/zi3(jmu))
            IF (zy  >=  0.) THEN
              zy = zy
            ELSE
              zy = -zy
            ENDIF
            IF (zy  <   z) THEN
              z = z
            ELSE
              z = zy
            ENDIF
          ENDIF
        ENDDO
        DO jmu=1,kmu
          za1 = zinm2(jmu)
          zd1 = zinm1(jmu)
          zg1 = zin(jmu)
          IF (za1  >   accu .AND. zd1  >   accu .AND. zi3(jmu)  >   accu&
&          ) THEN
            zy = (zg1/zd1-zd1/za1)/(1.0_JPRB-zg1/zd1)**2*(zg1/zi3(jmu))
            IF (zy  >=  0.) THEN
              zy = zy
            ELSE
              zy = -zy
            ENDIF
            IF (zy  <   z) THEN
              z = z
            ELSE
              z = zy
            ENDIF
          ENDIF
        ENDDO
        IF (z  <   accu4) THEN

! SUCCESSFUL TEST (GEOMETRICAL SERIE)

          DO jmu=-kmu,kmu
            zy1 = 1.0_JPRB
            zd1d = zinm1d(jmu)
            zd1 = zinm1(jmu)
            zg1d = zind(jmu)
            zg1 = zin(jmu)
            IF (zd1  >   accu) THEN
              zy1d = -((zg1d*zd1-zg1*zd1d)/zd1**2)
              zy1 = 1.0_JPRB - zg1/zd1
              IF (zg1 - zd1  >=  0.) THEN
                z_abs4 = zg1 - zd1
              ELSE
                z_abs4 = -(zg1-zd1)
              ENDIF
              IF (z_abs4  >   accu) THEN
                zg1d = (zg1d*zy1-zg1*zy1d)/zy1**2
                zg1 = zg1/zy1
                zi3d(jmu) = zi3d(jmu) + zg1d
                zi3(jmu) = zi3(jmu) + zg1
              ENDIF
            ENDIF
          ENDDO
          zd1 = zro1
          zg1 = zro0
          zy = 1.0_JPRB
          IF (zd1  >=  accu) THEN
            IF (zg1 - zd1  >=  0.) THEN
              z_abs5 = zg1 - zd1
            ELSE
              z_abs5 = -(zg1-zd1)
            ENDIF
            IF (z_abs5  >=  accu) THEN
              zy1 = 1.0_JPRB - zg1/zd1
              zg1 = zg1/zy1
            ENDIF
            zro = zro + zg1
          ENDIF
        ELSE
!        EXIT

! ZINM2 IS THE (N-2)ieme SCATTERING ORDER

          DO jmu=-kmu,kmu
            zinm2(jmu) = zinm1(jmu)
          ENDDO
          zro2 = zro1
        ENDIF
      ENDIF
      IF (ig  <=  2 .OR. z  >=  0.0001_JPRB) THEN

! ZINM1 IS THE (N-1)ieme SCATTERING ORDER

        DO jmu=-kmu,kmu
          zinm1d(jmu) = zind(jmu)
          zinm1(jmu) = zin(jmu)
        ENDDO
        zro1 = zro0

! SUM OF THE N-1 ORDERS

        DO jmu=-kmu,kmu
          zi3d(jmu) = zi3d(jmu) + zind(jmu)
          zi3(jmu) = zi3(jmu) + zin(jmu)
        ENDDO
        zro = zro + zro0

! STOP IF ORDER N IS LESS THAN 1% OF THE SUM

        z = 0.0_JPRB
        DO jmu=-kmu,kmu
          IF (zi3(jmu)  >=  0.) THEN
            z_abs6 = zi3(jmu)
          ELSE
            z_abs6 = -zi3(jmu)
          ENDIF
          IF (z_abs6  >=  accu) THEN
            IF (zin(jmu)/zi3(jmu)  >=  0.) THEN
              zy = zin(jmu)/zi3(jmu)
            ELSE
              zy = -(zin(jmu)/zi3(jmu))
            ENDIF
            IF (z  <   zy) THEN
              z = zy
            ELSE
              z = z
            ENDIF
          ENDIF
        ENDDO
      ENDIF
    ENDDO
!      IF ((Z <  0.00001_JPRB).OR.(IG >  20)) THEN
!        EXIT
!      ENDIF
! END LOOP ON SUCCESSIVE ORDERS 

! SUM OF THE FOURIER COMPONENT S

    z_delta0s = 1.0_JPRB
    IF (jpleg  /=  0) z_delta0s = 2.0_JPRB
    DO jmu=-kmu,kmu
      zi4(jmu) = zi4(jmu) + z_delta0s*zi3(jmu)
    ENDDO

! STOP OF THE FOURIER DECOMPOSITION

    jmum1 = kmu - 1
    DO jnp=1,knp
      zphi = prp(jnp)
      DO j=-jmum1,jmum1
        IF (j  >   0) THEN
          z_arg1 = DBLE(jpleg)*(zphi+zpi)
          pxld(j, jnp) = pxld(j, jnp) + z_delta0s*COS(z_arg1)*zi3d(j)
          pxl(j, jnp) = pxl(j, jnp) + z_delta0s*zi3(j)*COS(z_arg1)
        ELSE
          z_arg1 = DBLE(jpleg)*zphi
          pxld(j, jnp) = pxld(j, jnp) + z_delta0s*COS(z_arg1)*zi3d(j)
          pxl(j, jnp) = pxl(j, jnp) + z_delta0s*zi3(j)*COS(z_arg1)
        ENDIF
      ENDDO
    ENDDO
    IF (jpleg  ==  0) THEN
      DO j=1,jmum1
        pxld(0, 1) = pxld(0, 1) + prm(j)*pgb(j)*zi3d(-j)
        pxl(0, 1) = pxl(0, 1) + prm(j)*pgb(j)*zi3(-j)
      ENDDO
    ENDIF
    z_arg1 = DBLE(jpleg)*(phirad+zpi)
    pxld(kmu, 1) = pxld(kmu, 1) + z_delta0s*COS(z_arg1)*zi3d(kmu)
    pxl(kmu, 1) = pxl(kmu, 1) + z_delta0s*zi3(kmu)*COS(z_arg1)
! DOWNWARD FLUX
    z_arg1 = DBLE(jpleg)*(phirad+zpi)
    pxld(-kmu, 1) = pxld(-kmu, 1) + z_delta0s*COS(z_arg1)*zi3d(-kmu)
    pxl(-kmu, 1) = pxl(-kmu, 1) + z_delta0s*zi3(-kmu)*COS(z_arg1)
    z = 0.0
    DO jmu=-kmu,kmu
      IF (zi4(jmu)  >=  0.) THEN
        z_abs7 = zi4(jmu)
      ELSE
        z_abs7 = -zi4(jmu)
      ENDIF
      IF (z_abs7  >=  accu) THEN
        IF (zi3(jmu)/zi4(jmu)  >=  0.) THEN
          zx = zi3(jmu)/zi4(jmu)
        ELSE
          zx = -(zi3(jmu)/zi4(jmu))
        ENDIF
        IF (z  <   zx) THEN
          z = zx
        ELSE
          z = z
        ENDIF
      ENDIF
    ENDDO
  ENDDO

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