GCC Code Coverage Report

Directory: ./
File: rad/recmwf_aero.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 166 349 47.6%
Branches: 227 818 27.8%
Line Branch Exec Source
1 !
2 ! $Id: recmwf_aero.F90 3989 2021-10-10 07:18:17Z oboucher $
3 !
4 !OPTIONS XOPT(NOEVAL)
5 120 SUBROUTINE RECMWF_AERO (KST, KEND, KPROMA, KTDIA , KLEV,&
6 & KMODE,&
7 120 & PALBD , PALBP , PAPRS , PAPRSF , PCCO2 , PCLFR,&
8 120 & PQO3 , PAER , PDP , PEMIS , PMU0,&
9 & PQ , PQS , PQIWP , PQLWP , PSLM , PT , PTS,&
10 & PREF_LIQ, PREF_ICE,&
11 !--OB
12 & PREF_LIQ_PI, PREF_ICE_PI,&
13 !--fin
14 & PEMTD , PEMTU , PTRSO,&
15 120 & PTH , PCTRSO, PCEMTR, PTRSOD,&
16 & PLWFC, PLWFT, PSWFC, PSWFT, PSFSWDIR, PSFSWDIF,&
17 & PFSDNN, PFSDNV,&
18 & PPIZA_TOT,PCGA_TOT,PTAU_TOT, &
19 !--OB
20 120 & PPIZA_NAT,PCGA_NAT,PTAU_NAT, &
21 !--fin OB
22 !--C.Kleinschmitt
23 120 & PTAU_LW_TOT, PTAU_LW_NAT, &
24 !--end
25 120 & PFLUX,PFLUC,&
26 & PFSDN ,PFSUP , PFSCDN , PFSCUP, PFSCCDN, PFSCCUP, PFLCCDN, PFLCCUP,&
27 !--OB diagnostics
28 & PTOPSWADAERO,PSOLSWADAERO,&
29 & PTOPSWAD0AERO,PSOLSWAD0AERO,&
30 & PTOPSWAIAERO,PSOLSWAIAERO,&
31 120 & PTOPSWCFAERO,PSOLSWCFAERO,&
32 & PSWADAERO,& !--NL
33 !--LW diagnostics CK
34 & PTOPLWADAERO,PSOLLWADAERO,&
35 & PTOPLWAD0AERO,PSOLLWAD0AERO,&
36 & PTOPLWAIAERO,PSOLLWAIAERO,&
37 & PLWADAERO,& !--NL
38 !--ajout volmip
39 & volmip_solsw, flag_volc_surfstrat,&
40 !..end
41 & ok_ade, ok_aie, ok_volcan, flag_aerosol,flag_aerosol_strat,&
42 & flag_aer_feedback)
43 !--fin
44
45 !**** *RECMWF* - METEO-FRANCE RADIATION INTERFACE TO ECMWF RADIATION SCHEME
46
47 ! PURPOSE.
48 ! --------
49 ! SIMPLE INTERFACE TO RADLSW (NO INTERPOLATION)
50
51 !** INTERFACE.
52 ! ----------
53
54 ! EXPLICIT ARGUMENTS :
55 ! --------------------
56 ! KST : START INDEX OF DATA IN KPROMA-LONG VECTOR
57 ! KEND : END INDEX OF DATA IN KPROMA-LONG VECTOR
58 ! KPROMA : VECTOR LENGTH
59 ! KTDIA : INDEX OF TOP LEVEL FROM WHICH COMPUTATIONS ARE ACTIVE
60 ! KLEV : NUMBER OF LEVELS
61 ! PAER : (KPROMA,KLEV ,6) ; OPTICAL THICKNESS OF THE AEROSOLS
62 ! PALBD : (KPROMA,NSW) ; DIFFUSE ALBEDO IN THE 2 SW INTERVALS
63 ! PALBP : (KPROMA,NSW) ; PARALLEL ALBEDO IN THE 2 SW INTERVALS
64 ! PAPRS : (KPROMA,KLEV+1) ; HALF LEVEL PRESSURE
65 ! PAPRSF : (KPROMA,KLEV ) ; FULL LEVEL PRESSURE
66 ! PCCO2 : ; CONCENTRATION IN CO2 (PA/PA)
67 ! PCLFR : (KPROMA,KLEV ) ; CLOUD FRACTIONAL COVER
68 ! PQO3 : (KPROMA,KLEV ) ; OZONE MIXING RATIO (MASS)
69 ! PDP : (KPROMA,KLEV) ; LAYER PRESSURE THICKNESS
70 ! PEMIS : (KPROMA) ; SURFACE EMISSIVITY
71 ! PMU0 : (KPROMA) ; SOLAR ANGLE
72 ! PQ : (KPROMA,KLEV ) ; SPECIFIC HUMIDITY PA/PA
73 ! PQS : (KPROMA,KLEV ) ; SATURATION SPECIFIC HUMIDITY PA/PA
74 ! PQIWP : (KPROMA,KLEV ) ; ICE WATER KG/KG
75 ! PQLWP : (KPROMA,KLEV ) ; LIQUID WATER KG/KG
76 ! PSLM : (KPROMA) ; LAND-SEA MASK
77 ! PT : (KPROMA,KLEV) ; FULL LEVEL TEMPERATURE
78 ! PTS : (KPROMA) ; SURFACE TEMPERATURE
79 ! PPIZA_TOT : (KPROMA,KLEV,NSW); Single scattering albedo of total aerosol
80 ! PCGA_TOT : (KPROMA,KLEV,NSW); Assymetry factor for total aerosol
81 ! PTAU_TOT: (KPROMA,KLEV,NSW) ; Optical depth of total aerosol
82 ! PREF_LIQ (KPROMA,KLEV) ; Liquid droplet radius (um) - present-day
83 ! PREF_ICE (KPROMA,KLEV) ; Ice crystal radius (um) - present-day
84 !--OB
85 ! PREF_LIQ_PI (KPROMA,KLEV) ; Liquid droplet radius (um) - pre-industrial
86 ! PREF_ICE_PI (KPROMA,KLEV) ; Ice crystal radius (um) - pre-industrial
87 ! ok_ade---input-L- apply the Aerosol Direct Effect or not?
88 ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
89 ! ok_volcan-input-L- activate volcanic diags (SW heat & LW cool rate, SW & LW flux)
90 ! flag_aerosol-input-I- aerosol flag from 0 to 7
91 ! flag_aerosol_strat-input-I- use stratospheric aerosols flag (T/F)
92 ! flag_aer_feedback-input-I- use aerosols radiative effect flag (T/F)
93 ! PPIZA_NAT : (KPROMA,KLEV,NSW); Single scattering albedo of natural aerosol
94 ! PCGA_NAT : (KPROMA,KLEV,NSW); Assymetry factor for natural aerosol
95 ! PTAU_NAT: (KPROMA,KLEV,NSW) ; Optical depth of natural aerosol
96 ! PTAU_LW_TOT (KPROMA,KLEV,NLW); LW Optical depth of total aerosols
97 ! PTAU_LW_NAT (KPROMA,KLEV,NLW); LW Optical depth of natural aerosols
98 !--fin OB
99
100 ! ==== OUTPUTS ===
101 ! PEMTD (KPROMA,KLEV+1) ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
102 ! PEMTU (KPROMA,KLEV+1) ; TOTAL UPWARD LONGWAVE EMISSIVITY
103 ! PTRSO (KPROMA,KLEV+1) ; TOTAL SHORTWAVE TRANSMISSIVITY
104 ! PTH (KPROMA,KLEV+1) ; HALF LEVEL TEMPERATURE
105 ! PCTRSO(KPROMA,2) ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY
106 ! PCEMTR(KPROMA,2) ; CLEAR-SKY NET LONGWAVE EMISSIVITY
107 ! PTRSOD(KPROMA) ; TOTAL-SKY SURFACE SW TRANSMISSITY
108 ! PLWFC (KPROMA,2) ; CLEAR-SKY LONGWAVE FLUXES
109 ! PLWFT (KPROMA,KLEV+1) ; TOTAL-SKY LONGWAVE FLUXES
110 ! PSWFC (KPROMA,2) ; CLEAR-SKY SHORTWAVE FLUXES
111 ! PSWFT (KPROMA,KLEV+1) ; TOTAL-SKY SHORTWAVE FLUXES
112 ! Ajout flux LW et SW montants et descendants, et ciel clair (MPL 19.12.08)
113 ! PFLUX (KPROMA,2,KLEV+1) ; LW total sky flux (1=up, 2=down)
114 ! PFLUC (KPROMA,2,KLEV+1) ; LW clear sky flux (1=up, 2=down)
115 ! PFSDN(KPROMA,KLEV+1) ; SW total sky flux down
116 ! PFSUP(KPROMA,KLEV+1) ; SW total sky flux up
117 ! PFSCDN(KPROMA,KLEV+1) ; SW clear sky flux down
118 ! PFSCUP(KPROMA,KLEV+1) ; SW clear sky flux up
119 ! PFSCCDN(KPROMA,KLEV+1) ; SW clear sky clean (no aerosol) flux down
120 ! PFSCCUP(KPROMA,KLEV+1) ; SW clear sky clean (no aerosol) flux up
121 ! PFLCCDN(KPROMA,KLEV+1) ; LW clear sky clean (no aerosol) flux down
122 ! PFLCCUP(KPROMA,KLEV+1) ; LW clear sky clean (no aerosol) flux up
123
124
125 ! IMPLICIT ARGUMENTS : NONE
126 ! --------------------
127
128 ! METHOD.
129 ! -------
130 ! SEE DOCUMENTATION
131
132 ! EXTERNALS.
133 ! ----------
134
135 ! REFERENCE.
136 ! ----------
137 ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
138
139 ! AUTHORS.
140 ! --------
141 ! ORIGINAL BY B. RITTER *ECMWF* 83-10-13
142 ! REWRITING FOR IFS BY J.-J. MORCRETTE 94-11-15
143 ! 96-11: Ph. Dandin. Meteo-France
144 ! REWRITING FOR DM BY J.PH. PIEDELIEVRE 1998-07
145 ! Duplication of RFMR to use present (cy25) ECMWF radiation scheme : Y. Bouteloup 09-2003
146 ! Use of 6 aerosols & introduce NSW : F. Bouyssel 09-2004
147 ! 04-11-18 : 4 New arguments for AROME : Y. Seity
148 ! 2005-10-10 Y. Seity : 3 optional arguments for dust optical properties
149 ! JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation (ECMWF)
150 ! Olivier Boucher: added LMD radiation diagnostics 2014-03
151
152 !-----------------------------------------------------------------------
153
154 USE PARKIND1 ,ONLY : JPIM ,JPRB
155 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
156 USE YOEAERD , ONLY : RCAEROS
157 USE YOMCST , ONLY : RMD ,RMO3
158 USE YOMPHY3 , ONLY : RII0
159 USE YOERAD , ONLY : NLW, NAER, RCCNLND ,RCCNSEA
160 USE YOERAD , ONLY : NAER, RCCNLND ,RCCNSEA
161 USE YOERDU , ONLY : REPSCQ
162 USE YOMGEM , ONLY : NGPTOT
163 USE YOERDI , ONLY : RRAE ,REPCLC ,REPH2O
164 USE YOMARPHY , ONLY : LRDUST
165 USE phys_output_mod, ONLY : swaerofree_diag, swaero_diag
166
167 !-----------------------------------------------------------------------
168
169 !* 0.1 ARGUMENTS.
170 ! ----------
171
172 IMPLICIT NONE
173 INCLUDE "clesphys.h"
174
175 INTEGER(KIND=JPIM),INTENT(IN) :: KPROMA
176 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
177 INTEGER(KIND=JPIM),INTENT(IN) :: KST
178 INTEGER(KIND=JPIM),INTENT(IN) :: KEND
179 INTEGER(KIND=JPIM) :: KTDIA ! Argument NOT used
180 INTEGER(KIND=JPIM),INTENT(IN) :: KMODE
181 REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KPROMA,NSW)
182 REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KPROMA,NSW)
183 REAL(KIND=JPRB) ,INTENT(IN) :: PAPRS(KPROMA,KLEV+1)
184 REAL(KIND=JPRB) ,INTENT(IN) :: PAPRSF(KPROMA,KLEV)
185 REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2
186 REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR(KPROMA,KLEV)
187 REAL(KIND=JPRB) ,INTENT(IN) :: PQO3(KPROMA,KLEV)
188 REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KPROMA,KLEV,6)
189 REAL(KIND=JPRB) ,INTENT(IN) :: PDP(KPROMA,KLEV)
190 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(KPROMA)
191 REAL(KIND=JPRB) ,INTENT(IN) :: PMU0(KPROMA)
192 REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KPROMA,KLEV)
193 REAL(KIND=JPRB) ,INTENT(IN) :: PQS(KPROMA,KLEV)
194 REAL(KIND=JPRB) ,INTENT(IN) :: PQIWP(KPROMA,KLEV)
195 REAL(KIND=JPRB) ,INTENT(IN) :: PQLWP(KPROMA,KLEV)
196 REAL(KIND=JPRB) ,INTENT(IN) :: PSLM(KPROMA)
197 REAL(KIND=JPRB) ,INTENT(IN) :: PT(KPROMA,KLEV)
198 REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KPROMA)
199 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_TOT(KPROMA,KLEV,NSW)
200 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_TOT(KPROMA,KLEV,NSW)
201 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_TOT(KPROMA,KLEV,NSW)
202 !--OB
203 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_NAT(KPROMA,KLEV,NSW)
204 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_NAT(KPROMA,KLEV,NSW)
205 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_NAT(KPROMA,KLEV,NSW)
206 240 REAL(KIND=JPRB) :: PPIZA_ZERO(KPROMA,KLEV,NSW)
207 240 REAL(KIND=JPRB) :: PCGA_ZERO(KPROMA,KLEV,NSW)
208 240 REAL(KIND=JPRB) :: PTAU_ZERO(KPROMA,KLEV,NSW)
209 !--fin
210 !--C.Kleinschmitt
211 240 REAL(KIND=JPRB) :: PTAU_LW_ZERO(KPROMA,KLEV,NLW)
212 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW_TOT(KPROMA,KLEV,NLW)
213 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW_NAT(KPROMA,KLEV,NLW)
214 !--end
215 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_LIQ(KPROMA,KLEV)
216 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE(KPROMA,KLEV)
217 !--OB
218 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_LIQ_PI(KPROMA,KLEV)
219 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE_PI(KPROMA,KLEV)
220 LOGICAL, INTENT(in) :: ok_ade, ok_aie ! switches whether to use aerosol direct (indirect) effects or not
221 LOGICAL, INTENT(in) :: ok_volcan ! produce volcanic diags (SW/LW heat flux and rate)
222 INTEGER, INTENT(in) :: flag_aerosol ! takes value 0 (no aerosol) or 1 to 6 (aerosols)
223 LOGICAL, INTENT(in) :: flag_aerosol_strat ! use stratospheric aerosols
224 LOGICAL, INTENT(in) :: flag_aer_feedback ! use aerosols radiative feedback
225 REAL(KIND=JPRB) ,INTENT(out) :: PTOPSWADAERO(KPROMA), PSOLSWADAERO(KPROMA) ! Aerosol direct forcing at TOA and surface
226 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWAD0AERO(KPROMA), PSOLSWAD0AERO(KPROMA) ! Aerosol direct forcing at TOA and surface
227 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWAIAERO(KPROMA), PSOLSWAIAERO(KPROMA) ! ditto, indirect
228 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWCFAERO(KPROMA,3), PSOLSWCFAERO(KPROMA,3) !--do we keep this ?
229 !--fin
230 !--NL
231 REAL(KIND=JPRB) ,INTENT(OUT) :: PSWADAERO(KPROMA, KLEV+1) ! SW Aerosol direct forcing
232 REAL(KIND=JPRB) ,INTENT(OUT) :: PLWADAERO(KPROMA, KLEV+1) ! LW Aerosol direct forcing
233 !--CK
234 REAL(KIND=JPRB) ,INTENT(out) :: PTOPLWADAERO(KPROMA), PSOLLWADAERO(KPROMA) ! LW Aerosol direct forcing at TOA + surface
235 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPLWAD0AERO(KPROMA), PSOLLWAD0AERO(KPROMA) ! LW Aerosol direct forcing at TOA + surface
236 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPLWAIAERO(KPROMA), PSOLLWAIAERO(KPROMA) ! LW Aer. indirect forcing at TOA + surface
237 !--end
238 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMTD(KPROMA,KLEV+1)
239 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMTU(KPROMA,KLEV+1)
240 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRSO(KPROMA,KLEV+1)
241 REAL(KIND=JPRB) ,INTENT(INOUT) :: PTH(KPROMA,KLEV+1)
242 REAL(KIND=JPRB) ,INTENT(OUT) :: PCTRSO(KPROMA,2)
243 REAL(KIND=JPRB) ,INTENT(OUT) :: PCEMTR(KPROMA,2)
244 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRSOD(KPROMA)
245 REAL(KIND=JPRB) ,INTENT(OUT) :: PLWFC(KPROMA,2)
246 REAL(KIND=JPRB) ,INTENT(OUT) :: PLWFT(KPROMA,KLEV+1)
247 REAL(KIND=JPRB) ,INTENT(OUT) :: PSWFC(KPROMA,2)
248 REAL(KIND=JPRB) ,INTENT(OUT) :: PSWFT(KPROMA,KLEV+1)
249 REAL(KIND=JPRB) ,INTENT(OUT) :: PSFSWDIR(KPROMA,NSW)
250 REAL(KIND=JPRB) ,INTENT(OUT) :: PSFSWDIF(KPROMA,NSW)
251 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDNN(KPROMA)
252 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDNV(KPROMA)
253 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(KPROMA,2,KLEV+1) ! LW total sky flux (1=up, 2=down)
254 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUC(KPROMA,2,KLEV+1) ! LW clear sky flux (1=up, 2=down)
255 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDN(KPROMA,KLEV+1) ! SW total sky flux down
256 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSUP(KPROMA,KLEV+1) ! SW total sky flux up
257 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCDN(KPROMA,KLEV+1) ! SW clear sky flux down
258 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCUP(KPROMA,KLEV+1) ! SW clear sky flux up
259 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCCDN(KPROMA,KLEV+1) ! SW clear sky clean (no aerosol) flux down
260 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCCUP(KPROMA,KLEV+1) ! SW clear sky clean (no aerosol) flux up
261 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLCCDN(KPROMA,KLEV+1) ! LW clear sky clean (no aerosol) flux down
262 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLCCUP(KPROMA,KLEV+1) ! LW clear sky clean (no aerosol) flux up
263 !--ajout VOLMIP
264 REAL(KIND=JPRB) ,INTENT(OUT) :: volmip_solsw(KPROMA) ! SW clear sky in the case of VOLMIP
265 INTEGER, INTENT(IN) :: flag_volc_surfstrat !--VOlMIP Modif
266
267 ! ==== COMPUTED IN RADITE ===
268 ! ------------------------------------------------------------------
269 !* 0.2 LOCAL ARRAYS.
270 ! -------------
271 240 REAL(KIND=JPRB) :: ZRAER (KPROMA,6,KLEV)
272 240 REAL(KIND=JPRB) :: ZRCLC (KPROMA,KLEV)
273 240 REAL(KIND=JPRB) :: ZRMU0 (KPROMA)
274 240 REAL(KIND=JPRB) :: ZRPR (KPROMA,KLEV)
275 240 REAL(KIND=JPRB) :: ZRTI (KPROMA,KLEV)
276 240 REAL(KIND=JPRB) :: ZQLWP (KPROMA,KLEV ) , ZQIWP (KPROMA,KLEV )
277
278 240 REAL(KIND=JPRB) :: ZPQO3 (KPROMA,KLEV)
279 REAL(KIND=JPRB) :: ZQOZ (NGPTOT,KLEV)
280 240 REAL(KIND=JPRB) :: ZQS (KPROMA,KLEV)
281 240 REAL(KIND=JPRB) :: ZQ (KPROMA,KLEV)
282 240 REAL(KIND=JPRB) :: ZEMTD (KPROMA,KLEV+1)
283 240 REAL(KIND=JPRB) :: ZEMTU (KPROMA,KLEV+1)
284 240 REAL(KIND=JPRB) :: ZTRSOC (KPROMA,2)
285 240 REAL(KIND=JPRB) :: ZEMTC (KPROMA,2)
286
287 240 REAL(KIND=JPRB) :: ZNBAS (KPROMA)
288 240 REAL(KIND=JPRB) :: ZNTOP (KPROMA)
289 240 REAL(KIND=JPRB) :: ZQRAIN (KPROMA,KLEV)
290 240 REAL(KIND=JPRB) :: ZQRAINT(KPROMA,KLEV)
291 240 REAL(KIND=JPRB) :: ZCCNL (KPROMA)
292 240 REAL(KIND=JPRB) :: ZCCNO (KPROMA)
293
294 ! output of radlsw
295
296 240 REAL(KIND=JPRB) :: ZEMIT (KPROMA)
297 240 REAL(KIND=JPRB) :: ZFCT (KPROMA,KLEV+1)
298 240 REAL(KIND=JPRB) :: ZFLT (KPROMA,KLEV+1)
299 240 REAL(KIND=JPRB) :: ZFCS (KPROMA,KLEV+1)
300 240 REAL(KIND=JPRB) :: ZFLS (KPROMA,KLEV+1)
301 240 REAL(KIND=JPRB) :: ZFRSOD (KPROMA),ZSUDU(KPROMA)
302 240 REAL(KIND=JPRB) :: ZPARF (KPROMA),ZUVDF(KPROMA),ZPARCF(KPROMA),ZTINCF(KPROMA)
303
304 INTEGER(KIND=JPIM) :: IBEG, IEND, JK, JL
305
306 240 REAL(KIND=JPRB) :: ZCRAE, ZRII0, ZEMIW(KPROMA)
307 REAL(KIND=JPRB) :: ZHOOK_HANDLE
308
309 !---aerosol radiative diagnostics
310 ! Key to define the aerosol effect acting on climate
311 ! OB: AEROSOLFEEDBACK_ACTIVE is now a LOGICAL
312 ! TRUE: fluxes use natural and/or anthropogenic aerosols according to ok_ade and ok_aie, DEFAULT
313 ! FALSE: fluxes use no aerosols (case 1)
314 ! to be used only for maintaining bit reproducibility with aerosol diagnostics activated
315 LOGICAL :: AEROSOLFEEDBACK_ACTIVE ! now externalized from .def files
316
317 !OB - Fluxes including aerosol effects
318 ! | direct effect
319 !ind effect | no aerosol NATural TOTal
320 !standard | 5
321 !natural (PI) | 1 3
322 !total (PD) | 2 4
323 ! so we need which case when ?
324 ! if flag_aerosol is on
325 ! ok_ade and ok_aie = 4-2, 4-3 and 4 to proceed
326 ! ok_ade and not ok_aie = 3-1 and 3 to proceed
327 ! not ok_ade and ok_aie = 2-1 and 2 to proceed
328 ! not ok_ade and not ok_aie = 1 to proceed
329 ! therefore the cases have the following corresponding switches
330 ! 1 = not ok_ade and not ok_aie OR not ok_ade and ok_aie and swaero_diag OR ok_ade and not ok_aie and swaero_diag
331 ! 2 = not ok_ade and ok_aie OR ok_aie and ok_ade and swaero_diag
332 ! 3 = ok_ade and not ok_aie OR ok_aie and ok_ade and swaero_diag
333 ! 4 = ok_ade and ok_aie
334 ! 5 = no aerosol feedback wanted or no aerosol at all
335 ! if they are called in this order then the correct call is used to proceed
336
337 240 REAL(KIND=JPRB) :: ZFSUP_AERO(KPROMA,KLEV+1,5)
338 240 REAL(KIND=JPRB) :: ZFSDN_AERO(KPROMA,KLEV+1,5)
339 240 REAL(KIND=JPRB) :: ZFSUP0_AERO(KPROMA,KLEV+1,5)
340 240 REAL(KIND=JPRB) :: ZFSDN0_AERO(KPROMA,KLEV+1,5)
341 !--LW (CK):
342 240 REAL(KIND=JPRB) :: LWUP_AERO(KPROMA,KLEV+1,5)
343 240 REAL(KIND=JPRB) :: LWDN_AERO(KPROMA,KLEV+1,5)
344 240 REAL(KIND=JPRB) :: LWUP0_AERO(KPROMA,KLEV+1,5)
345 240 REAL(KIND=JPRB) :: LWDN0_AERO(KPROMA,KLEV+1,5)
346
347 INTERFACE
348 SUBROUTINE RADLSW &
349 & ( KIDIA, KFDIA , KLON , KLEV , KMODE, KAER,&
350 & PRII0,&
351 & PAER , PALBD , PALBP, PAPH , PAP,&
352 & PCCNL, PCCNO,&
353 & PCCO2, PCLFR , PDP , PEMIS, PEMIW , PLSM , PMU0, POZON,&
354 & PQ , PQIWP , PQLWP, PQS , PQRAIN, PRAINT,&
355 & PTH , PT , PTS , PNBAS, PNTOP,&
356 & PREF_LIQ, PREF_ICE,&
357 & PEMIT, PFCT , PFLT , PFCS , PFLS,&
358 & PFRSOD,PSUDU , PUVDF, PPARF, PPARCF, PTINCF,&
359 & PSFSWDIR, PSFSWDIF,PFSDNN,PFSDNV ,&
360 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST,&
361 & PTAU_LW,&
362 & PFLUX,PFLUC,PFSDN ,PFSUP , PFSCDN , PFSCUP)
363
364 USE PARKIND1 ,ONLY : JPIM ,JPRB
365 USE YOERAD , ONLY : NLW, LRRTM ,LCCNL ,LCCNO, LDIFFC,&
366 & NRADIP , NRADLP , NICEOPT, NLIQOPT, NINHOM ,NLAYINH ,&
367 & RCCNLND, RCCNSEA, RLWINHF, RSWINHF, RRe2De ,&
368 & LEDBUG
369 include "clesphys.h"
370 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
371 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
372 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
373 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
374 INTEGER(KIND=JPIM),INTENT(IN) :: KMODE
375 INTEGER(KIND=JPIM),INTENT(IN) :: KAER
376 REAL(KIND=JPRB) ,INTENT(IN) :: PRII0
377 REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV)
378 REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,NSW)
379 REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW)
380 REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1)
381 REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV)
382 REAL(KIND=JPRB) ,INTENT(IN) :: PCCNL(KLON)
383 REAL(KIND=JPRB) ,INTENT(IN) :: PCCNO(KLON)
384 REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2
385 REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR(KLON,KLEV)
386 REAL(KIND=JPRB) ,INTENT(IN) :: PDP(KLON,KLEV)
387 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(KLON)
388 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIW(KLON)
389 REAL(KIND=JPRB) ,INTENT(IN) :: PLSM(KLON)
390 REAL(KIND=JPRB) ,INTENT(IN) :: PMU0(KLON)
391 REAL(KIND=JPRB) ,INTENT(IN) :: POZON(KLON,KLEV)
392 REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV)
393 REAL(KIND=JPRB) ,INTENT(IN) :: PQIWP(KLON,KLEV)
394 REAL(KIND=JPRB) ,INTENT(IN) :: PQLWP(KLON,KLEV)
395 REAL(KIND=JPRB) ,INTENT(IN) :: PQS(KLON,KLEV)
396 REAL(KIND=JPRB) :: PQRAIN(KLON,KLEV)
397 REAL(KIND=JPRB) :: PRAINT(KLON,KLEV)
398 REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1)
399 REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV)
400 REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KLON)
401 REAL(KIND=JPRB) ,INTENT(IN) :: PNBAS(KLON)
402 REAL(KIND=JPRB) ,INTENT(IN) :: PNTOP(KLON)
403 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_LIQ(KLON,KLEV)
404 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE(KLON,KLEV)
405 LOGICAL ,INTENT(IN) :: LRDUST
406 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV,NSW)
407 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV,NSW)
408 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV,NSW)
409 !--C.Kleinschmitt
410 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW(KLON,KLEV,NLW)
411 !--end
412 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMIT(KLON)
413 REAL(KIND=JPRB) ,INTENT(OUT) :: PFCT(KLON,KLEV+1)
414 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLT(KLON,KLEV+1)
415 REAL(KIND=JPRB) ,INTENT(OUT) :: PFCS(KLON,KLEV+1)
416 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLS(KLON,KLEV+1)
417 REAL(KIND=JPRB) ,INTENT(OUT) :: PFRSOD(KLON)
418 REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU(KLON)
419 REAL(KIND=JPRB) ,INTENT(OUT) :: PUVDF(KLON)
420 REAL(KIND=JPRB) ,INTENT(OUT) :: PPARF(KLON)
421 REAL(KIND=JPRB) ,INTENT(OUT) :: PPARCF(KLON), PTINCF(KLON)
422 REAL(KIND=JPRB) ,INTENT(OUT) :: PSFSWDIR(KLON,NSW)
423 REAL(KIND=JPRB) ,INTENT(OUT) :: PSFSWDIF(KLON,NSW)
424 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDNN(KLON)
425 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDNV(KLON)
426 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(KLON,2,KLEV+1) ! LW total sky flux (1=up, 2=down)
427 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUC(KLON,2,KLEV+1) ! LW clear sky flux (1=up, 2=down)
428 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDN(KLON,KLEV+1) ! SW total sky flux down
429 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSUP(KLON,KLEV+1) ! SW total sky flux up
430 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCDN(KLON,KLEV+1) ! SW clear sky flux down
431 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCUP(KLON,KLEV+1) ! SW clear sky flux up
432 END SUBROUTINE RADLSW
433 END INTERFACE
434
435
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
 120 IF (LHOOK) CALL DR_HOOK('RECMWF_AERO',0,ZHOOK_HANDLE)
436 120 IBEG=KST
437 120 IEND=KEND
438
439 120 AEROSOLFEEDBACK_ACTIVE = flag_aer_feedback !NL: externalize aer feedback
440
441
442 !* 1. PREPARATORY WORK
443 ! ----------------
444 !--OB
445 ! 1.0 INITIALIZATIONS
446 ! --------------
447
448
6/6
✓ Branch 0 taken 600 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 24000 times.
✓ Branch 3 taken 600 times.
✓ Branch 4 taken 23856000 times.
✓ Branch 5 taken 24000 times.
 23880720 ZFSUP_AERO (:,:,:)=0.
449
6/6
✓ Branch 0 taken 600 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 24000 times.
✓ Branch 3 taken 600 times.
✓ Branch 4 taken 23856000 times.
✓ Branch 5 taken 24000 times.
 23880720 ZFSDN_AERO (:,:,:)=0.
450
6/6
✓ Branch 0 taken 600 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 24000 times.
✓ Branch 3 taken 600 times.
✓ Branch 4 taken 23856000 times.
✓ Branch 5 taken 24000 times.
 23880720 ZFSUP0_AERO(:,:,:)=0.
451
6/6
✓ Branch 0 taken 600 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 24000 times.
✓ Branch 3 taken 600 times.
✓ Branch 4 taken 23856000 times.
✓ Branch 5 taken 24000 times.
 23880720 ZFSDN0_AERO(:,:,:)=0.
452
453
6/6
✓ Branch 0 taken 600 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 24000 times.
✓ Branch 3 taken 600 times.
✓ Branch 4 taken 23856000 times.
✓ Branch 5 taken 24000 times.
 23880720 LWUP_AERO (:,:,:)=0.
454
6/6
✓ Branch 0 taken 600 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 24000 times.
✓ Branch 3 taken 600 times.
✓ Branch 4 taken 23856000 times.
✓ Branch 5 taken 24000 times.
 23880720 LWDN_AERO (:,:,:)=0.
455
6/6
✓ Branch 0 taken 600 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 24000 times.
✓ Branch 3 taken 600 times.
✓ Branch 4 taken 23856000 times.
✓ Branch 5 taken 24000 times.
 23880720 LWUP0_AERO(:,:,:)=0.
456
6/6
✓ Branch 0 taken 600 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 24000 times.
✓ Branch 3 taken 600 times.
✓ Branch 4 taken 23856000 times.
✓ Branch 5 taken 24000 times.
 23880720 LWDN0_AERO(:,:,:)=0.
457
458
6/6
✓ Branch 0 taken 720 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 28080 times.
✓ Branch 3 taken 720 times.
✓ Branch 4 taken 27911520 times.
✓ Branch 5 taken 28080 times.
 27940440 PTAU_ZERO(:,:,:) =1.e-15
459
6/6
✓ Branch 0 taken 720 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 28080 times.
✓ Branch 3 taken 720 times.
✓ Branch 4 taken 27911520 times.
✓ Branch 5 taken 28080 times.
 27940440 PPIZA_ZERO(:,:,:)=1.0
460
6/6
✓ Branch 0 taken 720 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 28080 times.
✓ Branch 3 taken 720 times.
✓ Branch 4 taken 27911520 times.
✓ Branch 5 taken 28080 times.
 27940440 PCGA_ZERO(:,:,:) =0.0
461
462
6/6
✓ Branch 0 taken 1920 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 74880 times.
✓ Branch 3 taken 1920 times.
✓ Branch 4 taken 74430720 times.
✓ Branch 5 taken 74880 times.
 74507640 PTAU_LW_ZERO(:,:,:) =1.e-15
463
464
465 !* 1.1 LOCAL CONSTANTS
466 ! ---------------
467
468 120 ZRII0=RII0
469 120 ZCRAE=RRAE*(RRAE+2.0_JPRB)
470
471 !* 2.1 FULL-LEVEL QUANTITIES
472
473
4/4
✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4651920 times.
✓ Branch 3 taken 4680 times.
 4656720 ZRPR =PAPRSF
474
475
2/2
✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 120 times.
 4800 DO JK=1,KLEV
476
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 4680 times.
 4656720 DO JL=IBEG,IEND
477 ! ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)*RMD/RMO3
478 4651920 ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)
479 4651920 ZRCLC(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR(JL,JK)))
480
2/2
✓ Branch 0 taken 1092084 times.
✓ Branch 1 taken 3559836 times.
 4651920 IF (ZRCLC(JL,JK) > REPCLC) THEN
481 1092084 ZQLWP(JL,JK)=PQLWP(JL,JK)
482 1092084 ZQIWP(JL,JK)=PQIWP(JL,JK)
483 ELSE
484 3559836 ZQLWP(JL,JK)=REPH2O*ZRCLC(JL,JK)
485 3559836 ZQIWP(JL,JK)=REPH2O*ZRCLC(JL,JK)
486 ENDIF
487 4651920 ZQRAIN(JL,JK)=0.
488 4651920 ZQRAINT(JL,JK)=0.
489 4651920 ZRTI(JL,JK) =PT(JL,JK)
490 4651920 ZQS (JL,JK)=MAX(2.0_JPRB*REPH2O,PQS(JL,JK))
491 4651920 ZQ (JL,JK)=MAX(REPH2O,MIN(PQ(JL,JK),ZQS(JL,JK)*(1.0_JPRB-REPH2O)))
492 4656600 ZEMIW(JL)=PEMIS(JL)
493 ENDDO
494 ENDDO
495
496
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
 120 IF (NAER == 0) THEN
497 ✗ ZRAER=RCAEROS
498 ELSE
499
2/2
✓ Branch 0 taken 120 times.
✓ Branch 1 taken 4680 times.
 4800 DO JK=1,KLEV
500
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 4680 times.
 4656720 DO JL=IBEG,IEND
501 4651920 ZRAER(JL,1,JK)=PAER(JL,JK,1)
502 4651920 ZRAER(JL,2,JK)=PAER(JL,JK,2)
503 4651920 ZRAER(JL,3,JK)=PAER(JL,JK,3)
504 4651920 ZRAER(JL,4,JK)=PAER(JL,JK,4)
505 4651920 ZRAER(JL,5,JK)=RCAEROS
506 4656600 ZRAER(JL,6,JK)=PAER(JL,JK,6)
507 ENDDO
508 ENDDO
509 ENDIF
510
511 !* 2.2 HALF-LEVEL QUANTITIES
512
513
2/2
✓ Branch 0 taken 4560 times.
✓ Branch 1 taken 120 times.
 4680 DO JK=2,KLEV
514
2/2
✓ Branch 0 taken 4532640 times.
✓ Branch 1 taken 4560 times.
 4537320 DO JL=IBEG,IEND
515 PTH(JL,JK)=&
516 & (PT(JL,JK-1)*PAPRSF(JL,JK-1)*(PAPRSF(JL,JK)-PAPRS(JL,JK))&
517 & +PT(JL,JK)*PAPRSF(JL,JK)*(PAPRS(JL,JK)-PAPRSF(JL,JK-1)))&
518 4537200 & *(1.0_JPRB/(PAPRS(JL,JK)*(PAPRSF(JL,JK)-PAPRSF(JL,JK-1))))
519 ENDDO
520 ENDDO
521
522 !* 2.3 QUANTITIES AT BOUNDARIES
523
524
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
 119400 DO JL=IBEG,IEND
525 119280 PTH(JL,KLEV+1)=PTS(JL)
526 PTH(JL,1)=PT(JL,1)-PAPRSF(JL,1)*(PT(JL,1)-PTH(JL,2))&
527 119280 & /(PAPRSF(JL,1)-PAPRS(JL,2))
528 119280 ZNBAS(JL)=1.
529 119280 ZNTOP(JL)=1.
530 119280 ZCCNL(JL)=RCCNLND
531 119400 ZCCNO(JL)=RCCNSEA
532 ENDDO
533
534 !* 3.1 SOLAR ZENITH ANGLE IS EARTH'S CURVATURE
535 ! CORRECTED
536
537 ! CCMVAL: on impose ZRMU0=PMU0 MPL 25032010
538 ! 2eme essai en 3D MPL 20052010
539 !DO JL=IBEG,IEND
540 ! ZRMU0(JL)=PMU0(JL)
541 !ENDDO
542 !!!!! A REVOIR MPL 20091201: enleve cette correction pour comparer a AR4
543
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
 119400 DO JL=IBEG,IEND
544
2/2
✓ Branch 0 taken 63279 times.
✓ Branch 1 taken 56001 times.
 119400 IF (PMU0(JL) > 1.E-10_JPRB) THEN
545 63279 ZRMU0(JL)=RRAE/(SQRT(PMU0(JL)**2+ZCRAE)-PMU0(JL))
546 ELSE
547 56001 ZRMU0(JL)= RRAE/SQRT(ZCRAE)
548 ENDIF
549 ENDDO
550
551 !* 4.1 CALL TO ACTUAL RADIATION SCHEME
552 !
553 !----now we make multiple calls to the radiation according to which
554 !----aerosol flags are on
555
556
2/4
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 120 times.
 120 IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN
557
558 !--Case 1
559 IF ( ( .not. ok_ade .AND. .not. ok_aie ) .OR. &
560 ✗ & ( .not. ok_ade .AND. ok_aie .AND. swaero_diag ) .OR. &
561 & ( ok_ade .AND. .not. ok_aie .AND. swaero_diag ) ) THEN
562
563 ! natural aerosols for direct and indirect effect
564 ! PI cloud optical properties
565 ! use PREF_LIQ_PI and PREF_ICE_PI
566 ! use NAT aerosol optical properties
567 ! store fluxes in index 1
568
569 CALL RADLSW (&
570 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,&
571 & ZRII0 ,&
572 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,&
573 & ZCCNL , ZCCNO ,&
574 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,&
575 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,&
576 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,&
577 & PREF_LIQ_PI, PREF_ICE_PI,&
578 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,&
579 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,&
580 & PSFSWDIF,PFSDNN, PFSDNV ,&
581 & LRDUST,PPIZA_NAT,PCGA_NAT,PTAU_NAT,PTAU_LW_NAT,PFLUX,PFLUC,&
582 ✗ & PFSDN , PFSUP , PFSCDN , PFSCUP )
583
584 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
585 ✗ ZFSUP0_AERO(:,:,1) = PFSCUP(:,:)
586 ✗ ZFSDN0_AERO(:,:,1) = PFSCDN(:,:)
587
588 ✗ ZFSUP_AERO(:,:,1) = PFSUP(:,:)
589 ✗ ZFSDN_AERO(:,:,1) = PFSDN(:,:)
590
591 ✗ LWUP0_AERO(:,:,1) = PFLUC(:,1,:)
592 ✗ LWDN0_AERO(:,:,1) = PFLUC(:,2,:)
593
594 ✗ LWUP_AERO(:,:,1) = PFLUX(:,1,:)
595 ✗ LWDN_AERO(:,:,1) = PFLUX(:,2,:)
596
597 ENDIF
598
599 !--Case 2
600 ✗ IF ( ( .not. ok_ade .AND. ok_aie ) .OR. &
601 & ( ok_ade .AND. ok_aie .AND. swaero_diag ) ) THEN
602
603 ! natural aerosols for direct indirect effect
604 ! use NAT aerosol optical properties
605 ! PD cloud optical properties
606 ! use PREF_LIQ and PREF_ICE
607 ! store fluxes in index 2
608
609 CALL RADLSW (&
610 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,&
611 & ZRII0 ,&
612 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,&
613 & ZCCNL , ZCCNO ,&
614 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,&
615 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,&
616 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,&
617 & PREF_LIQ, PREF_ICE,&
618 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,&
619 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,&
620 & PSFSWDIF,PFSDNN, PFSDNV ,&
621 & LRDUST,PPIZA_NAT,PCGA_NAT,PTAU_NAT,PTAU_LW_NAT,PFLUX,PFLUC,&
622 ✗ & PFSDN , PFSUP , PFSCDN , PFSCUP )
623
624 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
625 ✗ ZFSUP0_AERO(:,:,2) = PFSCUP(:,:)
626 ✗ ZFSDN0_AERO(:,:,2) = PFSCDN(:,:)
627
628 ✗ ZFSUP_AERO(:,:,2) = PFSUP(:,:)
629 ✗ ZFSDN_AERO(:,:,2) = PFSDN(:,:)
630
631 ✗ LWUP0_AERO(:,:,2) = PFLUC(:,1,:)
632 ✗ LWDN0_AERO(:,:,2) = PFLUC(:,2,:)
633
634 ✗ LWUP_AERO(:,:,2) = PFLUX(:,1,:)
635 ✗ LWDN_AERO(:,:,2) = PFLUX(:,2,:)
636
637 ENDIF ! ok_aie
638
639 !--Case 3
640 ✗ IF ( ( ok_ade .AND. .not. ok_aie ) .OR. &
641 & ( ok_ade .AND. ok_aie .AND. swaero_diag ) ) THEN
642
643 ! direct effect of total aerosol activated
644 ! TOT aerosols for direct effect
645 ! PI cloud optical properties
646 ! use PREF_LIQ_PI and PREF_ICE_PI
647 ! STORE fluxes in index 3
648
649 CALL RADLSW (&
650 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,&
651 & ZRII0 ,&
652 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,&
653 & ZCCNL , ZCCNO ,&
654 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,&
655 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,&
656 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,&
657 & PREF_LIQ_PI, PREF_ICE_PI,&
658 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,&
659 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,&
660 & PSFSWDIF,PFSDNN, PFSDNV ,&
661 & LRDUST,PPIZA_TOT,PCGA_TOT,PTAU_TOT,PTAU_LW_TOT,PFLUX,PFLUC,&
662 ✗ & PFSDN , PFSUP , PFSCDN , PFSCUP )
663
664 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
665 ✗ ZFSUP0_AERO(:,:,3) = PFSCUP(:,:)
666 ✗ ZFSDN0_AERO(:,:,3) = PFSCDN(:,:)
667
668 ✗ ZFSUP_AERO(:,:,3) = PFSUP(:,:)
669 ✗ ZFSDN_AERO(:,:,3) = PFSDN(:,:)
670
671 ✗ LWUP0_AERO(:,:,3) = PFLUC(:,1,:)
672 ✗ LWDN0_AERO(:,:,3) = PFLUC(:,2,:)
673
674 ✗ LWUP_AERO(:,:,3) = PFLUX(:,1,:)
675 ✗ LWDN_AERO(:,:,3) = PFLUX(:,2,:)
676
677 ENDIF !-end ok_ade
678
679 !--Case 4
680 ✗ IF (ok_ade .and. ok_aie) THEN
681
682 ! total aerosols for direct indirect effect
683 ! use TOT aerosol optical properties
684 ! PD cloud optical properties
685 ! use PREF_LIQ and PREF_ICE
686 ! store fluxes in index 4
687
688 CALL RADLSW (&
689 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,&
690 & ZRII0 ,&
691 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,&
692 & ZCCNL , ZCCNO ,&
693 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,&
694 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,&
695 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,&
696 & PREF_LIQ, PREF_ICE,&
697 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,&
698 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,&
699 & PSFSWDIF,PFSDNN, PFSDNV ,&
700 & LRDUST,PPIZA_TOT,PCGA_TOT,PTAU_TOT,PTAU_LW_TOT,PFLUX,PFLUC,&
701 ✗ & PFSDN , PFSUP , PFSCDN , PFSCUP )
702
703 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
704 ✗ ZFSUP0_AERO(:,:,4) = PFSCUP(:,:)
705 ✗ ZFSDN0_AERO(:,:,4) = PFSCDN(:,:)
706
707 ✗ ZFSUP_AERO(:,:,4) = PFSUP(:,:)
708 ✗ ZFSDN_AERO(:,:,4) = PFSDN(:,:)
709
710 ✗ LWUP0_AERO(:,:,4) = PFLUC(:,1,:)
711 ✗ LWDN0_AERO(:,:,4) = PFLUC(:,2,:)
712
713 ✗ LWUP_AERO(:,:,4) = PFLUX(:,1,:)
714 ✗ LWDN_AERO(:,:,4) = PFLUX(:,2,:)
715
716 ENDIF ! ok_ade .and. ok_aie
717
718 ENDIF !--if flag_aerosol GT 0 OR flag_aerosol_strat
719
720 ! case with no aerosols at all is also computed IF ACTIVEFEEDBACK_ACTIVE is false
721
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 (.not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol .EQ. 0 .OR. swaerofree_diag) THEN
722
723 ! ZERO aerosol effect
724 ! ZERO aerosol optical depth
725 ! STANDARD cloud optical properties
726 ! STORE fluxes in index 5
727
728 CALL RADLSW (&
729 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,&
730 & ZRII0 ,&
731 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,&
732 & ZCCNL , ZCCNO ,&
733 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,&
734 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,&
735 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,&
736 !--this needs to be changed to fixed cloud optical properties
737 & PREF_LIQ_PI, PREF_ICE_PI,&
738 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,&
739 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,&
740 & PSFSWDIF,PFSDNN, PFSDNV ,&
741 & LRDUST,PPIZA_ZERO,PCGA_ZERO,PTAU_ZERO, PTAU_LW_ZERO,PFLUX,PFLUC,&
742 120 & PFSDN , PFSUP , PFSCDN , PFSCUP )
743
744 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
745
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 ZFSUP0_AERO(:,:,5) = PFSCUP(:,:)
746
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 ZFSDN0_AERO(:,:,5) = PFSCDN(:,:)
747
748
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 ZFSUP_AERO(:,:,5) = PFSUP(:,:)
749
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 ZFSDN_AERO(:,:,5) = PFSDN(:,:)
750
751
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 LWUP0_AERO(:,:,5) = PFLUC(:,1,:)
752
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 LWDN0_AERO(:,:,5) = PFLUC(:,2,:)
753
754
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 LWUP_AERO(:,:,5) = PFLUX(:,1,:)
755
4/4
✓ Branch 0 taken 120 times.
✓ Branch 1 taken 4800 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 LWDN_AERO(:,:,5) = PFLUX(:,2,:)
756
757 ENDIF ! .not. AEROSOLFEEDBACK_ACTIVE
758
759 !* 4.2 TRANSFORM FLUXES TO MODEL HISTORICAL VARIABLES
760
761
2/2
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
 4920 DO JK=1,KLEV+1
762
2/2
✓ Branch 0 taken 4771200 times.
✓ Branch 1 taken 4800 times.
 4776120 DO JL=IBEG,IEND
763 4771200 PSWFT(JL,JK)=ZFLS(JL,JK)/(ZRII0*ZRMU0(JL))
764 4776000 PLWFT(JL,JK)=ZFLT(JL,JK)
765 ENDDO
766 ENDDO
767
768
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 ZEMTD=PLWFT
769
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 ZEMTU=PLWFT
770
771
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
 119400 DO JL=IBEG,IEND
772 119280 ZTRSOC(JL, 1)=ZFCS(JL, 1)/(ZRII0*ZRMU0(JL))
773 119280 ZTRSOC(JL, 2)=ZFCS(JL,KLEV+1)/(ZRII0*ZRMU0(JL))
774 119280 ZEMTC (JL, 1)=ZFCT(JL, 1)
775 119400 ZEMTC (JL, 2)=ZFCT(JL,KLEV+1)
776 ENDDO
777
778 ! ------------ -- ------- -- ---- -----
779 !* 5.1 STORAGE OF TRANSMISSIVITY AND EMISSIVITIES
780 !* IN KPROMA-LONG ARRAYS
781
782
2/2
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
 4920 DO JK=1,KLEV+1
783
2/2
✓ Branch 0 taken 4771200 times.
✓ Branch 1 taken 4800 times.
 4776120 DO JL=IBEG,IEND
784 4771200 PEMTD(JL,JK)=ZEMTD(JL,JK)
785 4771200 PEMTU(JL,JK)=ZEMTU(JL,JK)
786 4776000 PTRSO(JL,JK)=MAX(0.0_JPRB,MIN(1.0_JPRB,PSWFT(JL,JK)))
787 ENDDO
788 ENDDO
789
2/2
✓ Branch 0 taken 240 times.
✓ Branch 1 taken 120 times.
 360 DO JK=1,2
790
2/2
✓ Branch 0 taken 238560 times.
✓ Branch 1 taken 240 times.
 238920 DO JL=IBEG,IEND
791 238560 PCEMTR(JL,JK)=ZEMTC (JL,JK)
792 238800 PCTRSO(JL,JK)=MAX( 0.0_JPRB,MIN(1.0_JPRB,ZTRSOC(JL,JK)))
793 ENDDO
794 ENDDO
795
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
 119400 DO JL=IBEG,IEND
796 119400 PTRSOD(JL)=MAX(0.0_JPRB,MIN(1.0_JPRB,ZFRSOD(JL)/(ZRII0*ZRMU0(JL))))
797 ENDDO
798
799 !* 7.3 RECONSTRUCT FLUXES FOR DIAGNOSTICS
800
801
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
 119400 DO JL=IBEG,IEND
802
2/2
✓ Branch 0 taken 56001 times.
✓ Branch 1 taken 63279 times.
 119400 IF (PMU0(JL) < 1.E-10_JPRB) ZRMU0(JL)=0.0_JPRB
803 ENDDO
804
2/2
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
 4920 DO JK=1,KLEV+1
805
2/2
✓ Branch 0 taken 4771200 times.
✓ Branch 1 taken 4800 times.
 4776120 DO JL=IBEG,IEND
806 4771200 PLWFT(JL,JK)=PEMTD(JL,JK)
807 4776000 PSWFT(JL,JK)=ZRMU0(JL)*ZRII0*PTRSO(JL,JK)
808 ENDDO
809 ENDDO
810
2/2
✓ Branch 0 taken 240 times.
✓ Branch 1 taken 120 times.
 360 DO JK=1,2
811
2/2
✓ Branch 0 taken 238560 times.
✓ Branch 1 taken 240 times.
 238920 DO JL=IBEG,IEND
812 238560 PSWFC(JL,JK)=ZRMU0(JL)*ZRII0*PCTRSO(JL,JK)
813 238800 PLWFC(JL,JK)=PCEMTR(JL,JK)
814 ENDDO
815 ENDDO
816
817 !* 8.0 DIAGNOSTICS
818 !---Now we copy back the correct fields to proceed to the next timestep
819
820
3/6
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 120 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 120 times.
 120 IF ( AEROSOLFEEDBACK_ACTIVE .AND. (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) ) THEN
821
822 ✗ IF ( ok_ade .and. ok_aie ) THEN
823 ✗ PFSUP(:,:) = ZFSUP_AERO(:,:,4)
824 ✗ PFSDN(:,:) = ZFSDN_AERO(:,:,4)
825 ✗ PFSCUP(:,:) = ZFSUP0_AERO(:,:,4)
826 ✗ PFSCDN(:,:) = ZFSDN0_AERO(:,:,4)
827
828 ✗ PFLUX(:,1,:) = LWUP_AERO(:,:,4)
829 ✗ PFLUX(:,2,:) = LWDN_AERO(:,:,4)
830 ✗ PFLUC(:,1,:) = LWUP0_AERO(:,:,4)
831 ✗ PFLUC(:,2,:) = LWDN0_AERO(:,:,4)
832 ENDIF
833
834 ✗ IF ( ok_ade .and. (.not. ok_aie) ) THEN
835 ✗ PFSUP(:,:) = ZFSUP_AERO(:,:,3)
836 ✗ PFSDN(:,:) = ZFSDN_AERO(:,:,3)
837 ✗ PFSCUP(:,:) = ZFSUP0_AERO(:,:,3)
838 ✗ PFSCDN(:,:) = ZFSDN0_AERO(:,:,3)
839
840 ✗ PFLUX(:,1,:) = LWUP_AERO(:,:,3)
841 ✗ PFLUX(:,2,:) = LWDN_AERO(:,:,3)
842 ✗ PFLUC(:,1,:) = LWUP0_AERO(:,:,3)
843 ✗ PFLUC(:,2,:) = LWDN0_AERO(:,:,3)
844 ENDIF
845
846 ✗ IF ( (.not. ok_ade) .and. ok_aie ) THEN
847 ✗ PFSUP(:,:) = ZFSUP_AERO(:,:,2)
848 ✗ PFSDN(:,:) = ZFSDN_AERO(:,:,2)
849 ✗ PFSCUP(:,:) = ZFSUP0_AERO(:,:,2)
850 ✗ PFSCDN(:,:) = ZFSDN0_AERO(:,:,2)
851
852 ✗ PFLUX(:,1,:) = LWUP_AERO(:,:,2)
853 ✗ PFLUX(:,2,:) = LWDN_AERO(:,:,2)
854 ✗ PFLUC(:,1,:) = LWUP0_AERO(:,:,2)
855 ✗ PFLUC(:,2,:) = LWDN0_AERO(:,:,2)
856 ENDiF
857
858 ✗ IF ((.not. ok_ade) .and. (.not. ok_aie)) THEN
859 ✗ PFSUP(:,:) = ZFSUP_AERO(:,:,1)
860 ✗ PFSDN(:,:) = ZFSDN_AERO(:,:,1)
861 ✗ PFSCUP(:,:) = ZFSUP0_AERO(:,:,1)
862 ✗ PFSCDN(:,:) = ZFSDN0_AERO(:,:,1)
863
864 ✗ PFLUX(:,1,:) = LWUP_AERO(:,:,1)
865 ✗ PFLUX(:,2,:) = LWDN_AERO(:,:,1)
866 ✗ PFLUC(:,1,:) = LWUP0_AERO(:,:,1)
867 ✗ PFLUC(:,2,:) = LWDN0_AERO(:,:,1)
868 ENDIF
869
870 ! The following allows to compute the forcing diagostics without
871 ! letting the aerosol forcing act on the meteorology
872 ! SEE logic above
873
874 ELSE !--not AEROSOLFEEDBACK_ACTIVE
875
876
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 PFSUP(:,:) = ZFSUP_AERO(:,:,5)
877
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 PFSDN(:,:) = ZFSDN_AERO(:,:,5)
878
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 PFSCUP(:,:) = ZFSUP0_AERO(:,:,5)
879
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 PFSCDN(:,:) = ZFSDN0_AERO(:,:,5)
880
881
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 PFLUX(:,1,:) = LWUP_AERO(:,:,5)
882
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 PFLUX(:,2,:) = LWDN_AERO(:,:,5)
883
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 PFLUC(:,1,:) = LWUP0_AERO(:,:,5)
884
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 PFLUC(:,2,:) = LWDN0_AERO(:,:,5)
885
886 ENDIF
887
888 !--VolMIP Strat/Surf
889 !--only ok_ade + ok_aie case treated
890
1/6
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
 120 IF (ok_ade.AND.ok_aie.AND.ok_volcan) THEN
891 !--in this case the fluxes used for the heating rates come from case 4 but SW surface radiation is kept from case 2
892 ✗ IF (flag_volc_surfstrat.EQ.2) THEN ! STRAT HEATING
893 ✗ volmip_solsw(:)= ZFSDN_AERO(:,1,2)-ZFSUP_AERO(:,1,2)
894 ✗ ELSEIF (flag_volc_surfstrat.EQ.1) THEN ! SURF COOLING
895 !--in this case the fluxes used for the heating rates come from case 2 but SW surface radiation is kept from case 4
896 ✗ PFSUP(:,:) = ZFSUP_AERO(:,:,2)
897 ✗ PFSDN(:,:) = ZFSDN_AERO(:,:,2)
898 ✗ PFSCUP(:,:) = ZFSUP0_AERO(:,:,2)
899 ✗ PFSCDN(:,:) = ZFSDN0_AERO(:,:,2)
900 ✗ PFLUX(:,1,:) = LWUP_AERO(:,:,2)
901 ✗ PFLUX(:,2,:) = LWDN_AERO(:,:,2)
902 ✗ PFLUC(:,1,:) = LWDN0_AERO(:,:,2)
903 ✗ PFLUC(:,2,:) = LWDN0_AERO(:,:,2)
904 ✗ volmip_solsw(:)= ZFSDN_AERO(:,1,4)-ZFSUP_AERO(:,1,4)
905 ENDIF
906 ENDIF
907 !--End VolMIP Strat/Surf
908
909
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
 120 IF (swaerofree_diag) THEN
910 ! copy shortwave clear-sky clean (no aerosol) case
911
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 PFSCCUP(:,:) = ZFSUP0_AERO(:,:,5)
912
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 PFSCCDN(:,:) = ZFSDN0_AERO(:,:,5)
913 ! copy longwave clear-sky clean (no aerosol) case
914
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 PFLCCUP(:,:) = LWUP0_AERO(:,:,5)
915
4/4
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 4771200 times.
✓ Branch 3 taken 4800 times.
 4776120 PFLCCDN(:,:) = LWDN0_AERO(:,:,5)
916 ENDIF
917
918 !OB- HERE CHECK WITH MP IF BOTTOM AND TOP INDICES ARE OK !!!!!!!!!!!!!!!!!!
919 ! net anthropogenic forcing direct and 1st indirect effect diagnostics
920 ! requires a natural aerosol field read and used
921 ! Difference of net fluxes from double call to radiation
922 ! Will need to be extended to LW radiation -> done by CK (2014-05-23)
923
924
2/4
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 120 times.
 120 IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN
925
926 ✗ IF (ok_ade.AND.ok_aie) THEN
927
928 ! direct anthropogenic forcing
929 ✗ PSOLSWADAERO(:) = (ZFSDN_AERO(:,1,4) -ZFSUP_AERO(:,1,4)) -(ZFSDN_AERO(:,1,2) -ZFSUP_AERO(:,1,2))
930 ✗ PTOPSWADAERO(:) = (ZFSDN_AERO(:,KLEV+1,4) -ZFSUP_AERO(:,KLEV+1,4)) -(ZFSDN_AERO(:,KLEV+1,2) -ZFSUP_AERO(:,KLEV+1,2))
931 ✗ PSOLSWAD0AERO(:) = (ZFSDN0_AERO(:,1,4) -ZFSUP0_AERO(:,1,4)) -(ZFSDN0_AERO(:,1,2) -ZFSUP0_AERO(:,1,2))
932 ✗ PTOPSWAD0AERO(:) = (ZFSDN0_AERO(:,KLEV+1,4)-ZFSUP0_AERO(:,KLEV+1,4))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2))
933 ✗ IF(ok_volcan) THEN
934 ✗ PSWADAERO(:,:) = (ZFSDN_AERO(:,:,4) -ZFSUP_AERO(:,:,4)) -(ZFSDN_AERO(:,:,2) -ZFSUP_AERO(:,:,2)) !--NL
935 ENDIF
936
937 ! indirect anthropogenic forcing
938 ✗ PSOLSWAIAERO(:) = (ZFSDN_AERO(:,1,4) -ZFSUP_AERO(:,1,4)) -(ZFSDN_AERO(:,1,3) -ZFSUP_AERO(:,1,3))
939 ✗ PTOPSWAIAERO(:) = (ZFSDN_AERO(:,KLEV+1,4)-ZFSUP_AERO(:,KLEV+1,4))-(ZFSDN_AERO(:,KLEV+1,3)-ZFSUP_AERO(:,KLEV+1,3))
940
941 ! Cloud radiative forcing with natural aerosol for direct effect
942 ✗ PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,2) -ZFSUP_AERO(:,1,2)) -(ZFSDN0_AERO(:,1,2) -ZFSUP0_AERO(:,1,2))
943 ✗ PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2))
944 ! Cloud radiative forcing with anthropogenic aerosol for direct effect
945 ✗ PSOLSWCFAERO(:,2) = (ZFSDN_AERO(:,1,4) -ZFSUP_AERO(:,1,4)) -(ZFSDN0_AERO(:,1,4) -ZFSUP0_AERO(:,1,4))
946 ✗ PTOPSWCFAERO(:,2) = (ZFSDN_AERO(:,KLEV+1,4)-ZFSUP_AERO(:,KLEV+1,4))-(ZFSDN0_AERO(:,KLEV+1,4)-ZFSUP0_AERO(:,KLEV+1,4))
947 ! Cloud radiative forcing with no direct effect at all
948 ✗ PSOLSWCFAERO(:,3) = 0.0
949 ✗ PTOPSWCFAERO(:,3) = 0.0
950
951 ! LW direct anthropogenic forcing
952 ✗ PSOLLWADAERO(:) = (-LWDN_AERO(:,1,4) -LWUP_AERO(:,1,4)) -(-LWDN_AERO(:,1,2) -LWUP_AERO(:,1,2))
953 ✗ PTOPLWADAERO(:) = (-LWDN_AERO(:,KLEV+1,4) -LWUP_AERO(:,KLEV+1,4)) -(-LWDN_AERO(:,KLEV+1,2) -LWUP_AERO(:,KLEV+1,2))
954 ✗ PSOLLWAD0AERO(:) = (-LWDN0_AERO(:,1,4) -LWUP0_AERO(:,1,4)) -(-LWDN0_AERO(:,1,2) -LWUP0_AERO(:,1,2))
955 ✗ PTOPLWAD0AERO(:) = (-LWDN0_AERO(:,KLEV+1,4)-LWUP0_AERO(:,KLEV+1,4))-(-LWDN0_AERO(:,KLEV+1,2)-LWUP0_AERO(:,KLEV+1,2))
956 ✗ IF(ok_volcan) THEN
957 ✗ PLWADAERO(:,:) = (-LWDN_AERO(:,:,4) -LWUP_AERO(:,:,4)) -(-LWDN_AERO(:,:,2) -LWUP_AERO(:,:,2)) !--NL
958 ENDIF
959
960 ! LW indirect anthropogenic forcing
961 ✗ PSOLLWAIAERO(:) = (-LWDN_AERO(:,1,4) -LWUP_AERO(:,1,4)) -(-LWDN_AERO(:,1,3) -LWUP_AERO(:,1,3))
962 ✗ PTOPLWAIAERO(:) = (-LWDN_AERO(:,KLEV+1,4)-LWUP_AERO(:,KLEV+1,4))-(-LWDN_AERO(:,KLEV+1,3)-LWUP_AERO(:,KLEV+1,3))
963
964 ENDIF
965
966 ✗ IF (ok_ade.AND..NOT.ok_aie) THEN
967
968 ! direct anthropogenic forcing
969 ✗ PSOLSWADAERO(:) = (ZFSDN_AERO(:,1,3) -ZFSUP_AERO(:,1,3)) -(ZFSDN_AERO(:,1,1) -ZFSUP_AERO(:,1,1))
970 ✗ PTOPSWADAERO(:) = (ZFSDN_AERO(:,KLEV+1,3) -ZFSUP_AERO(:,KLEV+1,3)) -(ZFSDN_AERO(:,KLEV+1,1) -ZFSUP_AERO(:,KLEV+1,1))
971 ✗ PSOLSWAD0AERO(:) = (ZFSDN0_AERO(:,1,3) -ZFSUP0_AERO(:,1,3)) -(ZFSDN0_AERO(:,1,1) -ZFSUP0_AERO(:,1,1))
972 ✗ PTOPSWAD0AERO(:) = (ZFSDN0_AERO(:,KLEV+1,3)-ZFSUP0_AERO(:,KLEV+1,3))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1))
973 ✗ IF(ok_volcan) THEN
974 ✗ PSWADAERO(:,:) = (ZFSDN_AERO(:,:,3) -ZFSUP_AERO(:,:,3)) -(ZFSDN_AERO(:,:,1) -ZFSUP_AERO(:,:,1)) !--NL
975 ENDIF
976
977 ! indirect anthropogenic forcing
978 ✗ PSOLSWAIAERO(:) = 0.0
979 ✗ PTOPSWAIAERO(:) = 0.0
980
981 ! Cloud radiative forcing with natural aerosol for direct effect
982 ✗ PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,1) -ZFSUP_AERO(:,1,1)) -(ZFSDN0_AERO(:,1,1) -ZFSUP0_AERO(:,1,1))
983 ✗ PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1))
984 ! Cloud radiative forcing with anthropogenic aerosol for direct effect
985 ✗ PSOLSWCFAERO(:,2) = (ZFSDN_AERO(:,1,3) -ZFSUP_AERO(:,1,3)) -(ZFSDN0_AERO(:,1,3) -ZFSUP0_AERO(:,1,3))
986 ✗ PTOPSWCFAERO(:,2) = (ZFSDN_AERO(:,KLEV+1,3)-ZFSUP_AERO(:,KLEV+1,3))-(ZFSDN0_AERO(:,KLEV+1,3)-ZFSUP0_AERO(:,KLEV+1,3))
987 ! Cloud radiative forcing with no direct effect at all
988 ✗ PSOLSWCFAERO(:,3) = 0.0
989 ✗ PTOPSWCFAERO(:,3) = 0.0
990
991 ! LW direct anthropogenic forcing
992 ✗ PSOLLWADAERO(:) = (-LWDN_AERO(:,1,3) -LWUP_AERO(:,1,3)) -(-LWDN_AERO(:,1,1) -LWUP_AERO(:,1,1))
993 ✗ PTOPLWADAERO(:) = (-LWDN_AERO(:,KLEV+1,3) -LWUP_AERO(:,KLEV+1,3)) -(-LWDN_AERO(:,KLEV+1,1) -LWUP_AERO(:,KLEV+1,1))
994 ✗ PSOLLWAD0AERO(:) = (-LWDN0_AERO(:,1,3) -LWUP0_AERO(:,1,3)) -(-LWDN0_AERO(:,1,1) -LWUP0_AERO(:,1,1))
995 ✗ PTOPLWAD0AERO(:) = (-LWDN0_AERO(:,KLEV+1,3)-LWUP0_AERO(:,KLEV+1,3))-(-LWDN0_AERO(:,KLEV+1,1)-LWUP0_AERO(:,KLEV+1,1))
996 ✗ IF(ok_volcan) THEN
997 ✗ PLWADAERO(:,:) = (-LWDN_AERO(:,:,3) -LWUP_AERO(:,:,3)) -(-LWDN_AERO(:,:,1) -LWUP_AERO(:,:,1)) !--NL
998 ENDIF
999
1000 ! LW indirect anthropogenic forcing
1001 ✗ PSOLLWAIAERO(:) = 0.0
1002 ✗ PTOPLWAIAERO(:) = 0.0
1003
1004 ENDIF
1005
1006 ✗ IF (.NOT.ok_ade.AND.ok_aie) THEN
1007
1008 ! direct anthropogenic forcing
1009 ✗ PSOLSWADAERO(:) = 0.0
1010 ✗ PTOPSWADAERO(:) = 0.0
1011 ✗ PSOLSWAD0AERO(:) = 0.0
1012 ✗ PTOPSWAD0AERO(:) = 0.0
1013 ✗ IF(ok_volcan) THEN
1014 ✗ PSWADAERO(:,:) = 0.0 !--NL
1015 ENDIF
1016
1017 ! indirect anthropogenic forcing
1018 ✗ PSOLSWAIAERO(:) = (ZFSDN_AERO(:,1,2) -ZFSUP_AERO(:,1,2)) -(ZFSDN_AERO(:,1,1) -ZFSUP_AERO(:,1,1))
1019 ✗ PTOPSWAIAERO(:) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1))
1020
1021 ! Cloud radiative forcing with natural aerosol for direct effect
1022 ✗ PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,2) -ZFSUP_AERO(:,1,2)) -(ZFSDN0_AERO(:,1,2) -ZFSUP0_AERO(:,1,2))
1023 ✗ PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2))
1024 ! Cloud radiative forcing with anthropogenic aerosol for direct effect
1025 ✗ PSOLSWCFAERO(:,2) = 0.0
1026 ✗ PTOPSWCFAERO(:,2) = 0.0
1027 ! Cloud radiative forcing with no direct effect at all
1028 ✗ PSOLSWCFAERO(:,3) = 0.0
1029 ✗ PTOPSWCFAERO(:,3) = 0.0
1030
1031 ! LW direct anthropogenic forcing
1032 ✗ PSOLLWADAERO(:) = 0.0
1033 ✗ PTOPLWADAERO(:) = 0.0
1034 ✗ PSOLLWAD0AERO(:) = 0.0
1035 ✗ PTOPLWAD0AERO(:) = 0.0
1036 ✗ IF(ok_volcan) THEN
1037 ✗ PLWADAERO(:,:) = 0.0 !--NL
1038 ENDIF
1039
1040 ! LW indirect anthropogenic forcing
1041 ✗ PSOLLWAIAERO(:) = (-LWDN_AERO(:,1,2) -LWUP_AERO(:,1,2)) -(-LWDN_AERO(:,1,1) -LWUP_AERO(:,1,1))
1042 ✗ PTOPLWAIAERO(:) = (-LWDN_AERO(:,KLEV+1,2)-LWUP_AERO(:,KLEV+1,2))-(-LWDN_AERO(:,KLEV+1,1)-LWUP_AERO(:,KLEV+1,1))
1043
1044 ENDIF
1045
1046 ✗ IF (.NOT.ok_ade.AND..NOT.ok_aie) THEN
1047
1048 ! direct anthropogenic forcing
1049 ✗ PSOLSWADAERO(:) = 0.0
1050 ✗ PTOPSWADAERO(:) = 0.0
1051 ✗ PSOLSWAD0AERO(:) = 0.0
1052 ✗ PTOPSWAD0AERO(:) = 0.0
1053 ✗ IF(ok_volcan) THEN
1054 ✗ PSWADAERO(:,:) = 0.0 !--NL
1055 ENDIF
1056
1057 ! indirect anthropogenic forcing
1058 ✗ PSOLSWAIAERO(:) = 0.0
1059 ✗ PTOPSWAIAERO(:) = 0.0
1060
1061 ! Cloud radiative forcing with natural aerosol for direct effect
1062 ✗ PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,1) -ZFSUP_AERO(:,1,1)) -(ZFSDN0_AERO(:,1,1) -ZFSUP0_AERO(:,1,1))
1063 ✗ PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1))
1064 ! Cloud radiative forcing with anthropogenic aerosol for direct effect
1065 ✗ PSOLSWCFAERO(:,2) = 0.0
1066 ✗ PTOPSWCFAERO(:,2) = 0.0
1067 ! Cloud radiative forcing with no direct effect at all
1068 ✗ PSOLSWCFAERO(:,3) = 0.0
1069 ✗ PTOPSWCFAERO(:,3) = 0.0
1070
1071 ! LW direct anthropogenic forcing
1072 ✗ PSOLLWADAERO(:) = 0.0
1073 ✗ PTOPLWADAERO(:) = 0.0
1074 ✗ PSOLLWAD0AERO(:) = 0.0
1075 ✗ PTOPLWAD0AERO(:) = 0.0
1076 ✗ IF(ok_volcan) THEN
1077 ✗ PLWADAERO(:,:) = 0.0 !--NL
1078 ENDIF
1079
1080 ! LW indirect anthropogenic forcing
1081 ✗ PSOLLWAIAERO(:) = 0.0
1082 ✗ PTOPLWAIAERO(:) = 0.0
1083
1084 ENDIF
1085
1086 ENDIF
1087
1088 !IF (swaero_diag .OR. .NOT. AEROSOLFEEDBACK_ACTIVE) THEN
1089
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
 120 IF (.NOT. AEROSOLFEEDBACK_ACTIVE) THEN
1090 ! Cloudforcing without aerosol at all
1091 ✗ PSOLSWCFAERO(:,3) = (ZFSDN_AERO(:,1,5) -ZFSUP_AERO(:,1,5)) -(ZFSDN0_AERO(:,1,5) -ZFSUP0_AERO(:,1,5))
1092 ✗ PTOPSWCFAERO(:,3) = (ZFSDN_AERO(:,KLEV+1,5)-ZFSUP_AERO(:,KLEV+1,5))-(ZFSDN0_AERO(:,KLEV+1,5)-ZFSUP0_AERO(:,KLEV+1,5))
1093
1094 ENDIF
1095
1096
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
 120 IF (LHOOK) CALL DR_HOOK('RECMWF_AERO',1,ZHOOK_HANDLE)
1097 120 END SUBROUTINE RECMWF_AERO
1098