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

Annotation of /trunk/Sources/phylmd/clmain.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 226 - (hide annotations)
Mon Oct 16 13:04:05 2017 UTC (6 years, 5 months ago) by guez
File size: 20305 byte(s)
In clmain, u1lay and v1lay do not depend on the subsurface. So output
values of zu1 and zv1 are simply u(:, 1) and v(:, 1). Just remove the
corresponding computations from clmain and define yu1 and yv1 in physiq.

1 guez 38 module clmain_m
2 guez 3
3 guez 38 IMPLICIT NONE
4 guez 3
5 guez 38 contains
6 guez 3
7 guez 221 SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &
8 guez 215 cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &
9 guez 223 qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, &
10     agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &
11 guez 226 flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, t2m, q2m, &
12     u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &
13     trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
14 guez 3
15 guez 99 ! From phylmd/clmain.F, version 1.6, 2005/11/16 14:47:19
16 guez 62 ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18
17     ! Objet : interface de couche limite (diffusion verticale)
18 guez 3
19 guez 62 ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul
20     ! de la couche limite pour les traceurs se fait avec "cltrac" et
21 guez 145 ! ne tient pas compte de la diff\'erentiation des sous-fractions
22     ! de sol.
23 guez 3
24 guez 49 use clqh_m, only: clqh
25 guez 62 use clvent_m, only: clvent
26 guez 47 use coefkz_m, only: coefkz
27     use coefkzmin_m, only: coefkzmin
28 guez 202 USE conf_gcm_m, ONLY: prt_level, lmt_pas
29 guez 62 USE conf_phys_m, ONLY: iflag_pbl
30     USE dimphy, ONLY: klev, klon, zmasq
31     USE dimsoil, ONLY: nsoilmx
32 guez 47 use hbtm_m, only: hbtm
33 guez 62 USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
34 guez 202 USE interfoce_lim_m, ONLY: interfoce_lim
35 guez 104 use stdlevvar_m, only: stdlevvar
36 guez 62 USE suphec_m, ONLY: rd, rg, rkappa
37 guez 202 use time_phylmdz, only: itap
38 guez 62 use ustarhb_m, only: ustarhb
39     use vdif_kcay_m, only: vdif_kcay
40 guez 47 use yamada4_m, only: yamada4
41 guez 15
42 guez 62 REAL, INTENT(IN):: dtime ! interval du temps (secondes)
43 guez 202
44 guez 62 REAL, INTENT(inout):: pctsrf(klon, nbsrf)
45 guez 202 ! tableau des pourcentages de surface de chaque maille
46 guez 62
47     REAL, INTENT(IN):: t(klon, klev) ! temperature (K)
48 guez 225 REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg / kg)
49 guez 62 REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
50 guez 221 INTEGER, INTENT(IN):: julien ! jour de l'annee en cours
51 guez 213 REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal
52 guez 222 REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)
53 guez 71 REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
54 guez 99 REAL, INTENT(IN):: ksta, ksta_ter
55     LOGICAL, INTENT(IN):: ok_kzmin
56 guez 101
57 guez 118 REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
58     ! soil temperature of surface fraction
59    
60 guez 225 REAL, INTENT(inout):: qsol(:) ! (klon)
61 guez 101 ! column-density of water in soil, in kg m-2
62    
63 guez 225 REAL, INTENT(IN):: paprs(klon, klev + 1) ! pression a intercouche (Pa)
64 guez 62 REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
65 guez 215 REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
66 guez 70 REAL qsurf(klon, nbsrf)
67     REAL evap(klon, nbsrf)
68 guez 155 REAL, intent(inout):: falbe(klon, nbsrf)
69 guez 214 REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
70 guez 70
71 guez 101 REAL, intent(in):: rain_fall(klon)
72 guez 225 ! liquid water mass flux (kg / m2 / s), positive down
73 guez 101
74     REAL, intent(in):: snow_f(klon)
75 guez 225 ! solid water mass flux (kg / m2 / s), positive down
76 guez 101
77 guez 222 REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)
78     REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
79 guez 70 real agesno(klon, nbsrf)
80     REAL, INTENT(IN):: rugoro(klon)
81    
82 guez 38 REAL d_t(klon, klev), d_q(klon, klev)
83 guez 49 ! d_t------output-R- le changement pour "t"
84     ! d_q------output-R- le changement pour "q"
85 guez 62
86     REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
87     ! changement pour "u" et "v"
88    
89 guez 221 REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
90 guez 70
91 guez 206 REAL, intent(out):: flux_t(klon, nbsrf)
92 guez 225 ! flux de chaleur sensible (Cp T) (W / m2) (orientation positive vers
93 guez 206 ! le bas) à la surface
94 guez 70
95 guez 206 REAL, intent(out):: flux_q(klon, nbsrf)
96 guez 225 ! flux de vapeur d'eau (kg / m2 / s) à la surface
97 guez 70
98 guez 206 REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
99     ! tension du vent à la surface, en Pa
100    
101 guez 70 REAL, INTENT(out):: cdragh(klon), cdragm(klon)
102 guez 225 real q2(klon, klev + 1, nbsrf)
103 guez 70
104 guez 99 REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
105 guez 49 ! dflux_t derive du flux sensible
106     ! dflux_q derive du flux latent
107 guez 191 ! IM "slab" ocean
108 guez 70
109     REAL, intent(out):: ycoefh(klon, klev)
110 guez 226 ! Pour pouvoir extraire les coefficients d'\'echange, le champ
111     ! "ycoefh" a \'et\'e cr\'e\'e. Nous avons moyenn\'e les valeurs de
112     ! ce champ sur les quatre sous-surfaces du mod\`ele.
113    
114 guez 221 REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
115 guez 70
116 guez 225 REAL, INTENT(inout):: u10m_srf(:, :), v10m_srf(:, :) ! (klon, nbsrf)
117     ! composantes du vent \`a 10m sans spirale d'Ekman
118    
119     ! Ionela Musat. Cf. Anne Mathieu : planetary boundary layer, hbtm.
120     ! Comme les autres diagnostics on cumule dans physiq ce qui permet
121     ! de sortir les grandeurs par sous-surface.
122 guez 191 REAL pblh(klon, nbsrf) ! height of planetary boundary layer
123 guez 70 REAL capcl(klon, nbsrf)
124     REAL oliqcl(klon, nbsrf)
125     REAL cteicl(klon, nbsrf)
126 guez 221 REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
127 guez 70 REAL therm(klon, nbsrf)
128     REAL trmb1(klon, nbsrf)
129     ! trmb1-------deep_cape
130     REAL trmb2(klon, nbsrf)
131     ! trmb2--------inhibition
132     REAL trmb3(klon, nbsrf)
133     ! trmb3-------Point Omega
134     REAL plcl(klon, nbsrf)
135     REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
136     ! ffonte----Flux thermique utilise pour fondre la neige
137     ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la
138 guez 225 ! hauteur de neige, en kg / m2 / s
139 guez 70 REAL run_off_lic_0(klon)
140    
141     ! Local:
142 guez 15
143 guez 202 LOGICAL:: firstcal = .true.
144    
145     ! la nouvelle repartition des surfaces sortie de l'interface
146     REAL, save:: pctsrf_new_oce(klon)
147     REAL, save:: pctsrf_new_sic(klon)
148    
149 guez 70 REAL y_fqcalving(klon), y_ffonte(klon)
150     real y_run_off_lic_0(klon)
151     REAL rugmer(klon)
152 guez 38 REAL ytsoil(klon, nsoilmx)
153     REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
154     REAL yalb(klon)
155 guez 215
156 guez 225 REAL u1lay(klon), v1lay(klon) ! vent dans la premi\`ere couche, pour
157     ! une sous-surface donnée
158 guez 215
159     REAL snow(klon), yqsurf(klon), yagesno(klon)
160 guez 225 real yqsol(klon) ! column-density of water in soil, in kg m-2
161     REAL yrain_f(klon) ! liquid water mass flux (kg / m2 / s), positive down
162     REAL ysnow_f(klon) ! solid water mass flux (kg / m2 / s), positive down
163 guez 38 REAL yrugm(klon), yrads(klon), yrugoro(klon)
164     REAL yfluxlat(klon)
165     REAL y_d_ts(klon)
166     REAL y_d_t(klon, klev), y_d_q(klon, klev)
167     REAL y_d_u(klon, klev), y_d_v(klon, klev)
168 guez 206 REAL y_flux_t(klon), y_flux_q(klon)
169     REAL y_flux_u(klon), y_flux_v(klon)
170 guez 38 REAL y_dflux_t(klon), y_dflux_q(klon)
171 guez 62 REAL coefh(klon, klev), coefm(klon, klev)
172 guez 38 REAL yu(klon, klev), yv(klon, klev)
173     REAL yt(klon, klev), yq(klon, klev)
174 guez 225 REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
175 guez 15
176 guez 38 REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
177 guez 15
178 guez 225 REAL yzlay(klon, klev), yzlev(klon, klev + 1), yteta(klon, klev)
179     REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
180     REAL ykmq(klon, klev + 1)
181     REAL yq2(klon, klev + 1)
182     REAL q2diag(klon, klev + 1)
183 guez 15
184 guez 38 REAL delp(klon, klev)
185     INTEGER i, k, nsrf
186 guez 15
187 guez 38 INTEGER ni(klon), knon, j
188 guez 40
189 guez 38 REAL pctsrf_pot(klon, nbsrf)
190 guez 145 ! "pourcentage potentiel" pour tenir compte des \'eventuelles
191 guez 40 ! apparitions ou disparitions de la glace de mer
192 guez 15
193 guez 38 REAL yt2m(klon), yq2m(klon), yu10m(klon)
194     REAL yustar(klon)
195 guez 15
196 guez 38 REAL yt10m(klon), yq10m(klon)
197     REAL ypblh(klon)
198     REAL ylcl(klon)
199     REAL ycapcl(klon)
200     REAL yoliqcl(klon)
201     REAL ycteicl(klon)
202     REAL ypblt(klon)
203     REAL ytherm(klon)
204     REAL ytrmb1(klon)
205     REAL ytrmb2(klon)
206     REAL ytrmb3(klon)
207     REAL uzon(klon), vmer(klon)
208     REAL tair1(klon), qair1(klon), tairsol(klon)
209     REAL psfce(klon), patm(klon)
210 guez 15
211 guez 38 REAL qairsol(klon), zgeo1(klon)
212     REAL rugo1(klon)
213 guez 15
214 guez 38 ! utiliser un jeu de fonctions simples
215     LOGICAL zxli
216     PARAMETER (zxli=.FALSE.)
217 guez 15
218 guez 38 !------------------------------------------------------------
219 guez 15
220 guez 38 ytherm = 0.
221 guez 15
222 guez 38 DO k = 1, klev ! epaisseur de couche
223     DO i = 1, klon
224 guez 225 delp(i, k) = paprs(i, k) - paprs(i, k + 1)
225 guez 38 END DO
226     END DO
227 guez 15
228 guez 40 ! Initialization:
229     rugmer = 0.
230     cdragh = 0.
231     cdragm = 0.
232     dflux_t = 0.
233     dflux_q = 0.
234     ypct = 0.
235     yqsurf = 0.
236     yrain_f = 0.
237     ysnow_f = 0.
238     yrugos = 0.
239     ypaprs = 0.
240     ypplay = 0.
241     ydelp = 0.
242     yu = 0.
243     yv = 0.
244     yt = 0.
245     yq = 0.
246     y_dflux_t = 0.
247     y_dflux_q = 0.
248 guez 38 yrugoro = 0.
249 guez 40 d_ts = 0.
250 guez 38 flux_t = 0.
251     flux_q = 0.
252     flux_u = 0.
253     flux_v = 0.
254 guez 214 fluxlat = 0.
255 guez 40 d_t = 0.
256     d_q = 0.
257     d_u = 0.
258     d_v = 0.
259 guez 70 ycoefh = 0.
260 guez 15
261 guez 145 ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
262     ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
263     ! (\`a affiner)
264 guez 15
265 guez 202 pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
266     pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
267 guez 38 pctsrf_pot(:, is_oce) = 1. - zmasq
268     pctsrf_pot(:, is_sic) = 1. - zmasq
269 guez 15
270 guez 202 ! Tester si c'est le moment de lire le fichier:
271     if (mod(itap - 1, lmt_pas) == 0) then
272 guez 221 CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
273 guez 202 endif
274    
275 guez 99 ! Boucler sur toutes les sous-fractions du sol:
276    
277 guez 49 loop_surface: DO nsrf = 1, nbsrf
278     ! Chercher les indices :
279 guez 38 ni = 0
280     knon = 0
281     DO i = 1, klon
282 guez 145 ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
283 guez 38 ! "potentielles"
284     IF (pctsrf_pot(i, nsrf) > epsfra) THEN
285     knon = knon + 1
286     ni(knon) = i
287     END IF
288     END DO
289 guez 15
290 guez 62 if_knon: IF (knon /= 0) then
291 guez 38 DO j = 1, knon
292     i = ni(j)
293 guez 62 ypct(j) = pctsrf(i, nsrf)
294 guez 207 yts(j) = ftsol(i, nsrf)
295 guez 215 snow(j) = fsnow(i, nsrf)
296 guez 62 yqsurf(j) = qsurf(i, nsrf)
297 guez 155 yalb(j) = falbe(i, nsrf)
298 guez 62 yrain_f(j) = rain_fall(i)
299     ysnow_f(j) = snow_f(i)
300     yagesno(j) = agesno(i, nsrf)
301 guez 222 yrugos(j) = frugs(i, nsrf)
302 guez 62 yrugoro(j) = rugoro(i)
303 guez 225 u1lay(j) = u(i, 1)
304     v1lay(j) = v(i, 1)
305 guez 222 yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
306 guez 225 ypaprs(j, klev + 1) = paprs(i, klev + 1)
307 guez 62 y_run_off_lic_0(j) = run_off_lic_0(i)
308 guez 38 END DO
309 guez 3
310 guez 99 ! For continent, copy soil water content
311 guez 225 IF (nsrf == is_ter) yqsol(:knon) = qsol(ni(:knon))
312 guez 3
313 guez 208 ytsoil(:knon, :) = ftsoil(ni(:knon), :, nsrf)
314 guez 3
315 guez 38 DO k = 1, klev
316     DO j = 1, knon
317     i = ni(j)
318 guez 62 ypaprs(j, k) = paprs(i, k)
319     ypplay(j, k) = pplay(i, k)
320     ydelp(j, k) = delp(i, k)
321     yu(j, k) = u(i, k)
322     yv(j, k) = v(i, k)
323     yt(j, k) = t(i, k)
324     yq(j, k) = q(i, k)
325 guez 38 END DO
326     END DO
327 guez 3
328 guez 62 ! calculer Cdrag et les coefficients d'echange
329 guez 221 CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
330     yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
331     coefh(:knon, :))
332 guez 62 IF (iflag_pbl == 1) THEN
333     CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
334     coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
335     coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
336     END IF
337 guez 3
338 guez 70 ! on met un seuil pour coefm et coefh
339 guez 62 IF (nsrf == is_oce) THEN
340     coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)
341     coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)
342 guez 38 END IF
343 guez 3
344 guez 62 IF (ok_kzmin) THEN
345     ! Calcul d'une diffusion minimale pour les conditions tres stables
346     CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
347 guez 70 coefm(:knon, 1), ycoefm0, ycoefh0)
348 guez 62 coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
349     coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
350 guez 98 END IF
351 guez 3
352 guez 62 IF (iflag_pbl >= 3) THEN
353 guez 145 ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
354     ! Fr\'ed\'eric Hourdin
355 guez 62 yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
356     + ypplay(:knon, 1))) &
357     * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
358     DO k = 2, klev
359     yzlay(1:knon, k) = yzlay(1:knon, k-1) &
360     + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &
361     / ypaprs(1:knon, k) &
362     * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
363     END DO
364     DO k = 1, klev
365 guez 225 yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
366     / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
367 guez 62 END DO
368     yzlev(1:knon, 1) = 0.
369 guez 225 yzlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
370 guez 62 - yzlay(:knon, klev - 1)
371     DO k = 2, klev
372 guez 225 yzlev(1:knon, k) = 0.5 * (yzlay(1:knon, k) + yzlay(1:knon, k-1))
373 guez 62 END DO
374     DO k = 1, klev + 1
375     DO j = 1, knon
376     i = ni(j)
377     yq2(j, k) = q2(i, k, nsrf)
378     END DO
379     END DO
380    
381     CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
382 guez 99 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
383 guez 62
384 guez 145 ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
385 guez 62
386     IF (iflag_pbl >= 11) THEN
387 guez 145 CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
388     yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
389     iflag_pbl)
390 guez 62 ELSE
391     CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
392     coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
393     END IF
394    
395     coefm(:knon, 2:) = ykmm(:knon, 2:klev)
396     coefh(:knon, 2:) = ykmn(:knon, 2:klev)
397 guez 38 END IF
398 guez 3
399 guez 62 ! calculer la diffusion des vitesses "u" et "v"
400 guez 225 CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &
401     coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &
402     y_flux_u(:knon))
403     CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &
404     coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &
405     y_flux_v(:knon))
406 guez 3
407 guez 62 ! calculer la diffusion de "q" et de "h"
408 guez 221 CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
409 guez 225 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
410     u1lay(:knon), v1lay(:knon), coefh(:knon, :), yt, yq, &
411     yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &
412     snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &
413     pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
414     yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &
415     y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)
416 guez 3
417 guez 62 ! calculer la longueur de rugosite sur ocean
418     yrugm = 0.
419     IF (nsrf == is_oce) THEN
420     DO j = 1, knon
421 guez 225 yrugm(j) = 0.018 * coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2) &
422     / rg + 0.11 * 14E-6 &
423     / sqrt(coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2))
424 guez 62 yrugm(j) = max(1.5E-05, yrugm(j))
425     END DO
426     END IF
427 guez 38 DO j = 1, knon
428 guez 225 y_dflux_t(j) = y_dflux_t(j) * ypct(j)
429     y_dflux_q(j) = y_dflux_q(j) * ypct(j)
430 guez 38 END DO
431 guez 3
432 guez 62 DO k = 1, klev
433     DO j = 1, knon
434     i = ni(j)
435 guez 225 coefh(j, k) = coefh(j, k) * ypct(j)
436     coefm(j, k) = coefm(j, k) * ypct(j)
437     y_d_t(j, k) = y_d_t(j, k) * ypct(j)
438     y_d_q(j, k) = y_d_q(j, k) * ypct(j)
439     y_d_u(j, k) = y_d_u(j, k) * ypct(j)
440     y_d_v(j, k) = y_d_v(j, k) * ypct(j)
441 guez 62 END DO
442 guez 38 END DO
443 guez 3
444 guez 214 flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
445     flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
446     flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
447     flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
448 guez 15
449 guez 206 evap(:, nsrf) = -flux_q(:, nsrf)
450    
451 guez 155 falbe(:, nsrf) = 0.
452 guez 215 fsnow(:, nsrf) = 0.
453 guez 62 qsurf(:, nsrf) = 0.
454 guez 222 frugs(:, nsrf) = 0.
455 guez 38 DO j = 1, knon
456     i = ni(j)
457 guez 62 d_ts(i, nsrf) = y_d_ts(j)
458 guez 155 falbe(i, nsrf) = yalb(j)
459 guez 215 fsnow(i, nsrf) = snow(j)
460 guez 62 qsurf(i, nsrf) = yqsurf(j)
461 guez 222 frugs(i, nsrf) = yz0_new(j)
462 guez 62 fluxlat(i, nsrf) = yfluxlat(j)
463     IF (nsrf == is_oce) THEN
464     rugmer(i) = yrugm(j)
465 guez 222 frugs(i, nsrf) = yrugm(j)
466 guez 62 END IF
467     agesno(i, nsrf) = yagesno(j)
468     fqcalving(i, nsrf) = y_fqcalving(j)
469     ffonte(i, nsrf) = y_ffonte(j)
470     cdragh(i) = cdragh(i) + coefh(j, 1)
471     cdragm(i) = cdragm(i) + coefm(j, 1)
472     dflux_t(i) = dflux_t(i) + y_dflux_t(j)
473     dflux_q(i) = dflux_q(i) + y_dflux_q(j)
474 guez 38 END DO
475 guez 62 IF (nsrf == is_ter) THEN
476 guez 99 qsol(ni(:knon)) = yqsol(:knon)
477     else IF (nsrf == is_lic) THEN
478 guez 62 DO j = 1, knon
479     i = ni(j)
480     run_off_lic_0(i) = y_run_off_lic_0(j)
481     END DO
482     END IF
483 guez 118
484 guez 62 ftsoil(:, :, nsrf) = 0.
485 guez 208 ftsoil(ni(:knon), :, nsrf) = ytsoil(:knon, :)
486 guez 62
487 guez 38 DO j = 1, knon
488     i = ni(j)
489 guez 62 DO k = 1, klev
490     d_t(i, k) = d_t(i, k) + y_d_t(j, k)
491     d_q(i, k) = d_q(i, k) + y_d_q(j, k)
492     d_u(i, k) = d_u(i, k) + y_d_u(j, k)
493     d_v(i, k) = d_v(i, k) + y_d_v(j, k)
494 guez 70 ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)
495 guez 62 END DO
496 guez 38 END DO
497 guez 62
498 guez 99 ! diagnostic t, q a 2m et u, v a 10m
499 guez 62
500 guez 38 DO j = 1, knon
501     i = ni(j)
502 guez 62 uzon(j) = yu(j, 1) + y_d_u(j, 1)
503     vmer(j) = yv(j, 1) + y_d_v(j, 1)
504     tair1(j) = yt(j, 1) + y_d_t(j, 1)
505     qair1(j) = yq(j, 1) + y_d_q(j, 1)
506 guez 225 zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &
507     1))) * (ypaprs(j, 1)-ypplay(j, 1))
508 guez 62 tairsol(j) = yts(j) + y_d_ts(j)
509     rugo1(j) = yrugos(j)
510     IF (nsrf == is_oce) THEN
511 guez 222 rugo1(j) = frugs(i, nsrf)
512 guez 62 END IF
513     psfce(j) = ypaprs(j, 1)
514     patm(j) = ypplay(j, 1)
515 guez 15
516 guez 62 qairsol(j) = yqsurf(j)
517 guez 38 END DO
518 guez 15
519 guez 225 CALL stdlevvar(klon, knon, nsrf, zxli, uzon(:knon), vmer(:knon), &
520     tair1, qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, &
521     yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
522 guez 3
523 guez 62 DO j = 1, knon
524     i = ni(j)
525     t2m(i, nsrf) = yt2m(j)
526     q2m(i, nsrf) = yq2m(j)
527 guez 3
528 guez 225 u10m_srf(i, nsrf) = (yu10m(j) * uzon(j)) &
529     / sqrt(uzon(j)**2 + vmer(j)**2)
530     v10m_srf(i, nsrf) = (yu10m(j) * vmer(j)) &
531     / sqrt(uzon(j)**2 + vmer(j)**2)
532 guez 62 END DO
533 guez 15
534 guez 206 CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
535     y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
536     yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
537 guez 15
538 guez 38 DO j = 1, knon
539     i = ni(j)
540 guez 62 pblh(i, nsrf) = ypblh(j)
541     plcl(i, nsrf) = ylcl(j)
542     capcl(i, nsrf) = ycapcl(j)
543     oliqcl(i, nsrf) = yoliqcl(j)
544     cteicl(i, nsrf) = ycteicl(j)
545     pblt(i, nsrf) = ypblt(j)
546     therm(i, nsrf) = ytherm(j)
547     trmb1(i, nsrf) = ytrmb1(j)
548     trmb2(i, nsrf) = ytrmb2(j)
549     trmb3(i, nsrf) = ytrmb3(j)
550 guez 38 END DO
551 guez 3
552 guez 38 DO j = 1, knon
553 guez 62 DO k = 1, klev + 1
554     i = ni(j)
555     q2(i, k, nsrf) = yq2(j, k)
556     END DO
557 guez 38 END DO
558 guez 215 else
559     fsnow(:, nsrf) = 0.
560 guez 62 end IF if_knon
561 guez 49 END DO loop_surface
562 guez 15
563 guez 38 ! On utilise les nouvelles surfaces
564 guez 222 frugs(:, is_oce) = rugmer
565 guez 202 pctsrf(:, is_oce) = pctsrf_new_oce
566     pctsrf(:, is_sic) = pctsrf_new_sic
567 guez 15
568 guez 202 firstcal = .false.
569    
570 guez 38 END SUBROUTINE clmain
571 guez 15
572 guez 38 end module clmain_m

  ViewVC Help
Powered by ViewVC 1.1.21