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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 212 - (show annotations)
Thu Jan 12 12:31:31 2017 UTC (7 years, 5 months ago) by guez
File size: 13060 byte(s)
Moved variables from module com_io_dyn to module inithist_m, where
they are defined.

Split grid_atob.f into grille_m.f and dist_sphe.f. Extracted ASCCI art
to documentation. In grille_m, use automatic arrays instead of maximum
size. In grille_m, instead of printing data for every problematic
point, print a single diagnostic message.

Removed variables top_height, overlap, lev_histhf, lev_histday,
lev_histmth, type_run, ok_isccp, ok_regdyn, lonmin_ins, lonmax_ins,
latmin_ins, latmax_ins of module clesphys, not used.

Removed variable itap of module histwrite_phy_m, not used. There is a
variable itap in module time_phylmdz.

Added output of tro3.

In physiq, no need to compute wo at every time-step, since we only use
it in radlwsw.

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

  ViewVC Help
Powered by ViewVC 1.1.21