Context Navigation

sw_aeroAR4.F90 @ 1229

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

-- Replaced "integer*4" declarations by "integer", "real*8" by

"real(kind=8)" and "real*4" by "real". Note that these are the only
modifications in the files "radiation_AR4.F" and "sw_aeroAR4.F90".

-- Corrected the kind of arguments to "max" and "min".

-- Replaced "nH" edit descriptors, which is a deleted feature in

Fortran 95, by character strings.

-- "regr_lat_time_climoz" now allows the pressure coordinate in the

input file to be in descending order.

-- Replaced call to not standard function "float" by call to intrinsic

function "real".

-- Included file "radepsi.h" in "physiq" was not used. Removed it.

The following set of modifications is related to the management of time.

-- In "gcm", "leapfrog" and "sortvarc0", "day_ini" was defined as 1

plus number of days between the reference date "(annee_ref,
day_ref)" and the first day of the current simulation. Changed
definition: "(annee_ref, day_ini)" is the first day of the current
simulation. There is an accompanying modification for "day_end".

-- Corrected bug in call to "ioconf_startdate" in "gcm".

-- Added call to "ioconf_calendar" in "create_etat0_limit".

File size: 26.9 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	* (101325. / PPSOL(JL))
211	ENDDO
212	ENDDO
213
214
215	! clear-sky:
216	flag_aer=0.0
217	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
218	PRMU0,PFRAC,PTAVE,PWV,&
219	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
220	INU = 1
221	CALL SW1S_LMDAR4(INU,PAER, flag_aer, &
222	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
223	PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
224	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
225	ZFD, ZFU)
226	INU = 2
227	CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
228	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
229	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
230	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
231	PWV, PQS,&
232	ZFDOWN, ZFUP)
233	DO JK = 1 , KFLEV+1
234	DO JL = 1, KDLON
235	ZFSUP0(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
236	ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
237	ZFSUP0_AERO(JL,JK,1) = ZFSUP0(JL,JK)
238	ZFSDN0_AERO(JL,JK,1) = ZFSDN0(JL,JK)
239	ENDDO
240	ENDDO
241
242
243	! cloudy-sky:
244	flag_aer=0.0
245	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
246	PRMU0,PFRAC,PTAVE,PWV,&
247	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
248	INU = 1
249	CALL SW1S_LMDAR4(INU, PAER, flag_aer, &
250	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
251	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
252	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
253	ZFD, ZFU)
254	INU = 2
255	CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
256	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
257	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
258	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
259	PWV, PQS,&
260	ZFDOWN, ZFUP)
261
262	DO JK = 1 , KFLEV+1
263	DO JL = 1, KDLON
264	ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
265	ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
266	ZFSUP_AERO(JL,JK,1) = ZFSUP(JL,JK)
267	ZFSDN_AERO(JL,JK,1) = ZFSDN(JL,JK)
268	ENDDO
269	ENDDO
270
271	ZFSUP0_AERO(:,:,2) = ZFSUP0_AERO(:,:,1)
272	ZFSDN0_AERO(:,:,2) = ZFSDN0_AERO(:,:,1)
273	ZFSUP_AERO(:,:,2) = ZFSUP_AERO(:,:,1)
274	ZFSDN_AERO(:,:,2) = ZFSDN_AERO(:,:,1)
275
276
277	IF (ok_ade) THEN
278
279	! clear sky (Anne Cozic 03/07/2007)
280	! CAS AER (2)
281	flag_aer=1.0
282	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
283	PRMU0,PFRAC,PTAVE,PWV,&
284	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
285	INU = 1
286	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
287	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
288	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
289	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
290	ZFD, ZFU)
291	INU = 2
292	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
293	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
294	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
295	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
296	PWV, PQS,&
297	ZFDOWN, ZFUP)
298
299	DO JK = 1 , KFLEV+1
300	DO JL = 1, KDLON
301	ZFSUPAD0_AERO(JL,JK) = ZFSUP0(JL,JK)
302	ZFSDNAD0_AERO(JL,JK) = ZFSDN0(JL,JK)
303	ZFSUP0(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
304	ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
305	ZFSUP0_AERO(JL,JK,2) = ZFSUP0(JL,JK)
306	ZFSDN0_AERO(JL,JK,2) = ZFSDN0(JL,JK)
307	ENDDO
308	ENDDO
309
310	! cloudy-sky + aerosol dir OB
311	! ACo AER
312	flag_aer=1.0
313	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
314	PRMU0,PFRAC,PTAVE,PWV,&
315	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
316	INU = 1
317	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
318	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
319	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
320	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
321	ZFD, ZFU)
322	INU = 2
323	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
324	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
325	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
326	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
327	PWV, PQS,&
328	ZFDOWN, ZFUP)
329
330	DO JK = 1 , KFLEV+1
331	DO JL = 1, KDLON
332	ZFSUPAD_AERO(JL,JK) = ZFSUP(JL,JK)
333	ZFSDNAD_AERO(JL,JK) = ZFSDN(JL,JK)
334	ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
335	ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
336	ZFSUP_AERO(JL,JK,2) = ZFSUP(JL,JK)
337	ZFSDN_AERO(JL,JK,2) = ZFSDN(JL,JK)
338	ENDDO
339	ENDDO
340
341	!CAS NAT
342	! clear sky
343	flag_aer=1.0
344	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
345	PRMU0,PFRAC,PTAVE,PWV,&
346	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
347	INU = 1
348	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
349	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
350	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
351	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
352	ZFD, ZFU)
353	INU = 2
354	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
355	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
356	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
357	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
358	PWV, PQS,&
359	ZFDOWN, ZFUP)
360
361	DO JK = 1 , KFLEV+1
362	DO JL = 1, KDLON
363	ZFSUP0_AERO(JL,JK,3) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
364	ZFSDN0_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
365	ENDDO
366	ENDDO
367
368	! cloudy-sky
369	! ACo NAT
370	flag_aer=1.0
371	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
372	PRMU0,PFRAC,PTAVE,PWV,&
373	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
374	INU = 1
375	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
376	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
377	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
378	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
379	ZFD, ZFU)
380	INU = 2
381	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
382	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
383	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
384	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
385	PWV, PQS,&
386	ZFDOWN, ZFUP)
387
388	DO JK = 1 , KFLEV+1
389	DO JL = 1, KDLON
390	ZFSUP_AERO(JL,JK,3) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
391	ZFSDN_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
392	ENDDO
393	ENDDO
394
395	! clear sky (Yves 01/12/2007)
396	! CAS BC (4)
397	flag_aer=1.0
398	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
399	PRMU0,PFRAC,PTAVE,PWV,&
400	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
401	INU = 1
402	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
403	tauaero(:,:,4,:), pizaero(:,:,4,:), cgaero(:,:,4,:),&
404	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
405	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
406	ZFD, ZFU)
407	INU = 2
408	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
409	tauaero(:,:,4,:), pizaero(:,:,4,:), cgaero(:,:,4,:),&
410	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
411	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
412	PWV, PQS,&
413	ZFDOWN, ZFUP)
414
415	DO JK = 1 , KFLEV+1
416	DO JL = 1, KDLON
417	ZFSUP0_AERO(JL,JK,4) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
418	ZFSDN0_AERO(JL,JK,4) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
419	ENDDO
420	ENDDO
421
422	! cloudy-sky + aerosol dir OB
423	! CAS BC (4)
424	flag_aer=1.0
425	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
426	PRMU0,PFRAC,PTAVE,PWV,&
427	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
428	INU = 1
429	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
430	tauaero(:,:,4,:), pizaero(:,:,4,:), cgaero(:,:,4,:),&
431	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
432	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
433	ZFD, ZFU)
434	INU = 2
435	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
436	tauaero(:,:,4,:), pizaero(:,:,4,:), cgaero(:,:,4,:),&
437	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
438	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
439	PWV, PQS,&
440	ZFDOWN, ZFUP)
441
442	DO JK = 1 , KFLEV+1
443	DO JL = 1, KDLON
444	ZFSUP_AERO(JL,JK,4) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
445	ZFSDN_AERO(JL,JK,4) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
446	ENDDO
447	ENDDO
448
449	! clear sky (Yves 13/12/2007)
450	! CAS SO4 (5)
451	flag_aer=1.0
452	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
453	PRMU0,PFRAC,PTAVE,PWV,&
454	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
455	INU = 1
456	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
457	tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),&
458	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
459	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
460	ZFD, ZFU)
461	INU = 2
462	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
463	tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),&
464	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
465	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
466	PWV, PQS,&
467	ZFDOWN, ZFUP)
468
469	DO JK = 1 , KFLEV+1
470	DO JL = 1, KDLON
471	ZFSUP0_AERO(JL,JK,5) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
472	ZFSDN0_AERO(JL,JK,5) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
473	ENDDO
474	ENDDO
475
476	! cloudy-sky + aerosol dir OB
477	! CAS SO4 (5)
478	flag_aer=1.0
479	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
480	PRMU0,PFRAC,PTAVE,PWV,&
481	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
482	INU = 1
483	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
484	tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),&
485	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
486	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
487	ZFD, ZFU)
488	INU = 2
489	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
490	tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),&
491	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
492	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
493	PWV, PQS,&
494	ZFDOWN, ZFUP)
495
496	DO JK = 1 , KFLEV+1
497	DO JL = 1, KDLON
498	ZFSUP_AERO(JL,JK,5) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
499	ZFSDN_AERO(JL,JK,5) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
500	ENDDO
501	ENDDO
502
503	! clear sky (Yves 13/12/2007)
504	! CAS POM (6)
505	flag_aer=1.0
506	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
507	PRMU0,PFRAC,PTAVE,PWV,&
508	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
509	INU = 1
510	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
511	tauaero(:,:,6,:), pizaero(:,:,6,:), cgaero(:,:,6,:),&
512	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
513	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
514	ZFD, ZFU)
515	INU = 2
516	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
517	tauaero(:,:,6,:), pizaero(:,:,6,:), cgaero(:,:,6,:),&
518	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
519	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
520	PWV, PQS,&
521	ZFDOWN, ZFUP)
522
523	DO JK = 1 , KFLEV+1
524	DO JL = 1, KDLON
525	ZFSUP0_AERO(JL,JK,6) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
526	ZFSDN0_AERO(JL,JK,6) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
527	ENDDO
528	ENDDO
529
530	! cloudy-sky + aerosol dir OB
531	! CAS POM (6)
532	flag_aer=1.0
533	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
534	PRMU0,PFRAC,PTAVE,PWV,&
535	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
536	INU = 1
537	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
538	tauaero(:,:,6,:), pizaero(:,:,6,:), cgaero(:,:,6,:),&
539	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
540	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
541	ZFD, ZFU)
542	INU = 2
543	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
544	tauaero(:,:,6,:), pizaero(:,:,6,:), cgaero(:,:,6,:),&
545	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
546	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
547	PWV, PQS,&
548	ZFDOWN, ZFUP)
549
550	DO JK = 1 , KFLEV+1
551	DO JL = 1, KDLON
552	ZFSUP_AERO(JL,JK,6) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
553	ZFSDN_AERO(JL,JK,6) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
554	ENDDO
555	ENDDO
556
557	! clear sky (Yves 13/12/2007)
558	! CAS DUST (7)
559	flag_aer=1.0
560	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
561	PRMU0,PFRAC,PTAVE,PWV,&
562	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
563	INU = 1
564	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
565	tauaero(:,:,7,:), pizaero(:,:,7,:), cgaero(:,:,7,:),&
566	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
567	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
568	ZFD, ZFU)
569	INU = 2
570	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
571	tauaero(:,:,7,:), pizaero(:,:,7,:), cgaero(:,:,7,:),&
572	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
573	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
574	PWV, PQS,&
575	ZFDOWN, ZFUP)
576
577	DO JK = 1 , KFLEV+1
578	DO JL = 1, KDLON
579	ZFSUP0_AERO(JL,JK,7) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
580	ZFSDN0_AERO(JL,JK,7) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
581	ENDDO
582	ENDDO
583
584	! cloudy-sky + aerosol dir OB
585	! CAS DUST (7)
586	flag_aer=1.0
587	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
588	PRMU0,PFRAC,PTAVE,PWV,&
589	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
590	INU = 1
591	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
592	tauaero(:,:,7,:), pizaero(:,:,7,:), cgaero(:,:,7,:),&
593	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
594	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
595	ZFD, ZFU)
596	INU = 2
597	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
598	tauaero(:,:,7,:), pizaero(:,:,7,:), cgaero(:,:,7,:),&
599	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
600	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
601	PWV, PQS,&
602	ZFDOWN, ZFUP)
603
604	DO JK = 1 , KFLEV+1
605	DO JL = 1, KDLON
606	ZFSUP_AERO(JL,JK,7) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
607	ZFSDN_AERO(JL,JK,7) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
608	ENDDO
609	ENDDO
610
611	! clear sky (Yves 13/12/2007)
612	! CAS Seasalt SS (8)
613	flag_aer=1.0
614	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
615	PRMU0,PFRAC,PTAVE,PWV,&
616	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
617	INU = 1
618	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
619	tauaero(:,:,8,:), pizaero(:,:,8,:), cgaero(:,:,8,:),&
620	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
621	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
622	ZFD, ZFU)
623	INU = 2
624	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
625	tauaero(:,:,8,:), pizaero(:,:,8,:), cgaero(:,:,8,:),&
626	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
627	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
628	PWV, PQS,&
629	ZFDOWN, ZFUP)
630
631	DO JK = 1 , KFLEV+1
632	DO JL = 1, KDLON
633	ZFSUP0_AERO(JL,JK,8) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
634	ZFSDN0_AERO(JL,JK,8) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
635	ENDDO
636	ENDDO
637
638	! cloudy-sky + aerosol dir OB
639	! CAS Seasalt SS (8)
640	flag_aer=1.0
641	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
642	PRMU0,PFRAC,PTAVE,PWV,&
643	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
644	INU = 1
645	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
646	tauaero(:,:,8,:), pizaero(:,:,8,:), cgaero(:,:,8,:),&
647	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
648	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
649	ZFD, ZFU)
650	INU = 2
651	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
652	tauaero(:,:,8,:), pizaero(:,:,8,:), cgaero(:,:,8,:),&
653	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
654	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
655	PWV, PQS,&
656	ZFDOWN, ZFUP)
657
658	DO JK = 1 , KFLEV+1
659	DO JL = 1, KDLON
660	ZFSUP_AERO(JL,JK,8) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
661	ZFSDN_AERO(JL,JK,8) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
662	ENDDO
663	ENDDO
664
665	ENDIF ! ok_ade
666
667
668	IF (ok_aie) THEN
669	!jq cloudy-sky + aerosol direct + aerosol indirect
670	flag_aer=1.0
671	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
672	PRMU0,PFRAC,PTAVE,PWV,&
673	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
674	INU = 1
675	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
676	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
677	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
678	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
679	ZFD, ZFU)
680	INU = 2
681	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
682	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
683	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
684	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
685	PWV, PQS,&
686	ZFDOWN, ZFUP)
687	DO JK = 1 , KFLEV+1
688	DO JL = 1, KDLON
689	ZFSUPAI_AERO(JL,JK) = ZFSUP(JL,JK)
690	ZFSDNAI_AERO(JL,JK) = ZFSDN(JL,JK)
691	ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
692	ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
693	ZFSUP_AERO(JL,JK,2) = ZFSUP(JL,JK)
694	ZFSDN_AERO(JL,JK,2) = ZFSDN(JL,JK)
695	ENDDO
696	ENDDO
697	ENDIF ! ok_aie
698
699	itapsw = 0
700	ENDIF
701	itapsw = itapsw + 1
702
703	DO k = 1, KFLEV
704	kpl1 = k+1
705	DO i = 1, KDLON
706
707	PHEAT(i,k) = -(ZFSUP_AERO(i,kpl1,2)-ZFSUP_AERO(i,k,2)) &
708	-(ZFSDN_AERO(i,k,2)-ZFSDN_AERO(i,kpl1,2))
709	PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
710	PHEAT0(i,k) = -(ZFSUP0_AERO(i,kpl1,2)-ZFSUP0_AERO(i,k,2)) &
711	-(ZFSDN0_AERO(i,k,2)-ZFSDN0_AERO(i,kpl1,2))
712	PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k)
713
714	ENDDO
715	ENDDO
716	DO i = 1, KDLON
717	PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20)
718	! clear sky
719	PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)
720	PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)
721
722	PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)
723	PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)
724
725	PSOLSW0AERO(i,:) = ZFSDN0_AERO(i,1,:) - ZFSUP0_AERO(i,1,:)
726	PTOPSW0AERO(i,:) = &
727	ZFSDN0_AERO(i,KFLEV+1,:) - ZFSUP0_AERO(i,KFLEV+1,:)
728
729	PSOLSWAERO(i,:) = ZFSDN_AERO(i,1,:) - ZFSUP_AERO(i,1,:)
730	PTOPSWAERO(i,:) = &
731	ZFSDN_AERO(i,KFLEV+1,:) - ZFSUP_AERO(i,KFLEV+1,:)
732
733	PSOLSWADAERO(i) = ZFSDNAD_AERO(i,1) - ZFSUPAD_AERO(i,1)
734	PTOPSWADAERO(i) = &
735	ZFSDNAD_AERO(i,KFLEV+1) - ZFSUPAD_AERO(i,KFLEV+1)
736
737	PSOLSWAD0AERO(i) = ZFSDNAD0_AERO(i,1) - ZFSUPAD0_AERO(i,1)
738	PTOPSWAD0AERO(i) = &
739	ZFSDNAD0_AERO(i,KFLEV+1) - ZFSUPAD0_AERO(i,KFLEV+1)
740
741	PSOLSWAIAERO(i) = ZFSDNAI_AERO(i,1) - ZFSUPAI_AERO(i,1)
742	PTOPSWAIAERO(i) = &
743	ZFSDNAI_AERO(i,KFLEV+1) - ZFSUPAI_AERO(i,KFLEV+1)
744
745	ENDDO
746	END SUBROUTINE SW_AEROAR4
747

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

Download in other formats:

Original Format