Context Navigation

sw_aeroAR4.F90 @ 1246

Last change on this file since 1246 was 1246, checked in by Laurent Fairhead, 15 years ago

En deconnectant les aérosols (ok_ade=ok_aie=n) on a les mêmes

résultats avant et après les modifs.

preindustrial readin fields are used to compute natural aerosol fields

to allow for clean double calls to radiation

full forcing diagnostics (NAT, ANT, ZERO, Cloud forcing, CS,AS) are

activated with lev_histmth 4, If lev_histmth is not 4, the call to the
radiation is minimized, for efficiency, but ade and aie are computed and
applied (however for species wise forcing one would need to do
difference runs) (still quite a bit new forcing info, requires probably

some more explanation)

there is a hardcoded key in sw_aeroAR4.F90 which lets you choose to use the zero aerosol, or natural aerosol perturbation acting on the meteorology, but still would put out the full forcing diagnostics.
aod fields from offline aerosol fields are also output in histmth for

all aerosol tracers read in and available for evaluation

aeropt contains the ss humidity correction from nicolas&yves

File size: 21.2 KB

Line
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 )
21
22	USE dimphy
23
24	IMPLICIT NONE
25
26	#include "YOMCST.h"
27	#include "clesphys.h"
28	!
29	! ------------------------------------------------------------------
30	!
31	! PURPOSE.
32	! --------
33	!
34	! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
35	! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
36	!
37	! METHOD.
38	! -------
39	!
40	! 1. COMPUTES ABSORBER AMOUNTS (SWU)
41	! 2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL (SW1S)
42	! 3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL (SW2S)
43	!
44	! REFERENCE.
45	! ----------
46	!
47	! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
48	! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
49	!
50	! AUTHOR.
51	! -------
52	! JEAN-JACQUES MORCRETTE ECMWF
53	!
54	! MODIFICATIONS.
55	! --------------
56	! ORIGINAL : 89-07-14
57	! 95-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo
58	! 03-11-27 J. QUAAS Introduce aerosol forcings (based on BOUCHER)
59	! 09-04 A. COZIC - C.DEANDREIS Indroduce NAT/BC/POM/DUST/SS aerosol forcing
60	! ------------------------------------------------------------------
61	!
62	!* ARGUMENTS:
63	!
64	REAL(KIND=8) PSCT ! constante solaire (valeur conseillee: 1370)
65
66	REAL(KIND=8) PPSOL(KDLON) ! SURFACE PRESSURE (PA)
67	REAL(KIND=8) PDP(KDLON,KFLEV) ! LAYER THICKNESS (PA)
68	REAL(KIND=8) PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
69
70	REAL(KIND=8) PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
71	REAL(KIND=8) PFRAC(KDLON) ! fraction de la journee
72
73	REAL(KIND=8) PTAVE(KDLON,KFLEV) ! LAYER TEMPERATURE (K)
74	REAL(KIND=8) PWV(KDLON,KFLEV) ! SPECIFI! HUMIDITY (KG/KG)
75	REAL(KIND=8) PQS(KDLON,KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
76	REAL(KIND=8) POZON(KDLON,KFLEV) ! OZONE CONCENTRATION (KG/KG)
77	REAL(KIND=8) PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS
78
79	REAL(KIND=8) PALBD(KDLON,2) ! albedo du sol (lumiere diffuse)
80	REAL(KIND=8) PALBP(KDLON,2) ! albedo du sol (lumiere parallele)
81
82	REAL(KIND=8) PCLDSW(KDLON,KFLEV) ! CLOUD FRACTION
83	REAL(KIND=8) PTAU(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS
84	REAL(KIND=8) PCG(KDLON,2,KFLEV) ! ASYMETRY FACTOR
85	REAL(KIND=8) POMEGA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO
86
87	REAL(KIND=8) PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY)
88	REAL(KIND=8) PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
89	REAL(KIND=8) PALBPLA(KDLON) ! PLANETARY ALBEDO
90	REAL(KIND=8) PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
91	REAL(KIND=8) PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
92	REAL(KIND=8) PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
93	REAL(KIND=8) PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
94	!
95	!* LOCAL VARIABLES:
96	!
97	real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
98
99	REAL(KIND=8) ZOZ(KDLON,KFLEV)
100	! column-density of ozone in layer, in kilo-Dobsons
101
102	REAL(KIND=8) ZAKI(KDLON,2)
103	REAL(KIND=8) ZCLD(KDLON,KFLEV)
104	REAL(KIND=8) ZCLEAR(KDLON)
105	REAL(KIND=8) ZDSIG(KDLON,KFLEV)
106	REAL(KIND=8) ZFACT(KDLON)
107	REAL(KIND=8) ZFD(KDLON,KFLEV+1)
108	REAL(KIND=8) ZFDOWN(KDLON,KFLEV+1)
109	REAL(KIND=8) ZFU(KDLON,KFLEV+1)
110	REAL(KIND=8) ZFUP(KDLON,KFLEV+1)
111	REAL(KIND=8) ZRMU(KDLON)
112	REAL(KIND=8) ZSEC(KDLON)
113	REAL(KIND=8) ZUD(KDLON,5,KFLEV+1)
114	REAL(KIND=8) ZCLDSW0(KDLON,KFLEV)
115
116	REAL(KIND=8) ZFSUP(KDLON,KFLEV+1)
117	REAL(KIND=8) ZFSDN(KDLON,KFLEV+1)
118	REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1)
119	REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1)
120
121	INTEGER inu, jl, jk, i, k, kpl1
122
123	INTEGER swpas ! Every swpas steps, sw is calculated
124	PARAMETER(swpas=1)
125
126	INTEGER, SAVE :: itapsw = 0
127	!$OMP THREADPRIVATE(itapsw)
128	LOGICAL, SAVE :: appel1er = .TRUE.
129	!$OMP THREADPRIVATE(appel1er)
130	LOGICAL, SAVE :: initialized = .FALSE.
131	!$OMP THREADPRIVATE(initialized)
132
133	!jq-Introduced for aerosol forcings
134	REAL(KIND=8), SAVE :: flag_aer
135	!$OMP THREADPRIVATE(flag_aer)
136
137	LOGICAL ok_ade, ok_aie ! use aerosol forcings or not?
138	REAL(KIND=8) tauaero(kdlon,kflev,9,2) ! aerosol optical properties
139	REAL(KIND=8) pizaero(kdlon,kflev,9,2) ! (see aeropt.F)
140	REAL(KIND=8) cgaero(kdlon,kflev,9,2) ! -"-
141	REAL(KIND=8) PTAUA(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS (pre-industrial value)
142	REAL(KIND=8) POMEGAA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO
143	REAL(KIND=8) PTOPSWADAERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
144	REAL(KIND=8) PSOLSWADAERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
145	REAL(KIND=8) PTOPSWAD0AERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
146	REAL(KIND=8) PSOLSWAD0AERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
147	REAL(KIND=8) PTOPSWAIAERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
148	REAL(KIND=8) PSOLSWAIAERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
149	REAL(KIND=8) PTOPSWAERO(KDLON,9) ! SW TOA AS DRF nat & ant
150	REAL(KIND=8) PTOPSW0AERO(KDLON,9) ! SW SRF AS DRF nat & ant
151	REAL(KIND=8) PSOLSWAERO(KDLON,9) ! SW TOA CS DRF nat & ant
152	REAL(KIND=8) PSOLSW0AERO(KDLON,9) ! SW SRF CS DRF nat & ant
153	REAL(KIND=8) PTOPSWCFAERO(KDLON,3) ! SW TOA AS cloudRF nat & ant
154	REAL(KIND=8) PSOLSWCFAERO(KDLON,3) ! SW SRF AS cloudRF nat & ant
155
156	!jq - Fluxes including aerosol effects
157	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAD_AERO(:,:)
158	!$OMP THREADPRIVATE(ZFSUPAD_AERO)
159	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAD_AERO(:,:)
160	!$OMP THREADPRIVATE(ZFSDNAD_AERO)
161	!jq - Fluxes including aerosol effects
162	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAD0_AERO(:,:)
163	!$OMP THREADPRIVATE(ZFSUPAD0_AERO)
164	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAD0_AERO(:,:)
165	!$OMP THREADPRIVATE(ZFSDNAD0_AERO)
166	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAI_AERO(:,:)
167	!$OMP THREADPRIVATE(ZFSUPAI_AERO)
168	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAI_AERO(:,:)
169	!$OMP THREADPRIVATE(ZFSDNAI_AERO)
170	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUP_AERO(:,:,:)
171	!$OMP THREADPRIVATE(ZFSUP_AERO)
172	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDN_AERO(:,:,:)
173	!$OMP THREADPRIVATE(ZFSDN_AERO)
174	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUP0_AERO(:,:,:)
175	!$OMP THREADPRIVATE(ZFSUP0_AERO)
176	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDN0_AERO(:,:,:)
177	!$OMP THREADPRIVATE(ZFSDN0_AERO)
178
179	! Key to define the aerosol effect acting on climate
180	! 0: aerosol feedback active according to ok_ade, ok_aie DEFAULT
181	! 1: no feedback , zero aerosol fluxes are used for climate, diagnostics according to ok_ade_ok_aie
182	! 2: feedback according to total aerosol direct effect used for climate, diagnostics according to ok_ade, ok_aie
183	! 3: feedback according to natural aerosol direct effect used for climate, diagnostics according to ok_ade_ok_aie
184
185	INTEGER :: AEROSOLFEEDBACK_ACTIVE = 0
186
187	IF ((.not. ok_ade) .and. (AEROSOLFEEDBACK_ACTIVE .ge. 2)) THEN
188	print*,'Error: direct effect is not activated but assumed to be active - see sw_aeroAR4.F90'
189	stop
190	ENDIF
191	AEROSOLFEEDBACK_ACTIVE=MIN(MAX(AEROSOLFEEDBACK_ACTIVE,0),3)
192	IF (AEROSOLFEEDBACK_ACTIVE .gt. 3) THEN
193	print*,'Error: AEROSOLFEEDBACK_ACTIVE options go only until 3'
194	stop
195	ENDIF
196
197	IF(.NOT.initialized) THEN
198	flag_aer=0.
199	initialized=.TRUE.
200	ALLOCATE(ZFSUPAD_AERO(KDLON,KFLEV+1))
201	ALLOCATE(ZFSDNAD_AERO(KDLON,KFLEV+1))
202	ALLOCATE(ZFSUPAD0_AERO(KDLON,KFLEV+1))
203	ALLOCATE(ZFSDNAD0_AERO(KDLON,KFLEV+1))
204	ALLOCATE(ZFSUPAI_AERO(KDLON,KFLEV+1))
205	ALLOCATE(ZFSDNAI_AERO(KDLON,KFLEV+1))
206	ALLOCATE(ZFSUP_AERO (KDLON,KFLEV+1,9))
207	ALLOCATE(ZFSDN_AERO (KDLON,KFLEV+1,9))
208	ALLOCATE(ZFSUP0_AERO(KDLON,KFLEV+1,9))
209	ALLOCATE(ZFSDN0_AERO(KDLON,KFLEV+1,9))
210	ZFSUPAD_AERO(:,:)=0.
211	ZFSDNAD_AERO(:,:)=0.
212	ZFSUPAD0_AERO(:,:)=0.
213	ZFSDNAD0_AERO(:,:)=0.
214	ZFSUPAI_AERO(:,:)=0.
215	ZFSDNAI_AERO(:,:)=0.
216	ZFSUP_AERO (:,:,:)=0.
217	ZFSDN_AERO (:,:,:)=0.
218	ZFSUP0_AERO(:,:,:)=0.
219	ZFSDN0_AERO(:,:,:)=0.
220	ENDIF
221
222	IF (appel1er) THEN
223	PRINT*, 'SW calling frequency : ', swpas
224	PRINT*, " In general, it should be 1"
225	appel1er = .FALSE.
226	ENDIF
227	! ------------------------------------------------------------------
228	IF (MOD(itapsw,swpas).EQ.0) THEN
229
230	DO JK = 1 , KFLEV
231	DO JL = 1, KDLON
232	ZCLDSW0(JL,JK) = 0.0
233	ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG &
234	PDP(JL,JK)(101325.0/PPSOL(JL))
235	ENDDO
236	ENDDO
237
238	! clear sky is either computed IF no direct effect is asked for, or for extended diag)
239	IF (( lev_histmth .eq. 4 ) .or. ( .not. ok_ade )) THEN
240
241	! clear-sky: zero aerosol effect
242	flag_aer=0.0
243	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
244	PRMU0,PFRAC,PTAVE,PWV,&
245	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
246	INU = 1
247	CALL SW1S_LMDAR4(INU,PAER, flag_aer, &
248	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
249	PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
250	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
251	ZFD, ZFU)
252	INU = 2
253	CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
254	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
255	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
256	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
257	PWV, PQS,&
258	ZFDOWN, ZFUP)
259	DO JK = 1 , KFLEV+1
260	DO JL = 1, KDLON
261	ZFSUP0_AERO(JL,JK,1) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
262	ZFSDN0_AERO(JL,JK,1) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
263	ENDDO
264	ENDDO
265	ENDIF
266
267	! cloudy sky is either computed IF no indirect effect is asked for, or for extended diag)
268	IF (( lev_histmth .eq. 4 ) .or. ( .not. ok_aie )) THEN
269	! cloudy-sky: zero aerosol effect
270	flag_aer=0.0
271	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
272	PRMU0,PFRAC,PTAVE,PWV,&
273	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
274	INU = 1
275	CALL SW1S_LMDAR4(INU, PAER, flag_aer, &
276	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
277	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
278	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
279	ZFD, ZFU)
280	INU = 2
281	CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
282	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
283	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
284	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
285	PWV, PQS,&
286	ZFDOWN, ZFUP)
287
288	DO JK = 1 , KFLEV+1
289	DO JL = 1, KDLON
290	ZFSUP_AERO(JL,JK,1) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
291	ZFSDN_AERO(JL,JK,1) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
292	ENDDO
293	ENDDO
294	ENDIF
295
296
297	IF (ok_ade) THEN
298
299	! clear sky (Anne Cozic 03/07/2007) direct effect of total aerosol
300	! CAS AER (2)
301	flag_aer=1.0
302	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
303	PRMU0,PFRAC,PTAVE,PWV,&
304	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
305	INU = 1
306	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
307	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
308	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
309	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
310	ZFD, ZFU)
311	INU = 2
312	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
313	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
314	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
315	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
316	PWV, PQS,&
317	ZFDOWN, ZFUP)
318
319	DO JK = 1 , KFLEV+1
320	DO JL = 1, KDLON
321	ZFSUP0_AERO(JL,JK,2) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
322	ZFSDN0_AERO(JL,JK,2) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
323	ENDDO
324	ENDDO
325
326	! cloudy sky is either computed IF no indirect effect is asked for, or for extended diag)
327	IF (( lev_histmth .eq. 4 ) .or. (.not. ok_aie)) THEN
328	! cloudy-sky aerosol direct effect of total aerosol
329	flag_aer=1.0
330	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
331	PRMU0,PFRAC,PTAVE,PWV,&
332	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
333	INU = 1
334	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
335	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
336	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
337	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
338	ZFD, ZFU)
339	INU = 2
340	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
341	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
342	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
343	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
344	PWV, PQS,&
345	ZFDOWN, ZFUP)
346
347	DO JK = 1 , KFLEV+1
348	DO JL = 1, KDLON
349	ZFSUP_AERO(JL,JK,2) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
350	ZFSDN_AERO(JL,JK,2) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
351	ENDDO
352	ENDDO
353	ENDIF
354
355	! natural aeroosl clear sky is computed for extended diag)
356	IF ( lev_histmth .eq. 4 ) THEN
357	! clear sky direct effect natural aerosol
358	flag_aer=1.0
359	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
360	PRMU0,PFRAC,PTAVE,PWV,&
361	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
362	INU = 1
363	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
364	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
365	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
366	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
367	ZFD, ZFU)
368	INU = 2
369	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
370	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
371	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
372	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
373	PWV, PQS,&
374	ZFDOWN, ZFUP)
375
376	DO JK = 1 , KFLEV+1
377	DO JL = 1, KDLON
378	ZFSUP0_AERO(JL,JK,3) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
379	ZFSDN0_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
380	ENDDO
381	ENDDO
382	ENDIF
383
384	! cloud sky natural is for extended diagnostics
385	IF ( lev_histmth .eq. 4 ) THEN
386	! cloudy-sky direct effect natural aerosol
387	flag_aer=1.0
388	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
389	PRMU0,PFRAC,PTAVE,PWV,&
390	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
391	INU = 1
392	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
393	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
394	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
395	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
396	ZFD, ZFU)
397	INU = 2
398	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
399	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
400	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
401	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
402	PWV, PQS,&
403	ZFDOWN, ZFUP)
404
405	DO JK = 1 , KFLEV+1
406	DO JL = 1, KDLON
407	ZFSUP_AERO(JL,JK,3) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
408	ZFSDN_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
409	ENDDO
410	ENDDO
411	ENDIF
412
413	ENDIF ! ok_ade
414
415	! cloudy sky needs to be computed in all cases IF ok_aie is activated
416	IF (ok_aie) THEN
417	!jq cloudy-sky + aerosol direct + aerosol indirect of total aerosol
418	flag_aer=1.0
419	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
420	PRMU0,PFRAC,PTAVE,PWV,&
421	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
422	INU = 1
423	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
424	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
425	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
426	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
427	ZFD, ZFU)
428	INU = 2
429	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
430	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
431	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
432	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
433	PWV, PQS,&
434	ZFDOWN, ZFUP)
435	DO JK = 1 , KFLEV+1
436	DO JL = 1, KDLON
437	ZFSUP_AERO(JL,JK,4) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
438	ZFSDN_AERO(JL,JK,4) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
439	ENDDO
440	ENDDO
441	ENDIF ! ok_aie
442
443	itapsw = 0
444	ENDIF
445	itapsw = itapsw + 1
446
447	IF ( AEROSOLFEEDBACK_ACTIVE .eq. 0) THEN
448	IF ( ok_ade .and. ok_aie ) THEN
449	ZFSUP(:,:) = ZFSUP_AERO(:,:,4)
450	ZFSDN(:,:) = ZFSDN_AERO(:,:,4)
451	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,2)
452	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,2)
453	ENDIF
454	IF ( ok_ade .and. (.not. ok_aie) ) THEN
455	ZFSUP(:,:) = ZFSUP_AERO(:,:,2)
456	ZFSDN(:,:) = ZFSDN_AERO(:,:,2)
457	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,2)
458	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,2)
459	ENDIF
460
461	IF ( (.not. ok_ade) .and. ok_aie ) THEN
462	print*,'Warning: indirect effect in cloudy regions includes direct aerosol effect'
463	ZFSUP(:,:) = ZFSUP_AERO(:,:,4)
464	ZFSDN(:,:) = ZFSDN_AERO(:,:,4)
465	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,1)
466	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,1)
467	ENDIF
468	IF ((.not. ok_ade) .and. (.not. ok_aie)) THEN
469	ZFSUP(:,:) = ZFSUP_AERO(:,:,1)
470	ZFSDN(:,:) = ZFSDN_AERO(:,:,1)
471	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,1)
472	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,1)
473	ENDIF
474
475	! MS the following allows to compute the forcing diagostics without
476	! letting the aerosol forcing act on the meteorology
477	! SEE logic above
478	ELSEIF ( AEROSOLFEEDBACK_ACTIVE .gt. 0) THEN
479	ZFSUP(:,:) = ZFSUP_AERO(:,:,AEROSOLFEEDBACK_ACTIVE)
480	ZFSDN(:,:) = ZFSDN_AERO(:,:,AEROSOLFEEDBACK_ACTIVE)
481	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,AEROSOLFEEDBACK_ACTIVE)
482	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,AEROSOLFEEDBACK_ACTIVE)
483	ENDIF
484
485
486	DO k = 1, KFLEV
487	kpl1 = k+1
488	DO i = 1, KDLON
489	PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k))-(ZFSDN(i,k)-ZFSDN(i,kpl1))
490	PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
491	PHEAT0(i,k) = -(ZFSUP0(i,kpl1)-ZFSUP0(i,k))-(ZFSDN0(i,k)-ZFSDN0(i,kpl1))
492	PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k)
493	ENDDO
494	ENDDO
495
496	DO i = 1, KDLON
497	! effective SW surface albedo calculation
498	PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20)
499
500	! clear sky net fluxes at TOA and SRF
501	PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)
502	PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)
503
504	! cloudy sky net fluxes at TOA and SRF
505	PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)
506	PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)
507
508
509	! net anthropogenic forcing direct and 1st indirect effect diagnostics
510	! requires a natural aerosol field read and used
511	! Difference of net fluxes from double call to radiation
512
513
514	IF (ok_ade) THEN
515
516	! indices 1: natural; 2 anthropogenic
517	! TOA/SRF all sky natural forcing
518	PSOLSWAERO(i,1) = (ZFSDN_AERO(i,1,3) - ZFSUP_AERO(i,1,3))-(ZFSDN_AERO(i,1,1) - ZFSUP_AERO(i,1,1))
519	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))
520
521	! TOA/SRF all sky anthropogenic forcing
522	PSOLSWAERO(i,2) = (ZFSDN_AERO(i,1,2) - ZFSUP_AERO(i,1,2))-(ZFSDN_AERO(i,1,3) - ZFSUP_AERO(i,1,3))
523	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))
524
525	! TOA/SRF clear sky natural forcing
526	PSOLSW0AERO(i,1) = (ZFSDN0_AERO(i,1,3) - ZFSUP0_AERO(i,1,3))-(ZFSDN0_AERO(i,1,1) - ZFSUP0_AERO(i,1,1))
527	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))
528
529	! TOA/SRF clear sky anthropogenic forcing
530	PSOLSW0AERO(i,2) = (ZFSDN0_AERO(i,1,2) - ZFSUP0_AERO(i,1,2))-(ZFSDN0_AERO(i,1,3) - ZFSUP0_AERO(i,1,3))
531	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))
532
533	! Cloud forcing indices 1: natural; 2 anthropogenic; 3: zero aerosol direct effect
534	! Instantaneously computed cloudy sky direct aerosol effect, cloud forcing due to aerosols above clouds
535	! natural
536	PSOLSWCFAERO(i,1) = PSOLSWAERO(i,1) - PSOLSW0AERO(i,1)
537	PTOPSWCFAERO(i,1) = PTOPSWAERO(i,1) - PTOPSW0AERO(i,1)
538
539	! Instantaneously computed cloudy SKY DIRECT aerosol effect, cloud forcing due to aerosols above clouds
540	! anthropogenic
541	PSOLSWCFAERO(i,2) = PSOLSWAERO(i,2) - PSOLSW0AERO(i,2)
542	PTOPSWCFAERO(i,2) = PTOPSWAERO(i,2) - PTOPSW0AERO(i,2)
543
544	! Cloudforcing without aerosol
545	! zero
546	PSOLSWCFAERO(i,3) = (ZFSDN_AERO(i,1,1) - ZFSUP_AERO(i,1,1))-(ZFSDN0_AERO(i,1,1) - ZFSUP0_AERO(i,1,1))
547	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))
548
549	! direct anthropogenic forcing , as in old LMDzT, however differences of net fluxes
550	PSOLSWADAERO(i) = PSOLSWAERO(i,2)
551	PTOPSWADAERO(i) = PTOPSWAERO(i,2)
552	PSOLSWAD0AERO(i) = PSOLSW0AERO(i,2)
553	PTOPSWAD0AERO(i) = PTOPSW0AERO(i,2)
554
555	ENDIF
556
557
558	IF (ok_aie) THEN
559	PSOLSWAIAERO(i) = (ZFSDN_AERO(i,1,4) - ZFSUP_AERO(i,1,4))-(ZFSDN_AERO(i,1,2) - ZFSUP_AERO(i,1,2))
560	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))
561	ENDIF
562
563	ENDDO
564	END SUBROUTINE SW_AEROAR4

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format