!OPTIONS XOPT(NOEVAL)
SUBROUTINE RADHEAT15 &
 & (  KIDIA  , KFDIA  , KLON   , KLEV , LDZERO,&
 & PAPHM1 ,&
 & PEMIS  , PEMTED , PMU0,&
 & PQM1,&
 & PTE    , PTRSOL , PTRSOD , PTSM1M , PTSPHY,&
 & PFRSO  , PFRTH  , PFRSOD , PFRTHD )  

!**** *RADHEAT15* - COMPUTES TEMPERATURE CHANGES DUE TO RADIATION.
!****               FROZEN VERSION (CYCLE 15) OF RADHEAT

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

!          *RADHEAT15* IS CALLED FROM *APLPAR*.
!          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.
!     -------
!        96-11: Ph. Dandin. Meteo-France
!     J.-J. MORCRETTE  E.C.M.W.F.    90/01/17.      ADAPTATION TO I.F.S.
!     J.-F. GELEYN     E.C.M.W.F.    82/06/03.

!     MODIFICATIONS.
!     --------------
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

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

USE YOMPHY3  , ONLY : RII0
USE YOMCST   , ONLY : RG       ,RSIGMA   ,R        ,RCPD     ,RCPV
USE YOMRDI15 , ONLY : RRAE15

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)               :: KTDIA ! Argument NOT used
LOGICAL           ,INTENT(IN)    :: LDZERO 
REAL(KIND=JPRB)                  :: PALB(KLON) ! Argument NOT used
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM1(KLON,KLEV+1) 
REAL(KIND=JPRB)                  :: PAPM1(KLON,KLEV) ! Argument NOT used
REAL(KIND=JPRB)                  :: PCLC(KLON,KLEV) ! Argument NOT used
REAL(KIND=JPRB)                  :: PDP(KLON,KLEV) ! Argument NOT used
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMTED(KLON,KLEV+1) 
REAL(KIND=JPRB)                  :: PEMTEU(KLON,KLEV+1) ! Argument NOT used
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMU0(KLON) 
REAL(KIND=JPRB)                  :: PQIWP(KLON,KLEV) ! Argument NOT used
REAL(KIND=JPRB)                  :: PQLWP(KLON,KLEV) ! Argument NOT used
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTE(KLON,KLEV) 
REAL(KIND=JPRB)                  :: PTM1(KLON,KLEV) ! Argument NOT used
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) 
!-----------------------------------------------------------------------

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

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

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

REAL(KIND=JPRB) ::&
 & ZDTDT(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, ZVTMP2
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

IF (LHOOK) CALL DR_HOOK('RADHEAT15',0,ZHOOK_HANDLE)
ZTMST=PTSPHY
ZCONS1=RRAE15*(RRAE15+2.0_JPRB)
ZCONS3=RG/RCPD
ILONS=KFDIA-KIDIA+1
ZBUD = 1.0_JPRB
ZRII0=RII0
! RVTMP2 (in yoethf.h) is not used in the frozen version (PhD)
ZVTMP2=RCPV/RCPD-1.0_JPRB

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

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

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

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

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

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

!      DO 312 JK=2,KLEV
!      DO 311 JL=KIDIA,KFDIA
!      ZTH(JL,JK)=(PTM1(JL,JK-1)*PAPM1(JL,JK-1)
!     S        *(PAPM1(JL,JK)-PAPHM1(JL,JK))
!     S        +PTM1(JL,JK)*PAPM1(JL,JK)*(PAPHM1(JL,JK)-PAPM1(JL,JK-1)))
!     S        *(1./(PAPHM1(JL,JK)*(PAPM1(JL,JK)-PAPM1(JL,JK-1))))
! 311  CONTINUE
! 312  CONTINUE

!      DO 313 JL=KIDIA,KFDIA
!      ZTH(JL,KLEV+1)=PTSM1M(JL)
!      ZTH(JL,1)=PTM1(JL,1)-PAPM1(JL,1)*(PTM1(JL,1)-ZTH(JL,2))
!     S          /(PAPM1(JL,1)-PAPHM1(JL,2))
! 313  CONTINUE

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

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

!*         4.1     TOP FLUX.

DO JL=KIDIA,KFDIA
  ZFSO(JL)=ZI0(JL)*PTRSOL(JL,1)
!      IF (LRAYFM.OR.LRAYFM15) THEN
  ZFTE(JL)=PEMTED(JL,1)
!      ELSE
!         ZFTE(JL)=RSIGMA*ZTH(JL,1)**4*PEMTED(JL,1)
!      ENDIF
  ZFLT(JL)=ZFSO(JL)+ZFTE(JL)
  PFRTH(JL,1)=ZFTE(JL)
  PFRSO(JL,1)=ZFSO(JL)
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)
!      IF (LRAYFM.OR.LRAYFM15) THEN
    ZFTE(JL)=PEMTED(JL,JK+1)
!      ELSE
!         ZFTE(JL)=RSIGMA*ZTH(JL,JK+1)**4*PEMTED(JL,JK+1)
!      ENDIF
    ZFLB(JL)=ZFSO(JL)+ZFTE(JL)
    IF(.NOT.LDZERO) THEN
      ZDTDT(JL)=-ZCONS3*(ZFLB(JL)-ZFLT(JL))/((PAPHM1(JL,JK+1)&
       & -PAPHM1(JL,JK))*(1.0_JPRB+ZVTMP2*PQM1(JL,JK)))  
      PTE(JL,JK)=PTE(JL,JK)+ZDTDT(JL)
    ENDIF
  ENDDO

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

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

!*         4.5     SOLAR AND TERRESTRIAL DOWNWARD FLUXES AT SURFACE

DO JL=KIDIA,KFDIA
  PFRSOD(JL)=ZI0(JL)*PTRSOD(JL)
!      ZTH4(JL)=RSIGMA*ZTH(JL,KLEV+1)**4
!      ZFRTHU(JL)=ZTH4(JL)*(1.+PEMTED(JL,KLEV+1)
!     *                  *(1.-PEMIS(JL))/PEMIS(JL))
!      PFRTHD(JL)=ZFRTHU(JL)+ZTH4(JL)*PEMTED(JL,KLEV+1)
  ZTH4(JL)=RSIGMA*PTSM1M(JL)**4
  PFRTHD(JL)=(PEMTED(JL,KLEV+1)+PEMIS(JL)*ZTH4(JL))/PEMIS(JL)
ENDDO

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

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