LMDZ
sw_aeroAR4.F90
Go to the documentation of this file.
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 #include "YOMCST.h"
29 #include "clesphys.h"
30  !
31  ! ------------------------------------------------------------------
32  !
33  ! PURPOSE.
34  ! --------
35  !
36  ! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
37  ! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
38  !
39  ! METHOD.
40  ! -------
41  !
42  ! 1. COMPUTES ABSORBER AMOUNTS (SWU)
43  ! 2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL (SW1S)
44  ! 3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL (SW2S)
45  !
46  ! REFERENCE.
47  ! ----------
48  !
49  ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
50  ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
51  !
52  ! AUTHOR.
53  ! -------
54  ! JEAN-JACQUES MORCRETTE *ECMWF*
55  !
56  ! MODIFICATIONS.
57  ! --------------
58  ! ORIGINAL : 89-07-14
59  ! 1995-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo
60  ! 2003-11-27 J. QUAAS Introduce aerosol forcings (based on BOUCHER)
61  ! 2009-04 A. COZIC - C.DEANDREIS Indroduce NAT/BC/POM/DUST/SS aerosol forcing
62  ! 2012-09 O. BOUCHER - reorganise aerosol cases with ok_ade, ok_aie, flag_aerosol
63  ! ------------------------------------------------------------------
64  !
65  !* ARGUMENTS:
66  !
67  REAL(KIND=8) PSCT ! constante solaire (valeur conseillee: 1370)
68 
69  REAL(KIND=8) PPSOL(kdlon) ! SURFACE PRESSURE (PA)
70  REAL(KIND=8) PDP(kdlon,kflev) ! LAYER THICKNESS (PA)
71  REAL(KIND=8) PPMB(kdlon,kflev+1) ! HALF-LEVEL PRESSURE (MB)
72 
73  REAL(KIND=8) PRMU0(kdlon) ! COSINE OF ZENITHAL ANGLE
74  REAL(KIND=8) PFRAC(kdlon) ! fraction de la journee
75 
76  REAL(KIND=8) PTAVE(kdlon,kflev) ! LAYER TEMPERATURE (K)
77  REAL(KIND=8) PWV(kdlon,kflev) ! SPECIFI! HUMIDITY (KG/KG)
78  REAL(KIND=8) PQS(kdlon,kflev) ! SATURATED WATER VAPOUR (KG/KG)
79  REAL(KIND=8) POZON(kdlon,kflev) ! OZONE CONCENTRATION (KG/KG)
80  REAL(KIND=8) PAER(kdlon,kflev,5) ! AEROSOLS' OPTICAL THICKNESS
81 
82  REAL(KIND=8) PALBD(kdlon,2) ! albedo du sol (lumiere diffuse)
83  REAL(KIND=8) PALBP(kdlon,2) ! albedo du sol (lumiere parallele)
84 
85  REAL(KIND=8) PCLDSW(kdlon,kflev) ! CLOUD FRACTION
86  REAL(KIND=8) PTAU(kdlon,2,kflev) ! CLOUD OPTICAL THICKNESS (pre-industrial value)
87  REAL(KIND=8) PCG(kdlon,2,kflev) ! ASYMETRY FACTOR
88  REAL(KIND=8) POMEGA(kdlon,2,kflev) ! SINGLE SCATTERING ALBEDO
89 
90  REAL(KIND=8) PHEAT(kdlon,kflev) ! SHORTWAVE HEATING (K/DAY)
91  REAL(KIND=8) PHEAT0(kdlon,kflev)! SHORTWAVE HEATING (K/DAY) clear-sky
92  REAL(KIND=8) PALBPLA(kdlon) ! PLANETARY ALBEDO
93  REAL(KIND=8) PTOPSW(kdlon) ! SHORTWAVE FLUX AT T.O.A.
94  REAL(KIND=8) PSOLSW(kdlon) ! SHORTWAVE FLUX AT SURFACE
95  REAL(KIND=8) PTOPSW0(kdlon) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
96  REAL(KIND=8) PSOLSW0(kdlon) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
97  !
98  !* LOCAL VARIABLES:
99  !
100  real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
101 
102  REAL(KIND=8) ZOZ(kdlon,kflev)
103  ! column-density of ozone in layer, in kilo-Dobsons
104 
105  REAL(KIND=8) ZAKI(kdlon,2)
106  REAL(KIND=8) ZCLD(kdlon,kflev)
107  REAL(KIND=8) ZCLEAR(kdlon)
108  REAL(KIND=8) ZDSIG(kdlon,kflev)
109  REAL(KIND=8) ZFACT(kdlon)
110  REAL(KIND=8) ZFD(kdlon,kflev+1)
111  REAL(KIND=8) ZFDOWN(kdlon,kflev+1)
112  REAL(KIND=8) ZFU(kdlon,kflev+1)
113  REAL(KIND=8) ZFUP(kdlon,kflev+1)
114  REAL(KIND=8) ZRMU(kdlon)
115  REAL(KIND=8) ZSEC(kdlon)
116  REAL(KIND=8) ZUD(kdlon,5,kflev+1)
117  REAL(KIND=8) ZCLDSW0(kdlon,kflev)
118 
119  REAL(KIND=8) ZFSUP(kdlon,kflev+1)
120  REAL(KIND=8) ZFSDN(kdlon,kflev+1)
121  REAL(KIND=8) ZFSUP0(kdlon,kflev+1)
122  REAL(KIND=8) ZFSDN0(kdlon,kflev+1)
123 
124  INTEGER inu, jl, jk, i, k, kpl1
125 
126  INTEGER swpas ! Every swpas steps, sw is calculated
127  parameter(swpas=1)
128 
129  INTEGER, SAVE :: itapsw = 0
130  !$OMP THREADPRIVATE(itapsw)
131  LOGICAL, SAVE :: appel1er = .true.
132  !$OMP THREADPRIVATE(appel1er)
133  LOGICAL, SAVE :: initialized = .false.
134  !$OMP THREADPRIVATE(initialized)
135 
136  !jq-local flag introduced for aerosol forcings
137  REAL(KIND=8), SAVE :: flag_aer
138  !$OMP THREADPRIVATE(flag_aer)
139 
140  LOGICAL ok_ade, ok_aie ! use aerosol forcings or not?
141  LOGICAL flag_aerosol_strat ! use stratospehric aerosols
142  INTEGER flag_aerosol ! global flag for aerosol 0 (no aerosol) or 1-5 (aerosols)
143  REAL(KIND=8) tauaero(kdlon,kflev,naero_grp,2) ! aerosol optical properties
144  REAL(KIND=8) pizaero(kdlon,kflev,naero_grp,2) ! (see aeropt.F)
145  REAL(KIND=8) cgaero(kdlon,kflev,naero_grp,2) ! -"-
146  REAL(KIND=8) PTAUA(kdlon,2,kflev) ! CLOUD OPTICAL THICKNESS (present-day value)
147  REAL(KIND=8) POMEGAA(kdlon,2,kflev) ! SINGLE SCATTERING ALBEDO
148  REAL(KIND=8) PTOPSWADAERO(kdlon) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
149  REAL(KIND=8) PSOLSWADAERO(kdlon) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
150  REAL(KIND=8) PTOPSWAD0AERO(kdlon) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
151  REAL(KIND=8) PSOLSWAD0AERO(kdlon) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
152  REAL(KIND=8) PTOPSWAIAERO(kdlon) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
153  REAL(KIND=8) PSOLSWAIAERO(kdlon) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
154  REAL(KIND=8) PTOPSWAERO(kdlon,9) ! SW TOA AS DRF nat & ant
155  REAL(KIND=8) PTOPSW0AERO(kdlon,9) ! SW SRF AS DRF nat & ant
156  REAL(KIND=8) PSOLSWAERO(kdlon,9) ! SW TOA CS DRF nat & ant
157  REAL(KIND=8) PSOLSW0AERO(kdlon,9) ! SW SRF CS DRF nat & ant
158  REAL(KIND=8) PTOPSWCFAERO(kdlon,3) ! SW TOA AS cloudRF nat & ant
159  REAL(KIND=8) PSOLSWCFAERO(kdlon,3) ! SW SRF AS cloudRF nat & ant
160 
161  !jq - Fluxes including aerosol effects
162  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAD_AERO(:,:)
163  !$OMP THREADPRIVATE(ZFSUPAD_AERO)
164  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAD_AERO(:,:)
165  !$OMP THREADPRIVATE(ZFSDNAD_AERO)
166  !jq - Fluxes including aerosol effects
167  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAD0_AERO(:,:)
168  !$OMP THREADPRIVATE(ZFSUPAD0_AERO)
169  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAD0_AERO(:,:)
170  !$OMP THREADPRIVATE(ZFSDNAD0_AERO)
171  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAI_AERO(:,:)
172  !$OMP THREADPRIVATE(ZFSUPAI_AERO)
173  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAI_AERO(:,:)
174  !$OMP THREADPRIVATE(ZFSDNAI_AERO)
175  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUP_AERO(:,:,:)
176  !$OMP THREADPRIVATE(ZFSUP_AERO)
177  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDN_AERO(:,:,:)
178  !$OMP THREADPRIVATE(ZFSDN_AERO)
179  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUP0_AERO(:,:,:)
180  !$OMP THREADPRIVATE(ZFSUP0_AERO)
181  REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDN0_AERO(:,:,:)
182  !$OMP THREADPRIVATE(ZFSDN0_AERO)
183 
184 ! Key to define the aerosol effect acting on climate
185 ! OB: AEROSOLFEEDBACK_ACTIVE is now a LOGICAL
186 ! TRUE: fluxes use natural and/or anthropogenic aerosols according to ok_ade and ok_aie, DEFAULT
187 ! FALSE: fluxes use no aerosols (case 1)
188 
189  LOGICAL,SAVE :: AEROSOLFEEDBACK_ACTIVE = .true.
190 !$OMP THREADPRIVATE(AEROSOLFEEDBACK_ACTIVE)
191 
192  CHARACTER (LEN=20) :: modname='sw_aeroAR4'
193  CHARACTER (LEN=80) :: abort_message
194 
195  IF(.NOT.initialized) THEN
196  flag_aer=0.
197  initialized=.true.
198  ALLOCATE(zfsupad_aero(kdlon,kflev+1))
199  ALLOCATE(zfsdnad_aero(kdlon,kflev+1))
200  ALLOCATE(zfsupad0_aero(kdlon,kflev+1))
201  ALLOCATE(zfsdnad0_aero(kdlon,kflev+1))
202  ALLOCATE(zfsupai_aero(kdlon,kflev+1))
203  ALLOCATE(zfsdnai_aero(kdlon,kflev+1))
204 !-OB decrease size of these arrays to what is needed
205 ! | direct effect
206 !ind effect | no aerosol natural total
207 !natural (PTAU) | 1 3 2 --ZFSUP/ZFSDN
208 !total (PTAUA) | 5 4 --ZFSUP/ZFSDN
209 !no cloud | 1 3 2 --ZFSUP0/ZFSDN0
210 ! so we need which case when ?
211 ! ok_ade and ok_aie = 4-5, 4-2 and 2
212 ! ok_ade and not ok_aie = 2-3 and 2
213 ! not ok_ade and ok_aie = 5-3 and 5
214 ! not ok_ade and not ok_aie = 3
215 ! therefore the cases have the folliwng switches
216 ! 3 = not ok_ade or not ok_aie
217 ! 4 = ok_ade and ok_aie
218 ! 2 = ok_ade
219 ! 5 = ok_aie
220  ALLOCATE(zfsup_aero(kdlon,kflev+1,5))
221  ALLOCATE(zfsdn_aero(kdlon,kflev+1,5))
222  ALLOCATE(zfsup0_aero(kdlon,kflev+1,3))
223  ALLOCATE(zfsdn0_aero(kdlon,kflev+1,3))
224 ! end OB modif
225  zfsupad_aero(:,:)=0.
226  zfsdnad_aero(:,:)=0.
227  zfsupad0_aero(:,:)=0.
228  zfsdnad0_aero(:,:)=0.
229  zfsupai_aero(:,:)=0.
230  zfsdnai_aero(:,:)=0.
231  zfsup_aero(:,:,:)=0.
232  zfsdn_aero(:,:,:)=0.
233  zfsup0_aero(:,:,:)=0.
234  zfsdn0_aero(:,:,:)=0.
235  ENDIF
236 
237  IF (appel1er) THEN
238  WRITE(lunout,*)'SW calling frequency : ', swpas
239  WRITE(lunout,*) " In general, it should be 1"
240  appel1er = .false.
241  ENDIF
242  ! ------------------------------------------------------------------
243  IF (mod(itapsw,swpas).EQ.0) THEN
244 
245  DO jk = 1 , kflev
246  DO jl = 1, kdlon
247  zcldsw0(jl,jk) = 0.0
248  zoz(jl,jk) = pozon(jl,jk)*46.6968/rg &
249  *pdp(jl,jk)*(101325.0/ppsol(jl))
250  ENDDO
251  ENDDO
252 
253 ! clear sky with no aerosols at all is computed IF ACTIVEFEEDBACK_ACTIVE is false or for extended diag
254  IF ( swaero_diag .or. .not. aerosolfeedback_active .OR. flag_aerosol .EQ. 0 ) THEN
255 
256  ! clear-sky: zero aerosol effect
257  flag_aer=0.0
258  CALL swu_lmdar4(psct,zcldsw0,ppmb,ppsol,&
259  prmu0,pfrac,ptave,pwv,&
260  zaki,zcld,zclear,zdsig,zfact,zrmu,zsec,zud)
261  inu = 1
262  CALL sw1s_lmdar4(inu,paer, flag_aer, &
263  tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
264  palbd, palbp, pcg, zcld, zclear, zcldsw0,&
265  zdsig, pomega, zoz, zrmu, zsec, ptau, zud,&
266  zfd, zfu)
267  inu = 2
268  CALL sw2s_lmdar4(inu, paer, flag_aer, &
269  tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
270  zaki, palbd, palbp, pcg, zcld, zclear, zcldsw0,&
271  zdsig, pomega, zoz, zrmu, zsec, ptau, zud,&
272  pwv, pqs,&
273  zfdown, zfup)
274  DO jk = 1 , kflev+1
275  DO jl = 1, kdlon
276  zfsup0_aero(jl,jk,1) = (zfup(jl,jk) + zfu(jl,jk)) * zfact(jl)
277  zfsdn0_aero(jl,jk,1) = (zfdown(jl,jk) + zfd(jl,jk)) * zfact(jl)
278  ENDDO
279  ENDDO
280  ENDIF ! swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE
281 
282 ! cloudy sky with no aerosols at all is either computed IF no indirect effect is asked for, or for extended diag
283  IF ( swaero_diag .or. .not. aerosolfeedback_active .OR. flag_aerosol .EQ. 0 ) THEN
284  ! cloudy-sky: zero aerosol effect
285  flag_aer=0.0
286  CALL swu_lmdar4(psct,pcldsw,ppmb,ppsol,&
287  prmu0,pfrac,ptave,pwv,&
288  zaki,zcld,zclear,zdsig,zfact,zrmu,zsec,zud)
289  inu = 1
290  CALL sw1s_lmdar4(inu, paer, flag_aer, &
291  tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
292  palbd, palbp, pcg, zcld, zclear, pcldsw,&
293  zdsig, pomega, zoz, zrmu, zsec, ptau, zud,&
294  zfd, zfu)
295  inu = 2
296  CALL sw2s_lmdar4(inu, paer, flag_aer, &
297  tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
298  zaki, palbd, palbp, pcg, zcld, zclear, pcldsw,&
299  zdsig, pomega, zoz, zrmu, zsec, ptau, zud,&
300  pwv, pqs,&
301  zfdown, zfup)
302 
303  DO jk = 1 , kflev+1
304  DO jl = 1, kdlon
305  zfsup_aero(jl,jk,1) = (zfup(jl,jk) + zfu(jl,jk)) * zfact(jl)
306  zfsdn_aero(jl,jk,1) = (zfdown(jl,jk) + zfd(jl,jk)) * zfact(jl)
307  ENDDO
308  ENDDO
309  ENDIF ! swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE
310 
311  IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN
312 
313  IF (ok_ade.and.swaero_diag .or. .not. ok_ade) THEN
314 
315  ! clear sky direct effect natural aerosol
316  ! CAS AER (3)
317  flag_aer=1.0
318  CALL swu_lmdar4(psct,zcldsw0,ppmb,ppsol,&
319  prmu0,pfrac,ptave,pwv,&
320  zaki,zcld,zclear,zdsig,zfact,zrmu,zsec,zud)
321  inu = 1
322  CALL sw1s_lmdar4(inu, paer, flag_aer,&
323  tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
324  palbd, palbp, pcg, zcld, zclear, pcldsw,&
325  zdsig, pomega, zoz, zrmu, zsec, ptau, zud,&
326  zfd, zfu)
327  inu = 2
328  CALL sw2s_lmdar4(inu, paer, flag_aer,&
329  tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
330  zaki, palbd, palbp, pcg, zcld, zclear, pcldsw,&
331  zdsig, pomega, zoz, zrmu, zsec, ptau, zud,&
332  pwv, pqs,&
333  zfdown, zfup)
334 
335  DO jk = 1 , kflev+1
336  DO jl = 1, kdlon
337  zfsup0_aero(jl,jk,3) = (zfup(jl,jk) + zfu(jl,jk)) * zfact(jl)
338  zfsdn0_aero(jl,jk,3) = (zfdown(jl,jk) + zfd(jl,jk)) * zfact(jl)
339  ENDDO
340  ENDDO
341  ENDIF !--end not swaero_diag or not ok_ade
342 
343  IF (ok_ade) THEN
344 
345  ! clear sky direct effect of total aerosol
346  ! CAS AER (2)
347  flag_aer=1.0
348  CALL swu_lmdar4(psct,zcldsw0,ppmb,ppsol,&
349  prmu0,pfrac,ptave,pwv,&
350  zaki,zcld,zclear,zdsig,zfact,zrmu,zsec,zud)
351  inu = 1
352  CALL sw1s_lmdar4(inu, paer, flag_aer,&
353  tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
354  palbd, palbp, pcg, zcld, zclear, pcldsw,&
355  zdsig, pomega, zoz, zrmu, zsec, ptau, zud,&
356  zfd, zfu)
357  inu = 2
358  CALL sw2s_lmdar4(inu, paer, flag_aer,&
359  tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
360  zaki, palbd, palbp, pcg, zcld, zclear, pcldsw,&
361  zdsig, pomega, zoz, zrmu, zsec, ptau, zud,&
362  pwv, pqs,&
363  zfdown, zfup)
364 
365  DO jk = 1 , kflev+1
366  DO jl = 1, kdlon
367  zfsup0_aero(jl,jk,2) = (zfup(jl,jk) + zfu(jl,jk)) * zfact(jl)
368  zfsdn0_aero(jl,jk,2) = (zfdown(jl,jk) + zfd(jl,jk)) * zfact(jl)
369  ENDDO
370  ENDDO
371 
372  ! cloudy-sky with natural aerosols for indirect effect
373  ! but total aerosols for direct effect
374  ! PTAU
375  ! CAS AER (2)
376  flag_aer=1.0
377  CALL swu_lmdar4(psct,pcldsw,ppmb,ppsol,&
378  prmu0,pfrac,ptave,pwv,&
379  zaki,zcld,zclear,zdsig,zfact,zrmu,zsec,zud)
380  inu = 1
381  CALL sw1s_lmdar4(inu, paer, flag_aer,&
382  tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
383  palbd, palbp, pcg, zcld, zclear, pcldsw,&
384  zdsig, pomega, zoz, zrmu, zsec, ptau, zud,&
385  zfd, zfu)
386  inu = 2
387  CALL sw2s_lmdar4(inu, paer, flag_aer,&
388  tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
389  zaki, palbd, palbp, pcg, zcld, zclear, pcldsw,&
390  zdsig, pomega, zoz, zrmu, zsec, ptau, zud,&
391  pwv, pqs,&
392  zfdown, zfup)
393 
394  DO jk = 1 , kflev+1
395  DO jl = 1, kdlon
396  zfsup_aero(jl,jk,2) = (zfup(jl,jk) + zfu(jl,jk)) * zfact(jl)
397  zfsdn_aero(jl,jk,2) = (zfdown(jl,jk) + zfd(jl,jk)) * zfact(jl)
398  ENDDO
399  ENDDO
400 
401  ENDIF !-end ok_ade
402 
403  IF ( .not. ok_ade .or. .not. ok_aie ) THEN
404 
405  ! cloudy-sky with natural aerosols for indirect effect
406  ! and natural aerosols for direct effect
407  ! PTAU
408  ! CAS AER (3)
409  ! cloudy-sky direct effect natural aerosol
410  flag_aer=1.0
411  CALL swu_lmdar4(psct,pcldsw,ppmb,ppsol,&
412  prmu0,pfrac,ptave,pwv,&
413  zaki,zcld,zclear,zdsig,zfact,zrmu,zsec,zud)
414  inu = 1
415  CALL sw1s_lmdar4(inu, paer, flag_aer,&
416  tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
417  palbd, palbp, pcg, zcld, zclear, pcldsw,&
418  zdsig, pomega, zoz, zrmu, zsec, ptau, zud,&
419  zfd, zfu)
420  inu = 2
421  CALL sw2s_lmdar4(inu, paer, flag_aer,&
422  tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
423  zaki, palbd, palbp, pcg, zcld, zclear, pcldsw,&
424  zdsig, pomega, zoz, zrmu, zsec, ptau, zud,&
425  pwv, pqs,&
426  zfdown, zfup)
427 
428  DO jk = 1 , kflev+1
429  DO jl = 1, kdlon
430  zfsup_aero(jl,jk,3) = (zfup(jl,jk) + zfu(jl,jk)) * zfact(jl)
431  zfsdn_aero(jl,jk,3) = (zfdown(jl,jk) + zfd(jl,jk)) * zfact(jl)
432  ENDDO
433  ENDDO
434 
435  ENDIF !--true/false or false/true
436 
437  IF (ok_ade .and. ok_aie) THEN
438 
439  ! cloudy-sky with total aerosols for indirect effect
440  ! and total aerosols for direct effect
441  ! PTAUA
442  ! CAS AER (2)
443  flag_aer=1.0
444  CALL swu_lmdar4(psct,pcldsw,ppmb,ppsol,&
445  prmu0,pfrac,ptave,pwv,&
446  zaki,zcld,zclear,zdsig,zfact,zrmu,zsec,zud)
447  inu = 1
448  CALL sw1s_lmdar4(inu, paer, flag_aer,&
449  tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
450  palbd, palbp, pcg, zcld, zclear, pcldsw,&
451  zdsig, pomegaa, zoz, zrmu, zsec, ptaua, zud,&
452  zfd, zfu)
453  inu = 2
454  CALL sw2s_lmdar4(inu, paer, flag_aer,&
455  tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
456  zaki, palbd, palbp, pcg, zcld, zclear, pcldsw,&
457  zdsig, pomegaa, zoz, zrmu, zsec, ptaua, zud,&
458  pwv, pqs,&
459  zfdown, zfup)
460 
461  DO jk = 1 , kflev+1
462  DO jl = 1, kdlon
463  zfsup_aero(jl,jk,4) = (zfup(jl,jk) + zfu(jl,jk)) * zfact(jl)
464  zfsdn_aero(jl,jk,4) = (zfdown(jl,jk) + zfd(jl,jk)) * zfact(jl)
465  ENDDO
466  ENDDO
467 
468  ENDIF ! ok_ade .and. ok_aie
469 
470  IF (ok_aie) THEN
471  ! cloudy-sky with total aerosols for indirect effect
472  ! and natural aerosols for direct effect
473  ! PTAUA
474  ! CAS AER (3)
475  flag_aer=1.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(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
482  palbd, palbp, pcg, zcld, zclear, pcldsw,&
483  zdsig, pomegaa, zoz, zrmu, zsec, ptaua, zud,&
484  zfd, zfu)
485  inu = 2
486  CALL sw2s_lmdar4(inu, paer, flag_aer,&
487  tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
488  zaki, palbd, palbp, pcg, zcld, zclear, pcldsw,&
489  zdsig, pomegaa, zoz, zrmu, zsec, ptaua, zud,&
490  pwv, pqs,&
491  zfdown, zfup)
492 
493  DO jk = 1 , kflev+1
494  DO jl = 1, kdlon
495  zfsup_aero(jl,jk,5) = (zfup(jl,jk) + zfu(jl,jk)) * zfact(jl)
496  zfsdn_aero(jl,jk,5) = (zfdown(jl,jk) + zfd(jl,jk)) * zfact(jl)
497  ENDDO
498  ENDDO
499 
500  ENDIF ! ok_aie
501 
502  ENDIF !--if flag_aerosol GT 0 OR flag_aerosol_strat
503 
504  itapsw = 0
505  ENDIF
506  itapsw = itapsw + 1
507 
508  IF ( aerosolfeedback_active .AND. (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) ) THEN
509  IF ( ok_ade .and. ok_aie ) THEN
510  zfsup(:,:) = zfsup_aero(:,:,4)
511  zfsdn(:,:) = zfsdn_aero(:,:,4)
512  zfsup0(:,:) = zfsup0_aero(:,:,2)
513  zfsdn0(:,:) = zfsdn0_aero(:,:,2)
514  ENDIF
515 
516  IF ( ok_ade .and. (.not. ok_aie) ) THEN
517  zfsup(:,:) = zfsup_aero(:,:,2)
518  zfsdn(:,:) = zfsdn_aero(:,:,2)
519  zfsup0(:,:) = zfsup0_aero(:,:,2)
520  zfsdn0(:,:) = zfsdn0_aero(:,:,2)
521  ENDIF
522 
523  IF ( (.not. ok_ade) .and. ok_aie ) THEN
524  zfsup(:,:) = zfsup_aero(:,:,5)
525  zfsdn(:,:) = zfsdn_aero(:,:,5)
526  zfsup0(:,:) = zfsup0_aero(:,:,3)
527  zfsdn0(:,:) = zfsdn0_aero(:,:,3)
528  ENDIF
529 
530  IF ((.not. ok_ade) .and. (.not. ok_aie)) THEN
531  zfsup(:,:) = zfsup_aero(:,:,3)
532  zfsdn(:,:) = zfsdn_aero(:,:,3)
533  zfsup0(:,:) = zfsup0_aero(:,:,3)
534  zfsdn0(:,:) = zfsdn0_aero(:,:,3)
535  ENDIF
536 
537 ! MS the following allows to compute the forcing diagostics without
538 ! letting the aerosol forcing act on the meteorology
539 ! SEE logic above
540  ELSE
541  zfsup(:,:) = zfsup_aero(:,:,1)
542  zfsdn(:,:) = zfsdn_aero(:,:,1)
543  zfsup0(:,:) = zfsup0_aero(:,:,1)
544  zfsdn0(:,:) = zfsdn0_aero(:,:,1)
545  ENDIF
546 
547 ! Now computes heating rates
548  DO k = 1, kflev
549  kpl1 = k+1
550  DO i = 1, kdlon
551  pheat(i,k) = -(zfsup(i,kpl1)-zfsup(i,k))-(zfsdn(i,k)-zfsdn(i,kpl1))
552  pheat(i,k) = pheat(i,k) * rday*rg/rcpd / pdp(i,k)
553  pheat0(i,k) = -(zfsup0(i,kpl1)-zfsup0(i,k))-(zfsdn0(i,k)-zfsdn0(i,kpl1))
554  pheat0(i,k) = pheat0(i,k) * rday*rg/rcpd / pdp(i,k)
555  ENDDO
556  ENDDO
557 
558  DO i = 1, kdlon
559 ! effective SW surface albedo calculation
560  palbpla(i) = zfsup(i,kflev+1)/(zfsdn(i,kflev+1)+1.0e-20)
561 
562 ! clear sky net fluxes at TOA and SRF
563  psolsw0(i) = zfsdn0(i,1) - zfsup0(i,1)
564  ptopsw0(i) = zfsdn0(i,kflev+1) - zfsup0(i,kflev+1)
565 
566 ! cloudy sky net fluxes at TOA and SRF
567  psolsw(i) = zfsdn(i,1) - zfsup(i,1)
568  ptopsw(i) = zfsdn(i,kflev+1) - zfsup(i,kflev+1)
569 
570 ! net anthropogenic forcing direct and 1st indirect effect diagnostics
571 ! requires a natural aerosol field read and used
572 ! Difference of net fluxes from double call to radiation
573 
574 IF (ok_ade) THEN
575 
576 ! indices 1: natural; 2 anthropogenic
577 
578 ! TOA/SRF all sky natural forcing
579  psolswaero(i,1) = (zfsdn_aero(i,1,3) - zfsup_aero(i,1,3))-(zfsdn_aero(i,1,1) - zfsup_aero(i,1,1))
580  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))
581 
582 ! TOA/SRF clear sky natural forcing
583  psolsw0aero(i,1) = (zfsdn0_aero(i,1,3) - zfsup0_aero(i,1,3))-(zfsdn0_aero(i,1,1) - zfsup0_aero(i,1,1))
584  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))
585 
586  IF (ok_aie) THEN
587 
588 ! TOA/SRF all sky anthropogenic forcing
589  psolswaero(i,2) = (zfsdn_aero(i,1,4) - zfsup_aero(i,1,4))-(zfsdn_aero(i,1,5) - zfsup_aero(i,1,5))
590  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))
591 
592  ELSE
593 
594 ! TOA/SRF all sky anthropogenic forcing
595  psolswaero(i,2) = (zfsdn_aero(i,1,2) - zfsup_aero(i,1,2))-(zfsdn_aero(i,1,3) - zfsup_aero(i,1,3))
596  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))
597 
598  ENDIF
599 
600 ! TOA/SRF clear sky anthropogenic forcing
601  psolsw0aero(i,2) = (zfsdn0_aero(i,1,2) - zfsup0_aero(i,1,2))-(zfsdn0_aero(i,1,3) - zfsup0_aero(i,1,3))
602  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))
603 
604 ! direct anthropogenic forcing , as in old LMDzT, however differences of net fluxes
605  psolswadaero(i) = psolswaero(i,2)
606  ptopswadaero(i) = ptopswaero(i,2)
607  psolswad0aero(i) = psolsw0aero(i,2)
608  ptopswad0aero(i) = ptopsw0aero(i,2)
609 
610 ! OB: these diagnostics may not always work but who need them
611 ! Cloud forcing indices 1: natural; 2 anthropogenic; 3: zero aerosol direct effect
612 ! Instantaneously computed cloudy sky direct aerosol effect, cloud forcing due to aerosols above clouds
613 ! natural
614  psolswcfaero(i,1) = psolswaero(i,1) - psolsw0aero(i,1)
615  ptopswcfaero(i,1) = ptopswaero(i,1) - ptopsw0aero(i,1)
616 
617 ! Instantaneously computed cloudy SKY DIRECT aerosol effect, cloud forcing due to aerosols above clouds
618 ! anthropogenic
619  psolswcfaero(i,2) = psolswaero(i,2) - psolsw0aero(i,2)
620  ptopswcfaero(i,2) = ptopswaero(i,2) - ptopsw0aero(i,2)
621 
622 ! Cloudforcing without aerosol
623 ! zero
624  psolswcfaero(i,3) = (zfsdn_aero(i,1,1) - zfsup_aero(i,1,1))-(zfsdn0_aero(i,1,1) - zfsup0_aero(i,1,1))
625  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))
626 
627 ENDIF
628 
629 IF (ok_aie) THEN
630  IF (ok_ade) THEN
631  psolswaiaero(i) = (zfsdn_aero(i,1,4) - zfsup_aero(i,1,4))-(zfsdn_aero(i,1,2) - zfsup_aero(i,1,2))
632  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))
633  ELSE
634  psolswaiaero(i) = (zfsdn_aero(i,1,5) - zfsup_aero(i,1,5))-(zfsdn_aero(i,1,3) - zfsup_aero(i,1,3))
635  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))
636  ENDIF
637 ENDIF
638 
639 ENDDO
640 
641 END SUBROUTINE sw_aeroar4
dimphy::kflev
integer, save kflev
Definition: dimphy.F90:10
phys_output_var_mod::swaero_diag
logical, save swaero_diag
Definition: phys_output_var_mod.F90:49
false
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
phys_output_mod
Definition: phys_output_mod.F90:4
dimphy::kdlon
integer, save kdlon
Definition: dimphy.F90:4
swu_lmdar4
subroutine swu_lmdar4(psct, pcldsw, ppmb, ppsol, prmu0, pfrac, ptave, pwv, paki, pcld, pclear, pdsig, pfact, prmu, psec, pud)
Definition: radiation_AR4.F90:312
parameter
!$Header!integer nvarmx parameter(nfmx=10, imx=200, jmx=150, lmx=200, nvarmx=1000) real xd(imx
sw2s_lmdar4
subroutine sw2s_lmdar4(knu, paer, flag_aer, tauae, pizae, cgae, paki, palbd, palbp, pcg, pcld, pclear, pcldsw, pdsig, pomega, poz, prmu, psec, ptau, pud, pwv, pqs, pfdown, pfup)
Definition: radiation_AR4.F90:700
true
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
Definition: calcul_STDlev.h:139
print_control_mod
Definition: print_control_mod.F90:2
aero_mod
Definition: aero_mod.F90:3
paer
INTERFACE SUBROUTINE RRTM_ECRT_140GP && paer
Definition: rrtm_ecrt_140gp.intfb.h:3
sw_aeroar4
subroutine sw_aeroar4(PSCT, PRMU0, PFRAC, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, PWV, PQS, POZON, PAER, PCLDSW, PTAU, POMEGA, PCG, PHEAT, PHEAT0, PALBPLA, PTOPSW, PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, ZFSDN0, tauaero, pizaero, cgaero, PTAUA, POMEGAA, PTOPSWADAERO, PSOLSWADAERO, PTOPSWAD0AERO, PSOLSWAD0AERO, PTOPSWAIAERO, PSOLSWAIAERO, PTOPSWAERO, PTOPSW0AERO, PSOLSWAERO, PSOLSW0AERO, PTOPSWCFAERO, PSOLSWCFAERO, ok_ade, ok_aie, flag_aerosol, flag_aerosol_strat)
Definition: sw_aeroAR4.F90:21
dimphy
Definition: dimphy.F90:1
aero_mod::naero_grp
integer, parameter naero_grp
Definition: aero_mod.F90:64
lunout
!$Header!gestion des impressions de sorties et de débogage la sortie standard prt_level COMMON comprint lunout
Definition: iniprint.h:7
rg
real rg
Definition: comcstphy.h:1
sw1s_lmdar4
subroutine sw1s_lmdar4(knu, paer, flag_aer, tauae, pizae, cgae, palbd, palbp, pcg, pcld, pclear, pcldsw, pdsig, pomega, poz, prmu, psec, ptau, pud, pfd, pfu)
Definition: radiation_AR4.F90:479