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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 69 - (show 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 module radlwsw_m
2
3 IMPLICIT none
4
5 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 ! Author: Z. X. Li (LMD/CNRS)
16 ! Date: 1996/07/19
17
18 ! 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 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
47 real rmu0(klon), fract(klon), dist
48 ! 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
52 real, intent(in):: paprs(klon, klev+1)
53 ! paprs----input-R- pression a inter-couche (Pa)
54 real, intent(in):: pplay(klon, klev)
55 ! pplay----input-R- pression au milieu de couche (Pa)
56 real albedo(klon), alblw(klon), tsol(klon)
57 ! albedo---input-R- albedo du sol (entre 0 et 1)
58 ! tsol-----input-R- temperature du sol (en K)
59 real, intent(in):: t(klon, klev)
60 ! t--------input-R- temperature (K)
61 real q(klon, klev)
62 ! q--------input-R- vapeur d'eau (en kg/kg)
63 real, intent(in):: wo(klon, klev)
64 ! wo-------input-R- contenu en ozone (en kg/kg) correction MPL 100505
65 real cldfra(klon, klev), cldemi(klon, klev)
66 ! 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 real cldtaupd(klon, klev)
70 ! input-R- epaisseur optique des nuages dans le visible (present-day value)
71
72 real, intent(out):: heat(klon, klev)
73 ! échauffement atmosphérique (visible) (K/jour)
74
75 real cool(klon, klev)
76 ! cool-----output-R- refroidissement dans l'IR (K/jour)
77 real heat0(klon, klev), cool0(klon, klev)
78 real radsol(klon), topsw(klon)
79 ! 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
82 real, intent(out):: toplw(klon)
83 ! rayonnement infrarouge montant au sommet de l'atmosphère
84
85 real solsw(klon), sollw(klon), albpla(klon)
86 ! 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 real topsw0(klon), solsw0(klon), sollw0(klon)
90 real, intent(out):: toplw0(klon)
91 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 INTEGER k, kk, i, iof, nb_gr
106 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 ! 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
148 real topswai(klon), solswai(klon)
149 ! output: aerosol indirect forcing atTOA and surface
150 ! 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
153 real tau_ae(klon, klev, 2), piz_ae(klon, klev, 2), cg_ae(klon, klev, 2)
154 ! input-R- aerosol optical properties (calculated in aeropt.F)
155
156 real cldtaupi(klon, klev)
157 ! cloud optical thickness for pre-industrial aerosol concentrations
158 ! (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
165 logical ok_ade, ok_aie
166 ! switches whether to use aerosol direct (indirect) effects or not
167 ! ok_ade---input-L- apply the Aerosol Direct Effect or not?
168 ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
169
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 loop_iof: DO iof = 0, klon - kdlon, kdlon
205 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 end DO loop_iof
370
371 END SUBROUTINE radlwsw
372
373 end module radlwsw_m

  ViewVC Help
Powered by ViewVC 1.1.21