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

SUBROUTINE ISO_GEMS_TL(ptamoy, ptamoyd, ptray, pizmoy, pizmoyd, pbetal, &
&  pbetald, prm, pgb, ppsl, ptodaer, ptodaerd, ptodray, pxf, pxfd)

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

USE rt6svalues

  IMPLICIT NONE
!****ISO*** COMPUTES ATMOSPHERIC TRANSMISSION


!     INTERFACE
!     ---------
! ISO IS CALLED BY SCATRA

!     INPUTS
!     ------

! 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 DEPTH
! PTODRAY             : TOTAL MOLECULAR OPTICAL DEPTH

!     OUTPUTS
!     -------

! PXF(-1,1) : ATMOSPHERIC TRANSMISSION 

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

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

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

!     MODEL PARAMETERS
!     ----------------
!--------------------------------------------------------------------------------------
! 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), ptodaerd
  REAL(KIND=JPRB), INTENT(IN) :: ppsl(0:knang, -1:knang, -kmu:kmu)
  REAL(KIND=JPRB), INTENT(OUT) :: pxf(-1:1)
  REAL(KIND=JPRB), INTENT(OUT) :: pxfd(-1:1)
! LOCAL VARIABLES
! ---------------
!INTEGER(KIND=JPIM),PARAMETER  :: KMU=25, KNP=49, KNANG=80, KNT=20
  INTEGER(KIND=JPIM) :: jlev, jmu, jmu2, ig
  REAL(KIND=JPRB) :: zh(0:knt), zydel(0:knt), zxdel(0:knt)
  REAL(KIND=JPRB) :: zhd(0:knt), zydeld(0:knt), zxdeld(0:knt)
  REAL(KIND=JPRB) :: zaaa, zron, zbeta0, zbeta2
! AEROSOL PHASE FUNCTION
  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), zin(-kmu:kmu)
  REAL(KIND=JPRB) :: zi3d(-kmu:kmu), zind(-kmu:kmu)
  REAL(KIND=JPRB) :: zinm1(-kmu:kmu), zinm2(-kmu:kmu)
  REAL(KIND=JPRB) :: zinm1d(-kmu:kmu)
  REAL(KIND=JPRB) :: zii1, zii2, zbpjk, zbpjmk, zxi1, zxi2
  REAL(KIND=JPRB) :: zii1d, zii2d, zbpjkd, zbpjmkd, zxi1d, zxi2d
  REAL(KIND=JPRB) :: z, zx, zxx, zxpk, zy, zyy
  REAL(KIND=JPRB) :: zxd, zxxd, zyd
  REAL(KIND=JPRB) :: za1, zd1, zg1, zy1, za, zb, zc, zd, zf, zzi1
  REAL(KIND=JPRB) :: zd1d, zg1d, zy1d, zad, zbd, zcd, zdd, zfd, zzi1d
  REAL(KIND=JPRB) :: zypk, zxpj, zro, zro0, zro1, zro2, zaux
  REAL(KIND=JPRB) :: zrod, zro0d, zro1d, 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)
  INTRINSIC EXP
  INTRINSIC MAX
  INTRINSIC ABS
  REAL(KIND=JPRB) :: z_abs1

  REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "kernel_pbp_tl.intfb.h"

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

! VARIABLE INITIALIZATION 
  zind(:) = 0._JPRB
  zin(:) = 0.0_JPRB
  zi3(:) = 0.0_JPRB
  zi1d(:, :) = 0._JPRB
  zi1(:, :) = 0.0_JPRB
  zi2(:, :) = 0.0_JPRB
  zinm1d(:) = 0._JPRB
  zinm1(:) = 0.0_JPRB
  zinm2(:) = 0.0_JPRB
  pxfd(:) = 0._JPRB
  pxf(:) = 0.0_JPRB

! 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
      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
    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
      zydeld(jlev) = 0._JPRB
      zydel(jlev) = 0.0_JPRB
      zxdeld(jlev) = pizmoyd(jlev)
      zxdel(jlev) = pizmoy(jlev)
    ENDDO
  ELSE
    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
    zydeld(0:knt) = 0._JPRB
    zauxd = 0._JPRB
    DO jlev=0,knt
      zauxd = zauxd + ptamoyd(jlev)
      zaux = zaux + ptamoy(jlev) + ptray(jlev)
      zhd(jlev) = zauxd
      zh(jlev) = zaux
      zxdeld(jlev) = ((pizmoyd(jlev)*ptamoy(jlev)+pizmoy(jlev)*ptamoyd(&
&        jlev))*zh(jlev)-pizmoy(jlev)*ptamoy(jlev)*zhd(jlev))/zh(jlev)**&
&        2
      zxdel(jlev) = pizmoy(jlev)*ptamoy(jlev)/zh(jlev)
      zydeld(jlev) = -(ptray(jlev)*zhd(jlev)/zh(jlev)**2)
      zydel(jlev) = ptray(jlev)/zh(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

! PRIMARY SCATTERING

  ig = 1
  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(0, ppsl, pbetal, pbetald, z_pxpl, z_pbp, z_pbpd)
  zi2d(:, :) = 0._JPRB
  zi2(:, :) = 0.0_JPRB
  zi1d(0:knt, -kmu:kmu) = 0._JPRB

! VERTICAL INTEGRATION, PRIMARY UPWARD RADIATION

  DO jmu=1,kmu
    zi1d(knt, jmu) = 0._JPRB
    zi1(knt, jmu) = 1.0_JPRB
    zzi1 = zi1(knt, jmu)
    zyy = prm(jmu)
    DO jlev=knt-1,0,-1
      zi1d(jlev, jmu) = -((ptodaerd-zhd(jlev))*EXP(-((ptodaer+ptodray-zh&
&        (jlev))/zyy))/zyy)
      zi1(jlev, jmu) = EXP(-((ptodaer+ptodray-zh(jlev))/zyy))
    ENDDO
  ENDDO

! VERTICAL INTEGRATION, PRIMARY DOWNWARD RADIATION

  DO jmu=-kmu,-1
    DO jlev=0,knt
      zi1d(jlev, jmu) = 0._JPRB
      zi1(jlev, jmu) = 0.0_JPRB
    ENDDO
  ENDDO
  zi3d(-kmu:kmu) = 0._JPRB
  zinm1d(-kmu:kmu) = 0._JPRB

! ZINM2 IS INITIALIZED WITH SCATTERING COMPUTED AT N-2
! ZI3 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)
  zrod = zi1d(0, kmu)
  zro = zi1(0, kmu)
  zind(-kmu:kmu) = 0._JPRB
  zro1d = 0._JPRB
  zi2d(0:knt, -kmu:kmu) = 0._JPRB

! LOOP ON SUCCESSIVE ORDER

  DO ig=2,nord

! SUCCESSIVE ORDERS

! MULTIPLE SCATTERING SOURCE FUNCTION AT EVERY LEVEL WITHIN THE LAYER

    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)
          z = 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)
          zii2d = zii2d + z*(zxi1d*zbpjk+zxi1*zbpjkd+zxi2d*zbpjmk+zxi2*&
&            zbpjmkd)
          zii2 = zii2 + z*(zxi1*zbpjk+zxi2*zbpjmk)
          zii1d = zii1d + z*(zxi1d*zbpjmk+zxi1*zbpjmkd+zxi2d*zbpjk+zxi2*&
&            zbpjkd)
          zii1 = zii1 + z*(zxi1*zbpjmk+zxi2*zbpjk)
        ENDDO
        zi2d(jlev, jmu) = zii2d
        zi2(jlev, jmu) = zii2
        zi2d(jlev, -jmu) = zii1d
        zi2(jlev, -jmu) = zii1
      ENDDO
    ENDDO

! 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
        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
        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
    zro0d = zi1d(0, kmu)
    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.-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  /=  0.0_JPRB .AND. zd1  /=  0.0_JPRB .AND. zi3(jmu)  /=  &
&            0.0_JPRB) THEN
          zy = (zg1/zd1-zd1/za1)/(1.-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  /=  0.0_JPRB .AND. zd1  /=  0.0_JPRB .AND. zi3(jmu)  /=  &
&            0.0_JPRB) THEN
          zy = (zg1/zd1-zd1/za1)/(1.-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,-1
          zy1 = 1.0_JPRB
          zd1d = zinm1d(jmu)
          zd1 = zinm1(jmu)
          zg1d = zind(jmu)
          zg1 = zin(jmu)
          IF (zd1  /=  0.0_JPRB) THEN
            zy1d = -((zg1d*zd1-zg1*zd1d)/zd1**2)
            zy1 = 1.0_JPRB - zg1/zd1
            zg1d = (zg1d*zy1-zg1*zy1d)/zy1**2
            zg1 = zg1/zy1
            zi3d(jmu) = zi3d(jmu) + zg1d
            zi3(jmu) = zi3(jmu) + zg1
          ENDIF
        ENDDO
        DO jmu=1,kmu
          zy1 = 1.0_JPRB
          zd1d = zinm1d(jmu)
          zd1 = zinm1(jmu)
          zg1d = zind(jmu)
          zg1 = zin(jmu)
          IF (zd1  /=  0.0_JPRB) THEN
            zy1d = -((zg1d*zd1-zg1*zd1d)/zd1**2)
            zy1 = 1.0_JPRB - zg1/zd1
            zg1d = (zg1d*zy1-zg1*zy1d)/zy1**2
            zg1 = zg1/zy1
            zi3d(jmu) = zi3d(jmu) + zg1d
            zi3(jmu) = zi3(jmu) + zg1
          ENDIF
        ENDDO
        zd1d = zro1d
        zd1 = zro1
        zg1d = zro0d
        zg1 = zro0
        zy = 1.0_JPRB
        IF (zd1  >=  accu) THEN
          IF (zg1 - zd1  >=  0.) THEN
            z_abs1 = zg1 - zd1
          ELSE
            z_abs1 = -(zg1-zd1)
          ENDIF
          IF (z_abs1  >=  accu) THEN
            zy1d = -((zg1d*zd1-zg1*zd1d)/zd1**2)
            zy1 = 1.0_JPRB - zg1/zd1
            zg1d = (zg1d*zy1-zg1*zy1d)/zy1**2
            zg1 = zg1/zy1
          ENDIF
          zrod = zrod + zg1d
          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  >=  accu4) THEN

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

      DO jmu=-kmu,kmu
        zinm1d(jmu) = zind(jmu)
        zinm1(jmu) = zin(jmu)
      ENDDO
      zro1d = zro0d
      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
      zrod = zrod + zro0d
      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.0_JPRB) THEN
!        ZY=ABS(ZIN(JMU)/ZI3(JMU))
!        Z=MAX(Z,ZY)
!      ENDIF
!    ENDDO
!    IF ((Z <  ACCU5).OR.(IG >  SCATORD)) THEN
!      EXIT
!    ENDIF
    ENDIF
  ENDDO
! END LOOP ON SUCCESSIVE ORDERS 
  pxfd(1) = zi3d(kmu)
  pxf(1) = pxf(1) + zi3(kmu)
  pxfd(-1) = zrod
  pxf(-1) = zro
  DO jmu=1,kmu
    pxfd(0) = pxfd(0) + prm(jmu)*pgb(jmu)*zi3d(-jmu)
    pxf(0) = pxf(0) + prm(jmu)*pgb(jmu)*zi3(-jmu)
  ENDDO

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