GCC Code Coverage Report


Directory: ./
File: phys/sw_aeroAR4.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 207 0.0%
Branches: 0 470 0.0%

Line Branch Exec Source
1 !
2 ! $Id$
3 !
4 SUBROUTINE SW_AEROAR4(PSCT, PRMU0, PFRAC, &
5 PPMB, PDP, &
6 PPSOL, PALBD, PALBP,&
7 PTAVE, PWV, PQS, POZON, PAER,&
8 PCLDSW, PTAU, POMEGA, PCG,&
9 PHEAT, PHEAT0,&
10 PALBPLA,PTOPSW,PSOLSW,PTOPSW0,PSOLSW0,&
11 ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
12 tauaero, pizaero, cgaero,&
13 PTAUA, POMEGAA,&
14 PTOPSWADAERO,PSOLSWADAERO,&
15 PTOPSWAD0AERO,PSOLSWAD0AERO,&
16 PTOPSWAIAERO,PSOLSWAIAERO,&
17 PTOPSWAERO,PTOPSW0AERO,&
18 PSOLSWAERO,PSOLSW0AERO,&
19 PTOPSWCFAERO,PSOLSWCFAERO,&
20 ok_ade, ok_aie, flag_aerosol, flag_aerosol_strat )
21
22 USE dimphy
23 USE phys_output_mod, ONLY : swaero_diag
24 USE print_control_mod, ONLY: lunout
25 USE aero_mod, ONLY : naero_grp
26 IMPLICIT NONE
27
28 !
29 ! $Header$
30 !
31 ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
32 ! veillez � n'utiliser que des ! pour les commentaires
33 ! et � bien positionner les & des lignes de continuation
34 ! (les placer en colonne 6 et en colonne 73)
35 !
36 !
37 ! A1.0 Fundamental constants
38 REAL RPI,RCLUM,RHPLA,RKBOL,RNAVO
39 ! A1.1 Astronomical constants
40 REAL RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA
41 ! A1.1.bis Constantes concernant l'orbite de la Terre:
42 REAL R_ecc, R_peri, R_incl
43 ! A1.2 Geoide
44 REAL RA,RG,R1SA
45 ! A1.3 Radiation
46 ! REAL RSIGMA,RI0
47 REAL RSIGMA
48 ! A1.4 Thermodynamic gas phase
49 REAL RMO3,RMCO2,RMC,RMCH4,RMN2O,RMCFC11,RMCFC12
50 REAL R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV
51 REAL RKAPPA,RETV, eps_w
52 ! A1.5,6 Thermodynamic liquid,solid phases
53 REAL RCW,RCS
54 ! A1.7 Thermodynamic transition of phase
55 REAL RLVTT,RLSTT,RLMLT,RTT,RATM
56 ! A1.8 Curve of saturation
57 REAL RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS
58 REAL RALPD,RBETD,RGAMD
59 !
60 COMMON/YOMCST/RPI ,RCLUM ,RHPLA ,RKBOL ,RNAVO &
61 & ,RDAY ,REA ,REPSM ,RSIYEA,RSIDAY,ROMEGA &
62 & ,R_ecc, R_peri, R_incl &
63 & ,RA ,RG ,R1SA &
64 & ,RSIGMA &
65 & ,R ,RMD ,RMV ,RD ,RV ,RCPD &
66 & ,RMO3 ,RMCO2 ,RMC ,RMCH4 ,RMN2O ,RMCFC11 ,RMCFC12 &
67 & ,RCPV ,RCVD ,RCVV ,RKAPPA,RETV, eps_w &
68 & ,RCW ,RCS &
69 & ,RLVTT ,RLSTT ,RLMLT ,RTT ,RATM &
70 & ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS &
71 & ,RALPD ,RBETD ,RGAMD
72 ! ------------------------------------------------------------------
73 !$OMP THREADPRIVATE(/YOMCST/)
74 ! $Id: clesphys.h 3435 2019-01-22 15:21:59Z fairhead $
75 !
76 ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
77 ! veillez \`a n'utiliser que des ! pour les commentaires
78 ! et \`a bien positionner les & des lignes de continuation
79 ! (les placer en colonne 6 et en colonne 73)
80 !
81 !..include cles_phys.h
82 !
83 INTEGER iflag_cycle_diurne
84 LOGICAL soil_model,new_oliq,ok_orodr,ok_orolf
85 LOGICAL ok_limitvrai
86 LOGICAL ok_all_xml
87 LOGICAL ok_lwoff
88 INTEGER nbapp_rad, iflag_con, nbapp_cv, nbapp_wk, iflag_ener_conserv
89 REAL co2_ppm, co2_ppm0, solaire
90 !FC
91 REAL Cd_frein
92 LOGICAL ok_suntime_rrtm
93 REAL(kind=8) RCO2, RCH4, RN2O, RCFC11, RCFC12
94 REAL(kind=8) RCO2_act, RCH4_act, RN2O_act, RCFC11_act, RCFC12_act
95 REAL(kind=8) CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt
96 !IM ajout CFMIP2/CMIP5
97 REAL(kind=8) RCO2_per,RCH4_per,RN2O_per,RCFC11_per,RCFC12_per
98 REAL(kind=8) CH4_ppb_per,N2O_ppb_per,CFC11_ppt_per,CFC12_ppt_per
99
100 !OM ---> correction du bilan d'eau global
101 !OM Correction sur precip KE
102 REAL cvl_corr
103 !OM Fonte calotte dans bilan eau
104 LOGICAL ok_lic_melt
105 !OB Depot de vapeur d eau sur la calotte pour le bilan eau
106 LOGICAL ok_lic_cond
107
108 !IM simulateur ISCCP
109 INTEGER top_height, overlap
110 !IM seuils cdrm, cdrh
111 REAL cdmmax, cdhmax
112 !IM param. stabilite s/ terres et en dehors
113 REAL ksta, ksta_ter, f_ri_cd_min
114 !IM ok_kzmin : clef calcul Kzmin dans la CL de surface cf FH
115 LOGICAL ok_kzmin
116 !IM, MAFo fmagic, pmagic : parametres - additionnel et multiplicatif -
117 ! pour regler l albedo sur ocean
118 REAL pbl_lmixmin_alpha
119 REAL fmagic, pmagic
120 ! Hauteur (imposee) du contenu en eau du sol
121 REAL qsol0,albsno0,evap0
122 ! Frottement au sol (Cdrag)
123 Real f_cdrag_ter,f_cdrag_oce
124 REAL min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce,f_z0qh_oce
125 REAL z0m_seaice,z0h_seaice
126 INTEGER iflag_gusts,iflag_z0_oce
127
128 ! Rugoro
129 Real f_rugoro,z0min
130
131 ! tau_gl : constante de rappel de la temperature a la surface de la glace
132 REAL tau_gl
133
134 !IM lev_histhf : niveau sorties 6h
135 !IM lev_histday : niveau sorties journalieres
136 !IM lev_histmth : niveau sorties mensuelles
137 !IM lev_histdayNMC : on peut sortir soit sur 8 (comme AR5) ou bien
138 ! sur 17 niveaux de pression
139 INTEGER lev_histhf, lev_histday, lev_histmth
140 INTEGER lev_histdayNMC
141 Integer lev_histins, lev_histLES
142 !IM ok_histNMC : sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC)
143 !IM freq_outNMC : frequences de sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC)
144 !IM freq_calNMC : frequences de calcul fis. hist*NMC.nc
145 LOGICAL ok_histNMC(3)
146 INTEGER levout_histNMC(3)
147 REAL freq_outNMC(3) , freq_calNMC(3)
148 CHARACTER(len=4) type_run
149 ! aer_type: pour utiliser un fichier constant dans readaerosol
150 CHARACTER(len=8) :: aer_type
151 LOGICAL ok_regdyn
152 REAL lonmin_ins, lonmax_ins, latmin_ins, latmax_ins
153 REAL ecrit_ins, ecrit_hf, ecrit_day
154 REAL ecrit_mth, ecrit_tra, ecrit_reg
155 REAL ecrit_LES
156 REAL freq_ISCCP, ecrit_ISCCP
157 REAL freq_COSP, freq_AIRS
158 LOGICAL :: ok_cosp,ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP
159 LOGICAL :: ok_airs
160 INTEGER :: ip_ebil_phy, iflag_rrtm, iflag_ice_thermo, NSW, iflag_albedo
161 LOGICAL :: ok_chlorophyll
162 LOGICAL :: ok_strato
163 LOGICAL :: ok_hines, ok_gwd_rando
164 LOGICAL :: ok_qch4
165 LOGICAL :: ok_conserv_q
166 LOGICAL :: adjust_tropopause
167 LOGICAL :: ok_daily_climoz
168 ! flag to bypass or not the phytrac module
169 INTEGER :: iflag_phytrac
170
171 COMMON/clesphys/ &
172 ! REAL FIRST
173 & co2_ppm, solaire &
174 & , RCO2, RCH4, RN2O, RCFC11, RCFC12 &
175 & , RCO2_act, RCH4_act, RN2O_act, RCFC11_act, RCFC12_act &
176 & , RCO2_per, RCH4_per, RN2O_per, RCFC11_per, RCFC12_per &
177 & , CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt &
178 & , CH4_ppb_per, N2O_ppb_per, CFC11_ppt_per, CFC12_ppt_per &
179 & , cdmmax,cdhmax,ksta,ksta_ter,f_ri_cd_min,pbl_lmixmin_alpha &
180 & , fmagic, pmagic &
181 & , f_cdrag_ter,f_cdrag_oce,f_rugoro,z0min,tau_gl &
182 & , min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce,f_z0qh_oce &
183 & , z0m_seaice,z0h_seaice &
184 & , freq_outNMC, freq_calNMC &
185 & , lonmin_ins, lonmax_ins, latmin_ins, latmax_ins &
186 & , freq_ISCCP, ecrit_ISCCP, freq_COSP, freq_AIRS &
187 & , cvl_corr &
188 & , qsol0,albsno0,evap0 &
189 & , co2_ppm0 &
190 !FC
191 & , Cd_frein &
192 & , ecrit_LES &
193 & , ecrit_ins, ecrit_hf, ecrit_day &
194 & , ecrit_mth, ecrit_tra, ecrit_reg &
195 ! THEN INTEGER AND LOGICALS
196 & , top_height &
197 & , iflag_cycle_diurne, soil_model, new_oliq &
198 & , ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad &
199 & , iflag_con, nbapp_cv, nbapp_wk &
200 & , iflag_ener_conserv &
201 & , ok_suntime_rrtm &
202 & , overlap &
203 & , ok_kzmin &
204 & , lev_histhf, lev_histday, lev_histmth &
205 & , lev_histins, lev_histLES, lev_histdayNMC, levout_histNMC &
206 & , ok_histNMC &
207 & , type_run, ok_regdyn, ok_cosp, ok_airs &
208 & , ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP &
209 & , ip_ebil_phy &
210 & , iflag_gusts ,iflag_z0_oce &
211 & , ok_lic_melt, ok_lic_cond, aer_type &
212 & , iflag_rrtm, ok_strato,ok_hines, ok_qch4 &
213 & , iflag_ice_thermo, ok_gwd_rando, NSW, iflag_albedo &
214 & , ok_chlorophyll,ok_conserv_q, adjust_tropopause &
215 & , ok_daily_climoz, ok_all_xml, ok_lwoff &
216 & , iflag_phytrac
217
218 save /clesphys/
219 !$OMP THREADPRIVATE(/clesphys/)
220 !
221 ! ------------------------------------------------------------------
222 !
223 ! PURPOSE.
224 ! --------
225 !
226 ! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
227 ! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
228 !
229 ! METHOD.
230 ! -------
231 !
232 ! 1. COMPUTES ABSORBER AMOUNTS (SWU)
233 ! 2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL (SW1S)
234 ! 3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL (SW2S)
235 !
236 ! REFERENCE.
237 ! ----------
238 !
239 ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
240 ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
241 !
242 ! AUTHOR.
243 ! -------
244 ! JEAN-JACQUES MORCRETTE *ECMWF*
245 !
246 ! MODIFICATIONS.
247 ! --------------
248 ! ORIGINAL : 89-07-14
249 ! 1995-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo
250 ! 2003-11-27 J. QUAAS Introduce aerosol forcings (based on BOUCHER)
251 ! 2009-04 A. COZIC - C.DEANDREIS Indroduce NAT/BC/POM/DUST/SS aerosol forcing
252 ! 2012-09 O. BOUCHER - reorganise aerosol cases with ok_ade, ok_aie, flag_aerosol
253 ! ------------------------------------------------------------------
254 !
255 !* ARGUMENTS:
256 !
257 REAL(KIND=8) PSCT ! constante solaire (valeur conseillee: 1370)
258
259 REAL(KIND=8) PPSOL(KDLON) ! SURFACE PRESSURE (PA)
260 REAL(KIND=8) PDP(KDLON,KFLEV) ! LAYER THICKNESS (PA)
261 REAL(KIND=8) PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
262
263 REAL(KIND=8) PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
264 REAL(KIND=8) PFRAC(KDLON) ! fraction de la journee
265
266 REAL(KIND=8) PTAVE(KDLON,KFLEV) ! LAYER TEMPERATURE (K)
267 REAL(KIND=8) PWV(KDLON,KFLEV) ! SPECIFI! HUMIDITY (KG/KG)
268 REAL(KIND=8) PQS(KDLON,KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
269 REAL(KIND=8) POZON(KDLON,KFLEV) ! OZONE CONCENTRATION (KG/KG)
270 REAL(KIND=8) PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS
271
272 REAL(KIND=8) PALBD(KDLON,2) ! albedo du sol (lumiere diffuse)
273 REAL(KIND=8) PALBP(KDLON,2) ! albedo du sol (lumiere parallele)
274
275 REAL(KIND=8) PCLDSW(KDLON,KFLEV) ! CLOUD FRACTION
276 REAL(KIND=8) PTAU(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS (pre-industrial value)
277 REAL(KIND=8) PCG(KDLON,2,KFLEV) ! ASYMETRY FACTOR
278 REAL(KIND=8) POMEGA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO
279
280 REAL(KIND=8) PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY)
281 REAL(KIND=8) PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
282 REAL(KIND=8) PALBPLA(KDLON) ! PLANETARY ALBEDO
283 REAL(KIND=8) PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
284 REAL(KIND=8) PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
285 REAL(KIND=8) PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
286 REAL(KIND=8) PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
287 !
288 !* LOCAL VARIABLES:
289 !
290 real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
291
292 REAL(KIND=8) ZOZ(KDLON,KFLEV)
293 ! column-density of ozone in layer, in kilo-Dobsons
294
295 REAL(KIND=8) ZAKI(KDLON,2)
296 REAL(KIND=8) ZCLD(KDLON,KFLEV)
297 REAL(KIND=8) ZCLEAR(KDLON)
298 REAL(KIND=8) ZDSIG(KDLON,KFLEV)
299 REAL(KIND=8) ZFACT(KDLON)
300 REAL(KIND=8) ZFD(KDLON,KFLEV+1)
301 REAL(KIND=8) ZFDOWN(KDLON,KFLEV+1)
302 REAL(KIND=8) ZFU(KDLON,KFLEV+1)
303 REAL(KIND=8) ZFUP(KDLON,KFLEV+1)
304 REAL(KIND=8) ZRMU(KDLON)
305 REAL(KIND=8) ZSEC(KDLON)
306 REAL(KIND=8) ZUD(KDLON,5,KFLEV+1)
307 REAL(KIND=8) ZCLDSW0(KDLON,KFLEV)
308
309 REAL(KIND=8) ZFSUP(KDLON,KFLEV+1)
310 REAL(KIND=8) ZFSDN(KDLON,KFLEV+1)
311 REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1)
312 REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1)
313
314 INTEGER inu, jl, jk, i, k, kpl1
315
316 INTEGER swpas ! Every swpas steps, sw is calculated
317 PARAMETER(swpas=1)
318
319 INTEGER, SAVE :: itapsw = 0
320 !$OMP THREADPRIVATE(itapsw)
321 LOGICAL, SAVE :: appel1er = .TRUE.
322 !$OMP THREADPRIVATE(appel1er)
323 LOGICAL, SAVE :: initialized = .FALSE.
324 !$OMP THREADPRIVATE(initialized)
325
326 !jq-local flag introduced for aerosol forcings
327 REAL(KIND=8), SAVE :: flag_aer
328 !$OMP THREADPRIVATE(flag_aer)
329
330 LOGICAL ok_ade, ok_aie ! use aerosol forcings or not?
331 INTEGER flag_aerosol_strat ! use stratospehric aerosols
332 INTEGER flag_aerosol ! global flag for aerosol 0 (no aerosol) or 1-5 (aerosols)
333 REAL(KIND=8) tauaero(kdlon,kflev,naero_grp,2) ! aerosol optical properties
334 REAL(KIND=8) pizaero(kdlon,kflev,naero_grp,2) ! (see aeropt.F)
335 REAL(KIND=8) cgaero(kdlon,kflev,naero_grp,2) ! -"-
336 REAL(KIND=8) PTAUA(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS (present-day value)
337 REAL(KIND=8) POMEGAA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO
338 REAL(KIND=8) PTOPSWADAERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
339 REAL(KIND=8) PSOLSWADAERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
340 REAL(KIND=8) PTOPSWAD0AERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
341 REAL(KIND=8) PSOLSWAD0AERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
342 REAL(KIND=8) PTOPSWAIAERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
343 REAL(KIND=8) PSOLSWAIAERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
344 REAL(KIND=8) PTOPSWAERO(KDLON,9) ! SW TOA AS DRF nat & ant
345 REAL(KIND=8) PTOPSW0AERO(KDLON,9) ! SW SRF AS DRF nat & ant
346 REAL(KIND=8) PSOLSWAERO(KDLON,9) ! SW TOA CS DRF nat & ant
347 REAL(KIND=8) PSOLSW0AERO(KDLON,9) ! SW SRF CS DRF nat & ant
348 REAL(KIND=8) PTOPSWCFAERO(KDLON,3) ! SW TOA AS cloudRF nat & ant
349 REAL(KIND=8) PSOLSWCFAERO(KDLON,3) ! SW SRF AS cloudRF nat & ant
350
351 !jq - Fluxes including aerosol effects
352 REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAD_AERO(:,:)
353 !$OMP THREADPRIVATE(ZFSUPAD_AERO)
354 REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAD_AERO(:,:)
355 !$OMP THREADPRIVATE(ZFSDNAD_AERO)
356 !jq - Fluxes including aerosol effects
357 REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAD0_AERO(:,:)
358 !$OMP THREADPRIVATE(ZFSUPAD0_AERO)
359 REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAD0_AERO(:,:)
360 !$OMP THREADPRIVATE(ZFSDNAD0_AERO)
361 REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAI_AERO(:,:)
362 !$OMP THREADPRIVATE(ZFSUPAI_AERO)
363 REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAI_AERO(:,:)
364 !$OMP THREADPRIVATE(ZFSDNAI_AERO)
365 REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUP_AERO(:,:,:)
366 !$OMP THREADPRIVATE(ZFSUP_AERO)
367 REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDN_AERO(:,:,:)
368 !$OMP THREADPRIVATE(ZFSDN_AERO)
369 REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUP0_AERO(:,:,:)
370 !$OMP THREADPRIVATE(ZFSUP0_AERO)
371 REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDN0_AERO(:,:,:)
372 !$OMP THREADPRIVATE(ZFSDN0_AERO)
373
374 ! Key to define the aerosol effect acting on climate
375 ! OB: AEROSOLFEEDBACK_ACTIVE is now a LOGICAL
376 ! TRUE: fluxes use natural and/or anthropogenic aerosols according to ok_ade and ok_aie, DEFAULT
377 ! FALSE: fluxes use no aerosols (case 1)
378
379 LOGICAL,SAVE :: AEROSOLFEEDBACK_ACTIVE = .TRUE.
380 !$OMP THREADPRIVATE(AEROSOLFEEDBACK_ACTIVE)
381
382 CHARACTER (LEN=20) :: modname='sw_aeroAR4'
383 CHARACTER (LEN=80) :: abort_message
384
385 IF(.NOT.initialized) THEN
386 flag_aer=0.
387 initialized=.TRUE.
388 ALLOCATE(ZFSUPAD_AERO(KDLON,KFLEV+1))
389 ALLOCATE(ZFSDNAD_AERO(KDLON,KFLEV+1))
390 ALLOCATE(ZFSUPAD0_AERO(KDLON,KFLEV+1))
391 ALLOCATE(ZFSDNAD0_AERO(KDLON,KFLEV+1))
392 ALLOCATE(ZFSUPAI_AERO(KDLON,KFLEV+1))
393 ALLOCATE(ZFSDNAI_AERO(KDLON,KFLEV+1))
394 !-OB decrease size of these arrays to what is needed
395 ! | direct effect
396 !ind effect | no aerosol natural total
397 !natural (PTAU) | 1 3 2 --ZFSUP/ZFSDN
398 !total (PTAUA) | 5 4 --ZFSUP/ZFSDN
399 !no cloud | 1 3 2 --ZFSUP0/ZFSDN0
400 ! so we need which case when ?
401 ! ok_ade and ok_aie = 4-5, 4-2 and 2
402 ! ok_ade and not ok_aie = 2-3 and 2
403 ! not ok_ade and ok_aie = 5-3 and 5
404 ! not ok_ade and not ok_aie = 3
405 ! therefore the cases have the folliwng switches
406 ! 3 = not ok_ade or not ok_aie
407 ! 4 = ok_ade and ok_aie
408 ! 2 = ok_ade
409 ! 5 = ok_aie
410 ALLOCATE(ZFSUP_AERO (KDLON,KFLEV+1,5))
411 ALLOCATE(ZFSDN_AERO (KDLON,KFLEV+1,5))
412 ALLOCATE(ZFSUP0_AERO(KDLON,KFLEV+1,3))
413 ALLOCATE(ZFSDN0_AERO(KDLON,KFLEV+1,3))
414 ! end OB modif
415 ZFSUPAD_AERO(:,:)=0.
416 ZFSDNAD_AERO(:,:)=0.
417 ZFSUPAD0_AERO(:,:)=0.
418 ZFSDNAD0_AERO(:,:)=0.
419 ZFSUPAI_AERO(:,:)=0.
420 ZFSDNAI_AERO(:,:)=0.
421 ZFSUP_AERO (:,:,:)=0.
422 ZFSDN_AERO (:,:,:)=0.
423 ZFSUP0_AERO(:,:,:)=0.
424 ZFSDN0_AERO(:,:,:)=0.
425 ENDIF
426
427 IF (appel1er) THEN
428 WRITE(lunout,*)'SW calling frequency : ', swpas
429 WRITE(lunout,*) " In general, it should be 1"
430 appel1er = .FALSE.
431 ENDIF
432 ! ------------------------------------------------------------------
433 IF (MOD(itapsw,swpas).EQ.0) THEN
434
435 DO JK = 1 , KFLEV
436 DO JL = 1, KDLON
437 ZCLDSW0(JL,JK) = 0.0
438 ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG &
439 *PDP(JL,JK)*(101325.0/PPSOL(JL))
440 ENDDO
441 ENDDO
442
443 ! clear sky with no aerosols at all is computed IF ACTIVEFEEDBACK_ACTIVE is false or for extended diag
444 IF ( swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol .EQ. 0 ) THEN
445
446 ! clear-sky: zero aerosol effect
447 flag_aer=0.0
448 CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
449 PRMU0,PFRAC,PTAVE,PWV,&
450 ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
451 INU = 1
452 CALL SW1S_LMDAR4(INU,PAER, flag_aer, &
453 tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
454 PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
455 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
456 ZFD, ZFU)
457 INU = 2
458 CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
459 tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
460 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
461 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
462 PWV, PQS,&
463 ZFDOWN, ZFUP)
464 DO JK = 1 , KFLEV+1
465 DO JL = 1, KDLON
466 ZFSUP0_AERO(JL,JK,1) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
467 ZFSDN0_AERO(JL,JK,1) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
468 ENDDO
469 ENDDO
470 ENDIF ! swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE
471
472 ! cloudy sky with no aerosols at all is either computed IF no indirect effect is asked for, or for extended diag
473 IF ( swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol .EQ. 0 ) THEN
474 ! cloudy-sky: zero aerosol effect
475 flag_aer=0.0
476 CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
477 PRMU0,PFRAC,PTAVE,PWV,&
478 ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
479 INU = 1
480 CALL SW1S_LMDAR4(INU, PAER, flag_aer, &
481 tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
482 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
483 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
484 ZFD, ZFU)
485 INU = 2
486 CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
487 tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
488 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
489 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
490 PWV, PQS,&
491 ZFDOWN, ZFUP)
492
493 DO JK = 1 , KFLEV+1
494 DO JL = 1, KDLON
495 ZFSUP_AERO(JL,JK,1) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
496 ZFSDN_AERO(JL,JK,1) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
497 ENDDO
498 ENDDO
499 ENDIF ! swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE
500
501 IF (flag_aerosol.GT.0 .OR. flag_aerosol_strat.GT.0) THEN
502
503 IF (ok_ade.and.swaero_diag .or. .not. ok_ade) THEN
504
505 ! clear sky direct effect natural aerosol
506 ! CAS AER (3)
507 flag_aer=1.0
508 CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
509 PRMU0,PFRAC,PTAVE,PWV,&
510 ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
511 INU = 1
512 CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
513 tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
514 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
515 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
516 ZFD, ZFU)
517 INU = 2
518 CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
519 tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
520 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
521 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
522 PWV, PQS,&
523 ZFDOWN, ZFUP)
524
525 DO JK = 1 , KFLEV+1
526 DO JL = 1, KDLON
527 ZFSUP0_AERO(JL,JK,3) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
528 ZFSDN0_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
529 ENDDO
530 ENDDO
531 ENDIF !--end not swaero_diag or not ok_ade
532
533 IF (ok_ade) THEN
534
535 ! clear sky direct effect of total aerosol
536 ! CAS AER (2)
537 flag_aer=1.0
538 CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
539 PRMU0,PFRAC,PTAVE,PWV,&
540 ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
541 INU = 1
542 CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
543 tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
544 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
545 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
546 ZFD, ZFU)
547 INU = 2
548 CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
549 tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
550 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
551 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
552 PWV, PQS,&
553 ZFDOWN, ZFUP)
554
555 DO JK = 1 , KFLEV+1
556 DO JL = 1, KDLON
557 ZFSUP0_AERO(JL,JK,2) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
558 ZFSDN0_AERO(JL,JK,2) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
559 ENDDO
560 ENDDO
561
562 ! cloudy-sky with natural aerosols for indirect effect
563 ! but total aerosols for direct effect
564 ! PTAU
565 ! CAS AER (2)
566 flag_aer=1.0
567 CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
568 PRMU0,PFRAC,PTAVE,PWV,&
569 ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
570 INU = 1
571 CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
572 tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
573 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
574 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
575 ZFD, ZFU)
576 INU = 2
577 CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
578 tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
579 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
580 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
581 PWV, PQS,&
582 ZFDOWN, ZFUP)
583
584 DO JK = 1 , KFLEV+1
585 DO JL = 1, KDLON
586 ZFSUP_AERO(JL,JK,2) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
587 ZFSDN_AERO(JL,JK,2) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
588 ENDDO
589 ENDDO
590
591 ENDIF !-end ok_ade
592
593 IF ( .not. ok_ade .or. .not. ok_aie ) THEN
594
595 ! cloudy-sky with natural aerosols for indirect effect
596 ! and natural aerosols for direct effect
597 ! PTAU
598 ! CAS AER (3)
599 ! cloudy-sky direct effect natural aerosol
600 flag_aer=1.0
601 CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
602 PRMU0,PFRAC,PTAVE,PWV,&
603 ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
604 INU = 1
605 CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
606 tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
607 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
608 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
609 ZFD, ZFU)
610 INU = 2
611 CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
612 tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
613 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
614 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
615 PWV, PQS,&
616 ZFDOWN, ZFUP)
617
618 DO JK = 1 , KFLEV+1
619 DO JL = 1, KDLON
620 ZFSUP_AERO(JL,JK,3) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
621 ZFSDN_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
622 ENDDO
623 ENDDO
624
625 ENDIF !--true/false or false/true
626
627 IF (ok_ade .and. ok_aie) THEN
628
629 ! cloudy-sky with total aerosols for indirect effect
630 ! and total aerosols for direct effect
631 ! PTAUA
632 ! CAS AER (2)
633 flag_aer=1.0
634 CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
635 PRMU0,PFRAC,PTAVE,PWV,&
636 ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
637 INU = 1
638 CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
639 tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
640 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
641 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
642 ZFD, ZFU)
643 INU = 2
644 CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
645 tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
646 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
647 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
648 PWV, PQS,&
649 ZFDOWN, ZFUP)
650
651 DO JK = 1 , KFLEV+1
652 DO JL = 1, KDLON
653 ZFSUP_AERO(JL,JK,4) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
654 ZFSDN_AERO(JL,JK,4) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
655 ENDDO
656 ENDDO
657
658 ENDIF ! ok_ade .and. ok_aie
659
660 IF (ok_aie) THEN
661 ! cloudy-sky with total aerosols for indirect effect
662 ! and natural aerosols for direct effect
663 ! PTAUA
664 ! CAS AER (3)
665 flag_aer=1.0
666 CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
667 PRMU0,PFRAC,PTAVE,PWV,&
668 ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
669 INU = 1
670 CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
671 tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
672 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
673 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
674 ZFD, ZFU)
675 INU = 2
676 CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
677 tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
678 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
679 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
680 PWV, PQS,&
681 ZFDOWN, ZFUP)
682
683 DO JK = 1 , KFLEV+1
684 DO JL = 1, KDLON
685 ZFSUP_AERO(JL,JK,5) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
686 ZFSDN_AERO(JL,JK,5) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
687 ENDDO
688 ENDDO
689
690 ENDIF ! ok_aie
691
692 ENDIF !--if flag_aerosol GT 0 OR flag_aerosol_strat GT 0
693
694 itapsw = 0
695 ENDIF
696 itapsw = itapsw + 1
697
698 IF ( AEROSOLFEEDBACK_ACTIVE .AND. (flag_aerosol.GT.0 .OR. flag_aerosol_strat.GT.0) ) THEN
699 IF ( ok_ade .and. ok_aie ) THEN
700 ZFSUP(:,:) = ZFSUP_AERO(:,:,4)
701 ZFSDN(:,:) = ZFSDN_AERO(:,:,4)
702 ZFSUP0(:,:) = ZFSUP0_AERO(:,:,2)
703 ZFSDN0(:,:) = ZFSDN0_AERO(:,:,2)
704 ENDIF
705
706 IF ( ok_ade .and. (.not. ok_aie) ) THEN
707 ZFSUP(:,:) = ZFSUP_AERO(:,:,2)
708 ZFSDN(:,:) = ZFSDN_AERO(:,:,2)
709 ZFSUP0(:,:) = ZFSUP0_AERO(:,:,2)
710 ZFSDN0(:,:) = ZFSDN0_AERO(:,:,2)
711 ENDIF
712
713 IF ( (.not. ok_ade) .and. ok_aie ) THEN
714 ZFSUP(:,:) = ZFSUP_AERO(:,:,5)
715 ZFSDN(:,:) = ZFSDN_AERO(:,:,5)
716 ZFSUP0(:,:) = ZFSUP0_AERO(:,:,3)
717 ZFSDN0(:,:) = ZFSDN0_AERO(:,:,3)
718 ENDIF
719
720 IF ((.not. ok_ade) .and. (.not. ok_aie)) THEN
721 ZFSUP(:,:) = ZFSUP_AERO(:,:,3)
722 ZFSDN(:,:) = ZFSDN_AERO(:,:,3)
723 ZFSUP0(:,:) = ZFSUP0_AERO(:,:,3)
724 ZFSDN0(:,:) = ZFSDN0_AERO(:,:,3)
725 ENDIF
726
727 ! MS the following allows to compute the forcing diagostics without
728 ! letting the aerosol forcing act on the meteorology
729 ! SEE logic above
730 ELSE
731 ZFSUP(:,:) = ZFSUP_AERO(:,:,1)
732 ZFSDN(:,:) = ZFSDN_AERO(:,:,1)
733 ZFSUP0(:,:) = ZFSUP0_AERO(:,:,1)
734 ZFSDN0(:,:) = ZFSDN0_AERO(:,:,1)
735 ENDIF
736
737 ! Now computes heating rates
738 DO k = 1, KFLEV
739 kpl1 = k+1
740 DO i = 1, KDLON
741 PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k))-(ZFSDN(i,k)-ZFSDN(i,kpl1))
742 PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
743 PHEAT0(i,k) = -(ZFSUP0(i,kpl1)-ZFSUP0(i,k))-(ZFSDN0(i,k)-ZFSDN0(i,kpl1))
744 PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k)
745 ENDDO
746 ENDDO
747
748 DO i = 1, KDLON
749 ! effective SW surface albedo calculation
750 PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20)
751
752 ! clear sky net fluxes at TOA and SRF
753 PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)
754 PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)
755
756 ! cloudy sky net fluxes at TOA and SRF
757 PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)
758 PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)
759
760 ! net anthropogenic forcing direct and 1st indirect effect diagnostics
761 ! requires a natural aerosol field read and used
762 ! Difference of net fluxes from double call to radiation
763
764 IF (ok_ade) THEN
765
766 ! indices 1: natural; 2 anthropogenic
767
768 ! TOA/SRF all sky natural forcing
769 PSOLSWAERO(i,1) = (ZFSDN_AERO(i,1,3) - ZFSUP_AERO(i,1,3))-(ZFSDN_AERO(i,1,1) - ZFSUP_AERO(i,1,1))
770 PTOPSWAERO(i,1) = (ZFSDN_AERO(i,KFLEV+1,3) - ZFSUP_AERO(i,KFLEV+1,3))- (ZFSDN_AERO(i,KFLEV+1,1) - ZFSUP_AERO(i,KFLEV+1,1))
771
772 ! TOA/SRF clear sky natural forcing
773 PSOLSW0AERO(i,1) = (ZFSDN0_AERO(i,1,3) - ZFSUP0_AERO(i,1,3))-(ZFSDN0_AERO(i,1,1) - ZFSUP0_AERO(i,1,1))
774 PTOPSW0AERO(i,1) = (ZFSDN0_AERO(i,KFLEV+1,3) - ZFSUP0_AERO(i,KFLEV+1,3))-(ZFSDN0_AERO(i,KFLEV+1,1) - ZFSUP0_AERO(i,KFLEV+1,1))
775
776 IF (ok_aie) THEN
777
778 ! TOA/SRF all sky anthropogenic forcing
779 PSOLSWAERO(i,2) = (ZFSDN_AERO(i,1,4) - ZFSUP_AERO(i,1,4))-(ZFSDN_AERO(i,1,5) - ZFSUP_AERO(i,1,5))
780 PTOPSWAERO(i,2) = (ZFSDN_AERO(i,KFLEV+1,4) - ZFSUP_AERO(i,KFLEV+1,4))- (ZFSDN_AERO(i,KFLEV+1,5) - ZFSUP_AERO(i,KFLEV+1,5))
781
782 ELSE
783
784 ! TOA/SRF all sky anthropogenic forcing
785 PSOLSWAERO(i,2) = (ZFSDN_AERO(i,1,2) - ZFSUP_AERO(i,1,2))-(ZFSDN_AERO(i,1,3) - ZFSUP_AERO(i,1,3))
786 PTOPSWAERO(i,2) = (ZFSDN_AERO(i,KFLEV+1,2) - ZFSUP_AERO(i,KFLEV+1,2))- (ZFSDN_AERO(i,KFLEV+1,3) - ZFSUP_AERO(i,KFLEV+1,3))
787
788 ENDIF
789
790 ! TOA/SRF clear sky anthropogenic forcing
791 PSOLSW0AERO(i,2) = (ZFSDN0_AERO(i,1,2) - ZFSUP0_AERO(i,1,2))-(ZFSDN0_AERO(i,1,3) - ZFSUP0_AERO(i,1,3))
792 PTOPSW0AERO(i,2) = (ZFSDN0_AERO(i,KFLEV+1,2) - ZFSUP0_AERO(i,KFLEV+1,2))-(ZFSDN0_AERO(i,KFLEV+1,3) - ZFSUP0_AERO(i,KFLEV+1,3))
793
794 ! direct anthropogenic forcing , as in old LMDzT, however differences of net fluxes
795 PSOLSWADAERO(i) = PSOLSWAERO(i,2)
796 PTOPSWADAERO(i) = PTOPSWAERO(i,2)
797 PSOLSWAD0AERO(i) = PSOLSW0AERO(i,2)
798 PTOPSWAD0AERO(i) = PTOPSW0AERO(i,2)
799
800 ! OB: these diagnostics may not always work but who need them
801 ! Cloud forcing indices 1: natural; 2 anthropogenic; 3: zero aerosol direct effect
802 ! Instantaneously computed cloudy sky direct aerosol effect, cloud forcing due to aerosols above clouds
803 ! natural
804 PSOLSWCFAERO(i,1) = PSOLSWAERO(i,1) - PSOLSW0AERO(i,1)
805 PTOPSWCFAERO(i,1) = PTOPSWAERO(i,1) - PTOPSW0AERO(i,1)
806
807 ! Instantaneously computed cloudy SKY DIRECT aerosol effect, cloud forcing due to aerosols above clouds
808 ! anthropogenic
809 PSOLSWCFAERO(i,2) = PSOLSWAERO(i,2) - PSOLSW0AERO(i,2)
810 PTOPSWCFAERO(i,2) = PTOPSWAERO(i,2) - PTOPSW0AERO(i,2)
811
812 ! Cloudforcing without aerosol
813 ! zero
814 PSOLSWCFAERO(i,3) = (ZFSDN_AERO(i,1,1) - ZFSUP_AERO(i,1,1))-(ZFSDN0_AERO(i,1,1) - ZFSUP0_AERO(i,1,1))
815 PTOPSWCFAERO(i,3) = (ZFSDN_AERO(i,KFLEV+1,1) - ZFSUP_AERO(i,KFLEV+1,1))- (ZFSDN0_AERO(i,KFLEV+1,1) - ZFSUP0_AERO(i,KFLEV+1,1))
816
817 ENDIF
818
819 IF (ok_aie) THEN
820 IF (ok_ade) THEN
821 PSOLSWAIAERO(i) = (ZFSDN_AERO(i,1,4) - ZFSUP_AERO(i,1,4))-(ZFSDN_AERO(i,1,2) - ZFSUP_AERO(i,1,2))
822 PTOPSWAIAERO(i) = (ZFSDN_AERO(i,KFLEV+1,4) - ZFSUP_AERO(i,KFLEV+1,4))-(ZFSDN_AERO(i,KFLEV+1,2) - ZFSUP_AERO(i,KFLEV+1,2))
823 ELSE
824 PSOLSWAIAERO(i) = (ZFSDN_AERO(i,1,5) - ZFSUP_AERO(i,1,5))-(ZFSDN_AERO(i,1,3) - ZFSUP_AERO(i,1,3))
825 PTOPSWAIAERO(i) = (ZFSDN_AERO(i,KFLEV+1,5) - ZFSUP_AERO(i,KFLEV+1,5))-(ZFSDN_AERO(i,KFLEV+1,3) - ZFSUP_AERO(i,KFLEV+1,3))
826 ENDIF
827 ENDIF
828
829 ENDDO
830
831 END SUBROUTINE SW_AEROAR4
832