GCC Code Coverage Report


Directory: ./
File: rad/radlsw.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 226 467 48.4%
Branches: 122 330 37.0%

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