SUBROUTINE SW &
 & ( KIDIA, KFDIA , KLON  , KLEV , KAER,&
 & PSCT , PCARDI, PPSOL , PALBD, PALBP , PWV, PQS,&
 & PRMU0, PCG   , PCLDSW, PDP  , POMEGA, POZ, PPMB,&
 & PTAU , PTAVE , PAER,&
 & PFDOWN, PFUP,&
 & PCDOWN, PCUP,&
 & PFDNN, PFDNV , PFUPN, PFUPV,&
 & PCDNN, PCDNV , PCUPN, PCUPV,&
 & PSUDU, PUVDF , PPARF, PPARCF, PDIFFS , PDIRFS, &
 & LRDUST, PPIZA_DST,PCGA_DST,PTAUREL_DST &
 & )


!**** *SW* - COMPUTES THE SHORTWAVE RADIATION FLUXES.

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

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

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

!          *SW* IS CALLED FROM *RADLSW*

!        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*, *SW1S*, *SWNI*

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

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

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

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 89-07-14
!        95-01-01   J.-J. MORCRETTE  Direct/Diffuse Albedo
!        95-12-07   J.-J. MORCRETTE  Near-Infrared in nsw-1 Intervals
!        990128     JJMorcrette      sunshine duration
!        99-05-25   JJMorcrette      Revised aerosols
!        00-12-18   JJMorcrette      6 spectral intervals
!        02-09-01   JJMorcrette      UV and PAR
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        Y.Seity  04-11-18 : add two arguments for AROME extern. surface
!        Y.Seity  05-10-10 : add add 3 optional arg. for dust SW properties
!        JJMorcrette 20060721 PP of clear-sky PAR
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
!USE YOERAD   , ONLY : NSW
! NSW mis dans .def MPL 20140211
USE write_field_phy
! Temporary fix waiting for cleaner interface (or not)
USE clesphys_mod_h, ONLY: NSW

IMPLICIT NONE

!!include "clesphys.h"

integer, save :: icount=0
!$OMP THREADPRIVATE(icount)
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)    :: PSCT 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCARDI 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPSOL(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KLON,NSW) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KLON,NSW) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWV(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCG(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLDSW(KLON,KLEV) 
REAL(KIND=JPRB)                  :: PDP(KLON,KLEV) ! Argument NOT used
REAL(KIND=JPRB)   ,INTENT(IN)    :: POMEGA(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POZ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPMB(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU(KLON,NSW,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAVE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV) 
!++MODIFCODE
LOGICAL           ,INTENT(IN)    :: LRDUST
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZA_DST(KLON,KLEV,NSW)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGA_DST(KLON,KLEV,NSW)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUREL_DST(KLON,KLEV,NSW)
!--MODIFCODE
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFDOWN(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFUP(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCDOWN(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCUP(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFDNN(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFDNV(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFUPN(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFUPV(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCDNN(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCDNV(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCUPN(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCUPV(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSUDU(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUVDF(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PPARF(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PPARCF(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDIFFS(KLON,NSW) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDIRFS(KLON,NSW) 
!     ------------------------------------------------------------------

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

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

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

REAL(KIND=JPRB) :: ZAKI(KLON,2,NSW)&
 & ,  ZCLD(KLON,KLEV)    , ZCLEAR(KLON) &
 & ,  ZDSIG(KLON,KLEV)   , ZFACT(KLON)&
 & ,  ZFD(KLON,KLEV+1)   , ZCD(KLON,KLEV+1)&
 & ,  ZCDOWN(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)   , ZCU(KLON,KLEV+1)&
 & ,  ZCUP(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)         &
 & ,  ZSUDU1(KLON)       , ZSUDU2(KLON)       &
 & ,  ZSUDU1T(KLON)      , ZSUDU2T(KLON)      &
 & ,  ZUD(KLON,5,KLEV+1) ,ZDIFF(KLON,KLEV)   ,ZDIRF(KLON,KLEV)    &
 & ,  ZDIFF2(KLON,KLEV)  , ZDIRF2(KLON,KLEV)

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

REAL(KIND=JPRB) :: ZHOOK_HANDLE
LOGICAL         :: LLDEBUG
character*1 str1

#include "sw1s.intfb.h"
#include "swni.intfb.h"
#include "swu.intfb.h"

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

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

IF (LHOOK) CALL DR_HOOK('SW',0,ZHOOK_HANDLE)
LLDEBUG=.FALSE.
CALL SWU ( KIDIA,KFDIA ,KLON  ,KLEV,&
 & PSCT ,PCARDI,PCLDSW,PPMB ,PPSOL,&
 & PRMU0,PTAVE ,PWV,&
 & ZAKI ,ZCLD  ,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD )  

!     ------------------------------------------------------------------
!*         2.     INTERVAL (0.185/0.25-0.68 MICRON): U.V. AND VISIBLE
!                 ---------------------------------------------------
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
    ZFD(JL,JK) =0.0_JPRB
    ZFU(JL,JK) =0.0_JPRB
    ZCD(JL,JK) =0.0_JPRB
    ZCU(JL,JK) =0.0_JPRB
  ENDDO
ENDDO
DO JL = KIDIA,KFDIA
  ZSUDU1T(JL)=0.0_JPRB
  PUVDF(JL)  =0.0_JPRB
  PPARF(JL)  =0.0_JPRB
  PPARCF(JL) =0.0_JPRB
ENDDO

IF(LLDEBUG) THEN
call writefield_phy('sw_zsec',ZSEC,1)
call writefield_phy('sw_zrmu',ZRMU,1)
call writefield_phy('sw_prmu0',PRMU0,1)
call writefield_phy('sw_zfact',ZFACT,1)
ENDIF

icount=icount+1
DO JNU = INUVS , INUIR-1
   !++MODIFCODE
     CALL SW1S &
           &( KIDIA , KFDIA, KLON , KLEV , KAER  , JNU &
           &,  PAER , PALBD , PALBP, PCG  , ZCLD , ZCLEAR &
           &,  ZDSIG, POMEGA, POZ  , ZRMU , ZSEC , PTAU  , ZUD  &
           &,  ZFDUVS,ZFUUVS, ZCDUVS,ZCUUVS, ZSUDU1, ZDIFF,ZDIRF &
           &,  LRDUST,PPIZA_DST(:,:,JNU) &       ! SSA for this wavelength
           &,  PCGA_DST(:,:,JNU)   &            ! GCA for this wavelengt
           &,  PTAUREL_DST(:,:,JNU) )           ! TAUREL for this wavelength
  !--MODIFCODE
IF(LLDEBUG) THEN
! Ecriture des champs avec un indicage du fichier par l'intervalle spectral
  write(str1,'(i1)') jnu
  call writefield_phy("sw_zcduvs"//str1,zcduvs,klev+1)
ENDIF


  DO JL=KIDIA,KFDIA
  PDIFFS(JL,JNU)=ZDIFF(JL,1)*ZFACT(JL)
  PDIRFS(JL,JNU)=ZDIRF(JL,1)*ZFACT(JL)
  ENDDO
  DO JK = 1 , KLEV+1
    DO JL = KIDIA,KFDIA
      ZFD(JL,JK)=ZFD(JL,JK)+ZFDUVS(JL,JK)
      ZFU(JL,JK)=ZFU(JL,JK)+ZFUUVS(JL,JK)
      ZCD(JL,JK)=ZCD(JL,JK)+ZCDUVS(JL,JK)
      ZCU(JL,JK)=ZCU(JL,JK)+ZCUUVS(JL,JK)
    ENDDO
  ENDDO
  DO JL = KIDIA,KFDIA
    ZSUDU1T(JL)=ZSUDU1T(JL)+ZSUDU1(JL)
  ENDDO

  IF (NSW == 6) THEN
    IF (JNU <= 2) THEN
      DO JL = KIDIA,KFDIA
        PUVDF(JL)=PUVDF(JL)+ZFDUVS(JL,1)
      ENDDO
    ELSEIF (JNU == 3) THEN
      DO JL=KIDIA,KFDIA
        PPARF(JL)=PPARF(JL)+ZFDUVS(JL,1)
        PPARCF(JL)=PPARCF(JL)+ZCDUVS(JL,1)
      ENDDO
    ENDIF    
  ENDIF  
ENDDO

!if (icount==5) stop'on arrete dans sw.F90 au bout de 5 appels'
!     ------------------------------------------------------------------

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

DO JK = 1 , KLEV+1
  DO JL = KIDIA,KFDIA
    ZFDOWN(JL,JK)=0.0_JPRB
    ZFUP  (JL,JK)=0.0_JPRB
    ZCDOWN(JL,JK)=0.0_JPRB
    ZCUP  (JL,JK)=0.0_JPRB
    ZSUDU2T(JL)  =0.0_JPRB
  ENDDO
ENDDO

DO JNU = INUIR , NSW
   !++MODIFCODE
      CALL SWNI &
           &(  KIDIA ,KFDIA , KLON , KLEV , KAER , JNU &
           &,  PAER  ,ZAKI  , PALBD, PALBP, PCG  , ZCLD, ZCLEAR &
           &,  ZDSIG ,POMEGA, POZ  , ZRMU , ZSEC , PTAU, ZUD      &
           &,  PWV   ,PQS &
           &,  ZFDNIR,ZFUNIR,ZCDNIR,ZCUNIR,ZSUDU2,ZDIFF2,ZDIRF2 &
           &,  LRDUST,PPIZA_DST(:,:,JNU)  &
           &,  PCGA_DST(:,:,JNU)    &
           &,  PTAUREL_DST(:,:,JNU) &
           &)
    !--MODIFCODE

IF(LLDEBUG) THEN
! Ecriture des champs avec un indicage du fichier par l'intervalle spectral
  write(str1,'(i1)') jnu
  call writefield_phy("sw_zcdnir"//str1,zcdnir,klev+1)
ENDIF

  DO JL=KIDIA,KFDIA
    PDIFFS(JL,JNU)=ZDIFF2(JL,1)*ZFACT(JL)
    PDIRFS(JL,JNU)=ZDIRF2(JL,1)*ZFACT(JL)
  ENDDO
  DO JK = 1 , KLEV+1
    DO JL = KIDIA,KFDIA
      ZFDOWN(JL,JK)=ZFDOWN(JL,JK)+ZFDNIR(JL,JK)
      ZFUP  (JL,JK)=ZFUP  (JL,JK)+ZFUNIR(JL,JK)
      ZCDOWN(JL,JK)=ZCDOWN(JL,JK)+ZCDNIR(JL,JK)
      ZCUP  (JL,JK)=ZCUP  (JL,JK)+ZCUNIR(JL,JK)
    ENDDO
  ENDDO
  DO JL = KIDIA,KFDIA
    ZSUDU2T(JL)=ZSUDU2T(JL)+ZSUDU2(JL)
  ENDDO
ENDDO

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

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

DO JL = KIDIA,KFDIA
  PFDNN(JL)=ZFDOWN(JL,1)*ZFACT(JL)
  PFDNV(JL)=ZFD(JL,1)*ZFACT(JL)
  PFUPN(JL)=ZFUP(JL,KLEV+1)*ZFACT(JL)
  PFUPV(JL)=ZFU(JL,KLEV+1)*ZFACT(JL)

  PCDNN(JL)=ZCDOWN(JL,1)*ZFACT(JL)
  PCDNV(JL)=ZCD(JL,1)*ZFACT(JL)
  PCUPN(JL)=ZCUP(JL,KLEV+1)*ZFACT(JL)
  PCUPV(JL)=ZCU(JL,KLEV+1)*ZFACT(JL)

  PSUDU(JL)=(ZSUDU1T(JL)+ZSUDU2T(JL))*ZFACT(JL)
  PUVDF(JL)=PUVDF(JL)*ZFACT(JL)
  PPARF(JL)=PPARF(JL)*ZFACT(JL)
  PPARCF(JL)=PPARCF(JL)*ZFACT(JL)
ENDDO

!WRITE(*,'("---> Dans SW:")')
!WRITE(*,'("ZFUP  ",10E12.5)') (ZFUP(1,JK),JK=1,KLEV+1)
!WRITE(*,'("ZFU   ",10E12.5)') (ZFU(1,JK),JK=1,KLEV+1)
!WRITE(*,'("ZFUNIR",10E12.5)') (ZFUNIR(1,JK),JK=1,KLEV+1)
!WRITE(*,'("ZFACT ",E12.5)') ZFACT(1)

DO JK = 1 , KLEV+1
  DO JL = KIDIA,KFDIA
    PFUP(JL,JK)   = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)
    PFDOWN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
    PCUP(JL,JK)   = (ZCUP(JL,JK)   + ZCU(JL,JK)) * ZFACT(JL)
    PCDOWN(JL,JK) = (ZCDOWN(JL,JK) + ZCD(JL,JK)) * ZFACT(JL)
  ENDDO
ENDDO
IF(LLDEBUG) THEN
call writefield_phy('sw_pcdown',PCDOWN,KLEV+1)
ENDIF

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

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