!OPTIONS XOPT(HSFUN)
SUBROUTINE RADHEATTL &
 & (  KIDIA   , KFDIA   , KLON    , KLEV,&
 & PAPHM15 , PAPM15,&
 & PEMIS   , PEMTED5 , PMU0,&
 & PQM15,&
 & PTE5    , PTM15   , PTRSOL5 , PTRSOD5 , PTSM1M5,&
 & PCLFR5  , PQLWP5  , PQIWP5  ,&
 & PFRSO5  , PFRTH5  , PFRSOD5 , PFRTHD5,&
 & PAPHM1  , PAPM1,&
 & PEMTED,&
 & PQM1,&
 & PTE     , PTM1    , PTRSOL  , PTRSOD , PTSM1M,&
 & PFRSO   , PFRTH   , PFRSOD  , PFRTHD )  

!**** *RADHEATTL* - COMPUTES TEMPERATURE CHANGES DUE TO RADIATION.
!                   (Tangent linear)

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

!          *RADHEATTL* IS CALLED FROM *CALLPARTL*.
!          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.

!     PARAMETER     DESCRIPTION                                   UNITS
!     ---------     -----------                                   -----

!     INPUT PARAMETERS (INTEGER):

!    *KIDIA*        START POINT
!    *KFDIA*        END POINT
!    *KLON*         NUMBER OF GRID POINTS PER PACKET
!    *KLEV*         NUMBER OF LEVELS

!     INPUT PARAMETERS (LOGICAL):

!     INPUT PARAMETERS (REAL):

!    *PQM15*        SPECIFIC HUMIDITY AT T-1                  (Trajectory)
!    *PTM15*        TEMPERATURE AT T-1                        (Trajectory)
!    *PAPHM15*      PRESSURE AT HALF LEVELS                   (Trajectory) 
!    *PAPM15*       PRESSURE AT FULL LEVELS                   (Trajectory)
!    *PEMIS*        SURFACE EMISSIVITY                        (Trajectory)
!    *PEMTED5*      ATMOSPHERIC EMISSIVITY                    (Trajectory)
!    *PQM1*         SPECIFIC HUMIDITY AT T-1                     KG/KG
!    *PTM1*         TEMPERATURE AT T-1                            K
!    *PAPHM1*       PRESSURE AT HALF LEVELS                       PA
!    *PAPM1*        PRESSURE AT FULL LEVELS                       PA

!     UPDATED PARAMETERS (REAL):

!    *PTE5*         TEMPERATURE TENDENCY                      (Trajectory)
!    *PTE *         TEMPERATURE TENDENCY                         K/S

!     OUTPUT PARAMETERS (REAL):

!    *PFRTH5*       LONGWAVE RADIATION FLUX                   (Trajectory)
!    *PFRTHD5*      DOWNWARD LONGWAVE RADIATION FLUX AT THE SURFACE 
!                                                             (Trajectory) 
!    *PFRTH*        LONGWAVE RADIATION FLUX                         W/M**2
!    *PFRTHD*       DOWNWARD LONGWAVE RADIATION FLUX AT THE SURFACE W/M**2

!     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. MAHFOUF    E.C.M.W.F.    96/11/19

!     adapted from

!     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.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     JJMorcrette      20090408   bug-fix to solar zenith angle
!     M. Janiskova     03-Mar-2009 changed regularization in upper levels
!-----------------------------------------------------------------------

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
USE YOEPHLI  , ONLY : RLPP00
USE YOPHNC   , ONLY : LERADN2

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)    :: PAPHM15(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMTED5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMU0(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTE5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTRSOL5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTRSOD5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSM1M5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLFR5(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQLWP5(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQIWP5(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRSO5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRTH5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRSOD5(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRTHD5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM1(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMTED(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTM1(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(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) 

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

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

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

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

REAL(KIND=JPRB) :: ZDTDT(KLON), ZDTDIV(KLON) &
 & ,  ZFLB(KLON) , ZFLT(KLON) , ZFSO(KLON) , ZFTE(KLON)&
 & ,  ZI0(KLON)  ,  ZTH(KLON,KLEV+1)&
 & ,  ZTH4(KLON)  

REAL(KIND=JPRB) :: ZDTDT5(KLON) , ZDTDIV5(KLON) &
 & ,  ZFLB5(KLON) , ZFLT5(KLON) , ZFSO5(KLON) , ZFTE5(KLON)&
 & ,  ZTH5(KLON,KLEV+1)&
 & ,  ZTH45(KLON)
REAL(KIND=JPRB) :: ZFLBR5(KLON) , ZFLTR5(KLON)
REAL(KIND=JPRB) :: ZCOND5(KLON,KLEV)

INTEGER(KIND=JPIM) :: JK, JL
INTEGER(KIND=JPIM) :: ILEV(KLON)
LOGICAL :: LLCOND(KLON,KLEV)

REAL(KIND=JPRB) :: Z1S, Z1S5, Z2S, Z2S5, Z3S, Z3S5, ZCONS1, ZCONS3, ZRII0
REAL(KIND=JPRB) :: ZSTRAT, ZSTRATLW, ZSTRATSW
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

IF (LHOOK) CALL DR_HOOK('RADHEATTL',0,ZHOOK_HANDLE)
ZCONS1=RRAE*(RRAE+2.0_JPRB)
ZCONS3=RG/RCPD
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)=ZRII0*PMU0(JL)
  ELSE
    ZI0(JL)=0.0_JPRB
  ENDIF
ENDDO
!     ------------------------------------------------------------------

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

IF (.NOT.LERADN2) THEN
  DO JK=2,KLEV
    DO JL=KIDIA,KFDIA
      Z1S  = PAPM1 (JL,JK-1)*(PAPM15(JL,JK)-PAPHM15(JL,JK)) +&
       & PAPM15(JL,JK-1)*(PAPM1 (JL,JK)-PAPHM1 (JL,JK))  
      Z1S5 = PAPM15(JL,JK-1)*(PAPM15(JL,JK)-PAPHM15(JL,JK))
      Z2S  = PAPM1 (JL,JK)*(PAPHM15(JL,JK)-PAPM15(JL,JK-1)) +&
       & PAPM15(JL,JK)*(PAPHM1 (JL,JK)-PAPM1 (JL,JK-1))  
      Z2S5 = PAPM15(JL,JK)*(PAPHM15(JL,JK)-PAPM15(JL,JK-1))
      Z3S  = PAPHM1 (JL,JK)*(PAPM15(JL,JK)-PAPM15(JL,JK-1)) +&
       & PAPHM15(JL,JK)*(PAPM1 (JL,JK)-PAPM1 (JL,JK-1))  
      Z3S5 = PAPHM15(JL,JK)*(PAPM15(JL,JK)-PAPM15(JL,JK-1))
      ZTH (JL,JK)=(PTM1 (JL,JK-1)*Z1S5+PTM1 (JL,JK)*Z2S5 +&
       & PTM15(JL,JK-1)*Z1S +PTM15(JL,JK)*Z2S )/Z3S5 -&
       & (PTM15(JL,JK-1)*Z1S5+PTM15(JL,JK)*Z2S5)*Z3S /&
       & Z3S5**2  
      ZTH5(JL,JK)=(PTM15(JL,JK-1)*Z1S5+PTM15(JL,JK)*Z2S5)/Z3S5
    ENDDO
  ENDDO

  DO JL=KIDIA,KFDIA
    ZTH (JL,KLEV+1)=PTSM1M (JL)
    ZTH5(JL,KLEV+1)=PTSM1M5(JL)
    ZTH (JL,1)=PTM1(JL,1)-PAPM1 (JL,1)*(PTM15(JL,1)-ZTH5(JL,2))/&
     & (PAPM15(JL,1)-PAPHM15(JL,2)) -&
     & PAPM15(JL,1)*(PTM1 (JL,1)-ZTH (JL,2))/&
     & (PAPM15(JL,1)-PAPHM15(JL,2)) +&
     & PAPM15(JL,1)*(PTM15(JL,1)-ZTH5(JL,2))*&
     & (PAPM1 (JL,1)-PAPHM1 (JL,2))/&
     & (PAPM15(JL,1)-PAPHM15(JL,2))**2  
    ZTH5(JL,1)=PTM15(JL,1)-PAPM15(JL,1)*(PTM15(JL,1)-ZTH5(JL,2))&
     & /(PAPM15(JL,1)-PAPHM15(JL,2))  
  ENDDO
ENDIF

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

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

!*         4.1     TOP FLUX.

DO JL=KIDIA,KFDIA
  ZFSO (JL)=ZI0(JL)*PTRSOL (JL,1)
  ZFSO5(JL)=ZI0(JL)*PTRSOL5(JL,1)
  IF (LERADN2) THEN
    ZFTE (JL)=   PEMTED (JL,1)
  ELSE
    ZFTE (JL)=4._JPRB*PEMTED5(JL,1)*ZTH(JL,1)/ZTH5(JL,1)
  ENDIF
  ZFTE5(JL)=   PEMTED5(JL,1)

  PFRTH (JL,1)=ZFTE (JL)
  PFRTH5(JL,1)=ZFTE5(JL)
  PFRSO (JL,1)=ZFSO (JL)
  PFRSO5(JL,1)=ZFSO5(JL)
ENDDO

!* Computation of the cloud top level
DO JL = KIDIA,KFDIA
  ILEV(JL)=KLEV
ENDDO
DO JK = 1 , KLEV
  DO JL = KIDIA,KFDIA
    ZCOND5(JL,JK) = PQLWP5(JL,JK)+PQIWP5(JL,JK)
    IF (PCLFR5(JL,JK)>=1.E-04_JPRB &
     & .AND. ZCOND5(JL,JK)>=0.5E-08_JPRB) THEN
      ILEV(JL) = MIN(ILEV(JL),JK)
    ENDIF
  ENDDO
ENDDO
!* Condition when regularization is applied
DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    LLCOND(JL,JK) = PAPM15(JL,JK) <= 40000.0_JPRB &
     & .AND. (JK<=(ILEV(JL)+20).AND.JK>ILEV(JL))
  ENDDO
ENDDO

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

!***
DO JK=1,KLEV
!***
  DO JL=KIDIA,KFDIA
    ZSTRAT=1.0_JPRB/(1.0_JPRB+(RLPP00/PAPM15(JL,JK))**10)
    IF (.NOT. LERADN2) THEN
      ZSTRATLW = ZSTRAT
      ZSTRATSW = ZSTRAT
    ELSE
      IF (LLCOND(JL,JK)) THEN
        ZSTRATLW = ZSTRAT
      ELSE
        ZSTRATLW = 1.0_JPRB
      ENDIF
      IF (LLCOND(JL,JK) .AND. PAPM15(JL,JK)>15000.0_JPRB) THEN
        ZSTRATSW = ZSTRAT
      ELSEIF (PAPM15(JL,JK)<=15000.0_JPRB) THEN
        ZSTRATSW = ZSTRAT
      ELSE
        ZSTRATSW = 1.0_JPRB
      ENDIF
    ENDIF

    ZFLT  (JL) = ZSTRATSW*ZFSO (JL)+ZSTRATLW*ZFTE (JL) ! for regularization
    ZFLTR5(JL) = ZSTRATSW*ZFSO5(JL)+ZSTRATLW*ZFTE5(JL) ! for regularization
    ZFLT5 (JL) = ZFSO5(JL)+ZFTE5(JL)

    ZFSO (JL)=ZI0(JL)*PTRSOL (JL,JK+1)
    ZFSO5(JL)=ZI0(JL)*PTRSOL5(JL,JK+1)
! Set surface solar flux to minimum value for stability in vertical diffusion
    IF (JK == KLEV .AND. ZFSO5(JL) < 1.E-15_JPRB) THEN
      ZFSO (JL)=0.0_JPRB
      ZFSO5(JL)=1.E-15_JPRB
    ENDIF
    IF (LERADN2) THEN
      ZFTE (JL)=   PEMTED(JL,JK+1)
    ELSE
      ZFTE (JL)=4._JPRB*PEMTED5(JL,JK+1)*ZTH(JL,JK+1)/ZTH5(JL,JK+1)
    ENDIF
    ZFTE5(JL)=   PEMTED5(JL,JK+1)
    ZFLB  (JL) = ZSTRATSW*ZFSO (JL)+ZSTRATLW*ZFTE (JL)
    ZFLBR5(JL) = ZSTRATSW*ZFSO5(JL)+ZSTRATLW*ZFTE5(JL)
    ZFLB5 (JL) = ZFSO5(JL)+ZFTE5(JL)

    ZDTDIV5(JL)=1.0_JPRB/((PAPHM15(JL,JK+1)&
     & -PAPHM15(JL,JK))*(1.0_JPRB+RVTMP2*PQM15(JL,JK)))    
    ZDTDIV (JL)=-(PAPHM1 (JL,JK+1)-PAPHM1 (JL,JK)) &
     & *(1.0_JPRB+RVTMP2*PQM15(JL,JK))*ZDTDIV5(JL)**2 &
     & -(PAPHM15(JL,JK+1)-PAPHM15(JL,JK))*RVTMP2*PQM1(JL,JK)*ZDTDIV5(JL)**2

! regularized ZDTDT (using ZFLTR5, ZFLBR5)
    ZDTDT (JL)=-ZCONS3*(ZFLBR5(JL)-ZFLTR5(JL))*ZDTDIV(JL) &
     &         -ZCONS3*(ZFLB  (JL)-ZFLT  (JL))*ZDTDIV5(JL)
    ZDTDT5(JL)=-ZCONS3*(ZFLB5(JL)-ZFLT5(JL))*ZDTDIV5(JL)

    PTE (JL,JK)=PTE (JL,JK)+ZDTDT (JL)
    PTE5(JL,JK)=PTE5(JL,JK)+ZDTDT5(JL)
  ENDDO

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

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

!*         4.5     SOLAR AND TERRESTRIAL DOWNWARD FLUXES AT SURFACE

DO JL=KIDIA,KFDIA
  PFRSOD (JL)=ZI0(JL)*PTRSOD (JL)
  PFRSOD5(JL)=ZI0(JL)*PTRSOD5(JL)
  ZTH4 (JL)=4._JPRB*RSIGMA*PTSM1M5(JL)**3*PTSM1M(JL)
  ZTH45(JL)=   RSIGMA*PTSM1M5(JL)**4
  IF (LERADN2) THEN
    PFRTHD (JL)=(PEMTED(JL,KLEV+1)+PEMIS(JL)*ZTH4(JL))/PEMIS(JL)
  ELSE
    PFRTHD (JL)=                             ZTH4 (JL)
  ENDIF
  PFRTHD5(JL)=(PEMTED5(JL,KLEV+1)+PEMIS(JL)*ZTH45(JL))/PEMIS(JL)
ENDDO

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

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