/[lmdze]/trunk/Sources/phylmd/clqh.f
ViewVC logotype

Contents of /trunk/Sources/phylmd/clqh.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 206 - (show annotations)
Tue Aug 30 12:52:46 2016 UTC (7 years, 7 months ago) by guez
File size: 9595 byte(s)
Removed dimension klev of flux_[tquv] and y_flux_[tquv] in
clmain. Removed dimension klev of flux_[tquv] in physiq. Removed
dimension klev of flux_[tq] in hbtm. Removed dimension klev of
flux_[tq] in clqh and computations for layers other than the surface
layer. Removed dimension klev of flux_v in clvent and computations for
layers other than the surface layer. Values for layers other than the
surface layer were not used nor output (not even in LMDZ).

Removed argument dnwd0 of concvl. Simply write - mp in physiq
(following LMDZ).

Removed useless intermediary variables zxflux[tquv] in physiq.

1 module clqh_m
2
3 IMPLICIT none
4
5 contains
6
7 SUBROUTINE clqh(dtime, jour, debut, rlat, nisurf, knindex, tsoil, qsol, &
8 rmu0, rugos, rugoro, u1lay, v1lay, coef, t, q, ts, paprs, pplay, delp, &
9 radsol, albedo, snow, qsurf, precip_rain, precip_snow, fder, fluxlat, &
10 pctsrf_new_sic, agesno, d_t, d_q, d_ts, z0_new, flux_t, flux_q, &
11 dflux_s, dflux_l, fqcalving, ffonte, run_off_lic_0)
12
13 ! Author: Z. X. Li (LMD/CNRS)
14 ! Date: 1993/08/18
15 ! Objet : diffusion verticale de "q" et de "h"
16
17 USE conf_phys_m, ONLY: iflag_pbl
18 USE dimphy, ONLY: klev, klon
19 USE dimsoil, ONLY: nsoilmx
20 USE indicesol, ONLY: nbsrf
21 USE interfsurf_hq_m, ONLY: interfsurf_hq
22 USE suphec_m, ONLY: rcpd, rd, rg, rkappa
23
24 REAL, intent(in):: dtime ! intervalle du temps (s)
25 integer, intent(in):: jour ! jour de l'annee en cours
26 logical, intent(in):: debut
27 real, intent(in):: rlat(klon)
28 integer, intent(in):: nisurf
29 integer, intent(in):: knindex(:) ! (knon)
30
31 REAL tsoil(klon, nsoilmx)
32
33 REAL, intent(inout):: qsol(klon)
34 ! column-density of water in soil, in kg m-2
35
36 real, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal
37 real rugos(klon) ! rugosite
38 REAL rugoro(klon)
39 REAL u1lay(klon) ! vitesse u de la 1ere couche (m / s)
40 REAL v1lay(klon) ! vitesse v de la 1ere couche (m / s)
41
42 REAL, intent(in):: coef(:, :) ! (knon, klev)
43 ! Le coefficient d'echange (m**2 / s) multiplie par le cisaillement
44 ! du vent (dV / dz). La premiere valeur indique la valeur de Cdrag
45 ! (sans unite).
46
47 REAL t(klon, klev) ! temperature (K)
48 REAL q(klon, klev) ! humidite specifique (kg / kg)
49 REAL, intent(in):: ts(klon) ! temperature du sol (K)
50 REAL paprs(klon, klev+1) ! pression a inter-couche (Pa)
51 REAL pplay(klon, klev) ! pression au milieu de couche (Pa)
52 REAL delp(klon, klev) ! epaisseur de couche en pression (Pa)
53 REAL radsol(klon) ! ray. net au sol (Solaire+IR) W / m2
54 REAL, intent(inout):: albedo(:) ! (knon) albedo de la surface
55 REAL, intent(inout):: snow(klon) ! hauteur de neige
56 REAL qsurf(klon) ! humidite de l'air au dessus de la surface
57
58 real, intent(in):: precip_rain(klon)
59 ! liquid water mass flux (kg / m2 / s), positive down
60
61 real, intent(in):: precip_snow(klon)
62 ! solid water mass flux (kg / m2 / s), positive down
63
64 real, intent(inout):: fder(klon)
65 real fluxlat(klon)
66 real, intent(in):: pctsrf_new_sic(:) ! (klon)
67 REAL, intent(inout):: agesno(:) ! (knon)
68 REAL d_t(klon, klev) ! incrementation de "t"
69 REAL d_q(klon, klev) ! incrementation de "q"
70 REAL, intent(out):: d_ts(:) ! (knon) incrementation de "ts"
71 real z0_new(klon)
72
73 REAL, intent(out):: flux_t(:) ! (knon)
74 ! (diagnostic) flux de chaleur sensible (Cp T) à la surface,
75 ! positif vers le bas, W / m2
76
77 REAL, intent(out):: flux_q(:) ! (knon)
78 ! flux de la vapeur d'eau à la surface, en kg / (m**2 s)
79
80 REAL dflux_s(klon) ! derivee du flux sensible dF / dTs
81 REAL dflux_l(klon) ! derivee du flux latent dF / dTs
82
83 ! Flux d'eau "perdue" par la surface et n\'ecessaire pour que limiter la
84 ! hauteur de neige, en kg / m2 / s
85 REAL fqcalving(klon)
86
87 ! Flux thermique utiliser pour fondre la neige
88 REAL ffonte(klon)
89
90 REAL run_off_lic_0(klon)! runof glacier au pas de temps precedent
91
92 ! Local:
93
94 INTEGER knon
95 REAL evap(size(knindex)) ! (knon) evaporation au sol
96
97 INTEGER i, k
98 REAL zx_cq(klon, klev)
99 REAL zx_dq(klon, klev)
100 REAL zx_ch(klon, klev)
101 REAL zx_dh(klon, klev)
102 REAL zx_buf1(klon)
103 REAL zx_buf2(klon)
104 REAL zx_coef(klon, klev)
105 REAL local_h(klon, klev) ! enthalpie potentielle
106 REAL local_q(klon, klev)
107 REAL psref(klon) ! pression de reference pour temperature potent.
108 REAL zx_pkh(klon, klev), zx_pkf(klon, klev)
109
110 ! contre-gradient pour la vapeur d'eau: (kg / kg) / metre
111 REAL gamq(klon, 2:klev)
112 ! contre-gradient pour la chaleur sensible: Kelvin / metre
113 REAL gamt(klon, 2:klev)
114 REAL z_gamaq(klon, 2:klev), z_gamah(klon, 2:klev)
115 REAL zdelz
116
117 real temp_air(klon), spechum(klon)
118 real tq_cdrag(klon), petAcoef(klon), peqAcoef(klon)
119 real petBcoef(klon), peqBcoef(klon)
120 real p1lay(klon)
121
122 real tsurf_new(size(knindex)) ! (knon)
123 real zzpk
124
125 !----------------------------------------------------------------
126
127 knon = size(knindex)
128
129 if (iflag_pbl == 1) then
130 do k = 3, klev
131 do i = 1, knon
132 gamq(i, k)= 0.0
133 gamt(i, k)= - 1.0e-03
134 enddo
135 enddo
136 do i = 1, knon
137 gamq(i, 2) = 0.0
138 gamt(i, 2) = - 2.5e-03
139 enddo
140 else
141 do k = 2, klev
142 do i = 1, knon
143 gamq(i, k) = 0.0
144 gamt(i, k) = 0.0
145 enddo
146 enddo
147 endif
148
149 DO i = 1, knon
150 psref(i) = paprs(i, 1) !pression de reference est celle au sol
151 ENDDO
152 DO k = 1, klev
153 DO i = 1, knon
154 zx_pkh(i, k) = (psref(i) / paprs(i, k))**RKAPPA
155 zx_pkf(i, k) = (psref(i) / pplay(i, k))**RKAPPA
156 local_h(i, k) = RCPD * t(i, k) * zx_pkf(i, k)
157 local_q(i, k) = q(i, k)
158 ENDDO
159 ENDDO
160
161 ! Convertir les coefficients en variables convenables au calcul:
162
163 DO k = 2, klev
164 DO i = 1, knon
165 zx_coef(i, k) = coef(i, k) * RG / (pplay(i, k - 1) - pplay(i, k)) &
166 * (paprs(i, k) * 2 / (t(i, k)+t(i, k - 1)) / RD)**2
167 zx_coef(i, k) = zx_coef(i, k) * dtime * RG
168 ENDDO
169 ENDDO
170
171 ! Preparer les flux lies aux contre-gardients
172
173 DO k = 2, klev
174 DO i = 1, knon
175 zdelz = RD * (t(i, k - 1)+t(i, k)) / 2.0 / RG / paprs(i, k) &
176 * (pplay(i, k - 1) - pplay(i, k))
177 z_gamaq(i, k) = gamq(i, k) * zdelz
178 z_gamah(i, k) = gamt(i, k) * zdelz * RCPD * zx_pkh(i, k)
179 ENDDO
180 ENDDO
181 DO i = 1, knon
182 zx_buf1(i) = zx_coef(i, klev) + delp(i, klev)
183 zx_cq(i, klev) = (local_q(i, klev) * delp(i, klev) &
184 - zx_coef(i, klev) * z_gamaq(i, klev)) / zx_buf1(i)
185 zx_dq(i, klev) = zx_coef(i, klev) / zx_buf1(i)
186
187 zzpk=(pplay(i, klev) / psref(i))**RKAPPA
188 zx_buf2(i) = zzpk * delp(i, klev) + zx_coef(i, klev)
189 zx_ch(i, klev) = (local_h(i, klev) * zzpk * delp(i, klev) &
190 - zx_coef(i, klev) * z_gamah(i, klev)) / zx_buf2(i)
191 zx_dh(i, klev) = zx_coef(i, klev) / zx_buf2(i)
192 ENDDO
193 DO k = klev - 1, 2, - 1
194 DO i = 1, knon
195 zx_buf1(i) = delp(i, k)+zx_coef(i, k) &
196 +zx_coef(i, k+1) * (1. - zx_dq(i, k+1))
197 zx_cq(i, k) = (local_q(i, k) * delp(i, k) &
198 +zx_coef(i, k+1) * zx_cq(i, k+1) &
199 +zx_coef(i, k+1) * z_gamaq(i, k+1) &
200 - zx_coef(i, k) * z_gamaq(i, k)) / zx_buf1(i)
201 zx_dq(i, k) = zx_coef(i, k) / zx_buf1(i)
202
203 zzpk=(pplay(i, k) / psref(i))**RKAPPA
204 zx_buf2(i) = zzpk * delp(i, k)+zx_coef(i, k) &
205 +zx_coef(i, k+1) * (1. - zx_dh(i, k+1))
206 zx_ch(i, k) = (local_h(i, k) * zzpk * delp(i, k) &
207 +zx_coef(i, k+1) * zx_ch(i, k+1) &
208 +zx_coef(i, k+1) * z_gamah(i, k+1) &
209 - zx_coef(i, k) * z_gamah(i, k)) / zx_buf2(i)
210 zx_dh(i, k) = zx_coef(i, k) / zx_buf2(i)
211 ENDDO
212 ENDDO
213
214 DO i = 1, knon
215 zx_buf1(i) = delp(i, 1) + zx_coef(i, 2) * (1. - zx_dq(i, 2))
216 zx_cq(i, 1) = (local_q(i, 1) * delp(i, 1) &
217 +zx_coef(i, 2) * (z_gamaq(i, 2)+zx_cq(i, 2))) &
218 / zx_buf1(i)
219 zx_dq(i, 1) = - 1. * RG / zx_buf1(i)
220
221 zzpk=(pplay(i, 1) / psref(i))**RKAPPA
222 zx_buf2(i) = zzpk * delp(i, 1) + zx_coef(i, 2) * (1. - zx_dh(i, 2))
223 zx_ch(i, 1) = (local_h(i, 1) * zzpk * delp(i, 1) &
224 +zx_coef(i, 2) * (z_gamah(i, 2)+zx_ch(i, 2))) &
225 / zx_buf2(i)
226 zx_dh(i, 1) = - 1. * RG / zx_buf2(i)
227 ENDDO
228
229 ! Appel a interfsurf (appel generique) routine d'interface avec la surface
230
231 ! initialisation
232 petAcoef =0.
233 peqAcoef = 0.
234 petBcoef =0.
235 peqBcoef = 0.
236 p1lay =0.
237
238 petAcoef(1:knon) = zx_ch(1:knon, 1)
239 peqAcoef(1:knon) = zx_cq(1:knon, 1)
240 petBcoef(1:knon) = zx_dh(1:knon, 1)
241 peqBcoef(1:knon) = zx_dq(1:knon, 1)
242 tq_cdrag(1:knon) =coef(:knon, 1)
243 temp_air(1:knon) =t(1:knon, 1)
244 spechum(1:knon)=q(1:knon, 1)
245 p1lay(1:knon) = pplay(1:knon, 1)
246
247 CALL interfsurf_hq(dtime, jour, rmu0, nisurf, knon, knindex, rlat, debut, &
248 nsoilmx, tsoil, qsol, u1lay, v1lay, temp_air, spechum, tq_cdrag, &
249 petAcoef, peqAcoef, petBcoef, peqBcoef, precip_rain, precip_snow, &
250 fder, rugos, rugoro, snow, qsurf, ts(:knon), p1lay, psref, radsol, &
251 evap, flux_t, fluxlat, dflux_l, dflux_s, tsurf_new, albedo, &
252 z0_new, pctsrf_new_sic, agesno, fqcalving, ffonte, run_off_lic_0)
253
254 flux_q = - evap
255 d_ts = tsurf_new - ts(:knon)
256
257 !==== une fois on a zx_h_ts, on peut faire l'iteration ========
258 DO i = 1, knon
259 local_h(i, 1) = zx_ch(i, 1) + zx_dh(i, 1) * flux_t(i) * dtime
260 local_q(i, 1) = zx_cq(i, 1) + zx_dq(i, 1) * flux_q(i) * dtime
261 ENDDO
262 DO k = 2, klev
263 DO i = 1, knon
264 local_q(i, k) = zx_cq(i, k) + zx_dq(i, k) * local_q(i, k - 1)
265 local_h(i, k) = zx_ch(i, k) + zx_dh(i, k) * local_h(i, k - 1)
266 ENDDO
267 ENDDO
268
269 ! Calcul tendances
270 DO k = 1, klev
271 DO i = 1, knon
272 d_t(i, k) = local_h(i, k) / zx_pkf(i, k) / RCPD - t(i, k)
273 d_q(i, k) = local_q(i, k) - q(i, k)
274 ENDDO
275 ENDDO
276
277 END SUBROUTINE clqh
278
279 end module clqh_m

  ViewVC Help
Powered by ViewVC 1.1.21