Head

GCC Code Coverage Report
Directory:	./		Exec	Total	Coverage
File:	phylmd/rrtm/radlsw.F90	Lines:	226	467	48.4 %
Date:	2023-06-30 12:51:15	Branches:	122	330	37.0 %

SUBROUTINE RADLSW &
 & ( KIDIA, KFDIA , KLON , KLEV  , KMODE, KAER,&
 & PRII0,&
 & PAER , PALBD , PALBP, PAPH , PAP,&
 & PCCNL, PCCNO,&
 & PCCO2, PCLFR , PDP  , PEMIS, PEMIW , PLSM , PMU0, POZON,&
 & PQ   , PQIWP , PQLWP, PQS  , PQRAIN, PRAINT,&
 & PTH  , PT    , PTS  , PNBAS, PNTOP,&
 & PREF_LIQ, PREF_ICE,&
 & PEMIT, PFCT  , PFLT , PFCS , PFLS,&
 & PFRSOD,PSUDU , PUVDF, PPARF, PPARCF, PTINCF,&
 & PSFSWDIR, PSFSWDIF,PFSDNN,PFSDNV ,&
 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST,&
 & PTAU_LW,&
 & PFLUX,PFLUC,PFSDN ,PFSUP , PFSCDN , PFSCUP)

use write_field_phy

!**** *RADLSW* - INTERFACE TO ECMWF LW AND SW RADIATION SCHEMES

!     PURPOSE.
!     --------
!           CONTROLS RADIATION COMPUTATIONS

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

!        EXPLICIT ARGUMENTS :
!        --------------------
! PAER   : (KLON,6,KLEV)     ; OPTICAL THICKNESS OF THE AEROSOLS
! PALBD  : (KLON,NSW)        ; SURF. SW ALBEDO FOR DIFFUSE RADIATION
! PALBP  : (KLON,NSW)        ; SURF. SW ALBEDO FOR PARALLEL RADIATION
! PAPH   : (KLON,KLEV+1)     ; HALF LEVEL PRESSURE
! PAP    : (KLON,KLEV)       ; FULL LEVEL PRESSURE
! PCCNL  : (KLON)            ; CCN CONCENTRATION OVER LAND
! PCCNO  : (KLON)            ; CCN CONCENTRATION OVER OCEAN
! PCCO2  :                   ; CONCENTRATION IN CO2 (KG/KG)
! PCLFR  : (KLON,KLEV)       ; CLOUD FRACTIONAL COVER
! PDP    : (KLON,KLEV)       ; LAYER PRESSURE THICKNESS
! PEMIS  : (KLON)            ; SURFACE LW EMISSIVITY
! PEMIW  : (KLON)            ; SURFACE LW WINDOW EMISSIVITY
! PLSM   : (KLON)            ; LAND-SEA MASK
! PMU0   : (KLON)            ; SOLAR ANGLE
! PNBAS  : (KLON)            ; INDEX OF BASE OF CONVECTIVE LAYER
! PNTOP  : (KLON)            ; INDEX OF TOP OF CONVECTIVE LAYER
! POZON  : (KLON,KLEV)       ; OZONE AMOUNT in LAYER (KG/KG*PA)
! PQ     : (KLON,KLEV)       ; SPECIFIC HUMIDITY KG/KG
! PQIWP  : (KLON,KLEV)       ; SOLID  WATER KG/KG
! PQLWP  : (KLON,KLEV)       ; LIQUID WATER KG/KG
! PQS    : (KLON,KLEV)       ; SATURATION WATER VAPOR  KG/KG
! PQRAIN : (KLON,KLEV)       ; RAIN WATER KG/KG
! PRAINT : (KLON,KLEV)       ; RAIN RATE (m/s)
! PTH    : (KLON,KLEV+1)     ; HALF LEVEL TEMPERATURE
! PT     : (KLON,KLEV)       ; FULL LEVEL TEMPERATURE
! PTS    : (KLON)            ; SURFACE TEMPERATURE
! LDDUST                     ; Dust properties switch
! PPIZA_DST  : (KPROMA,KLEV,NSW); Single scattering albedo of dust
! PCGA_DST   : (KPROMA,KLEV,NSW); Assymetry factor for dust
! PTAUREL_DST: (KPROMA,KLEV,NSW); Optical depth of dust relative to at 550nm
! PTAU_LW  (KPROMA,KLEV,NLW); LW Optical depth of aerosols
! PREF_LIQ (KPROMA,KLEV)        ; Liquid droplet radius (um)
! PREF_ICE (KPROMA,KLEV)        ; Ice crystal radius (um)
!     ==== OUTPUTS ===
! PFCT   : (KLON,KLEV+1)     ; CLEAR-SKY LW NET FLUXES
! PFLT   : (KLON,KLEV+1)     ; TOTAL LW NET FLUXES
! PFCS   : (KLON,KLEV+1)     ; CLEAR-SKY SW NET FLUXES
! PFLS   : (KLON,KLEV+1)     ; TOTAL SW NET FLUXES
! PFRSOD : (KLON)            ; TOTAL-SKY SURFACE SW DOWNWARD FLUX
! PEMIT  : (KLON)            ; SURFACE TOTAL LONGWAVE EMISSIVITY
! PSUDU  : (KLON)            ; SOLAR RADIANCE IN SUN'S DIRECTION
! PPARF  : (KLON)            ; PHOTOSYNTHETICALLY ACTIVE RADIATION
! PUVDF  : (KLON)            ; UV(-B) RADIATION
! PPARCF : (KLON)            ; CLEAR-SKY PHOTOSYNTHETICALLY ACTIVE RADIATION
! PTINCF : (KLON)            ; TOA INCIDENT SOLAR RADIATION
! Ajout flux LW et SW montants et descendants, et ciel clair (MPL 19.12.08)
! PFLUX  : (KLON,2,KLEV+1)   ; LW total sky flux (1=up, 2=down)
! PFLUC  : (KLON,2,KLEV+1)   ; LW clear sky flux (1=up, 2=down)
! PFSDN(KLON,KLEV+1)         ; SW total sky flux down
! PFSUP(KLON,KLEV+1)         ; SW total sky flux up
! PFSCDN(KLON,KLEV+1)        ; SW clear sky flux down
! PFSCUP(KLON,KLEV+1)        ; SW clear sky flux up



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

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

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

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

!     AUTHORS.
!     --------
!        J.-J. MORCRETTE         *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 88-02-04
!        J.-J. MORCRETTE 94-11-15 DIRECT/DIFFUSE SURFACE ALBEDO
!        08/96: J.-J. Morcrette/Ph. Dandin: tests of eff. radius param.
!        9909 : JJMorcrette effect.radius + inhomogeneity factors
!        JJMorcrette 990128 : sunshine duration
!        JJMorcrette : 990831 RRTM-140gp
!        JJMorcrette : 010112 Sun-Rikus ice particle Diameter
!        JJMorcrette : 010301 cleaning liq/ice cloud optical properties
!        JJMorcrette : 011005 CCN --> Re liquid water clouds
!        JJMorcrette : 011108 Safety checks
!        JJMorcrette : 011108 Safety checks
!        DJSalmond   : 020211 Check before R-To-R
!        JJMorcrette : 020901 PAR & UV
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        JJMorcrette : 050402 New sets of optical properties (NB: inactive)
!        Y.Seity       04-11-18 : add 4 arguments for AROME externalized surface
!        Y.Seity       05-10-10 : add 3 optional arg. for dust SW properties
!        JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation
!-----------------------------------------------------------------------

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

USE YOMCST   , ONLY : RG       ,RD       ,RTT      ,RPI
!USE YOERAD   , ONLY : NSW      ,LRRTM    ,LCCNL    ,LCCNO, LDIFFC, &
! NSW mis dans .def MPL 20140211
USE YOERAD   , ONLY : NLW, LRRTM    ,LCCNL    ,LCCNO, LDIFFC, &
 & NRADIP , NRADLP , NICEOPT, NLIQOPT, NINHOM ,NLAYINH ,&
 & RCCNLND, RCCNSEA, RLWINHF, RSWINHF, RRe2De ,&
 & LEDBUG
USE YOELW    , ONLY : NSIL     ,NTRA     ,NUA      ,TSTAND   ,XP
USE YOESW    , ONLY : RYFWCA   ,RYFWCB   ,RYFWCC   ,RYFWCD   ,&
 & RYFWCE   ,RYFWCF   ,REBCUA   ,REBCUB   ,REBCUC   ,&
 & REBCUD   ,REBCUE   ,REBCUF   ,REBCUI   ,REBCUJ   ,&
 & REBCUG   ,REBCUH   ,RHSAVI   ,RFULIO   ,RFLAA0   ,&
 & RFLAA1   ,RFLBB0   ,RFLBB1   ,RFLBB2   ,RFLBB3   ,&
 & RFLCC0   ,RFLCC1   ,RFLCC2   ,RFLCC3   ,RFLDD0   ,&
 & RFLDD1   ,RFLDD2   ,RFLDD3   ,RFUETA   ,RFUETB   ,RFUETC  ,RASWCA   ,&
 & RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF   ,&
 & RFUAA0   ,RFUAA1   ,RFUBB0   ,RFUBB1   ,RFUBB2   ,&
 & RFUBB3   ,RFUCC0   ,RFUCC1   ,RFUCC2   ,RFUCC3   ,&
 & RLILIA   ,RLILIB
USE YOERDU        , ONLY : NUAER    ,NTRAER   ,REPLOG   ,REPSC    ,REPSCW   ,DIFF
!USE YOETHF        , ONLY : RTICE
USE YOEPHLI       , ONLY : LPHYLIN
USE YOERRTWN      , ONLY :                     DELWAVE   ,TOTPLNK

USE YOMLUN_IFSAUX , ONLY : NULOUT
USE YOMCT3        , ONLY : NSTEP

IMPLICIT NONE

include "clesphys.h"
!!include "clesrrtm.h"
include "YOETHF.h"
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),INTENT(IN)    :: KMODE
INTEGER(KIND=JPIM),INTENT(IN)    :: KAER
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRII0
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KLON,NSW)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KLON,NSW)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCNL(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCNO(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLFR(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDP(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIW(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSM(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMU0(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: POZON(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQIWP(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQLWP(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS(KLON,KLEV)
REAL(KIND=JPRB)                  :: PQRAIN(KLON,KLEV) ! Argument NOT used
REAL(KIND=JPRB)                  :: PRAINT(KLON,KLEV) ! Argument NOT used
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTH(KLON,KLEV+1)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PNBAS(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PNTOP(KLON)
LOGICAL           ,INTENT(IN)    :: LRDUST
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZA_DST(KLON,KLEV,NSW)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGA_DST(KLON,KLEV,NSW)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUREL_DST(KLON,KLEV,NSW)
!--C.Kleinschmitt
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU_LW(KLON,KLEV,NLW)
!--end
REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_LIQ(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_ICE(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMIT(KLON)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFCT(KLON,KLEV+1)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLT(KLON,KLEV+1)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFCS(KLON,KLEV+1)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLS(KLON,KLEV+1)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRSOD(KLON)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSUDU(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(OUT)   :: PSFSWDIR(KLON,NSW)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSFSWDIF(KLON,NSW)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDNN(KLON)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDNV(KLON)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUX(KLON,2,KLEV+1) ! LW total sky flux (1=up, 2=down)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC(KLON,2,KLEV+1) ! LW clear sky flux (1=up, 2=down)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDN(KLON,KLEV+1)   ! SW total sky flux down
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUP(KLON,KLEV+1)   ! SW total sky flux up
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCDN(KLON,KLEV+1)  ! SW clear sky flux down
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCUP(KLON,KLEV+1)  ! SW clear sky flux up


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

!*       0.1   ARGUMENTS.
!              ----------
!     ==== COMPUTED IN RADLSW ===
!     -----------------------------------------------------------------

!*       0.2   LOCAL ARRAYS.
!              -------------
!     -----------------------------------------------------------------

!-- ARRAYS FOR LOCAL VARIABLES -----------------------------------------

INTEGER(KIND=JPIM) :: IBAS(KLON)     , ITOP(KLON)

REAL(KIND=JPRB) ::&
 & ZALBD(KLON,NSW)    , ZALBP(KLON,NSW)&
 & , ZCG(KLON,NSW,KLEV) , ZOMEGA(KLON,NSW,KLEV)&
 & , ZTAU (KLON,NSW,KLEV) &
 & , ZTAUCLD(KLON,KLEV,16), ZTCLEAR(KLON)
REAL(KIND=JPRB) ::&
 & ZCLDLD(KLON,KLEV)  , ZCLDLU(KLON,KLEV)&
 & , ZCLDSW(KLON,KLEV)  , ZCLD0(KLON,KLEV)&
 & , ZDT0(KLON)        &
 & , ZEMIS(KLON)        , ZEMIW(KLON)&
 & , ZFIWP(KLON)        , ZFLWP(KLON)      , ZFRWP(KLON)&
 & , ZIWC(KLON)         , ZLWC(KLON)&
 !cc            , ZRWC(KLON)
 & , ZMU0(KLON)         , ZOZ(KLON,KLEV)   , ZOZN(KLON,KLEV)&
 & , ZPMB(KLON,KLEV+1)  , ZPSOL(KLON)&
 & , ZTAVE (KLON,KLEV)  , ZTL(KLON,KLEV+1)&
 & , ZVIEW(KLON)
REAL(KIND=JPRB) ::&
 & ZFCDWN(KLON,KLEV+1), ZFCUP(KLON,KLEV+1)&
 & , ZFSDWN(KLON,KLEV+1), ZFSUP(KLON,KLEV+1)&
 & , ZFSUPN(KLON)       , ZFSUPV(KLON)&
 & , ZFCUPN(KLON)       , ZFCUPV(KLON)&
 & , ZFSDNN(KLON)       , ZFSDNV(KLON)&
 & , ZFCDNN(KLON)       , ZFCDNV(KLON)&
 & , ZDIRFS(KLON,NSW)   , ZDIFFS(KLON,NSW)
REAL(KIND=JPRB) ::&
 & ZALFICE(KLON)      , ZGAMICE(KLON)     , ZBICE(KLON)   , ZDESR(KLON)&
 & , ZRADIP(KLON)       , ZRADLP(KLON)     &
 !cc           , ZRADRD(KLON)
 & , ZRAINT(KLON)       , ZRES(KLON)&
 & , ZTICE(KLON)        , ZEMIT(KLON),  ZBICFU(KLON)&
 & , ZKICFU(KLON)
REAL(KIND=JPRB) :: ZSUDU(KLON)   , ZPARF(KLON)       , ZUVDF(KLON), ZPARCF(KLON)
INTEGER(KIND=JPIM) :: IKL, JK, JKL, JKLP1, JKP1, JL, JNU, JRTM, JSW, INDLAY

REAL(KIND=JPRB) :: ZASYMX, ZDIFFD, ZGI, ZGL, ZGR, ZIWGKG, ZLWGKG,&
 & ZMSAID, ZMSAIU, ZMSALD, ZMSALU, ZRSAIA, ZRSAID, ZRSAIE, ZRSAIF, ZRSAIG, ZRSALD, &
 & ZMULTI, ZMULTL, ZOI   , ZOL, &
 & ZOMGMX, ZOR, ZRMUZ, ZRWGKG, ZTAUD, ZTAUMX, ZTEMPC, &
 & ZTOI, ZTOL, ZTOR, ZZFIWP, ZZFLWP, ZDPOG, ZPODT

REAL(KIND=JPRB) :: ZALND, ZASEA, ZD, ZDEN, ZNTOT, ZNUM, ZRATIO, Z1RADI, &
 & Z1RADL, ZBETAI, ZOMGI, ZOMGP, ZFDEL, ZTCELS, ZFSR, ZAIWC, &
 & ZBIWC, ZTBLAY, ZADDPLK, ZPLANCK, ZEXTCF, Z1MOMG, &
 & ZDefRe, ZRefDe, ZVI , ZMABSD

!REAL(KIND=JPRB) :: ZAVDP(KLON), ZAVTO(KLON), ZSQTO(KLON)
REAL(KIND=JPRB) :: ZAVTO(KLON), ZSQTO(KLON)
REAL(KIND=JPRB) :: ZSQUAR(KLON,KLEV), ZVARIA(KLON,KLEV)
INTEGER(KIND=JPIM) :: IKI, JKI, JEXPLR, JXPLDN
LOGICAL         :: LLDEBUG


REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "lw.intfb.h"
#include "rrtm_rrtm_140gp.intfb.h"
#include "sw.intfb.h"

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

!*         1.     SET-UP INPUT QUANTITIES FOR RADIATION
!                 -------------------------------------

IF (LHOOK) CALL DR_HOOK('RADLSW',0,ZHOOK_HANDLE)

LLDEBUG=.FALSE.
ZRefDe = RRe2De
ZDefRe = 1.0_JPRB / ZRefDe

DO JL = KIDIA,KFDIA
  ZFCUP(JL,KLEV+1) = 0.0_JPRB
  ZFCDWN(JL,KLEV+1) = REPLOG
  ZFSUP(JL,KLEV+1) = 0.0_JPRB
  ZFSDWN(JL,KLEV+1) = REPLOG
  PFLUX(JL,1,KLEV+1) = 0.0_JPRB
  PFLUX(JL,2,KLEV+1) = 0.0_JPRB
  PFLUC(JL,1,KLEV+1) = 0.0_JPRB
  PFLUC(JL,2,KLEV+1) = 0.0_JPRB
  ZFSDNN(JL) = 0.0_JPRB
  ZFSDNV(JL) = 0.0_JPRB
  ZFCDNN(JL) = 0.0_JPRB
  ZFCDNV(JL) = 0.0_JPRB
  ZFSUPN(JL) = 0.0_JPRB
  ZFSUPV(JL) = 0.0_JPRB
  ZFCUPN(JL) = 0.0_JPRB
  ZFCUPV(JL) = 0.0_JPRB
  ZPSOL(JL) = PAPH(JL,KLEV+1)
  ZPMB(JL,1) = ZPSOL(JL) / 100.0_JPRB
  ZDT0(JL) = PTS(JL) - PTH(JL,KLEV+1)
  PSUDU(JL) = 0.0_JPRB
  PPARF(JL) = 0.0_JPRB
  PPARCF(JL)= 0.0_JPRB
  PUVDF(JL) = 0.0_JPRB
  PSFSWDIR(JL,:)=0.0_JPRB
  PSFSWDIF(JL,:)=0.0_JPRB
  IBAS(JL) = INT ( 0.01_JPRB + PNBAS(JL) )
  ITOP(JL) = INT ( 0.01_JPRB + PNTOP(JL) )
ENDDO

!*         1.1    INITIALIZE VARIOUS FIELDS
!                 -------------------------

DO JSW=1,NSW
  DO JL = KIDIA,KFDIA
    ZALBD(JL,JSW)=PALBD(JL,JSW)
    ZALBP(JL,JSW)=PALBP(JL,JSW)
  ENDDO
ENDDO
DO JL = KIDIA,KFDIA
  ZEMIS(JL)  =PEMIS(JL)
  ZEMIW(JL)  =PEMIW(JL)
  ZMU0(JL)   =PMU0(JL)
ENDDO

DO JK = 1 , KLEV
  JKP1 = JK + 1
  JKL = KLEV+ 1 - JK
  JKLP1 = JKL + 1
  DO JL = KIDIA,KFDIA
    ZPMB(JL,JK+1)=PAPH(JL,JKL)/100.0_JPRB

!-- ZOZ in cm.atm for SW scheme
    ZOZ(JL,JK)   = POZON(JL,JKL) * 46.6968_JPRB / RG

    ZCLD0(JL,JK) = 0.0_JPRB
    ZFCUP(JL,JK) = 0.0_JPRB
    ZFCDWN(JL,JK) = 0.0_JPRB
    ZFSUP(JL,JK) = 0.0_JPRB
    ZFSDWN(JL,JK) = 0.0_JPRB
    PFLUX(JL,1,JK) = 0.0_JPRB
    PFLUX(JL,2,JK) = 0.0_JPRB
    PFLUC(JL,1,JK) = 0.0_JPRB
    PFLUC(JL,2,JK) = 0.0_JPRB
  ENDDO
ENDDO

DO JK=1,KLEV
  JKL=KLEV+1-JK
  JKLP1=JKL+1
  DO JL=KIDIA,KFDIA
    ZTL(JL,JK)=PTH(JL,JKLP1)
    ZTAVE(JL,JK)=PT(JL,JKL)
  ENDDO
ENDDO
DO JL=KIDIA,KFDIA
  ZTL(JL,KLEV+1)= PTH(JL,1)
  ZPMB(JL,KLEV+1) = PAPH(JL,1)/100.0_JPRB
ENDDO
!***

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

!*         2.     CLOUD AND AEROSOL PARAMETERS
!                 ----------------------------

DO JK = 1 , KLEV
  IKL = KLEV + 1 - JK

!          2.1    INITIALIZE OPTICAL PROPERTIES TO CLEAR SKY VALUES
!                 -------------------------------------------------

  DO JSW = 1,NSW
    DO JL = KIDIA,KFDIA
      ZTAU(JL,JSW,JK)  = 0.0_JPRB
      ZOMEGA(JL,JSW,JK)= 1.0_JPRB
      ZCG(JL,JSW,JK)   = 0.0_JPRB
    ENDDO
  ENDDO
  DO JL = KIDIA,KFDIA
    ZCLDSW(JL,JK)  = 0.0_JPRB
    ZCLDLD(JL,JK)  = 0.0_JPRB
    ZCLDLU(JL,JK)  = 0.0_JPRB
  ENDDO

!          2.2    CLOUD ICE AND LIQUID CONTENT AND PATH
!                 -------------------------------------

  DO JL = KIDIA,KFDIA

! --- LIQUID WATER CONTENT (g.m-3) AND LIQUID WATER PATH (g.m-2)
    IF (PCLFR(JL,IKL) > REPSC ) THEN
      ZLWGKG=MAX(PQLWP(JL,IKL)*1000.0_JPRB,0.0_JPRB)
      ZIWGKG=MAX(PQIWP(JL,IKL)*1000.0_JPRB,0.0_JPRB)
      ZLWGKG=ZLWGKG/PCLFR(JL,IKL)
      ZIWGKG=ZIWGKG/PCLFR(JL,IKL)
    ELSE
      ZLWGKG=0.0_JPRB
      ZIWGKG=0.0_JPRB
    ENDIF
    ZRWGKG=0.0_JPRB
    ZRAINT(JL)=0.0_JPRB

! --- RAIN LIQUID WATER CONTENT (g.m-3) AND LIQUID WATER PATH (g.m-2)
!    IF (PRAINT(JL,IKL) >= REPSCW) THEN
!      ZRWGKG=MAX(PQRAIN(JL,IKL)*1000., 0.0)
!      ZRAINT(JL)=PRAINT(JL,IKL)*3600.*1000.
!- no radiative effect of rain (for the moment)
!      ZRWGKG=0.
!      ZRAINT(JL)=0.
! ===========================================================

! Modifications Martin et al.
!    ELSE
!    ENDIF
    ZDPOG=PDP(JL,IKL)/RG
    ZFLWP(JL)= ZLWGKG*ZDPOG
    ZFIWP(JL)= ZIWGKG*ZDPOG
    ZFRWP(JL)= ZRWGKG*ZDPOG
    ZPODT=PAP(JL,IKL)/(RD*PT(JL,IKL))
    ZLWC(JL)=ZLWGKG*ZPODT
    ZIWC(JL)=ZIWGKG*ZPODT
!    ZRWC(JL)=ZRWGKG*ZPODT

  ENDDO
  DO JL = KIDIA,KFDIA
! --- EFFECTIVE RADIUS FOR WATER, ICE AND RAIN PARTICLES

! very old parametrization as f(pressure)

    IF (NRADLP == 0) THEN
!-- very old parametrization as f(pressure) ERA-15
      ZRADLP(JL)=10.0_JPRB + (100000.0_JPRB-PAP(JL,IKL))*3.5_JPRB

    ELSEIF (NRADLP == 1) THEN
! simple distinction between land (10) and ocean (13) Zhang and Rossow
      IF (PLSM(JL) < 0.5_JPRB) THEN
        ZRADLP(JL)=13.0_JPRB
      ELSE
        ZRADLP(JL)=10.0_JPRB
      ENDIF

    ELSEIF (NRADLP == 2) THEN
!--  based on Martin et al., 1994, JAS
      IF (PLSM(JL) < 0.5_JPRB) THEN
        IF (LCCNO) THEN
!          ZASEA=50.0_JPRB
          ZASEA=PCCNO(JL)
        ELSE
          ZASEA=RCCNSEA
        ENDIF
        ZD=0.33_JPRB
        ZNTOT=-1.15E-03_JPRB*ZASEA*ZASEA+0.963_JPRB*ZASEA+5.30_JPRB
      ELSE
        IF (LCCNL) THEN
!          ZALND=900.0_JPRB
          ZALND=PCCNL(JL)
        ELSE
          ZALND=RCCNLND
        ENDIF
        ZD=0.43_JPRB
        ZNTOT=-2.10E-04_JPRB*ZALND*ZALND+0.568_JPRB*ZALND-27.9_JPRB
      ENDIF
      ZNUM=3.0_JPRB*ZLWC(JL)*(1.0_JPRB+3.0_JPRB*ZD*ZD)**2
      ZDEN=4.0_JPRB*RPI*ZNTOT*(1.0_JPRB+ZD*ZD)**3
      IF((ZNUM/ZDEN) > REPLOG)THEN
        ZRADLP(JL)=100.0_JPRB*EXP(0.333_JPRB*LOG(ZNUM/ZDEN))
        ZRADLP(JL)=MAX(ZRADLP(JL), 4.0_JPRB)
        ZRADLP(JL)=MIN(ZRADLP(JL),16.0_JPRB)
      ELSE
        ZRADLP(JL)=4.0_JPRB
      ENDIF

    ELSEIF (NRADLP == 3) THEN
! one uses the cloud droplet radius from newmicro
! IKL or JK ?? - I think IKL but needs to be verified > ref_liq_i
! (inverted) is used in the call of RECMWF_AERO in radlwsw_m.F90,
! so everything is fine - JBM 6/2019
        ZRADLP(JL)=PREF_LIQ(JL,IKL)
    ENDIF

! ===========================================================
! ___________________________________________________________

! rain drop from          : unused as ZRAINT is 0.
!    ZRADRD(JL)=500.0_JPRB*ZRAINT(JL)**0.22_JPRB
!    IF (ZFLWP(JL).GT.0.) THEN
!      ZRADRD(JL)=ZRADLP(JL)+ZRADRD(JL)
!    ENDIF

  ENDDO
  DO JL = KIDIA,KFDIA

! diagnosing the ice particle effective radius/diameter

!- ice particle effective radius =f(T) from Liou and Ou (1994)

    IF (PT(JL,IKL) < RTICE) THEN
      ZTEMPC=PT(JL,IKL)-RTT
    ELSE
      ZTEMPC=RTICE-RTT
    ENDIF
    ZRADIP(JL)=326.3_JPRB+ZTEMPC*(12.42_JPRB + ZTEMPC*(0.197_JPRB + ZTEMPC*&
      & 0.0012_JPRB))

    IF (NRADIP == 0) THEN
!-- fixed 40 micron effective radius
      ZRADIP(JL)= 40.0_JPRB
      ZDESR(JL) = ZDefRe * ZRADIP(JL)

    ELSEIF (NRADIP == 1) THEN

!-- old formulation based on Liou & Ou (1994) temperature (40-130microns)
      ZRADIP(JL)=MAX(ZRADIP(JL),40.0_JPRB)
      ZDESR(JL) = ZDefRe * ZRADIP(JL)

    ELSEIF (NRADIP == 2) THEN
!-- formulation following Jakob, Klein modifications to ice content
      ZRADIP(JL)=MAX(ZRADIP(JL),30.0_JPRB)
      ZRADIP(JL)=MIN(ZRADIP(JL),60.0_JPRB)
      ZDESR(JL)= ZDefRe * ZRADIP(JL)

    ELSEIF (NRADIP == 3  ) THEN

!- ice particle effective radius =f(T,IWC) from Sun and Rikus (1999)
! revised by Sun (2001)
      IF (ZIWC(JL) > 0.0_JPRB ) THEN
        ZTEMPC = PT(JL,IKL)-83.15_JPRB
        ZTCELS = PT(JL,IKL)-RTT
        ZFSR = 1.2351_JPRB +0.0105_JPRB * ZTCELS
! Sun, 2001 (corrected from Sun & Rikus, 1999)
        ZAIWC = 45.8966_JPRB * ZIWC(JL)**0.2214_JPRB
        ZBIWC = 0.7957_JPRB * ZIWC(JL)**0.2535_JPRB
        ZDESR(JL) = ZFSR * (ZAIWC + ZBIWC*ZTEMPC)
!-new        ZDESR(JL) = MIN ( MAX( ZDESR(JL), 30.0_JPRB), 155.0_JPRB)
        ZDESR(JL) = MIN ( MAX( ZDESR(JL), 45.0_JPRB), 350.0_JPRB)
        ZRADIP(JL)= ZRefDe * ZDESR(JL)
      ELSE
!        ZDESR(JL) = 92.5_JPRB
        ZDESR(JL) = 80.0_JPRB
        ZRADIP(JL)= ZRefDe * ZDESR(JL)
      ENDIF

    ELSEIF (NRADIP == 4  ) THEN
! one uses the cloud droplet radius from newmicro
! IKL or JK ?? - I think IKL but needs to be verified
        ZRADIP(JL)=PREF_ICE(JL,IKL)
    ENDIF

  ENDDO

!          2.3    CLOUD SHORTWAVE OPTICAL PROPERTIES
!                 ----------------------------------

!   -------------------------
! --+ SW OPTICAL PARAMETERS +  Water clouds after Fouquart (1987)
!   -------------------------  Ice clouds (Ebert, Curry, 1992)

  DO JSW=1,NSW
    DO JL = KIDIA,KFDIA
      ZTOL=0.0_JPRB
      ZGL =0.0_JPRB
      ZOL =0.0_JPRB
      ZTOI=0.0_JPRB
      ZGI =0.0_JPRB
      ZOI =0.0_JPRB
      ZTOR=0.0_JPRB
      ZGR =0.0_JPRB
      ZOR =0.0_JPRB
      IF (ZFLWP(JL)+ZFIWP(JL)+ZFRWP(JL) > 2.0_JPRB * REPSCW ) THEN
        IF (ZFLWP(JL) >= REPSCW ) THEN
          IF (NLIQOPT /= 0 ) THEN
!-- SW: Slingo, 1989
            ZTOL = ZFLWP(JL)*(RASWCA(JSW)+RASWCB(JSW)/ZRADLP(JL))
            ZGL  = RASWCE(JSW)+RASWCF(JSW)*ZRADLP(JL)
            ZOL  = 1. - RASWCC(JSW)-RASWCD(JSW)*ZRADLP(JL)
          ELSE
!-- SW: Fouquart, 1991
            ZTOL = ZFLWP(JL)*(RYFWCA(JSW)+RYFWCB(JSW)/ZRADLP(JL))
            ZGL  = RYFWCF(JSW)
!            ZOL  = RYFWCC(JSW)-RYFWCD(JSW)*EXP(-RYFWCE(JSW)*ZTOL)
!-- NB: RSWINHF is there simply for making the CY29R2 branch bit compatible with
! the previous. Should be cleaned when RRTM_SW becomes active
            ZOL  = RYFWCC(JSW)-RYFWCD(JSW)*EXP(-RYFWCE(JSW)*ZTOL*RSWINHF)
          ENDIF
        ENDIF

        IF (ZFIWP(JL) >= REPSCW ) THEN
          IF (NICEOPT <= 1) THEN
!-- SW: Ebert-Curry
            ZTOI = ZFIWP(JL)*(REBCUA(JSW)+REBCUB(JSW)/ZRADIP(JL))
            ZGI  = REBCUE(JSW)+REBCUF(JSW)*ZRADIP(JL)
            ZOI  = 1.0_JPRB - REBCUC(JSW)-REBCUD(JSW)*ZRADIP(JL)

          ELSEIF (NICEOPT == 2) THEN
!-- SW: Fu-Liou 1993
            Z1RADI = 1.0_JPRB / ZDESR(JL)
            ZBETAI = RFLAA0(JSW)+Z1RADI* RFLAA1(JSW)
            ZTOI = ZFIWP(JL) * ZBETAI
            ZOMGI= RFLBB0(JSW)+ZRADIP(JL)*(RFLBB1(JSW) + ZRADIP(JL) &
             & *(RFLBB2(JSW)+ZRADIP(JL)* RFLBB3(JSW) ))
            ZOI  = 1.0_JPRB - ZOMGI
            ZOMGP= RFLCC0(JSW)+ZRADIP(JL)*(RFLCC1(JSW) + ZRADIP(JL) &
             & *(RFLCC2(JSW)+ZRADIP(JL)* RFLCC3(JSW) ))
            ZFDEL= RFLDD0(JSW)+ZRADIP(JL)*(RFLDD1(JSW) + ZRADIP(JL) &
             & *(RFLDD2(JSW)+ZRADIP(JL)* RFLDD3(JSW) ))
            ZGI  = ((1.0_JPRB -ZFDEL)*ZOMGP + ZFDEL*3.0_JPRB) / 3.0_JPRB

          ELSEIF (NICEOPT == 3) THEN
!-- SW: Fu 1996
            Z1RADI = 1.0_JPRB / ZDESR(JL)
            ZBETAI = RFUAA0(JSW)+Z1RADI* RFUAA1(JSW)
            ZTOI = ZFIWP(JL) * ZBETAI
            ZOMGI= RFUBB0(JSW)+ZDESR(JL)*(RFUBB1(JSW) + ZDESR(JL) &
             &   *(RFUBB2(JSW)+ZDESR(JL)* RFUBB3(JSW) ))
            ZOI  = 1.0_JPRB - ZOMGI
            ZGI  = RFUCC0(JSW)+ZDESR(JL)*(RFUCC1(JSW) + ZDESR(JL) &
             &   *(RFUCC2(JSW)+ZDESR(JL)* RFUCC3(JSW) ))
            ZGI  = MIN(1.0_JPRB, ZGI)

          ENDIF
        ENDIF

!        IF (ZFRWP(JL) >= REPSCW ) THEN
!          ZTOR= ZFRWP(JL)*0.003_JPRB * ZRAINT(JL)**(-0.22_JPRB)
!          ZOR = 1.0_JPRB - RROMA(JSW)*ZRAINT(JL)**RROMB(JSW)
!          ZGR = RRASY(JSW)
!        ENDIF

!  - MIX of WATER and ICE CLOUDS
        ZTAUMX= ZTOL + ZTOI + ZTOR
        ZOMGMX= ZTOL*ZOL + ZTOI*ZOI + ZTOR*ZOR
        ZASYMX= ZTOL*ZOL*ZGL + ZTOI*ZOI*ZGI + ZTOR*ZOR*ZGR

        ZASYMX= ZASYMX/ZOMGMX
        ZOMGMX= ZOMGMX/ZTAUMX

! --- SW FINAL CLOUD OPTICAL PARAMETERS

        ZCLDSW(JL,JK)  = PCLFR(JL,IKL)
        ZTAU(JL,JSW,JK)  = ZTAUMX
        ZOMEGA(JL,JSW,JK)= ZOMGMX
        ZCG(JL,JSW,JK)   = ZASYMX
      ENDIF
    ENDDO
  ENDDO

  IF(LLDEBUG) THEN
   call writefield_phy("radlsw_ztau",ztau(:,1,:),klev)
  ENDIF

!          2.4    CLOUD LONGWAVE OPTICAL PROPERTIES FOR EC-OPE
!                 --------------------------------------------

!   -------------------------
! --+ LW OPTICAL PARAMETERS +  Water (and Ice) from Smith and Shi (1992)
!   -------------------------  Ice clouds (Ebert, Curry, 1992)

  IF (.NOT.LRRTM) THEN

    DO JL = KIDIA,KFDIA
      ZALFICE(JL)=0.0_JPRB
      ZGAMICE(JL)=0.0_JPRB
      ZBICE(JL)=0.0_JPRB
      ZTICE(JL)=(PT(JL,IKL)-TSTAND)/TSTAND
      IF (NICEOPT == 1) THEN
        ZBICFU(JL)=1.0_JPRB
      ELSE
        ZBICFU(JL)=0.0_JPRB
      ENDIF
      ZKICFU(JL)=0.0_JPRB
    ENDDO

    DO JNU= 1,NSIL
      DO JL = KIDIA,KFDIA
        ZRES(JL)  = XP(1,JNU)+ZTICE(JL)*(XP(2,JNU)+ZTICE(JL)*(XP(3,&
         & JNU)&
         & +ZTICE(JL)*(XP(4,JNU)+ZTICE(JL)*(XP(5,JNU)+ZTICE(JL)*(XP(6,&
         & JNU)&
         & )))))
        ZBICE(JL) = ZBICE(JL) + ZRES(JL)
        ZGAMICE(JL) = ZGAMICE(JL) + REBCUI(JNU)*ZRES(JL)
        ZALFICE(JL) = ZALFICE(JL) + REBCUJ(JNU)*ZRES(JL)
      ENDDO
    ENDDO

!-- Fu et al. (1998) with M'91 LW scheme
    IF (NICEOPT == 2 .OR. NICEOPT == 3) THEN
      DO JRTM=1,16
        DO JL=KIDIA,KFDIA
          IF (PT(JL,IKL) < 160.0_JPRB) THEN
            INDLAY=1
            ZTBLAY =PT(JL,IKL)-160.0_JPRB
          ELSEIF (PT(JL,IKL) < 339.0_JPRB ) THEN
            INDLAY=PT(JL,IKL)-159.0_JPRB
            INDLAY=MAX(INDLAY,1)
            ZTBLAY =PT(JL,IKL)-INT(PT(JL,IKL))
          ELSE
            INDLAY=180
            ZTBLAY =PT(JL,IKL)-339.0_JPRB
          ENDIF
          ZADDPLK = TOTPLNK(INDLAY+1,JRTM)-TOTPLNK(INDLAY,JRTM)
          ZPLANCK = DELWAVE(JRTM) * (TOTPLNK(INDLAY,JRTM) + ZTBLAY*ZADDPLK)
          ZBICFU(JL) = ZBICFU(JL) + ZPLANCK

          IF (ZIWC(JL) > 0.0_JPRB ) THEN
            ZRATIO =  1.0_JPRB / ZDESR(JL)
            IF (NICEOPT == 2) THEN
! ice cloud spectral emissivity a la Fu & Liou (1993)
              ZMABSD = RFULIO(JRTM,1) + ZRATIO &
               & *(RFULIO(JRTM,2) + ZRATIO*RFULIO(JRTM,3))

! ice cloud spectral emissivity a la Fu et al (1998)
            ELSEIF (NICEOPT == 3) THEN
              ZMABSD = RFUETA(JRTM,1) + ZRATIO &
               & *(RFUETA(JRTM,2) + ZRATIO*RFUETA(JRTM,3))
            ENDIF
            ZKICFU(JL) = ZKICFU(JL)+ ZMABSD*ZPLANCK
          ENDIF
        ENDDO
      ENDDO
    ENDIF

    DO JL = KIDIA,KFDIA
      ZGAMICE(JL) = ZGAMICE(JL) / ZBICE(JL)
      ZALFICE(JL) = ZALFICE(JL) / ZBICE(JL)
      ZKICFU(JL)  = ZKICFU(JL) / ZBICFU(JL)

      IF (ZFLWP(JL)+ZFIWP(JL) > REPSCW) THEN

        IF (NLIQOPT == 0) THEN
! water cloud emissivity a la Smith & Shi (1992)
          ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL)
          ZMSALD= 0.158_JPRB*ZMULTL
          ZMSALU= 0.130_JPRB*ZMULTL

        ELSE
! water cloud emissivity a la Savijarvi (1997)
          ZMSALU= 0.2441_JPRB-0.0105_JPRB*ZRADLP(JL)
          ZMSALD= 1.2154_JPRB*ZMSALU

        ENDIF

        IF (NICEOPT == 0) THEN
! ice cloud emissivity a la Smith & Shi (1992)
          ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL)
          ZMSAID= 0.113_JPRB*ZMULTI
          ZMSAIU= 0.093_JPRB*ZMULTI

        ELSEIF (NICEOPT == 1) THEN
! ice cloud emissivity a la Ebert & Curry (1992)
          ZMSAID= 1.66_JPRB*(ZALFICE(JL)+ZGAMICE(JL)/ZRADIP(JL))
          ZMSAIU= ZMSAID

        ELSEIF (NICEOPT == 2 .OR. NICEOPT == 3) THEN
! ice cloud emissivity a la Fu & Liou (1993) or Fu et al. (1998)
          ZMSAID= 1.66_JPRB*ZKICFU(JL)
          ZMSAIU= ZMSAID
        ENDIF

        IF (NINHOM == 1) THEN
          ZZFLWP= ZFLWP(JL) * RLWINHF
          ZZFIWP= ZFIWP(JL) * RLWINHF
        ELSE
          ZZFLWP= ZFLWP(JL)
          ZZFIWP= ZFIWP(JL)
        ENDIF

! effective cloudiness accounting for condensed water
        ZCLDLD(JL,JK) = PCLFR(JL,IKL)*(1.0_JPRB-EXP(-ZMSALD*ZZFLWP-ZMSAID* &
         & ZZFIWP))
        ZCLDLU(JL,JK) = PCLFR(JL,IKL)*(1.0_JPRB-EXP(-ZMSALU*ZZFLWP-ZMSAIU* &
         & ZZFIWP))
      ENDIF
    ENDDO

  ELSE

!          2.5    CLOUD LONGWAVE OPTICAL PROPERTIES FOR RRTM
!                 ------------------------------------------

!   -------------------------
! --+ LW OPTICAL PARAMETERS +  Water (and Ice) from Savijarvi (1998)
!   -------------------------  Ice clouds (Ebert, Curry, 1992)

! No need for a fixed diffusivity factor, accounted for spectrally below
! The detailed spectral structure does not require defining upward and
! downward effective optical properties

    DO JRTM=1,16
      DO JL = KIDIA,KFDIA
        ZTAUCLD(JL,JK,JRTM) = 0.0_JPRB
        ZMSALD = 0.0_JPRB
        ZMSAID = 0.0_JPRB

        IF (ZFLWP(JL)+ZFIWP(JL) > REPSCW) THEN

          IF (NLIQOPT == 0 .OR. NLIQOPT >= 3 ) THEN
! water cloud total emissivity a la Smith and Shi (1992)
            ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL)
            ZRSALD= 0.144_JPRB*ZMULTL / 1.66_JPRB

          ELSEIF (NLIQOPT == 1) THEN
! water cloud spectral emissivity a la Savijarvi (1997)
            ZRSALD= RHSAVI(JRTM,1) + ZRADLP(JL)&
             & *(RHSAVI(JRTM,2) + ZRADLP(JL)*RHSAVI(JRTM,3))

          ELSEIF (NLIQOPT == 2) THEN
! water cloud spectral emissivity a la Lindner and Li (2000)
            Z1RADL = 1.0_JPRB / ZRADLP(JL)
            ZEXTCF = RLILIA(JRTM,1)+ZRADLP(JL)*RLILIA(JRTM,2)+ Z1RADL*&
             & (RLILIA(JRTM,3) + Z1RADL*(RLILIA(JRTM,4) + Z1RADL*&
             & RLILIA(JRTM,5) ))
            Z1MOMG = RLILIB(JRTM,1) + Z1RADL*RLILIB(JRTM,2) &
             & + ZRADLP(JL) *(RLILIB(JRTM,3) + ZRADLP(JL)*RLILIB(JRTM,4) )
            ZRSALD = Z1MOMG * ZEXTCF
          ENDIF

          IF (NICEOPT == 0) THEN
! ice cloud spectral emissivity a la Smith & Shi (1992)
            ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL)
            ZRSAID= 0.103_JPRB*ZMULTI / 1.66_JPRB

          ELSEIF (NICEOPT == 1) THEN
! ice cloud spectral emissivity a la Ebert-Curry (1992)
            ZRSAID= REBCUH(JRTM)+REBCUG(JRTM)/ZRADIP(JL)

          ELSEIF (NICEOPT == 2) THEN
! ice cloud spectral emissivity a la Fu & Liou (1993)
            Z1RADI = 1.0_JPRB / ZDESR(JL)
            ZRSAID = RFULIO(JRTM,1) + Z1RADI &
             & *(RFULIO(JRTM,2) + Z1RADI * RFULIO(JRTM,3))

          ELSEIF (NICEOPT == 3) THEN
! ice cloud spectral emissivity a la Fu et al (1998) including
! parametrisation for LW scattering effect
            Z1RADI = 1.0_JPRB / ZDESR(JL)
            ZRSAIE = RFUETA(JRTM,1) + Z1RADI &
             &*(RFUETA(JRTM,2) + Z1RADI * RFUETA(JRTM,3))
            ZRSAIA = Z1RADI*(RFUETB(JRTM,1) +ZDESR(JL)*( RFUETB(JRTM,2) +ZDESR(JL)*( RFUETB(JRTM,3) +ZDESR(JL)* RFUETB(JRTM,4))))
            ZRSAIG = RFUETC(JRTM,1) +ZDESR(JL)*( RFUETC(JRTM,2) +ZDESR(JL)*( RFUETC(JRTM,3) +ZDESR(JL)* RFUETC(JRTM,4)))
            ZRSAIF = 0.5_JPRB + ZRSAIG*( 0.3738_JPRB + ZRSAIG*( 0.0076_JPRB + ZRSAIG*0.1186_JPRB ) )
            ZRSAID = (1.0_JPRB - ZRSAIA/ZRSAIE * ZRSAIF) * ZRSAIE
          ENDIF

          ZTAUD = ZRSALD*ZFLWP(JL)+ZRSAID*ZFIWP(JL)

! Diffusivity correction within clouds a la Savijarvi
          IF (LDIFFC) THEN
            ZDIFFD=MIN(MAX(1.517_JPRB-0.156_JPRB*LOG(ZTAUD) , 1.0_JPRB), &
             &     2.0_JPRB)
          ELSE
            ZDIFFD=1.66_JPRB
          ENDIF

          ZTAUCLD(JL,JK,JRTM) = ZTAUD*ZDIFFD
        ENDIF

      ENDDO
    ENDDO

  ENDIF

ENDDO

NUAER = NUA
NTRAER = NTRA

!     ------------------------------------------------------------------
!
!          2.6    SCALING OF OPTICAL THICKNESS
!                 SPECTRALLY, ACCOUNTING FOR VERTICAL VARIABILITY

JEXPLR=NLAYINH
JXPLDN=2*JEXPLR+1

IF (NINHOM == 1) THEN
!-- simple scaling a la Tiedtke (1996) with RSWINHF in SW and RLWINHF in LW
  DO JSW=1,NSW
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        ZTAU(JL,JSW,JK)=ZTAU(JL,JSW,JK) * RSWINHF
      ENDDO
    ENDDO
  ENDDO

  DO JRTM=1,16
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM) * RLWINHF
      ENDDO
    ENDDO
  ENDDO

ELSEIF (JEXPLR /= 0) THEN
  DO JSW=1,NSW
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        ZSQUAR(JL,JK)=0.0_JPRB
        ZVARIA(JL,JK)=1.0_JPRB
      ENDDO
    ENDDO
!-- range should be defined from Hogan & Illingworth
    DO JK=1+JEXPLR,KLEV-JEXPLR
      DO JL=KIDIA,KFDIA
!        ZAVDP(JL)=0.0_JPRB
        ZAVTO(JL)=0.0_JPRB
        ZSQTO(JL)=0.0_JPRB
      ENDDO
      DO JKI=JK-JEXPLR,JK+JEXPLR
        IKI=KLEV+1-JKI
        DO JL=KIDIA,KFDIA
!          ZAVDP(JL)=ZAVDP(JL)+PDP(JL,IKI)/RG
          ZAVTO(JL)=ZAVTO(JL)+ZTAU(JL,JSW,JKI)
        ENDDO
      ENDDO
      DO JL=KIDIA,KFDIA
!        ZAVTO(JL)=ZAVTO(JL)/ZAVDP(JL)
        ZAVTO(JL)=ZAVTO(JL)/JXPLDN
      ENDDO
      DO JKI=JK-JEXPLR,JK+JEXPLR
        IKI=KLEV+1-JKI
        DO JL=KIDIA,KFDIA
!          ZSQTO(JL)=ZSQTO(JL)+(ZTAU(JL,JSW,JKI)/PDP(JL,IKI)-ZAVTO(JL))**2
          ZSQTO(JL)=ZSQTO(JL)+(ZTAU(JL,JSW,JKI)-ZAVTO(JL))**2
        ENDDO
      ENDDO
      DO JL=KIDIA,KFDIA
        ZSQTO(JL)=SQRT(ZSQTO(JL)/(JXPLDN*(JXPLDN-1)))
        IF (ZAVTO(JL) > 0.0_JPRB) THEN
          ZVARIA(JL,JK)=(ZSQTO(JL)/ZAVTO(JL))**2
          ZSQUAR(JL,JK)=EXP(-ZVARIA(JL,JK))
        ELSE
          ZVARIA(JL,JK)=0.0_JPRB
          ZSQUAR(JL,JK)=1.0_JPRB
        ENDIF

!-- scaling a la Barker
        IF (NINHOM ==2) THEN
          ZTAU(JL,JSW,JK)=ZTAU(JL,JSW,JK)*ZSQUAR(JL,JK)

!-- scaling a la Cairns et al.
        ELSEIF (NINHOM == 3) THEN
          ZVI=ZVARIA(JL,JK)
          ZTAU(JL,JSW,JK)  = ZTAU(JL,JSW,JK)/(1.0_JPRB+ZVI)
          ZOMEGA(JL,JSW,JK)= ZOMEGA(JL,JSW,JK) &
            &   /(1.0_JPRB + ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK) ) )
          ZCG(JL,JSW,JK)   = ZCG(JL,JSW,JK) &
            & *(1.0_JPRB+ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK))) &
            & /(1.0_JPRB+ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK)*ZCG(JL,JSW,JK)))
        ENDIF
      ENDDO
!      JL=KIDIA
!      print 9261,JSW,JK,ZTAU(JL,JSW,JK),ZAVTO(JL),ZSQTO(JL),ZVARIA(JL,JK),ZSQUAR(JL,JK)
9261   format(1x,'Varia1 ',2I3,7F10.4)
    ENDDO
  ENDDO


  DO JRTM=1,16
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        ZSQUAR(JL,JK)=0.0_JPRB
        ZVARIA(JL,JK)=1.0_JPRB
      ENDDO
    ENDDO
!-- range to be defined from Hogan & Illingworth
    DO JK=1+JEXPLR,KLEV-JEXPLR
      DO JL=KIDIA,KFDIA
!        ZAVDP(JL)=0.0_JPRB
        ZAVTO(JL)=0.0_JPRB
        ZSQTO(JL)=0.0_JPRB
      ENDDO
      DO JKI=JK-JEXPLR,JK+JEXPLR
        IKI=KLEV+1-JKI
        DO JL=KIDIA,KFDIA
!          ZAVDP(JL)=ZAVDP(JL)+PDP(JL,IKI)/RG
          ZAVTO(JL)=ZAVTO(JL)+ZTAUCLD(JL,JKI,JRTM)
        ENDDO
      ENDDO
      DO JL=KIDIA,KFDIA
!        ZAVTO(JL)=ZAVTO(JL)/ZAVDP(JL)
        ZAVTO(JL)=ZAVTO(JL)/JXPLDN
      ENDDO
      DO JKI=JK-JEXPLR,JK+JEXPLR
        IKI=KLEV+1-JKI
        DO JL=KIDIA,KFDIA
!          ZSQTO(JL)=ZSQTO(JL)+(ZTAUCLD(JL,JKI,JRTM)/PDP(JL,IKI)-ZAVTO(JL))**2
            ZSQTO(JL)=ZSQTO(JL)+(ZTAUCLD(JL,JKI,JRTM)-ZAVTO(JL))**2
        ENDDO
      ENDDO
      DO JL=KIDIA,KFDIA
        ZSQTO(JL)=SQRT(ZSQTO(JL)/(JXPLDN*(JXPLDN-1)))
        IF (ZAVTO(JL) > 0.0_JPRB) THEN
          ZVARIA(JL,JK)=(ZSQTO(JL)/ZAVTO(JL))**2
          ZSQUAR(JL,JK)=EXP(-ZVARIA(JL,JK))
        ELSE
          ZVARIA(JL,JK)=0.0_JPRB
          ZSQUAR(JL,JK)=1.0_JPRB
        ENDIF

!-- scaling a la Barker
        IF (NINHOM ==2) THEN
          ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM)*ZSQUAR(JL,JK)

!-- scaling a la Cairns et al.
        ELSEIF (NINHOM == 3) THEN
          ZVI=ZVARIA(JL,JK)
          ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM)/(1.0_JPRB+ZVI)
        ENDIF
      ENDDO
!      JL=KIDIA
!      print 9262,JRTM,JK,ZTAUCLD(JL,JK,JRTM),ZAVTO(JL),ZSQTO(JL),ZVARIA(JL,JK),ZSQUAR(JL,JK)
9262   format(1x,'Varia2 ',2I3,7F10.4)
    ENDDO
  ENDDO
ENDIF



!     ------------------------------------------------------------------
!
!*         2.7    DIFFUSIVITY FACTOR OR SATELLITE VIEWING ANGLE
!                 ---------------------------------------------

DO JL = KIDIA,KFDIA
  ZVIEW(JL) = DIFF
ENDDO

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

!*         3.     CALL LONGWAVE RADIATION CODE
!                 ----------------------------

!*         3.1    FULL LONGWAVE RADIATION COMPUTATIONS
!                 ------------------------------------

!print *,'RADLSW: LPHYLIN, LRRTM',LPHYLIN, LRRTM
IF (.NOT.LPHYLIN) THEN
  IF ( .NOT. LRRTM) THEN

    CALL LW &
     & ( KIDIA , KFDIA , KLON  , KLEV , KMODE,&
     & PCCO2 , ZCLDLD, ZCLDLU,&
     & PDP   , ZDT0  , ZEMIS , ZEMIW,&
     & ZPMB  , POZON , ZTL,&
     & PAER  , ZTAVE , ZVIEW , PQ,&
     & ZEMIT , PFLUX , PFLUC &
     & )
!   print *,'RADLSW: apres CALL LW'
    IF(LLDEBUG) THEN
    call writefield_phy('radlsw_flux1',PFLUX(:,1,:),klev+1)
    call writefield_phy('radlsw_flux2',PFLUX(:,2,:),klev+1)
    call writefield_phy('radlsw_fluc1',PFLUC(:,1,:),klev+1)
    call writefield_phy('radlsw_fluc2',PFLUC(:,2,:),klev+1)
    ENDIF

  ELSE

!*         3.2    FULL LONGWAVE RADIATION COMPUTATIONS - RRTM
!                 ------------------------------------   ----

!  i)  pass ZOZN (ozone mass mixing ratio) to RRTM; remove pressure
!      weighting applied to POZON in driverMC (below)
!  ii) pass ZEMIS and ZEMIW to RRTM; return ZEMIT from RRTM
!  iii)pass ZTAUCLD, cloud optical depths (water+ice) to RRTM,
!      computed from equations above
!  iv) pass ECRT arrays to RRTM arrays in interface routine ECRTATM
!      in module rrtm_ecrt.f

    DO JL = KIDIA,KFDIA
      DO JK = 1, KLEV
        ZOZN(JL,JK) = POZON(JL,JK)/PDP(JL,JK)
      ENDDO
    ENDDO

!   print *,'RADLSW: avant CALL RRTM_RRTM_140GP,PAP=',PAP(1,:)
    CALL RRTM_RRTM_140GP &
     & ( KIDIA , KFDIA , KLON  , KLEV,&
     & PAER  , PAPH  , PAP,&
     & PTS   , PTH   , PT,&
     & ZEMIS , ZEMIW,&
     & PQ    , PCCO2 , ZOZN  ,&
     & ZCLDSW  , ZTAUCLD,&
     & PTAU_LW,&
     & ZEMIT , PFLUX , PFLUC , ZTCLEAR )
!   print *,'RADLSW: apres CALL RRTM_RRTM_140GP'

  ENDIF
ELSE
  ZEMIT (:)   = 0.0_JPRB
  PFLUX(:,:,:)= 0.0_JPRB
  PFLUC(:,:,:)= 0.0_JPRB
! print *,'RADLSW: ZEMIT,PFLUX et PFLUC = 0'
ENDIF

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

!*         4.     CALL SHORTWAVE RADIATION CODE
!                 -----------------------------

ZRMUZ=0.0_JPRB
DO JL = KIDIA,KFDIA
  ZRMUZ = MAX (ZRMUZ, ZMU0(JL))
ENDDO

IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
  WRITE(NULOUT,'(4E15.8)') PRII0,PCCO2,ZPSOL(KIDIA),ZMU0(KIDIA)
  WRITE(NULOUT,'("ZALBD ",6E15.8)') (ZALBD(KIDIA,JSW),JSW=1,NSW)
  WRITE(NULOUT,'("ZALBP ",6E15.8)') (ZALBP(KIDIA,JSW),JSW=1,NSW)
  WRITE(NULOUT,'("PQ    ",10E12.5)') (PQ(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("PQS   ",10E12.5)') (PQS(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("PDP   ",10E12.5)') (PDP(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("ZPMB  ",10E12.5)') (ZPMB(KIDIA,JK),JK=1,KLEV+1)
  WRITE(NULOUT,'("ZTAVE ",10E12.5)') (ZTAVE(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("ZCLDSW",10E12.5)') (ZCLDSW(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("ZTAU  ",10E12.5)') ((ZTAU(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
  WRITE(NULOUT,'("ZCG   ",10E12.5)') ((ZCG(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
  WRITE(NULOUT,'("ZOMEGA",10E12.5)') ((ZOMEGA(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
  WRITE(NULOUT,'("ZOZ   ",10E12.5)') (ZOZ(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("PAER  ",10E12.5)') ((PAER(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
ENDIF

IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
  WRITE(NULOUT,'(4E15.8)') PRII0,PCCO2,ZPSOL(KIDIA),ZMU0(KIDIA)
  WRITE(NULOUT,'("ZALBD ",6E15.8)') (ZALBD(KIDIA,JSW),JSW=1,NSW)
  WRITE(NULOUT,'("ZALBP ",6E15.8)') (ZALBP(KIDIA,JSW),JSW=1,NSW)
  WRITE(NULOUT,'("PQ    ",10E12.5)') (PQ(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("PQS   ",10E12.5)') (PQS(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("PDP   ",10E12.5)') (PDP(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("ZPMB  ",10E12.5)') (ZPMB(KIDIA,JK),JK=1,KLEV+1)
  WRITE(NULOUT,'("ZTAVE ",10E12.5)') (ZTAVE(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("ZCLDSW",10E12.5)') (ZCLDSW(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("ZTAU  ",10E12.5)') ((ZTAU(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
  WRITE(NULOUT,'("ZCG   ",10E12.5)') ((ZCG(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
  WRITE(NULOUT,'("ZOMEGA",10E12.5)') ((ZOMEGA(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
  WRITE(NULOUT,'("ZOZ   ",10E12.5)') (ZOZ(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("PAER  ",10E12.5)') ((PAER(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
ENDIF
CALL SW &
 & ( KIDIA , KFDIA , KLON  , KLEV  , KAER,&
 & PRII0 , PCCO2 , ZPSOL , ZALBD , ZALBP , PQ   , PQS,&
 & ZMU0  , ZCG   , ZCLDSW, PDP   , ZOMEGA, ZOZ  , ZPMB,&
 & ZTAU  , ZTAVE , PAER,&
 & PFSDN , PFSUP , PFSCDN, PFSCUP,&
 & ZFSDNN, ZFSDNV, ZFSUPN, ZFSUPV,&
 & ZFCDNN, ZFCDNV, ZFCUPN, ZFCUPV,&
 & ZSUDU , ZUVDF , ZPARF ,ZPARCF, ZDIFFS, ZDIRFS, &
 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST&
   & )
PFSDNV=ZFSDNV
PFSDNN=ZFSDNN
IF (SIZE(PSFSWDIR,2)>1) THEN
  PSFSWDIR= ZDIRFS
  PSFSWDIF= ZDIFFS
ELSE
  PSFSWDIR (:,1) = ZFSDNV(:) + ZFSDNN(:)
  PSFSWDIF (:,:) = 0.
ENDIF

IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
  WRITE(NULOUT,'("ZFSDWN",10E12.5)') (ZFSDWN(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("ZFSUP ",10E12.5)') (ZFSUP (KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("ZFCDWN",10E12.5)') (ZFCDWN(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("ZFCUP ",10E12.5)') (ZFCUP (KIDIA,JK),JK=1,KLEV)
  LEDBUG=.FALSE.
ENDIF
IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
  WRITE(NULOUT,'("ZFSDWN",10E12.5)') (ZFSDWN(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("ZFSUP ",10E12.5)') (ZFSUP (KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("ZFCDWN",10E12.5)') (ZFCDWN(KIDIA,JK),JK=1,KLEV)
  WRITE(NULOUT,'("ZFCUP ",10E12.5)') (ZFCUP (KIDIA,JK),JK=1,KLEV)
  LEDBUG=.FALSE.
ENDIF
!     ------------------------------------------------------------------

!*         5.     FILL UP THE MODEL NET LW AND SW RADIATIVE FLUXES
!                 ------------------------------------------------

DO JKL = 1 , KLEV+1
  JK = KLEV+1 + 1 - JKL
  DO JL = KIDIA,KFDIA
    PFLS(JL,JKL) = ZFSDWN(JL,JK) - ZFSUP(JL,JK)
    PFLT(JL,JKL) = - PFLUX(JL,1,JK) - PFLUX(JL,2,JK)
    PFCS(JL,JKL) = ZFCDWN(JL,JK) - ZFCUP(JL,JK)
    PFCT(JL,JKL) = - PFLUC(JL,1,JK) - PFLUC(JL,2,JK)
  ENDDO
ENDDO

DO JL = KIDIA,KFDIA
  PFRSOD(JL)=ZFSDWN(JL,1)
  PEMIT (JL)=ZEMIT (JL)
  PSUDU (JL)=ZSUDU (JL)
  PUVDF (JL)=ZUVDF (JL)
  PPARF (JL)=ZPARF (JL)
  PPARCF(JL)=ZPARCF(JL)
  PTINCF(JL)=PRII0 * ZMU0(JL)
ENDDO
!print 9501,(PUVDF(JL),JL=KIDIA,KFDIA)
9501 format(1x,'RADLSW PUVDF: ',30f6.1)
!print 9502,(PPARF(JL),JL=KIDIA,KFDIA)
9502 format(1x,'RADLSW PPARF: ',30f6.1)

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

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



































Generated by: GCOVR (Version 4.2)