!OPTIONS XOPT(NOEVAL)
SUBROUTINE RFMR (KST, KEND, KPROMA, KTDIA , KLEV,&
 & KMODE , KFLUX , KRAD,&
 & PALBD , PALBP , PAPRS , PAPRSF , PCCO2 , PCLFR,&
 & PQO3  , PAER  , PDP   , PEMIS  , PMU0,&
 & PQ    , PQS   , PQIWP , PQLWP , PSLM   , PT    , PTS,&
 & PEMTD , PEMTU , PTRSO,&
 & PTH   , PCTRSO, PCEMTR, PTRSOD,&
 & PLWFC, PLWFT, PSWFC, PSWFT)  

!**** *RFMR* - RADIATION INTERFACE TO ACTUAL RADIATION SCHEME
!****          FROZEN VERSION (CYCLE 15) OF RADINT

!     PURPOSE.
!     --------
!           CONTROLS THE SPACE INTERPOLATION FOR RADIATION FIELDS

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

!     EXPLICIT ARGUMENTS :
!        --------------------
! KST    : START INDEX OF DATA IN KPROMA-LONG VECTOR
! KEND   : END   INDEX OF DATA IN KPROMA-LONG VECTOR
! KPROMA : VECTOR LENGTH
! KTDIA  : INDEX OF TOP LEVEL FROM WHICH COMPUTATIONS ARE ACTIVE
! KLEV   : NUMBER OF LEVELS
! PAER   : (KPROMA,KLEV ,6)     ; OPTICAL THICKNESS OF THE AEROSOLS
! PALBD  : (KPROMA,2)           ; DIFFUSE ALBEDO IN THE 2 SW INTERVALS
! PALBP  : (KPROMA,2)           ; PARALLEL ALBEDO IN THE 2 SW INTERVALS
! PAPRS  : (KPROMA,KLEV+1)      ; HALF LEVEL PRESSURE
! PAPRSF : (KPROMA,KLEV )       ; FULL LEVEL PRESSURE
! PCCO2  :                      ; CONCENTRATION IN CO2 (PA/PA)
! PCLFR  : (KPROMA,KLEV )       ; CLOUD FRACTIONAL COVER
! PQO3   : (KPROMA,KLEV )       ; OZONE MIXING RATIO (MASS)
! PDP    : (KPROMA,KLEV)        ; LAYER PRESSURE THICKNESS
! PEMIS  : (KPROMA)             ; SURFACE EMISSIVITY
! PMU0   : (KPROMA)             ; SOLAR ANGLE
! PQ     : (KPROMA,KLEV )       ; SPECIFIC HUMIDITY PA/PA
! PQS    : (KPROMA,KLEV )       ; SATURATION SPECIFIC HUMIDITY PA/PA
! PQIWP  : (KPROMA,KLEV )       ; ICE    WATER KG/KG
! PQLWP  : (KPROMA,KLEV )       ; LIQUID WATER KG/KG
! PSLM   : (KPROMA)             ; LAND-SEA MASK
! PT     : (KPROMA,KLEV)        ; FULL LEVEL TEMPERATURE
! PTS    : (KPROMA)             ; SURFACE TEMPERATURE

!     ==== OUTPUTS ===
! PEMTD (KPROMA,KLEV+1)         ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
! PEMTU (KPROMA,KLEV+1)         ; TOTAL UPWARD   LONGWAVE EMISSIVITY
! PTRSO (KPROMA,KLEV+1)         ; TOTAL SHORTWAVE TRANSMISSIVITY
! PTH   (KPROMA,KLEV+1)         ; HALF LEVEL TEMPERATURE
! PCTRSO(KPROMA,2)              ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY
! PCEMTR(KPROMA,2)              ; CLEAR-SKY NET LONGWAVE EMISSIVITY
! PTRSOD(KPROMA)                ; TOTAL-SKY SURFACE SW TRANSMISSITY
! PLWFC (KPROMA,2)              ; CLEAR-SKY LONGWAVE FLUXES
! PLWFT (KPROMA,KLEV+1)         ; TOTAL-SKY LONGWAVE FLUXES
! PSWFC (KPROMA,2)              ; CLEAR-SKY SHORTWAVE FLUXES
! PSWFT (KPROMA,KLEV+1)         ; TOTAL-SKY SHORTWAVE FLUXES

!        IMPLICIT ARGUMENTS :   NONE
!        --------------------

!     METHOD.
!     -------
!     SEE DOCUMENTATION

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

!     REFERENCE.
!     ----------
!     ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS

!     AUTHORS.
!     --------
!     ORIGINAL BY  B. RITTER   *ECMWF*        83-10-13
!     REWRITING FOR IFS BY J.-J. MORCRETTE    94-11-15
!     96-11: Ph. Dandin. Meteo-France
!     REWRITING FOR DM  BY J.PH. PIEDELIEVRE   1998-07
!     12-2005 : GMGEC/EAC Hu Rong Ming - Adding sulfate aerosols

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

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

USE YOMAERD15, ONLY : RCAEROS15
USE YOMCST   , ONLY :         RMD      ,RMO3
USE YOMPHY3  , ONLY : RII0
USE YOMRAD15 , ONLY : NAER15 
USE YOMRDU15 , ONLY : REPSCQ15
USE YOMRDI15 , ONLY : RRAE15   ,REPCLC15 

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

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KST 
INTEGER(KIND=JPIM),INTENT(IN)    :: KEND 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTDIA
INTEGER(KIND=JPIM),INTENT(IN)    :: KMODE 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLUX
INTEGER(KIND=JPIM),INTENT(IN)    :: KRAD
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KPROMA,2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KPROMA,2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRS(KPROMA,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF(KPROMA,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLFR(KPROMA,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQO3(KPROMA,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KPROMA,KLEV,6) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDP(KPROMA,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMU0(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KPROMA,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS(KPROMA,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQIWP(KPROMA,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQLWP(KPROMA,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLM(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KPROMA,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMTD(KPROMA,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMTU(KPROMA,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRSO(KPROMA,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTH(KPROMA,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCTRSO(KPROMA,2) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCEMTR(KPROMA,2) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRSOD(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLWFC(KPROMA,2) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLWFT(KPROMA,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSWFC(KPROMA,2) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSWFT(KPROMA,KLEV+1) 
!     ==== COMPUTED IN RADITE ===
!     ------------------------------------------------------------------
!*       0.2   LOCAL ARRAYS.
!              -------------
REAL(KIND=JPRB) :: ZRAER  (KPROMA,KLEV,6)
REAL(KIND=JPRB) :: ZRALD  (KPROMA,2)
REAL(KIND=JPRB) :: ZRALP  (KPROMA,2)
REAL(KIND=JPRB) :: ZRALTE (KPROMA)
REAL(KIND=JPRB) :: ZRCLC  (KPROMA,KLEV)
REAL(KIND=JPRB) :: ZRDP   (KPROMA,KLEV)
REAL(KIND=JPRB) :: ZRFRTH (KPROMA,KLEV+1)
REAL(KIND=JPRB) :: ZRFRSO (KPROMA,KLEV+1)
REAL(KIND=JPRB) :: ZRFRSOD(KPROMA)
REAL(KIND=JPRB) :: ZRHPR  (KPROMA,KLEV+1)
REAL(KIND=JPRB) :: ZRHTI  (KPROMA,KLEV+1)
REAL(KIND=JPRB) :: ZRIWA  (KPROMA,KLEV)
REAL(KIND=JPRB) :: ZRLWA  (KPROMA,KLEV)
REAL(KIND=JPRB) :: ZRLWFC (KPROMA,KLEV+1)
REAL(KIND=JPRB) :: ZRMU0  (KPROMA)
REAL(KIND=JPRB) :: ZROZ   (KPROMA,KLEV)
REAL(KIND=JPRB) :: ZRPR   (KPROMA,KLEV)
REAL(KIND=JPRB) :: ZRQS   (KPROMA,KLEV)
REAL(KIND=JPRB) :: ZRSLM  (KPROMA)
REAL(KIND=JPRB) :: ZRSWFC (KPROMA,KLEV+1)
REAL(KIND=JPRB) :: ZRTS   (KPROMA)
REAL(KIND=JPRB) :: ZRTI   (KPROMA,KLEV)
REAL(KIND=JPRB) :: ZRWV   (KPROMA,KLEV)

REAL(KIND=JPRB) :: ZPQO3 (KPROMA,KLEV)

REAL(KIND=JPRB) :: ZQS   (KPROMA,KLEV)
REAL(KIND=JPRB) :: ZQWV  (KPROMA,KLEV)
REAL(KIND=JPRB) :: ZQLWP (KPROMA,KLEV)
REAL(KIND=JPRB) :: ZQIWP (KPROMA,KLEV)
REAL(KIND=JPRB) :: ZTRSO (KPROMA,KLEV+1)
REAL(KIND=JPRB) :: ZEMTD (KPROMA,KLEV+1)
REAL(KIND=JPRB) :: ZEMTU (KPROMA,KLEV+1)
REAL(KIND=JPRB) :: ZTRSOC(KPROMA,2)
REAL(KIND=JPRB) :: ZEMTC (KPROMA,2)
REAL(KIND=JPRB) :: ZTRSOD(KPROMA)

INTEGER(KIND=JPIM) :: IBEG, IEND, JK, JL

REAL(KIND=JPRB) :: ZCRAE, ZRII0
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "radlsw15.intfb.h"

IF (LHOOK) CALL DR_HOOK('RFMR',0,ZHOOK_HANDLE)
IBEG=KST
IEND=KEND

!*       1.    PREPARATORY WORK
!              ----------------

!*       1.1    LOCAL CONSTANTS
!                ---------------

ZRII0=RII0
ZCRAE=RRAE15*(RRAE15+2.0_JPRB)

!*       2.1    FULL-LEVEL QUANTITIES

ZRPR =PAPRSF
ZRTI =PT
ZQWV =PQ
ZQS  =PQS
ZQLWP=0.0_JPRB
ZQIWP=0.0_JPRB

DO JK=1,KLEV
  DO JL=IBEG,IEND
    ZRCLC(JL,JK)=MIN(MAX(PCLFR(JL,JK),REPCLC15),1.0_JPRB-REPCLC15)
! PQO3 (kg/kg) -> ZPQO3 (ppm Pa/Pa)
    ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)*RMD/RMO3
  ENDDO
ENDDO
DO JK=1,KLEV
  DO JL=IBEG,IEND
    IF (ZRCLC(JL,JK) > REPCLC15) THEN
      ZQLWP(JL,JK)=PQLWP(JL,JK)/ZRCLC(JL,JK)
      ZQIWP(JL,JK)=PQIWP(JL,JK)/ZRCLC(JL,JK)
    ENDIF
  ENDDO
ENDDO

IF (NAER15 == 0) THEN
  ZRAER=RCAEROS15
ELSE
  DO JK=1,KLEV
    DO JL=IBEG,IEND
      ZRAER(JL,JK,1)=PAER(JL,JK,1)
      ZRAER(JL,JK,2)=PAER(JL,JK,2)
      ZRAER(JL,JK,3)=PAER(JL,JK,3)
      ZRAER(JL,JK,5)=PAER(JL,JK,5)
      ZRAER(JL,JK,6)=PAER(JL,JK,6)
    ENDDO
  ENDDO
  ZRAER(:,:,4)=RCAEROS15
ENDIF

!*       2.2    HALF-LEVEL QUANTITIES

DO JK=2,KLEV
  DO JL=IBEG,IEND
    PTH(JL,JK)=&
     & (PT(JL,JK-1)*PAPRSF(JL,JK-1)*(PAPRSF(JL,JK)-PAPRS(JL,JK))&
     & +PT(JL,JK)*PAPRSF(JL,JK)*(PAPRS(JL,JK)-PAPRSF(JL,JK-1)))&
     & *(1.0_JPRB/(PAPRS(JL,JK)*(PAPRSF(JL,JK)-PAPRSF(JL,JK-1))))  
  ENDDO
ENDDO

!*       2.3     QUANTITIES AT BOUNDARIES

DO JL=IBEG,IEND
  PTH(JL,KLEV+1)=PTS(JL)
  PTH(JL,1)=PT(JL,1)-PAPRSF(JL,1)*(PT(JL,1)-PTH(JL,2))&
   & /(PAPRSF(JL,1)-PAPRS(JL,2))  
ENDDO

ZRHTI=PTH
ZRTS=PTS
ZRSLM=PSLM
ZRALD=PALBD
ZRALP=PALBP
ZRALTE=PEMIS

!*       3.1     SOLAR ZENITH ANGLE IS EARTH'S CURVATURE
!                CORRECTED

DO JL=IBEG,IEND
  ZRMU0(JL)=RRAE15/(SQRT(PMU0(JL)**2+ZCRAE)-PMU0(JL))
ENDDO

ZRHPR=PAPRS

DO JK=1,KLEV
  DO JL=IBEG,IEND
    ZRQS (JL,JK)=MAX(REPSCQ15,ZQS(JL,JK))
    ZRWV (JL,JK)=MAX(REPSCQ15,ZQWV(JL,JK))
    ZRLWA(JL,JK)=ZQLWP(JL,JK)*ZRCLC(JL,JK)
    ZRIWA(JL,JK)=ZQIWP(JL,JK)*ZRCLC(JL,JK)
  ENDDO
ENDDO

DO JK=1,KLEV
  DO JL=IBEG,IEND
    ZRDP(JL,JK)=ZRHPR(JL,JK+1)-ZRHPR(JL,JK)
  ENDDO
ENDDO

ZROZ=ZPQO3

!*         4.1     CALL TO ACTUAL RADIATION SCHEME

CALL RADLSW15 &
 & ( IBEG  , IEND   , KPROMA  , KTDIA , KLEV,&
 & KMODE , KFLUX  , KRAD    , NAER15,&
 & ZRII0,&
 & ZRAER , ZRALD  , ZRALP   , ZRHPR , ZRPR  , PCCO2,&
 & ZRCLC , ZRDP   , ZRALTE  , ZRSLM , ZRMU0 , ZROZ , ZRWV,&
 & ZRIWA , ZRLWA  , ZRQS    , ZRHTI , ZRTI  , ZRTS,&
 ! FLUX OUTPUTS
 ! ------------
 & ZRLWFC, ZRFRTH , ZRSWFC  , ZRFRSO, ZRFRSOD )   

!*         4.2     TRANSFORM FLUXES TO MODEL HISTORICAL VARIABLES

DO JK=1,KLEV+1
  DO JL=IBEG,IEND
    ZTRSO(JL,JK)=ZRFRSO(JL,JK)/(ZRII0*ZRMU0(JL))
  ENDDO
ENDDO

ZEMTD=ZRFRTH
ZEMTU=ZRFRTH

DO JL=IBEG,IEND
  ZTRSOD(JL)=ZRFRSOD(JL)/(ZRII0*ZRMU0(JL))
ENDDO
IF (KMODE /= 0) THEN
  DO JL=IBEG,IEND
    ZTRSOC(JL, 1)=ZRSWFC(JL,     1)/(ZRII0*ZRMU0(JL))
    ZTRSOC(JL, 2)=ZRSWFC(JL,KLEV+1)/(ZRII0*ZRMU0(JL))
    ZEMTC (JL, 1)=ZRLWFC(JL,     1)
    ZEMTC (JL, 2)=ZRLWFC(JL,KLEV+1)
  ENDDO
ELSE
  DO JL=IBEG,IEND
    ZTRSOC(JL, 1)=ZTRSO (JL,     1)
    ZTRSOC(JL, 2)=ZTRSO (JL,KLEV+1)
    ZEMTC (JL, 1)=ZRFRTH(JL,     1)
    ZEMTC (JL, 2)=ZRFRTH(JL,KLEV+1)
  ENDDO
ENDIF

!                 ------------ -- ------- -- ---- -----
!*         5.1    STORAGE OF TRANSMISSIVITY AND EMISSIVITIES
!*                IN KPROMA-LONG ARRAYS

DO JK=1,KLEV+1
  DO JL=IBEG,IEND
    PEMTD(JL,JK)=ZEMTD(JL,JK)
    PEMTU(JL,JK)=ZEMTU(JL,JK)
    PTRSO(JL,JK)=MAX(0.0_JPRB,MIN(1.0_JPRB,ZTRSO(JL,JK)))
  ENDDO
ENDDO
DO JK=1,2
  DO JL=IBEG,IEND
    PCEMTR(JL,JK)=ZEMTC (JL,JK)
    PCTRSO(JL,JK)=MAX( 0.0_JPRB,MIN(1.0_JPRB,ZTRSOC(JL,JK)))
  ENDDO
ENDDO
DO JL=IBEG,IEND
  PTRSOD(JL)=MAX(0.0_JPRB,MIN(1.0_JPRB,ZTRSOD(JL)))
ENDDO

!*         7.3   RECONSTRUCT FLUXES FOR DIAGNOSTICS

DO JL=IBEG,IEND
  IF (PMU0(JL) < 1.E-10_JPRB) ZRMU0(JL)=0.0_JPRB
ENDDO
DO JK=1,KLEV+1
  DO JL=IBEG,IEND
    PLWFT(JL,JK)=PEMTD(JL,JK)
    PSWFT(JL,JK)=ZRMU0(JL)*ZRII0*PTRSO(JL,JK)
  ENDDO
ENDDO
DO JK=1,2
  DO JL=IBEG,IEND
    PSWFC(JL,JK)=ZRMU0(JL)*ZRII0*PCTRSO(JL,JK)
    PLWFC(JL,JK)=PCEMTR(JL,JK)
  ENDDO
ENDDO

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