SUBROUTINE SWAD &
 & ( KIDIA , KFDIA  , KLON , KLEV  , KAER,&
 !- trajectory inputs
 & PSCT5 , PCARDI5, PPSOL5 , PALBD5, PALBP5 , PWV5, PQS5,&
 & PRMU05, PCG5   , PCLDSW5, POMEGA5, POZ5, PPMB5,&
 & PTAU5 , PTAVE5 , PAER5,&
 !- trajectory outputs
 & PFACT5 , PFDOWN5, PFUP5,&
 ! & PCDOWN5, PCUP5  ,&
 !- perturbation inputs      
 & PSCT  , PCARDI , PPSOL  , PALBD , PALBP  , PWV , PQS,&
 & PRMU0 , PCG    , PCLDSW , POMEGA , POZ , PPMB,&
 & PTAU  , PTAVE  , PAER,&
 !- perturbation outputs
 & PFDOWN , PFUP &
! & PCDOWN , PCUP &
 & )  

!**** *SWAD* - COMPUTES THE SHORTWAVE RADIATION FLUXES.
!              -> ADJOINT <-

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

!          THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
!     SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).

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

!          *SWAD* IS CALLED FROM *RADLSWAD*

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

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

!     METHOD.
!     -------

!          1. COMPUTES ABSORBER AMOUNTS                 (SWU)
!          2. COMPUTES FLUXES IN U.V./VISIBLE  SPECTRAL INTERVAL (SW1S)
!          3. COMPUTES FLUXES IN NEAR-INFRARED SPECTRAL INTERVAL (SWNI)

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

!          *SWU*
!          *SWUAD*, *SW1SAD*, *SWNIAD*

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

!        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
!        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)

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

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 96-10-26
!        Modified : 99-04-26 M. Janiskova - initialization of missing
!                                           local arrays and AD corrections
!                 2000-02-24 M. Janiskova - adopted for revised aerosols
!                                           as in sw
!                 2002-05-07 M.Janiskova  - (adopted for 6 spectral 
!                                             intervals)
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!                 2008-03-18 M.Janiskova - commented diagnostic computation
!                                          removed call to some NL routines
!     ------------------------------------------------------------------

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

USE YOERAD   , ONLY : NSW
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 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSCT5 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCARDI5 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPSOL5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD5(KLON,NSW) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP5(KLON,NSW) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWV5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU05(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCG5(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLDSW5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POMEGA5(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POZ5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPMB5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU5(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAVE5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER5(KLON,6,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFACT5(KLON)
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) :: PSCT 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCARDI 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PPSOL(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PALBD(KLON,NSW) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PALBP(KLON,NSW) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWV(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQS(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRMU0(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCG(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCLDSW(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: POMEGA(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: POZ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PPMB(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTAU(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTAVE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAER(KLON,6,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
!              ---------

!- Inputs Trajectory

!- Outputs Trajectory

!- Inputs Perturbations

!- Outputs Perturbations

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

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

!- Trajectory

REAL(KIND=JPRB) :: ZAKI5(KLON,2,NSW)&
 & ,  ZCLD5(KLON,KLEV)    , ZCLEAR5(KLON) &
 & ,  ZDSIG5(KLON,KLEV)   &
 & ,  ZFD5(KLON,KLEV+1)   &
 & ,  ZCDNIR5(KLON,KLEV+1), ZCDUVS5(KLON,KLEV+1)&
 & ,  ZFDOWN5(KLON,KLEV+1), ZFDNIR5(KLON,KLEV+1), ZFDUVS5(KLON,KLEV+1)&
 & ,  ZFU5(KLON,KLEV+1)   &
 & ,  ZCUNIR5(KLON,KLEV+1), ZCUUVS5(KLON,KLEV+1)&
 & ,  ZFUP5(KLON,KLEV+1)  , ZFUNIR5(KLON,KLEV+1), ZFUUVS5(KLON,KLEV+1)&
 & ,  ZRMU5(KLON)         , ZSEC5(KLON)         &
 & ,  ZUD5(KLON,5,KLEV+1)
! diagnostic clear sky quantities
!REAL(KIND=JPRB) :: ZCDOWN5(KLON,KLEV+1), ZCUP5(KLON,KLEV+1) &
! & ,  ZCU5(KLON,KLEV+1), ZCD5(KLON,KLEV+1)

!- Perturbations

REAL(KIND=JPRB) :: ZAKI(KLON,2,NSW)&
 & ,  ZCLD(KLON,KLEV)    , ZCLEAR(KLON) &
 & ,  ZDSIG(KLON,KLEV)   &
 & ,  ZFD(KLON,KLEV+1)   &
 & ,  ZCDNIR(KLON,KLEV+1), ZCDUVS(KLON,KLEV+1)&
 & ,  ZFDOWN(KLON,KLEV+1), ZFDNIR(KLON,KLEV+1), ZFDUVS(KLON,KLEV+1)&
 & ,  ZFU(KLON,KLEV+1)   &
 & ,  ZCUNIR(KLON,KLEV+1), ZCUUVS(KLON,KLEV+1)&
 & ,  ZFUP(KLON,KLEV+1)  , ZFUNIR(KLON,KLEV+1), ZFUUVS(KLON,KLEV+1)&
 & ,  ZRMU(KLON)         , ZSEC(KLON)         &
 & ,  ZUD(KLON,5,KLEV+1) 
REAL(KIND=JPRB) :: ZFACT(KLON)
! diagnostic clear sky quantitie
!REAL(KIND=JPRB) :: ZCDOWN(KLON,KLEV+1), ZCUP(KLON,KLEV+1)&
! & ,  ZCU(KLON,KLEV+1), ZCD(KLON,KLEV+1)

INTEGER(KIND=JPIM) ::  JK, JL, JNU, INUVS, INUIR
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "sw1sad.intfb.h"
#include "swniad.intfb.h"
#include "swu.intfb.h"
#include "swuad.intfb.h"

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

!*         1.     ABSORBER AMOUNTS AND OTHER USEFUL QUANTITIES
!                 --------------------------------------------

! 100 CONTINUE

IF (LHOOK) CALL DR_HOOK('SWAD',0,ZHOOK_HANDLE)
CALL SWU &
 & ( KIDIA , KFDIA  , KLON   , KLEV,&
 & PSCT5 , PCARDI5, PCLDSW5, PPMB5 , PPSOL5,&
 & PRMU05, PTAVE5 , PWV5,&
 & ZAKI5 , ZCLD5  , ZCLEAR5, ZDSIG5, PFACT5, ZRMU5 , ZSEC5, ZUD5 &
 & )  

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

!*         2.     INTERVAL (0.25-0.68 MICRON): U.V. AND VISIBLE
!                 ---------------------------------------------

! 200 CONTINUE

IF (NSW <= 4) THEN
  INUVS=1
  INUIR=2
ELSEIF (NSW == 6) THEN
  INUVS=1
  INUIR=4
ENDIF

DO JK = 1 , KLEV+1
  DO JL = KIDIA,KFDIA
    ZFD5(JL,JK) = 0.0_JPRB
    ZFU5(JL,JK) = 0.0_JPRB

! diagnostic clear sky quantities
!    ZCD5(JL,JK) = 0.0_JPRB
!    ZCU5(JL,JK) = 0.0_JPRB
  ENDDO
ENDDO

! CALL SW1S is not necessary, trajectory values are obtained from SW1SAD

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

!*         3.     INTERVAL (0.68-4.00 MICRON): NEAR-INFRARED
!                 ------------------------------------------

! 300 CONTINUE

DO JK = 1 , KLEV+1
  DO JL = KIDIA,KFDIA
    ZFDOWN5(JL,JK)=0.0_JPRB
    ZFUP5  (JL,JK)=0.0_JPRB

! diagnostic clear sky quantities
!    ZCDOWN5(JL,JK)=0.0_JPRB
!    ZCUP5  (JL,JK)=0.0_JPRB
  ENDDO
ENDDO

! CALL SWNI is not necessary, trajectory values are obtained from SWNIAD

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

!!*         4.     FILL THE ARRAYS
!!                 ---------------

! 400 CONTINUE

! Filled at the end

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

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

! diagnostic clear sky quantities
!ZCD(:,:)    = 0.0_JPRB
!ZCU(:,:)    = 0.0_JPRB
!ZCDOWN(:,:) = 0.0_JPRB
!ZCUP(:,:)   = 0.0_JPRB

ZFACT(:)    = 0.0_JPRB
ZFD(:,:)    = 0.0_JPRB
ZFU(:,:)    = 0.0_JPRB
ZFDOWN(:,:) = 0.0_JPRB
ZFUP(:,:)   = 0.0_JPRB

ZFDUVS(:,:) = 0.0_JPRB
ZFUUVS(:,:) = 0.0_JPRB
ZCDUVS(:,:) = 0.0_JPRB
ZCUUVS(:,:) = 0.0_JPRB

ZCLEAR(:)   = 0.0_JPRB
ZRMU(:)     = 0.0_JPRB
ZSEC(:)     = 0.0_JPRB
ZCLD(:,:)   = 0.0_JPRB
ZDSIG(:,:)  = 0.0_JPRB
ZAKI(:,:,:) = 0.0_JPRB
ZUD(:,:,:)  = 0.0_JPRB

ZFDNIR(:,:) = 0.0_JPRB
ZFUNIR(:,:) = 0.0_JPRB
ZCDNIR(:,:) = 0.0_JPRB
ZCUNIR(:,:) = 0.0_JPRB

DO JK=KLEV+1,1,-1
  DO JL=KIDIA,KFDIA
! diagnostic clear sky quantities
!    ZCDOWN(JL,JK) = ZCDOWN(JL,JK) + PCDOWN(JL,JK)
!    ZCD(JL,JK)    = ZCD(JL,JK)    + PCDOWN(JL,JK)
!    PCDOWN(JL,JK) = 0.0_JPRB

!    ZCUP(JL,JK) = ZCUP(JL,JK) + PCUP(JL,JK)
!    ZCU(JL,JK)  = ZCU(JL,JK)  + PCUP(JL,JK)
!    PCUP(JL,JK) = 0.0_JPRB

    ZFDOWN(JL,JK) = ZFDOWN(JL,JK) + PFDOWN(JL,JK)
    ZFD(JL,JK)    = ZFD(JL,JK)    + PFDOWN(JL,JK)
    PFDOWN(JL,JK) = 0.0_JPRB

    ZFUP(JL,JK) = ZFUP(JL,JK) + PFUP(JL,JK)
    ZFU(JL,JK)  = ZFU(JL,JK)  + PFUP(JL,JK)
    PFUP(JL,JK) = 0.0_JPRB
  ENDDO
ENDDO

!1400 CONTINUE 

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

DO JNU=NSW,INUIR,-1

  DO JK=KLEV+1,1,-1
    DO JL=KIDIA,KFDIA
! diagnostic clear sky quantities
!      ZCUNIR(JL,JK) = ZCUNIR(JL,JK) + ZCUP  (JL,JK)
!      ZCDNIR(JL,JK) = ZCDNIR(JL,JK) + ZCDOWN(JL,JK)

      ZFUNIR(JL,JK) = ZFUNIR(JL,JK) + ZFUP  (JL,JK)
      ZFDNIR(JL,JK) = ZFDNIR(JL,JK) + ZFDOWN(JL,JK)
    ENDDO
  ENDDO

  CALL SWNIAD &
   & ( KIDIA  , KFDIA , KLON   , KLEV   , KAER  , JNU,&
   & PAER5  , ZAKI5 , PALBD5 , PALBP5,&
   & PCG5   , ZCLD5 , ZCLEAR5,&
   & ZDSIG5 ,POMEGA5, POZ5   , ZRMU5  , ZSEC5 , PTAU5, ZUD5,&
   & PWV5   , PQS5,&
   & ZFDNIR5,ZFUNIR5,&
! ZCDNIR5, ZCUNIR5,&
   & PAER   , ZAKI  , PALBD  , PALBP,&
   & PCG    , ZCLD  , ZCLEAR,&
   & ZDSIG  , POMEGA, POZ    , ZRMU   , ZSEC  , PTAU , ZUD,&
   & PWV    , PQS,&
   & ZFDNIR , ZFUNIR &
!, ZCDNIR , ZCUNIR &
   & )  

! Trajectory computation from swniad, instead of swni
  DO JK = 1 , KLEV+1
    DO JL = KIDIA,KFDIA
      ZFDOWN5(JL,JK)=ZFDOWN5(JL,JK)+ZFDNIR5(JL,JK)
      ZFUP5  (JL,JK)=ZFUP5  (JL,JK)+ZFUNIR5(JL,JK)

! diagnostic clear sky quantities
!      ZCDOWN5(JL,JK)=ZCDOWN5(JL,JK)+ZCDNIR5(JL,JK)
!      ZCUP5  (JL,JK)=ZCUP5  (JL,JK)+ZCUNIR5(JL,JK)
    ENDDO
  ENDDO

ENDDO

!1300 CONTINUE 

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

DO JNU = INUIR-1,INUVS,-1

  DO JK = KLEV+1,1,-1
    DO JL = KIDIA,KFDIA
! diagnostic clear sky quantities
!      ZCUUVS(JL,JK) = ZCUUVS(JL,JK) + ZCU(JL,JK)
!      ZCDUVS(JL,JK) = ZCDUVS(JL,JK) + ZCD(JL,JK)

      ZFUUVS(JL,JK) = ZFUUVS(JL,JK) + ZFU(JL,JK)
      ZFDUVS(JL,JK) = ZFDUVS(JL,JK) + ZFD(JL,JK)
    ENDDO
  ENDDO

  CALL SW1SAD &
   & ( KIDIA , KFDIA  , KLON  , KLEV  , KAER  , JNU,&
   & PAER5 , PALBD5 , PALBP5, PCG5  , ZCLD5 , ZCLEAR5,&
   & ZDSIG5, POMEGA5, POZ5  , ZRMU5 , ZSEC5 , PTAU5  , ZUD5,&
   & ZFDUVS5, ZFUUVS5, ZCDUVS5, ZCUUVS5,&
   & PAER  , PALBD  , PALBP , PCG   , ZCLD  , ZCLEAR,&
   & ZDSIG , POMEGA , POZ   , ZRMU  , ZSEC  , PTAU   , ZUD,&
   & ZFDUVS, ZFUUVS , ZCDUVS, ZCUUVS &
   & )  

! Trajectory computation from sw1sad, instead of sw1s
  DO JK = 1 , KLEV+1
    DO JL = KIDIA,KFDIA
      ZFD5(JL,JK)= ZFD5(JL,JK)+ZFDUVS5(JL,JK)
      ZFU5(JL,JK)= ZFU5(JL,JK)+ZFUUVS5(JL,JK)

! diagnostic clear sky quantities
!      ZCD5(JL,JK)= ZCD5(JL,JK)+ZCDUVS5(JL,JK)
!      ZCU5(JL,JK)= ZCU5(JL,JK)+ZCUUVS5(JL,JK)
    ENDDO
  ENDDO

!1200 CONTINUE

ENDDO

DO JK = 1 , KLEV+1
  DO JL = KIDIA,KFDIA
    ZFD(JL,JK) = 0.0_JPRB
    ZFU(JL,JK) = 0.0_JPRB

! diagnostic clear sky quantities
!    ZCD(JL,JK) = 0.0_JPRB
!    ZCU(JL,JK) = 0.0_JPRB
  ENDDO
ENDDO

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

CALL SWUAD &
 & ( KIDIA , KFDIA  , KLON   , KLEV,&
 & PSCT5 , PCARDI5, PCLDSW5, PPMB5 , PPSOL5,&
 & PRMU05, PTAVE5 , PWV5,&
 & ZAKI5 , ZCLD5  , ZCLEAR5, ZDSIG5, PFACT5, ZRMU5 , ZSEC5, ZUD5,&
 & PSCT  , PCARDI , PCLDSW , PPMB  , PPSOL,&
 & PRMU0 , PTAVE  , PWV,&
 & ZAKI  , ZCLD   , ZCLEAR , ZDSIG , ZFACT , ZRMU  , ZSEC , ZUD  &
 & )  

!1100 CONTINUE

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

!*         4.     FILL THE ARRAYS
!                 ---------------

DO JK = 1 , KLEV+1
  DO JL = KIDIA,KFDIA
    PFUP5(JL,JK)   = ZFUP5(JL,JK)   + ZFU5(JL,JK)
    PFDOWN5(JL,JK) = ZFDOWN5(JL,JK) + ZFD5(JL,JK)

! diagnostic clear sky quantities
!    PCUP5(JL,JK)   = ZCUP5(JL,JK)   + ZCU5(JL,JK)
!    PCDOWN5(JL,JK) = ZCDOWN5(JL,JK) + ZCD5(JL,JK)
  ENDDO
ENDDO

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

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