Context Navigation

sw_aeroAR4.F90 @ 1161

Last change on this file since 1161 was 1159, checked in by jghattas, 16 years ago

Recuperation de la variable solaire avec include clesphys.h au lieu de liste des arguments
Recuperation de qq modifications qui etaient fait sur radlwsw.F mais pas repercute sur la nouvelle version radlwsw_aero.F90 :
- Ajoute iflag_rrtm et 3 arguments qui sont necessaire pour iflag_rrtm=1 + Cosmetique

Marie-Pierre + Josefine

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

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

Download in other formats:

Original Format