Context Navigation

sw_aeroAR4.F90 @ 1743

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

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

Download in other formats:

Original Format