Context Navigation

sw_aeroAR4.F90 @ 1157

Last change on this file since 1157 was 1153, checked in by jghattas, 17 years ago
Changement de nom de fichier et nom de subroutine en ajoutant AR4 pour faire comprendre que cette subroutine fait partie du paquet de la radiation AR4.
File size: 26.4 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 itapsw
117	LOGICAL appel1er
118	DATA itapsw /0/
119	DATA appel1er /.TRUE./
120	SAVE itapsw,appel1er
121	!$OMP THREADPRIVATE(appel1er)
122	!$OMP THREADPRIVATE(itapsw)
123	!jq-Introduced for aerosol forcings
124	REAL*8 flag_aer
125	LOGICAL ok_ade, ok_aie ! use aerosol forcings or not?
126	REAL*8 tauaero(kdlon,kflev,9,2) ! aerosol optical properties
127	REAL*8 pizaero(kdlon,kflev,9,2) ! (see aeropt.F)
128	REAL*8 cgaero(kdlon,kflev,9,2) ! -"-
129	REAL*8 PTAUA(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS (pre-industrial value)
130	REAL*8 POMEGAA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO
131	REAL*8 PTOPSWADAERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
132	REAL*8 PSOLSWADAERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
133	REAL*8 PTOPSWAD0AERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
134	REAL*8 PSOLSWAD0AERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
135	REAL*8 PTOPSWAIAERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
136	REAL*8 PSOLSWAIAERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
137	REAL*8 PTOPSWAERO(KDLON,9)
138	REAL*8 PTOPSW0AERO(KDLON,9)
139	REAL*8 PSOLSWAERO(KDLON,9)
140	REAL*8 PSOLSW0AERO(KDLON,9)
141
142	!jq - Fluxes including aerosol effects
143	REAL*8,ALLOCATABLE,SAVE :: ZFSUPAD_AERO(:,:)
144	!$OMP THREADPRIVATE(ZFSUPAD_AERO)
145	REAL*8,ALLOCATABLE,SAVE :: ZFSDNAD_AERO(:,:)
146	!$OMP THREADPRIVATE(ZFSDNAD_AERO)
147	!jq - Fluxes including aerosol effects
148	REAL*8,ALLOCATABLE,SAVE :: ZFSUPAD0_AERO(:,:)
149	!$OMP THREADPRIVATE(ZFSUPAD0_AERO)
150	REAL*8,ALLOCATABLE,SAVE :: ZFSDNAD0_AERO(:,:)
151	!$OMP THREADPRIVATE(ZFSDNAD0_AERO)
152	REAL*8,ALLOCATABLE,SAVE :: ZFSUPAI_AERO(:,:)
153	!$OMP THREADPRIVATE(ZFSUPAI_AERO)
154	REAL*8,ALLOCATABLE,SAVE :: ZFSDNAI_AERO(:,:)
155	!$OMP THREADPRIVATE(ZFSDNAI_AERO)
156	REAL*8,ALLOCATABLE,SAVE :: ZFSUP_AERO(:,:,:)
157	!$OMP THREADPRIVATE(ZFSUP_AERO)
158	REAL*8,ALLOCATABLE,SAVE :: ZFSDN_AERO(:,:,:)
159	!$OMP THREADPRIVATE(ZFSDN_AERO)
160	REAL*8,ALLOCATABLE,SAVE :: ZFSUP0_AERO(:,:,:)
161	!$OMP THREADPRIVATE(ZFSUP0_AERO)
162	REAL*8,ALLOCATABLE,SAVE :: ZFSDN0_AERO(:,:,:)
163	!$OMP THREADPRIVATE(ZFSDN0_AERO)
164
165	LOGICAL initialized
166	!rv
167	SAVE flag_aer
168	!$OMP THREADPRIVATE(flag_aer)
169	DATA initialized/.FALSE./
170	SAVE initialized
171	!$OMP THREADPRIVATE(initialized)
172
173
174	IF(.NOT.initialized) THEN
175	flag_aer=0.
176	initialized=.TRUE.
177	ALLOCATE(ZFSUPAD_AERO(KDLON,KFLEV+1))
178	ALLOCATE(ZFSDNAD_AERO(KDLON,KFLEV+1))
179	ALLOCATE(ZFSUPAD0_AERO(KDLON,KFLEV+1))
180	ALLOCATE(ZFSDNAD0_AERO(KDLON,KFLEV+1))
181	ALLOCATE(ZFSUPAI_AERO(KDLON,KFLEV+1))
182	ALLOCATE(ZFSDNAI_AERO(KDLON,KFLEV+1))
183	ALLOCATE(ZFSUP_AERO (KDLON,KFLEV+1,9))
184	ALLOCATE(ZFSDN_AERO (KDLON,KFLEV+1,9))
185	ALLOCATE(ZFSUP0_AERO(KDLON,KFLEV+1,9))
186	ALLOCATE(ZFSDN0_AERO(KDLON,KFLEV+1,9))
187	ZFSUPAD_AERO(:,:)=0.
188	ZFSDNAD_AERO(:,:)=0.
189	ZFSUPAD0_AERO(:,:)=0.
190	ZFSDNAD0_AERO(:,:)=0.
191	ZFSUPAI_AERO(:,:)=0.
192	ZFSDNAI_AERO(:,:)=0.
193	ZFSUP_AERO (:,:,:)=0.
194	ZFSDN_AERO (:,:,:)=0.
195	ZFSUP0_AERO(:,:,:)=0.
196	ZFSDN0_AERO(:,:,:)=0.
197	ENDIF
198	!rv
199
200
201	IF (appel1er) THEN
202	PRINT*, 'SW calling frequency : ', swpas
203	PRINT*, " In general, it should be 1"
204	appel1er = .FALSE.
205	ENDIF
206	! ------------------------------------------------------------------
207	IF (MOD(itapsw,swpas).EQ.0) THEN
208
209	DO JK = 1 , KFLEV
210	DO JL = 1, KDLON
211	ZCLDSW0(JL,JK) = 0.0
212	ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG &
213	PDP(JL,JK)(101325.0/PPSOL(JL))
214	ENDDO
215	ENDDO
216
217
218	! clear-sky:
219	flag_aer=0.0
220	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
221	PRMU0,PFRAC,PTAVE,PWV,&
222	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
223	INU = 1
224	CALL SW1S_LMDAR4(INU,PAER, flag_aer, &
225	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
226	PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
227	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
228	ZFD, ZFU)
229	INU = 2
230	CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
231	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
232	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
233	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
234	PWV, PQS,&
235	ZFDOWN, ZFUP)
236	DO JK = 1 , KFLEV+1
237	DO JL = 1, KDLON
238	ZFSUP0(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
239	ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
240	ZFSUP0_AERO(JL,JK,1) = ZFSUP0(JL,JK)
241	ZFSDN0_AERO(JL,JK,1) = ZFSDN0(JL,JK)
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(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
268	ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
269	ZFSUP_AERO(JL,JK,1) = ZFSUP(JL,JK)
270	ZFSDN_AERO(JL,JK,1) = ZFSDN(JL,JK)
271	ENDDO
272	ENDDO
273
274	ZFSUP0_AERO(:,:,2) = ZFSUP0_AERO(:,:,1)
275	ZFSDN0_AERO(:,:,2) = ZFSDN0_AERO(:,:,1)
276	ZFSUP_AERO(:,:,2) = ZFSUP_AERO(:,:,1)
277	ZFSDN_AERO(:,:,2) = ZFSDN_AERO(:,:,1)
278
279
280	IF (ok_ade) THEN
281
282	! clear sky (Anne Cozic 03/07/2007)
283	! CAS AER (2)
284	flag_aer=1.0
285	CALL SWU_LMDAR4(PSCT,ZCLDSW0,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(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
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(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
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	ZFSUPAD0_AERO(JL,JK) = ZFSUP0(JL,JK)
305	ZFSDNAD0_AERO(JL,JK) = ZFSDN0(JL,JK)
306	ZFSUP0(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
307	ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
308	ZFSUP0_AERO(JL,JK,2) = ZFSUP0(JL,JK)
309	ZFSDN0_AERO(JL,JK,2) = ZFSDN0(JL,JK)
310	ENDDO
311	ENDDO
312
313	! cloudy-sky + aerosol dir OB
314	! ACo AER
315	flag_aer=1.0
316	CALL SWU_LMDAR4(PSCT,PCLDSW,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(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
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(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
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	ZFSUPAD_AERO(JL,JK) = ZFSUP(JL,JK)
336	ZFSDNAD_AERO(JL,JK) = ZFSDN(JL,JK)
337	ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
338	ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
339	ZFSUP_AERO(JL,JK,2) = ZFSUP(JL,JK)
340	ZFSDN_AERO(JL,JK,2) = ZFSDN(JL,JK)
341	ENDDO
342	ENDDO
343
344	!CAS NAT
345	! clear sky
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(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
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(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
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,3) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
367	ZFSDN0_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
368	ENDDO
369	ENDDO
370
371	! cloudy-sky
372	! ACo NAT
373	flag_aer=1.0
374	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
375	PRMU0,PFRAC,PTAVE,PWV,&
376	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
377	INU = 1
378	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
379	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
380	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
381	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
382	ZFD, ZFU)
383	INU = 2
384	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
385	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
386	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
387	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
388	PWV, PQS,&
389	ZFDOWN, ZFUP)
390
391	DO JK = 1 , KFLEV+1
392	DO JL = 1, KDLON
393	ZFSUP_AERO(JL,JK,3) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
394	ZFSDN_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
395	ENDDO
396	ENDDO
397
398	! clear sky (Yves 01/12/2007)
399	! CAS BC (4)
400	flag_aer=1.0
401	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
402	PRMU0,PFRAC,PTAVE,PWV,&
403	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
404	INU = 1
405	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
406	tauaero(:,:,4,:), pizaero(:,:,4,:), cgaero(:,:,4,:),&
407	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
408	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
409	ZFD, ZFU)
410	INU = 2
411	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
412	tauaero(:,:,4,:), pizaero(:,:,4,:), cgaero(:,:,4,:),&
413	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
414	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
415	PWV, PQS,&
416	ZFDOWN, ZFUP)
417
418	DO JK = 1 , KFLEV+1
419	DO JL = 1, KDLON
420	ZFSUP0_AERO(JL,JK,4) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
421	ZFSDN0_AERO(JL,JK,4) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
422	ENDDO
423	ENDDO
424
425	! cloudy-sky + aerosol dir OB
426	! CAS BC (4)
427	flag_aer=1.0
428	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
429	PRMU0,PFRAC,PTAVE,PWV,&
430	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
431	INU = 1
432	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
433	tauaero(:,:,4,:), pizaero(:,:,4,:), cgaero(:,:,4,:),&
434	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
435	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
436	ZFD, ZFU)
437	INU = 2
438	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
439	tauaero(:,:,4,:), pizaero(:,:,4,:), cgaero(:,:,4,:),&
440	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
441	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
442	PWV, PQS,&
443	ZFDOWN, ZFUP)
444
445	DO JK = 1 , KFLEV+1
446	DO JL = 1, KDLON
447	ZFSUP_AERO(JL,JK,4) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
448	ZFSDN_AERO(JL,JK,4) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
449	ENDDO
450	ENDDO
451
452	! clear sky (Yves 13/12/2007)
453	! CAS SO4 (5)
454	flag_aer=1.0
455	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
456	PRMU0,PFRAC,PTAVE,PWV,&
457	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
458	INU = 1
459	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
460	tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),&
461	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
462	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
463	ZFD, ZFU)
464	INU = 2
465	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
466	tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),&
467	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
468	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
469	PWV, PQS,&
470	ZFDOWN, ZFUP)
471
472	DO JK = 1 , KFLEV+1
473	DO JL = 1, KDLON
474	ZFSUP0_AERO(JL,JK,5) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
475	ZFSDN0_AERO(JL,JK,5) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
476	ENDDO
477	ENDDO
478
479	! cloudy-sky + aerosol dir OB
480	! CAS SO4 (5)
481	flag_aer=1.0
482	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
483	PRMU0,PFRAC,PTAVE,PWV,&
484	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
485	INU = 1
486	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
487	tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),&
488	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
489	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
490	ZFD, ZFU)
491	INU = 2
492	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
493	tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),&
494	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
495	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
496	PWV, PQS,&
497	ZFDOWN, ZFUP)
498
499	DO JK = 1 , KFLEV+1
500	DO JL = 1, KDLON
501	ZFSUP_AERO(JL,JK,5) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
502	ZFSDN_AERO(JL,JK,5) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
503	ENDDO
504	ENDDO
505
506	! clear sky (Yves 13/12/2007)
507	! CAS POM (6)
508	flag_aer=1.0
509	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
510	PRMU0,PFRAC,PTAVE,PWV,&
511	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
512	INU = 1
513	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
514	tauaero(:,:,6,:), pizaero(:,:,6,:), cgaero(:,:,6,:),&
515	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
516	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
517	ZFD, ZFU)
518	INU = 2
519	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
520	tauaero(:,:,6,:), pizaero(:,:,6,:), cgaero(:,:,6,:),&
521	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
522	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
523	PWV, PQS,&
524	ZFDOWN, ZFUP)
525
526	DO JK = 1 , KFLEV+1
527	DO JL = 1, KDLON
528	ZFSUP0_AERO(JL,JK,6) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
529	ZFSDN0_AERO(JL,JK,6) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
530	ENDDO
531	ENDDO
532
533	! cloudy-sky + aerosol dir OB
534	! CAS POM (6)
535	flag_aer=1.0
536	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
537	PRMU0,PFRAC,PTAVE,PWV,&
538	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
539	INU = 1
540	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
541	tauaero(:,:,6,:), pizaero(:,:,6,:), cgaero(:,:,6,:),&
542	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
543	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
544	ZFD, ZFU)
545	INU = 2
546	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
547	tauaero(:,:,6,:), pizaero(:,:,6,:), cgaero(:,:,6,:),&
548	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
549	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
550	PWV, PQS,&
551	ZFDOWN, ZFUP)
552
553	DO JK = 1 , KFLEV+1
554	DO JL = 1, KDLON
555	ZFSUP_AERO(JL,JK,6) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
556	ZFSDN_AERO(JL,JK,6) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
557	ENDDO
558	ENDDO
559
560	! clear sky (Yves 13/12/2007)
561	! CAS DUST (7)
562	flag_aer=1.0
563	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
564	PRMU0,PFRAC,PTAVE,PWV,&
565	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
566	INU = 1
567	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
568	tauaero(:,:,7,:), pizaero(:,:,7,:), cgaero(:,:,7,:),&
569	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
570	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
571	ZFD, ZFU)
572	INU = 2
573	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
574	tauaero(:,:,7,:), pizaero(:,:,7,:), cgaero(:,:,7,:),&
575	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
576	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
577	PWV, PQS,&
578	ZFDOWN, ZFUP)
579
580	DO JK = 1 , KFLEV+1
581	DO JL = 1, KDLON
582	ZFSUP0_AERO(JL,JK,7) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
583	ZFSDN0_AERO(JL,JK,7) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
584	ENDDO
585	ENDDO
586
587	! cloudy-sky + aerosol dir OB
588	! CAS DUST (7)
589	flag_aer=1.0
590	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
591	PRMU0,PFRAC,PTAVE,PWV,&
592	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
593	INU = 1
594	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
595	tauaero(:,:,7,:), pizaero(:,:,7,:), cgaero(:,:,7,:),&
596	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
597	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
598	ZFD, ZFU)
599	INU = 2
600	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
601	tauaero(:,:,7,:), pizaero(:,:,7,:), cgaero(:,:,7,:),&
602	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
603	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
604	PWV, PQS,&
605	ZFDOWN, ZFUP)
606
607	DO JK = 1 , KFLEV+1
608	DO JL = 1, KDLON
609	ZFSUP_AERO(JL,JK,7) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
610	ZFSDN_AERO(JL,JK,7) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
611	ENDDO
612	ENDDO
613
614	! clear sky (Yves 13/12/2007)
615	! CAS Seasalt SS (8)
616	flag_aer=1.0
617	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
618	PRMU0,PFRAC,PTAVE,PWV,&
619	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
620	INU = 1
621	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
622	tauaero(:,:,8,:), pizaero(:,:,8,:), cgaero(:,:,8,:),&
623	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
624	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
625	ZFD, ZFU)
626	INU = 2
627	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
628	tauaero(:,:,8,:), pizaero(:,:,8,:), cgaero(:,:,8,:),&
629	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
630	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
631	PWV, PQS,&
632	ZFDOWN, ZFUP)
633
634	DO JK = 1 , KFLEV+1
635	DO JL = 1, KDLON
636	ZFSUP0_AERO(JL,JK,8) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
637	ZFSDN0_AERO(JL,JK,8) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
638	ENDDO
639	ENDDO
640
641	! cloudy-sky + aerosol dir OB
642	! CAS Seasalt SS (8)
643	flag_aer=1.0
644	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
645	PRMU0,PFRAC,PTAVE,PWV,&
646	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
647	INU = 1
648	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
649	tauaero(:,:,8,:), pizaero(:,:,8,:), cgaero(:,:,8,:),&
650	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
651	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
652	ZFD, ZFU)
653	INU = 2
654	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
655	tauaero(:,:,8,:), pizaero(:,:,8,:), cgaero(:,:,8,:),&
656	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
657	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
658	PWV, PQS,&
659	ZFDOWN, ZFUP)
660
661	DO JK = 1 , KFLEV+1
662	DO JL = 1, KDLON
663	ZFSUP_AERO(JL,JK,8) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
664	ZFSDN_AERO(JL,JK,8) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
665	ENDDO
666	ENDDO
667
668	ENDIF ! ok_ade
669
670
671	IF (ok_aie) THEN
672	!jq cloudy-sky + aerosol direct + aerosol indirect
673	flag_aer=1.0
674	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
675	PRMU0,PFRAC,PTAVE,PWV,&
676	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
677	INU = 1
678	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
679	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
680	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
681	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
682	ZFD, ZFU)
683	INU = 2
684	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
685	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
686	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
687	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
688	PWV, PQS,&
689	ZFDOWN, ZFUP)
690	DO JK = 1 , KFLEV+1
691	DO JL = 1, KDLON
692	ZFSUPAI_AERO(JL,JK) = ZFSUP(JL,JK)
693	ZFSDNAI_AERO(JL,JK) = ZFSDN(JL,JK)
694	ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
695	ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
696	ZFSUP_AERO(JL,JK,2) = ZFSUP(JL,JK)
697	ZFSDN_AERO(JL,JK,2) = ZFSDN(JL,JK)
698	ENDDO
699	ENDDO
700	ENDIF ! ok_aie
701
702	itapsw = 0
703	ENDIF
704	itapsw = itapsw + 1
705
706	DO k = 1, KFLEV
707	kpl1 = k+1
708	DO i = 1, KDLON
709
710	PHEAT(i,k) = -(ZFSUP_AERO(i,kpl1,2)-ZFSUP_AERO(i,k,2)) &
711	-(ZFSDN_AERO(i,k,2)-ZFSDN_AERO(i,kpl1,2))
712	PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
713	PHEAT0(i,k) = -(ZFSUP0_AERO(i,kpl1,2)-ZFSUP0_AERO(i,k,2)) &
714	-(ZFSDN0_AERO(i,k,2)-ZFSDN0_AERO(i,kpl1,2))
715	PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k)
716
717	ENDDO
718	ENDDO
719	DO i = 1, KDLON
720	PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20)
721	! clear sky
722	PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)
723	PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)
724
725	PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)
726	PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)
727
728	PSOLSW0AERO(i,:) = ZFSDN0_AERO(i,1,:) - ZFSUP0_AERO(i,1,:)
729	PTOPSW0AERO(i,:) = &
730	ZFSDN0_AERO(i,KFLEV+1,:) - ZFSUP0_AERO(i,KFLEV+1,:)
731
732	PSOLSWAERO(i,:) = ZFSDN_AERO(i,1,:) - ZFSUP_AERO(i,1,:)
733	PTOPSWAERO(i,:) = &
734	ZFSDN_AERO(i,KFLEV+1,:) - ZFSUP_AERO(i,KFLEV+1,:)
735
736	PSOLSWADAERO(i) = ZFSDNAD_AERO(i,1) - ZFSUPAD_AERO(i,1)
737	PTOPSWADAERO(i) = &
738	ZFSDNAD_AERO(i,KFLEV+1) - ZFSUPAD_AERO(i,KFLEV+1)
739
740	PSOLSWAD0AERO(i) = ZFSDNAD0_AERO(i,1) - ZFSUPAD0_AERO(i,1)
741	PTOPSWAD0AERO(i) = &
742	ZFSDNAD0_AERO(i,KFLEV+1) - ZFSUPAD0_AERO(i,KFLEV+1)
743
744	PSOLSWAIAERO(i) = ZFSDNAI_AERO(i,1) - ZFSUPAI_AERO(i,1)
745	PTOPSWAIAERO(i) = &
746	ZFSDNAI_AERO(i,KFLEV+1) - ZFSUPAI_AERO(i,KFLEV+1)
747
748	ENDDO
749	END SUBROUTINE SW_AEROAR4
750

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

Download in other formats:

Original Format