!  Differentiation of os_gems in reverse (adjoint) mode:
!   gradient, with respect to input variables: pizmoy pbetal ptamoy
!   of linear combination of output variables: pizmoy pbetal pxl ptamoy

SUBROUTINE OS_GEMS_AD(ptamoy, ptamoyb, ptray, pizmoy, pizmoyb, phirad, &
&  pbetal, pbetalb, prm, pgb, prp, ppsl, ptodaer, ptodray, pxl, pxlb)

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(INOUT) :: ptamoyb(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(INOUT) :: pizmoyb(0:knt)
  REAL(KIND=JPRB), INTENT(IN) :: pbetal(0:knt, 0:knang), ptodaer, ptodray
  REAL(KIND=JPRB), INTENT(INOUT) :: pbetalb(0:knt, 0:knang)
  REAL(KIND=JPRB), INTENT(IN) :: ppsl(0:knang, -1:knang, -kmu:kmu)
  REAL(KIND=JPRB), INTENT(IN) :: pxl(-kmu:kmu, knp)
  REAL(KIND=JPRB), INTENT(INOUT) :: pxlb(-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, jmu2, jmum1, ig, jnp, j
  REAL(KIND=JPRB) :: zh(0:knt), zch(0:knt), zydel(0:knt), zxdel(0:knt)
  REAL(KIND=JPRB) :: zhb(0:knt), zchb(0:knt), zydelb(0:knt), zxdelb(0:knt)
  REAL(KIND=JPRB) :: zxmus, zaaa, zron, zbeta0, zbeta2
! AEROSOL PHASE FUNCTION
  REAL(KIND=JPRB) :: zsa2(0:knt)
  REAL(KIND=JPRB) :: zsa2b(0:knt)
  REAL(KIND=JPRB) :: zi1(0:knt, -kmu:kmu), zi2(0:knt, -kmu:kmu)
  REAL(KIND=JPRB) :: zi1b(0:knt, -kmu:kmu), zi2b(0:knt, -kmu:kmu)
  REAL(KIND=JPRB) :: zi3(-kmu:kmu), zi4(-kmu:kmu)
  REAL(KIND=JPRB) :: zi3b(-kmu:kmu)
  REAL(KIND=JPRB) :: zinm1(-kmu:kmu), zinm2(-kmu:kmu)
  REAL(KIND=JPRB) :: zinm1b(-kmu:kmu)
  REAL(KIND=JPRB) :: zin(-kmu:kmu)
  REAL(KIND=JPRB) :: zinb(-kmu:kmu)
  REAL(KIND=JPRB) :: zii1, zii2, zbpjk, zbpjmk, zxi1, zxi2, zxdb
  REAL(KIND=JPRB) :: zii1b, zii2b, zbpjkb, zbpjmkb, zxi1b, zxi2b, zxdbb
  REAL(KIND=JPRB) :: zspl, z, zx, zxx, zsa1, zxpk, zy, zyy
  REAL(KIND=JPRB) :: zxb, zxxb, zyb
  REAL(KIND=JPRB) :: za1, zd1, zg1, zy1, z_delta0s, za, zb, zc, zd, zf, zzi1
  REAL(KIND=JPRB) :: zd1b, zg1b, zy1b, zab, zbb, zcb, zdb, zfb, zzi1b
  REAL(KIND=JPRB) :: zypk, zxpj, zphi, zro, zro0, zro1, zro2, zaux, zaux2
  REAL(KIND=JPRB) :: zauxb
! 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_pbpb(0:knt, 0:kmu, -kmu:kmu)

  LOGICAL, DIMENSION(0:knt, -kmu:kmu) :: ll_mask
  LOGICAL, DIMENSION(0:knt, -kmu:kmu) :: ll_mask0
  INTEGER(KIND=JPIM) :: i_branch
  INTEGER(KIND=JPIM) :: i_ad_from
  INTEGER(KIND=JPIM) :: i_ad_to
  INTEGER(KIND=JPIM) :: i_ad_to0
  INTRINSIC COS
  INTRINSIC EXP
  REAL(KIND=JPRB) :: z_tempb9
  REAL(KIND=JPRB) :: z_tempb8
  REAL(KIND=JPRB) :: z_tempb7
  REAL(KIND=JPRB) :: z_tempb6
  REAL(KIND=JPRB) :: z_tempb5
  REAL(KIND=JPRB) :: z_tempb4
  REAL(KIND=JPRB) :: z_tempb3
  REAL(KIND=JPRB) :: z_tempb2
  REAL(KIND=JPRB) :: z_tempb1
  REAL(KIND=JPRB) :: z_tempb0
  INTRINSIC MAX
  REAL(KIND=JPRB) :: z_tempb12
  REAL(KIND=JPRB) :: z_tempb11
  REAL(KIND=JPRB) :: z_tempb10
  INTRINSIC abs
  REAL(KIND=JPRB) :: z_tempb
  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) :: ZHOOK_HANDLE

#include "kernel_pbp.intfb.h"
#include "kernel_pbp_ad.intfb.h"
#include "popinteger4.intfb.h"
#include "popreal8.intfb.h"
!#include "popreal8array.intfb.h"
!#include "popbooleanarray.intfb.h"
#include "pushinteger4.intfb.h"
#include "pushreal8.intfb.h"
!#include "pushreal8array.intfb.h"
!#include "pushbooleanarray.intfb.h"

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

! VARIABLE INITIALIZATION 
  zin(:) = 0.0_JPRB
  zi4(:) = 0.0_JPRB
  zi1(:, :) = 0.0_JPRB
  zi2(:, :) = 0.0_JPRB
  zinm1(:) = 0.0_JPRB
  zinm2(:) = 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)
      zh(jlev) = zaux
      zch(jlev) = EXP(-(zh(jlev)/zxmus))/2.0_JPRB
      zydel(jlev) = 1.0_JPRB
      zxdel(jlev) = 0.0_JPRB
    ENDDO
  ENDIF

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

  IF (ptodray  <=  accu2 .AND. ptodaer   >  ptodray) THEN
    zaux = 0.0_JPRB
    DO jlev=0,knt
      zaux = zaux + ptamoy(jlev)
      zh(jlev) = zaux
      zch(jlev) = EXP(-(zh(jlev)/zxmus))/2.0_JPRB
      zydel(jlev) = 0.0_JPRB
      zxdel(jlev) = pizmoy(jlev)
    ENDDO
    CALL PUSHINTEGER4(1)
  ELSE
    CALL PUSHINTEGER4(0)
  ENDIF

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

  IF (ptodray   >  accu2 .AND. ptodaer   >  accu2) THEN
    zaux = 0.0_JPRB
    DO jlev=0,knt
      zaux = zaux + ptamoy(jlev) + ptray(jlev)
      CALL PUSHREAL8(zh(jlev))
      zh(jlev) = zaux
      zch(jlev) = EXP(-(zh(jlev)/zxmus))/2.0_JPRB
      zxdel(jlev) = pizmoy(jlev)*ptamoy(jlev)/(ptamoy(jlev)+ptray(jlev))
      zydel(jlev) = ptray(jlev)/(ptamoy(jlev)+ptray(jlev))
    ENDDO
    CALL PUSHINTEGER4(1)
  ELSE
    CALL PUSHINTEGER4(0)
  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
! LOOP ON S, TERM IN THE FOURIER SERIES
  DO jpleg=0,nfour

! PRIMARY SCATTERING

    zro1 = 0.0_JPRB
    zi3(:) = 0.0_JPRB
    CALL PUSHREAL8ARRAY(z_pbp, 27*26*51)

! KERNEL COMPUTATIONS

    CALL KERNEL_PBP(jpleg, ppsl, pbetal, z_pxpl, z_pbp)
    IF (jpleg   >  0) THEN
      CALL PUSHREAL8(zbeta0)
      zbeta0 = 0.0_JPRB
      CALL PUSHINTEGER4(1)
    ELSE
      CALL PUSHINTEGER4(0)
    ENDIF
    DO jmu=-kmu,kmu
      IF (jpleg - 2  <=  0) THEN
        zspl = z_pxpl(0)
        CALL PUSHREAL8(zsa1)
! RAYLEIGH PHASE FUNCTION
        zsa1 = zbeta0 + zbeta2*z_pxpl(jmu)*zspl
        CALL PUSHINTEGER4(0)
      ELSE
        CALL PUSHREAL8(zsa1)
        zsa1 = 0.0_JPRB
        CALL PUSHINTEGER4(1)
      ENDIF
      DO jlev=0,knt
        CALL PUSHREAL8(zsa2(jlev))
        zsa2(jlev) = z_pbp(jlev, 0, jmu)
        CALL PUSHREAL8(zi2(jlev, jmu))
        zi2(jlev, jmu) = zch(jlev)*(zsa2(jlev)*zxdel(jlev)+zsa1*zydel(jlev))
      ENDDO
    ENDDO

! VERTICAL INTEGRATION, PRIMARY UPWARD RADIATION

    DO jmu=1,kmu
      zi1(knt, jmu) = 0.0_JPRB
      zzi1 = zi1(knt, jmu)
      CALL PUSHREAL8(zy)
      zy = prm(jmu)
      DO jlev=knt-1,0,-1
        CALL PUSHREAL8(zf)
        zf = zh(jlev+1) - zh(jlev)
        CALL PUSHREAL8(za)
        za = (zi2(jlev+1, jmu)-zi2(jlev, jmu))/zf
        CALL PUSHREAL8(zb)
        zb = zi2(jlev, jmu) - za*zh(jlev)
        CALL PUSHREAL8(zc)
        zc = EXP(-(zf/zy))
        CALL PUSHREAL8(zd)
        zd = 1.0_JPRB - zc
        CALL PUSHREAL8(zx)
        zx = zh(jlev) - zh(jlev+1)*zc
        CALL PUSHREAL8(zzi1)
        zzi1 = zc*zzi1 + (zd*(zb+za*zy)+za*zx)*0.5_JPRB
        zi1(jlev, jmu) = zzi1
      ENDDO
    ENDDO

! VERTICAL INTEGRATION, PRIMARY DOWNWARD RADIATION

    DO jmu=-kmu,-1
      zi1(0, jmu) = 0.0_JPRB
      zzi1 = zi1(0, jmu)
      CALL PUSHREAL8(zy)
      zy = prm(jmu)
      DO jlev=1,knt
        CALL PUSHREAL8(zf)
        zf = zh(jlev) - zh(jlev-1)
        CALL PUSHREAL8(zc)
        zc = EXP(zf/zy)
        CALL PUSHREAL8(zd)
        zd = 1.0_JPRB - zc
        CALL PUSHREAL8(za)
        za = (zi2(jlev, jmu)-zi2(jlev-1, jmu))/zf
        CALL PUSHREAL8(zb)
        zb = zi2(jlev, jmu) - za*zh(jlev)
        CALL PUSHREAL8(zx)
        zx = zh(jlev) - zh(jlev-1)*zc
        CALL PUSHREAL8(zzi1)
        zzi1 = zc*zzi1 + (zd*(zb+za*zy)+za*zx)*0.5_JPRB
        zi1(jlev, jmu) = zzi1
      ENDDO
    ENDDO

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

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

! LOOP ON SUCCESSIVE ORDER

! PRIMARY SCATTERING
    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
          CALL PUSHREAL8(zxpk)
          zxpk = z_pxpl(jmu)
          CALL PUSHREAL8(zypk)
          zypk = z_pxpl(-jmu)
          DO jlev=0,knt
            zii1 = 0.0_JPRB
            zii2 = 0.0_JPRB
            CALL PUSHREAL8(zx)
            zx = zxdel(jlev)
            CALL PUSHREAL8(zy)
            zy = zydel(jlev)
            DO jmu2=1,kmu
              CALL PUSHREAL8(zxpj)
              zxpj = z_pxpl(jmu2)
              CALL PUSHREAL8(zaux2)
              zaux2 = pgb(jmu2)
              CALL PUSHREAL8(zxi1)
              zxi1 = zi1(jlev, jmu2)
              CALL PUSHREAL8(zxi2)
              zxi2 = zi1(jlev, -jmu2)
              CALL PUSHREAL8(zbpjk)
              zbpjk = z_pbp(jlev,jmu2,jmu)*zx + zy*(zbeta0+zbeta2*zxpj*zxpk)
              CALL PUSHREAL8(zbpjmk)
              zbpjmk = z_pbp(jlev,jmu2,-jmu)*zx + zy*(zbeta0+zbeta2*zxpj*zypk)
              zxdb = zaux2*(zxi1*zbpjk+zxi2*zbpjmk)
              zii2 = zii2 + zxdb
              zxdb = zaux2*(zxi1*zbpjmk+zxi2*zbpjk)
              zii1 = zii1 + zxdb
            ENDDO
            CALL PUSHREAL8(zi2(jlev, jmu))
            zi2(jlev, jmu) = zii2
            CALL PUSHREAL8(zi2(jlev, -jmu))
            zi2(jlev, -jmu) = zii1
          ENDDO
        ENDDO
        CALL PUSHBOOLEANARRAY(ll_mask, 27*51)
        ll_mask(:, :) = zi2(:, :)  <   zeps
        CALL PUSHREAL8ARRAY(zi2, 27*51)
        WHERE (ll_mask(:, :)) zi2(:, :) = 0.0_JPRB
        CALL PUSHINTEGER4(0)
      ELSEIF (jpleg - 2   >  0) THEN
        DO jmu=1,kmu
          DO jlev=0,knt
            zii1 = 0.0_JPRB
            zii2 = 0.0_JPRB
            CALL PUSHREAL8(zx)
            zx = zxdel(jlev)
            DO jmu2=1,kmu
              CALL PUSHREAL8(zaux2)
              zaux2 = pgb(jmu2)
              CALL PUSHREAL8(zxi1)
              zxi1 = zi1(jlev, jmu2)
              CALL PUSHREAL8(zxi2)
              zxi2 = zi1(jlev, -jmu2)
              CALL PUSHREAL8(zbpjk)
              zbpjk = z_pbp(jlev, jmu2, jmu)*zx
              CALL PUSHREAL8(zbpjmk)
              zbpjmk = z_pbp(jlev, jmu2, -jmu)*zx
              zxdb = zaux2*(zxi1*zbpjk+zxi2*zbpjmk)
              zii2 = zii2 + zxdb
              zxdb = zaux2*(zxi1*zbpjmk+zxi2*zbpjk)
              zii1 = zii1 + zxdb
            ENDDO
            CALL PUSHREAL8(zi2(jlev, jmu))
            zi2(jlev, jmu) = zii2
            CALL PUSHREAL8(zi2(jlev, -jmu))
            zi2(jlev, -jmu) = zii1
          ENDDO
        ENDDO
        CALL PUSHBOOLEANARRAY(ll_mask0, 27*51)
        ll_mask0(:, :) = zi2(:, :)  <   zeps
        CALL PUSHREAL8ARRAY(zi2, 27*51)
        WHERE (ll_mask0(:, :)) zi2(:, :) = 0.0_JPRB
        CALL PUSHINTEGER4(2)
      ELSE
        CALL PUSHINTEGER4(1)
      ENDIF

! VERTICAL INTEGRATION, UPWARD RADIATION

      DO jmu=1,kmu
        zi1(knt, jmu) = 0.0_JPRB
        zzi1 = zi1(knt, jmu)
        CALL PUSHREAL8(zyy)
        zyy = prm(jmu)
        DO jlev=knt-1,0,-1
          CALL PUSHREAL8(zf)
          zf = zh(jlev+1) - zh(jlev)
          CALL PUSHREAL8(za)
          za = (zi2(jlev+1, jmu)-zi2(jlev, jmu))/zf
          CALL PUSHREAL8(zb)
          zb = zi2(jlev, jmu) - za*zh(jlev)
          CALL PUSHREAL8(zc)
          zc = EXP(-(zf/zyy))
          CALL PUSHREAL8(zd)
          zd = 1.d+00 - zc
          CALL PUSHREAL8(zxx)
          zxx = zh(jlev) - zh(jlev+1)*zc
          CALL PUSHREAL8(zzi1)
          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
            CALL PUSHINTEGER4(1)
          ELSE
            CALL PUSHINTEGER4(0)
          ENDIF
          zi1(jlev, jmu) = zzi1
        ENDDO
      ENDDO

! VERTICAL INTEGRATION, DOWNWARD RADIATION

      DO jmu=-kmu,-1
        zi1(0, jmu) = 0.0_JPRB
        zzi1 = zi1(0, jmu)
        CALL PUSHREAL8(zyy)
        zyy = prm(jmu)
        DO jlev=1,knt
          CALL PUSHREAL8(zf)
          zf = zh(jlev) - zh(jlev-1)
          CALL PUSHREAL8(zc)
          zc = EXP(zf/zyy)
          CALL PUSHREAL8(zd)
          zd = 1.d+00 - zc
          CALL PUSHREAL8(za)
          za = (zi2(jlev, jmu)-zi2(jlev-1, jmu))/zf
          CALL PUSHREAL8(zb)
          zb = zi2(jlev, jmu) - za*zh(jlev)
          CALL PUSHREAL8(zxx)
          zxx = zh(jlev) - zh(jlev-1)*zc
          CALL PUSHREAL8(zzi1)
          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
            CALL PUSHINTEGER4(1)
          ELSE
            CALL PUSHINTEGER4(0)
          ENDIF
          zi1(jlev, jmu) = zzi1
        ENDDO
      ENDDO

! IN IS THE Nieme SCATTERING ORDER

      DO jmu=-kmu,-1
        zin(jmu) = zi1(knt, jmu)
      ENDDO
      DO jmu=1,kmu
        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
          CALL PUSHREAL8(zy)
          zy = (zg1/zd1-zd1/za1)/(1.0_JPRB-zg1/zd1)**2*(zg1/zro)
          IF (zy  >=  0.) THEN
            CALL PUSHINTEGER4(1)
            zy = zy
          ELSE
            CALL PUSHINTEGER4(1)
            zy = -zy
          ENDIF
          IF (z  <   zy) THEN
            z = zy
          ELSE
            z = z
          ENDIF
        ELSE
          CALL PUSHINTEGER4(0)
        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
            CALL PUSHREAL8(zy)
            zy = (zg1/zd1-zd1/za1)/(1.0_JPRB-zg1/zd1)**2*(zg1/zi3(jmu))
            IF (zy  >=  0.) THEN
              CALL PUSHINTEGER4(3)
              zy = zy
            ELSE
              CALL PUSHINTEGER4(3)
              zy = -zy
            ENDIF
            IF (zy  <   z) THEN
              z = z
            ELSE
              z = zy
            ENDIF
          ELSE
            CALL PUSHINTEGER4(2)
          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
            CALL PUSHREAL8(zy)
            zy = (zg1/zd1-zd1/za1)/(1.0_JPRB-zg1/zd1)**2*(zg1/zi3(jmu))
            IF (zy  >=  0.) THEN
              CALL PUSHINTEGER4(2)
              zy = zy
            ELSE
              CALL PUSHINTEGER4(2)
              zy = -zy
            ENDIF
            IF (zy  <   z) THEN
              z = z
            ELSE
              z = zy
            ENDIF
          ELSE
            CALL PUSHINTEGER4(1)
          ENDIF
        ENDDO
        IF (z  <   accu4) THEN

! SUCCESSFUL TEST (GEOMETRICAL SERIE)

          DO jmu=-kmu,kmu
            CALL PUSHREAL8(zd1)
            zd1 = zinm1(jmu)
            CALL PUSHREAL8(zg1)
            zg1 = zin(jmu)
            IF (zd1   >  accu) THEN
              CALL PUSHREAL8(zy1)
              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
                CALL PUSHREAL8(zg1)
                zg1 = zg1/zy1
                zi3(jmu) = zi3(jmu) + zg1
                CALL PUSHINTEGER4(3)
              ELSE
                CALL PUSHINTEGER4(2)
              ENDIF
            ELSE
              CALL PUSHINTEGER4(1)
            ENDIF
          ENDDO
          CALL PUSHREAL8(zd1)
          zd1 = zro1
          CALL PUSHREAL8(zg1)
          zg1 = zro0
          IF (zd1  >=  accu) THEN
            IF (zg1 - zd1  >=  0.) THEN
              z_abs5 = zg1 - zd1
            ELSE
              z_abs5 = -(zg1-zd1)
            ENDIF
            IF (z_abs5  >=  accu) THEN
              CALL PUSHREAL8(zy1)
              zy1 = 1.0_JPRB - zg1/zd1
              zg1 = zg1/zy1
              CALL PUSHINTEGER4(4)
            ELSE
              CALL PUSHINTEGER4(3)
            ENDIF
            zro = zro + zg1
          ELSE
            CALL PUSHINTEGER4(2)
          ENDIF
        ELSE
          CALL PUSHINTEGER4(1)
!        EXIT

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

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

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

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

! SUM OF THE N-1 ORDERS

        DO jmu=-kmu,kmu
          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
              CALL PUSHREAL8(zy)
              zy = zin(jmu)/zi3(jmu)
              CALL PUSHINTEGER4(3)
            ELSE
              CALL PUSHREAL8(zy)
              zy = -(zin(jmu)/zi3(jmu))
              CALL PUSHINTEGER4(2)
            ENDIF
            IF (z  <   zy) THEN
              z = zy
            ELSE
              z = z
            ENDIF
          ELSE
            CALL PUSHINTEGER4(1)
          ENDIF
        ENDDO
        CALL PUSHINTEGER4(2)
      ELSE
        CALL PUSHINTEGER4(1)
      ENDIF
    ENDDO
    CALL PUSHREAL8(z_delta0s)
!      IF ((Z <   .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
      CALL PUSHREAL8(zphi)
      zphi = prp(jnp)
      i_ad_from = -jmum1
      DO j=i_ad_from,jmum1
        IF (j   >  0) THEN
          CALL PUSHINTEGER4(1)
        ELSE
          CALL PUSHINTEGER4(2)
        ENDIF
      ENDDO
      CALL PUSHINTEGER4(j - 1)
      CALL PUSHINTEGER4(i_ad_from)
    ENDDO
    IF (jpleg  ==  0) THEN
      j = jmum1 + 1
      CALL PUSHINTEGER4(j - 1)
      CALL PUSHINTEGER4(1)
    ELSE
      CALL PUSHINTEGER4(0)
    ENDIF
! DOWNWARD FLUX
    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
          CALL PUSHREAL8(zx)
          zx = zi3(jmu)/zi4(jmu)
          CALL PUSHINTEGER4(3)
        ELSE
          CALL PUSHREAL8(zx)
          zx = -(zi3(jmu)/zi4(jmu))
          CALL PUSHINTEGER4(2)
        ENDIF
        IF (z  <   zx) THEN
          z = zx
        ELSE
          z = z
        ENDIF
      ELSE
        CALL PUSHINTEGER4(1)
      ENDIF
    ENDDO
  ENDDO
  zinb(-kmu:kmu) = 0._JPRB
  zydelb(0:knt) = 0._JPRB
  zchb(0:knt) = 0._JPRB
  zxdelb(0:knt) = 0._JPRB
  zi1b(0:knt, -kmu:kmu) = 0._JPRB
  zi2b(0:knt, -kmu:kmu) = 0._JPRB
  zinm1b(-kmu:kmu) = 0._JPRB
  zsa2b(0:knt) = 0._JPRB
  zhb(0:knt) = 0._JPRB
  DO jpleg=nfour,0,-1
    DO jmu=kmu,-kmu,-1
      CALL POPINTEGER4(i_branch)
      IF (i_branch  <   3) THEN
        IF (.NOT.i_branch  <   2) CALL POPREAL8(zx)
      ELSE
        CALL POPREAL8(zx)
      ENDIF
    ENDDO
    zi3b(-kmu:kmu) = 0._JPRB
    zi3b(-kmu) = COS(DBLE(jpleg)*(phirad+zpi))*z_delta0s*pxlb(-kmu, 1)
    zi3b(kmu) = zi3b(kmu) + COS(DBLE(jpleg)*(phirad+zpi))*z_delta0s*pxlb(&
&      kmu, 1)
    CALL POPINTEGER4(i_branch)
    IF (.NOT.i_branch  <   1) THEN
      CALL POPINTEGER4(i_ad_to0)
      DO j=i_ad_to0,1,-1
        zi3b(-j) = zi3b(-j) + prm(j)*pgb(j)*pxlb(0, 1)
      ENDDO
    ENDIF
    DO jnp=knp,1,-1
      CALL POPINTEGER4(i_ad_from)
      CALL POPINTEGER4(i_ad_to)
      DO j=i_ad_to,i_ad_from,-1
        CALL POPINTEGER4(i_branch)
        IF (i_branch  <   2) THEN
          zi3b(j) = zi3b(j) + COS(DBLE(jpleg)*(zphi+zpi))*z_delta0s*pxlb(j&
&            , jnp)
        ELSE
          zi3b(j) = zi3b(j) + COS(DBLE(jpleg)*zphi)*z_delta0s*pxlb(j, jnp)
        ENDIF
      ENDDO
      CALL POPREAL8(zphi)
    ENDDO
    CALL POPREAL8(z_delta0s)
    z_pbpb(0:knt, 0:kmu, -kmu:kmu) = 0._JPRB
    DO ig=nord,2,-1
      CALL POPINTEGER4(i_branch)
      IF (.NOT.i_branch  <   2) THEN
        DO jmu=kmu,-kmu,-1
          CALL POPINTEGER4(i_branch)
          IF (i_branch  <   3) THEN
            IF (.NOT.i_branch  <   2) CALL POPREAL8(zy)
          ELSE
            CALL POPREAL8(zy)
          ENDIF
        ENDDO
        DO jmu=kmu,-kmu,-1
          zinb(jmu) = zinb(jmu) + zi3b(jmu)
        ENDDO
        DO jmu=kmu,-kmu,-1
          zinb(jmu) = zinb(jmu) + zinm1b(jmu)
          zinm1b(jmu) = 0._JPRB
        ENDDO
      ENDIF
      CALL POPINTEGER4(i_branch)
      IF (i_branch  <   3) THEN
        IF (i_branch  <   2) THEN
          IF (i_branch  <   1) THEN
            GOTO 120
          ELSE
            GOTO 110
          ENDIF
        ENDIF
      ELSEIF (.NOT.i_branch  <   4) THEN
        CALL POPREAL8(zy1)
      ENDIF
      CALL POPREAL8(zg1)
      CALL POPREAL8(zd1)
      DO jmu=kmu,-kmu,-1
        CALL POPINTEGER4(i_branch)
        IF (i_branch  <   3) THEN
          IF (i_branch  <   2) THEN
            zg1b = 0._JPRB
            zd1b = 0._JPRB
            GOTO 100
          ELSE
            zy1b = 0._JPRB
            zg1b = 0._JPRB
          ENDIF
        ELSE
          zg1b = zi3b(jmu)
          CALL POPREAL8(zg1)
          zy1b = -(zg1*zg1b/zy1**2)
          zg1b = zg1b/zy1
        ENDIF
        CALL POPREAL8(zy1)
        zg1b = zg1b - zy1b/zd1
        zd1b = zg1*zy1b/zd1**2
 100    CONTINUE 
        CALL POPREAL8(zg1)
        zinb(jmu) = zinb(jmu) + zg1b
        CALL POPREAL8(zd1)
        zinm1b(jmu) = zinm1b(jmu) + zd1b
      ENDDO
 110  CONTINUE
      DO jmu=kmu,1,-1
        CALL POPINTEGER4(i_branch)
        IF (.NOT.i_branch  <   2) CALL POPREAL8(zy)
      ENDDO
      DO jmu=-1,-kmu,-1
        CALL POPINTEGER4(i_branch)
        IF (.NOT.i_branch  <   3) CALL POPREAL8(zy)
      ENDDO
      CALL POPINTEGER4(i_branch)
      IF (.NOT.i_branch  <   1) CALL POPREAL8(zy)
 120  CONTINUE
      DO jmu=kmu,1,-1
        zi1b(0, jmu) = zi1b(0, jmu) + zinb(jmu)
        zinb(jmu) = 0._JPRB
      ENDDO
      DO jmu=-1,-kmu,-1
        zi1b(knt, jmu) = zi1b(knt, jmu) + zinb(jmu)
        zinb(jmu) = 0._JPRB
      ENDDO
      DO jmu=-1,-kmu,-1
        zzi1b = 0._JPRB
        DO jlev=knt,1,-1
          zzi1b = zzi1b + zi1b(jlev, jmu)
          zi1b(jlev, jmu) = 0._JPRB
          CALL POPINTEGER4(i_branch)
          IF (.NOT.i_branch  <   1) zzi1b = 0._JPRB
          CALL POPREAL8(zzi1)
          z_tempb11 = 0.5_JPRB*zzi1b
          zdb = (zb+zyy*za)*z_tempb11
          zxxb = za*z_tempb11
          zcb = zzi1*zzi1b - zdb - zh(jlev-1)*zxxb
          zbb = zd*z_tempb11
          zab = (zxx+zd*zyy)*z_tempb11 - zh(jlev)*zbb
          zzi1b = zc*zzi1b
          CALL POPREAL8(zxx)
          zhb(jlev) = zhb(jlev) + zxxb
          zhb(jlev-1) = zhb(jlev-1) - zc*zxxb
          CALL POPREAL8(zb)
          z_tempb12 = zab/zf
          zi2b(jlev, jmu) = zi2b(jlev, jmu) + z_tempb12 + zbb
          zfb = EXP(zf/zyy)*zcb/zyy - (zi2(jlev, jmu)-zi2(jlev-1, jmu))*&
&            z_tempb12/zf
          zhb(jlev) = zhb(jlev) + zfb - za*zbb
          CALL POPREAL8(za)
          zi2b(jlev-1, jmu) = zi2b(jlev-1, jmu) - z_tempb12
          CALL POPREAL8(zd)
          CALL POPREAL8(zc)
          CALL POPREAL8(zf)
          zhb(jlev-1) = zhb(jlev-1) - zfb
        ENDDO
        CALL POPREAL8(zyy)
        zi1b(0, jmu) = 0._JPRB
      ENDDO
      DO jmu=kmu,1,-1
        zzi1b = 0._JPRB
        DO jlev=0,knt-1,1
          zzi1b = zzi1b + zi1b(jlev, jmu)
          zi1b(jlev, jmu) = 0._JPRB
          CALL POPINTEGER4(i_branch)
          IF (.NOT.i_branch  <   1) zzi1b = 0._JPRB
          CALL POPREAL8(zzi1)
          z_tempb9 = 0.5_JPRB*zzi1b
          zdb = (zb+zyy*za)*z_tempb9
          zxxb = za*z_tempb9
          zcb = zzi1*zzi1b - zdb - zh(jlev+1)*zxxb
          zbb = zd*z_tempb9
          zab = (zxx+zd*zyy)*z_tempb9 - zh(jlev)*zbb
          zzi1b = zc*zzi1b
          CALL POPREAL8(zxx)
          zhb(jlev) = zhb(jlev) + zxxb
          zhb(jlev+1) = zhb(jlev+1) - zc*zxxb
          CALL POPREAL8(zd)
          CALL POPREAL8(zc)
          z_tempb10 = zab/zf
          zfb = -((zi2(jlev+1, jmu)-zi2(jlev, jmu))*z_tempb10/zf) - EXP(-(&
&            zf/zyy))*zcb/zyy
          CALL POPREAL8(zb)
          zi2b(jlev, jmu) = zi2b(jlev, jmu) + zbb
          zhb(jlev) = zhb(jlev) - za*zbb
          CALL POPREAL8(za)
          zi2b(jlev+1, jmu) = zi2b(jlev+1, jmu) + z_tempb10
          zi2b(jlev, jmu) = zi2b(jlev, jmu) - z_tempb10
          CALL POPREAL8(zf)
          zhb(jlev+1) = zhb(jlev+1) + zfb
          zhb(jlev) = zhb(jlev) - zfb
        ENDDO
        CALL POPREAL8(zyy)
        zi1b(knt, jmu) = 0._JPRB
      ENDDO
      CALL POPINTEGER4(i_branch)
      IF (i_branch  <   2) THEN
        IF (i_branch  <   1) THEN
          CALL POPREAL8ARRAY(zi2, 27*51)
          WHERE (ll_mask(:, :)) zi2b(:, :) = 0._JPRB
          CALL POPBOOLEANARRAY(ll_mask, 27*51)
          DO jmu=kmu,1,-1
            DO jlev=knt,0,-1
              CALL POPREAL8(zi2(jlev, -jmu))
              zii1b = zi2b(jlev, -jmu)
              zi2b(jlev, -jmu) = 0._JPRB
              CALL POPREAL8(zi2(jlev, jmu))
              zii2b = zi2b(jlev, jmu)
              zi2b(jlev, jmu) = 0._JPRB
              zxb = 0._JPRB
              zyb = 0._JPRB
              DO jmu2=kmu,1,-1
                zxdbb = zii1b
                z_tempb5 = zaux2*zxdbb
                zxdbb = zii2b
                z_tempb6 = zaux2*zxdbb
                zxi1b = zbpjk*z_tempb6 + zbpjmk*z_tempb5
                zbpjmkb = zxi2*z_tempb6 + zxi1*z_tempb5
                zxi2b = zbpjmk*z_tempb6 + zbpjk*z_tempb5
                zbpjkb = zxi1*z_tempb6 + zxi2*z_tempb5
                CALL POPREAL8(zbpjmk)
                z_pbpb(jlev, jmu2, -jmu) = z_pbpb(jlev, jmu2, -jmu) + zx*&
&                  zbpjmkb
                zxb = zxb + z_pbp(jlev, jmu2, jmu)*zbpjkb + z_pbp(jlev, jmu2&
&                  , -jmu)*zbpjmkb
                zyb = zyb + (zbeta0+zbeta2*zxpj*zxpk)*zbpjkb + (zbeta0+&
&                  zbeta2*zxpj*zypk)*zbpjmkb
                CALL POPREAL8(zbpjk)
                z_pbpb(jlev, jmu2, jmu) = z_pbpb(jlev, jmu2, jmu) + zx*&
&                  zbpjkb
                CALL POPREAL8(zxi2)
                zi1b(jlev, -jmu2) = zi1b(jlev, -jmu2) + zxi2b
                CALL POPREAL8(zxi1)
                zi1b(jlev, jmu2) = zi1b(jlev, jmu2) + zxi1b
                CALL POPREAL8(zaux2)
                CALL POPREAL8(zxpj)
              ENDDO
              CALL POPREAL8(zy)
              zydelb(jlev) = zydelb(jlev) + zyb
              CALL POPREAL8(zx)
              zxdelb(jlev) = zxdelb(jlev) + zxb
            ENDDO
            CALL POPREAL8(zypk)
            CALL POPREAL8(zxpk)
          ENDDO
        ENDIF
      ELSE
        CALL POPREAL8ARRAY(zi2, 27*51)
        WHERE (ll_mask0(:, :)) zi2b(:, :) = 0._JPRB
        CALL POPBOOLEANARRAY(ll_mask0, 27*51)
        DO jmu=kmu,1,-1
          DO jlev=knt,0,-1
            CALL POPREAL8(zi2(jlev, -jmu))
            zii1b = zi2b(jlev, -jmu)
            zi2b(jlev, -jmu) = 0._JPRB
            CALL POPREAL8(zi2(jlev, jmu))
            zii2b = zi2b(jlev, jmu)
            zi2b(jlev, jmu) = 0._JPRB
            zxb = 0._JPRB
            DO jmu2=kmu,1,-1
              zxdbb = zii1b
              z_tempb7 = zaux2*zxdbb
              zxdbb = zii2b
              z_tempb8 = zaux2*zxdbb
              zxi1b = zbpjk*z_tempb8 + zbpjmk*z_tempb7
              zbpjmkb = zxi2*z_tempb8 + zxi1*z_tempb7
              zxi2b = zbpjmk*z_tempb8 + zbpjk*z_tempb7
              zbpjkb = zxi1*z_tempb8 + zxi2*z_tempb7
              CALL POPREAL8(zbpjmk)
              z_pbpb(jlev, jmu2, -jmu) = z_pbpb(jlev, jmu2, -jmu) + zx*&
&                zbpjmkb
              zxb = zxb + z_pbp(jlev, jmu2, jmu)*zbpjkb + z_pbp(jlev, jmu2, &
&                -jmu)*zbpjmkb
              CALL POPREAL8(zbpjk)
              z_pbpb(jlev, jmu2, jmu) = z_pbpb(jlev, jmu2, jmu) + zx*zbpjkb
              CALL POPREAL8(zxi2)
              zi1b(jlev, -jmu2) = zi1b(jlev, -jmu2) + zxi2b
              CALL POPREAL8(zxi1)
              zi1b(jlev, jmu2) = zi1b(jlev, jmu2) + zxi1b
              CALL POPREAL8(zaux2)
            ENDDO
            CALL POPREAL8(zx)
            zxdelb(jlev) = zxdelb(jlev) + zxb
          ENDDO
        ENDDO
      ENDIF
    ENDDO
    DO jmu=kmu,1,-1
      zi1b(0, jmu) = zi1b(0, jmu) + zinm1b(jmu) + zi3b(jmu)
      zi3b(jmu) = 0._JPRB
      zinm1b(jmu) = 0._JPRB
    ENDDO
    DO jmu=-1,-kmu,-1
      zi1b(knt, jmu) = zi1b(knt, jmu) + zinm1b(jmu) + zi3b(jmu)
      zi3b(jmu) = 0._JPRB
      zinm1b(jmu) = 0._JPRB
    ENDDO
    DO jmu=-1,-kmu,-1
      zzi1b = 0._JPRB
      DO jlev=knt,1,-1
        zzi1b = zzi1b + zi1b(jlev, jmu)
        zi1b(jlev, jmu) = 0._JPRB
        CALL POPREAL8(zzi1)
        z_tempb3 = 0.5_JPRB*zzi1b
        zdb = (zb+zy*za)*z_tempb3
        zxb = za*z_tempb3
        zcb = zzi1*zzi1b - zdb - zh(jlev-1)*zxb
        zbb = zd*z_tempb3
        zab = (zx+zd*zy)*z_tempb3 - zh(jlev)*zbb
        zzi1b = zc*zzi1b
        CALL POPREAL8(zx)
        zhb(jlev) = zhb(jlev) + zxb
        zhb(jlev-1) = zhb(jlev-1) - zc*zxb
        CALL POPREAL8(zb)
        z_tempb4 = zab/zf
        zi2b(jlev, jmu) = zi2b(jlev, jmu) + z_tempb4 + zbb
        zfb = EXP(zf/zy)*zcb/zy - (zi2(jlev, jmu)-zi2(jlev-1, jmu))*&
&          z_tempb4/zf
        zhb(jlev) = zhb(jlev) + zfb - za*zbb
        CALL POPREAL8(za)
        zi2b(jlev-1, jmu) = zi2b(jlev-1, jmu) - z_tempb4
        CALL POPREAL8(zd)
        CALL POPREAL8(zc)
        CALL POPREAL8(zf)
        zhb(jlev-1) = zhb(jlev-1) - zfb
      ENDDO
      CALL POPREAL8(zy)
      zi1b(0, jmu) = 0._JPRB
    ENDDO
    DO jmu=kmu,1,-1
      zzi1b = 0._JPRB
      DO jlev=0,knt-1,1
        zzi1b = zzi1b + zi1b(jlev, jmu)
        zi1b(jlev, jmu) = 0._JPRB
        CALL POPREAL8(zzi1)
        z_tempb1 = 0.5_JPRB*zzi1b
        zdb = (zb+zy*za)*z_tempb1
        zxb = za*z_tempb1
        zcb = zzi1*zzi1b - zdb - zh(jlev+1)*zxb
        zbb = zd*z_tempb1
        zab = (zx+zd*zy)*z_tempb1 - zh(jlev)*zbb
        zzi1b = zc*zzi1b
        CALL POPREAL8(zx)
        zhb(jlev) = zhb(jlev) + zxb
        zhb(jlev+1) = zhb(jlev+1) - zc*zxb
        CALL POPREAL8(zd)
        CALL POPREAL8(zc)
        z_tempb2 = zab/zf
        zfb = -((zi2(jlev+1, jmu)-zi2(jlev, jmu))*z_tempb2/zf) - EXP(-(zf/&
&          zy))*zcb/zy
        CALL POPREAL8(zb)
        zi2b(jlev, jmu) = zi2b(jlev, jmu) + zbb
        zhb(jlev) = zhb(jlev) - za*zbb
        CALL POPREAL8(za)
        zi2b(jlev+1, jmu) = zi2b(jlev+1, jmu) + z_tempb2
        zi2b(jlev, jmu) = zi2b(jlev, jmu) - z_tempb2
        CALL POPREAL8(zf)
        zhb(jlev+1) = zhb(jlev+1) + zfb
        zhb(jlev) = zhb(jlev) - zfb
      ENDDO
      CALL POPREAL8(zy)
      zi1b(knt, jmu) = 0._JPRB
    ENDDO
    DO jmu=kmu,-kmu,-1
      DO jlev=knt,0,-1
        CALL POPREAL8(zi2(jlev, jmu))
        z_tempb0 = zch(jlev)*zi2b(jlev, jmu)
        zchb(jlev) = zchb(jlev) + (zsa2(jlev)*zxdel(jlev)+zsa1*zydel(&
&          jlev))*zi2b(jlev, jmu)
        zsa2b(jlev) = zsa2b(jlev) + zxdel(jlev)*z_tempb0
        zxdelb(jlev) = zxdelb(jlev) + zsa2(jlev)*z_tempb0
        zydelb(jlev) = zydelb(jlev) + zsa1*z_tempb0
        zi2b(jlev, jmu) = 0._JPRB
        CALL POPREAL8(zsa2(jlev))
        z_pbpb(jlev, 0, jmu) = z_pbpb(jlev, 0, jmu) + zsa2b(jlev)
        zsa2b(jlev) = 0._JPRB
      ENDDO
      CALL POPINTEGER4(i_branch)
      IF (i_branch  <   1) THEN
        CALL POPREAL8(zsa1)
      ELSE
        CALL POPREAL8(zsa1)
      ENDIF
    ENDDO
    CALL POPINTEGER4(i_branch)
    IF (.NOT.i_branch  <   1) CALL POPREAL8(zbeta0)
    CALL POPREAL8ARRAY(z_pbp, 27*26*51)
    CALL KERNEL_PBP_AD(jpleg, ppsl, pbetal, pbetalb, z_pxpl, z_pbp, z_pbpb)
  ENDDO
  CALL POPINTEGER4(i_branch)
  IF (.NOT.i_branch  <   1) THEN
    zauxb = 0._JPRB
    DO jlev=knt,0,-1
      z_tempb = zxdelb(jlev)/(ptray(jlev)+ptamoy(jlev))
      zhb(jlev) = zhb(jlev) - EXP(-(zh(jlev)/zxmus))*zchb(jlev)/(2.0_JPRB*&
&        zxmus)
      zauxb = zauxb + zhb(jlev)
      ptamoyb(jlev) = ptamoyb(jlev) + (pizmoy(jlev)-pizmoy(jlev)*ptamoy(&
&        jlev)/(ptray(jlev)+ptamoy(jlev)))*z_tempb + zauxb - ptray(jlev)*&
&        zydelb(jlev)/(ptray(jlev)+ptamoy(jlev))**2
      zydelb(jlev) = 0._JPRB
      pizmoyb(jlev) = pizmoyb(jlev) + ptamoy(jlev)*z_tempb
      zxdelb(jlev) = 0._JPRB
      zchb(jlev) = 0._JPRB
      CALL POPREAL8(zh(jlev))
      zhb(jlev) = 0._JPRB
    ENDDO
  ENDIF
  CALL POPINTEGER4(i_branch)
  IF (.NOT.i_branch  <   1) THEN
    zauxb = 0._JPRB
    DO jlev=knt,0,-1
      pizmoyb(jlev) = pizmoyb(jlev) + zxdelb(jlev)
      zxdelb(jlev) = 0._JPRB
      zhb(jlev) = zhb(jlev) - EXP(-(zh(jlev)/zxmus))*zchb(jlev)/(2.0_JPRB*&
&        zxmus)
      zchb(jlev) = 0._JPRB
      zauxb = zauxb + zhb(jlev)
      zhb(jlev) = 0._JPRB
      ptamoyb(jlev) = ptamoyb(jlev) + zauxb
    ENDDO
  ENDIF

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