source: LMDZ6/trunk/libf/phylmd/rrtm/radlsw.F90 @ 5441

Last change on this file since 5441 was 5294, checked in by Laurent Fairhead, 8 weeks ago

Keeping clesphys.h was not the right solution
LF
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 42.1 KB
RevLine 
[1989]1SUBROUTINE RADLSW &
2 & ( KIDIA, KFDIA , KLON , KLEV  , KMODE, KAER,&
3 & PRII0,&
4 & PAER , PALBD , PALBP, PAPH , PAP,&
5 & PCCNL, PCCNO,&
6 & PCCO2, PCLFR , PDP  , PEMIS, PEMIW , PLSM , PMU0, POZON,&
7 & PQ   , PQIWP , PQLWP, PQS  , PQRAIN, PRAINT,&
8 & PTH  , PT    , PTS  , PNBAS, PNTOP,&
9 & PREF_LIQ, PREF_ICE,&
10 & PEMIT, PFCT  , PFLT , PFCS , PFLS,&
11 & PFRSOD,PSUDU , PUVDF, PPARF, PPARCF, PTINCF,&
12 & PSFSWDIR, PSFSWDIF,PFSDNN,PFSDNV ,& 
[2146]13 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST,&
14 & PTAU_LW,&
15 & PFLUX,PFLUC,PFSDN ,PFSUP , PFSCDN , PFSCUP)
[1989]16
17use write_field_phy
[5294]18! Temporary fix waiting for cleaner interface (or not)
19USE clesphys_mod_h, ONLY: NSW
[1989]20
21!**** *RADLSW* - INTERFACE TO ECMWF LW AND SW RADIATION SCHEMES
22
23!     PURPOSE.
24!     --------
25!           CONTROLS RADIATION COMPUTATIONS
26
27!**   INTERFACE.
28!     ----------
29
30!        EXPLICIT ARGUMENTS :
31!        --------------------
32! PAER   : (KLON,6,KLEV)     ; OPTICAL THICKNESS OF THE AEROSOLS
33! PALBD  : (KLON,NSW)        ; SURF. SW ALBEDO FOR DIFFUSE RADIATION
34! PALBP  : (KLON,NSW)        ; SURF. SW ALBEDO FOR PARALLEL RADIATION
35! PAPH   : (KLON,KLEV+1)     ; HALF LEVEL PRESSURE
36! PAP    : (KLON,KLEV)       ; FULL LEVEL PRESSURE
37! PCCNL  : (KLON)            ; CCN CONCENTRATION OVER LAND
38! PCCNO  : (KLON)            ; CCN CONCENTRATION OVER OCEAN
39! PCCO2  :                   ; CONCENTRATION IN CO2 (KG/KG)
40! PCLFR  : (KLON,KLEV)       ; CLOUD FRACTIONAL COVER
41! PDP    : (KLON,KLEV)       ; LAYER PRESSURE THICKNESS
42! PEMIS  : (KLON)            ; SURFACE LW EMISSIVITY
43! PEMIW  : (KLON)            ; SURFACE LW WINDOW EMISSIVITY
44! PLSM   : (KLON)            ; LAND-SEA MASK
45! PMU0   : (KLON)            ; SOLAR ANGLE
46! PNBAS  : (KLON)            ; INDEX OF BASE OF CONVECTIVE LAYER
47! PNTOP  : (KLON)            ; INDEX OF TOP OF CONVECTIVE LAYER
48! POZON  : (KLON,KLEV)       ; OZONE AMOUNT in LAYER (KG/KG*PA)
49! PQ     : (KLON,KLEV)       ; SPECIFIC HUMIDITY KG/KG
50! PQIWP  : (KLON,KLEV)       ; SOLID  WATER KG/KG
51! PQLWP  : (KLON,KLEV)       ; LIQUID WATER KG/KG
52! PQS    : (KLON,KLEV)       ; SATURATION WATER VAPOR  KG/KG
53! PQRAIN : (KLON,KLEV)       ; RAIN WATER KG/KG
54! PRAINT : (KLON,KLEV)       ; RAIN RATE (m/s)
55! PTH    : (KLON,KLEV+1)     ; HALF LEVEL TEMPERATURE
56! PT     : (KLON,KLEV)       ; FULL LEVEL TEMPERATURE
57! PTS    : (KLON)            ; SURFACE TEMPERATURE
58! LDDUST                     ; Dust properties switch
59! PPIZA_DST  : (KPROMA,KLEV,NSW); Single scattering albedo of dust
60! PCGA_DST   : (KPROMA,KLEV,NSW); Assymetry factor for dust
61! PTAUREL_DST: (KPROMA,KLEV,NSW); Optical depth of dust relative to at 550nm
[2146]62! PTAU_LW  (KPROMA,KLEV,NLW); LW Optical depth of aerosols
[1989]63! PREF_LIQ (KPROMA,KLEV)        ; Liquid droplet radius (um)
64! PREF_ICE (KPROMA,KLEV)        ; Ice crystal radius (um)
65!     ==== OUTPUTS ===
66! PFCT   : (KLON,KLEV+1)     ; CLEAR-SKY LW NET FLUXES
67! PFLT   : (KLON,KLEV+1)     ; TOTAL LW NET FLUXES
68! PFCS   : (KLON,KLEV+1)     ; CLEAR-SKY SW NET FLUXES
69! PFLS   : (KLON,KLEV+1)     ; TOTAL SW NET FLUXES
70! PFRSOD : (KLON)            ; TOTAL-SKY SURFACE SW DOWNWARD FLUX
71! PEMIT  : (KLON)            ; SURFACE TOTAL LONGWAVE EMISSIVITY
72! PSUDU  : (KLON)            ; SOLAR RADIANCE IN SUN'S DIRECTION
73! PPARF  : (KLON)            ; PHOTOSYNTHETICALLY ACTIVE RADIATION
74! PUVDF  : (KLON)            ; UV(-B) RADIATION
75! PPARCF : (KLON)            ; CLEAR-SKY PHOTOSYNTHETICALLY ACTIVE RADIATION
76! PTINCF : (KLON)            ; TOA INCIDENT SOLAR RADIATION
77! Ajout flux LW et SW montants et descendants, et ciel clair (MPL 19.12.08)
78! PFLUX  : (KLON,2,KLEV+1)   ; LW total sky flux (1=up, 2=down)
79! PFLUC  : (KLON,2,KLEV+1)   ; LW clear sky flux (1=up, 2=down)
80! PFSDN(KLON,KLEV+1)         ; SW total sky flux down
81! PFSUP(KLON,KLEV+1)         ; SW total sky flux up
82! PFSCDN(KLON,KLEV+1)        ; SW clear sky flux down
83! PFSCUP(KLON,KLEV+1)        ; SW clear sky flux up
84
85
86
87!        IMPLICIT ARGUMENTS :   NONE
88!        --------------------
89
90!     METHOD.
91!     -------
92!        SEE DOCUMENTATION
93
94!     EXTERNALS.
95!     ----------
96
97!     REFERENCE.
98!     ----------
99!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
100
101!     AUTHORS.
102!     --------
103!        J.-J. MORCRETTE         *ECMWF*
104
105!     MODIFICATIONS.
106!     --------------
107!        ORIGINAL : 88-02-04
108!        J.-J. MORCRETTE 94-11-15 DIRECT/DIFFUSE SURFACE ALBEDO
109!        08/96: J.-J. Morcrette/Ph. Dandin: tests of eff. radius param.
110!        9909 : JJMorcrette effect.radius + inhomogeneity factors
111!        JJMorcrette 990128 : sunshine duration
112!        JJMorcrette : 990831 RRTM-140gp
113!        JJMorcrette : 010112 Sun-Rikus ice particle Diameter
114!        JJMorcrette : 010301 cleaning liq/ice cloud optical properties
115!        JJMorcrette : 011005 CCN --> Re liquid water clouds
116!        JJMorcrette : 011108 Safety checks
117!        JJMorcrette : 011108 Safety checks
118!        DJSalmond   : 020211 Check before R-To-R
119!        JJMorcrette : 020901 PAR & UV
120!        M.Hamrud      01-Oct-2003 CY28 Cleaning
121!        JJMorcrette : 050402 New sets of optical properties (NB: inactive)
122!        Y.Seity       04-11-18 : add 4 arguments for AROME externalized surface
123!        Y.Seity       05-10-10 : add 3 optional arg. for dust SW properties
124!        JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation
125!-----------------------------------------------------------------------
126
127USE PARKIND1  ,ONLY : JPIM     ,JPRB
128USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
129
130USE YOMCST   , ONLY : RG       ,RD       ,RTT      ,RPI
131!USE YOERAD   , ONLY : NSW      ,LRRTM    ,LCCNL    ,LCCNO, LDIFFC, &
132! NSW mis dans .def MPL 20140211
[2146]133USE YOERAD   , ONLY : NLW, LRRTM    ,LCCNL    ,LCCNO, LDIFFC, &
[1989]134 & NRADIP , NRADLP , NICEOPT, NLIQOPT, NINHOM ,NLAYINH ,&
135 & RCCNLND, RCCNSEA, RLWINHF, RSWINHF, RRe2De ,& 
136 & LEDBUG 
137USE YOELW    , ONLY : NSIL     ,NTRA     ,NUA      ,TSTAND   ,XP
138USE YOESW    , ONLY : RYFWCA   ,RYFWCB   ,RYFWCC   ,RYFWCD   ,&
139 & RYFWCE   ,RYFWCF   ,REBCUA   ,REBCUB   ,REBCUC   ,&
140 & REBCUD   ,REBCUE   ,REBCUF   ,REBCUI   ,REBCUJ   ,&
141 & REBCUG   ,REBCUH   ,RHSAVI   ,RFULIO   ,RFLAA0   ,&
142 & RFLAA1   ,RFLBB0   ,RFLBB1   ,RFLBB2   ,RFLBB3   ,&
143 & RFLCC0   ,RFLCC1   ,RFLCC2   ,RFLCC3   ,RFLDD0   ,&
144 & RFLDD1   ,RFLDD2   ,RFLDD3   ,RFUETA   ,RFUETB   ,RFUETC  ,RASWCA   ,&
145 & RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF   ,&
146 & RFUAA0   ,RFUAA1   ,RFUBB0   ,RFUBB1   ,RFUBB2   ,&
147 & RFUBB3   ,RFUCC0   ,RFUCC1   ,RFUCC2   ,RFUCC3   ,&
148 & RLILIA   ,RLILIB 
149USE YOERDU        , ONLY : NUAER    ,NTRAER   ,REPLOG   ,REPSC    ,REPSCW   ,DIFF
[2043]150!USE YOETHF        , ONLY : RTICE
[1989]151USE YOEPHLI       , ONLY : LPHYLIN
152USE YOERRTWN      , ONLY :                     DELWAVE   ,TOTPLNK   
153
154USE YOMLUN_IFSAUX , ONLY : NULOUT
155USE YOMCT3        , ONLY : NSTEP
156
157IMPLICIT NONE
158
[5294]159!!include "clesphys.h"
[2146]160!!include "clesrrtm.h"
[2043]161include "YOETHF.h"
[1989]162INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
163INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
164INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
165INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
166INTEGER(KIND=JPIM),INTENT(IN)    :: KMODE
167INTEGER(KIND=JPIM),INTENT(IN)    :: KAER
168REAL(KIND=JPRB)   ,INTENT(IN)    :: PRII0
169REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV)
170REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KLON,NSW)
171REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KLON,NSW)
172REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1)
173REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV)
174REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCNL(KLON)
175REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCNO(KLON)
176REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2
177REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLFR(KLON,KLEV)
178REAL(KIND=JPRB)   ,INTENT(IN)    :: PDP(KLON,KLEV)
179REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON)
180REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIW(KLON)
181REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSM(KLON)
182REAL(KIND=JPRB)   ,INTENT(IN)    :: PMU0(KLON)
183REAL(KIND=JPRB)   ,INTENT(IN)    :: POZON(KLON,KLEV)
184REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV)
185REAL(KIND=JPRB)   ,INTENT(IN)    :: PQIWP(KLON,KLEV)
186REAL(KIND=JPRB)   ,INTENT(IN)    :: PQLWP(KLON,KLEV)
187REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS(KLON,KLEV)
188REAL(KIND=JPRB)                  :: PQRAIN(KLON,KLEV) ! Argument NOT used
189REAL(KIND=JPRB)                  :: PRAINT(KLON,KLEV) ! Argument NOT used
190REAL(KIND=JPRB)   ,INTENT(IN)    :: PTH(KLON,KLEV+1)
191REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV)
192REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON)
193REAL(KIND=JPRB)   ,INTENT(IN)    :: PNBAS(KLON)
194REAL(KIND=JPRB)   ,INTENT(IN)    :: PNTOP(KLON)
195LOGICAL           ,INTENT(IN)    :: LRDUST
196REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZA_DST(KLON,KLEV,NSW)
197REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGA_DST(KLON,KLEV,NSW)
198REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUREL_DST(KLON,KLEV,NSW)
[2146]199!--C.Kleinschmitt
200REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU_LW(KLON,KLEV,NLW)
201!--end
[1989]202REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_LIQ(KLON,KLEV)
203REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_ICE(KLON,KLEV)
204REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMIT(KLON)
205REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFCT(KLON,KLEV+1)
206REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLT(KLON,KLEV+1)
207REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFCS(KLON,KLEV+1)
208REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLS(KLON,KLEV+1)
209REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRSOD(KLON)
210REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSUDU(KLON)
211REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUVDF(KLON)
212REAL(KIND=JPRB)   ,INTENT(OUT)   :: PPARF(KLON)
213REAL(KIND=JPRB)   ,INTENT(OUT)   :: PPARCF(KLON), PTINCF(KLON)
214REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSFSWDIR(KLON,NSW)
215REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSFSWDIF(KLON,NSW)
216REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDNN(KLON)
217REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDNV(KLON)
218REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUX(KLON,2,KLEV+1) ! LW total sky flux (1=up, 2=down)
219REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC(KLON,2,KLEV+1) ! LW clear sky flux (1=up, 2=down)
220REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDN(KLON,KLEV+1)   ! SW total sky flux down
221REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUP(KLON,KLEV+1)   ! SW total sky flux up
222REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCDN(KLON,KLEV+1)  ! SW clear sky flux down
223REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCUP(KLON,KLEV+1)  ! SW clear sky flux up
224
225
226!     -----------------------------------------------------------------
227
228!*       0.1   ARGUMENTS.
229!              ----------
230!     ==== COMPUTED IN RADLSW ===
231!     -----------------------------------------------------------------
232
233!*       0.2   LOCAL ARRAYS.
234!              -------------
235!     -----------------------------------------------------------------
236
237!-- ARRAYS FOR LOCAL VARIABLES -----------------------------------------
238
239INTEGER(KIND=JPIM) :: IBAS(KLON)     , ITOP(KLON)
240
241REAL(KIND=JPRB) ::&
242 & ZALBD(KLON,NSW)    , ZALBP(KLON,NSW)&
243 & , ZCG(KLON,NSW,KLEV) , ZOMEGA(KLON,NSW,KLEV)&
244 & , ZTAU (KLON,NSW,KLEV) &
245 & , ZTAUCLD(KLON,KLEV,16), ZTCLEAR(KLON) 
246REAL(KIND=JPRB) ::&
247 & ZCLDLD(KLON,KLEV)  , ZCLDLU(KLON,KLEV)&
248 & , ZCLDSW(KLON,KLEV)  , ZCLD0(KLON,KLEV)&
249 & , ZDT0(KLON)        &
250 & , ZEMIS(KLON)        , ZEMIW(KLON)&
251 & , ZFIWP(KLON)        , ZFLWP(KLON)      , ZFRWP(KLON)&
252 & , ZIWC(KLON)         , ZLWC(KLON)&
253 !cc            , ZRWC(KLON)
254 & , ZMU0(KLON)         , ZOZ(KLON,KLEV)   , ZOZN(KLON,KLEV)&
255 & , ZPMB(KLON,KLEV+1)  , ZPSOL(KLON)&
256 & , ZTAVE (KLON,KLEV)  , ZTL(KLON,KLEV+1)&
257 & , ZVIEW(KLON) 
258REAL(KIND=JPRB) ::&
259 & ZFCDWN(KLON,KLEV+1), ZFCUP(KLON,KLEV+1)&
260 & , ZFSDWN(KLON,KLEV+1), ZFSUP(KLON,KLEV+1)&
261 & , ZFSUPN(KLON)       , ZFSUPV(KLON)&
262 & , ZFCUPN(KLON)       , ZFCUPV(KLON)&
263 & , ZFSDNN(KLON)       , ZFSDNV(KLON)&
264 & , ZFCDNN(KLON)       , ZFCDNV(KLON)& 
265 & , ZDIRFS(KLON,NSW)   , ZDIFFS(KLON,NSW) 
266REAL(KIND=JPRB) ::&
267 & ZALFICE(KLON)      , ZGAMICE(KLON)     , ZBICE(KLON)   , ZDESR(KLON)&
268 & , ZRADIP(KLON)       , ZRADLP(KLON)     &
269 !cc           , ZRADRD(KLON)
270 & , ZRAINT(KLON)       , ZRES(KLON)&
271 & , ZTICE(KLON)        , ZEMIT(KLON),  ZBICFU(KLON)&
272 & , ZKICFU(KLON)
273REAL(KIND=JPRB) :: ZSUDU(KLON)   , ZPARF(KLON)       , ZUVDF(KLON), ZPARCF(KLON)
274INTEGER(KIND=JPIM) :: IKL, JK, JKL, JKLP1, JKP1, JL, JNU, JRTM, JSW, INDLAY
275
276REAL(KIND=JPRB) :: ZASYMX, ZDIFFD, ZGI, ZGL, ZGR, ZIWGKG, ZLWGKG,&
277 & ZMSAID, ZMSAIU, ZMSALD, ZMSALU, ZRSAIA, ZRSAID, ZRSAIE, ZRSAIF, ZRSAIG, ZRSALD, &
278 & ZMULTI, ZMULTL, ZOI   , ZOL, &
279 & ZOMGMX, ZOR, ZRMUZ, ZRWGKG, ZTAUD, ZTAUMX, ZTEMPC, &
280 & ZTOI, ZTOL, ZTOR, ZZFIWP, ZZFLWP, ZDPOG, ZPODT 
281
282REAL(KIND=JPRB) :: ZALND, ZASEA, ZD, ZDEN, ZNTOT, ZNUM, ZRATIO, Z1RADI, &
283 & Z1RADL, ZBETAI, ZOMGI, ZOMGP, ZFDEL, ZTCELS, ZFSR, ZAIWC, &
284 & ZBIWC, ZTBLAY, ZADDPLK, ZPLANCK, ZEXTCF, Z1MOMG, &
285 & ZDefRe, ZRefDe, ZVI , ZMABSD
286
287!REAL(KIND=JPRB) :: ZAVDP(KLON), ZAVTO(KLON), ZSQTO(KLON)
288REAL(KIND=JPRB) :: ZAVTO(KLON), ZSQTO(KLON)
289REAL(KIND=JPRB) :: ZSQUAR(KLON,KLEV), ZVARIA(KLON,KLEV)
290INTEGER(KIND=JPIM) :: IKI, JKI, JEXPLR, JXPLDN
291LOGICAL         :: LLDEBUG
292
293
294REAL(KIND=JPRB) :: ZHOOK_HANDLE
295
296#include "lw.intfb.h"
297#include "rrtm_rrtm_140gp.intfb.h"
298#include "sw.intfb.h"
299
300!     -----------------------------------------------------------------
301
302!*         1.     SET-UP INPUT QUANTITIES FOR RADIATION
303!                 -------------------------------------
304
305IF (LHOOK) CALL DR_HOOK('RADLSW',0,ZHOOK_HANDLE)
306
307LLDEBUG=.FALSE.
308ZRefDe = RRe2De
309ZDefRe = 1.0_JPRB / ZRefDe
310
311DO JL = KIDIA,KFDIA
312  ZFCUP(JL,KLEV+1) = 0.0_JPRB
313  ZFCDWN(JL,KLEV+1) = REPLOG
314  ZFSUP(JL,KLEV+1) = 0.0_JPRB
315  ZFSDWN(JL,KLEV+1) = REPLOG
316  PFLUX(JL,1,KLEV+1) = 0.0_JPRB
317  PFLUX(JL,2,KLEV+1) = 0.0_JPRB
318  PFLUC(JL,1,KLEV+1) = 0.0_JPRB
319  PFLUC(JL,2,KLEV+1) = 0.0_JPRB
320  ZFSDNN(JL) = 0.0_JPRB
321  ZFSDNV(JL) = 0.0_JPRB
322  ZFCDNN(JL) = 0.0_JPRB
323  ZFCDNV(JL) = 0.0_JPRB
324  ZFSUPN(JL) = 0.0_JPRB
325  ZFSUPV(JL) = 0.0_JPRB
326  ZFCUPN(JL) = 0.0_JPRB
327  ZFCUPV(JL) = 0.0_JPRB
328  ZPSOL(JL) = PAPH(JL,KLEV+1)
329  ZPMB(JL,1) = ZPSOL(JL) / 100.0_JPRB
330  ZDT0(JL) = PTS(JL) - PTH(JL,KLEV+1)
331  PSUDU(JL) = 0.0_JPRB
332  PPARF(JL) = 0.0_JPRB
333  PPARCF(JL)= 0.0_JPRB
334  PUVDF(JL) = 0.0_JPRB
335  PSFSWDIR(JL,:)=0.0_JPRB
336  PSFSWDIF(JL,:)=0.0_JPRB
337  IBAS(JL) = INT ( 0.01_JPRB + PNBAS(JL) )
338  ITOP(JL) = INT ( 0.01_JPRB + PNTOP(JL) )
339ENDDO
340
341!*         1.1    INITIALIZE VARIOUS FIELDS
342!                 -------------------------
343
344DO JSW=1,NSW
345  DO JL = KIDIA,KFDIA
346    ZALBD(JL,JSW)=PALBD(JL,JSW)
347    ZALBP(JL,JSW)=PALBP(JL,JSW)
348  ENDDO
349ENDDO
350DO JL = KIDIA,KFDIA
351  ZEMIS(JL)  =PEMIS(JL)
352  ZEMIW(JL)  =PEMIW(JL)
353  ZMU0(JL)   =PMU0(JL)
354ENDDO
355
356DO JK = 1 , KLEV
357  JKP1 = JK + 1
358  JKL = KLEV+ 1 - JK
359  JKLP1 = JKL + 1
360  DO JL = KIDIA,KFDIA
361    ZPMB(JL,JK+1)=PAPH(JL,JKL)/100.0_JPRB
362
363!-- ZOZ in cm.atm for SW scheme   
364    ZOZ(JL,JK)   = POZON(JL,JKL) * 46.6968_JPRB / RG
365
366    ZCLD0(JL,JK) = 0.0_JPRB
367    ZFCUP(JL,JK) = 0.0_JPRB
368    ZFCDWN(JL,JK) = 0.0_JPRB
369    ZFSUP(JL,JK) = 0.0_JPRB
370    ZFSDWN(JL,JK) = 0.0_JPRB
371    PFLUX(JL,1,JK) = 0.0_JPRB
372    PFLUX(JL,2,JK) = 0.0_JPRB
373    PFLUC(JL,1,JK) = 0.0_JPRB
374    PFLUC(JL,2,JK) = 0.0_JPRB
375  ENDDO
376ENDDO
377
378DO JK=1,KLEV
379  JKL=KLEV+1-JK
380  JKLP1=JKL+1
381  DO JL=KIDIA,KFDIA
382    ZTL(JL,JK)=PTH(JL,JKLP1)
383    ZTAVE(JL,JK)=PT(JL,JKL)
384  ENDDO
385ENDDO
386DO JL=KIDIA,KFDIA
387  ZTL(JL,KLEV+1)= PTH(JL,1)
388  ZPMB(JL,KLEV+1) = PAPH(JL,1)/100.0_JPRB
389ENDDO
390!***
391
392!     ------------------------------------------------------------------
393
394!*         2.     CLOUD AND AEROSOL PARAMETERS
395!                 ----------------------------
396
397DO JK = 1 , KLEV
398  IKL = KLEV + 1 - JK
399
400!          2.1    INITIALIZE OPTICAL PROPERTIES TO CLEAR SKY VALUES
401!                 -------------------------------------------------
402
403  DO JSW = 1,NSW
404    DO JL = KIDIA,KFDIA
405      ZTAU(JL,JSW,JK)  = 0.0_JPRB
406      ZOMEGA(JL,JSW,JK)= 1.0_JPRB
407      ZCG(JL,JSW,JK)   = 0.0_JPRB
408    ENDDO
409  ENDDO
410  DO JL = KIDIA,KFDIA
411    ZCLDSW(JL,JK)  = 0.0_JPRB
412    ZCLDLD(JL,JK)  = 0.0_JPRB
413    ZCLDLU(JL,JK)  = 0.0_JPRB
414  ENDDO
415
416!          2.2    CLOUD ICE AND LIQUID CONTENT AND PATH
417!                 -------------------------------------
418
419  DO JL = KIDIA,KFDIA
420
421! --- LIQUID WATER CONTENT (g.m-3) AND LIQUID WATER PATH (g.m-2)
422    IF (PCLFR(JL,IKL) > REPSC ) THEN
423      ZLWGKG=MAX(PQLWP(JL,IKL)*1000.0_JPRB,0.0_JPRB)
424      ZIWGKG=MAX(PQIWP(JL,IKL)*1000.0_JPRB,0.0_JPRB)
425      ZLWGKG=ZLWGKG/PCLFR(JL,IKL)
426      ZIWGKG=ZIWGKG/PCLFR(JL,IKL)
427    ELSE
428      ZLWGKG=0.0_JPRB
429      ZIWGKG=0.0_JPRB
430    ENDIF
431    ZRWGKG=0.0_JPRB
432    ZRAINT(JL)=0.0_JPRB
433
434! --- RAIN LIQUID WATER CONTENT (g.m-3) AND LIQUID WATER PATH (g.m-2)
435!    IF (PRAINT(JL,IKL) >= REPSCW) THEN
436!      ZRWGKG=MAX(PQRAIN(JL,IKL)*1000., 0.0)
437!      ZRAINT(JL)=PRAINT(JL,IKL)*3600.*1000.
438!- no radiative effect of rain (for the moment)
439!      ZRWGKG=0.
440!      ZRAINT(JL)=0.
441! ===========================================================
442
443! Modifications Martin et al.
444!    ELSE
445!    ENDIF
446    ZDPOG=PDP(JL,IKL)/RG
447    ZFLWP(JL)= ZLWGKG*ZDPOG
448    ZFIWP(JL)= ZIWGKG*ZDPOG
449    ZFRWP(JL)= ZRWGKG*ZDPOG
450    ZPODT=PAP(JL,IKL)/(RD*PT(JL,IKL))
451    ZLWC(JL)=ZLWGKG*ZPODT
452    ZIWC(JL)=ZIWGKG*ZPODT
453!    ZRWC(JL)=ZRWGKG*ZPODT
454
455  ENDDO
456  DO JL = KIDIA,KFDIA
457! --- EFFECTIVE RADIUS FOR WATER, ICE AND RAIN PARTICLES
458
459! very old parametrization as f(pressure)
460
461    IF (NRADLP == 0) THEN
462!-- very old parametrization as f(pressure) ERA-15
463      ZRADLP(JL)=10.0_JPRB + (100000.0_JPRB-PAP(JL,IKL))*3.5_JPRB
464
465    ELSEIF (NRADLP == 1) THEN
466! simple distinction between land (10) and ocean (13) Zhang and Rossow
467      IF (PLSM(JL) < 0.5_JPRB) THEN
468        ZRADLP(JL)=13.0_JPRB
469      ELSE
470        ZRADLP(JL)=10.0_JPRB
471      ENDIF
472     
473    ELSEIF (NRADLP == 2) THEN
474!--  based on Martin et al., 1994, JAS
475      IF (PLSM(JL) < 0.5_JPRB) THEN
476        IF (LCCNO) THEN
477!          ZASEA=50.0_JPRB
478          ZASEA=PCCNO(JL)
479        ELSE 
480          ZASEA=RCCNSEA
481        ENDIF 
482        ZD=0.33_JPRB
483        ZNTOT=-1.15E-03_JPRB*ZASEA*ZASEA+0.963_JPRB*ZASEA+5.30_JPRB
484      ELSE
485        IF (LCCNL) THEN
486!          ZALND=900.0_JPRB
487          ZALND=PCCNL(JL)
488        ELSE 
489          ZALND=RCCNLND
490        ENDIF 
491        ZD=0.43_JPRB
492        ZNTOT=-2.10E-04_JPRB*ZALND*ZALND+0.568_JPRB*ZALND-27.9_JPRB
493      ENDIF
494      ZNUM=3.0_JPRB*ZLWC(JL)*(1.0_JPRB+3.0_JPRB*ZD*ZD)**2
495      ZDEN=4.0_JPRB*RPI*ZNTOT*(1.0_JPRB+ZD*ZD)**3
496      IF((ZNUM/ZDEN) > REPLOG)THEN
497        ZRADLP(JL)=100.0_JPRB*EXP(0.333_JPRB*LOG(ZNUM/ZDEN))
498        ZRADLP(JL)=MAX(ZRADLP(JL), 4.0_JPRB)
499        ZRADLP(JL)=MIN(ZRADLP(JL),16.0_JPRB)
500      ELSE
501        ZRADLP(JL)=4.0_JPRB
502      ENDIF
503
504    ELSEIF (NRADLP == 3) THEN 
505! one uses the cloud droplet radius from newmicro
[3539]506! IKL or JK ?? - I think IKL but needs to be verified > ref_liq_i
507! (inverted) is used in the call of RECMWF_AERO in radlwsw_m.F90,
508! so everything is fine - JBM 6/2019
[1989]509        ZRADLP(JL)=PREF_LIQ(JL,IKL)
510    ENDIF 
511
512! ===========================================================
513! ___________________________________________________________
514
515! rain drop from          : unused as ZRAINT is 0.
516!    ZRADRD(JL)=500.0_JPRB*ZRAINT(JL)**0.22_JPRB
517!    IF (ZFLWP(JL).GT.0.) THEN
518!      ZRADRD(JL)=ZRADLP(JL)+ZRADRD(JL)
519!    ENDIF   
520
521  ENDDO
522  DO JL = KIDIA,KFDIA
523
524! diagnosing the ice particle effective radius/diameter
525
526!- ice particle effective radius =f(T) from Liou and Ou (1994)
527 
528    IF (PT(JL,IKL) < RTICE) THEN
529      ZTEMPC=PT(JL,IKL)-RTT
530    ELSE
531      ZTEMPC=RTICE-RTT
532    ENDIF
533    ZRADIP(JL)=326.3_JPRB+ZTEMPC*(12.42_JPRB + ZTEMPC*(0.197_JPRB + ZTEMPC*&
534      & 0.0012_JPRB))   
535
536    IF (NRADIP == 0) THEN
537!-- fixed 40 micron effective radius
538      ZRADIP(JL)= 40.0_JPRB
539      ZDESR(JL) = ZDefRe * ZRADIP(JL)
540     
541    ELSEIF (NRADIP == 1) THEN
542
543!-- old formulation based on Liou & Ou (1994) temperature (40-130microns)   
544      ZRADIP(JL)=MAX(ZRADIP(JL),40.0_JPRB)
545      ZDESR(JL) = ZDefRe * ZRADIP(JL)
546     
547    ELSEIF (NRADIP == 2) THEN 
548!-- formulation following Jakob, Klein modifications to ice content   
549      ZRADIP(JL)=MAX(ZRADIP(JL),30.0_JPRB)
550      ZRADIP(JL)=MIN(ZRADIP(JL),60.0_JPRB)
551      ZDESR(JL)= ZDefRe * ZRADIP(JL)
552 
553    ELSEIF (NRADIP == 3  ) THEN
554 
555!- ice particle effective radius =f(T,IWC) from Sun and Rikus (1999)
556! revised by Sun (2001)
557      IF (ZIWC(JL) > 0.0_JPRB ) THEN
558        ZTEMPC = PT(JL,IKL)-83.15_JPRB
559        ZTCELS = PT(JL,IKL)-RTT
560        ZFSR = 1.2351_JPRB +0.0105_JPRB * ZTCELS
561! Sun, 2001 (corrected from Sun & Rikus, 1999)
562        ZAIWC = 45.8966_JPRB * ZIWC(JL)**0.2214_JPRB
563        ZBIWC = 0.7957_JPRB * ZIWC(JL)**0.2535_JPRB
564        ZDESR(JL) = ZFSR * (ZAIWC + ZBIWC*ZTEMPC)
565!-new        ZDESR(JL) = MIN ( MAX( ZDESR(JL), 30.0_JPRB), 155.0_JPRB)
566        ZDESR(JL) = MIN ( MAX( ZDESR(JL), 45.0_JPRB), 350.0_JPRB)
567        ZRADIP(JL)= ZRefDe * ZDESR(JL)
568      ELSE
569!        ZDESR(JL) = 92.5_JPRB
570        ZDESR(JL) = 80.0_JPRB
571        ZRADIP(JL)= ZRefDe * ZDESR(JL)
572      ENDIF 
573 
574    ELSEIF (NRADIP == 4  ) THEN
575! one uses the cloud droplet radius from newmicro
576! IKL or JK ?? - I think IKL but needs to be verified
577        ZRADIP(JL)=PREF_ICE(JL,IKL)
578    ENDIF 
579   
580  ENDDO
581
582!          2.3    CLOUD SHORTWAVE OPTICAL PROPERTIES
583!                 ----------------------------------
584
585!   -------------------------
586! --+ SW OPTICAL PARAMETERS +  Water clouds after Fouquart (1987)
587!   -------------------------  Ice clouds (Ebert, Curry, 1992)
588
589  DO JSW=1,NSW
590    DO JL = KIDIA,KFDIA
591      ZTOL=0.0_JPRB
592      ZGL =0.0_JPRB
593      ZOL =0.0_JPRB
594      ZTOI=0.0_JPRB
595      ZGI =0.0_JPRB
596      ZOI =0.0_JPRB
597      ZTOR=0.0_JPRB
598      ZGR =0.0_JPRB
599      ZOR =0.0_JPRB
600      IF (ZFLWP(JL)+ZFIWP(JL)+ZFRWP(JL) > 2.0_JPRB * REPSCW ) THEN
601        IF (ZFLWP(JL) >= REPSCW ) THEN
602          IF (NLIQOPT /= 0 ) THEN
603!-- SW: Slingo, 1989
604            ZTOL = ZFLWP(JL)*(RASWCA(JSW)+RASWCB(JSW)/ZRADLP(JL))
605            ZGL  = RASWCE(JSW)+RASWCF(JSW)*ZRADLP(JL)
606            ZOL  = 1. - RASWCC(JSW)-RASWCD(JSW)*ZRADLP(JL)
607          ELSE         
608!-- SW: Fouquart, 1991
609            ZTOL = ZFLWP(JL)*(RYFWCA(JSW)+RYFWCB(JSW)/ZRADLP(JL))
610            ZGL  = RYFWCF(JSW)
611!            ZOL  = RYFWCC(JSW)-RYFWCD(JSW)*EXP(-RYFWCE(JSW)*ZTOL)
612!-- NB: RSWINHF is there simply for making the CY29R2 branch bit compatible with
613! the previous. Should be cleaned when RRTM_SW becomes active
614            ZOL  = RYFWCC(JSW)-RYFWCD(JSW)*EXP(-RYFWCE(JSW)*ZTOL*RSWINHF)
615          ENDIF
616        ENDIF
617
618        IF (ZFIWP(JL) >= REPSCW ) THEN
619          IF (NICEOPT <= 1) THEN
620!-- SW: Ebert-Curry         
621            ZTOI = ZFIWP(JL)*(REBCUA(JSW)+REBCUB(JSW)/ZRADIP(JL))
622            ZGI  = REBCUE(JSW)+REBCUF(JSW)*ZRADIP(JL)
623            ZOI  = 1.0_JPRB - REBCUC(JSW)-REBCUD(JSW)*ZRADIP(JL)
624           
625          ELSEIF (NICEOPT == 2) THEN 
626!-- SW: Fu-Liou 1993
627            Z1RADI = 1.0_JPRB / ZDESR(JL)
628            ZBETAI = RFLAA0(JSW)+Z1RADI* RFLAA1(JSW)
629            ZTOI = ZFIWP(JL) * ZBETAI
630            ZOMGI= RFLBB0(JSW)+ZRADIP(JL)*(RFLBB1(JSW) + ZRADIP(JL) &
631             & *(RFLBB2(JSW)+ZRADIP(JL)* RFLBB3(JSW) ))             
632            ZOI  = 1.0_JPRB - ZOMGI
633            ZOMGP= RFLCC0(JSW)+ZRADIP(JL)*(RFLCC1(JSW) + ZRADIP(JL) &
634             & *(RFLCC2(JSW)+ZRADIP(JL)* RFLCC3(JSW) ))   
635            ZFDEL= RFLDD0(JSW)+ZRADIP(JL)*(RFLDD1(JSW) + ZRADIP(JL) &
636             & *(RFLDD2(JSW)+ZRADIP(JL)* RFLDD3(JSW) ))   
637            ZGI  = ((1.0_JPRB -ZFDEL)*ZOMGP + ZFDEL*3.0_JPRB) / 3.0_JPRB
638           
639          ELSEIF (NICEOPT == 3) THEN 
640!-- SW: Fu 1996
641            Z1RADI = 1.0_JPRB / ZDESR(JL)
642            ZBETAI = RFUAA0(JSW)+Z1RADI* RFUAA1(JSW)
643            ZTOI = ZFIWP(JL) * ZBETAI
644            ZOMGI= RFUBB0(JSW)+ZDESR(JL)*(RFUBB1(JSW) + ZDESR(JL) &
645             &   *(RFUBB2(JSW)+ZDESR(JL)* RFUBB3(JSW) ))           
646            ZOI  = 1.0_JPRB - ZOMGI
647            ZGI  = RFUCC0(JSW)+ZDESR(JL)*(RFUCC1(JSW) + ZDESR(JL) &
648             &   *(RFUCC2(JSW)+ZDESR(JL)* RFUCC3(JSW) ))
649            ZGI  = MIN(1.0_JPRB, ZGI)
650     
651          ENDIF
652        ENDIF
653
654!        IF (ZFRWP(JL) >= REPSCW ) THEN
655!          ZTOR= ZFRWP(JL)*0.003_JPRB * ZRAINT(JL)**(-0.22_JPRB)         
656!          ZOR = 1.0_JPRB - RROMA(JSW)*ZRAINT(JL)**RROMB(JSW)
657!          ZGR = RRASY(JSW)
658!        ENDIF   
659
660!  - MIX of WATER and ICE CLOUDS
661        ZTAUMX= ZTOL + ZTOI + ZTOR
662        ZOMGMX= ZTOL*ZOL + ZTOI*ZOI + ZTOR*ZOR
663        ZASYMX= ZTOL*ZOL*ZGL + ZTOI*ZOI*ZGI + ZTOR*ZOR*ZGR
664
665        ZASYMX= ZASYMX/ZOMGMX
666        ZOMGMX= ZOMGMX/ZTAUMX
667
668! --- SW FINAL CLOUD OPTICAL PARAMETERS
669
670        ZCLDSW(JL,JK)  = PCLFR(JL,IKL)
671        ZTAU(JL,JSW,JK)  = ZTAUMX
672        ZOMEGA(JL,JSW,JK)= ZOMGMX
673        ZCG(JL,JSW,JK)   = ZASYMX
674      ENDIF
675    ENDDO
676  ENDDO
677
678  IF(LLDEBUG) THEN
679   call writefield_phy("radlsw_ztau",ztau(:,1,:),klev)
680  ENDIF
681
682!          2.4    CLOUD LONGWAVE OPTICAL PROPERTIES FOR EC-OPE
683!                 --------------------------------------------
684
685!   -------------------------
686! --+ LW OPTICAL PARAMETERS +  Water (and Ice) from Smith and Shi (1992)
687!   -------------------------  Ice clouds (Ebert, Curry, 1992)
688
689  IF (.NOT.LRRTM) THEN
690
691    DO JL = KIDIA,KFDIA
692      ZALFICE(JL)=0.0_JPRB
693      ZGAMICE(JL)=0.0_JPRB
694      ZBICE(JL)=0.0_JPRB
695      ZTICE(JL)=(PT(JL,IKL)-TSTAND)/TSTAND
696      IF (NICEOPT == 1) THEN
697        ZBICFU(JL)=1.0_JPRB
698      ELSE
699        ZBICFU(JL)=0.0_JPRB
700      ENDIF
701      ZKICFU(JL)=0.0_JPRB
702    ENDDO
703   
704    DO JNU= 1,NSIL
705      DO JL = KIDIA,KFDIA
706        ZRES(JL)  = XP(1,JNU)+ZTICE(JL)*(XP(2,JNU)+ZTICE(JL)*(XP(3,&
707         & JNU)&
708         & +ZTICE(JL)*(XP(4,JNU)+ZTICE(JL)*(XP(5,JNU)+ZTICE(JL)*(XP(6,&
709         & JNU)&
710         & ))))) 
711        ZBICE(JL) = ZBICE(JL) + ZRES(JL)
712        ZGAMICE(JL) = ZGAMICE(JL) + REBCUI(JNU)*ZRES(JL)
713        ZALFICE(JL) = ZALFICE(JL) + REBCUJ(JNU)*ZRES(JL)
714      ENDDO
715    ENDDO
716   
717!-- Fu et al. (1998) with M'91 LW scheme   
718    IF (NICEOPT == 2 .OR. NICEOPT == 3) THEN
719      DO JRTM=1,16
720        DO JL=KIDIA,KFDIA
721          IF (PT(JL,IKL) < 160.0_JPRB) THEN
722            INDLAY=1
723            ZTBLAY =PT(JL,IKL)-160.0_JPRB
724          ELSEIF (PT(JL,IKL) < 339.0_JPRB ) THEN
725            INDLAY=PT(JL,IKL)-159.0_JPRB
726            INDLAY=MAX(INDLAY,1)
727            ZTBLAY =PT(JL,IKL)-INT(PT(JL,IKL))
728          ELSE
729            INDLAY=180
730            ZTBLAY =PT(JL,IKL)-339.0_JPRB
731          ENDIF
732          ZADDPLK = TOTPLNK(INDLAY+1,JRTM)-TOTPLNK(INDLAY,JRTM)
733          ZPLANCK = DELWAVE(JRTM) * (TOTPLNK(INDLAY,JRTM) + ZTBLAY*ZADDPLK)
734          ZBICFU(JL) = ZBICFU(JL) + ZPLANCK
735       
736          IF (ZIWC(JL) > 0.0_JPRB ) THEN
737            ZRATIO =  1.0_JPRB / ZDESR(JL)
738            IF (NICEOPT == 2) THEN
739! ice cloud spectral emissivity a la Fu & Liou (1993)
740              ZMABSD = RFULIO(JRTM,1) + ZRATIO &
741               & *(RFULIO(JRTM,2) + ZRATIO*RFULIO(JRTM,3)) 
742         
743! ice cloud spectral emissivity a la Fu et al (1998)
744            ELSEIF (NICEOPT == 3) THEN
745              ZMABSD = RFUETA(JRTM,1) + ZRATIO &
746               & *(RFUETA(JRTM,2) + ZRATIO*RFUETA(JRTM,3)) 
747            ENDIF
748            ZKICFU(JL) = ZKICFU(JL)+ ZMABSD*ZPLANCK
749          ENDIF 
750        ENDDO
751      ENDDO
752    ENDIF
753   
754    DO JL = KIDIA,KFDIA
755      ZGAMICE(JL) = ZGAMICE(JL) / ZBICE(JL)
756      ZALFICE(JL) = ZALFICE(JL) / ZBICE(JL)
757      ZKICFU(JL)  = ZKICFU(JL) / ZBICFU(JL)
758     
759      IF (ZFLWP(JL)+ZFIWP(JL) > REPSCW) THEN
760
761        IF (NLIQOPT == 0) THEN
762! water cloud emissivity a la Smith & Shi (1992)
763          ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL)
764          ZMSALD= 0.158_JPRB*ZMULTL
765          ZMSALU= 0.130_JPRB*ZMULTL
766         
767        ELSE
768! water cloud emissivity a la Savijarvi (1997)
769          ZMSALU= 0.2441_JPRB-0.0105_JPRB*ZRADLP(JL)
770          ZMSALD= 1.2154_JPRB*ZMSALU
771         
772        ENDIF 
773         
774        IF (NICEOPT == 0) THEN         
775! ice cloud emissivity a la Smith & Shi (1992)
776          ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL)
777          ZMSAID= 0.113_JPRB*ZMULTI
778          ZMSAIU= 0.093_JPRB*ZMULTI
779
780        ELSEIF (NICEOPT == 1) THEN
781! ice cloud emissivity a la Ebert & Curry (1992)
782          ZMSAID= 1.66_JPRB*(ZALFICE(JL)+ZGAMICE(JL)/ZRADIP(JL))
783          ZMSAIU= ZMSAID
784         
785        ELSEIF (NICEOPT == 2 .OR. NICEOPT == 3) THEN 
786! ice cloud emissivity a la Fu & Liou (1993) or Fu et al. (1998)
787          ZMSAID= 1.66_JPRB*ZKICFU(JL)
788          ZMSAIU= ZMSAID         
789        ENDIF
790       
791        IF (NINHOM == 1) THEN
792          ZZFLWP= ZFLWP(JL) * RLWINHF
793          ZZFIWP= ZFIWP(JL) * RLWINHF
794        ELSE
795          ZZFLWP= ZFLWP(JL)
796          ZZFIWP= ZFIWP(JL)
797        ENDIF
798
799! effective cloudiness accounting for condensed water
800        ZCLDLD(JL,JK) = PCLFR(JL,IKL)*(1.0_JPRB-EXP(-ZMSALD*ZZFLWP-ZMSAID* &
801         & ZZFIWP)) 
802        ZCLDLU(JL,JK) = PCLFR(JL,IKL)*(1.0_JPRB-EXP(-ZMSALU*ZZFLWP-ZMSAIU* &
803         & ZZFIWP)) 
804      ENDIF
805    ENDDO
806
807  ELSE
808
809!          2.5    CLOUD LONGWAVE OPTICAL PROPERTIES FOR RRTM
810!                 ------------------------------------------
811
812!   -------------------------
813! --+ LW OPTICAL PARAMETERS +  Water (and Ice) from Savijarvi (1998)
814!   -------------------------  Ice clouds (Ebert, Curry, 1992)
815
816! No need for a fixed diffusivity factor, accounted for spectrally below
817! The detailed spectral structure does not require defining upward and
818! downward effective optical properties
819
820    DO JRTM=1,16
821      DO JL = KIDIA,KFDIA
822        ZTAUCLD(JL,JK,JRTM) = 0.0_JPRB
823        ZMSALD = 0.0_JPRB
824        ZMSAID = 0.0_JPRB
825       
826        IF (ZFLWP(JL)+ZFIWP(JL) > REPSCW) THEN
827   
828          IF (NLIQOPT == 0 .OR. NLIQOPT >= 3 ) THEN
829! water cloud total emissivity a la Smith and Shi (1992)
830            ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL)
831            ZRSALD= 0.144_JPRB*ZMULTL / 1.66_JPRB
832           
833          ELSEIF (NLIQOPT == 1) THEN
834! water cloud spectral emissivity a la Savijarvi (1997)
835            ZRSALD= RHSAVI(JRTM,1) + ZRADLP(JL)&
836             & *(RHSAVI(JRTM,2) + ZRADLP(JL)*RHSAVI(JRTM,3)) 
837             
838          ELSEIF (NLIQOPT == 2) THEN
839! water cloud spectral emissivity a la Lindner and Li (2000)
840            Z1RADL = 1.0_JPRB / ZRADLP(JL)
841            ZEXTCF = RLILIA(JRTM,1)+ZRADLP(JL)*RLILIA(JRTM,2)+ Z1RADL*&
842             & (RLILIA(JRTM,3) + Z1RADL*(RLILIA(JRTM,4) + Z1RADL*&
843             & RLILIA(JRTM,5) )) 
844            Z1MOMG = RLILIB(JRTM,1) + Z1RADL*RLILIB(JRTM,2) &
845             & + ZRADLP(JL) *(RLILIB(JRTM,3) + ZRADLP(JL)*RLILIB(JRTM,4) )
846            ZRSALD = Z1MOMG * ZEXTCF
847          ENDIF 
848         
849          IF (NICEOPT == 0) THEN
850! ice cloud spectral emissivity a la Smith & Shi (1992)
851            ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL)
852            ZRSAID= 0.103_JPRB*ZMULTI / 1.66_JPRB
853           
854          ELSEIF (NICEOPT == 1) THEN
855! ice cloud spectral emissivity a la Ebert-Curry (1992)
856            ZRSAID= REBCUH(JRTM)+REBCUG(JRTM)/ZRADIP(JL)
857           
858          ELSEIF (NICEOPT == 2) THEN
859! ice cloud spectral emissivity a la Fu & Liou (1993)
860            Z1RADI = 1.0_JPRB / ZDESR(JL)
861            ZRSAID = RFULIO(JRTM,1) + Z1RADI &
862             & *(RFULIO(JRTM,2) + Z1RADI * RFULIO(JRTM,3)) 
863             
864          ELSEIF (NICEOPT == 3) THEN
865! ice cloud spectral emissivity a la Fu et al (1998) including
866! parametrisation for LW scattering effect 
867            Z1RADI = 1.0_JPRB / ZDESR(JL)
868            ZRSAIE = RFUETA(JRTM,1) + Z1RADI &
869             &*(RFUETA(JRTM,2) + Z1RADI * RFUETA(JRTM,3))
870            ZRSAIA = Z1RADI*(RFUETB(JRTM,1) +ZDESR(JL)*( RFUETB(JRTM,2) +ZDESR(JL)*( RFUETB(JRTM,3) +ZDESR(JL)* RFUETB(JRTM,4))))
871            ZRSAIG = RFUETC(JRTM,1) +ZDESR(JL)*( RFUETC(JRTM,2) +ZDESR(JL)*( RFUETC(JRTM,3) +ZDESR(JL)* RFUETC(JRTM,4)))
872            ZRSAIF = 0.5_JPRB + ZRSAIG*( 0.3738_JPRB + ZRSAIG*( 0.0076_JPRB + ZRSAIG*0.1186_JPRB ) )
873            ZRSAID = (1.0_JPRB - ZRSAIA/ZRSAIE * ZRSAIF) * ZRSAIE
874          ENDIF   
875         
876          ZTAUD = ZRSALD*ZFLWP(JL)+ZRSAID*ZFIWP(JL)
877
878! Diffusivity correction within clouds a la Savijarvi
879          IF (LDIFFC) THEN
880            ZDIFFD=MIN(MAX(1.517_JPRB-0.156_JPRB*LOG(ZTAUD) , 1.0_JPRB), &
881             &     2.0_JPRB)
882          ELSE
883            ZDIFFD=1.66_JPRB
884          ENDIF
885
886          ZTAUCLD(JL,JK,JRTM) = ZTAUD*ZDIFFD
887        ENDIF
888       
889      ENDDO
890    ENDDO
891
892  ENDIF
893
894ENDDO
895
896NUAER = NUA
897NTRAER = NTRA
898
899!     ------------------------------------------------------------------
900!
901!          2.6    SCALING OF OPTICAL THICKNESS
902!                 SPECTRALLY, ACCOUNTING FOR VERTICAL VARIABILITY
903
904JEXPLR=NLAYINH
905JXPLDN=2*JEXPLR+1
906
907IF (NINHOM == 1) THEN
908!-- simple scaling a la Tiedtke (1996) with RSWINHF in SW and RLWINHF in LW
909  DO JSW=1,NSW
910    DO JK=1,KLEV
911      DO JL=KIDIA,KFDIA
912        ZTAU(JL,JSW,JK)=ZTAU(JL,JSW,JK) * RSWINHF
913      ENDDO
914    ENDDO
915  ENDDO
916
917  DO JRTM=1,16
918    DO JK=1,KLEV
919      DO JL=KIDIA,KFDIA
920        ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM) * RLWINHF
921      ENDDO
922    ENDDO
923  ENDDO
924
925ELSEIF (JEXPLR /= 0) THEN
926  DO JSW=1,NSW
927    DO JK=1,KLEV
928      DO JL=KIDIA,KFDIA
929        ZSQUAR(JL,JK)=0.0_JPRB
930        ZVARIA(JL,JK)=1.0_JPRB
931      ENDDO
932    ENDDO
933!-- range should be defined from Hogan & Illingworth
934    DO JK=1+JEXPLR,KLEV-JEXPLR
935      DO JL=KIDIA,KFDIA
936!        ZAVDP(JL)=0.0_JPRB
937        ZAVTO(JL)=0.0_JPRB
938        ZSQTO(JL)=0.0_JPRB
939      ENDDO
940      DO JKI=JK-JEXPLR,JK+JEXPLR
941        IKI=KLEV+1-JKI
942        DO JL=KIDIA,KFDIA
943!          ZAVDP(JL)=ZAVDP(JL)+PDP(JL,IKI)/RG
944          ZAVTO(JL)=ZAVTO(JL)+ZTAU(JL,JSW,JKI)
945        ENDDO
946      ENDDO
947      DO JL=KIDIA,KFDIA
948!        ZAVTO(JL)=ZAVTO(JL)/ZAVDP(JL)
949        ZAVTO(JL)=ZAVTO(JL)/JXPLDN
950      ENDDO
951      DO JKI=JK-JEXPLR,JK+JEXPLR
952        IKI=KLEV+1-JKI
953        DO JL=KIDIA,KFDIA
954!          ZSQTO(JL)=ZSQTO(JL)+(ZTAU(JL,JSW,JKI)/PDP(JL,IKI)-ZAVTO(JL))**2
955          ZSQTO(JL)=ZSQTO(JL)+(ZTAU(JL,JSW,JKI)-ZAVTO(JL))**2
956        ENDDO
957      ENDDO
958      DO JL=KIDIA,KFDIA
959        ZSQTO(JL)=SQRT(ZSQTO(JL)/(JXPLDN*(JXPLDN-1)))
960        IF (ZAVTO(JL) > 0.0_JPRB) THEN
961          ZVARIA(JL,JK)=(ZSQTO(JL)/ZAVTO(JL))**2
962          ZSQUAR(JL,JK)=EXP(-ZVARIA(JL,JK))
963        ELSE
964          ZVARIA(JL,JK)=0.0_JPRB
965          ZSQUAR(JL,JK)=1.0_JPRB
966        ENDIF
967
968!-- scaling a la Barker
969        IF (NINHOM ==2) THEN
970          ZTAU(JL,JSW,JK)=ZTAU(JL,JSW,JK)*ZSQUAR(JL,JK)
971
972!-- scaling a la Cairns et al.
973        ELSEIF (NINHOM == 3) THEN
974          ZVI=ZVARIA(JL,JK)
975          ZTAU(JL,JSW,JK)  = ZTAU(JL,JSW,JK)/(1.0_JPRB+ZVI)
976          ZOMEGA(JL,JSW,JK)= ZOMEGA(JL,JSW,JK) &
977            &   /(1.0_JPRB + ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK) ) )
978          ZCG(JL,JSW,JK)   = ZCG(JL,JSW,JK) &
979            & *(1.0_JPRB+ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK))) &
980            & /(1.0_JPRB+ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK)*ZCG(JL,JSW,JK)))
981        ENDIF
982      ENDDO
983!      JL=KIDIA
984!      print 9261,JSW,JK,ZTAU(JL,JSW,JK),ZAVTO(JL),ZSQTO(JL),ZVARIA(JL,JK),ZSQUAR(JL,JK)
9859261   format(1x,'Varia1 ',2I3,7F10.4)
986    ENDDO
987  ENDDO
988
989
990  DO JRTM=1,16
991    DO JK=1,KLEV
992      DO JL=KIDIA,KFDIA
993        ZSQUAR(JL,JK)=0.0_JPRB
994        ZVARIA(JL,JK)=1.0_JPRB
995      ENDDO
996    ENDDO
997!-- range to be defined from Hogan & Illingworth
998    DO JK=1+JEXPLR,KLEV-JEXPLR
999      DO JL=KIDIA,KFDIA
1000!        ZAVDP(JL)=0.0_JPRB
1001        ZAVTO(JL)=0.0_JPRB
1002        ZSQTO(JL)=0.0_JPRB
1003      ENDDO
1004      DO JKI=JK-JEXPLR,JK+JEXPLR
1005        IKI=KLEV+1-JKI
1006        DO JL=KIDIA,KFDIA
1007!          ZAVDP(JL)=ZAVDP(JL)+PDP(JL,IKI)/RG
1008          ZAVTO(JL)=ZAVTO(JL)+ZTAUCLD(JL,JKI,JRTM)
1009        ENDDO
1010      ENDDO
1011      DO JL=KIDIA,KFDIA
1012!        ZAVTO(JL)=ZAVTO(JL)/ZAVDP(JL)
1013        ZAVTO(JL)=ZAVTO(JL)/JXPLDN
1014      ENDDO
1015      DO JKI=JK-JEXPLR,JK+JEXPLR
1016        IKI=KLEV+1-JKI
1017        DO JL=KIDIA,KFDIA
1018!          ZSQTO(JL)=ZSQTO(JL)+(ZTAUCLD(JL,JKI,JRTM)/PDP(JL,IKI)-ZAVTO(JL))**2
1019            ZSQTO(JL)=ZSQTO(JL)+(ZTAUCLD(JL,JKI,JRTM)-ZAVTO(JL))**2
1020        ENDDO
1021      ENDDO
1022      DO JL=KIDIA,KFDIA
1023        ZSQTO(JL)=SQRT(ZSQTO(JL)/(JXPLDN*(JXPLDN-1)))
1024        IF (ZAVTO(JL) > 0.0_JPRB) THEN
1025          ZVARIA(JL,JK)=(ZSQTO(JL)/ZAVTO(JL))**2
1026          ZSQUAR(JL,JK)=EXP(-ZVARIA(JL,JK))
1027        ELSE
1028          ZVARIA(JL,JK)=0.0_JPRB
1029          ZSQUAR(JL,JK)=1.0_JPRB
1030        ENDIF
1031
1032!-- scaling a la Barker
1033        IF (NINHOM ==2) THEN
1034          ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM)*ZSQUAR(JL,JK)
1035
1036!-- scaling a la Cairns et al.
1037        ELSEIF (NINHOM == 3) THEN
1038          ZVI=ZVARIA(JL,JK)
1039          ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM)/(1.0_JPRB+ZVI)
1040        ENDIF
1041      ENDDO
1042!      JL=KIDIA
1043!      print 9262,JRTM,JK,ZTAUCLD(JL,JK,JRTM),ZAVTO(JL),ZSQTO(JL),ZVARIA(JL,JK),ZSQUAR(JL,JK)
10449262   format(1x,'Varia2 ',2I3,7F10.4)
1045    ENDDO
1046  ENDDO
1047ENDIF
1048
1049
1050
1051!     ------------------------------------------------------------------
1052!
1053!*         2.7    DIFFUSIVITY FACTOR OR SATELLITE VIEWING ANGLE
1054!                 ---------------------------------------------
1055
1056DO JL = KIDIA,KFDIA
1057  ZVIEW(JL) = DIFF
1058ENDDO
1059
1060!     ------------------------------------------------------------------
1061
1062!*         3.     CALL LONGWAVE RADIATION CODE
1063!                 ----------------------------
1064
1065!*         3.1    FULL LONGWAVE RADIATION COMPUTATIONS
1066!                 ------------------------------------
1067
[2192]1068!print *,'RADLSW: LPHYLIN, LRRTM',LPHYLIN, LRRTM
[1989]1069IF (.NOT.LPHYLIN) THEN
1070  IF ( .NOT. LRRTM) THEN
1071
1072    CALL LW &
1073     & ( KIDIA , KFDIA , KLON  , KLEV , KMODE,&
1074     & PCCO2 , ZCLDLD, ZCLDLU,&
1075     & PDP   , ZDT0  , ZEMIS , ZEMIW,&
1076     & ZPMB  , POZON , ZTL,&
1077     & PAER  , ZTAVE , ZVIEW , PQ,&
1078     & ZEMIT , PFLUX , PFLUC &
1079     & ) 
[2192]1080!   print *,'RADLSW: apres CALL LW'
[1989]1081    IF(LLDEBUG) THEN
1082    call writefield_phy('radlsw_flux1',PFLUX(:,1,:),klev+1)
1083    call writefield_phy('radlsw_flux2',PFLUX(:,2,:),klev+1)
1084    call writefield_phy('radlsw_fluc1',PFLUC(:,1,:),klev+1)
1085    call writefield_phy('radlsw_fluc2',PFLUC(:,2,:),klev+1)
1086    ENDIF
1087
1088  ELSE
1089
1090!*         3.2    FULL LONGWAVE RADIATION COMPUTATIONS - RRTM
1091!                 ------------------------------------   ----
1092
1093!  i)  pass ZOZN (ozone mass mixing ratio) to RRTM; remove pressure
1094!      weighting applied to POZON in driverMC (below)
1095!  ii) pass ZEMIS and ZEMIW to RRTM; return ZEMIT from RRTM
1096!  iii)pass ZTAUCLD, cloud optical depths (water+ice) to RRTM,
1097!      computed from equations above
1098!  iv) pass ECRT arrays to RRTM arrays in interface routine ECRTATM
1099!      in module rrtm_ecrt.f
1100
1101    DO JL = KIDIA,KFDIA
1102      DO JK = 1, KLEV
1103        ZOZN(JL,JK) = POZON(JL,JK)/PDP(JL,JK)
1104      ENDDO
1105    ENDDO
1106
[2192]1107!   print *,'RADLSW: avant CALL RRTM_RRTM_140GP,PAP=',PAP(1,:)
[1989]1108    CALL RRTM_RRTM_140GP &
1109     & ( KIDIA , KFDIA , KLON  , KLEV,&
1110     & PAER  , PAPH  , PAP,&
1111     & PTS   , PTH   , PT,&
1112     & ZEMIS , ZEMIW,&
[2146]1113     & PQ    , PCCO2 , ZOZN  ,&
1114     & ZCLDSW  , ZTAUCLD,&
1115     & PTAU_LW,&
1116     & ZEMIT , PFLUX , PFLUC , ZTCLEAR )
[2192]1117!   print *,'RADLSW: apres CALL RRTM_RRTM_140GP'
[1989]1118
1119  ENDIF
1120ELSE
1121  ZEMIT (:)   = 0.0_JPRB
1122  PFLUX(:,:,:)= 0.0_JPRB
1123  PFLUC(:,:,:)= 0.0_JPRB
[2192]1124! print *,'RADLSW: ZEMIT,PFLUX et PFLUC = 0'
[1989]1125ENDIF
1126
1127!     ------------------------------------------------------------------
1128
1129!*         4.     CALL SHORTWAVE RADIATION CODE
1130!                 -----------------------------
1131
1132ZRMUZ=0.0_JPRB
1133DO JL = KIDIA,KFDIA
1134  ZRMUZ = MAX (ZRMUZ, ZMU0(JL))
1135ENDDO
1136
1137IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
1138  WRITE(NULOUT,'(4E15.8)') PRII0,PCCO2,ZPSOL(KIDIA),ZMU0(KIDIA)
1139  WRITE(NULOUT,'("ZALBD ",6E15.8)') (ZALBD(KIDIA,JSW),JSW=1,NSW)
1140  WRITE(NULOUT,'("ZALBP ",6E15.8)') (ZALBP(KIDIA,JSW),JSW=1,NSW)
1141  WRITE(NULOUT,'("PQ    ",10E12.5)') (PQ(KIDIA,JK),JK=1,KLEV)
1142  WRITE(NULOUT,'("PQS   ",10E12.5)') (PQS(KIDIA,JK),JK=1,KLEV)
1143  WRITE(NULOUT,'("PDP   ",10E12.5)') (PDP(KIDIA,JK),JK=1,KLEV)
1144  WRITE(NULOUT,'("ZPMB  ",10E12.5)') (ZPMB(KIDIA,JK),JK=1,KLEV+1)
1145  WRITE(NULOUT,'("ZTAVE ",10E12.5)') (ZTAVE(KIDIA,JK),JK=1,KLEV)
1146  WRITE(NULOUT,'("ZCLDSW",10E12.5)') (ZCLDSW(KIDIA,JK),JK=1,KLEV)
1147  WRITE(NULOUT,'("ZTAU  ",10E12.5)') ((ZTAU(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1148  WRITE(NULOUT,'("ZCG   ",10E12.5)') ((ZCG(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1149  WRITE(NULOUT,'("ZOMEGA",10E12.5)') ((ZOMEGA(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1150  WRITE(NULOUT,'("ZOZ   ",10E12.5)') (ZOZ(KIDIA,JK),JK=1,KLEV)
1151  WRITE(NULOUT,'("PAER  ",10E12.5)') ((PAER(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1152ENDIF
1153
1154IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
1155  WRITE(NULOUT,'(4E15.8)') PRII0,PCCO2,ZPSOL(KIDIA),ZMU0(KIDIA)
1156  WRITE(NULOUT,'("ZALBD ",6E15.8)') (ZALBD(KIDIA,JSW),JSW=1,NSW)
1157  WRITE(NULOUT,'("ZALBP ",6E15.8)') (ZALBP(KIDIA,JSW),JSW=1,NSW)
1158  WRITE(NULOUT,'("PQ    ",10E12.5)') (PQ(KIDIA,JK),JK=1,KLEV)
1159  WRITE(NULOUT,'("PQS   ",10E12.5)') (PQS(KIDIA,JK),JK=1,KLEV)
1160  WRITE(NULOUT,'("PDP   ",10E12.5)') (PDP(KIDIA,JK),JK=1,KLEV)
1161  WRITE(NULOUT,'("ZPMB  ",10E12.5)') (ZPMB(KIDIA,JK),JK=1,KLEV+1)
1162  WRITE(NULOUT,'("ZTAVE ",10E12.5)') (ZTAVE(KIDIA,JK),JK=1,KLEV)
1163  WRITE(NULOUT,'("ZCLDSW",10E12.5)') (ZCLDSW(KIDIA,JK),JK=1,KLEV)
1164  WRITE(NULOUT,'("ZTAU  ",10E12.5)') ((ZTAU(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1165  WRITE(NULOUT,'("ZCG   ",10E12.5)') ((ZCG(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1166  WRITE(NULOUT,'("ZOMEGA",10E12.5)') ((ZOMEGA(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1167  WRITE(NULOUT,'("ZOZ   ",10E12.5)') (ZOZ(KIDIA,JK),JK=1,KLEV)
1168  WRITE(NULOUT,'("PAER  ",10E12.5)') ((PAER(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1169ENDIF
1170CALL SW &
1171 & ( KIDIA , KFDIA , KLON  , KLEV  , KAER,&
1172 & PRII0 , PCCO2 , ZPSOL , ZALBD , ZALBP , PQ   , PQS,&
1173 & ZMU0  , ZCG   , ZCLDSW, PDP   , ZOMEGA, ZOZ  , ZPMB,&
1174 & ZTAU  , ZTAVE , PAER,&
1175 & PFSDN , PFSUP , PFSCDN, PFSCUP,&
1176 & ZFSDNN, ZFSDNV, ZFSUPN, ZFSUPV,&
1177 & ZFCDNN, ZFCDNV, ZFCUPN, ZFCUPV,&
1178 & ZSUDU , ZUVDF , ZPARF ,ZPARCF, ZDIFFS, ZDIRFS, &
1179 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST&
1180   & )
1181PFSDNV=ZFSDNV
1182PFSDNN=ZFSDNN
1183IF (SIZE(PSFSWDIR,2)>1) THEN
1184  PSFSWDIR= ZDIRFS
1185  PSFSWDIF= ZDIFFS
1186ELSE
1187  PSFSWDIR (:,1) = ZFSDNV(:) + ZFSDNN(:)
1188  PSFSWDIF (:,:) = 0.
1189ENDIF
1190
1191IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
1192  WRITE(NULOUT,'("ZFSDWN",10E12.5)') (ZFSDWN(KIDIA,JK),JK=1,KLEV)
1193  WRITE(NULOUT,'("ZFSUP ",10E12.5)') (ZFSUP (KIDIA,JK),JK=1,KLEV)
1194  WRITE(NULOUT,'("ZFCDWN",10E12.5)') (ZFCDWN(KIDIA,JK),JK=1,KLEV)
1195  WRITE(NULOUT,'("ZFCUP ",10E12.5)') (ZFCUP (KIDIA,JK),JK=1,KLEV)
1196  LEDBUG=.FALSE.
1197ENDIF
1198IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
1199  WRITE(NULOUT,'("ZFSDWN",10E12.5)') (ZFSDWN(KIDIA,JK),JK=1,KLEV)
1200  WRITE(NULOUT,'("ZFSUP ",10E12.5)') (ZFSUP (KIDIA,JK),JK=1,KLEV)
1201  WRITE(NULOUT,'("ZFCDWN",10E12.5)') (ZFCDWN(KIDIA,JK),JK=1,KLEV)
1202  WRITE(NULOUT,'("ZFCUP ",10E12.5)') (ZFCUP (KIDIA,JK),JK=1,KLEV)
1203  LEDBUG=.FALSE.
1204ENDIF
1205!     ------------------------------------------------------------------
1206
1207!*         5.     FILL UP THE MODEL NET LW AND SW RADIATIVE FLUXES
1208!                 ------------------------------------------------
1209
1210DO JKL = 1 , KLEV+1
1211  JK = KLEV+1 + 1 - JKL
1212  DO JL = KIDIA,KFDIA
1213    PFLS(JL,JKL) = ZFSDWN(JL,JK) - ZFSUP(JL,JK)
1214    PFLT(JL,JKL) = - PFLUX(JL,1,JK) - PFLUX(JL,2,JK)
1215    PFCS(JL,JKL) = ZFCDWN(JL,JK) - ZFCUP(JL,JK)
1216    PFCT(JL,JKL) = - PFLUC(JL,1,JK) - PFLUC(JL,2,JK)
1217  ENDDO
1218ENDDO
1219
1220DO JL = KIDIA,KFDIA
1221  PFRSOD(JL)=ZFSDWN(JL,1)
1222  PEMIT (JL)=ZEMIT (JL)
1223  PSUDU (JL)=ZSUDU (JL)
1224  PUVDF (JL)=ZUVDF (JL)
1225  PPARF (JL)=ZPARF (JL)
1226  PPARCF(JL)=ZPARCF(JL)
1227  PTINCF(JL)=PRII0 * ZMU0(JL)
1228ENDDO
1229!print 9501,(PUVDF(JL),JL=KIDIA,KFDIA)
12309501 format(1x,'RADLSW PUVDF: ',30f6.1)
1231!print 9502,(PPARF(JL),JL=KIDIA,KFDIA)
12329502 format(1x,'RADLSW PPARF: ',30f6.1)
1233
1234!     --------------------------------------------------------------
1235
1236IF (LHOOK) CALL DR_HOOK('RADLSW',1,ZHOOK_HANDLE)
1237END SUBROUTINE RADLSW
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
Note: See TracBrowser for help on using the repository browser.