Context Navigation

sw_aeroAR4.F90 @ 1231

Last change on this file since 1231 was 1231, checked in by lguez, 15 years ago

These are changes related to ozone in radiative transfer computations:

-- Moved "max(ozonecm, 1e-12)" from procedure "radlwsw" to procedure

"ozonecm".

-- Removed ratio "p_surface / p_reference" in the computation of

"pozon" in "radlwsw".

-- Removed ratio "p_reference / p_surface" in the computation of

"zoz" in "SW_LMDAR4" and "SW_AEROAR4".

-- Removed ratio "mass of air / mass of ozone" in the computation of

"zoz" in "LW_LMDAR4".

File size: 26.8 KB

Line
1	SUBROUTINE SW_AEROAR4(PSCT, PRMU0, PFRAC, &
2	PPMB, PDP, &
3	PPSOL, PALBD, PALBP,&
4	PTAVE, PWV, PQS, POZON, PAER,&
5	PCLDSW, PTAU, POMEGA, PCG,&
6	PHEAT, PHEAT0,&
7	PALBPLA,PTOPSW,PSOLSW,PTOPSW0,PSOLSW0,&
8	ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
9	tauaero, pizaero, cgaero,&
10	PTAUA, POMEGAA,&
11	PTOPSWADAERO,PSOLSWADAERO,&
12	PTOPSWAD0AERO,PSOLSWAD0AERO,&
13	PTOPSWAIAERO,PSOLSWAIAERO,&
14	PTOPSWAERO,PTOPSW0AERO,&
15	PSOLSWAERO,PSOLSW0AERO,&
16	ok_ade, ok_aie )
17
18	USE dimphy
19	IMPLICIT NONE
20
21	#include "YOMCST.h"
22	!
23	! ------------------------------------------------------------------
24	!
25	! PURPOSE.
26	! --------
27	!
28	! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
29	! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
30	!
31	! METHOD.
32	! -------
33	!
34	! 1. COMPUTES ABSORBER AMOUNTS (SWU)
35	! 2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL (SW1S)
36	! 3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL (SW2S)
37	!
38	! REFERENCE.
39	! ----------
40	!
41	! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
42	! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
43	!
44	! AUTHOR.
45	! -------
46	! JEAN-JACQUES MORCRETTE ECMWF
47	!
48	! MODIFICATIONS.
49	! --------------
50	! ORIGINAL : 89-07-14
51	! 95-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo
52	! 03-11-27 J. QUAAS Introduce aerosol forcings (based on BOUCHER)
53	! 09-04 A. COZIC - C.DEANDREIS Indroduce NAT/BC/POM/DUST/SS aerosol forcing
54	! ------------------------------------------------------------------
55	!
56	!* ARGUMENTS:
57	!
58	REAL(KIND=8) PSCT ! constante solaire (valeur conseillee: 1370)
59
60	REAL(KIND=8) PPSOL(KDLON) ! SURFACE PRESSURE (PA)
61	REAL(KIND=8) PDP(KDLON,KFLEV) ! LAYER THICKNESS (PA)
62	REAL(KIND=8) PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
63
64	REAL(KIND=8) PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
65	REAL(KIND=8) PFRAC(KDLON) ! fraction de la journee
66
67	REAL(KIND=8) PTAVE(KDLON,KFLEV) ! LAYER TEMPERATURE (K)
68	REAL(KIND=8) PWV(KDLON,KFLEV) ! SPECIFI! HUMIDITY (KG/KG)
69	REAL(KIND=8) PQS(KDLON,KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
70	REAL(KIND=8) POZON(KDLON,KFLEV) ! OZONE CONCENTRATION (KG/KG)
71	REAL(KIND=8) PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS
72
73	REAL(KIND=8) PALBD(KDLON,2) ! albedo du sol (lumiere diffuse)
74	REAL(KIND=8) PALBP(KDLON,2) ! albedo du sol (lumiere parallele)
75
76	REAL(KIND=8) PCLDSW(KDLON,KFLEV) ! CLOUD FRACTION
77	REAL(KIND=8) PTAU(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS
78	REAL(KIND=8) PCG(KDLON,2,KFLEV) ! ASYMETRY FACTOR
79	REAL(KIND=8) POMEGA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO
80
81	REAL(KIND=8) PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY)
82	REAL(KIND=8) PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
83	REAL(KIND=8) PALBPLA(KDLON) ! PLANETARY ALBEDO
84	REAL(KIND=8) PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
85	REAL(KIND=8) PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
86	REAL(KIND=8) PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
87	REAL(KIND=8) PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
88	!
89	!* LOCAL VARIABLES:
90	!
91	real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
92
93	REAL(KIND=8) ZOZ(KDLON,KFLEV)
94	! column-density of ozone in layer, in kilo-Dobsons
95
96	REAL(KIND=8) ZAKI(KDLON,2)
97	REAL(KIND=8) ZCLD(KDLON,KFLEV)
98	REAL(KIND=8) ZCLEAR(KDLON)
99	REAL(KIND=8) ZDSIG(KDLON,KFLEV)
100	REAL(KIND=8) ZFACT(KDLON)
101	REAL(KIND=8) ZFD(KDLON,KFLEV+1)
102	REAL(KIND=8) ZFDOWN(KDLON,KFLEV+1)
103	REAL(KIND=8) ZFU(KDLON,KFLEV+1)
104	REAL(KIND=8) ZFUP(KDLON,KFLEV+1)
105	REAL(KIND=8) ZRMU(KDLON)
106	REAL(KIND=8) ZSEC(KDLON)
107	REAL(KIND=8) ZUD(KDLON,5,KFLEV+1)
108	REAL(KIND=8) ZCLDSW0(KDLON,KFLEV)
109
110	REAL(KIND=8) ZFSUP(KDLON,KFLEV+1)
111	REAL(KIND=8) ZFSDN(KDLON,KFLEV+1)
112	REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1)
113	REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1)
114
115	INTEGER inu, jl, jk, i, k, kpl1
116
117	INTEGER swpas ! Every swpas steps, sw is calculated
118	PARAMETER(swpas=1)
119
120	INTEGER, SAVE :: itapsw = 0
121	!$OMP THREADPRIVATE(itapsw)
122	LOGICAL, SAVE :: appel1er = .TRUE.
123	!$OMP THREADPRIVATE(appel1er)
124	LOGICAL, SAVE :: initialized = .FALSE.
125	!$OMP THREADPRIVATE(initialized)
126
127	!jq-Introduced for aerosol forcings
128	REAL(KIND=8), SAVE :: flag_aer
129	!$OMP THREADPRIVATE(flag_aer)
130
131	LOGICAL ok_ade, ok_aie ! use aerosol forcings or not?
132	REAL(KIND=8) tauaero(kdlon,kflev,9,2) ! aerosol optical properties
133	REAL(KIND=8) pizaero(kdlon,kflev,9,2) ! (see aeropt.F)
134	REAL(KIND=8) cgaero(kdlon,kflev,9,2) ! -"-
135	REAL(KIND=8) PTAUA(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS (pre-industrial value)
136	REAL(KIND=8) POMEGAA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO
137	REAL(KIND=8) PTOPSWADAERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
138	REAL(KIND=8) PSOLSWADAERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
139	REAL(KIND=8) PTOPSWAD0AERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
140	REAL(KIND=8) PSOLSWAD0AERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
141	REAL(KIND=8) PTOPSWAIAERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
142	REAL(KIND=8) PSOLSWAIAERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
143	REAL(KIND=8) PTOPSWAERO(KDLON,9)
144	REAL(KIND=8) PTOPSW0AERO(KDLON,9)
145	REAL(KIND=8) PSOLSWAERO(KDLON,9)
146	REAL(KIND=8) PSOLSW0AERO(KDLON,9)
147
148	!jq - Fluxes including aerosol effects
149	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAD_AERO(:,:)
150	!$OMP THREADPRIVATE(ZFSUPAD_AERO)
151	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAD_AERO(:,:)
152	!$OMP THREADPRIVATE(ZFSDNAD_AERO)
153	!jq - Fluxes including aerosol effects
154	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAD0_AERO(:,:)
155	!$OMP THREADPRIVATE(ZFSUPAD0_AERO)
156	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAD0_AERO(:,:)
157	!$OMP THREADPRIVATE(ZFSDNAD0_AERO)
158	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAI_AERO(:,:)
159	!$OMP THREADPRIVATE(ZFSUPAI_AERO)
160	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAI_AERO(:,:)
161	!$OMP THREADPRIVATE(ZFSDNAI_AERO)
162	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUP_AERO(:,:,:)
163	!$OMP THREADPRIVATE(ZFSUP_AERO)
164	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDN_AERO(:,:,:)
165	!$OMP THREADPRIVATE(ZFSDN_AERO)
166	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUP0_AERO(:,:,:)
167	!$OMP THREADPRIVATE(ZFSUP0_AERO)
168	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDN0_AERO(:,:,:)
169	!$OMP THREADPRIVATE(ZFSDN0_AERO)
170
171
172	IF(.NOT.initialized) THEN
173	flag_aer=0.
174	initialized=.TRUE.
175	ALLOCATE(ZFSUPAD_AERO(KDLON,KFLEV+1))
176	ALLOCATE(ZFSDNAD_AERO(KDLON,KFLEV+1))
177	ALLOCATE(ZFSUPAD0_AERO(KDLON,KFLEV+1))
178	ALLOCATE(ZFSDNAD0_AERO(KDLON,KFLEV+1))
179	ALLOCATE(ZFSUPAI_AERO(KDLON,KFLEV+1))
180	ALLOCATE(ZFSDNAI_AERO(KDLON,KFLEV+1))
181	ALLOCATE(ZFSUP_AERO (KDLON,KFLEV+1,9))
182	ALLOCATE(ZFSDN_AERO (KDLON,KFLEV+1,9))
183	ALLOCATE(ZFSUP0_AERO(KDLON,KFLEV+1,9))
184	ALLOCATE(ZFSDN0_AERO(KDLON,KFLEV+1,9))
185	ZFSUPAD_AERO(:,:)=0.
186	ZFSDNAD_AERO(:,:)=0.
187	ZFSUPAD0_AERO(:,:)=0.
188	ZFSDNAD0_AERO(:,:)=0.
189	ZFSUPAI_AERO(:,:)=0.
190	ZFSDNAI_AERO(:,:)=0.
191	ZFSUP_AERO (:,:,:)=0.
192	ZFSDN_AERO (:,:,:)=0.
193	ZFSUP0_AERO(:,:,:)=0.
194	ZFSDN0_AERO(:,:,:)=0.
195	ENDIF
196
197
198	IF (appel1er) THEN
199	PRINT*, 'SW calling frequency : ', swpas
200	PRINT*, " In general, it should be 1"
201	appel1er = .FALSE.
202	ENDIF
203	! ------------------------------------------------------------------
204	IF (MOD(itapsw,swpas).EQ.0) THEN
205
206	DO JK = 1 , KFLEV
207	DO JL = 1, KDLON
208	ZCLDSW0(JL,JK) = 0.0
209	ZOZ(JL,JK) = POZON(JL,JK) / dobson_u / 1e3 / RG * PDP(JL,JK)
210	ENDDO
211	ENDDO
212
213
214	! clear-sky:
215	flag_aer=0.0
216	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
217	PRMU0,PFRAC,PTAVE,PWV,&
218	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
219	INU = 1
220	CALL SW1S_LMDAR4(INU,PAER, flag_aer, &
221	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
222	PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
223	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
224	ZFD, ZFU)
225	INU = 2
226	CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
227	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
228	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
229	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
230	PWV, PQS,&
231	ZFDOWN, ZFUP)
232	DO JK = 1 , KFLEV+1
233	DO JL = 1, KDLON
234	ZFSUP0(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
235	ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
236	ZFSUP0_AERO(JL,JK,1) = ZFSUP0(JL,JK)
237	ZFSDN0_AERO(JL,JK,1) = ZFSDN0(JL,JK)
238	ENDDO
239	ENDDO
240
241
242	! cloudy-sky:
243	flag_aer=0.0
244	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
245	PRMU0,PFRAC,PTAVE,PWV,&
246	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
247	INU = 1
248	CALL SW1S_LMDAR4(INU, PAER, flag_aer, &
249	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
250	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
251	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
252	ZFD, ZFU)
253	INU = 2
254	CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
255	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
256	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
257	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
258	PWV, PQS,&
259	ZFDOWN, ZFUP)
260
261	DO JK = 1 , KFLEV+1
262	DO JL = 1, KDLON
263	ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
264	ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
265	ZFSUP_AERO(JL,JK,1) = ZFSUP(JL,JK)
266	ZFSDN_AERO(JL,JK,1) = ZFSDN(JL,JK)
267	ENDDO
268	ENDDO
269
270	ZFSUP0_AERO(:,:,2) = ZFSUP0_AERO(:,:,1)
271	ZFSDN0_AERO(:,:,2) = ZFSDN0_AERO(:,:,1)
272	ZFSUP_AERO(:,:,2) = ZFSUP_AERO(:,:,1)
273	ZFSDN_AERO(:,:,2) = ZFSDN_AERO(:,:,1)
274
275
276	IF (ok_ade) THEN
277
278	! clear sky (Anne Cozic 03/07/2007)
279	! CAS AER (2)
280	flag_aer=1.0
281	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
282	PRMU0,PFRAC,PTAVE,PWV,&
283	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
284	INU = 1
285	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
286	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
287	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
288	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
289	ZFD, ZFU)
290	INU = 2
291	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
292	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
293	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
294	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
295	PWV, PQS,&
296	ZFDOWN, ZFUP)
297
298	DO JK = 1 , KFLEV+1
299	DO JL = 1, KDLON
300	ZFSUPAD0_AERO(JL,JK) = ZFSUP0(JL,JK)
301	ZFSDNAD0_AERO(JL,JK) = ZFSDN0(JL,JK)
302	ZFSUP0(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
303	ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
304	ZFSUP0_AERO(JL,JK,2) = ZFSUP0(JL,JK)
305	ZFSDN0_AERO(JL,JK,2) = ZFSDN0(JL,JK)
306	ENDDO
307	ENDDO
308
309	! cloudy-sky + aerosol dir OB
310	! ACo AER
311	flag_aer=1.0
312	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
313	PRMU0,PFRAC,PTAVE,PWV,&
314	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
315	INU = 1
316	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
317	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
318	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
319	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
320	ZFD, ZFU)
321	INU = 2
322	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
323	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
324	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
325	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
326	PWV, PQS,&
327	ZFDOWN, ZFUP)
328
329	DO JK = 1 , KFLEV+1
330	DO JL = 1, KDLON
331	ZFSUPAD_AERO(JL,JK) = ZFSUP(JL,JK)
332	ZFSDNAD_AERO(JL,JK) = ZFSDN(JL,JK)
333	ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
334	ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
335	ZFSUP_AERO(JL,JK,2) = ZFSUP(JL,JK)
336	ZFSDN_AERO(JL,JK,2) = ZFSDN(JL,JK)
337	ENDDO
338	ENDDO
339
340	!CAS NAT
341	! clear sky
342	flag_aer=1.0
343	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
344	PRMU0,PFRAC,PTAVE,PWV,&
345	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
346	INU = 1
347	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
348	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
349	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
350	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
351	ZFD, ZFU)
352	INU = 2
353	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
354	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
355	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
356	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
357	PWV, PQS,&
358	ZFDOWN, ZFUP)
359
360	DO JK = 1 , KFLEV+1
361	DO JL = 1, KDLON
362	ZFSUP0_AERO(JL,JK,3) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
363	ZFSDN0_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
364	ENDDO
365	ENDDO
366
367	! cloudy-sky
368	! ACo NAT
369	flag_aer=1.0
370	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
371	PRMU0,PFRAC,PTAVE,PWV,&
372	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
373	INU = 1
374	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
375	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
376	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
377	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
378	ZFD, ZFU)
379	INU = 2
380	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
381	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
382	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
383	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
384	PWV, PQS,&
385	ZFDOWN, ZFUP)
386
387	DO JK = 1 , KFLEV+1
388	DO JL = 1, KDLON
389	ZFSUP_AERO(JL,JK,3) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
390	ZFSDN_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
391	ENDDO
392	ENDDO
393
394	! clear sky (Yves 01/12/2007)
395	! CAS BC (4)
396	flag_aer=1.0
397	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
398	PRMU0,PFRAC,PTAVE,PWV,&
399	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
400	INU = 1
401	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
402	tauaero(:,:,4,:), pizaero(:,:,4,:), cgaero(:,:,4,:),&
403	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
404	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
405	ZFD, ZFU)
406	INU = 2
407	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
408	tauaero(:,:,4,:), pizaero(:,:,4,:), cgaero(:,:,4,:),&
409	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
410	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
411	PWV, PQS,&
412	ZFDOWN, ZFUP)
413
414	DO JK = 1 , KFLEV+1
415	DO JL = 1, KDLON
416	ZFSUP0_AERO(JL,JK,4) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
417	ZFSDN0_AERO(JL,JK,4) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
418	ENDDO
419	ENDDO
420
421	! cloudy-sky + aerosol dir OB
422	! CAS BC (4)
423	flag_aer=1.0
424	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
425	PRMU0,PFRAC,PTAVE,PWV,&
426	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
427	INU = 1
428	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
429	tauaero(:,:,4,:), pizaero(:,:,4,:), cgaero(:,:,4,:),&
430	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
431	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
432	ZFD, ZFU)
433	INU = 2
434	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
435	tauaero(:,:,4,:), pizaero(:,:,4,:), cgaero(:,:,4,:),&
436	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
437	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
438	PWV, PQS,&
439	ZFDOWN, ZFUP)
440
441	DO JK = 1 , KFLEV+1
442	DO JL = 1, KDLON
443	ZFSUP_AERO(JL,JK,4) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
444	ZFSDN_AERO(JL,JK,4) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
445	ENDDO
446	ENDDO
447
448	! clear sky (Yves 13/12/2007)
449	! CAS SO4 (5)
450	flag_aer=1.0
451	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
452	PRMU0,PFRAC,PTAVE,PWV,&
453	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
454	INU = 1
455	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
456	tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),&
457	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
458	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
459	ZFD, ZFU)
460	INU = 2
461	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
462	tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),&
463	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
464	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
465	PWV, PQS,&
466	ZFDOWN, ZFUP)
467
468	DO JK = 1 , KFLEV+1
469	DO JL = 1, KDLON
470	ZFSUP0_AERO(JL,JK,5) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
471	ZFSDN0_AERO(JL,JK,5) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
472	ENDDO
473	ENDDO
474
475	! cloudy-sky + aerosol dir OB
476	! CAS SO4 (5)
477	flag_aer=1.0
478	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
479	PRMU0,PFRAC,PTAVE,PWV,&
480	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
481	INU = 1
482	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
483	tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),&
484	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
485	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
486	ZFD, ZFU)
487	INU = 2
488	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
489	tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),&
490	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
491	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
492	PWV, PQS,&
493	ZFDOWN, ZFUP)
494
495	DO JK = 1 , KFLEV+1
496	DO JL = 1, KDLON
497	ZFSUP_AERO(JL,JK,5) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
498	ZFSDN_AERO(JL,JK,5) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
499	ENDDO
500	ENDDO
501
502	! clear sky (Yves 13/12/2007)
503	! CAS POM (6)
504	flag_aer=1.0
505	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
506	PRMU0,PFRAC,PTAVE,PWV,&
507	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
508	INU = 1
509	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
510	tauaero(:,:,6,:), pizaero(:,:,6,:), cgaero(:,:,6,:),&
511	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
512	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
513	ZFD, ZFU)
514	INU = 2
515	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
516	tauaero(:,:,6,:), pizaero(:,:,6,:), cgaero(:,:,6,:),&
517	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
518	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
519	PWV, PQS,&
520	ZFDOWN, ZFUP)
521
522	DO JK = 1 , KFLEV+1
523	DO JL = 1, KDLON
524	ZFSUP0_AERO(JL,JK,6) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
525	ZFSDN0_AERO(JL,JK,6) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
526	ENDDO
527	ENDDO
528
529	! cloudy-sky + aerosol dir OB
530	! CAS POM (6)
531	flag_aer=1.0
532	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
533	PRMU0,PFRAC,PTAVE,PWV,&
534	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
535	INU = 1
536	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
537	tauaero(:,:,6,:), pizaero(:,:,6,:), cgaero(:,:,6,:),&
538	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
539	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
540	ZFD, ZFU)
541	INU = 2
542	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
543	tauaero(:,:,6,:), pizaero(:,:,6,:), cgaero(:,:,6,:),&
544	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
545	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
546	PWV, PQS,&
547	ZFDOWN, ZFUP)
548
549	DO JK = 1 , KFLEV+1
550	DO JL = 1, KDLON
551	ZFSUP_AERO(JL,JK,6) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
552	ZFSDN_AERO(JL,JK,6) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
553	ENDDO
554	ENDDO
555
556	! clear sky (Yves 13/12/2007)
557	! CAS DUST (7)
558	flag_aer=1.0
559	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
560	PRMU0,PFRAC,PTAVE,PWV,&
561	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
562	INU = 1
563	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
564	tauaero(:,:,7,:), pizaero(:,:,7,:), cgaero(:,:,7,:),&
565	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
566	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
567	ZFD, ZFU)
568	INU = 2
569	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
570	tauaero(:,:,7,:), pizaero(:,:,7,:), cgaero(:,:,7,:),&
571	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
572	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
573	PWV, PQS,&
574	ZFDOWN, ZFUP)
575
576	DO JK = 1 , KFLEV+1
577	DO JL = 1, KDLON
578	ZFSUP0_AERO(JL,JK,7) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
579	ZFSDN0_AERO(JL,JK,7) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
580	ENDDO
581	ENDDO
582
583	! cloudy-sky + aerosol dir OB
584	! CAS DUST (7)
585	flag_aer=1.0
586	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
587	PRMU0,PFRAC,PTAVE,PWV,&
588	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
589	INU = 1
590	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
591	tauaero(:,:,7,:), pizaero(:,:,7,:), cgaero(:,:,7,:),&
592	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
593	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
594	ZFD, ZFU)
595	INU = 2
596	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
597	tauaero(:,:,7,:), pizaero(:,:,7,:), cgaero(:,:,7,:),&
598	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
599	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
600	PWV, PQS,&
601	ZFDOWN, ZFUP)
602
603	DO JK = 1 , KFLEV+1
604	DO JL = 1, KDLON
605	ZFSUP_AERO(JL,JK,7) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
606	ZFSDN_AERO(JL,JK,7) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
607	ENDDO
608	ENDDO
609
610	! clear sky (Yves 13/12/2007)
611	! CAS Seasalt SS (8)
612	flag_aer=1.0
613	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
614	PRMU0,PFRAC,PTAVE,PWV,&
615	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
616	INU = 1
617	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
618	tauaero(:,:,8,:), pizaero(:,:,8,:), cgaero(:,:,8,:),&
619	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
620	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
621	ZFD, ZFU)
622	INU = 2
623	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
624	tauaero(:,:,8,:), pizaero(:,:,8,:), cgaero(:,:,8,:),&
625	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
626	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
627	PWV, PQS,&
628	ZFDOWN, ZFUP)
629
630	DO JK = 1 , KFLEV+1
631	DO JL = 1, KDLON
632	ZFSUP0_AERO(JL,JK,8) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
633	ZFSDN0_AERO(JL,JK,8) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
634	ENDDO
635	ENDDO
636
637	! cloudy-sky + aerosol dir OB
638	! CAS Seasalt SS (8)
639	flag_aer=1.0
640	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
641	PRMU0,PFRAC,PTAVE,PWV,&
642	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
643	INU = 1
644	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
645	tauaero(:,:,8,:), pizaero(:,:,8,:), cgaero(:,:,8,:),&
646	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
647	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
648	ZFD, ZFU)
649	INU = 2
650	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
651	tauaero(:,:,8,:), pizaero(:,:,8,:), cgaero(:,:,8,:),&
652	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
653	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
654	PWV, PQS,&
655	ZFDOWN, ZFUP)
656
657	DO JK = 1 , KFLEV+1
658	DO JL = 1, KDLON
659	ZFSUP_AERO(JL,JK,8) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
660	ZFSDN_AERO(JL,JK,8) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
661	ENDDO
662	ENDDO
663
664	ENDIF ! ok_ade
665
666
667	IF (ok_aie) THEN
668	!jq cloudy-sky + aerosol direct + aerosol indirect
669	flag_aer=1.0
670	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
671	PRMU0,PFRAC,PTAVE,PWV,&
672	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
673	INU = 1
674	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
675	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
676	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
677	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
678	ZFD, ZFU)
679	INU = 2
680	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
681	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
682	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
683	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
684	PWV, PQS,&
685	ZFDOWN, ZFUP)
686	DO JK = 1 , KFLEV+1
687	DO JL = 1, KDLON
688	ZFSUPAI_AERO(JL,JK) = ZFSUP(JL,JK)
689	ZFSDNAI_AERO(JL,JK) = ZFSDN(JL,JK)
690	ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
691	ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
692	ZFSUP_AERO(JL,JK,2) = ZFSUP(JL,JK)
693	ZFSDN_AERO(JL,JK,2) = ZFSDN(JL,JK)
694	ENDDO
695	ENDDO
696	ENDIF ! ok_aie
697
698	itapsw = 0
699	ENDIF
700	itapsw = itapsw + 1
701
702	DO k = 1, KFLEV
703	kpl1 = k+1
704	DO i = 1, KDLON
705
706	PHEAT(i,k) = -(ZFSUP_AERO(i,kpl1,2)-ZFSUP_AERO(i,k,2)) &
707	-(ZFSDN_AERO(i,k,2)-ZFSDN_AERO(i,kpl1,2))
708	PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
709	PHEAT0(i,k) = -(ZFSUP0_AERO(i,kpl1,2)-ZFSUP0_AERO(i,k,2)) &
710	-(ZFSDN0_AERO(i,k,2)-ZFSDN0_AERO(i,kpl1,2))
711	PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k)
712
713	ENDDO
714	ENDDO
715	DO i = 1, KDLON
716	PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20)
717	! clear sky
718	PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)
719	PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)
720
721	PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)
722	PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)
723
724	PSOLSW0AERO(i,:) = ZFSDN0_AERO(i,1,:) - ZFSUP0_AERO(i,1,:)
725	PTOPSW0AERO(i,:) = &
726	ZFSDN0_AERO(i,KFLEV+1,:) - ZFSUP0_AERO(i,KFLEV+1,:)
727
728	PSOLSWAERO(i,:) = ZFSDN_AERO(i,1,:) - ZFSUP_AERO(i,1,:)
729	PTOPSWAERO(i,:) = &
730	ZFSDN_AERO(i,KFLEV+1,:) - ZFSUP_AERO(i,KFLEV+1,:)
731
732	PSOLSWADAERO(i) = ZFSDNAD_AERO(i,1) - ZFSUPAD_AERO(i,1)
733	PTOPSWADAERO(i) = &
734	ZFSDNAD_AERO(i,KFLEV+1) - ZFSUPAD_AERO(i,KFLEV+1)
735
736	PSOLSWAD0AERO(i) = ZFSDNAD0_AERO(i,1) - ZFSUPAD0_AERO(i,1)
737	PTOPSWAD0AERO(i) = &
738	ZFSDNAD0_AERO(i,KFLEV+1) - ZFSUPAD0_AERO(i,KFLEV+1)
739
740	PSOLSWAIAERO(i) = ZFSDNAI_AERO(i,1) - ZFSUPAI_AERO(i,1)
741	PTOPSWAIAERO(i) = &
742	ZFSDNAI_AERO(i,KFLEV+1) - ZFSUPAI_AERO(i,KFLEV+1)
743
744	ENDDO
745	END SUBROUTINE SW_AEROAR4
746

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

Download in other formats:

Original Format