!OPTIONS XOPT(HSFUN)
SUBROUTINE RADHEATN &
 & (  KIDIA  , KFDIA  , KLON   , KLEV,&
 & PAPHM1 ,&
 & PEMIS  , PEMTED , PMU0,&
 & PQM1,&
 & PTE    , PTRSOL , PTRSOD , PTSM1M ,PTSPHY,&
 & PHRSW  , PHRLW  , PHRSC  , PHRLC,&
 & PFRSO  , PFRTH  , PFRSOD , PFRTHD,&
 & PEMTEC , PTRSOC , PFRSOC , PFRTHC , PINCSR,&
 & PSUDU  , PSDUR  , PDSRP,&
 & PUVDFI , PPARFI , PPARCFI, PTINCFI, PFDIRI, PCDIRI,& 
 & PUVDF  , PPARF  , PPARCF , PTINCF , PFDIR , PCDIR  &
 & )  

!**** *RADHEATN* - COMPUTES TEMPERATURE CHANGES DUE TO RADIATION.

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

!          THIS ROUTINE COMPUTES THE TENDENCIES OF THE ATMOSPHERE'S
!     TEMPERATURE DUE TO THE EFFECTS OF LONG WAVE AND SHORT WAVE
!     RADIATION. THE COMPUTATION IS DONE ON THE T-1 TIME LEVEL USING
!     VALUES OF ATMOSPHERIC TRANSMISIVITIES AND EMISSIVITIES THAT HAVE
!     BEEN STORED AT THE LAST FULL RADIATION TIME STEP. THE SURFACE
!     SOLAR FLUX LATER TO BE USED IN THE SOIL PROCESS CALCULATIONS IS
!     ALSO STORED.

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

!          *RADHEAT* IS CALLED FROM *CALLPAR*.
!          THE ROUTINE TAKES ITS INPUT FROM THE LONG-TERM STORAGE: TS,
!     T AND Q AT T-1 AND P ON LEVEL BOUNDARIES AND IN THE MIDDLE OF THE
!     LAYERS AT THE SAME TIME. ALSO USED ARE THE FOUR PARAMERTERS
!     DESCRIBING THE SUN'S POSITION. THE ROUTINE RETURNS ITS OUTPUT TO
!     THE LONG TERM STORAGE: TENDENCIES OF T AND SURFACE SOLAR FLUX.

!     METHOD.
!     -------

!          A CALL TO SUBROUTINE *SOLANG* GIVES FIELDS OF SOLAR ZENITH
!     ANGLES AND RELATIVE DAY LENGTH FROM WHICH AN EFFECTIVE SOLAR
!     INFLUX IS COMPUTED. THE RESULTS ARE OF COURSE DIFFERENT DEPENDING
!     ON THE SWITCH ON OR OFF OF THE DIURNAL CYCLE. PRODUCT OF SOLAR
!     INFLUX BY TRANSMISSIVITIES LEADS TO SOLAR FLUXES. THEN THE
!     TEMPERATURES ARE INTERPOLATED/EXTRAPOLATED TO THE LAYER BOUNDARIES
!     (AT THE BOTTOM ONE TAKES THE SURFACE TEMPERATURE) AND A PRODUCT BY
!     EMISSIVITIES OF SIGMA*T**4 GIVES THERMAL FLUXES. THE TWO FLUXES
!     ARE ADDED AND DIVERGENCES COMPUTED TO GIVE HEATING RATES.

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

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

!          SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION FOR DETAILS
!     ABOUT THE MATHEMATICS OF THIS ROUTINE.

!     AUTHOR.
!     -------
!     J.-F. GELEYN     E.C.M.W.F.    82/06/03.

!     MODIFICATIONS.
!     --------------
!     J.-J. MORCRETTE  E.C.M.W.F.    90/01/17.      ADAPTATION TO I.F.S.
!     J.-J. MORCRETTE  E.C.M.W.F. 95/04/18.   output downward surf. flux
!     JJMorcrette 990128 sunshine duration
!     JJMorcrette      ECMWF      990714      clear-sky heating rates
!     JJMorcrette      ECMWF      02-09-01    UV & PAR
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     JJMorcrette      20060721   PP clear-sky PAR and TOA incident solar radiation
!     JJMorcrette      20090408   bug-fix to solar zenith angle
!     JJMorcrette      20091201   Total and clear-sky direct SW radiation flux at surface 
!-----------------------------------------------------------------------

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

USE YOMPHY3  , ONLY : RII0
USE YOMCST   , ONLY : RG       ,RSIGMA   ,RCPD
USE YOETHF   , ONLY : RVTMP2
USE YOERDI   , ONLY : RRAE     ,RSUNDUR
USE YOMDYNCORE, ONLY  : LAQUA

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 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM1(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMTED(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMU0(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTRSOL(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTRSOD(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSM1M(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSPHY 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PHRSW(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PHRLW(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PHRSC(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PHRLC(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRSO(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRTH(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRSOD(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRTHD(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMTEC(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTRSOC(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRSOC(KLON,2) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRTHC(KLON,2) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PINCSR(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSUDU(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSDUR(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDSRP(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUVDFI(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPARFI(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPARCFI(KLON), PTINCFI(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUVDF(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PPARF(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PPARCF(KLON), PTINCF(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFDIRI(KLON), PCDIRI(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFDIR (KLON), PCDIR (KLON) 

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

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

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

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

REAL(KIND=JPRB) ::&
 & ZDTDT(KLON)&
 & ,  ZFLB(KLON) , ZFLT(KLON) , ZFSO(KLON) , ZFTE(KLON)&
 & ,  ZFSWT(KLON), ZFSWB(KLON), ZFLWT(KLON), ZFLWB(KLON)&
 & ,  ZFSWTC(KLON),ZFSWBC(KLON),ZFLWTC(KLON),ZFLWBC(KLON)&
 & ,  ZI0(KLON)  , ZTH4(KLON)  

INTEGER(KIND=JPIM) :: ILONS, JK, JL

REAL(KIND=JPRB) :: ZBUD, ZCONS1, ZCONS3, ZRII0, ZTMST
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

!*    COMPUTATIONAL CONSTANTS.
!     ------------- ----------

IF (LHOOK) CALL DR_HOOK('RADHEATN',0,ZHOOK_HANDLE)
ZTMST=PTSPHY
ZCONS1=RRAE*(RRAE+2.0_JPRB)
ZCONS3=RG/RCPD
ILONS=KFDIA-KIDIA+1
ZBUD = 1.0_JPRB
ZRII0=RII0

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

!*         1.     SECURITIES.
!                 -----------

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

!*         2.     INCIDENT SOLAR RADIATION
!                 ------------------------

DO JL=KIDIA,KFDIA
  IF (PMU0(JL) >= 1.E-10_JPRB) THEN
    IF( LAQUA ) THEN
      ZI0(JL)=ZRII0*PMU0(JL)
    ELSE
!!      ZI0(JL)=RRAE/(SQRT(PMU0(JL)**2+ZCONS1)-PMU0(JL)) * ZRII0
      ZI0(JL)=ZRII0*PMU0(JL)
    ENDIF
  ELSE
    ZI0(JL)=0.0_JPRB
  ENDIF
  PINCSR(JL)=ZI0(JL)
ENDDO

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

!*         3.     TEMPERATURES AT LAYERS' BOUNDARIES.
!                 -----------------------------------

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

!*         4.     FLUXES AND THEIR DIVERGENCES.
!                 ------ --- ----- ------------

!*         4.1     TOP FLUX.

DO JL=KIDIA,KFDIA
  ZFSO(JL)=ZI0(JL)*PTRSOL(JL,1)
  ZFTE(JL)=PEMTED(JL,1)
  ZFSWT(JL)=ZFSO(JL)
  ZFLWT(JL)=ZFTE(JL)
  ZFLT(JL)=ZFSO(JL)+ZFTE(JL)
  PFRTH(JL,1)=ZFTE(JL)
  PFRSO(JL,1)=ZFSO(JL)

!-- clear-sky quantities           
  ZFSWTC(JL)=ZI0(JL)*PTRSOC(JL,1)
  ZFLWTC(JL)=PEMTEC(JL,1)
  PFRSOC(JL,1)=ZI0(JL)*PTRSOC(JL,1)
  PFRTHC(JL,1)=PEMTEC(JL,1)
ENDDO

!*         4.2     VERTICAL LOOP, BOTTOM FLUX AND HEATING RATE.

!***
DO JK=1,KLEV
!***
  DO JL=KIDIA,KFDIA
    ZFSO(JL)=ZI0(JL)*PTRSOL(JL,JK+1)
! Set surface solar flux to minimum value for stability in vertical diffusion
    IF (JK == KLEV .AND. ZFSO(JL) < 1.E-15_JPRB) THEN
      ZFSO(JL)=1.E-15_JPRB
    ENDIF
    ZFTE(JL)=PEMTED(JL,JK+1)
    ZFSWB(JL)=ZFSO(JL)
    ZFLWB(JL)=ZFTE(JL)
    ZFLB(JL)=ZFSO(JL)+ZFTE(JL)
    ZDTDT(JL)=-ZCONS3*(ZFLB(JL)-ZFLT(JL))/((PAPHM1(JL,JK+1)&
     & -PAPHM1(JL,JK))*(1.0_JPRB+RVTMP2*PQM1(JL,JK)))  
    PTE(JL,JK)=PTE(JL,JK)+ZDTDT(JL)
    PHRSW(JL,JK)=-ZCONS3*(ZFSWB(JL)-ZFSWT(JL))/((PAPHM1(JL,JK+1)&
     & -PAPHM1(JL,JK))*(1.0_JPRB+RVTMP2*PQM1(JL,JK)))  
    PHRLW(JL,JK)=-ZCONS3*(ZFLWB(JL)-ZFLWT(JL))/((PAPHM1(JL,JK+1)&
     & -PAPHM1(JL,JK))*(1.0_JPRB+RVTMP2*PQM1(JL,JK)))  

!-- clear-sky quantities           
    ZFSWBC(JL)=ZI0(JL)*PTRSOC(JL,JK+1)
    ZFLWBC(JL)=PEMTEC(JL,JK+1)
    PHRSC(JL,JK)=-ZCONS3*(ZFSWBC(JL)-ZFSWTC(JL))&
     & /((PAPHM1(JL,JK+1)-PAPHM1(JL,JK))*(1.0_JPRB+RVTMP2*PQM1(JL,JK)))  
    PHRLC(JL,JK)=-ZCONS3*(ZFLWBC(JL)-ZFLWTC(JL))&
     & /((PAPHM1(JL,JK+1)-PAPHM1(JL,JK))*(1.0_JPRB+RVTMP2*PQM1(JL,JK)))  
  ENDDO

!*         4.4     FLUX SWAP, END OF THE LOOP AND SURFACE SOLAR FLUX.

  DO JL=KIDIA,KFDIA
    ZFLT(JL)=ZFLB(JL)
    ZFSWT(JL)=ZFSWB(JL)
    ZFLWT(JL)=ZFLWB(JL)
    PFRTH(JL,JK+1)=ZFTE(JL)
    PFRSO(JL,JK+1)=ZFSO(JL)
!-- clear-sky quantities           
    ZFSWTC(JL)=ZFSWBC(JL)
    ZFLWTC(JL)=ZFLWBC(JL)
  ENDDO
!***
ENDDO
!***

DO JL=KIDIA,KFDIA
  PFRSOC(JL,2)=ZI0(JL)*PTRSOC(JL,KLEV+1)
  PFRTHC(JL,2)=PEMTEC(JL,KLEV+1)
ENDDO

!*         4.5     SOLAR AND TERRESTRIAL DOWNWARD FLUXES AT SURFACE

DO JL=KIDIA,KFDIA
  PFRSOD(JL)=ZI0(JL)*PTRSOD(JL)
  PUVDF (JL)=ZI0(JL)*PUVDFI(JL)
  PPARF (JL)=ZI0(JL)*PPARFI(JL)
  PPARCF(JL)=ZI0(JL)*PPARCFI(JL)
  PTINCF(JL)=ZI0(JL)*PTINCFI(JL)
  PFDIR (JL)=ZI0(JL)*PFDIRI(JL)
  PCDIR (JL)=ZI0(JL)*PCDIRI(JL)

  PDSRP(JL)=ZI0(JL)*PSUDU(JL)
  IF (PDSRP(JL) >= RSUNDUR) THEN
    PSDUR(JL)=1.0_JPRB
  ELSE
    PSDUR(JL)=0.0_JPRB
  ENDIF

  ZTH4(JL)=RSIGMA*PTSM1M(JL)**4
  PFRTHD(JL)=(PEMTED(JL,KLEV+1)+PEMIS(JL)*ZTH4(JL))/PEMIS(JL)
ENDDO

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

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