Context Navigation

sw_aeroAR4.F90 @ 2337

Last change on this file since 2337 was 1910, checked in by Laurent Fairhead, 11 years ago
Merged trunk changes r1860:1909 into testing branch
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory
File size: 23.8 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, flag_aerosol_strat )
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	LOGICAL flag_aerosol_strat ! use stratospehric aerosols
141	INTEGER flag_aerosol ! global flag for aerosol 0 (no aerosol) or 1-5 (aerosols)
142	REAL(KIND=8) tauaero(kdlon,kflev,9,2) ! aerosol optical properties
143	REAL(KIND=8) pizaero(kdlon,kflev,9,2) ! (see aeropt.F)
144	REAL(KIND=8) cgaero(kdlon,kflev,9,2) ! -"-
145	REAL(KIND=8) PTAUA(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS (present-day value)
146	REAL(KIND=8) POMEGAA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO
147	REAL(KIND=8) PTOPSWADAERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
148	REAL(KIND=8) PSOLSWADAERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
149	REAL(KIND=8) PTOPSWAD0AERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
150	REAL(KIND=8) PSOLSWAD0AERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
151	REAL(KIND=8) PTOPSWAIAERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
152	REAL(KIND=8) PSOLSWAIAERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
153	REAL(KIND=8) PTOPSWAERO(KDLON,9) ! SW TOA AS DRF nat & ant
154	REAL(KIND=8) PTOPSW0AERO(KDLON,9) ! SW SRF AS DRF nat & ant
155	REAL(KIND=8) PSOLSWAERO(KDLON,9) ! SW TOA CS DRF nat & ant
156	REAL(KIND=8) PSOLSW0AERO(KDLON,9) ! SW SRF CS DRF nat & ant
157	REAL(KIND=8) PTOPSWCFAERO(KDLON,3) ! SW TOA AS cloudRF nat & ant
158	REAL(KIND=8) PSOLSWCFAERO(KDLON,3) ! SW SRF AS cloudRF nat & ant
159
160	!jq - Fluxes including aerosol effects
161	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAD_AERO(:,:)
162	!$OMP THREADPRIVATE(ZFSUPAD_AERO)
163	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAD_AERO(:,:)
164	!$OMP THREADPRIVATE(ZFSDNAD_AERO)
165	!jq - Fluxes including aerosol effects
166	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAD0_AERO(:,:)
167	!$OMP THREADPRIVATE(ZFSUPAD0_AERO)
168	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAD0_AERO(:,:)
169	!$OMP THREADPRIVATE(ZFSDNAD0_AERO)
170	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAI_AERO(:,:)
171	!$OMP THREADPRIVATE(ZFSUPAI_AERO)
172	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAI_AERO(:,:)
173	!$OMP THREADPRIVATE(ZFSDNAI_AERO)
174	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUP_AERO(:,:,:)
175	!$OMP THREADPRIVATE(ZFSUP_AERO)
176	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDN_AERO(:,:,:)
177	!$OMP THREADPRIVATE(ZFSDN_AERO)
178	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUP0_AERO(:,:,:)
179	!$OMP THREADPRIVATE(ZFSUP0_AERO)
180	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDN0_AERO(:,:,:)
181	!$OMP THREADPRIVATE(ZFSDN0_AERO)
182
183	! Key to define the aerosol effect acting on climate
184	! OB: AEROSOLFEEDBACK_ACTIVE is now a LOGICAL
185	! TRUE: fluxes use natural and/or anthropogenic aerosols according to ok_ade and ok_aie, DEFAULT
186	! FALSE: fluxes use no aerosols (case 1)
187
188	LOGICAL,SAVE :: AEROSOLFEEDBACK_ACTIVE = .TRUE.
189	!$OMP THREADPRIVATE(AEROSOLFEEDBACK_ACTIVE)
190
191	CHARACTER (LEN=20) :: modname='sw_aeroAR4'
192	CHARACTER (LEN=80) :: abort_message
193
194	IF(.NOT.initialized) THEN
195	flag_aer=0.
196	initialized=.TRUE.
197	ALLOCATE(ZFSUPAD_AERO(KDLON,KFLEV+1))
198	ALLOCATE(ZFSDNAD_AERO(KDLON,KFLEV+1))
199	ALLOCATE(ZFSUPAD0_AERO(KDLON,KFLEV+1))
200	ALLOCATE(ZFSDNAD0_AERO(KDLON,KFLEV+1))
201	ALLOCATE(ZFSUPAI_AERO(KDLON,KFLEV+1))
202	ALLOCATE(ZFSDNAI_AERO(KDLON,KFLEV+1))
203	!-OB decrease size of these arrays to what is needed
204	! \| direct effect
205	!ind effect \| no aerosol natural total
206	!natural (PTAU) \| 1 3 2 --ZFSUP/ZFSDN
207	!total (PTAUA) \| 5 4 --ZFSUP/ZFSDN
208	!no cloud \| 1 3 2 --ZFSUP0/ZFSDN0
209	! so we need which case when ?
210	! ok_ade and ok_aie = 4-5, 4-2 and 2
211	! ok_ade and not ok_aie = 2-3 and 2
212	! not ok_ade and ok_aie = 5-3 and 5
213	! not ok_ade and not ok_aie = 3
214	! therefore the cases have the folliwng switches
215	! 3 = not ok_ade or not ok_aie
216	! 4 = ok_ade and ok_aie
217	! 2 = ok_ade
218	! 5 = ok_aie
219	ALLOCATE(ZFSUP_AERO (KDLON,KFLEV+1,5))
220	ALLOCATE(ZFSDN_AERO (KDLON,KFLEV+1,5))
221	ALLOCATE(ZFSUP0_AERO(KDLON,KFLEV+1,3))
222	ALLOCATE(ZFSDN0_AERO(KDLON,KFLEV+1,3))
223	! end OB modif
224	ZFSUPAD_AERO(:,:)=0.
225	ZFSDNAD_AERO(:,:)=0.
226	ZFSUPAD0_AERO(:,:)=0.
227	ZFSDNAD0_AERO(:,:)=0.
228	ZFSUPAI_AERO(:,:)=0.
229	ZFSDNAI_AERO(:,:)=0.
230	ZFSUP_AERO (:,:,:)=0.
231	ZFSDN_AERO (:,:,:)=0.
232	ZFSUP0_AERO(:,:,:)=0.
233	ZFSDN0_AERO(:,:,:)=0.
234	ENDIF
235
236	IF (appel1er) THEN
237	WRITE(lunout,*)'SW calling frequency : ', swpas
238	WRITE(lunout,*) " In general, it should be 1"
239	appel1er = .FALSE.
240	ENDIF
241	! ------------------------------------------------------------------
242	IF (MOD(itapsw,swpas).EQ.0) THEN
243
244	DO JK = 1 , KFLEV
245	DO JL = 1, KDLON
246	ZCLDSW0(JL,JK) = 0.0
247	ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG &
248	PDP(JL,JK)(101325.0/PPSOL(JL))
249	ENDDO
250	ENDDO
251
252	! clear sky with no aerosols at all is computed IF ACTIVEFEEDBACK_ACTIVE is false or for extended diag
253	IF ( swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol .EQ. 0 ) THEN
254
255	! clear-sky: zero aerosol effect
256	flag_aer=0.0
257	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
258	PRMU0,PFRAC,PTAVE,PWV,&
259	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
260	INU = 1
261	CALL SW1S_LMDAR4(INU,PAER, flag_aer, &
262	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
263	PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
264	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
265	ZFD, ZFU)
266	INU = 2
267	CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
268	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
269	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
270	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
271	PWV, PQS,&
272	ZFDOWN, ZFUP)
273	DO JK = 1 , KFLEV+1
274	DO JL = 1, KDLON
275	ZFSUP0_AERO(JL,JK,1) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
276	ZFSDN0_AERO(JL,JK,1) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
277	ENDDO
278	ENDDO
279	ENDIF ! swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE
280
281	! cloudy sky with no aerosols at all is either computed IF no indirect effect is asked for, or for extended diag
282	IF ( swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol .EQ. 0 ) THEN
283	! cloudy-sky: zero aerosol effect
284	flag_aer=0.0
285	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
286	PRMU0,PFRAC,PTAVE,PWV,&
287	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
288	INU = 1
289	CALL SW1S_LMDAR4(INU, PAER, flag_aer, &
290	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
291	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
292	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
293	ZFD, ZFU)
294	INU = 2
295	CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
296	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
297	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
298	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
299	PWV, PQS,&
300	ZFDOWN, ZFUP)
301
302	DO JK = 1 , KFLEV+1
303	DO JL = 1, KDLON
304	ZFSUP_AERO(JL,JK,1) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
305	ZFSDN_AERO(JL,JK,1) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
306	ENDDO
307	ENDDO
308	ENDIF ! swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE
309
310	IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN
311
312	IF (ok_ade.and.swaero_diag .or. .not. ok_ade) THEN
313
314	! clear sky direct effect natural aerosol
315	! CAS AER (3)
316	flag_aer=1.0
317	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
318	PRMU0,PFRAC,PTAVE,PWV,&
319	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
320	INU = 1
321	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
322	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
323	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
324	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
325	ZFD, ZFU)
326	INU = 2
327	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
328	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
329	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
330	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
331	PWV, PQS,&
332	ZFDOWN, ZFUP)
333
334	DO JK = 1 , KFLEV+1
335	DO JL = 1, KDLON
336	ZFSUP0_AERO(JL,JK,3) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
337	ZFSDN0_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
338	ENDDO
339	ENDDO
340	ENDIF !--end not swaero_diag or not ok_ade
341
342	IF (ok_ade) THEN
343
344	! clear sky direct effect of total aerosol
345	! CAS AER (2)
346	flag_aer=1.0
347	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
348	PRMU0,PFRAC,PTAVE,PWV,&
349	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
350	INU = 1
351	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
352	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
353	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
354	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
355	ZFD, ZFU)
356	INU = 2
357	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
358	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
359	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
360	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
361	PWV, PQS,&
362	ZFDOWN, ZFUP)
363
364	DO JK = 1 , KFLEV+1
365	DO JL = 1, KDLON
366	ZFSUP0_AERO(JL,JK,2) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
367	ZFSDN0_AERO(JL,JK,2) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
368	ENDDO
369	ENDDO
370
371	! cloudy-sky with natural aerosols for indirect effect
372	! but total aerosols for direct effect
373	! PTAU
374	! CAS AER (2)
375	flag_aer=1.0
376	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
377	PRMU0,PFRAC,PTAVE,PWV,&
378	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
379	INU = 1
380	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
381	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
382	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
383	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
384	ZFD, ZFU)
385	INU = 2
386	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
387	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
388	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
389	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
390	PWV, PQS,&
391	ZFDOWN, ZFUP)
392
393	DO JK = 1 , KFLEV+1
394	DO JL = 1, KDLON
395	ZFSUP_AERO(JL,JK,2) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
396	ZFSDN_AERO(JL,JK,2) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
397	ENDDO
398	ENDDO
399
400	ENDIF !-end ok_ade
401
402	IF ( .not. ok_ade .or. .not. ok_aie ) THEN
403
404	! cloudy-sky with natural aerosols for indirect effect
405	! and natural aerosols for direct effect
406	! PTAU
407	! CAS AER (3)
408	! cloudy-sky direct effect natural aerosol
409	flag_aer=1.0
410	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
411	PRMU0,PFRAC,PTAVE,PWV,&
412	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
413	INU = 1
414	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
415	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
416	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
417	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
418	ZFD, ZFU)
419	INU = 2
420	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
421	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
422	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
423	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
424	PWV, PQS,&
425	ZFDOWN, ZFUP)
426
427	DO JK = 1 , KFLEV+1
428	DO JL = 1, KDLON
429	ZFSUP_AERO(JL,JK,3) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
430	ZFSDN_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
431	ENDDO
432	ENDDO
433
434	ENDIF !--true/false or false/true
435
436	IF (ok_ade .and. ok_aie) THEN
437
438	! cloudy-sky with total aerosols for indirect effect
439	! and total aerosols for direct effect
440	! PTAUA
441	! CAS AER (2)
442	flag_aer=1.0
443	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
444	PRMU0,PFRAC,PTAVE,PWV,&
445	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
446	INU = 1
447	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
448	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
449	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
450	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
451	ZFD, ZFU)
452	INU = 2
453	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
454	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
455	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
456	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
457	PWV, PQS,&
458	ZFDOWN, ZFUP)
459
460	DO JK = 1 , KFLEV+1
461	DO JL = 1, KDLON
462	ZFSUP_AERO(JL,JK,4) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
463	ZFSDN_AERO(JL,JK,4) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
464	ENDDO
465	ENDDO
466
467	ENDIF ! ok_ade .and. ok_aie
468
469	IF (ok_aie) THEN
470	! cloudy-sky with total aerosols for indirect effect
471	! and natural aerosols for direct effect
472	! PTAUA
473	! CAS AER (3)
474	flag_aer=1.0
475	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
476	PRMU0,PFRAC,PTAVE,PWV,&
477	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
478	INU = 1
479	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
480	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
481	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
482	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
483	ZFD, ZFU)
484	INU = 2
485	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
486	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
487	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
488	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
489	PWV, PQS,&
490	ZFDOWN, ZFUP)
491
492	DO JK = 1 , KFLEV+1
493	DO JL = 1, KDLON
494	ZFSUP_AERO(JL,JK,5) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
495	ZFSDN_AERO(JL,JK,5) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
496	ENDDO
497	ENDDO
498
499	ENDIF ! ok_aie
500
501	ENDIF !--if flag_aerosol GT 0 OR flag_aerosol_strat
502
503	itapsw = 0
504	ENDIF
505	itapsw = itapsw + 1
506
507	IF ( AEROSOLFEEDBACK_ACTIVE .AND. (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) ) THEN
508	IF ( ok_ade .and. ok_aie ) THEN
509	ZFSUP(:,:) = ZFSUP_AERO(:,:,4)
510	ZFSDN(:,:) = ZFSDN_AERO(:,:,4)
511	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,2)
512	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,2)
513	ENDIF
514
515	IF ( ok_ade .and. (.not. ok_aie) ) THEN
516	ZFSUP(:,:) = ZFSUP_AERO(:,:,2)
517	ZFSDN(:,:) = ZFSDN_AERO(:,:,2)
518	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,2)
519	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,2)
520	ENDIF
521
522	IF ( (.not. ok_ade) .and. ok_aie ) THEN
523	ZFSUP(:,:) = ZFSUP_AERO(:,:,5)
524	ZFSDN(:,:) = ZFSDN_AERO(:,:,5)
525	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,3)
526	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,3)
527	ENDIF
528
529	IF ((.not. ok_ade) .and. (.not. ok_aie)) THEN
530	ZFSUP(:,:) = ZFSUP_AERO(:,:,3)
531	ZFSDN(:,:) = ZFSDN_AERO(:,:,3)
532	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,3)
533	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,3)
534	ENDIF
535
536	! MS the following allows to compute the forcing diagostics without
537	! letting the aerosol forcing act on the meteorology
538	! SEE logic above
539	ELSE
540	ZFSUP(:,:) = ZFSUP_AERO(:,:,1)
541	ZFSDN(:,:) = ZFSDN_AERO(:,:,1)
542	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,1)
543	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,1)
544	ENDIF
545
546	! Now computes heating rates
547	DO k = 1, KFLEV
548	kpl1 = k+1
549	DO i = 1, KDLON
550	PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k))-(ZFSDN(i,k)-ZFSDN(i,kpl1))
551	PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
552	PHEAT0(i,k) = -(ZFSUP0(i,kpl1)-ZFSUP0(i,k))-(ZFSDN0(i,k)-ZFSDN0(i,kpl1))
553	PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k)
554	ENDDO
555	ENDDO
556
557	DO i = 1, KDLON
558	! effective SW surface albedo calculation
559	PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20)
560
561	! clear sky net fluxes at TOA and SRF
562	PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)
563	PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)
564
565	! cloudy sky net fluxes at TOA and SRF
566	PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)
567	PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)
568
569	! net anthropogenic forcing direct and 1st indirect effect diagnostics
570	! requires a natural aerosol field read and used
571	! Difference of net fluxes from double call to radiation
572
573	IF (ok_ade) THEN
574
575	! indices 1: natural; 2 anthropogenic
576
577	! TOA/SRF all sky natural forcing
578	PSOLSWAERO(i,1) = (ZFSDN_AERO(i,1,3) - ZFSUP_AERO(i,1,3))-(ZFSDN_AERO(i,1,1) - ZFSUP_AERO(i,1,1))
579	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))
580
581	! TOA/SRF clear sky natural forcing
582	PSOLSW0AERO(i,1) = (ZFSDN0_AERO(i,1,3) - ZFSUP0_AERO(i,1,3))-(ZFSDN0_AERO(i,1,1) - ZFSUP0_AERO(i,1,1))
583	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))
584
585	IF (ok_aie) THEN
586
587	! TOA/SRF all sky anthropogenic forcing
588	PSOLSWAERO(i,2) = (ZFSDN_AERO(i,1,4) - ZFSUP_AERO(i,1,4))-(ZFSDN_AERO(i,1,5) - ZFSUP_AERO(i,1,5))
589	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))
590
591	ELSE
592
593	! TOA/SRF all sky anthropogenic forcing
594	PSOLSWAERO(i,2) = (ZFSDN_AERO(i,1,2) - ZFSUP_AERO(i,1,2))-(ZFSDN_AERO(i,1,3) - ZFSUP_AERO(i,1,3))
595	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))
596
597	ENDIF
598
599	! TOA/SRF clear sky anthropogenic forcing
600	PSOLSW0AERO(i,2) = (ZFSDN0_AERO(i,1,2) - ZFSUP0_AERO(i,1,2))-(ZFSDN0_AERO(i,1,3) - ZFSUP0_AERO(i,1,3))
601	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))
602
603	! direct anthropogenic forcing , as in old LMDzT, however differences of net fluxes
604	PSOLSWADAERO(i) = PSOLSWAERO(i,2)
605	PTOPSWADAERO(i) = PTOPSWAERO(i,2)
606	PSOLSWAD0AERO(i) = PSOLSW0AERO(i,2)
607	PTOPSWAD0AERO(i) = PTOPSW0AERO(i,2)
608
609	! OB: these diagnostics may not always work but who need them
610	! Cloud forcing indices 1: natural; 2 anthropogenic; 3: zero aerosol direct effect
611	! Instantaneously computed cloudy sky direct aerosol effect, cloud forcing due to aerosols above clouds
612	! natural
613	PSOLSWCFAERO(i,1) = PSOLSWAERO(i,1) - PSOLSW0AERO(i,1)
614	PTOPSWCFAERO(i,1) = PTOPSWAERO(i,1) - PTOPSW0AERO(i,1)
615
616	! Instantaneously computed cloudy SKY DIRECT aerosol effect, cloud forcing due to aerosols above clouds
617	! anthropogenic
618	PSOLSWCFAERO(i,2) = PSOLSWAERO(i,2) - PSOLSW0AERO(i,2)
619	PTOPSWCFAERO(i,2) = PTOPSWAERO(i,2) - PTOPSW0AERO(i,2)
620
621	! Cloudforcing without aerosol
622	! zero
623	PSOLSWCFAERO(i,3) = (ZFSDN_AERO(i,1,1) - ZFSUP_AERO(i,1,1))-(ZFSDN0_AERO(i,1,1) - ZFSUP0_AERO(i,1,1))
624	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))
625
626	ENDIF
627
628	IF (ok_aie) THEN
629	IF (ok_ade) THEN
630	PSOLSWAIAERO(i) = (ZFSDN_AERO(i,1,4) - ZFSUP_AERO(i,1,4))-(ZFSDN_AERO(i,1,2) - ZFSUP_AERO(i,1,2))
631	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))
632	ELSE
633	PSOLSWAIAERO(i) = (ZFSDN_AERO(i,1,5) - ZFSUP_AERO(i,1,5))-(ZFSDN_AERO(i,1,3) - ZFSUP_AERO(i,1,3))
634	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))
635	ENDIF
636	ENDIF
637
638	ENDDO
639
640	END SUBROUTINE SW_AEROAR4

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

Download in other formats:

Original Format