SUBROUTINE SWNIAD &
 & ( KIDIA , KFDIA  , KLON   , KLEV   , KAER   , KNU,&
 & PAER5 , PAKI5  , PALBD5 , PALBP5,&
 & PCG5  , PCLD5  , PCLEAR5,&
 & PDSIG5, POMEGA5, POZ5   , PRMU5  , PSEC5  , PTAU5,&
 & PUD5  , PWV5   , PQS5,&
 & PFDOWN5,PFUP5,&
! PCDOWN5, PCUP5,&
 & PAER  , PAKI   , PALBD  , PALBP,&
 & PCG   , PCLD   , PCLEAR,&
 & PDSIG , POMEGA , POZ    , PRMU   , PSEC   , PTAU,&
 & PUD   , PWV    , PQS,&
 & PFDOWN, PFUP &
!, PCDOWN , PCUP &
 & )  

!**** *SWNIAD* - SHORTWAVE RADIATION, NEAR-INFRARED SPECTRAL INTERVALS
!                -> ADJOINT <-

!     PURPOSE.
!     --------

!          COMPUTES THE SHORTWAVE RADIATION FLUXES IN THE NEAR-INFRARED 
!     SPECTRAL INTERVALS ADAPTED FROM FOUQUART AND BONNEL (1980).

!**   INTERFACE.
!     ----------

!          *SWNIAD* IS CALLED FROM *SWAD*.

!        IMPLICIT ARGUMENTS :
!        --------------------

!     ==== INPUTS ===
!     ==== OUTPUTS ===

!     METHOD.
!     -------

!          1. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING TO
!     CONTINUUM SCATTERING FOR CLEAR-SKY AND CLOUDY PARTS OF THE COLUMN
!          2. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING FOR
!     A GREY MOLECULAR ABSORPTION
!          3. LAPLACE TRANSFORM ON THE PREVIOUS TO GET EFFECTIVE AMOUNTS
!     OF ABSORBERS
!          4. APPLY H2O AND U.M.G. TRANSMISSION FUNCTIONS
!          5. MULTIPLY BY OZONE TRANSMISSION FUNCTION

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

!          *SWCLR*  , *SWR*  , *SWDE*  , *SWTT*  , *SWTT1*
!          *SWCLRAD*, *SWRAD*, *SWDEAD*, *SWTTAD*, *SWTT1AD*

!     REFERENCE.
!     ----------

!        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
!        DOCUMENTATION

!     AUTHOR.
!     -------
!        JEAN-JACQUES MORCRETTE  *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 96-11-04
!        Modified : 99-26-04 M. Janiskova - corrections of AD code
!                 2000-02-24 M.Janiskova - adopted for  revised aerosols
!                                          as in swni
!                 2002-05-06 M.Janiskova - revised according to JJMorcrette
!                                          modiffications
!        03-10-10 Deborah Salmond and Marta Janiskova Optimisation
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!                 26-Mar-2008 M.Janiskova - code optimization and cleaning
!     ------------------------------------------------------------------

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

USE YOESW    , ONLY : RRAY     ,RSUN     ,RSWCE    ,RSWCP
USE YOERAD   , ONLY : NSW
USE YOERDU   , ONLY : REPLOG   ,REPSCQ   ,REPSC

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KAER 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNU 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER5(KLON,6,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAKI5(KLON,2,NSW) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD5(KLON,NSW) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP5(KLON,NSW) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCG5(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLD5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLEAR5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDSIG5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POMEGA5(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POZ5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSEC5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU5(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUD5(KLON,5,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWV5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFDOWN5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFUP5(KLON,KLEV+1) 
!REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCDOWN5(KLON,KLEV+1)
!REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCUP5(KLON,KLEV+1)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAER(KLON,6,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAKI(KLON,2,NSW) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PALBD(KLON,NSW) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PALBP(KLON,NSW) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCG(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCLD(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCLEAR(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDSIG(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: POMEGA(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: POZ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRMU(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSEC(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTAU(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUD(KLON,5,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWV(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQS(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFDOWN(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFUP(KLON,KLEV+1) 
!REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCDOWN(KLON,KLEV+1)
!REAL(KIND=JPRB)   ,INTENT(INOUT)  :: PCUP(KLON,KLEV+1)
!     ------------------------------------------------------------------

!*       0.1   ARGUMENTS
!              ---------

!     ------------------------------------------------------------------

!              ------------

INTEGER(KIND=JPIM) :: IIND2(2), IIND3(3)

REAL(KIND=JPRB) :: ZCGAZ5(KLON,KLEV)&
 & ,  ZFD5(KLON,KLEV+1)    , ZFU5(KLON,KLEV+1) &
 & ,  ZPIZAZ5(KLON,KLEV)   , ZRAYL15(KLON), ZRAYL5(KLON) &
 & ,  ZRAY15(KLON,KLEV+1)  , ZRAY015(KLON,KLEV+1)&
 & ,  ZRAY25(KLON,KLEV+1)  , ZRAY025(KLON,KLEV+1)&
 & ,  ZREFZ5(KLON,2,KLEV+1), ZREFZ05(KLON,2,KLEV+1)&
 & ,  ZRJ5(KLON,6,KLEV+1)  , ZRJ05(KLON,6,KLEV+1)&
 & ,  ZRK5(KLON,6,KLEV+1)  , ZRK05(KLON,6,KLEV+1)&
 & ,  ZRL5(KLON,8,KLEV+1)&
 & ,  ZRMUE5(KLON,KLEV+1)  , ZRMU05(KLON,KLEV+1)&
 & ,  ZR25(KLON,2)
REAL(KIND=JPRB) :: ZTAUAZ5(KLON,KLEV) &
 & ,  ZTRA15(KLON,KLEV+1)  , ZTRA015(KLON,KLEV+1)&
 & ,  ZTRA25(KLON,KLEV+1)  , ZTRA025(KLON,KLEV+1)&
 & ,  ZTRCLD5(KLON)        , ZTRCLR5(KLON)&
 & ,  ZDUMMY(KLON,KLEV)  

!-- extra fields for adjoint computations

REAL(KIND=JPRB) :: ZFUP5(KLON,KLEV+1)  , ZFDOWN5(KLON,KLEV+1)&
 & ,  ZDR15(KLON,KLEV+1)  , ZDR45(KLON,KLEV+1) &
 & ,  ZDRC35(KLON,3,KLEV+1),ZDRC45(KLON,KLEV+1)&
 & ,  ZDW35(KLON,3,KLEV+1), ZDW45(KLON,KLEV+1) ,ZDW55(KLON,KLEV+1)&
 & ,  ZDWM15(KLON,KLEV+1) , ZDWM45(KLON,KLEV+1),ZDWM55(KLON,KLEV+1)&
 & ,  ZSGG5(KLON,2,KLEV+1)  &
 & ,  ZSR215(KLON,2,KLEV+1) , ZSR225(KLON,2,KLEV+1)&
 & ,  ZSW25(KLON,2,6,KLEV+1) &
 & ,  ZUR15(KLON,KLEV+1)  , ZUR45(KLON,KLEV+1) &
 & ,  ZURC35(KLON,3,KLEV+1),ZURC45(KLON,KLEV+1)&
 & ,  ZUW35(KLON,3,KLEV+1),ZUW45(KLON,KLEV+1)  ,ZUW55(KLON,KLEV+1)&
 & ,  ZUWM15(KLON,KLEV+1) , ZUWM45(KLON,KLEV+1),ZUWM55(KLON,KLEV+1)  

REAL(KIND=JPRB) :: ZSWH2O5(KLON,2,KLEV+1)&
 & ,  ZSBB5(KLON,2,KLEV+1) , ZSAAT5(KLON,2,KLEV+1)&
 & ,  ZSAA5(KLON,2,KLEV+1) , ZSG5(KLON,2,KLEV+1)&
 & ,  ZSS5(KLON,2,KLEV+1)  , ZSTO15(KLON,2,KLEV+1)&
 & ,  ZSW05(KLON,2,KLEV+1) &
 & ,  ZSRE15(KLON,2,KLEV+1), ZSRE25(KLON,2,KLEV+1)&
 & ,  ZSTR15(KLON,2,KLEV+1), ZSTR25(KLON,2,KLEV+1)   

REAL(KIND=JPRB) :: ZRMUM15(KLON)  , ZCNEB5(KLON,2,KLEV)&
 & ,  ZPNEB5(KLON,KLEV)&
 & ,  ZRJ15(KLON,6,KLEV+1) , ZRK15(KLON,6,KLEV+1)&
 & ,  ZRJ25(KLON,6,KLEV+1) , ZRK25(KLON,6,KLEV+1)    
REAL(KIND=JPRB) :: ZREFZ15(KLON,KLEV+1,2), ZREFZ25(KLON,KLEV+1,2)
REAL(KIND=JPRB) :: ZZTR15(KLON,KLEV+1,2) , ZZTR25(KLON,KLEV+1,2)
REAL(KIND=JPRB) :: ZLOG15(KLON,6,KLEV+1), ZLOG25(KLON,6,KLEV+1)
REAL(KIND=JPRB) :: ZRR15(KLON,KLEV+1,2), ZRR25(KLON,2)
REAL(KIND=JPRB) :: ZRR35(KLON,KLEV), ZRR45(KLON,KLEV)
!---

REAL(KIND=JPRB) :: ZCGAZ(KLON,KLEV)&
 & ,  ZFD(KLON,KLEV+1)     , ZFU(KLON,KLEV+1) &
 & ,  ZG(KLON)             , ZGG(KLON)&
 & ,  ZPIZAZ(KLON,KLEV)    ,  ZRAYL(KLON)       &
 & ,  ZRAY1(KLON,KLEV+1)   , ZRAY01(KLON,KLEV+1)&
 & ,  ZRAY2(KLON,KLEV+1)   , ZRAY02(KLON,KLEV+1)&
 & ,  ZRE1(KLON), ZRE2(KLON), ZREF(KLON)        &
 & ,  ZREFZ(KLON,2,KLEV+1) , ZREFZ0(KLON,2,KLEV+1)&
 & ,  ZRJ(KLON,6,KLEV+1)   , ZRJ0(KLON,6,KLEV+1)&
 & ,  ZRK(KLON,6,KLEV+1)   , ZRK0(KLON,6,KLEV+1)&
 & ,  ZRL(KLON,8)&
 & ,  ZRMUE(KLON,KLEV+1)   , ZRMU0(KLON,KLEV+1) &
 & ,  ZR1(KLON) , ZR2(KLON,2), ZR3(KLON,3), ZR4(KLON)&
 & ,  ZR21(KLON), ZR22(KLON) , ZS(KLON)  
REAL(KIND=JPRB) :: ZTAUAZ(KLON,KLEV)    , ZTO1(KLON)&
 & ,  ZTR(KLON,2,KLEV+1)&
 & ,  ZTRA1(KLON,KLEV+1)   , ZTRA01(KLON,KLEV+1)&
 & ,  ZTRA2(KLON,KLEV+1)   , ZTRA02(KLON,KLEV+1)&
 & ,  ZTR1(KLON)           , ZTR2(KLON)&
 & ,  ZW0(KLON)       , ZW1(KLON)        , ZW2(KLON,2)&
 & ,  ZW3(KLON,3)     , ZW4(KLON)        , ZW5(KLON)&
 & ,  ZTMP1(KLON)     , ZTMP2(KLON)      , ZTMP3(KLON)
REAL(KIND=JPRB) :: ZRR2(KLON,2)

INTEGER(KIND=JPIM) :: IABS, IKL, IKLP1, IKM1, JABS, JAJ, JAJP,&
 & JK, JKKI, JKKP4, JL, JN, JN2J  

REAL(KIND=JPRB) :: ZAA, ZBB, ZPNEB, ZCNEB, ZRE11,&
 & ZRE115, ZRMUM1, &
 & ZWH2O, ZCHKG, ZCHKG5, ZCHKS, ZCHKS5  
REAL(KIND=JPRB) :: ZRR,ZRRJ,ZRRJ5,ZRRK,ZRRK5
REAL(KIND=JPRB) :: ZRK5D, ZRJ5D

! fields for adjoint computation
REAL(KIND=JPRB) :: ZRESWR15(KLON,KLEV), ZRESWR25(KLON,KLEV)
REAL(KIND=JPRB) :: ZTRSWR15(KLON,KLEV), ZTRSWR25(KLON,KLEV)

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "swclr.intfb.h"
#include "swclrad.intfb.h"
#include "swde.intfb.h"
#include "swdead.intfb.h"
#include "swr.intfb.h"
#include "swrad.intfb.h"
#include "swtt.intfb.h"
#include "swtt1.intfb.h"
#include "swtt1ad.intfb.h"
#include "swttad.intfb.h"

!     ------------------------------------------------------------------

!*         1.     Near-infrared spectral interval (0.68-4.00 micron)
!                 --------------------------------------------------

! 100 CONTINUE

!*         1.1    Optical thickness for rayleigh scattering
!                 -----------------------------------------

! 110 CONTINUE

IF (LHOOK) CALL DR_HOOK('SWNIAD',0,ZHOOK_HANDLE)
DO JL = KIDIA,KFDIA
  ZRMUM15(JL) = 1.0_JPRB - PRMU5(JL)
  ZRAYL15(JL) =  RRAY(KNU,1) + ZRMUM15(JL)&
   & * (RRAY(KNU,2) + ZRMUM15(JL)&
   & * (RRAY(KNU,3) + ZRMUM15(JL) * (RRAY(KNU,4) + ZRMUM15(JL)&
   & * (RRAY(KNU,5) + ZRMUM15(JL) *  RRAY(KNU,6)     ))))  
  IF (ZRAYL15(JL) >= 0.0_JPRB) THEN
    ZRAYL5(JL) = ZRAYL15(JL)    
  ELSE
    ZRAYL5(JL) = 0.0_JPRB
  ENDIF   
ENDDO

!     ------------------------------------------------------------------

!*         2.    Continuum scattering calculations
!                ---------------------------------

! 200 CONTINUE

!*         2.1   Clear-sky fraction of the column
!                --------------------------------

! 210 CONTINUE

CALL SWCLR &
 & ( KIDIA   , KFDIA  , KLON   , KLEV   , KAER    , KNU,&
 & PAER5   , PALBP5 , PDSIG5 , ZRAYL5 , PSEC5,&
 & ZCGAZ5  , ZPIZAZ5, ZRAY015, ZRAY025, ZREFZ05, ZRJ05,&
 & ZRK05   , ZRMU05 , ZTAUAZ5, ZTRA015, ZTRA025, ZTRCLR5, &
 & .FALSE., ZDUMMY, ZDUMMY, ZDUMMY)  

!*         2.2   Cloudy fraction of the column
!                -----------------------------

! 220 CONTINUE

CALL SWR &
 & ( KIDIA  , KFDIA  , KLON  , KLEV  , KNU,&
 & PALBD5 , PCG5   , PCLD5 ,POMEGA5, PSEC5, PTAU5,&
 & ZCGAZ5 , ZPIZAZ5, ZRAY15, ZRAY25, ZREFZ5,&
 & ZRJ15  , ZRK15  , ZRMUE5,&
 & ZTAUAZ5, ZTRA15 , ZTRA25 , ZTRCLD5, &
 & ZRESWR15,ZRESWR25,ZTRSWR15,ZTRSWR25 &
 & )  

!     ------------------------------------------------------------------

!*         3.    Scattering calculations with grey molecular absorption
!                ------------------------------------------------------

! 300 CONTINUE

JN = 2

DO JABS=1,2

  DO JK=1,KLEV+1
    DO JL = KIDIA,KFDIA
      ZREFZ15(JL,JK,JABS) = ZREFZ5(JL,1,JK)
      ZREFZ25(JL,JK,JABS) = ZREFZ5(JL,2,JK)
    ENDDO
  ENDDO

!*         3.1  Surface conditions
!               ------------------

! 310 CONTINUE

  DO JL = KIDIA,KFDIA
    ZREFZ25(JL,1,JABS) = PALBD5(JL,KNU)
    ZREFZ15(JL,1,JABS) = PALBD5(JL,KNU)
  ENDDO

!*         3.2  Introducing cloud effects
!               -------------------------

! 320 CONTINUE

  DO JK = 2 , KLEV+1
    IKM1 = JK - 1
    IKL=KLEV+1-IKM1
    DO JL = KIDIA,KFDIA

      IF (JABS == 1.AND. PCLD5(JL,IKM1) > REPSC ) THEN
        IF (PWV5(JL,IKL) >= REPSCQ) THEN
          ZSWH2O5(JL,JABS,JK) = PWV5(JL,IKL)
        ELSE
          ZSWH2O5(JL,JABS,JK) = REPSCQ
        ENDIF

        IF (PCLD5(JL,IKM1) <= 1.0_JPRB-REPSC ) THEN
          ZPNEB5(JL,IKM1) = PCLD5(JL,IKM1)
        ELSE
          ZPNEB5(JL,IKM1) = 1.0_JPRB-REPSC
        ENDIF
        IF (ZPNEB5(JL,IKM1) >= REPSC ) THEN
          ZCNEB5(JL,JABS,IKM1)= ZPNEB5(JL,IKM1)
        ELSE
          ZCNEB5(JL,JABS,IKM1)= REPSC
        ENDIF

        ZSBB5(JL,JABS,JK)=PUD5(JL,JABS,IKM1)*PQS5(JL,IKL)/ZSWH2O5(JL,JABS,JK)
        ZSAAT5(JL,JABS,JK)= (PUD5(JL,JABS,IKM1)&
         & -ZCNEB5(JL,JABS,IKM1)*ZSBB5(JL,JABS,JK)) &
         & /(1.0_JPRB-ZCNEB5(JL,JABS,IKM1))  
        IF (ZSAAT5(JL,JABS,JK) >= REPSCQ) THEN
          ZSAA5(JL,JABS,JK) = ZSAAT5(JL,JABS,JK)
        ELSE
          ZSAA5(JL,JABS,JK) = REPSCQ
        ENDIF
      ELSE
        ZSAA5(JL,JABS,JK)=PUD5(JL,JABS,IKM1)
        ZSBB5(JL,JABS,JK)=ZSAA5(JL,JABS,JK)
      ENDIF

      IF ((PAKI5(JL,JABS,KNU)*ZSAA5(JL,JABS,JK)*1.66_JPRB) <= 200._JPRB) THEN
        ZCHKS5 = PAKI5(JL,JABS,KNU)*ZSAA5(JL,JABS,JK)*1.66_JPRB
      ELSE
        ZCHKS5 = 200._JPRB
      ENDIF
      IF ((PAKI5(JL,JABS,KNU)*ZSAA5(JL,JABS,JK)/ZRMUE5(JL,JK)) &
       & <= 200._JPRB) THEN
        ZCHKG5 = PAKI5(JL,JABS,KNU)*ZSAA5(JL,JABS,JK)/ZRMUE5(JL,JK)
      ELSE
        ZCHKG5 = 200._JPRB
      ENDIF

      IF( N_VMASS > 0 )THEN
        ZTMP1(JL-KIDIA+1) = ( - ZCHKS5 )
        ZTMP2(JL-KIDIA+1) = ( - ZCHKG5 )
      ELSE
        ZSS5(JL,JABS,JK) = EXP( - ZCHKS5 )
        ZSG5(JL,JABS,JK) = EXP( - ZCHKG5 )
      ENDIF

      ZSTO15(JL,JABS,JK) = PTAU5(JL,KNU,IKM1) / POMEGA5(JL,KNU,IKM1)&
       & + ZTAUAZ5(JL,IKM1)   / ZPIZAZ5(JL,IKM1)&
       & + ZSBB5(JL,JABS,JK) * PAKI5(JL,JABS,KNU)  
      ZSR215(JL,JABS,JK) = PTAU5(JL,KNU,IKM1) + ZTAUAZ5(JL,IKM1)
      ZSR225(JL,JABS,JK) = PTAU5(JL,KNU,IKM1) / ZSR215(JL,JABS,JK)
      ZSGG5(JL,JABS,JK) = ZSR225(JL,JABS,JK) * PCG5(JL,KNU,IKM1)&
       & + (1.0_JPRB - ZSR225(JL,JABS,JK)) * ZCGAZ5(JL,IKM1)  
      ZSW05(JL,JABS,JK) = ZSR215(JL,JABS,JK) / ZSTO15(JL,JABS,JK)
    ENDDO

    CALL SWDE &
     & ( KIDIA , KFDIA , KLON,&
     & ZSGG5(1,JABS,JK), ZREFZ15(1,IKM1,JABS), ZRMUE5(1,JK), &
     & ZSTO15(1,JABS,JK), ZSW05(1,JABS,JK),&
     & ZSRE15(1,JABS,JK), ZSRE25(1,JABS,JK),&
     & ZSTR15(1,JABS,JK), ZSTR25(1,JABS,JK) &
     & )  

    IF( N_VMASS > 0 )THEN
      CALL VEXP(ZSS5(KIDIA,JABS,JK),ZTMP1,KFDIA-KIDIA+1)
      CALL VEXP(ZSG5(KIDIA,JABS,JK),ZTMP2,KFDIA-KIDIA+1)
    ENDIF

    DO JL = KIDIA,KFDIA
      ZRR15(JL,JK,JABS)= &
       & 1.0_JPRB/(1.0_JPRB-ZRAY25(JL,IKM1)*ZREFZ15(JL,IKM1,JABS))
      ZREFZ25(JL,JK,JABS) = PCLD5(JL,IKM1) * ZSRE15(JL,JABS,JK)&
       & + (1.0_JPRB-PCLD5(JL,IKM1)) * (ZRAY15(JL,IKM1)&
       & + ZREFZ25(JL,IKM1,JABS) * ZTRA15(JL,IKM1) * ZTRA25(JL,IKM1) )&
       & * ZSG5(JL,JABS,JK) * ZSS5(JL,JABS,JK)  

      ZZTR25(JL,IKM1,JABS) = PCLD5(JL,IKM1)*ZSTR15(JL,JABS,JK)&
       & + (ZTRA15(JL,IKM1)) * ZSG5(JL,JABS,JK) * (1.0_JPRB-PCLD5(JL,IKM1))  

      ZREFZ15(JL,JK,JABS) = PCLD5(JL,IKM1) * ZSRE25(JL,JABS,JK)&
       & + (1.0_JPRB-PCLD5(JL,IKM1)) * (ZRAY15(JL,IKM1)&
       & + ZREFZ15(JL,IKM1,JABS) * ZTRA15(JL,IKM1) * ZTRA25(JL,IKM1)&
       !      &/(_ONE_-ZRAY25(JL,IKM1)*ZREFZ5(JL,1,IKM1)) )&
       & * ZRR15(JL,JK,JABS))&
       & * ZSG5(JL,JABS,JK) * ZSS5(JL,JABS,JK)  

      ZZTR15(JL,IKM1,JABS) = PCLD5(JL,IKM1) * ZSTR25(JL,JABS,JK)&
       & + (ZTRA15(JL,IKM1) &
       & * ZRR15(JL,JK,JABS))&
       & * ZSG5(JL,JABS,JK) * (1.0_JPRB -PCLD5(JL,IKM1))  
    ENDDO
  ENDDO

!*         3.3  Reflect./transmissivity between surface and level
!               -------------------------------------------------

! 330 CONTINUE

  JN = JN + 1
  DO JL = KIDIA,KFDIA
    ZRJ15(JL,JN,KLEV+1) = 1.0_JPRB
    ZRK15(JL,JN,KLEV+1) = ZREFZ15(JL,KLEV+1,JABS)
  ENDDO
  DO JK = 1 , KLEV
    IKL = KLEV+1 - JK
    IKLP1 = IKL + 1
    DO JL = KIDIA,KFDIA
      ZRE115 = ZRJ15(JL,JN,IKLP1) * ZZTR15(JL,IKL,JABS)
      ZRJ15(JL,JN,IKL) = ZRE115
      ZRK15(JL,JN,IKL) = ZRE115 * ZREFZ15(JL,IKL,JABS)
    ENDDO
  ENDDO
  JN = JN + 1
  DO JL = KIDIA,KFDIA
    ZRJ15(JL,JN,KLEV+1) = 1.0_JPRB
    ZRK15(JL,JN,KLEV+1) = ZREFZ25(JL,KLEV+1,JABS)
  ENDDO
  DO JK = 1 , KLEV
    IKL = KLEV+1 - JK
    IKLP1 = IKL + 1
    DO JL = KIDIA,KFDIA
      ZRE115 = ZRJ15(JL,JN,IKLP1) * ZZTR25(JL,IKL,JABS)
      ZRJ15(JL,JN,IKL) = ZRE115
      ZRK15(JL,JN,IKL) = ZRE115 * ZREFZ25(JL,IKL,JABS)
    ENDDO
  ENDDO

ENDDO

!     ------------------------------------------------------------------

!*         4.    Invert grey and continuum fluxes
!                --------------------------------

! 400 CONTINUE

!*         4.1   Upward (ZRK) and downward (ZRJ) pseudo-fluxes
!                ---------------------------------------------

! 410 CONTINUE

DO JK = 1 , KLEV+1
  DO JAJ = 1 , 5 , 2
    JAJP = JAJ + 1
    DO JL = KIDIA,KFDIA
      ZRJ25(JL,JAJ,JK) = ZRJ15(JL,JAJ,JK) - ZRJ15(JL,JAJP,JK)
      ZRK25(JL,JAJ,JK) = ZRK15(JL,JAJ,JK) - ZRK15(JL,JAJP,JK)
      IF (ZRJ25(JL,JAJ,JK) <= REPLOG) THEN
        ZRJ5(JL,JAJ,JK) = REPLOG
      ELSE
        ZRJ5(JL,JAJ,JK) = ZRJ25(JL,JAJ,JK)
      ENDIF
      IF (ZRK25(JL,JAJ,JK) <= REPLOG) THEN
        ZRK5(JL,JAJ,JK) = REPLOG
      ELSE
        ZRK5(JL,JAJ,JK) = ZRK25(JL,JAJ,JK)
      ENDIF
    ENDDO
  ENDDO
ENDDO

DO JK = 1 , KLEV+1
  DO JAJ = 2 , 6 , 2
    DO JL = KIDIA,KFDIA
      IF (ZRJ15(JL,JAJ,JK) <= REPLOG) THEN
        ZRJ5(JL,JAJ,JK) = REPLOG
      ELSE
        ZRJ5(JL,JAJ,JK) = ZRJ15(JL,JAJ,JK)
      ENDIF
      IF (ZRK15(JL,JAJ,JK) <= REPLOG) THEN
        ZRK5(JL,JAJ,JK) = REPLOG
      ELSE
        ZRK5(JL,JAJ,JK) = ZRK15(JL,JAJ,JK)
      ENDIF
    ENDDO
  ENDDO
ENDDO

!*         4.2    Effective absorber amounts by inverse laplace
!                 ---------------------------------------------

! 420 CONTINUE

DO JAJ = 1 , 2
  DO JL = KIDIA,KFDIA
    ZRR25(JL,JAJ)=1.0_JPRB/PAKI5(JL,JAJ,KNU)
  ENDDO
ENDDO

DO JK = 1 , KLEV+1
  JKKI = 1
  DO JAJ = 1 , 2
    IIND2(1)=JAJ
    IIND2(2)=JAJ
    DO JN = 1 , 2
      JN2J = JN + 2 * JAJ
      JKKP4 = JKKI + 4

!*         4.2.1  Effective absorber amounts
!                 --------------------------

!4210 CONTINUE

      IF( N_VMASS > 0 )THEN

        CALL VDIV(ZTMP1,ZRJ5(KIDIA,JN,JK),ZRJ5(KIDIA,JN2J,JK),KFDIA-KIDIA+1)
        CALL VLOG(ZTMP2,ZTMP1,KFDIA-KIDIA+1)
        CALL VDIV(ZTMP1,ZRK5(KIDIA,JN,JK),ZRK5(KIDIA,JN2J,JK),KFDIA-KIDIA+1)
        CALL VLOG(ZTMP3,ZTMP1,KFDIA-KIDIA+1)

        DO JL = KIDIA,KFDIA
          ZSW25(JL,1,JN2J,JK) = ZTMP2(JL-KIDIA+1) * ZRR25(JL,JAJ)
          ZSW25(JL,2,JN2J,JK) = ZTMP3(JL-KIDIA+1) * ZRR25(JL,JAJ)
        ENDDO

      ELSE

        DO JL = KIDIA,KFDIA
          ZRRJ5=ZRJ5(JL,JN,JK)/ ZRJ5(JL,JN2J,JK)
          ZRRK5=ZRK5(JL,JN,JK)/ ZRK5(JL,JN2J,JK)
          ZLOG15(JL,JN2J,JK) = LOG( ZRRJ5 )
          ZSW25(JL,1,JN2J,JK) = ZLOG15(JL,JN2J,JK) * ZRR25(JL,JAJ)
          ZLOG25(JL,JN2J,JK) = LOG( ZRRK5 )
          ZSW25(JL,2,JN2J,JK) = ZLOG25(JL,JN2J,JK) * ZRR25(JL,JAJ)
        ENDDO

      ENDIF
!*         4.2.2  Transmission function
!                 ---------------------

!4220 CONTINUE

      CALL SWTT1( KIDIA,KFDIA,KLON, KNU, 2, IIND2, ZSW25(1,1,JN2J,JK), ZR25)

      DO JL = KIDIA,KFDIA
        ZRL5(JL,JKKI,JK)   = ZR25(JL,1)
        ZRL5(JL,JKKP4,JK)  = ZR25(JL,2)
      ENDDO

      JKKI=JKKI+1
    ENDDO
  ENDDO

!*         4.3    Upward and downward fluxes with h2o and umg absorption
!                 ------------------------------------------------------

! 430 CONTINUE

  DO JL = KIDIA,KFDIA
    ZFDOWN5(JL,JK) = ZRJ5(JL,1,JK) * ZRL5(JL,1,JK) * ZRL5(JL,3,JK)&
     & + ZRJ5(JL,2,JK) * ZRL5(JL,2,JK) * ZRL5(JL,4,JK)  
    ZFUP5(JL,JK)   = ZRK5(JL,1,JK) * ZRL5(JL,5,JK) * ZRL5(JL,7,JK)&
     & + ZRK5(JL,2,JK) * ZRL5(JL,6,JK) * ZRL5(JL,8,JK)  
  ENDDO
ENDDO

!     ------------------------------------------------------------------

!*         5.    Molecular absorption on clear-sky fluxes
!                ----------------------------------------

! 500 CONTINUE

!*         5.1   Downward fluxes
!                ---------------

! 510 CONTINUE

JAJ = 2
IIND3(1)=1
IIND3(2)=2
IIND3(3)=3

DO JL = KIDIA,KFDIA
  ZDW35(JL,1,KLEV+1)=0.0_JPRB
  ZDW35(JL,2,KLEV+1)=0.0_JPRB
  ZDW35(JL,3,KLEV+1)=0.0_JPRB
  ZDW45(JL,KLEV+1)  =0.0_JPRB
  ZDW55(JL,KLEV+1)  =0.0_JPRB

  ZFD5(JL,KLEV+1)= ZRJ05(JL,JAJ,KLEV+1)
ENDDO
DO JK = 1 , KLEV
  IKL = KLEV+1-JK
  DO JL = KIDIA,KFDIA
    ZRR35(JL,IKL)=1.0_JPRB/ZRMU05(JL,IKL)
    ZDW35(JL,1,IKL)=ZDW35(JL,1,IKL+1)+PUD5(JL,1,IKL)*ZRR35(JL,IKL)
    ZDW35(JL,2,IKL)=ZDW35(JL,2,IKL+1)+PUD5(JL,2,IKL)*ZRR35(JL,IKL)
    ZDW35(JL,3,IKL)=ZDW35(JL,3,IKL+1)+POZ5(JL,  IKL)*ZRR35(JL,IKL)
    ZDW45(JL,IKL)  =ZDW45(JL,IKL+1)  +PUD5(JL,4,IKL)*ZRR35(JL,IKL)
    ZDW55(JL,IKL)  =ZDW55(JL,IKL+1)  +PUD5(JL,5,IKL)*ZRR35(JL,IKL)
  ENDDO

  CALL SWTT1( KIDIA,KFDIA,KLON, KNU, 3, IIND3,&
   & ZDW35(1,1,IKL), ZDRC35(1,1,IKL) )

  IF( N_VMASS > 0 )THEN
    DO JL = KIDIA,KFDIA
      ZTMP1(JL-KIDIA+1) = (-RSWCE(KNU)*ZDW45(JL,IKL)-RSWCP(KNU)*ZDW55(JL,IKL))
    ENDDO
    CALL VEXP(ZDRC45(KIDIA,IKL),ZTMP1,KFDIA-KIDIA+1)
  ELSE
    DO JL = KIDIA,KFDIA
      ZDRC45(JL,IKL) = EXP(-RSWCE(KNU)*ZDW45(JL,IKL)-RSWCP(KNU)*ZDW55(JL,IKL))
    ENDDO
  ENDIF
  DO JL = KIDIA,KFDIA
    ZFD5(JL,IKL) = ZDRC35(JL,1,IKL)*ZDRC35(JL,2,IKL) &
     & * ZDRC35(JL,3,IKL)*ZDRC45(JL,IKL)*ZRJ05(JL,JAJ,IKL)  
  ENDDO
ENDDO

!*         5.2   Upward fluxes
!                -------------

! 520 CONTINUE

DO JL = KIDIA,KFDIA
  ZFU5(JL,1) = ZFD5(JL,1)*PALBP5(JL,KNU)

  ZUW35(JL,1,1) = ZDW35(JL,1,1)
  ZUW35(JL,2,1) = ZDW35(JL,2,1)
  ZUW35(JL,3,1) = ZDW35(JL,3,1)
  ZUW45(JL,1)   = ZDW45(JL,1)
  ZUW55(JL,1)   = ZDW55(JL,1)
ENDDO

DO JK = 2 , KLEV+1
  IKM1=JK-1
  DO JL = KIDIA,KFDIA
    ZUW35(JL,1,JK)=ZUW35(JL,1,IKM1)+PUD5(JL,1,IKM1)*1.66_JPRB
    ZUW35(JL,2,JK)=ZUW35(JL,2,IKM1)+PUD5(JL,2,IKM1)*1.66_JPRB
    ZUW35(JL,3,JK)=ZUW35(JL,3,IKM1)+POZ5(JL,  IKM1)*1.66_JPRB
    ZUW45(JL,JK)  =ZUW45(JL,IKM1)  +PUD5(JL,4,IKM1)*1.66_JPRB
    ZUW55(JL,JK)  =ZUW55(JL,IKM1)  +PUD5(JL,5,IKM1)*1.66_JPRB
  ENDDO

  CALL SWTT1( KIDIA,KFDIA,KLON, KNU, 3, IIND3, &
   & ZUW35(1,1,JK), ZURC35(1,1,JK) )

  IF( N_VMASS > 0 )THEN
    DO JL = KIDIA,KFDIA
      ZTMP1(JL-KIDIA+1) = (-RSWCE(KNU)*ZUW45(JL,JK)-RSWCP(KNU)*ZUW55(JL,JK))
    ENDDO
    CALL VEXP(ZURC45(KIDIA,JK),ZTMP1,KFDIA-KIDIA+1)
  ELSE
    DO JL = KIDIA,KFDIA
      ZURC45(JL,JK) = EXP(-RSWCE(KNU)*ZUW45(JL,JK)-RSWCP(KNU)*ZUW55(JL,JK))
    ENDDO
  ENDIF
  DO JL = KIDIA,KFDIA
    ZFU5(JL,JK) = ZURC35(JL,1,JK)*ZURC35(JL,2,JK) &
     & *ZURC35(JL,3,JK)*ZURC45(JL,JK)* ZRK05(JL,JAJ,JK)
  ENDDO
ENDDO

!     ------------------------------------------------------------------

!*         6.     Introduction of ozone and H2O continuum absorption
!                 --------------------------------------------------

! 600 CONTINUE
IABS=3

!*         6.1    Downward fluxes
!                 ---------------

! 610 CONTINUE
DO JL = KIDIA,KFDIA
  ZDWM15(JL,KLEV+1)=0.0_JPRB
  ZDWM45(JL,KLEV+1)=0.0_JPRB
  ZDWM55(JL,KLEV+1)=0.0_JPRB

  PFDOWN5(JL,KLEV+1) = ((1.0_JPRB-PCLEAR5(JL))*ZFDOWN5(JL,KLEV+1)&
   & + PCLEAR5(JL) * ZFD5(JL,KLEV+1)) * RSUN(KNU)  
! diagnostic clear sky quantity 
!  PCDOWN5(JL,KLEV+1) = ZFD5(JL,KLEV+1) * RSUN(KNU)
ENDDO

DO JK = 1 , KLEV
  IKL=KLEV+1-JK
  DO JL = KIDIA,KFDIA
    ZRR45(JL,IKL)=1.0_JPRB/ZRMUE5(JL,IKL)

    ZDWM15(JL,IKL) = ZDWM15(JL,IKL+1)+POZ5(JL,  IKL)*ZRR45(JL,IKL)
    ZDWM45(JL,IKL) = ZDWM45(JL,IKL+1)+PUD5(JL,4,IKL)*ZRR45(JL,IKL)
    ZDWM55(JL,IKL) = ZDWM55(JL,IKL+1)+PUD5(JL,5,IKL)*ZRR45(JL,IKL)
  ENDDO
  IF( N_VMASS > 0 )THEN
    DO JL = KIDIA,KFDIA
      ZTMP1(JL-KIDIA+1) =(-RSWCE(KNU)*ZDWM45(JL,IKL)-RSWCP(KNU)*ZDWM55(JL,IKL))
    ENDDO
    CALL VEXP(ZDR45(KIDIA,IKL),ZTMP1,KFDIA-KIDIA+1)
  ELSE
    DO JL = KIDIA,KFDIA
      ZDR45(JL,IKL) = EXP(-RSWCE(KNU)*ZDWM45(JL,IKL)-RSWCP(KNU)*ZDWM55(JL,IKL))
    ENDDO
  ENDIF

  CALL SWTT( KIDIA,KFDIA,KLON, KNU, IABS, ZDWM15(1,IKL), ZDR15(1,IKL))

  DO JL = KIDIA,KFDIA
    PFDOWN5(JL,IKL) = (&
     & (1.0_JPRB-PCLEAR5(JL)) *ZDR15(JL,IKL)*ZDR45(JL,IKL)*ZFDOWN5(JL,IKL)&
     & +    PCLEAR5(JL)                      *ZFD5(JL,IKL)&
     & ) * RSUN(KNU)  
! diagnostic clear sky quantity
!    PCDOWN5(JL,IKL) = ZFD5(JL,IKL) * RSUN(KNU)
  ENDDO
ENDDO

!*         6.2    Upward fluxes
!                 -------------

! 620 CONTINUE
DO JL = KIDIA,KFDIA
  PFUP5(JL,1) = (&
   & (1.0_JPRB-PCLEAR5(JL)) * ZDR15(JL,1)*ZDR45(JL,1) * ZFUP5(JL,1)&
   & +    PCLEAR5(JL)                      * ZFU5(JL,1)&
   & ) * RSUN(KNU)  
! diagnostic clear sky quantity
!  PCUP5(JL,1) = ZFU5(JL,1) * RSUN(KNU)

  ZUWM15(JL,1)  = ZDWM15(JL,1)
  ZUWM45(JL,1)  = ZDWM45(JL,1)
  ZUWM55(JL,1)  = ZDWM55(JL,1)
ENDDO

DO JK = 2 , KLEV+1
  IKM1=JK-1
  DO JL = KIDIA,KFDIA
    ZUWM15(JL,JK) = ZUWM15(JL,IKM1)+POZ5(JL  ,IKM1)*1.66_JPRB
    ZUWM45(JL,JK) = ZUWM45(JL,IKM1)+PUD5(JL,4,IKM1)*1.66_JPRB
    ZUWM55(JL,JK) = ZUWM55(JL,IKM1)+PUD5(JL,5,IKM1)*1.66_JPRB
  ENDDO
  IF( N_VMASS > 0 )THEN
    DO JL = KIDIA,KFDIA
      ZTMP1(JL-KIDIA+1) =(-RSWCE(KNU)*ZUWM45(JL,JK)-RSWCP(KNU)*ZUWM55(JL,JK))
    ENDDO
    CALL VEXP(ZUR45(KIDIA,JK),ZTMP1,KFDIA-KIDIA+1)
  ELSE
    DO JL = KIDIA,KFDIA
      ZUR45(JL,JK) = EXP(-RSWCE(KNU)*ZUWM45(JL,JK)-RSWCP(KNU)*ZUWM55(JL,JK))
    ENDDO
  ENDIF

  CALL SWTT( KIDIA,KFDIA,KLON, KNU, IABS, ZUWM15(1,JK), ZUR15(1,JK))

  DO JL = KIDIA,KFDIA
    PFUP5(JL,JK) = (&
     & (1.0_JPRB-PCLEAR5(JL)) * ZUR15(JL,JK)*ZUR45(JL,JK) * ZFUP5(JL,JK)&
     & +    PCLEAR5(JL)                        * ZFU5(JL,JK)&
     & ) * RSUN(KNU)  
! diagnostic clear sky quantity
!    PCUP5(JL,JK) = ZFU5(JL,JK) * RSUN(KNU)
  ENDDO
ENDDO

!     ==================================================================

!*         10.     ADJOINT CALCULATIONS
!                  --------------------

!1000 CONTINUE
!  arrays with the dimension (KLON)
ZRAYL(:) = 0.0_JPRB
ZS   (:) = 0.0_JPRB
ZG   (:) = 0.0_JPRB
ZTR1 (:) = 0.0_JPRB
ZRE1 (:) = 0.0_JPRB
ZTR2 (:) = 0.0_JPRB
ZRE2 (:) = 0.0_JPRB
ZW0  (:) = 0.0_JPRB
ZTO1 (:) = 0.0_JPRB
ZR21 (:) = 0.0_JPRB
ZR22 (:) = 0.0_JPRB
ZGG  (:) = 0.0_JPRB
ZREF (:) = 0.0_JPRB
ZW4  (:) = 0.0_JPRB
ZW5  (:) = 0.0_JPRB
ZR4  (:) = 0.0_JPRB
ZW1  (:) = 0.0_JPRB
ZR1  (:) = 0.0_JPRB

!  arrays with the dimensions (KLON,KLEV)
ZCGAZ(:,:)  = 0.0_JPRB
ZPIZAZ(:,:) = 0.0_JPRB
ZTAUAZ(:,:) = 0.0_JPRB

!  arrays with the dimensions (KLON,KLEV+1)
ZRAY01(:,:) = 0.0_JPRB
ZRAY02(:,:) = 0.0_JPRB
ZRMU0 (:,:) = 0.0_JPRB
ZTRA01(:,:) = 0.0_JPRB
ZTRA02(:,:) = 0.0_JPRB
ZRAY1 (:,:) = 0.0_JPRB
ZRAY2 (:,:) = 0.0_JPRB
ZRMUE (:,:) = 0.0_JPRB
ZTRA1 (:,:) = 0.0_JPRB
ZTRA2 (:,:) = 0.0_JPRB
ZFD   (:,:) = 0.0_JPRB
ZFU   (:,:) = 0.0_JPRB

!  arrays with the dimensions (KLON,2,KLEV+1)
ZREFZ (:,:,:) = 0.0_JPRB
ZRJ0  (:,:,:) = 0.0_JPRB
ZRK0  (:,:,:) = 0.0_JPRB
ZREFZ0(:,:,:) = 0.0_JPRB
ZTR   (:,:,:) = 0.0_JPRB

!  arrays with the dimensions (KLON,6,KLEV+1)
ZRJ   (:,:,:)  = 0.0_JPRB
ZRK   (:,:,:)  = 0.0_JPRB

!  arrays with the dimensions (KLON,2)
ZW2 (:,:) = 0.0_JPRB
ZR2 (:,:) = 0.0_JPRB
ZRR2 (:,:) = 0.0_JPRB

!  arrays with the dimensions (KLON,8)
ZRL (:,:) = 0.0_JPRB

!  arrays with the dimensions (KLON,3)
ZW3 (:,:) = 0.0_JPRB
ZR3 (:,:) = 0.0_JPRB

IABS=3

!     ------------------------------------------------------------------

!*    1. 6   INTRODUCTION OF OZONE AND H2O CONTINUUM ABSORPTION

!*    1.6.2    UPWARD FLUXES
!              -------------

DO JK=KLEV+1,2,-1
  IKM1=JK-1

  DO JL=KIDIA,KFDIA
!  diagnostic clear sky quantities
!    ZFU(JL,JK) = ZFU(JL,JK) + PCUP(JL,JK) *RSUN(KNU)
!    PCUP(JL,JK) = 0.0_JPRB

    PCLEAR(JL) = PCLEAR(JL)&
     & - PFUP(JL,JK) *ZUR15(JL,JK)*ZUR45(JL,JK)&
     & *ZFUP5(JL,JK)*RSUN(KNU)  
    ZR1(JL) = ZR1(JL) + PFUP(JL,JK)&
     & *(1.0_JPRB-PCLEAR5(JL))*ZUR45(JL,JK)*ZFUP5(JL,JK)*RSUN(KNU)  
    ZR4(JL) = ZR4(JL) + PFUP(JL,JK)&
     & *(1.0_JPRB-PCLEAR5(JL))*ZUR15(JL,JK)*ZFUP5(JL,JK)*RSUN(KNU)  
    PCLEAR(JL) = PCLEAR(JL) + PFUP(JL,JK) *ZFU5(JL,JK)*RSUN(KNU)
    ZFU(JL,JK) = ZFU(JL,JK) + PFUP(JL,JK) *PCLEAR5(JL)*RSUN(KNU)
    PFUP(JL,JK) = PFUP(JL,JK)&
     & *(1.0_JPRB-PCLEAR5(JL))*ZUR15(JL,JK)*ZUR45(JL,JK)*RSUN(KNU)   
  ENDDO

  CALL SWTTAD( KIDIA,KFDIA,KLON, KNU, IABS, &
   & ZUWM15(1,JK), ZUR15(1,JK), ZW1, ZR1)

  DO JL=KIDIA,KFDIA
    ZW4(JL) = ZW4(JL) - ZR4(JL) *RSWCE(KNU)*ZUR45(JL,JK)
    ZW5(JL) = ZW5(JL) - ZR4(JL) *RSWCP(KNU)*ZUR45(JL,JK)
    ZR4(JL) = 0.0_JPRB

    PUD(JL,5,IKM1) = PUD(JL,5,IKM1) + ZW5(JL) *1.66_JPRB
    PUD(JL,4,IKM1) = PUD(JL,4,IKM1) + ZW4(JL) *1.66_JPRB
    POZ(JL,IKM1) = POZ(JL,IKM1) + ZW1(JL) *1.66_JPRB
  ENDDO
ENDDO

DO JL=KIDIA,KFDIA
! diagnostic clear sky quantities
!  ZFU(JL,1) = ZFU(JL,1) + PCUP(JL,1) *RSUN(KNU)
!  PCUP(JL,1) = 0.0_JPRB

  PCLEAR(JL) = PCLEAR(JL)&
   & - PFUP(JL,1) *ZDR15(JL,1)*ZDR45(JL,1)&
   & *ZFUP5(JL,1)*RSUN(KNU)  
  ZR1(JL) = ZR1(JL) + PFUP(JL,1)&
   & *(1.0_JPRB-PCLEAR5(JL))*ZDR45(JL,1)*ZFUP5(JL,1)*RSUN(KNU)  
  ZR4(JL) = ZR4(JL) + PFUP(JL,1)&
   & *(1.0_JPRB-PCLEAR5(JL))*ZDR15(JL,1)*ZFUP5(JL,1)*RSUN(KNU)  
  PCLEAR(JL) = PCLEAR(JL) + PFUP(JL,1) *ZFU5(JL,1)*RSUN(KNU)
  ZFU(JL,1) = ZFU(JL,1) + PFUP(JL,1) *PCLEAR5(JL)*RSUN(KNU)
  PFUP(JL,1) = PFUP(JL,1)&
   & *(1.0_JPRB-PCLEAR5(JL))*ZDR15(JL,1)*ZDR45(JL,1)*RSUN(KNU)   
ENDDO

!1620 CONTINUE

!*        1.6.1    DOWNWARD FLUXES
!                  ---------------

DO JK=KLEV,1,-1
  IKL=KLEV+1-JK

  DO JL=KIDIA,KFDIA
! diagnostic clear sky quantities
!    ZFD(JL,IKL) = ZFD(JL,IKL) + PCDOWN(JL,IKL) *RSUN(KNU)
!    PCDOWN(JL,IKL) = 0.0_JPRB

    PCLEAR(JL) = PCLEAR(JL)&
     & - PFDOWN(JL,IKL) *ZDR15(JL,IKL)*ZDR45(JL,IKL)&
     & *ZFDOWN5(JL,IKL)*RSUN(KNU)  
    ZR1(JL) = ZR1(JL) + PFDOWN(JL,IKL)&
     & *(1.0_JPRB-PCLEAR5(JL))*ZDR45(JL,IKL)*ZFDOWN5(JL,IKL)*RSUN(KNU)  
    ZR4(JL) = ZR4(JL) + PFDOWN(JL,IKL)&
     & *(1.0_JPRB-PCLEAR5(JL))*ZDR15(JL,IKL)*ZFDOWN5(JL,IKL)*RSUN(KNU)  
    PCLEAR(JL) = PCLEAR(JL) + PFDOWN(JL,IKL) *ZFD5(JL,IKL)*RSUN(KNU)
    ZFD(JL,IKL) = ZFD(JL,IKL) + PFDOWN(JL,IKL) *PCLEAR5(JL)*RSUN(KNU)
    PFDOWN(JL,IKL) = PFDOWN(JL,IKL)&
     & *(1.0_JPRB-PCLEAR5(JL))*ZDR15(JL,IKL)*ZDR45(JL,IKL)*RSUN(KNU)  
  ENDDO

  CALL SWTTAD( KIDIA,KFDIA,KLON, KNU, IABS, &
   & ZDWM15(1,IKL), ZDR15(1,IKL), ZW1, ZR1)

  DO JL=KIDIA,KFDIA
    ZRR=0.0_JPRB

    ZW4(JL) = ZW4(JL) - ZR4(JL) *RSWCE(KNU)*ZDR45(JL,IKL)
    ZW5(JL) = ZW5(JL) - ZR4(JL) *RSWCP(KNU)*ZDR45(JL,IKL)
    ZR4(JL) = 0.0_JPRB

    ZRR=ZRR+PUD5(JL,5,IKL)*ZW5 (JL)+PUD5(JL,4,IKL)*ZW4(JL)+POZ5(JL,IKL)*ZW1(JL)
    PUD(JL,5,IKL) = PUD(JL,5,IKL) + ZW5(JL) *ZRR45(JL,IKL)
    PUD(JL,4,IKL) = PUD(JL,4,IKL) + ZW4(JL) *ZRR45(JL,IKL)
    POZ(JL,IKL)   = POZ(JL,IKL) + ZW1(JL) *ZRR45(JL,IKL)
    ZRMUE(JL,IKL) = ZRMUE(JL,IKL) - ZRR*ZRR45(JL,IKL)**2
  ENDDO

ENDDO

DO JL=KIDIA,KFDIA
! diagnostic clear sky quantities
!  ZFD(JL,KLEV+1) = ZFD(JL,KLEV+1) + PCDOWN(JL,KLEV+1) *RSUN(KNU)
!  PCDOWN(JL,KLEV+1) = 0.0_JPRB

  PCLEAR(JL) = PCLEAR(JL) - PFDOWN(JL,KLEV+1) *ZFDOWN5(JL,KLEV+1)*RSUN(KNU)
  PCLEAR(JL) = PCLEAR(JL) + PFDOWN(JL,KLEV+1) *ZFD5(JL,KLEV+1)*RSUN(KNU)
  ZFD(JL,KLEV+1) = ZFD(JL,KLEV+1)+ PFDOWN(JL,KLEV+1) *PCLEAR5(JL)*RSUN(KNU)
  PFDOWN(JL,KLEV+1) = &
   & PFDOWN(JL,KLEV+1) *(1.0_JPRB-PCLEAR5(JL))*RSUN(KNU)  

  ZR1(JL)=0.0_JPRB
  ZW5(JL)=0.0_JPRB
  ZW4(JL)=0.0_JPRB
  ZW1(JL)=0.0_JPRB
ENDDO

!1610 CONTINUE 

!1600 CONTINUE

!     ------------------------------------------------------------------

!*        1.5    MOLECULAR ABSORPTION ON CLEAR-SKY FLUXES
!                ----------------------------------------

!*        1.5.2   UPWARD FLUXES
!                 -------------

JAJ=2
IIND3(1)=1
IIND3(2)=2
IIND3(3)=3

DO JK=KLEV+1,2,-1
  IKM1=JK-1

  DO JL=KIDIA,KFDIA
    ZR3(JL,1) = ZR3(JL,1) + ZFU(JL,JK)*ZURC35(JL,2,JK)&
     & *ZURC35(JL,3,JK)*ZURC45(JL,JK)*ZRK05(JL,JAJ,JK)  
    ZR3(JL,2) = ZR3(JL,2) + ZFU(JL,JK)*ZURC35(JL,1,JK)&
     & *ZURC35(JL,3,JK)*ZURC45(JL,JK)*ZRK05(JL,JAJ,JK)  
    ZR3(JL,3) = ZR3(JL,3) + ZFU(JL,JK)*ZURC35(JL,1,JK)&
     & *ZURC35(JL,2,JK)*ZURC45(JL,JK)*ZRK05(JL,JAJ,JK)  
    ZR4(JL) = ZR4(JL) + ZFU(JL,JK)*ZURC35(JL,1,JK)&
     & *ZURC35(JL,2,JK)*ZURC35(JL,3,JK)*ZRK05(JL,JAJ,JK)  
    ZRK0(JL,JAJ,JK) = ZRK0(JL,JAJ,JK) + ZFU(JL,JK)&
     & *ZURC35(JL,1,JK)*ZURC35(JL,2,JK)*ZURC35(JL,3,JK)&
     & *ZURC45(JL,JK)  
    ZFU(JL,JK) = 0.0_JPRB

    ZW4(JL) = ZW4(JL) - ZR4(JL) *RSWCE(KNU)*ZURC45(JL,JK)
    ZW5(JL) = ZW5(JL) - ZR4(JL) *RSWCP(KNU)*ZURC45(JL,JK)
    ZR4(JL) = 0.0_JPRB
  ENDDO

  CALL SWTT1AD( KIDIA,KFDIA,KLON, KNU, 3, IIND3, &
   & ZUW35(1,1,JK), ZURC35(1,1,JK), ZW3, ZR3)

  DO JL=KIDIA,KFDIA
    PUD(JL,5,IKM1) = PUD(JL,5,IKM1) + ZW5(JL) *1.66_JPRB
    PUD(JL,4,IKM1) = PUD(JL,4,IKM1) + ZW4(JL) *1.66_JPRB
    POZ(JL,IKM1) = POZ(JL,IKM1) + ZW3(JL,3) *1.66_JPRB
    PUD(JL,2,IKM1) = PUD(JL,2,IKM1) + ZW3(JL,2) *1.66_JPRB
    PUD(JL,1,IKM1) = PUD(JL,1,IKM1) + ZW3(JL,1) *1.66_JPRB
  ENDDO

ENDDO

DO JL=KIDIA,KFDIA
  ZFD(JL,1) = ZFD(JL,1) + ZFU(JL,1) *PALBP5(JL,KNU)
  PALBP(JL,KNU) = PALBP(JL,KNU) + ZFU(JL,1) *ZFD5(JL,1)
  ZFU(JL,1) = 0.0_JPRB
ENDDO

!1520 CONTINUE

!*       1.5.1   DOWNWARD FLUXES
!                ---------------

DO JK=KLEV,1,-1
  IKL=KLEV+1-JK

  DO JL=KIDIA,KFDIA
    ZR3(JL,1) = ZR3(JL,1) + ZFD(JL,IKL)&
     & *ZDRC35(JL,2,IKL)*ZDRC35(JL,3,IKL)*ZDRC45(JL,IKL)&
     & *ZRJ05(JL,JAJ,IKL)  
    ZR3(JL,2) = ZR3(JL,2) + ZFD(JL,IKL)&
     & *ZDRC35(JL,1,IKL)*ZDRC35(JL,3,IKL)*ZDRC45(JL,IKL)&
     & *ZRJ05(JL,JAJ,IKL)  
    ZR3(JL,3) = ZR3(JL,3) + ZFD(JL,IKL)&
     & *ZDRC35(JL,1,IKL)*ZDRC35(JL,2,IKL)*ZDRC45(JL,IKL)&
     & *ZRJ05(JL,JAJ,IKL)  
    ZR4(JL) = ZR4(JL) + ZFD(JL,IKL)&
     & *ZDRC35(JL,1,IKL)*ZDRC35(JL,2,IKL)*ZDRC35(JL,3,IKL)&
     & *ZRJ05(JL,JAJ,IKL)  
    ZRJ0(JL,JAJ,IKL) = ZRJ0(JL,JAJ,IKL) + ZFD(JL,IKL)&
     & *ZDRC35(JL,1,IKL)*ZDRC35(JL,2,IKL)*ZDRC35(JL,3,IKL)&
     & *ZDRC45(JL,IKL)  
    ZFD(JL,IKL) = 0.0_JPRB

    ZW4(JL) = ZW4(JL) - ZR4(JL) *RSWCE(KNU)*ZDRC45(JL,IKL)
    ZW5(JL) = ZW5(JL) - ZR4(JL) *RSWCP(KNU)*ZDRC45(JL,IKL)
    ZR4(JL) = 0.0_JPRB
  ENDDO

  CALL SWTT1AD( KIDIA,KFDIA,KLON, KNU, 3, IIND3,&
   & ZDW35(1,1,IKL), ZDRC35(1,1,IKL), ZW3, ZR3)

  DO JL=KIDIA,KFDIA
    ZRR=0.0_JPRB

    ZRR=ZRR+PUD5(JL,5,IKL)*ZW5(JL)+PUD5(JL,4,IKL)*ZW4(JL) &
     & +POZ5(JL,IKL)*ZW3(JL,3)+PUD5(JL,2,IKL)*ZW3(JL,2) &
     & +PUD5(JL,1,IKL)*ZW3(JL,1)  
    PUD(JL,5,IKL) = PUD(JL,5,IKL) + ZW5(JL) *ZRR35(JL,IKL)
    PUD(JL,4,IKL) = PUD(JL,4,IKL) + ZW4(JL) *ZRR35(JL,IKL)
    POZ(JL,IKL)   = POZ(JL,IKL) + ZW3(JL,3) *ZRR35(JL,IKL)
    PUD(JL,2,IKL) = PUD(JL,2,IKL) + ZW3(JL,2) *ZRR35(JL,IKL)
    PUD(JL,1,IKL) = PUD(JL,1,IKL) + ZW3(JL,1) *ZRR35(JL,IKL)
    ZRMU0(JL,IKL) = ZRMU0(JL,IKL)- ZRR*ZRR35(JL,IKL)**2
  ENDDO

ENDDO

DO JL=KIDIA,KFDIA
  ZRJ0(JL,JAJ,KLEV+1) = ZRJ0(JL,JAJ,KLEV+1) + ZFD(JL,KLEV+1)
  ZFD(JL,KLEV+1) = 0.0_JPRB

!  ZR4(JL)=0.0_JPRB
  ZW5(JL)=0.0_JPRB
  ZW4(JL)=0.0_JPRB
  ZW3(JL,3)=0.0_JPRB
  ZW3(JL,2)=0.0_JPRB
  ZW3(JL,1)=0.0_JPRB
ENDDO

!1510 CONTINUE        

!1500 CONTINUE        

!     ------------------------------------------------------------------

!*       1. 4    INVERT GREY AND CONTINUUM FLUXES
!                --------------------------------

!*       1.4.3   UPWARD AND DOWNWARD FLUXES WITH H2O AND UMG ABSORPTION
!                ------------------------------------------------------

DO JK=KLEV+1,1,-1
  JKKI=4

  DO JL=KIDIA,KFDIA
    ZRK(JL,1,JK) = ZRK(JL,1,JK) + PFUP(JL,JK) * ZRL5(JL,5,JK)*ZRL5(JL,7,JK)
    ZRK(JL,2,JK) = ZRK(JL,2,JK) + PFUP(JL,JK) * ZRL5(JL,6,JK)*ZRL5(JL,8,JK)
    ZRL(JL,5   ) = ZRL(JL,5) + PFUP(JL,JK) * ZRK5(JL,1,JK)*ZRL5(JL,7,JK)
    ZRL(JL,6   ) = ZRL(JL,6) + PFUP(JL,JK) * ZRK5(JL,2,JK)*ZRL5(JL,8,JK)
    ZRL(JL,7   ) = ZRL(JL,7) + PFUP(JL,JK) * ZRK5(JL,1,JK)*ZRL5(JL,5,JK)
    ZRL(JL,8   ) = ZRL(JL,8) + PFUP(JL,JK) * ZRK5(JL,2,JK)*ZRL5(JL,6,JK)
    PFUP(JL,JK) = 0.0_JPRB

    ZRJ(JL,1,JK) = ZRJ(JL,1,JK) + PFDOWN(JL,JK) * ZRL5(JL,1,JK)*ZRL5(JL,3,JK)
    ZRJ(JL,2,JK) = ZRJ(JL,2,JK) + PFDOWN(JL,JK) * ZRL5(JL,2,JK)*ZRL5(JL,4,JK)
    ZRL(JL,1   ) = ZRL(JL,1) + PFDOWN(JL,JK) * ZRJ5(JL,1,JK)*ZRL5(JL,3,JK)
    ZRL(JL,2   ) = ZRL(JL,2) + PFDOWN(JL,JK) * ZRJ5(JL,2,JK)*ZRL5(JL,4,JK)
    ZRL(JL,3   ) = ZRL(JL,3) + PFDOWN(JL,JK) * ZRJ5(JL,1,JK)*ZRL5(JL,1,JK)
    ZRL(JL,4   ) = ZRL(JL,4) + PFDOWN(JL,JK) * ZRJ5(JL,2,JK)*ZRL5(JL,2,JK)
    PFDOWN(JL,JK) = 0.0_JPRB
  ENDDO

!1430 CONTINUE

!*       1.4.2   EFFECTIVE ABSORBER AMOUNTS BY INVERSE LAPLACE
!                ---------------------------------------------

  DO JAJ=2,1,-1
    IIND2(1)=JAJ
    IIND2(2)=JAJ

    DO JN=2,1,-1
      JN2J=JN+2*JAJ
      JKKP4=JKKI+4

      DO JL=KIDIA,KFDIA
        ZR2(JL,2) = ZR2(JL,2) + ZRL(JL,JKKP4)
        ZRL(JL,JKKP4) = 0.0_JPRB

        ZR2(JL,1) = ZR2(JL,1) + ZRL(JL,JKKI)
        ZRL(JL,JKKI) = 0.0_JPRB
      ENDDO

!*        1.4.2.1  EFFECTIVE ABSORBER AMOUNTS
!                  --------------------------
      CALL SWTT1AD( KIDIA,KFDIA,KLON, KNU, 2, IIND2,&
       &  ZSW25(1,1,JN2J,JK), ZR25, ZW2, ZR2)

      IF( N_VMASS > 0 )THEN

        CALL VDIV(ZTMP1,ZRJ5(KIDIA,JN,JK),ZRJ5(KIDIA,JN2J,JK),KFDIA-KIDIA+1)
        CALL VLOG(ZTMP2,ZTMP1,KFDIA-KIDIA+1)
        CALL VDIV(ZTMP1,ZRK5(KIDIA,JN,JK),ZRK5(KIDIA,JN2J,JK),KFDIA-KIDIA+1)
        CALL VLOG(ZTMP3,ZTMP1,KFDIA-KIDIA+1)
        DO JL=KIDIA,KFDIA
          ZRRJ=0.0_JPRB
          ZRRK=0.0_JPRB

          ZRK5D=1.0_JPRB/ZRK5(JL,JN2J,JK)
          ZRJ5D=1.0_JPRB/ZRJ5(JL,JN2J,JK)
          ZRRK5=ZRK5(JL,JN,JK) * ZRK5D
          ZRRJ5=ZRJ5(JL,JN,JK) * ZRJ5D

          ZRR2(JL,JAJ)=ZRR2(JL,JAJ)+ZW2(JL,2)*ZTMP3(JL-KIDIA+1) &
           & +ZW2(JL,1)*ZTMP2(JL-KIDIA+1)
          ZRRK=ZRRK+ZW2(JL,2)*ZRR25(JL,JAJ)/ZRRK5
          ZRRJ=ZRRJ+ZW2(JL,1)*ZRR25(JL,JAJ)/ZRRJ5

          ZRK(JL,JN,JK) = ZRK(JL,JN,JK)  + (ZRK5D*ZRRK)
          ZRK(JL,JN2J,JK) = ZRK(JL,JN2J,JK) - ZRRK5*(ZRK5D*ZRRK)
          ZW2(JL,2) = 0.0_JPRB

          ZRJ(JL,JN,JK) = ZRJ(JL,JN,JK)  + (ZRJ5D*ZRRJ)
          ZRJ(JL,JN2J,JK) = ZRJ(JL,JN2J,JK)  - ZRRJ5*(ZRJ5D*ZRRJ)
          ZW2(JL,1) = 0.0_JPRB
        ENDDO

      ELSE

        DO JL=KIDIA,KFDIA
          ZRRJ=0.0_JPRB
          ZRRK=0.0_JPRB

          ZRRK5=ZRK5(JL,JN,JK)/ ZRK5(JL,JN2J,JK)
          ZRRJ5=ZRJ5(JL,JN,JK)/ ZRJ5(JL,JN2J,JK)

          ZRR2(JL,JAJ)=ZRR2(JL,JAJ)+ZW2(JL,2)*ZLOG25(JL,JN2J,JK) &
           & +ZW2(JL,1)*ZLOG15(JL,JN2J,JK)
          ZRRK=ZRRK+ZW2(JL,2)*ZRR25(JL,JAJ)/ZRRK5
          ZRRJ=ZRRJ+ZW2(JL,1)*ZRR25(JL,JAJ)/ZRRJ5

          ZRK(JL,JN,JK) = ZRK(JL,JN,JK)  + 1.0_JPRB/ZRK5(JL,JN2J,JK)*ZRRK
          ZRK(JL,JN2J,JK) = ZRK(JL,JN2J,JK) - ZRRK5/ZRK5(JL,JN2J,JK)*ZRRK
          ZW2(JL,2) = 0.0_JPRB

          ZRJ(JL,JN,JK) = ZRJ(JL,JN,JK)  + 1.0_JPRB/ZRJ5(JL,JN2J,JK)*ZRRJ
          ZRJ(JL,JN2J,JK) = ZRJ(JL,JN2J,JK)  - ZRRJ5/ZRJ5(JL,JN2J,JK)*ZRRJ
          ZW2(JL,1) = 0.0_JPRB
        ENDDO

      ENDIF
      JKKI=JKKI-1
    ENDDO

  ENDDO

ENDDO

DO JAJ = 2, 1, -1
  DO JL = KIDIA,KFDIA
    PAKI(JL,JAJ,KNU) = PAKI(JL,JAJ,KNU) - ZRR2(JL,JAJ)*(ZRR25(JL,JAJ)**2)
    ZRR2(JL,JAJ) = 0.0_JPRB
  ENDDO
ENDDO

!1420 CONTINUE

!*       1.4.1   UPWARD (ZRK) AND DOWNWARD (ZRJ) PSEUDO-FLUXES
!                ---------------------------------------------

DO JK=KLEV+1,1,-1
  DO JAJ=6,2,-2
    DO JL=KIDIA,KFDIA
      IF (ZRK15(JL,JAJ,JK) <= REPLOG) THEN
        ZRK(JL,JAJ,JK) = 0.0_JPRB
      ENDIF

      IF (ZRJ15(JL,JAJ,JK) <= REPLOG) THEN
        ZRJ(JL,JAJ,JK) = 0.0_JPRB
      ENDIF
    ENDDO
  ENDDO
ENDDO

DO JK=KLEV+1,1,-1
  DO JAJ=5,1,-2
    JAJP=JAJ+1
    DO JL=KIDIA,KFDIA
      IF (ZRK25(JL,JAJ,JK) <= REPLOG) THEN
        ZRK(JL,JAJ,JK) = 0.0_JPRB
      ENDIF

      IF (ZRJ25(JL,JAJ,JK) <= REPLOG) THEN
        ZRJ(JL,JAJ,JK) = 0.0_JPRB
      ENDIF

      ZRK(JL,JAJP,JK) = ZRK(JL,JAJP,JK) - ZRK(JL,JAJ,JK)
      ZRJ(JL,JAJP,JK) = ZRJ(JL,JAJP,JK) - ZRJ(JL,JAJ,JK)

    ENDDO
  ENDDO
ENDDO

!1410 CONTINUE

!1400 CONTINUE

!     ------------------------------------------------------------------

!*       1. 3    SCATTERING CALCULATIONS WITH GREY MOLECULAR ABSORPTION
!                ------------------------------------------------------

!*      1. 3.3  REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
!               -------------------------------------------------

JN=6

DO JABS=2,1,-1

  DO JK=KLEV,1,-1
    IKL=KLEV+1-JK
    IKLP1=IKL+1

    DO JL=KIDIA,KFDIA
      ZRE115 = ZRJ15(JL,JN,IKLP1) * ZZTR25(JL,IKL,JABS)
!--------
      ZRE11 = 0.0_JPRB

      ZRE11 = ZRE11 + ZRK(JL,JN,IKL) * ZREFZ25(JL,IKL,JABS)
      ZREFZ(JL,2,IKL) = ZREFZ(JL,2,IKL) + ZRK(JL,JN,IKL) * ZRE115
      ZRK(JL,JN,IKL) = 0.0_JPRB

      ZRE11 = ZRE11 + ZRJ(JL,JN,IKL)
      ZRJ(JL,JN,IKL) = 0.0_JPRB

      ZRJ(JL,JN,IKLP1) = ZRJ(JL,JN,IKLP1) + ZRE11 &
       & * ZZTR25(JL,IKL,JABS)  
      ZTR(JL,2,IKL) = ZTR(JL,2,IKL) + ZRE11 * ZRJ15(JL,JN,IKLP1)
    ENDDO
  ENDDO
  DO JL=KIDIA,KFDIA
    ZREFZ(JL,2,KLEV+1) = ZREFZ(JL,2,KLEV+1) + ZRK(JL,JN,KLEV+1)
    ZRK(JL,JN,KLEV+1) = 0.0_JPRB
    ZRJ(JL,JN,KLEV+1) = 0.0_JPRB
  ENDDO

  JN=JN-1

  DO JK=KLEV,1,-1
    IKL=KLEV+1-JK
    IKLP1=IKL+1

    DO JL=KIDIA,KFDIA
      ZRE115 = ZRJ15(JL,JN,IKLP1) * ZZTR15(JL,IKL,JABS)
!--------
      ZRE11 = 0.0_JPRB

      ZRE11 = ZRE11 + ZRK(JL,JN,IKL) * ZREFZ15(JL,IKL,JABS)
      ZREFZ(JL,1,IKL) = ZREFZ(JL,1,IKL) + ZRK(JL,JN,IKL) * ZRE115
      ZRK(JL,JN,IKL) = 0.0_JPRB

      ZRE11 = ZRE11 + ZRJ(JL,JN,IKL)
      ZRJ(JL,JN,IKL) = 0.0_JPRB

      ZRJ(JL,JN,IKLP1) = ZRJ(JL,JN,IKLP1) + ZRE11 &
       & * ZZTR15(JL,IKL,JABS)  
      ZTR(JL,1,IKL) = ZTR(JL,1,IKL) + ZRE11 * ZRJ15(JL,JN,IKLP1)
    ENDDO
  ENDDO
  DO JL=KIDIA,KFDIA
    ZREFZ(JL,1,KLEV+1) = ZREFZ(JL,1,KLEV+1) + ZRK(JL,JN,KLEV+1)
    ZRK(JL,JN,KLEV+1) = 0.0_JPRB
    ZRJ(JL,JN,KLEV+1) = 0.0_JPRB
  ENDDO

!mj
  JN=JN-1
!mj

!1330 CONTINUE

!*      1. 3.2  INTRODUCING CLOUD EFFECTS
!               -------------------------

  DO JK=KLEV+1,2,-1
    IKM1=JK-1
    IKL=KLEV+1-IKM1

    DO JL=KIDIA,KFDIA
      ZRR=0.0_JPRB

      PCLD(JL,IKM1) = PCLD(JL,IKM1) + ZTR(JL,1,IKM1) * ZSTR25(JL,JABS,JK)
      ZTR2(JL) = ZTR2(JL) + ZTR(JL,1,IKM1) * PCLD5(JL,IKM1)

      ZRR=ZRR+ZTR(JL,1,IKM1)*ZTRA15(JL,IKM1) &
       & *ZSG5(JL,JABS,JK)*(1.0_JPRB-PCLD5(JL,IKM1))

      ZTRA1(JL,IKM1) = ZTRA1(JL,IKM1) + ZTR(JL,1,IKM1)&
       & *ZRR15(JL,JK,JABS)&
       & *ZSG5(JL,JABS,JK)*(1.0_JPRB-PCLD5(JL,IKM1))  
      ZG(JL) = ZG(JL) + ZTR(JL,1,IKM1)&
       & *ZTRA15(JL,IKM1) &
       & *ZRR15(JL,JK,JABS)&
       & *(1.0_JPRB-PCLD5(JL,IKM1))  
      PCLD(JL,IKM1) = PCLD(JL,IKM1) - ZTR(JL,1,IKM1)&
       & *ZTRA15(JL,IKM1) &
       & *ZRR15(JL,JK,JABS)&
       & *ZSG5(JL,JABS,JK)  

      ZTR(JL,1,IKM1) = 0.0_JPRB

      ZRE2(JL) = ZRE2(JL) + ZREFZ(JL,1,JK)*PCLD5(JL,IKM1)
      PCLD(JL,IKM1) = PCLD(JL,IKM1) + ZREFZ(JL,1,JK)*ZSRE25(JL,JABS,JK)
      ZRAY1(JL,IKM1) = ZRAY1(JL,IKM1) + ZREFZ(JL,1,JK) &
       & * (1.0_JPRB-PCLD5(JL,IKM1))*ZSG5(JL,JABS,JK)*ZSS5(JL,JABS,JK)  
      ZRR = ZRR + ZREFZ(JL,1,JK) &
       & *(1.0_JPRB-PCLD5(JL,IKM1))*ZSG5(JL,JABS,JK)*ZSS5(JL,JABS,JK) &
       & * ZREFZ15(JL,IKM1,JABS)*ZTRA15(JL,IKM1)*ZTRA25(JL,IKM1)  
      ZTRA2(JL,IKM1) =   ZTRA2(JL,IKM1) + ZREFZ(JL,1,JK) &
       & *(1.0_JPRB-PCLD5(JL,IKM1))*ZSG5(JL,JABS,JK)*ZSS5(JL,JABS,JK) &
       & * ZREFZ15(JL,IKM1,JABS)*ZTRA15(JL,IKM1)*ZRR15(JL,JK,JABS)  
      ZTRA1(JL,IKM1) =  ZTRA1(JL,IKM1) + ZREFZ(JL,1,JK) &
       & *(1.0_JPRB-PCLD5(JL,IKM1))*ZSG5(JL,JABS,JK)*ZSS5(JL,JABS,JK) &
       & * ZREFZ15(JL,IKM1,JABS)*ZTRA25(JL,IKM1)*ZRR15(JL,JK,JABS)  
      ZREFZ(JL,1,IKM1) = ZREFZ(JL,1,IKM1) + ZREFZ(JL,1,JK) &
       & *(1.0_JPRB-PCLD5(JL,IKM1))*ZSG5(JL,JABS,JK)*ZSS5(JL,JABS,JK) &
       & * ZTRA15(JL,IKM1)*ZTRA25(JL,IKM1)*ZRR15(JL,JK,JABS)  
      PCLD(JL,IKM1) = PCLD(JL,IKM1) - ZREFZ(JL,1,JK) &
       & * (ZRAY15(JL,IKM1)+ZREFZ15(JL,IKM1,JABS)*ZTRA15(JL,IKM1) &
       & * ZTRA25(JL,IKM1)*ZRR15(JL,JK,JABS) ) &
       & * ZSG5(JL,JABS,JK)*ZSS5(JL,JABS,JK)  
      ZS(JL) = ZS(JL) + ZREFZ(JL,1,JK) &
       & * (ZRAY15(JL,IKM1)+ZREFZ15(JL,IKM1,JABS)*ZTRA15(JL,IKM1) &
       & * ZTRA25(JL,IKM1)*ZRR15(JL,JK,JABS) ) &
       & *(1.0_JPRB-PCLD5(JL,IKM1))*ZSG5(JL,JABS,JK)  
      ZG(JL) = ZG(JL) + ZREFZ(JL,1,JK) &
       & * (ZRAY15(JL,IKM1)+ZREFZ15(JL,IKM1,JABS)*ZTRA15(JL,IKM1) &
       & * ZTRA25(JL,IKM1)*ZRR15(JL,JK,JABS) ) &
       & *(1.0_JPRB-PCLD5(JL,IKM1))*ZSS5(JL,JABS,JK)  
      ZREFZ(JL,1,JK) = 0.0_JPRB

      PCLD(JL,IKM1) = PCLD(JL,IKM1) + ZTR(JL,2,IKM1) *ZSTR15(JL,JABS,JK)
      ZTR1(JL) = ZTR1(JL) + ZTR(JL,2,IKM1) *PCLD5(JL,IKM1)
      ZTRA1(JL,IKM1) = ZTRA1(JL,IKM1)&
       & + ZTR(JL,2,IKM1) *ZSG5(JL,JABS,JK)*(1.0_JPRB-PCLD5(JL,IKM1))  
      ZG(JL) = ZG(JL) + ZTR(JL,2,IKM1) &
       & *ZTRA15(JL,IKM1)*(1.0_JPRB-PCLD5(JL,IKM1))
      PCLD(JL,IKM1) = PCLD(JL,IKM1) - ZTR(JL,2,IKM1) &
       & *ZTRA15(JL,IKM1)*ZSG5(JL,JABS,JK)
      ZTR(JL,2,IKM1) = 0.0_JPRB

      PCLD(JL,IKM1) = PCLD(JL,IKM1) + ZREFZ(JL,2,JK) *ZSRE15(JL,JABS,JK)
      ZRE1(JL) = ZRE1(JL) + ZREFZ(JL,2,JK) *PCLD5(JL,IKM1)
      PCLD(JL,IKM1) = PCLD(JL,IKM1) - ZREFZ(JL,2,JK)&
       & * (ZRAY15(JL,IKM1)&
       & + ZREFZ25(JL,IKM1,JABS) * ZTRA15(JL,IKM1) * ZTRA25(JL,IKM1))&
       & *ZSS5(JL,JABS,JK)*ZSG5(JL,JABS,JK)  
      ZRAY1(JL,IKM1) = ZRAY1(JL,IKM1) + ZREFZ(JL,2,JK) *(1.0_JPRB-&
       & PCLD5(JL,IKM1))&
       & *ZSS5(JL,JABS,JK)*ZSG5(JL,JABS,JK)  
      ZREFZ(JL,2,IKM1) = ZREFZ(JL,2,IKM1)&
       & + ZREFZ(JL,2,JK) *(1.0_JPRB-PCLD5(JL,IKM1))&
       & *ZTRA15(JL,IKM1)*ZTRA25(JL,IKM1)&
       & *ZSS5(JL,JABS,JK)*ZSG5(JL,JABS,JK)  
      ZTRA1(JL,IKM1) = ZTRA1(JL,IKM1)&
       & + ZREFZ(JL,2,JK) *(1.0_JPRB-PCLD5(JL,IKM1))&
       & *ZREFZ25(JL,IKM1,JABS)*ZTRA25(JL,IKM1)&
       & *ZSS5(JL,JABS,JK)*ZSG5(JL,JABS,JK)  
      ZTRA2(JL,IKM1) = ZTRA2(JL,IKM1)&
       & + ZREFZ(JL,2,JK) *(1.0_JPRB-PCLD5(JL,IKM1))&
       & *ZREFZ25(JL,IKM1,JABS)*ZTRA15(JL,IKM1)&
       & *ZSS5(JL,JABS,JK)*ZSG5(JL,JABS,JK)  
      ZG(JL) = ZG(JL) + ZREFZ(JL,2,JK) *(1.0_JPRB-PCLD5(JL,IKM1))&
       & * (ZRAY15(JL,IKM1)&
       & + ZREFZ25(JL,IKM1,JABS) * ZTRA15(JL,IKM1) * ZTRA25(JL,IKM1))&
       & *ZSS5(JL,JABS,JK)         
      ZS(JL) = ZS(JL) + ZREFZ(JL,2,JK) *(1.0_JPRB-PCLD5(JL,IKM1))&
       & * (ZRAY15(JL,IKM1)&
       & + ZREFZ25(JL,IKM1,JABS) * ZTRA15(JL,IKM1) * ZTRA25(JL,IKM1))&
       & *ZSG5(JL,JABS,JK)
      ZREFZ(JL,2,JK) = 0.0_JPRB
      ZRAY2(JL,IKM1) = ZRAY2(JL,IKM1) &
       & +ZRR*ZREFZ15(JL,IKM1,JABS)*ZRR15(JL,JK,JABS)**2
      ZREFZ(JL,1,IKM1) = ZREFZ(JL,1,IKM1) &
       & +ZRR*ZRAY25(JL,IKM1)*ZRR15(JL,JK,JABS)**2
    ENDDO

    CALL SWDEAD &
     & ( KIDIA , KFDIA , KLON,&
     & ZSGG5(1,JABS,JK), ZREFZ15(1,IKM1,JABS), ZRMUE5(1,JK), &
     & ZSTO15(1,JABS,JK), ZSW05(1,JABS,JK),&
     & ZSRE15(1,JABS,JK), ZSRE25(1,JABS,JK),&
     & ZSTR15(1,JABS,JK), ZSTR25(1,JABS,JK),&
     & ZGG   , ZREF  , ZRMUE(1,JK), ZTO1 , ZW0,&
     & ZRE1  , ZRE2  , ZTR1  , ZTR2     &
     & )  

    DO JL=KIDIA,KFDIA
!-----
      ZAA   = 0.0_JPRB
      ZBB   = 0.0_JPRB
      ZCNEB = 0.0_JPRB
      ZPNEB = 0.0_JPRB
      ZWH2O = 0.0_JPRB
      ZCHKS = 0.0_JPRB
      ZCHKG = 0.0_JPRB

      ZREFZ(JL,1,IKM1) = ZREFZ(JL,1,IKM1) + ZREF(JL)
      ZREF(JL) = 0.0_JPRB

      ZR21(JL) = ZR21(JL) + ZW0(JL) /ZSTO15(JL,JABS,JK)
      ZTO1(JL) = ZTO1(JL) - ZW0(JL) *ZSR215(JL,JABS,JK)&
       & /(ZSTO15(JL,JABS,JK)**2)  
      ZW0(JL) = 0.0_JPRB

      ZR22(JL) = ZR22(JL) + ZGG(JL) *PCG5(JL,KNU,IKM1)
      PCG(JL,KNU,IKM1) = PCG(JL,KNU,IKM1)+ZGG(JL)*ZSR225(JL,JABS,JK)
      ZR22(JL) = ZR22(JL) - ZGG(JL) *ZCGAZ5(JL,IKM1)
      ZCGAZ(JL,IKM1) = ZCGAZ(JL,IKM1) + ZGG(JL)&
       & *(1.0_JPRB-ZSR225(JL,JABS,JK))  
      ZGG(JL) = 0.0_JPRB

      PTAU(JL,KNU,IKM1) = PTAU(JL,KNU,IKM1) + ZR22(JL) &
       & /ZSR215(JL,JABS,JK)  
      ZR21(JL) = ZR21(JL) - ZR22(JL) *PTAU5(JL,KNU,IKM1)&
       & /(ZSR215(JL,JABS,JK)**2)  
      ZR22(JL) = 0.0_JPRB

      PTAU(JL,KNU,IKM1) = PTAU(JL,KNU,IKM1) + ZR21(JL)
      ZTAUAZ(JL,IKM1) = ZTAUAZ(JL,IKM1) + ZR21(JL)
      ZR21(JL) = 0.0_JPRB

      PTAU(JL,KNU,IKM1) = PTAU(JL,KNU,IKM1) + ZTO1(JL) /POMEGA5(JL,KNU,IKM1)
      ZW0(JL) = ZW0(JL)&
       & - ZTO1(JL) *PTAU5(JL,KNU,IKM1)/(POMEGA5(JL,KNU,IKM1)**2)  
      ZTAUAZ(JL,IKM1) = ZTAUAZ(JL,IKM1)+ ZTO1(JL) /ZPIZAZ5(JL,IKM1)
      ZPIZAZ(JL,IKM1) = ZPIZAZ(JL,IKM1)&
       & - ZTO1(JL) *ZTAUAZ5(JL,IKM1)/(ZPIZAZ5(JL,IKM1)**2)  
      ZBB = ZBB + ZTO1(JL) *PAKI5(JL,JABS,KNU)
      PAKI(JL,JABS,KNU) = PAKI(JL,JABS,KNU) + ZTO1(JL) *ZSBB5(JL,JABS,JK)
      ZTO1(JL) = 0.0_JPRB

      POMEGA(JL,KNU,IKM1) = POMEGA(JL,KNU,IKM1) + ZW0(JL)
      ZW0(JL) = 0.0_JPRB

      ZCHKG = ZCHKG - ZSG5(JL,JABS,JK)*ZG (JL)
      ZG(JL) = 0.0_JPRB
      ZCHKS = ZCHKS - ZSS5(JL,JABS,JK)*ZS(JL)
      ZS(JL) = 0.0_JPRB
      
      IF ((PAKI5(JL,JABS,KNU)*ZSAA5(JL,JABS,JK)/ZRMUE5(JL,JK)) &
         & <= 200._JPRB) THEN  
        ZAA = ZAA + (PAKI5(JL,JABS,KNU)/ZRMUE5(JL,JK))*ZCHKG
        PAKI(JL,JABS,KNU) = PAKI(JL,JABS,KNU) &
         & + (ZSAA5(JL,JABS,JK)/ZRMUE5(JL,JK))*ZCHKG
        ZRMUE(JL,JK) = ZRMUE(JL,JK) - (PAKI5(JL,JABS,KNU) &
         & *ZSAA5(JL,JABS,JK)/ZRMUE5(JL,JK)**2)*ZCHKG  
      ENDIF
      ZCHKG  = 0.0_JPRB
      
      IF ((PAKI5(JL,JABS,KNU)*ZSAA5(JL,JABS,JK)*1.66_JPRB) &
         & <= 200._JPRB) THEN   
        ZAA = ZAA + 1.66_JPRB*PAKI5(JL,JABS,KNU)*ZCHKS
        PAKI(JL,JABS,KNU) = PAKI(JL,JABS,KNU) &
         & + 1.66_JPRB*ZSAA5(JL,JABS,JK)*ZCHKS
      ENDIF
      ZCHKS  = 0.0_JPRB
      
      IF (JABS == 1.AND. PCLD5(JL,IKM1) > REPSC ) THEN
        IF (ZSAAT5(JL,JABS,JK) >= REPSCQ) THEN
          PUD(JL,JABS,IKM1) = PUD(JL,JABS,IKM1)&
           & + ZAA /(1.0_JPRB-ZCNEB5(JL,JABS,IKM1))  
          ZCNEB = ZCNEB - ZAA *ZSBB5(JL,JABS,JK)&
           & /(1.0_JPRB-ZCNEB5(JL,JABS,IKM1))  
          ZBB = ZBB - ZAA *ZCNEB5(JL,JABS,IKM1)&
           & /(1.0_JPRB-ZCNEB5(JL,JABS,IKM1))  
          ZCNEB = ZCNEB + ZAA &
           & *(PUD5(JL,JABS,IKM1)-ZCNEB5(JL,JABS,IKM1)&
           & *ZSBB5(JL,JABS,JK))/((1.0_JPRB-ZCNEB5(JL,JABS,IKM1))**2)  
        ENDIF
        ZAA = 0.0_JPRB

        PUD(JL,JABS,IKM1) = PUD(JL,JABS,IKM1)&
         & + ZBB *PQS5(JL,IKL)/ZSWH2O5(JL,JABS,JK)  
        PQS(JL,IKL) = PQS(JL,IKL)&
         & + ZBB *PUD5(JL,JABS,IKM1)/ZSWH2O5(JL,JABS,JK)  
        ZWH2O = ZWH2O - ZBB *PUD5(JL,JABS,IKM1)*PQS5(JL,IKL)&
         & /(ZSWH2O5(JL,JABS,JK)**2)  
        ZBB = 0.0_JPRB

        IF (ZPNEB5(JL,IKM1) >= REPSC ) THEN
          ZPNEB = ZPNEB + ZCNEB
        ENDIF
        ZCNEB = 0.0_JPRB 
        IF (PCLD5(JL,IKM1) <= 1.0_JPRB-REPSC ) THEN
          PCLD(JL,IKM1) = PCLD(JL,IKM1) + ZPNEB
        ENDIF
        ZPNEB = 0.0_JPRB

        IF (PWV5(JL,IKL) >= REPSCQ) THEN
          PWV(JL,IKL) = PWV(JL,IKL) + ZWH2O
        ENDIF
        ZWH2O = 0.0_JPRB
      ELSE
        ZAA = ZAA + ZBB
        ZBB = 0.0_JPRB

        PUD(JL,JABS,IKM1) = PUD(JL,JABS,IKM1) + ZAA
        ZAA = 0.0_JPRB
      ENDIF

    ENDDO

  ENDDO

!1320 CONTINUE

!*      1. 3.1  SURFACE CONDITIONS
!               ------------------

  DO JL=KIDIA,KFDIA
    PALBD(JL,KNU) = PALBD(JL,KNU) + ZREFZ(JL,1,1)
    ZREFZ(JL,1,1) = 0.0_JPRB

    PALBD(JL,KNU) = PALBD(JL,KNU) + ZREFZ(JL,2,1)
    ZREFZ(JL,2,1) = 0.0_JPRB
  ENDDO

!1310 CONTINUE        

ENDDO

!1300 CONTINUE 

!     ------------------------------------------------------------------

!*       1. 2    CONTINUUM SCATTERING CALCULATIONS
!                ---------------------------------

!*      1. 2.2   CLOUDY FRACTION OF THE COLUMN
!                -----------------------------

CALL SWRAD &
 & ( KIDIA  , KFDIA  , KLON  , KLEV  , KNU,&
 & PALBD5 , PCG5   , PCLD5 ,POMEGA5, PSEC5, PTAU5,&
 & ZCGAZ5 , ZPIZAZ5, ZRAY15, ZRAY25, ZREFZ5,&
 & ZRJ15  , ZRK15  , ZRMUE5,&
 & ZTAUAZ5, ZTRA15 , ZTRA25,&
! saved in NL computation - swr
 & ZRESWR15,ZRESWR25,ZTRSWR15,ZTRSWR25,&
! perturbation
 & PALBD  , PCG    , PCLD  ,POMEGA , PSEC , PTAU,&
 & ZCGAZ  , ZPIZAZ , ZRAY1 , ZRAY2 , ZREFZ  , ZRJ  , ZRK , ZRMUE,&
 & ZTAUAZ , ZTRA1  , ZTRA2 &
 & )  

!1220 CONTINUE

!     ------------------------------------------------------------------

!*      1. 2.1   CLEAR-SKY FRACTION OF THE COLUMN
!                --------------------------------

CALL SWCLRAD &
 & ( KIDIA   , KFDIA  , KLON   , KLEV   , KAER    , KNU,&
 & PAER5   , PALBP5 , PDSIG5 , ZRAYL5 , PSEC5,&
 & ZCGAZ5  , ZPIZAZ5, ZRAY015, ZRAY025, ZREFZ05, ZRJ05,&
 & ZRK05   , ZRMU05 , ZTAUAZ5, ZTRA015, ZTRA025,&
 & PAER    , PALBP  , PDSIG  , ZRAYL  , PSEC,&
 & ZCGAZ   , ZPIZAZ , ZRAY01 , ZRAY02 , ZREFZ0 , ZRJ0,&
 & ZRK0    , ZRMU0  , ZTAUAZ , ZTRA01 , ZTRA02 &
 & )  

!1210 CONTINUE

!1200 CONTINUE

!     ------------------------------------------------------------------

!*       1. 1     NEAR-INFRARED SPECTRAL INTERVAL (0.68-4.00 MICRON)
!                 --------------------------------------------------

!*      1. 1.1    OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
!                 -----------------------------------------

DO JL=KIDIA,KFDIA
!-----
  ZRMUM1 = 0.0_JPRB

  IF (ZRAYL15(JL) < 0.0_JPRB) THEN
    ZRAYL(JL) = 0.0_JPRB
  ENDIF
  ZRMUM1 = ZRMUM1 + ZRAYL (JL) * (1*RRAY(KNU,2) + ZRMUM15(JL)&
   & * (2*RRAY(KNU,3) + ZRMUM15(JL)* (3*RRAY(KNU,4) + ZRMUM15(JL)&
   & * (4*RRAY(KNU,5) + ZRMUM15(JL)*  5*RRAY(KNU,6)  ))))  
  ZRAYL(JL) = 0.0_JPRB

  PRMU(JL) = PRMU(JL) - ZRMUM1
ENDDO

!1110 CONTINUE

!1000 CONTINUE             

!     ------------------------------------------------------------------

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