Context Navigation

sw_aeroAR4.F90 @ 1239

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

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

Download in other formats:

Original Format