!  Differentiation of vertdisc in reverse (adjoint) mode:
!   gradient, with respect to input variables: ptaer_vertin phasel_in
!                piz_in
!   of linear combination of output variables: piz phasel ptaer_vert

SUBROUTINE VERTDISC_AD(pwl, ptray550_vertin, ptaer_vertin, ptaer_vertinb, &
&  phasel_in, phasel_inb, piz_in, piz_inb, ptaer_vert, ptaer_vertb, &
&  ptray_vert, phasel, phaselb, piz, pizb)

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

USE rt6svalues

  IMPLICIT NONE

!****VERTDISC*** ROUTINE THAT DISCRETICES THE VERTICAL INTO ISO-OPTICAL
!                DEPTH LAYERS. THIS IS DONE WITH RESPECT TO THE TOTAL 
!                OPTICAL DEPTH.
! The difference of this version with respect to the original one is that this one keeps
! the same values for the first layer (TOA) as the original profiles. It uses the rest 
! of the layers for the discretisation.

!    N.HUNEEUS ,  LOA 

!     INTERFACE
!     ---------
!           VERTDISC IS CALLED IN THE MAIN ROUTINE 6S_GEMS

!     INPUTS
!     ------
! 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.

!     OUTPUTS
!     -------
! PTAER_VERT(KLON,KNT,KWL)     : Aerosol optical thickness profile.
! PTRAY_VERT(KLON,KNT,KWL)     : Molecular optical thickness profile
! PHASEL(KLON,KLEV,KWL,KMU)    : Aerosol phase function profile.
! PIZ(KLON,KLEV,KWL)           : Aerosol single scattering albedo profile.


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

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

!     SWITCHES.
!     --------

!     MODEL PARAMETERS
!     ----------------
!--------------------------------------------------------------------------------------
  REAL(KIND=JPRB), INTENT(IN) :: pwl(kwl)
  REAL(KIND=JPRB), INTENT(IN) :: ptray550_vertin(klon, 0:klev), ptaer_vertin(klon,0:klev, kwl)
  REAL(KIND=JPRB), INTENT(INOUT) :: ptaer_vertinb(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(INOUT) :: phasel_inb(klon, 0:klev, kwl, knbmu), piz_inb(klon, 0:klev, kwl)
  REAL(KIND=JPRB), INTENT(IN) :: ptaer_vert(klon, 0:knt, kwl), ptray_vert(klon, 0:knt, kwl)
  REAL(KIND=JPRB), INTENT(INOUT) :: ptaer_vertb(klon, 0:knt, kwl)
  REAL(KIND=JPRB), INTENT(IN) :: phasel(klon, 0:knt, kwl, knbmu), piz(klon, 0:knt, kwl)
  REAL(KIND=JPRB), INTENT(INOUT) :: phaselb(klon, 0:knt, kwl, knbmu), pizb(klon, 0:knt, kwl)
! LOCAL VARIABLES
! ---------------
!INTEGER(KIND=JPIM),PARAMETER  :: KMU=25, KMU2=48, KNP=49, KNANG=80, KNBMU=83, KNT=20, KWL=1 
  INTEGER(KIND=JPIM) :: jlev, jdiv, jlon, jwl, jaux, jcont, jmu
!INTEGER(KIND=JPIM),PARAMETER :: ICTE=5 !TOGETHER WITH KNT THEY DETERMINE THE NUMBER OF LAYERS EACH
!ORIGINAL LAYER WILL DIVIDED
  REAL(KIND=JPRB) :: ztray(0:(klev+1)*idiv-1), ztaer(0:(klev+1)*idiv-1)&
&  , ztray_vertin(0:klev)
  REAL(KIND=JPRB) :: ztaerb(0:(klev+1)*idiv-1)
  REAL(KIND=JPRB) :: zpha(0:(klev+1)*idiv-1, knbmu), zpiz(0:(klev+1)*idiv-1)
  REAL(KIND=JPRB) :: zphab(0:(klev+1)*idiv-1, knbmu), zpizb(0:(klev+1)*idiv-1)
  REAL(KIND=JPRB) :: zod_axis, ziso_od, zodnew_aer, zodnew_ray, zodnew
  REAL(KIND=JPRB) :: zodnew_aerb
  REAL(KIND=JPRB) :: zomega, zphase(knbmu)
  REAL(KIND=JPRB) :: zomegab, zphaseb(knbmu)

  INTEGER(KIND=JPIM) :: i_branch
  INTRINSIC FLOAT
  REAL(KIND=JPRB) :: z_tempb


  REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "popinteger4.intfb.h"
#include "popreal8.intfb.h"
!#include "popreal8array.intfb.h"
#include "pushinteger4.intfb.h"
#include "pushreal8.intfb.h"
!#include "pushreal8array.intfb.h"

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

  DO jwl=1,kwl
    DO jlon=1,klon
! JLEV=0 CORRESPONDS TO THE TOP OF THE ATMOPSHERE. THE VARIABLES WITH THE NEW VERTICAL DISCRETIZATION

!  1. MOLECULAR OPTICAL THICKNESS AT DIFFERENT WAVELENGTHS 
!     ----------------------------------------------------

!    print *,'1. MOLECULAR OPTICAL THICKNESS AT DIFFERENT WAVELENGTHS'
      DO jlev=0,klev
        ztray_vertin(jlev) = ptray550_vertin(jlon, jlev)*(pwl(jwl)/&
&          pwl550)**(-4)
      ENDDO

! JLEV=0 CORRESPONDS TO THE TOP OF THE ATMOPSHERE. THE VARIABLES WITH THE NEW VERTICAL DISCRETIZATION

!  2. CALCULATING ISO-OPTICAL THICKNESS
!     ---------------------------------

      zod_axis = 0.0
      DO jlev=1,klev
        zod_axis = zod_axis + ptaer_vertin(jlon, jlev, jwl) + &
&          ztray_vertin(jlev)
      ENDDO
!    ZISO_OD=ZOD_AXIS/FLOAT(KNT+1)
      ziso_od = zod_axis/FLOAT(knt)
      CALL PUSHREAL8ARRAY(ztaer, 3510)

!  3. SPLITTING OF ORIGINAL LAYERS INTO IDIV LAYERS
!     ---------------------------------------------
!    print *,'2. SPLITTING OF ORIGINAL LAYERS INTO IDIV LAYERS'
      ztaer(:) = 0.000000001_JPRB
      ztray(:) = 0._JPRB
      CALL PUSHREAL8ARRAY(zpiz, 3510)
      zpiz(:) = 0.000000001_JPRB
      CALL PUSHREAL8ARRAY(zpha, 3510*83)
      zpha(:, :) = 0.000000001_JPRB
      DO jlev=1,klev
        DO jdiv=1,idiv
          CALL PUSHINTEGER4(jaux)
          jaux = jlev*idiv + jdiv
          ztaer(jaux-1) = ptaer_vertin(jlon, jlev, jwl)/idiv
          ztray(jaux-1) = ztray_vertin(jlev)/idiv
          zpiz(jaux-1) = piz_in(jlon, jlev, jwl)
          DO jmu=1,knbmu
            zpha(jaux-1, jmu) = phasel_in(jlon, jlev, jwl, jmu)
          ENDDO
        ENDDO
      ENDDO
      CALL PUSHREAL8(zodnew_aer)

!  4. NEW VERTICAL DISCRETIZATION
!     ---------------------------

!    print *,'3. NEW VERTICAL DISCRETIZATION'
      zodnew_aer = 0.0
      zodnew_ray = 0.0
      CALL PUSHREAL8(zomega)
      zomega = 0.0
      CALL PUSHREAL8ARRAY(zphase, 83)
      zphase(:) = 0.0
      CALL PUSHINTEGER4(jcont)
      jcont = 1
      DO jlev=1,idiv*(klev+1)-1
        zodnew = zodnew_aer + zodnew_ray
        CALL PUSHREAL8(zodnew_aer)
        zodnew_aer = zodnew_aer + ztaer(jlev)
        zodnew_ray = zodnew_ray + ztray(jlev)
        CALL PUSHREAL8(zomega)
        zomega = zomega + ztaer(jlev)*zpiz(jlev)
        DO jmu=1,knbmu
          CALL PUSHREAL8(zphase(jmu))
          zphase(jmu) = zphase(jmu) + zpha(jlev, jmu)*ztaer(jlev)*zpiz(&
&            jlev)
        ENDDO
        IF (zodnew + ztaer(jlev) + ztray(jlev)  >   ziso_od) THEN
          CALL PUSHREAL8(zodnew_aer)
! Starting new layer   
          zodnew_aer = 0.0
          zodnew_ray = 0.0
          CALL PUSHREAL8(zomega)
          zomega = 0.0
          CALL PUSHREAL8ARRAY(zphase, 83)
          zphase(:) = 0.0
          CALL PUSHINTEGER4(jcont)
          jcont = jcont + 1
          CALL PUSHINTEGER4(2)
        ELSE
          CALL PUSHINTEGER4(1)
        ENDIF
      ENDDO
    ENDDO
  ENDDO
  ptaer_vertinb(1:klon, 0:klev, 1:kwl) = 0._JPRB
  phasel_inb(1:klon, 0:klev, 1:kwl, 1:knbmu) = 0._JPRB
  piz_inb(1:klon, 0:klev, 1:kwl) = 0._JPRB
  DO jwl=kwl,1,-1
    DO jlon=klon,1,-1
      zpizb(0:(klev+1)*idiv-1) = 0._JPRB
      zodnew_aerb = 0._JPRB
      zphaseb(1:knbmu) = 0._JPRB
      zomegab = 0._JPRB
      zphab(0:(klev+1)*idiv-1, 1:knbmu) = 0._JPRB
      ztaerb(0:(klev+1)*idiv-1) = 0._JPRB
      DO jlev=idiv*(klev+1)-1,1,-1
        CALL POPINTEGER4(i_branch)
        IF (.NOT.i_branch  <   2) THEN
          CALL POPINTEGER4(jcont)
          CALL POPREAL8ARRAY(zphase, 83)
          CALL POPREAL8(zomega)
          CALL POPREAL8(zodnew_aer)
          zodnew_aerb = 0._JPRB
          zphaseb(1:knbmu) = 0._JPRB
          zomegab = 0._JPRB
        ENDIF
        DO jmu=knbmu,1,-1
          zphaseb(jmu) = zphaseb(jmu) + phaselb(jlon, jcont, jwl, jmu)/&
&            zomega
          zomegab = zomegab - zphase(jmu)*phaselb(jlon, jcont, jwl, jmu)&
&            /zomega**2
          phaselb(jlon, jcont, jwl, jmu) = 0._JPRB
        ENDDO
        zomegab = zomegab + pizb(jlon, jcont, jwl)/zodnew_aer
        zodnew_aerb = zodnew_aerb + ptaer_vertb(jlon, jcont, jwl) - &
&          zomega*pizb(jlon, jcont, jwl)/zodnew_aer**2
        pizb(jlon, jcont, jwl) = 0._JPRB
        ptaer_vertb(jlon, jcont, jwl) = 0._JPRB
        DO jmu=knbmu,1,-1
          CALL POPREAL8(zphase(jmu))
          z_tempb = zpha(jlev, jmu)*zphaseb(jmu)
          zphab(jlev, jmu) = zphab(jlev, jmu) + ztaer(jlev)*zpiz(jlev)*&
&            zphaseb(jmu)
          ztaerb(jlev) = ztaerb(jlev) + zpiz(jlev)*z_tempb
          zpizb(jlev) = zpizb(jlev) + ztaer(jlev)*z_tempb
        ENDDO
        CALL POPREAL8(zomega)
        ztaerb(jlev) = ztaerb(jlev) + zodnew_aerb + zpiz(jlev)*zomegab
        zpizb(jlev) = zpizb(jlev) + ztaer(jlev)*zomegab
        CALL POPREAL8(zodnew_aer)
      ENDDO
      CALL POPINTEGER4(jcont)
      CALL POPREAL8ARRAY(zphase, 83)
      CALL POPREAL8(zomega)
      CALL POPREAL8(zodnew_aer)
      DO jlev=klev,1,-1
        DO jdiv=idiv,1,-1
          DO jmu=knbmu,1,-1
            phasel_inb(jlon, jlev, jwl, jmu) = phasel_inb(jlon, jlev, &
&              jwl, jmu) + zphab(jaux-1, jmu)
            zphab(jaux-1, jmu) = 0._JPRB
          ENDDO
          piz_inb(jlon, jlev, jwl) = piz_inb(jlon, jlev, jwl) + zpizb(&
&            jaux-1)
          zpizb(jaux-1) = 0._JPRB
          ptaer_vertinb(jlon, jlev, jwl) = ptaer_vertinb(jlon, jlev, jwl&
&            ) + ztaerb(jaux-1)/idiv
          ztaerb(jaux-1) = 0._JPRB
          CALL POPINTEGER4(jaux)
        ENDDO
      ENDDO
      CALL POPREAL8ARRAY(zpha, 3510*83)
      CALL POPREAL8ARRAY(zpiz, 3510)
      CALL POPREAL8ARRAY(ztaer, 3510)
      DO jmu=knbmu,1,-1
        phasel_inb(jlon, 0, jwl, jmu) = phasel_inb(jlon, 0, jwl, jmu) + &
&          phaselb(jlon, 0, jwl, jmu)
        phaselb(jlon, 0, jwl, jmu) = 0._JPRB
      ENDDO
      piz_inb(jlon, 0, jwl) = piz_inb(jlon, 0, jwl) + pizb(jlon, 0, jwl)
      pizb(jlon, 0, jwl) = 0._JPRB
      ptaer_vertinb(jlon, 0, jwl) = ptaer_vertinb(jlon, 0, jwl) + &
&        ptaer_vertb(jlon, 0, jwl)
      ptaer_vertb(jlon, 0, jwl) = 0._JPRB
    ENDDO
  ENDDO

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