Context Navigation

radlwsw_aero.F90 @ 2007

Last change on this file since 2007 was 2005, checked in by Laurent Fairhead, 10 years ago

Oublié de mettre les propriétés

Forgot to set properties

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory
Property svn:keywords set to Author Date Id Revi

File size: 32.9 KB

Line
1	!
2	! $Id: radlwsw_aero.F90 2005 2014-04-04 12:59:37Z fhourdin $
3	!
4	SUBROUTINE radlwsw_aero( &
5	dist, rmu0, fract, &
6	paprs, pplay,tsol,alb1, alb2,&
7	t,q,wo,&
8	cldfra, cldemi, cldtaupd,&
9	ok_ade, ok_aie,&
10	tau_aero, piz_aero, cg_aero,&
11	cldtaupi, new_aod, &
12	heat,heat0,cool,cool0,radsol,albpla,&
13	topsw,toplw,solsw,sollw,&
14	sollwdown,&
15	topsw0,toplw0,solsw0,sollw0,&
16	lwdn0, lwdn, lwup0, lwup,&
17	swdn0, swdn, swup0, swup,&
18	topswad_aero, solswad_aero,&
19	topswai_aero, solswai_aero, &
20	topswad0_aero, solswad0_aero,&
21	topsw_aero, topsw0_aero,&
22	solsw_aero, solsw0_aero,qsat,flwc,fiwc)
23
24
25
26	USE DIMPHY
27	USE comgeomphy
28	USE write_field_phy
29	! modules necessaires au rayonnement
30	! -----------------------------------------
31	! USE YOMCST , ONLY : RG ,RD ,RTT ,RPI
32	! USE YOERAD , ONLY : NSW ,LRRTM ,LINHOM , LCCNL,LCCNO,
33	! USE YOERAD , ONLY : NSW ,LRRTM ,LCCNL ,LCCNO ,&
34	! NSW mis dans .def MPL 20140211
35	USE YOERAD , ONLY : LRRTM ,LCCNL ,LCCNO ,&
36	NRADIP , NRADLP , NICEOPT, NLIQOPT ,RCCNLND , RCCNSEA
37	USE YOELW , ONLY : NSIL ,NTRA ,NUA ,TSTAND ,XP
38	USE YOESW , ONLY : RYFWCA ,RYFWCB ,RYFWCC ,RYFWCD,&
39	RYFWCE ,RYFWCF ,REBCUA ,REBCUB ,REBCUC,&
40	REBCUD ,REBCUE ,REBCUF ,REBCUI ,REBCUJ,&
41	REBCUG ,REBCUH ,RHSAVI ,RFULIO ,RFLAA0,&
42	RFLAA1 ,RFLBB0 ,RFLBB1 ,RFLBB2 ,RFLBB3,&
43	RFLCC0 ,RFLCC1 ,RFLCC2 ,RFLCC3 ,RFLDD0,&
44	RFLDD1 ,RFLDD2 ,RFLDD3 ,RFUETA ,RASWCA,&
45	RASWCB ,RASWCC ,RASWCD ,RASWCE ,RASWCF
46	!& RASWCB ,RASWCC ,RASWCD ,RASWCE ,RASWCF, RLINLI
47	USE YOERDU , ONLY : NUAER ,NTRAER ,REPLOG ,REPSC ,REPSCW ,DIFF
48	USE YOETHF , ONLY : RTICE
49	USE YOERRTWN , ONLY : DELWAVE ,TOTPLNK
50	USE YOMPHY3 , ONLY : RII0
51
52	IMPLICIT NONE
53
54	!======================================================================
55	! Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
56	! Objet: interface entre le modele et les rayonnements
57	! Arguments:
58	! dist-----input-R- distance astronomique terre-soleil
59	! rmu0-----input-R- cosinus de l'angle zenithal
60	! fract----input-R- duree d'ensoleillement normalisee
61	! co2_ppm--input-R- concentration du gaz carbonique (en ppm)
62	! solaire--input-R- constante solaire (W/m**2)
63	! paprs----input-R- pression a inter-couche (Pa)
64	! pplay----input-R- pression au milieu de couche (Pa)
65	! tsol-----input-R- temperature du sol (en K)
66	! alb1-----input-R- albedo du sol(entre 0 et 1) dans l'interval visible
67	! alb2-----input-R- albedo du sol(entre 0 et 1) dans l'interval proche infra-rouge
68	! t--------input-R- temperature (K)
69	! q--------input-R- vapeur d'eau (en kg/kg)
70	! wo-------input-R- contenu en ozone (en kg/kg) correction MPL 100505
71	! cldfra---input-R- fraction nuageuse (entre 0 et 1)
72	! cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value)
73	! cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1)
74	! ok_ade---input-L- apply the Aerosol Direct Effect or not?
75	! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
76	! tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F)
77	! cldtaupi-input-R- epaisseur optique des nuages dans le visible
78	! calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller
79	! droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd
80	! it is needed for the diagnostics of the aerosol indirect radiative forcing
81	!
82	! heat-----output-R- echauffement atmospherique (visible) (K/jour)
83	! cool-----output-R- refroidissement dans l'IR (K/jour)
84	! radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
85	! albpla---output-R- albedo planetaire (entre 0 et 1)
86	! topsw----output-R- flux solaire net au sommet de l'atm.
87	! toplw----output-R- ray. IR montant au sommet de l'atmosphere
88	! solsw----output-R- flux solaire net a la surface
89	! sollw----output-R- ray. IR montant a la surface
90	! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)
91	! topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir)
92	! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind)
93	! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind)
94	!
95	! ATTENTION: swai and swad have to be interpreted in the following manner:
96	! ---------
97	! ok_ade=F & ok_aie=F -both are zero
98	! ok_ade=T & ok_aie=F -aerosol direct forcing is F_{AD} = topsw-topswad
99	! indirect is zero
100	! ok_ade=F & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai
101	! direct is zero
102	! ok_ade=T & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai
103	! aerosol direct forcing is F_{AD} = topswai-topswad
104	!
105
106	!======================================================================
107
108	! ====================================================================
109	! Adapte au modele de chimie INCA par Celine Deandreis & Anne Cozic -- 2009
110	! 1 = ZERO
111	! 2 = AER total
112	! 3 = NAT
113	! 4 = BC
114	! 5 = SO4
115	! 6 = POM
116	! 7 = DUST
117	! 8 = SS
118	! 9 = NO3
119	!
120	! ====================================================================
121	include "YOETHF.h"
122	include "YOMCST.h"
123	include "clesphys.h"
124
125	! Input arguments
126	! REAL, INTENT(in) :: solaire
127	REAL, INTENT(in) :: dist
128	REAL, INTENT(in) :: rmu0(KLON), fract(KLON)
129	REAL, INTENT(in) :: paprs(KLON,KLEV+1), pplay(KLON,KLEV)
130	REAL, INTENT(in) :: alb1(KLON), alb2(KLON),tsol(KLON)
131	REAL, INTENT(in) :: t(KLON,KLEV), q(KLON,KLEV), wo(KLON,KLEV)
132	LOGICAL, INTENT(in) :: ok_ade, ok_aie ! switches whether to use aerosol direct (indirect) effects or not
133	REAL, INTENT(in) :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV)
134	REAL, INTENT(in) :: tau_aero(KLON,KLEV,9,2) ! aerosol optical properties (see aeropt.F)
135	REAL, INTENT(in) :: piz_aero(KLON,KLEV,9,2) ! aerosol optical properties (see aeropt.F)
136	REAL, INTENT(in) :: cg_aero(KLON,KLEV,9,2) ! aerosol optical properties (see aeropt.F)
137	REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations
138	!MPL input supplementaires pour RECMWFL
139	! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)
140	REAL*8 GEMU(klon)
141	REAL*8 qsat(klon,klev),flwc(klon,klev),fiwc(klon,klev)
142	!MPL input RECMWFL:
143	!Tableaux aux niveaux inverses pour respecter convention Arpege
144	REAL*8 paprs_i(klon,klev+1)
145	REAL*8 pplay_i(klon,klev)
146	REAL*8 cldfra_i(klon,klev)
147	REAL*8 POZON_i(kdlon,kflev)
148	!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6
149	REAL*8 PAER_i(kdlon,kflev,6)
150	REAL*8 PDP_i(klon,klev)
151	REAL*8 t_i(klon,klev),q_i(klon,klev),qsat_i(klon,klev)
152	REAL*8 flwc_i(klon,klev),fiwc_i(klon,klev)
153	! new_aod: flag pour retrouver les resultats exacts de l'AR4 dans le cas ou l'on ne travaille qu'avec les sulfates
154	LOGICAL, INTENT(in) :: new_aod
155	LOGICAL lldebug
156
157	! Output arguments
158	REAL, INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV)
159	REAL, INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV)
160	REAL, INTENT(out) :: radsol(KLON), topsw(KLON), toplw(KLON)
161	REAL, INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON)
162	REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON)
163	REAL, INTENT(out) :: sollwdown(KLON)
164	REAL, INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1)
165	REAL, INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1)
166	REAL, INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1)
167	REAL, INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1)
168	REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON) ! output: aerosol direct forcing at TOA and surface
169	REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON) ! output: aerosol indirect forcing atTOA and surface
170	REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero
171	REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero
172	REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero
173	REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero
174	REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero
175	REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero
176	! --------- output RECMWFL
177	! ZEMTD (KPROMA,KLEV+1) ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
178	! ZEMTU (KPROMA,KLEV+1) ; TOTAL UPWARD LONGWAVE EMISSIVITY
179	! ZTRSO (KPROMA,KLEV+1) ; TOTAL SHORTWAVE TRANSMISSIVITY
180	! ZTH (KPROMA,KLEV+1) ; HALF LEVEL TEMPERATURE
181	! ZCTRSO(KPROMA,2) ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY
182	! ZCEMTR(KPROMA,2) ; CLEAR-SKY NET LONGWAVE EMISSIVITY
183	! ZTRSOD(KPROMA) ; TOTAL-SKY SURFACE SW TRANSMISSITY
184	! ZLWFC (KPROMA,2) ; CLEAR-SKY LONGWAVE FLUXES
185	! ZLWFT (KPROMA,KLEV+1) ; TOTAL-SKY LONGWAVE FLUXES
186	! ZLWFT0(KPROMA,KLEV+1) ; CLEAR-SKY LONGWAVE FLUXES ! added by MPL 090109
187	! ZSWFC (KPROMA,2) ; CLEAR-SKY SHORTWAVE FLUXES
188	! ZSWFT (KPROMA,KLEV+1) ; TOTAL-SKY SHORTWAVE FLUXES
189	! ZSWFT0(KPROMA,KLEV+1) ; CLEAR-SKY SHORTWAVE FLUXES ! added by MPL 090109
190	! ZFLUX (KLON,2,KLEV+1) ; TOTAL LW FLUXES 1=up, 2=DWN ! added by MPL 080411
191	! ZFLUC (KLON,2,KLEV+1) ; CLEAR SKY LW FLUXES ! added by MPL 080411
192	! ZFSDWN(klon,KLEV+1) ; TOTAL SW DWN FLUXES ! added by MPL 080411
193	! ZFCDWN(klon,KLEV+1) ; CLEAR SKY SW DWN FLUXES ! added by MPL 080411
194	! ZFSUP (klon,KLEV+1) ; TOTAL SW UP FLUXES ! added by MPL 080411
195	! ZFCUP (klon,KLEV+1) ; CLEAR SKY SW UP FLUXES ! added by MPL 080411
196	!MPL output RECMWFL:
197	REAL*8 ZEMTD (klon,klev+1),ZEMTD_i (klon,klev+1)
198	REAL*8 ZEMTU (klon,klev+1),ZEMTU_i (klon,klev+1)
199	REAL*8 ZTRSO (klon,klev+1),ZTRSO_i (klon,klev+1)
200	REAL*8 ZTH (klon,klev+1),ZTH_i (klon,klev+1)
201	REAL*8 ZCTRSO(klon,2)
202	REAL*8 ZCEMTR(klon,2)
203	REAL*8 ZTRSOD(klon)
204	REAL*8 ZLWFC (klon,2)
205	REAL*8 ZLWFT (klon,klev+1),ZLWFT_i (klon,klev+1)
206	REAL*8 ZSWFC (klon,2)
207	REAL*8 ZSWFT (klon,klev+1),ZSWFT_i (klon,klev+1)
208	REAL*8 ZSWFT0(klon,klev+1),ZLWFT0 (klon,klev+1)
209	REAL*8 PPIZA_DST(klon,klev,NSW)
210	REAL*8 PCGA_DST(klon,klev,NSW)
211	REAL*8 PTAUREL_DST(klon,klev,NSW)
212	REAL*8 PSFSWDIR(klon,NSW)
213	REAL*8 PSFSWDIF(klon,NSW)
214	REAL*8 PFSDNN(klon)
215	REAL*8 PFSDNV(klon)
216	!MPL On ne redefinit pas les tableaux ZFLUX,ZFLUC,
217	!MPL ZFSDWN,ZFCDWN,ZFSUP,ZFCUP car ils existent deja
218	!MPL sous les noms de ZFLDN,ZFLDN0,ZFLUP,ZFLUP0,
219	!MPL ZFSDN,ZFSDN0,ZFSUP,ZFSUP0
220	REAL*8 ZFLUX_i (klon,2,klev+1)
221	REAL*8 ZFLUC_i (klon,2,klev+1)
222	REAL*8 ZFSDWN_i (klon,klev+1)
223	REAL*8 ZFCDWN_i (klon,klev+1)
224	REAL*8 ZFSUP_i (klon,klev+1)
225	REAL*8 ZFCUP_i (klon,klev+1)
226
227	! Local variables
228	REAL*8 ZFSUP(KDLON,KFLEV+1)
229	REAL*8 ZFSDN(KDLON,KFLEV+1)
230	REAL*8 ZFSUP0(KDLON,KFLEV+1)
231	REAL*8 ZFSDN0(KDLON,KFLEV+1)
232	REAL*8 ZFLUP(KDLON,KFLEV+1)
233	REAL*8 ZFLDN(KDLON,KFLEV+1)
234	REAL*8 ZFLUP0(KDLON,KFLEV+1)
235	REAL*8 ZFLDN0(KDLON,KFLEV+1)
236	REAL*8 zx_alpha1, zx_alpha2
237	INTEGER k, kk, i, j, iof, nb_gr
238	INTEGER ist,iend,ktdia,kmode
239	INTEGER , SAVE :: iprint=0
240	REAL*8 PSCT
241	REAL*8 PALBD(kdlon,2), PALBP(kdlon,2)
242	REAL*8 PALBD_NEW(kdlon,NSW), PALBP_NEW(kdlon,NSW)
243	REAL*8 PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon)
244	REAL*8 PPSOL(kdlon), PDP(kdlon,KLEV)
245	REAL*8 PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1)
246	REAL*8 PTAVE(kdlon,kflev)
247	REAL*8 PWV(kdlon,kflev), PQS(kdlon,kflev), POZON(kdlon,kflev)
248	!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6
249	REAL*8 PAER(kdlon,kflev,6)
250	REAL*8 PCLDLD(kdlon,kflev)
251	REAL*8 PCLDLU(kdlon,kflev)
252	REAL*8 PCLDSW(kdlon,kflev)
253	REAL*8 PTAU(kdlon,2,kflev)
254	REAL*8 POMEGA(kdlon,2,kflev)
255	REAL*8 PCG(kdlon,2,kflev)
256	REAL*8 zfract(kdlon), zrmu0(kdlon), zdist
257	REAL*8 zheat(kdlon,kflev), zcool(kdlon,kflev)
258	REAL*8 zheat0(kdlon,kflev), zcool0(kdlon,kflev)
259	REAL*8 ztopsw(kdlon), ztoplw(kdlon)
260	REAL*8 zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon)
261	REAL*8 zsollwdown(kdlon)
262	REAL*8 ztopsw0(kdlon), ztoplw0(kdlon)
263	REAL*8 zsolsw0(kdlon), zsollw0(kdlon)
264	REAL*8 zznormcp
265	REAL*8 tauaero(kdlon,kflev,9,2) ! aer opt properties
266	REAL*8 pizaero(kdlon,kflev,9,2)
267	REAL*8 cgaero(kdlon,kflev,9,2)
268	REAL*8 PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use
269	REAL*8 POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo
270	REAL*8 ztopswadaero(kdlon), zsolswadaero(kdlon) ! Aerosol direct forcing at TOAand surface
271	REAL*8 ztopswad0aero(kdlon), zsolswad0aero(kdlon) ! Aerosol direct forcing at TOAand surface
272	REAL*8 ztopswaiaero(kdlon), zsolswaiaero(kdlon) ! dito, indirect
273	REAL*8 ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9)
274	REAL*8 zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9)
275
276	! initialisation
277	ist=1
278	iend=klon
279	ktdia=1
280	kmode=ist
281	lldebug=.FALSE.
282	! initialisation
283	tauaero(:,:,:,:)=0.
284	pizaero(:,:,:,:)=0.
285	cgaero(:,:,:,:)=0.
286
287	!
288	!-------------------------------------------
289	nb_gr = KLON / kdlon
290	IF (nb_gr*kdlon .NE. KLON) THEN
291	PRINT*, "kdlon mauvais:", KLON, kdlon, nb_gr
292	CALL abort
293	ENDIF
294	IF (kflev .NE. KLEV) THEN
295	PRINT*, "kflev differe de KLEV, kflev, KLEV"
296	CALL abort
297	ENDIF
298	!-------------------------------------------
299	! print *,'Entree de radlwsw, iflag_rrtm tsol=',iflag_rrtm,tsol
300	IF (iprint>10) THEN
301	DO k = 1, KLEV
302	DO i = 1, KLON
303	! print *,'En entree de radlwsw: k tsol temp',k,tsol,t(1,k)
304	heat(i,k)=0.
305	cool(i,k)=0.
306	heat0(i,k)=0.
307	cool0(i,k)=0.
308	ENDDO
309	ENDDO
310	ENDIF
311	!
312	zdist = dist
313	!
314	PSCT = solaire/zdist/zdist
315	DO j = 1, nb_gr
316	iof = kdlon*(j-1)
317	DO i = 1, kdlon
318	zfract(i) = fract(iof+i)
319	zrmu0(i) = rmu0(iof+i)
320	PALBD(i,1) = alb1(iof+i)
321	! PALBD(i,2) = alb1(iof+i)
322	PALBD(i,2) = alb2(iof+i)
323	!
324	PALBD_NEW(i,1) = alb1(iof+i)
325	DO kk=2,NSW
326	PALBD_NEW(i,kk) = alb2(iof+i)
327	ENDDO
328	! PALBD_NEW(i,2) = alb2(iof+i)
329	! PALBD_NEW(i,3) = alb2(iof+i)
330	! PALBD_NEW(i,4) = alb2(iof+i)
331	! PALBD_NEW(i,5) = alb2(iof+i)
332	! PALBD_NEW(i,6) = alb2(iof+i)
333	!
334	PALBP(i,1) = alb1(iof+i)
335	! PALBP(i,2) = alb1(iof+i)
336	PALBP(i,2) = alb2(iof+i)
337	!
338	PALBP_NEW(i,1) = alb1(iof+i)
339	DO kk=2,NSW
340	PALBP_NEW(i,kk) = alb2(iof+i)
341	ENDDO
342	! PALBP_NEW(i,2) = alb2(iof+i)
343	! PALBP_NEW(i,3) = alb2(iof+i)
344	! PALBP_NEW(i,4) = alb2(iof+i)
345	! PALBP_NEW(i,5) = alb2(iof+i)
346	! PALBP_NEW(i,6) = alb2(iof+i)
347	PEMIS(i) = 1.0
348	PVIEW(i) = 1.66
349	PPSOL(i) = paprs(iof+i,1)
350	zx_alpha1 = (paprs(iof+i,1)-pplay(iof+i,2))/(pplay(iof+i,1)-pplay(iof+i,2))
351	zx_alpha2 = 1.0 - zx_alpha1
352	PTL(i,1) = t(iof+i,1) * zx_alpha1 + t(iof+i,2) * zx_alpha2
353	PTL(i,KLEV+1) = t(iof+i,KLEV)
354	PDT0(i) = tsol(iof+i) - PTL(i,1)
355	ENDDO
356	DO k = 2, kflev
357	DO i = 1, kdlon
358	PTL(i,k) = (t(iof+i,k)+t(iof+i,k-1))*0.5
359	ENDDO
360	ENDDO
361	DO k = 1, kflev
362	DO i = 1, kdlon
363	PDP(i,k) = paprs(iof+i,k)-paprs(iof+i,k+1)
364	PTAVE(i,k) = t(iof+i,k)
365	PWV(i,k) = MAX (q(iof+i,k), 1.0e-12)
366	PQS(i,k) = PWV(i,k)
367	! wo: cm.atm (epaisseur en cm dans la situation standard)
368	! POZON: kg/kg
369	POZON(i,k) = MAX(wo(iof+i,k),1.0e-12)*RG/46.6968 &
370	/(paprs(iof+i,k)-paprs(iof+i,k+1))&
371	*(paprs(iof+i,1)/101325.0)
372	PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
373	PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
374	PCLDSW(i,k) = cldfra(iof+i,k)
375	PTAU(i,1,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! 1e-12 serait instable
376	PTAU(i,2,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! pour 32-bit machines
377	POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k))
378	POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k))
379	PCG(i,1,k) = 0.865
380	PCG(i,2,k) = 0.910
381	!-
382	! Introduced for aerosol indirect forcings.
383	! The following values use the cloud optical thickness calculated from
384	! present-day aerosol concentrations whereas the quantities without the
385	! "A" at the end are for pre-industial (natural-only) aerosol concentrations
386	!
387	PTAUA(i,1,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! 1e-12 serait instable
388	PTAUA(i,2,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! pour 32-bit machines
389	POMEGAA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i,1,k))
390	POMEGAA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i,2,k))
391	ENDDO
392	ENDDO
393	!
394	DO k = 1, kflev+1
395	DO i = 1, kdlon
396	PPMB(i,k) = paprs(iof+i,k)/100.0
397	ENDDO
398	ENDDO
399	!
400	!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6
401	DO kk = 1, 6
402	DO k = 1, kflev
403	DO i = 1, kdlon
404	PAER(i,k,kk) = 1.0E-15
405	ENDDO
406	ENDDO
407	ENDDO
408	DO k = 1, kflev
409	DO i = 1, kdlon
410	tauaero(i,k,:,1)=tau_aero(iof+i,k,:,1)
411	pizaero(i,k,:,1)=piz_aero(iof+i,k,:,1)
412	cgaero(i,k,:,1) =cg_aero(iof+i,k,:,1)
413	tauaero(i,k,:,2)=tau_aero(iof+i,k,:,2)
414	pizaero(i,k,:,2)=piz_aero(iof+i,k,:,2)
415	cgaero(i,k,:,2) =cg_aero(iof+i,k,:,2)
416	ENDDO
417	ENDDO
418	!
419	!======================================================================
420	!===== si iflag_rrtm=0 ================================================
421	!IM ctes ds clesphys.h CALL LW(RCO2,RCH4,RN2O,RCFC11,RCFC12,
422	!IM ctes ds clesphys.h CALL SW(PSCT, RCO2, zrmu0, zfract,
423	!
424	IF (iflag_rrtm.eq.0) then
425
426	!----- Mise a zero des tableaux output du rayonnement LW-AR4 ----------
427	DO k = 1, kflev+1
428	DO i = 1, kdlon
429	ZFLUP(i,k)=0.
430	ZFLDN(i,k)=0.
431	ZFLUP0(i,k)=0.
432	ZFLDN0(i,k)=0.
433	ENDDO
434	ENDDO
435	DO k = 1, kflev
436	DO i = 1, kdlon
437	zcool(i,k)=0.
438	zcool0(i,k)=0.
439	ENDDO
440	ENDDO
441	DO i = 1, kdlon
442	ztoplw(i)=0.
443	zsollw(i)=0.
444	ztoplw0(i)=0.
445	zsollw0(i)=0.
446	zsollwdown(i)=0.
447	ENDDO
448	!
449	CALL LW_LMDAR4(&
450	PPMB, PDP,&
451	PPSOL,PDT0,PEMIS,&
452	PTL, PTAVE, PWV, POZON, PAER,&
453	PCLDLD,PCLDLU,&
454	PVIEW,&
455	zcool, zcool0,&
456	ztoplw,zsollw,ztoplw0,zsollw0,&
457	zsollwdown,&
458	ZFLUP, ZFLDN, ZFLUP0,ZFLDN0)
459
460	!----- Mise a zero des tableaux output du rayonnement SW-AR4 ----------
461	DO k = 1, kflev+1
462	DO i = 1, kdlon
463	ZFSUP(i,k)=0.
464	ZFSDN(i,k)=0.
465	ZFSUP0(i,k)=0.
466	ZFSDN0(i,k)=0.
467	ENDDO
468	ENDDO
469	DO k = 1, kflev
470	DO i = 1, kdlon
471	zheat(i,k)=0.
472	zheat0(i,k)=0.
473	ENDDO
474	ENDDO
475	DO i = 1, kdlon
476	zalbpla(i)=0.
477	ztopsw(i)=0.
478	zsolsw(i)=0.
479	ztopsw0(i)=0.
480	zsolsw0(i)=0.
481	ztopswadaero(i)=0.
482	zsolswadaero(i)=0.
483	ztopswaiaero(i)=0.
484	zsolswaiaero(i)=0.
485	ENDDO
486	IF (.NOT. new_aod) THEN
487	! use old version
488	CALL SW_LMDAR4(PSCT, zrmu0, zfract,&
489	PPMB, PDP, &
490	PPSOL, PALBD, PALBP,&
491	PTAVE, PWV, PQS, POZON, PAER,&
492	PCLDSW, PTAU, POMEGA, PCG,&
493	zheat, zheat0,&
494	zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,&
495	ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
496	tau_aero(:,:,5,:), piz_aero(:,:,5,:), cg_aero(:,:,5,:),&
497	PTAUA, POMEGAA,&
498	ztopswadaero,zsolswadaero,&
499	ztopswaiaero,zsolswaiaero,&
500	ok_ade, ok_aie)
501	ELSE
502
503	CALL SW_AERO(PSCT, zrmu0, zfract,&
504	PPMB, PDP,&
505	PPSOL, PALBD, PALBP,&
506	PTAVE, PWV, PQS, POZON, PAER,&
507	PCLDSW, PTAU, POMEGA, PCG,&
508	zheat, zheat0,&
509	zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,&
510	ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
511	tauaero, pizaero, cgaero, &
512	PTAUA, POMEGAA,&
513	ztopswadaero,zsolswadaero,&
514	ztopswad0aero,zsolswad0aero,&
515	ztopswaiaero,zsolswaiaero, &
516	ztopsw_aero,ztopsw0_aero,&
517	zsolsw_aero,zsolsw0_aero,&
518	ok_ade, ok_aie)
519
520	ENDIF
521
522	!===== si iflag_rrtm=1, on passe dans SW via RECMWFL ===============
523	!----- Mise a zero des tableaux output de RECMWF -------------------
524
525	else
526	DO k = 1, kflev+1
527	DO i = 1, kdlon
528	ZEMTD_i(i,k)=0.
529	ZEMTU_i(i,k)=0.
530	ZTRSO_i(i,k)=0.
531	ZTH_i(i,k)=0.
532	ZLWFT_i(i,k)=0.
533	ZSWFT_i(i,k)=0.
534	ZFLUX_i(i,1,k)=0.
535	ZFLUX_i(i,2,k)=0.
536	ZFLUC_i(i,1,k)=0.
537	ZFLUC_i(i,2,k)=0.
538	ZFSDWN_i(i,k)=0.
539	ZFCDWN_i(i,k)=0.
540	ZFSUP_i(i,k)=0.
541	ZFCUP_i(i,k)=0.
542	ENDDO
543	ENDDO
544	!
545	DO k = 1, kflev
546	DO i = 1, kdlon
547	DO kk = 1, NSW
548	PPIZA_DST(i,k,kk)=0.
549	PCGA_DST(i,k,kk)=0.
550	PTAUREL_DST(i,k,kk)=0.
551	ENDDO
552	ENDDO
553	ENDDO
554	!
555	DO i = 1, kdlon
556	ZCTRSO(i,1)=0.
557	ZCTRSO(i,2)=0.
558	ZCEMTR(i,1)=0.
559	ZCEMTR(i,2)=0.
560	ZTRSOD(i)=0.
561	ZLWFC(i,1)=0.
562	ZLWFC(i,2)=0.
563	ZSWFC(i,1)=0.
564	ZSWFC(i,2)=0.
565	PFSDNN(i)=0.
566	PFSDNV(i)=0.
567	DO kk = 1, NSW
568	PSFSWDIR(i,kk)=0.
569	PSFSWDIF(i,kk)=0.
570	ENDDO
571	ENDDO
572	!----- Fin des mises a zero des tableaux output de RECMWF -------------------
573	GEMU(1:klon)=sin(rlatd(1:klon))
574	! On met les donnees dans l'ordre des niveaux arpege
575	paprs_i(:,1)=paprs(:,klev+1)
576	DO k=1,klev
577	paprs_i(1:klon,k+1) =paprs(1:klon,klev+1-k)
578	pplay_i(1:klon,k) =pplay(1:klon,klev+1-k)
579	cldfra_i(1:klon,k) =cldfra(1:klon,klev+1-k)
580	PDP_i(1:klon,k) =PDP(1:klon,klev+1-k)
581	t_i(1:klon,k) =t(1:klon,klev+1-k)
582	q_i(1:klon,k) =q(1:klon,klev+1-k)
583	qsat_i(1:klon,k) =qsat(1:klon,klev+1-k)
584	flwc_i(1:klon,k) =flwc(1:klon,klev+1-k)
585	fiwc_i(1:klon,k) =fiwc(1:klon,klev+1-k)
586	ENDDO
587	DO k=1,kflev
588	POZON_i(1:klon,k)=POZON(1:klon,kflev+1-k)
589	! print *,'Juste avant RECMWFL: k tsol temp',k,tsol,t(1,k)
590	!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6
591	DO i=1,6
592	PAER_i(1:klon,k,i)=PAER(1:klon,kflev+1-k,i)
593	ENDDO
594	ENDDO
595	! print *,'RADLWSW: avant RECMWFL, RI0,rmu0 =',solaire,rmu0
596
597	! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
598	! La version ARPEGE1D utilise differentes valeurs de la constante
599	! solaire suivant le rayonnement utilise.
600	! A controler ...
601	! SOLAR FLUX AT THE TOP (/YOMPHY3/)
602	! introduce season correction
603	!--------------------------------------
604	! RII0 = RIP0
605	! IF(LRAYFM)
606	! RII0 = RIP0M ! =rip0m if Morcrette non-each time step call.
607	! IF(LRAYFM15)
608	! RII0 = RIP0M15 ! =rip0m if Morcrette non-each time step call.
609	RII0=solaire
610	! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
611	! Ancien appel a RECMWF (celui du cy25)
612	! CALL RECMWF (ist , iend, klon , ktdia , klev , kmode ,
613	! s PALBD , PALBP , paprs_i , pplay_i , RCO2 , cldfra_i,
614	! s POZON_i , PAER_i , PDP_i , PEMIS , GEMU , rmu0,
615	! s q_i , qsat_i , fiwc_i , flwc_i , zmasq , t_i ,tsol,
616	! s ZEMTD_i , ZEMTU_i , ZTRSO_i ,
617	! s ZTH_i , ZCTRSO , ZCEMTR , ZTRSOD ,
618	! s ZLWFC , ZLWFT_i , ZSWFC , ZSWFT_i ,
619	! s ZFLUX_i , ZFLUC_i , ZFSDWN_i, ZFSUP_i , ZFCDWN_i,ZFCUP_i)
620	! s 'RECMWF ')
621	!
622	IF(lldebug) then
623	call writefield_phy('paprs_i',paprs_i,klev+1)
624	call writefield_phy('pplay_i',pplay_i,klev)
625	call writefield_phy('cldfra_i',cldfra_i,klev)
626	call writefield_phy('pozon_i',POZON_i,klev)
627	call writefield_phy('paer_i',PAER_i,klev)
628	call writefield_phy('pdp_i',PDP_i,klev)
629	call writefield_phy('q_i',q_i,klev)
630	call writefield_phy('qsat_i',qsat_i,klev)
631	call writefield_phy('fiwc_i',fiwc_i,klev)
632	call writefield_phy('flwc_i',flwc_i,klev)
633	call writefield_phy('t_i',t_i,klev)
634	call writefield_phy('palbd_new',PALBD_NEW,NSW)
635	call writefield_phy('palbp_new',PALBP_NEW,NSW)
636	ENDIF
637
638	! Nouvel appel a RECMWF (celui du cy32t0)
639	CALL RECMWF (ist , iend, klon , ktdia , klev , kmode ,&
640	PALBD_NEW,PALBP_NEW, paprs_i , pplay_i , RCO2 , cldfra_i,&
641	POZON_i , PAER_i , PDP_i , PEMIS , rmu0 ,&
642	q_i , qsat_i , fiwc_i , flwc_i , zmasq , t_i ,tsol,&
643	ZEMTD_i , ZEMTU_i , ZTRSO_i ,&
644	ZTH_i , ZCTRSO , ZCEMTR , ZTRSOD ,&
645	ZLWFC , ZLWFT_i , ZSWFC , ZSWFT_i ,&
646	PSFSWDIR , PSFSWDIF, PFSDNN , PFSDNV ,&
647	PPIZA_DST, PCGA_DST,PTAUREL_DST,ZFLUX_i , ZFLUC_i ,&
648	ZFSDWN_i , ZFSUP_i , ZFCDWN_i, ZFCUP_i)
649
650	print *,'RADLWSW: apres RECMWF'
651	IF(lldebug) THEN
652	call writefield_phy('zemtd_i',ZEMTD_i,klev+1)
653	call writefield_phy('zemtu_i',ZEMTU_i,klev+1)
654	call writefield_phy('ztrso_i',ZTRSO_i,klev+1)
655	call writefield_phy('zth_i',ZTH_i,klev+1)
656	call writefield_phy('zctrso',ZCTRSO,2)
657	call writefield_phy('zcemtr',ZCEMTR,2)
658	call writefield_phy('ztrsod',ZTRSOD,1)
659	call writefield_phy('zlwfc',ZLWFC,2)
660	call writefield_phy('zlwft_i',ZLWFT_i,klev+1)
661	call writefield_phy('zswfc',ZSWFC,2)
662	call writefield_phy('zswft_i',ZSWFT_i,klev+1)
663	call writefield_phy('psfswdir',PSFSWDIR,6)
664	call writefield_phy('psfswdif',PSFSWDIF,6)
665	call writefield_phy('pfsdnn',PFSDNN,1)
666	call writefield_phy('pfsdnv',PFSDNV,1)
667	call writefield_phy('ppiza_dst',PPIZA_DST,klev)
668	call writefield_phy('pcga_dst',PCGA_DST,klev)
669	call writefield_phy('ptaurel_dst',PTAUREL_DST,klev)
670	call writefield_phy('zflux_i',ZFLUX_i,klev+1)
671	call writefield_phy('zfluc_i',ZFLUC_i,klev+1)
672	call writefield_phy('zfsdwn_i',ZFSDWN_i,klev+1)
673	call writefield_phy('zfsup_i',ZFSUP_i,klev+1)
674	call writefield_phy('zfcdwn_i',ZFCDWN_i,klev+1)
675	call writefield_phy('zfcup_i',ZFCUP_i,klev+1)
676	ENDIF
677	! --------- output RECMWFL
678	! ZEMTD (KPROMA,KLEV+1) ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
679	! ZEMTU (KPROMA,KLEV+1) ; TOTAL UPWARD LONGWAVE EMISSIVITY
680	! ZTRSO (KPROMA,KLEV+1) ; TOTAL SHORTWAVE TRANSMISSIVITY
681	! ZTH (KPROMA,KLEV+1) ; HALF LEVEL TEMPERATURE
682	! ZCTRSO (KPROMA,2) ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY
683	! ZCEMTR (KPROMA,2) ; CLEAR-SKY NET LONGWAVE EMISSIVITY
684	! ZTRSOD (KPROMA) ; TOTAL-SKY SURFACE SW TRANSMISSITY
685	! ZLWFC (KPROMA,2) ; CLEAR-SKY LONGWAVE FLUXES
686	! ZLWFT (KPROMA,KLEV+1) ; TOTAL-SKY LONGWAVE FLUXES
687	! ZSWFC (KPROMA,2) ; CLEAR-SKY SHORTWAVE FLUXES
688	! ZSWFT (KPROMA,KLEV+1) ; TOTAL-SKY SHORTWAVE FLUXES
689	! PPIZA_DST (KPROMA,KLEV,NSW); Single scattering albedo of dust
690	! PCGA_DST (KPROMA,KLEV,NSW); Assymetry factor for dust
691	! PTAUREL_DST (KPROMA,KLEV,NSW); Optical depth of dust relative to at 550nm
692	! PSFSWDIR (KPROMA,NSW) ;
693	! PSFSWDIF (KPROMA,NSW) ;
694	! PFSDNN (KPROMA) ;
695	! PFSDNV (KPROMA) ;
696	! ---------
697	! On retablit l'ordre des niveaux lmd pour les tableaux de sortie
698	DO k=0,klev
699	ZEMTD(1:klon,k+1) = ZEMTD_i(1:klon,k+1)
700	ZEMTU(1:klon,k+1) = ZEMTU_i(1:klon,k+1)
701	ZTRSO(1:klon,k+1) = ZTRSO_i(1:klon,k+1)
702	ZTH(1:klon,k+1) = ZTH_i(1:klon,k+1)
703	! ZLWFT(1:klon,k+1) = ZLWFT_i(1:klon,klev+1-k)
704	! ZSWFT(1:klon,k+1) = ZSWFT_i(1:klon,klev+1-k)
705	ZFLUP(1:klon,k+1) = ZFLUX_i(1:klon,1,k+1)
706	ZFLDN(1:klon,k+1) = ZFLUX_i(1:klon,2,k+1)
707	ZFLUP0(1:klon,k+1) = ZFLUC_i(1:klon,1,k+1)
708	ZFLDN0(1:klon,k+1) = ZFLUC_i(1:klon,2,k+1)
709	ZFSDN(1:klon,k+1) = ZFSDWN_i(1:klon,k+1)
710	ZFSDN0(1:klon,k+1) = ZFCDWN_i(1:klon,k+1)
711	ZFSUP (1:klon,k+1) = ZFSUP_i(1:klon,k+1)
712	ZFSUP0(1:klon,k+1) = ZFCUP_i(1:klon,k+1)
713	! Nouveau calcul car visiblement ZSWFT et ZSWFC sont nuls dans RRTM cy32
714	! en sortie de radlsw.F90 - MPL 7.01.09
715	ZSWFT(1:klon,k+1) = ZFSDWN_i(1:klon,k+1)-ZFSUP_i(1:klon,k+1)
716	ZSWFT0(1:klon,k+1) = ZFCDWN_i(1:klon,k+1)-ZFCUP_i(1:klon,k+1)
717	! WRITE(*,'("FSDN FSUP FCDN FCUP: ",4E12.5)') ZFSDWN_i(1:klon,k+1),&
718	! ZFSUP_i(1:klon,k+1),ZFCDWN_i(1:klon,k+1),ZFCUP_i(1:klon,k+1)
719	ZLWFT(1:klon,k+1) =-ZFLUX_i(1:klon,2,k+1)-ZFLUX_i(1:klon,1,k+1)
720	ZLWFT0(1:klon,k+1)=-ZFLUC_i(1:klon,2,k+1)-ZFLUC_i(1:klon,1,k+1)
721	! print *,'FLUX2 FLUX1 FLUC2 FLUC1',ZFLUX_i(1:klon,2,k+1),
722	! s ZFLUX_i(1:klon,1,k+1),ZFLUC_i(1:klon,2,k+1),ZFLUC_i(1:klon,1,k+1)
723	ENDDO
724	print*,'OK1'
725	! ---------
726	! On renseigne les champs LMDz, pour avoir la meme chose qu'en sortie de
727	! LW_LMDAR4 et SW_LMDAR4
728	DO i = 1, kdlon
729	zsolsw(i) = ZSWFT(i,1)
730	zsolsw0(i) = ZSWFT0(i,1)
731	! zsolsw0(i) = ZFSDN0(i,1) -ZFSUP0(i,1)
732	ztopsw(i) = ZSWFT(i,klev+1)
733	ztopsw0(i) = ZSWFT0(i,klev+1)
734	! ztopsw0(i) = ZFSDN0(i,klev+1)-ZFSUP0(i,klev+1)
735	!
736	! zsollw(i) = ZFLDN(i,1) -ZFLUP(i,1)
737	! zsollw0(i) = ZFLDN0(i,1) -ZFLUP0(i,1)
738	! ztoplw(i) = ZFLDN(i,klev+1) -ZFLUP(i,klev+1)
739	! ztoplw0(i) = ZFLDN0(i,klev+1)-ZFLUP0(i,klev+1)
740	zsollw(i) = ZLWFT(i,1)
741	zsollw0(i) = ZLWFT0(i,1)
742	ztoplw(i) = ZLWFT(i,klev+1)
743	ztoplw0(i) = ZLWFT0(i,klev+1)
744	!
745	zalbpla(i) = ZFSUP(i,klev+1)/ZFSDN(i,klev+1)
746	zsollwdown(i)= ZFLDN(i,1)
747	ENDDO
748	print*,'OK2'
749
750	! extrait de SW_AR4
751	! DO k = 1, KFLEV
752	! kpl1 = k+1
753	! DO i = 1, KDLON
754	! PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k)) -(ZFSDN(i,k)-ZFSDN(i,kpl1))
755	! PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
756	! ZLWFT(klon,k),ZSWFT
757
758	DO k=1,kflev
759	DO i=1,kdlon
760	zheat(i,k)=(ZSWFT(i,k+1)-ZSWFT(i,k))RDAYRG/RCPD/PDP(i,k)
761	zheat0(i,k)=(ZSWFT0(i,k+1)-ZSWFT0(i,k))RDAYRG/RCPD/PDP(i,k)
762	zcool(i,k)=(ZLWFT(i,k)-ZLWFT(i,k+1))RDAYRG/RCPD/PDP(i,k)
763	zcool0(i,k)=(ZLWFT0(i,k)-ZLWFT0(i,k+1))RDAYRG/RCPD/PDP(i,k)
764	! print *,'heat cool heat0 coOl0 '&
765	! ,zheat(i,k),zcool(i,k),zheat0(i,k),zcool0(i,k)
766	ENDDO
767	ENDDO
768	ENDIF ! if(iflag_rrtm=0)
769	print*,'OK3'
770	!======================================================================
771	! PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)
772	! PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)
773	! PSOLSWAD(i) = ZFSDNAD(i,1) - ZFSUPAD(i,1)
774	! PSOLSWAI(i) = ZFSDNAI(i,1) - ZFSUPAI(i,1)
775	! PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)
776	! PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)
777	! PTOPSWAD(i) = ZFSDNAD(i,KFLEV+1) - ZFSUPAD(i,KFLEV+1)
778	! PTOPSWAI(i) = ZFSDNAI(i,KFLEV+1) - ZFSUPAI(i,KFLEV+1)
779	!======================================================================
780	DO i = 1, kdlon
781	radsol(iof+i) = zsolsw(i) + zsollw(i)
782	topsw(iof+i) = ztopsw(i)
783	toplw(iof+i) = ztoplw(i)
784	solsw(iof+i) = zsolsw(i)
785	sollw(iof+i) = zsollw(i)
786	sollwdown(iof+i) = zsollwdown(i)
787	DO k = 1, kflev+1
788	lwdn0 ( iof+i,k) = ZFLDN0 ( i,k)
789	lwdn ( iof+i,k) = ZFLDN ( i,k)
790	lwup0 ( iof+i,k) = ZFLUP0 ( i,k)
791	lwup ( iof+i,k) = ZFLUP ( i,k)
792	ENDDO
793	topsw0(iof+i) = ztopsw0(i)
794	toplw0(iof+i) = ztoplw0(i)
795	solsw0(iof+i) = zsolsw0(i)
796	sollw0(iof+i) = zsollw0(i)
797	albpla(iof+i) = zalbpla(i)
798
799	DO k = 1, kflev+1
800	swdn0 ( iof+i,k) = ZFSDN0 ( i,k)
801	swdn ( iof+i,k) = ZFSDN ( i,k)
802	swup0 ( iof+i,k) = ZFSUP0 ( i,k)
803	swup ( iof+i,k) = ZFSUP ( i,k)
804	ENDDO
805	ENDDO
806	print*,'OK4'
807	!-transform the aerosol forcings, if they have
808	! to be calculated
809	IF (ok_ade) THEN
810	DO i = 1, kdlon
811	topswad_aero(iof+i) = ztopswadaero(i)
812	topswad0_aero(iof+i) = ztopswad0aero(i)
813	solswad_aero(iof+i) = zsolswadaero(i)
814	solswad0_aero(iof+i) = zsolswad0aero(i)
815	topsw_aero(iof+i,:) = ztopsw_aero(iof+i,:)
816	topsw0_aero(iof+i,:) = ztopsw0_aero(iof+i,:)
817	solsw_aero(iof+i,:) = zsolsw_aero(iof+i,:)
818	solsw0_aero(iof+i,:) = zsolsw0_aero(iof+i,:)
819
820	ENDDO
821	ELSE
822	DO i = 1, kdlon
823	topswad_aero(iof+i) = 0.0
824	solswad_aero(iof+i) = 0.0
825	topswad0_aero(iof+i) = 0.0
826	solswad0_aero(iof+i) = 0.0
827	topsw_aero(iof+i,:) = 0.
828	topsw0_aero(iof+i,:) =0.
829	solsw_aero(iof+i,:) = 0.
830	solsw0_aero(iof+i,:) = 0.
831	ENDDO
832	ENDIF
833	IF (ok_aie) THEN
834	DO i = 1, kdlon
835	topswai_aero(iof+i) = ztopswaiaero(i)
836	solswai_aero(iof+i) = zsolswaiaero(i)
837	ENDDO
838	ELSE
839	DO i = 1, kdlon
840	topswai_aero(iof+i) = 0.0
841	solswai_aero(iof+i) = 0.0
842	ENDDO
843	ENDIF
844	print*,'OK5'
845	DO k = 1, kflev
846	DO i = 1, kdlon
847	! scale factor to take into account the difference between
848	! dry air and watter vapour scpecifi! heat capacity
849	zznormcp=1.0+RVTMP2*PWV(i,k)
850	heat(iof+i,k) = zheat(i,k)/zznormcp
851	cool(iof+i,k) = zcool(i,k)/zznormcp
852	heat0(iof+i,k) = zheat0(i,k)/zznormcp
853	cool0(iof+i,k) = zcool0(i,k)/zznormcp
854	ENDDO
855	ENDDO
856	print*,'OK6'
857	!
858	ENDDO
859	print*,'OK7'
860
861
862	ENDSUBROUTINE radlwsw_aero
863
864

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

Download in other formats:

Original Format