/[lmdze]/trunk/phylmd/Radlwsw/radlwsw.f
ViewVC logotype

Annotation of /trunk/phylmd/Radlwsw/radlwsw.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 69 - (hide annotations)
Mon Feb 18 16:33:12 2013 UTC (11 years, 2 months ago) by guez
Original Path: trunk/libf/phylmd/Radlwsw/radlwsw.f90
File size: 13841 byte(s)
Deleted files cvparam3.f90 and nuagecom.f90. Moved variables from
module cvparam3 to module cv3_param_m. Moved variables rad_chau1 and
rad_chau2 from module nuagecom to module conf_phys_m.

Read clesphys2_nml from conf_phys instead of gcm.

Removed argument iflag_con from several procedures. Access module
variable instead.

1 guez 53 module radlwsw_m
2 guez 3
3 guez 53 IMPLICIT none
4 guez 3
5 guez 53 contains
6    
7     SUBROUTINE radlwsw(dist, rmu0, fract, paprs, pplay, tsol, albedo, alblw, &
8     t, q, wo, cldfra, cldemi, cldtaupd, heat, heat0, cool, cool0, radsol, &
9     albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, toplw0, solsw0, &
10     sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, swup0, swup, ok_ade, &
11     ok_aie, tau_ae, piz_ae, cg_ae, topswad, solswad, cldtaupi, topswai, &
12     solswai)
13    
14     ! From LMDZ4/libf/phylmd/radlwsw.F, version 1.4 2005/06/06 13:16:33
15 guez 69 ! Author: Z. X. Li (LMD/CNRS)
16     ! Date: 1996/07/19
17 guez 53
18 guez 69 ! Objet : interface entre le modèle et les rayonnements solaire et
19     ! infrarouge
20    
21     ! ATTENTION: swai and swad have to be interpreted in the following manner:
22    
23     ! not ok_ade and not ok_aie
24     ! both are zero
25    
26     ! ok_ade and not ok_aie
27     ! aerosol direct forcing is F_{AD} = topsw - topswad
28     ! indirect is zero
29    
30     ! not ok_ade and ok_aie
31     ! aerosol indirect forcing is F_{AI} = topsw - topswai
32     ! direct is zero
33    
34     ! ok_ade and ok_aie
35     ! aerosol indirect forcing is F_{AI} = topsw - topswai
36     ! aerosol direct forcing is F_{AD} = topswai - topswad
37    
38 guez 53 USE dimphy, ONLY: klev, klon
39     USE clesphys, ONLY: bug_ozone, solaire
40     USE suphec_m, ONLY: rg
41     USE raddim, ONLY: kdlon
42     USE yoethf_m, ONLY: rvtmp2
43     use sw_m, only: sw
44    
45     ! Arguments:
46 guez 69
47     real rmu0(klon), fract(klon), dist
48 guez 53 ! dist-----input-R- distance astronomique terre-soleil
49     ! rmu0-----input-R- cosinus de l'angle zenithal
50     ! fract----input-R- duree d'ensoleillement normalisee
51 guez 69
52     real, intent(in):: paprs(klon, klev+1)
53 guez 53 ! paprs----input-R- pression a inter-couche (Pa)
54 guez 69 real, intent(in):: pplay(klon, klev)
55 guez 53 ! pplay----input-R- pression au milieu de couche (Pa)
56 guez 69 real albedo(klon), alblw(klon), tsol(klon)
57     ! albedo---input-R- albedo du sol (entre 0 et 1)
58 guez 53 ! tsol-----input-R- temperature du sol (en K)
59 guez 69 real, intent(in):: t(klon, klev)
60 guez 53 ! t--------input-R- temperature (K)
61 guez 69 real q(klon, klev)
62 guez 53 ! q--------input-R- vapeur d'eau (en kg/kg)
63 guez 69 real, intent(in):: wo(klon, klev)
64 guez 53 ! wo-------input-R- contenu en ozone (en kg/kg) correction MPL 100505
65 guez 69 real cldfra(klon, klev), cldemi(klon, klev)
66 guez 53 ! cldfra---input-R- fraction nuageuse (entre 0 et 1)
67     ! cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1)
68    
69 guez 69 real cldtaupd(klon, klev)
70     ! input-R- epaisseur optique des nuages dans le visible (present-day value)
71 guez 53
72     real, intent(out):: heat(klon, klev)
73     ! échauffement atmosphérique (visible) (K/jour)
74    
75     real cool(klon, klev)
76 guez 69 ! cool-----output-R- refroidissement dans l'IR (K/jour)
77 guez 53 real heat0(klon, klev), cool0(klon, klev)
78 guez 62 real radsol(klon), topsw(klon)
79 guez 69 ! radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
80     ! topsw----output-R- flux solaire net au sommet de l'atm.
81 guez 62
82     real, intent(out):: toplw(klon)
83     ! rayonnement infrarouge montant au sommet de l'atmosphère
84    
85 guez 53 real solsw(klon), sollw(klon), albpla(klon)
86 guez 69 ! solsw----output-R- flux solaire net a la surface
87     ! sollw----output-R- ray. IR montant a la surface
88     ! albpla---output-R- albedo planetaire (entre 0 et 1)
89 guez 62 real topsw0(klon), solsw0(klon), sollw0(klon)
90     real, intent(out):: toplw0(klon)
91 guez 53 real sollwdown(klon)
92     !IM output 3D
93     DOUBLE PRECISION ZFSUP(KDLON, KLEV+1)
94     DOUBLE PRECISION ZFSDN(KDLON, KLEV+1)
95     DOUBLE PRECISION ZFSUP0(KDLON, KLEV+1)
96     DOUBLE PRECISION ZFSDN0(KDLON, KLEV+1)
97    
98     DOUBLE PRECISION ZFLUP(KDLON, KLEV+1)
99     DOUBLE PRECISION ZFLDN(KDLON, KLEV+1)
100     DOUBLE PRECISION ZFLUP0(KDLON, KLEV+1)
101     DOUBLE PRECISION ZFLDN0(KDLON, KLEV+1)
102    
103     DOUBLE PRECISION zx_alpha1, zx_alpha2
104    
105 guez 62 INTEGER k, kk, i, iof, nb_gr
106 guez 53 EXTERNAL lw
107    
108     DOUBLE PRECISION PSCT
109    
110     DOUBLE PRECISION PALBD(kdlon, 2), PALBP(kdlon, 2)
111     DOUBLE PRECISION PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon)
112     DOUBLE PRECISION PPSOL(kdlon), PDP(kdlon, klev)
113     DOUBLE PRECISION PTL(kdlon, klev+1), PPMB(kdlon, klev+1)
114     DOUBLE PRECISION PTAVE(kdlon, klev)
115     DOUBLE PRECISION PWV(kdlon, klev), PQS(kdlon, klev), POZON(kdlon, klev)
116     DOUBLE PRECISION PAER(kdlon, klev, 5)
117     DOUBLE PRECISION PCLDLD(kdlon, klev)
118     DOUBLE PRECISION PCLDLU(kdlon, klev)
119     DOUBLE PRECISION PCLDSW(kdlon, klev)
120     DOUBLE PRECISION PTAU(kdlon, 2, klev)
121     DOUBLE PRECISION POMEGA(kdlon, 2, klev)
122     DOUBLE PRECISION PCG(kdlon, 2, klev)
123    
124     DOUBLE PRECISION zfract(kdlon), zrmu0(kdlon), zdist
125    
126     DOUBLE PRECISION zheat(kdlon, klev), zcool(kdlon, klev)
127     DOUBLE PRECISION zheat0(kdlon, klev), zcool0(kdlon, klev)
128     DOUBLE PRECISION ztopsw(kdlon), ztoplw(kdlon)
129     DOUBLE PRECISION zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon)
130     DOUBLE PRECISION zsollwdown(kdlon)
131    
132     DOUBLE PRECISION ztopsw0(kdlon), ztoplw0(kdlon)
133     DOUBLE PRECISION zsolsw0(kdlon), zsollw0(kdlon)
134     DOUBLE PRECISION zznormcp
135     !IM output 3D: SWup, SWdn, LWup, LWdn
136     REAL swdn(klon, klev+1), swdn0(klon, klev+1)
137     REAL swup(klon, klev+1), swup0(klon, klev+1)
138     REAL lwdn(klon, klev+1), lwdn0(klon, klev+1)
139     REAL lwup(klon, klev+1), lwup0(klon, klev+1)
140    
141     !jq the following quantities are needed for the aerosol radiative forcings
142    
143     real topswad(klon), solswad(klon)
144     ! output: aerosol direct forcing at TOA and surface
145 guez 69 ! topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir)
146     ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)
147 guez 53
148     real topswai(klon), solswai(klon)
149     ! output: aerosol indirect forcing atTOA and surface
150 guez 69 ! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind)
151     ! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind)
152 guez 53
153     real tau_ae(klon, klev, 2), piz_ae(klon, klev, 2), cg_ae(klon, klev, 2)
154 guez 69 ! input-R- aerosol optical properties (calculated in aeropt.F)
155 guez 53
156     real cldtaupi(klon, klev)
157     ! cloud optical thickness for pre-industrial aerosol concentrations
158 guez 69 ! (i.e. with a smaller droplet concentration and thus larger droplet radii)
159     ! -input-R- epaisseur optique des nuages dans le visible
160     ! calculated for pre-industrial (pi) aerosol concentrations,
161     ! i.e. with smaller droplet concentration, thus larger droplets,
162     ! thus generally cdltaupi cldtaupd it is needed for the
163     ! diagnostics of the aerosol indirect radiative forcing
164 guez 53
165     logical ok_ade, ok_aie
166     ! switches whether to use aerosol direct (indirect) effects or not
167 guez 62 ! ok_ade---input-L- apply the Aerosol Direct Effect or not?
168     ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
169 guez 53
170     double precision tauae(kdlon, klev, 2) ! aer opt properties
171     double precision pizae(kdlon, klev, 2)
172     double precision cgae(kdlon, klev, 2)
173    
174     DOUBLE PRECISION PTAUA(kdlon, 2, klev)
175     ! present-day value of cloud opt thickness (PTAU is pre-industrial
176     ! value), local use
177    
178     DOUBLE PRECISION POMEGAA(kdlon, 2, klev) ! dito for single scatt albedo
179    
180     DOUBLE PRECISION ztopswad(kdlon), zsolswad(kdlon)
181     ! Aerosol direct forcing at TOAand surface
182    
183     DOUBLE PRECISION ztopswai(kdlon), zsolswai(kdlon) ! dito, indirect
184    
185     !----------------------------------------------------------------------
186    
187     tauae = 0.
188     pizae = 0.
189     cgae = 0.
190    
191     nb_gr = klon / kdlon
192     IF (nb_gr * kdlon /= klon) THEN
193     PRINT *, "kdlon mauvais :", klon, kdlon, nb_gr
194     stop 1
195     ENDIF
196    
197     heat = 0.
198     cool = 0.
199     heat0 = 0.
200     cool0 = 0.
201     zdist = dist
202     PSCT = solaire / zdist / zdist
203    
204 guez 62 loop_iof: DO iof = 0, klon - kdlon, kdlon
205 guez 53 DO i = 1, kdlon
206     zfract(i) = fract(iof+i)
207     zrmu0(i) = rmu0(iof+i)
208     PALBD(i, 1) = albedo(iof+i)
209     PALBD(i, 2) = alblw(iof+i)
210     PALBP(i, 1) = albedo(iof+i)
211     PALBP(i, 2) = alblw(iof+i)
212     ! cf. JLD pour etre en accord avec ORCHIDEE il faut mettre
213     ! PEMIS(i) = 0.96
214     PEMIS(i) = 1.0
215     PVIEW(i) = 1.66
216     PPSOL(i) = paprs(iof+i, 1)
217     zx_alpha1 = (paprs(iof+i, 1)-pplay(iof+i, 2)) &
218     / (pplay(iof+i, 1)-pplay(iof+i, 2))
219     zx_alpha2 = 1.0 - zx_alpha1
220     PTL(i, 1) = t(iof+i, 1) * zx_alpha1 + t(iof+i, 2) * zx_alpha2
221     PTL(i, klev+1) = t(iof+i, klev)
222     PDT0(i) = tsol(iof+i) - PTL(i, 1)
223     ENDDO
224     DO k = 2, klev
225     DO i = 1, kdlon
226     PTL(i, k) = (t(iof+i, k)+t(iof+i, k-1))*0.5
227     ENDDO
228     ENDDO
229     DO k = 1, klev
230     DO i = 1, kdlon
231     PDP(i, k) = paprs(iof+i, k)-paprs(iof+i, k+1)
232     PTAVE(i, k) = t(iof+i, k)
233     PWV(i, k) = MAX (q(iof+i, k), 1.0e-12)
234     PQS(i, k) = PWV(i, k)
235     ! wo: cm.atm (epaisseur en cm dans la situation standard)
236     ! POZON: kg/kg
237     IF (bug_ozone) then
238     POZON(i, k) = MAX(wo(iof+i, k), 1.0e-12)*RG/46.6968 &
239     /(paprs(iof+i, k)-paprs(iof+i, k+1)) &
240     *(paprs(iof+i, 1)/101325.0)
241     ELSE
242     ! le calcul qui suit est maintenant fait dans ozonecm (MPL)
243     POZON(i, k) = wo(i, k)
244     ENDIF
245     PCLDLD(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)
246     PCLDLU(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)
247     PCLDSW(i, k) = cldfra(iof+i, k)
248     PTAU(i, 1, k) = MAX(cldtaupi(iof+i, k), 1.0e-05)
249     ! (1e-12 serait instable)
250     PTAU(i, 2, k) = MAX(cldtaupi(iof+i, k), 1.0e-05)
251     ! (pour 32-bit machines)
252     POMEGA(i, 1, k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i, 1, k))
253     POMEGA(i, 2, k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i, 2, k))
254     PCG(i, 1, k) = 0.865
255     PCG(i, 2, k) = 0.910
256    
257     ! Introduced for aerosol indirect forcings. The
258     ! following values use the cloud optical thickness
259     ! calculated from present-day aerosol concentrations
260     ! whereas the quantities without the "A" at the end are
261     ! for pre-industial (natural-only) aerosol concentrations
262     PTAUA(i, 1, k) = MAX(cldtaupd(iof+i, k), 1.0e-05)
263     ! (1e-12 serait instable)
264     PTAUA(i, 2, k) = MAX(cldtaupd(iof+i, k), 1.0e-05)
265     ! (pour 32-bit machines)
266     POMEGAA(i, 1, k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i, 1, k))
267     POMEGAA(i, 2, k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i, 2, k))
268     !jq-end
269     ENDDO
270     ENDDO
271    
272     DO k = 1, klev+1
273     DO i = 1, kdlon
274     PPMB(i, k) = paprs(iof+i, k)/100.0
275     ENDDO
276     ENDDO
277    
278     DO kk = 1, 5
279     DO k = 1, klev
280     DO i = 1, kdlon
281     PAER(i, k, kk) = 1.0E-15
282     ENDDO
283     ENDDO
284     ENDDO
285    
286     DO k = 1, klev
287     DO i = 1, kdlon
288     tauae(i, k, 1) = tau_ae(iof+i, k, 1)
289     pizae(i, k, 1) = piz_ae(iof+i, k, 1)
290     cgae(i, k, 1) =cg_ae(iof+i, k, 1)
291     tauae(i, k, 2) = tau_ae(iof+i, k, 2)
292     pizae(i, k, 2) = piz_ae(iof+i, k, 2)
293     cgae(i, k, 2) =cg_ae(iof+i, k, 2)
294     ENDDO
295     ENDDO
296    
297     CALL LW(PPMB, PDP, PPSOL, PDT0, PEMIS, PTL, PTAVE, PWV, POZON, PAER, &
298     PCLDLD, PCLDLU, PVIEW, zcool, zcool0, ztoplw, zsollw, ztoplw0, &
299     zsollw0, zsollwdown, ZFLUP, ZFLDN, ZFLUP0, ZFLDN0)
300     CALL SW(PSCT, zrmu0, zfract, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &
301     PWV, PQS, POZON, PAER, PCLDSW, PTAU, POMEGA, PCG, zheat, zheat0, &
302     zalbpla, ztopsw, zsolsw, ztopsw0, zsolsw0, ZFSUP, ZFSDN, ZFSUP0, &
303     ZFSDN0, tauae, pizae, cgae, PTAUA, POMEGAA, ztopswad, zsolswad, &
304     ztopswai, zsolswai, ok_ade, ok_aie)
305    
306     DO i = 1, kdlon
307     radsol(iof+i) = zsolsw(i) + zsollw(i)
308     topsw(iof+i) = ztopsw(i)
309     toplw(iof+i) = ztoplw(i)
310     solsw(iof+i) = zsolsw(i)
311     sollw(iof+i) = zsollw(i)
312     sollwdown(iof+i) = zsollwdown(i)
313    
314     DO k = 1, klev+1
315     lwdn0 ( iof+i, k) = ZFLDN0 ( i, k)
316     lwdn ( iof+i, k) = ZFLDN ( i, k)
317     lwup0 ( iof+i, k) = ZFLUP0 ( i, k)
318     lwup ( iof+i, k) = ZFLUP ( i, k)
319     ENDDO
320    
321     topsw0(iof+i) = ztopsw0(i)
322     toplw0(iof+i) = ztoplw0(i)
323     solsw0(iof+i) = zsolsw0(i)
324     sollw0(iof+i) = zsollw0(i)
325     albpla(iof+i) = zalbpla(i)
326    
327     DO k = 1, klev+1
328     swdn0 ( iof+i, k) = ZFSDN0 ( i, k)
329     swdn ( iof+i, k) = ZFSDN ( i, k)
330     swup0 ( iof+i, k) = ZFSUP0 ( i, k)
331     swup ( iof+i, k) = ZFSUP ( i, k)
332     ENDDO
333     ENDDO
334     ! transform the aerosol forcings, if they have to be calculated
335     IF (ok_ade) THEN
336     DO i = 1, kdlon
337     topswad(iof+i) = ztopswad(i)
338     solswad(iof+i) = zsolswad(i)
339     ENDDO
340     ELSE
341     DO i = 1, kdlon
342     topswad(iof+i) = 0.0
343     solswad(iof+i) = 0.0
344     ENDDO
345     ENDIF
346     IF (ok_aie) THEN
347     DO i = 1, kdlon
348     topswai(iof+i) = ztopswai(i)
349     solswai(iof+i) = zsolswai(i)
350     ENDDO
351     ELSE
352     DO i = 1, kdlon
353     topswai(iof+i) = 0.0
354     solswai(iof+i) = 0.0
355     ENDDO
356     ENDIF
357    
358     DO k = 1, klev
359     DO i = 1, kdlon
360     ! scale factor to take into account the difference
361     ! between dry air and water vapour specific heat capacity
362     zznormcp = 1. + RVTMP2 * PWV(i, k)
363     heat(iof+i, k) = zheat(i, k) / zznormcp
364     cool(iof+i, k) = zcool(i, k)/zznormcp
365     heat0(iof+i, k) = zheat0(i, k)/zznormcp
366     cool0(iof+i, k) = zcool0(i, k)/zznormcp
367     ENDDO
368     ENDDO
369 guez 62 end DO loop_iof
370 guez 53
371     END SUBROUTINE radlwsw
372    
373     end module radlwsw_m

  ViewVC Help
Powered by ViewVC 1.1.21