!OPTIONS XOPT(HSFUN)
SUBROUTINE RADHEAT &
 & (  KIDIA  , KFDIA  , KLON   , KLEV,&
 & PAPHM1 ,&
 & PEMIS  , PEMTED , PMU0,&
 & PQM1,&
 & PTE    , PTRSOL , PTRSOD , PTSM1M , PTSPHY,&
 & PFRSO  , PFRTH  , PFRSOD , PFRTHD,&
 & PCEMTR , PCTRSO , PFRSOC , PFRTHC,&
 & PSUDU  , PSDUR  , PDSRP &
 & )  

!**** *RADHEAT* - 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.

!          WITH THE METEO-FRANCE PHYSICS, THE CONSTANT EMISSIVITY
!     HYPOTHESIS LEADS TO SPURIOUS OSCILLATIONS IN THE STRATOSPHERE. A
!     CONSTANT THERMAL FLUX APPROACH IS THEREFORE USED UNTIL A NEW
!     SUBROUTINE RISES...

!     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 surf.downward flux
!     Ph. DANDIN Meteo-France        95/04          FMR WITH MF PHYSICS.
!     JJMorcrette 990128 sunshine duration
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     JJMorcrette 20090408 bug-fix to solar zenith angle
!     M. Janiskova     03-Mar-2009 Code re-arrangement for adjoint comp.
!-----------------------------------------------------------------------

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

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)   :: 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)    :: PCEMTR(KLON,2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCTRSO(KLON,2) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRSOC(KLON,2) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRTHC(KLON,2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSUDU(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSDUR(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDSRP(KLON) 

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

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

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

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

REAL(KIND=JPRB) ::&
 & ZDTDT(KLON)   , ZDTDIV(KLON) &
 & ,  ZFLB(KLON) , ZFLT(KLON) , ZFSO(KLON) , ZFTE(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('RADHEAT',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
!!    ZI0(JL)=RRAE/(SQRT(PMU0(JL)**2+ZCONS1)-PMU0(JL)) * ZRII0
    ZI0(JL)=PMU0(JL)*ZRII0
  ELSE
    ZI0(JL)=0.0_JPRB
  ENDIF
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)

  PFRTH(JL,1)=ZFTE(JL)
  PFRSO(JL,1)=ZFSO(JL)

  PFRTHC(JL,1)=PCEMTR(JL,1)
  PFRSOC(JL,1)=ZI0(JL)*PCTRSO(JL,1)
ENDDO

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

!***
DO JK=1,KLEV
!***
  DO JL=KIDIA,KFDIA
    ZFLT(JL)=ZFSO(JL)+ZFTE(JL)

    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)
    ZFLB(JL)=ZFSO(JL)+ZFTE(JL)
    ZDTDIV(JL)=1.0_JPRB/((PAPHM1(JL,JK+1)&
     & -PAPHM1(JL,JK))*(1.0_JPRB+RVTMP2*PQM1(JL,JK))) 
    ZDTDT(JL)=-ZCONS3*(ZFLB(JL)-ZFLT(JL))*ZDTDIV(JL) 
    PTE(JL,JK)=PTE(JL,JK)+ZDTDT(JL)
  ENDDO

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

  DO JL=KIDIA,KFDIA
    PFRTH(JL,JK+1)=ZFTE(JL)
    PFRSO(JL,JK+1)=ZFSO(JL)
  ENDDO
!***
ENDDO
!***

DO JL=KIDIA,KFDIA
  PFRTHC(JL,2)=PCEMTR(JL,2)
  PFRSOC(JL,2)=ZI0(JL)*PCTRSO(JL,2)
ENDDO

!*         4.5     SOLAR AND TERRESTRIAL DOWNWARD FLUXES AT SURFACE

DO JL=KIDIA,KFDIA
  PFRSOD(JL)=ZI0(JL)*PTRSOD(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('RADHEAT',1,ZHOOK_HANDLE)
END SUBROUTINE RADHEAT
