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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 154 - (hide annotations)
Tue Jul 7 17:49:23 2015 UTC (8 years, 9 months ago) by guez
File size: 22514 byte(s) 
Removed argument dtphys of physiq. Use it directly from comconst in
physiq instead.

Donwgraded variables eignfnu, eignfnv of module inifgn_m to dummy
arguments of SUBROUTINE inifgn. They were not used elsewhere than in
the calling procedure inifilr. Renamed argument dv of inifgn to eignval_v.

Made alboc and alboc_cd independent of the size of arguments. Now we
can call them only at indices knindex in interfsurf_hq, where we need
them. Fixed a bug in alboc_cd: rmu0 was modified, and the
corresponding actual argument in interfsurf_hq is an intent(in)
argument of interfsurf_hq.

Variables of size knon instead of klon in interfsur_lim and interfsurf_hq.

Removed argument alb_new of interfsurf_hq because it was the same than
alblw. Simplified test on cycle_diurne, following LMDZ.

Moved tests on nbapp_rad from physiq to read_clesphys2. No need for
separate counter itaprad, we can use itap. Define lmt_pas and radpas
from integer input parameters instead of real-type computed values.
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 99 SUBROUTINE clmain(dtime, itap, pctsrf, pctsrf_new, t, q, u, v, jour, rmu0, &
8 guez 101 co2_ppm, ts, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
9     paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, rain_fall, &
10     snow_f, solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, &
11     d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &
12     q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &
13     capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &
14     fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab)
15 guez 3
16 guez 99 ! From phylmd/clmain.F, version 1.6, 2005/11/16 14:47:19
17 guez 62 ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18
18     ! Objet : interface de couche limite (diffusion verticale)
19 guez 3
20 guez 62 ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul
21     ! de la couche limite pour les traceurs se fait avec "cltrac" et
22 guez 145 ! ne tient pas compte de la diff\'erentiation des sous-fractions
23     ! de sol.
24 guez 3
25 guez 145 ! Pour pouvoir extraire les coefficients d'\'echanges et le vent
26     ! dans la premi\`ere couche, trois champs ont \'et\'e cr\'e\'es : "ycoefh",
27     ! "zu1" et "zv1". Nous avons moyenn\'e les valeurs de ces trois
28     ! champs sur les quatre sous-surfaces du mod\`ele.
29 guez 3
30 guez 49 use clqh_m, only: clqh
31 guez 62 use clvent_m, only: clvent
32 guez 47 use coefkz_m, only: coefkz
33     use coefkzmin_m, only: coefkzmin
34 guez 62 USE conf_gcm_m, ONLY: prt_level
35     USE conf_phys_m, ONLY: iflag_pbl
36     USE dimens_m, ONLY: iim, jjm
37     USE dimphy, ONLY: klev, klon, zmasq
38     USE dimsoil, ONLY: nsoilmx
39 guez 47 use hbtm_m, only: hbtm
40 guez 62 USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
41 guez 104 use stdlevvar_m, only: stdlevvar
42 guez 62 USE suphec_m, ONLY: rd, rg, rkappa
43     use ustarhb_m, only: ustarhb
44     use vdif_kcay_m, only: vdif_kcay
45 guez 47 use yamada4_m, only: yamada4
46 guez 15
47 guez 62 REAL, INTENT(IN):: dtime ! interval du temps (secondes)
48     INTEGER, INTENT(IN):: itap ! numero du pas de temps
49     REAL, INTENT(inout):: pctsrf(klon, nbsrf)
50    
51     ! la nouvelle repartition des surfaces sortie de l'interface
52     REAL, INTENT(out):: pctsrf_new(klon, nbsrf)
53    
54     REAL, INTENT(IN):: t(klon, klev) ! temperature (K)
55     REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)
56     REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
57     INTEGER, INTENT(IN):: jour ! jour de l'annee en cours
58     REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal
59 guez 99 REAL, intent(in):: co2_ppm ! taux CO2 atmosphere
60 guez 104 REAL, INTENT(IN):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)
61 guez 71 REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
62 guez 99 REAL, INTENT(IN):: ksta, ksta_ter
63     LOGICAL, INTENT(IN):: ok_kzmin
64 guez 101
65 guez 118 REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
66     ! soil temperature of surface fraction
67    
68 guez 99 REAL, INTENT(inout):: qsol(klon)
69 guez 101 ! column-density of water in soil, in kg m-2
70    
71 guez 62 REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)
72     REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
73 guez 70 REAL snow(klon, nbsrf)
74     REAL qsurf(klon, nbsrf)
75     REAL evap(klon, nbsrf)
76     REAL albe(klon, nbsrf)
77     REAL alblw(klon, nbsrf)
78    
79     REAL fluxlat(klon, nbsrf)
80    
81 guez 101 REAL, intent(in):: rain_fall(klon)
82     ! liquid water mass flux (kg/m2/s), positive down
83    
84     REAL, intent(in):: snow_f(klon)
85     ! solid water mass flux (kg/m2/s), positive down
86    
87 guez 72 REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
88 guez 154 REAL, intent(in):: fder(klon)
89 guez 145 REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es
90 guez 70
91     REAL rugos(klon, nbsrf)
92     ! rugos----input-R- longeur de rugosite (en m)
93    
94     LOGICAL, INTENT(IN):: debut
95     real agesno(klon, nbsrf)
96     REAL, INTENT(IN):: rugoro(klon)
97    
98 guez 38 REAL d_t(klon, klev), d_q(klon, klev)
99 guez 49 ! d_t------output-R- le changement pour "t"
100     ! d_q------output-R- le changement pour "q"
101 guez 62
102     REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
103     ! changement pour "u" et "v"
104    
105 guez 104 REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"
106 guez 70
107 guez 38 REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)
108 guez 49 ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
109     ! (orientation positive vers le bas)
110     ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
111 guez 70
112     REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)
113     ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
114     ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
115    
116     REAL, INTENT(out):: cdragh(klon), cdragm(klon)
117     real q2(klon, klev+1, nbsrf)
118    
119 guez 99 REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
120 guez 49 ! dflux_t derive du flux sensible
121     ! dflux_q derive du flux latent
122 guez 38 !IM "slab" ocean
123 guez 70
124     REAL, intent(out):: ycoefh(klon, klev)
125     REAL, intent(out):: zu1(klon)
126     REAL zv1(klon)
127     REAL t2m(klon, nbsrf), q2m(klon, nbsrf)
128     REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
129    
130     !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds
131     ! physiq ce qui permet de sortir les grdeurs par sous surface)
132     REAL pblh(klon, nbsrf)
133     ! pblh------- HCL
134     REAL capcl(klon, nbsrf)
135     REAL oliqcl(klon, nbsrf)
136     REAL cteicl(klon, nbsrf)
137     REAL pblt(klon, nbsrf)
138     ! pblT------- T au nveau HCL
139     REAL therm(klon, nbsrf)
140     REAL trmb1(klon, nbsrf)
141     ! trmb1-------deep_cape
142     REAL trmb2(klon, nbsrf)
143     ! trmb2--------inhibition
144     REAL trmb3(klon, nbsrf)
145     ! trmb3-------Point Omega
146     REAL plcl(klon, nbsrf)
147     REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
148     ! ffonte----Flux thermique utilise pour fondre la neige
149     ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la
150     ! hauteur de neige, en kg/m2/s
151     REAL run_off_lic_0(klon)
152    
153 guez 38 REAL flux_o(klon), flux_g(klon)
154 guez 49 !IM "slab" ocean
155     ! flux_g---output-R- flux glace (pour OCEAN='slab ')
156     ! flux_o---output-R- flux ocean (pour OCEAN='slab ')
157 guez 70
158     REAL tslab(klon)
159 guez 49 ! tslab-in/output-R temperature du slab ocean (en Kelvin)
160     ! uniqmnt pour slab
161 guez 70
162     ! Local:
163 guez 15
164 guez 70 REAL y_flux_o(klon), y_flux_g(klon)
165     real ytslab(klon)
166     REAL y_fqcalving(klon), y_ffonte(klon)
167     real y_run_off_lic_0(klon)
168 guez 15
169 guez 70 REAL rugmer(klon)
170 guez 15
171 guez 38 REAL ytsoil(klon, nsoilmx)
172 guez 15
173 guez 38 REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
174     REAL yalb(klon)
175     REAL yalblw(klon)
176     REAL yu1(klon), yv1(klon)
177 guez 49 ! on rajoute en output yu1 et yv1 qui sont les vents dans
178     ! la premiere couche
179 guez 101 REAL ysnow(klon), yqsurf(klon), yagesno(klon)
180    
181     real yqsol(klon)
182     ! column-density of water in soil, in kg m-2
183    
184     REAL yrain_f(klon)
185     ! liquid water mass flux (kg/m2/s), positive down
186    
187     REAL ysnow_f(klon)
188     ! solid water mass flux (kg/m2/s), positive down
189    
190 guez 72 REAL ysollw(klon), ysolsw(klon)
191 guez 99 REAL yfder(klon)
192 guez 38 REAL yrugm(klon), yrads(klon), yrugoro(klon)
193 guez 15
194 guez 38 REAL yfluxlat(klon)
195 guez 15
196 guez 38 REAL y_d_ts(klon)
197     REAL y_d_t(klon, klev), y_d_q(klon, klev)
198     REAL y_d_u(klon, klev), y_d_v(klon, klev)
199     REAL y_flux_t(klon, klev), y_flux_q(klon, klev)
200     REAL y_flux_u(klon, klev), y_flux_v(klon, klev)
201     REAL y_dflux_t(klon), y_dflux_q(klon)
202 guez 62 REAL coefh(klon, klev), coefm(klon, klev)
203 guez 38 REAL yu(klon, klev), yv(klon, klev)
204     REAL yt(klon, klev), yq(klon, klev)
205     REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)
206 guez 15
207 guez 38 REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
208 guez 15
209 guez 38 REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)
210     REAL ykmm(klon, klev+1), ykmn(klon, klev+1)
211     REAL ykmq(klon, klev+1)
212 guez 70 REAL yq2(klon, klev+1)
213 guez 38 REAL q2diag(klon, klev+1)
214 guez 15
215 guez 38 REAL u1lay(klon), v1lay(klon)
216     REAL delp(klon, klev)
217     INTEGER i, k, nsrf
218 guez 15
219 guez 38 INTEGER ni(klon), knon, j
220 guez 40
221 guez 38 REAL pctsrf_pot(klon, nbsrf)
222 guez 145 ! "pourcentage potentiel" pour tenir compte des \'eventuelles
223 guez 40 ! apparitions ou disparitions de la glace de mer
224 guez 15
225 guez 38 REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
226 guez 15
227 guez 38 REAL yt2m(klon), yq2m(klon), yu10m(klon)
228     REAL yustar(klon)
229     ! -- LOOP
230     REAL yu10mx(klon)
231     REAL yu10my(klon)
232     REAL ywindsp(klon)
233     ! -- LOOP
234 guez 15
235 guez 38 REAL yt10m(klon), yq10m(klon)
236     REAL ypblh(klon)
237     REAL ylcl(klon)
238     REAL ycapcl(klon)
239     REAL yoliqcl(klon)
240     REAL ycteicl(klon)
241     REAL ypblt(klon)
242     REAL ytherm(klon)
243     REAL ytrmb1(klon)
244     REAL ytrmb2(klon)
245     REAL ytrmb3(klon)
246     REAL uzon(klon), vmer(klon)
247     REAL tair1(klon), qair1(klon), tairsol(klon)
248     REAL psfce(klon), patm(klon)
249 guez 15
250 guez 38 REAL qairsol(klon), zgeo1(klon)
251     REAL rugo1(klon)
252 guez 15
253 guez 38 ! utiliser un jeu de fonctions simples
254     LOGICAL zxli
255     PARAMETER (zxli=.FALSE.)
256 guez 15
257 guez 38 !------------------------------------------------------------
258 guez 15
259 guez 38 ytherm = 0.
260 guez 15
261 guez 38 DO k = 1, klev ! epaisseur de couche
262     DO i = 1, klon
263     delp(i, k) = paprs(i, k) - paprs(i, k+1)
264     END DO
265     END DO
266     DO i = 1, klon ! vent de la premiere couche
267     zx_alf1 = 1.0
268     zx_alf2 = 1.0 - zx_alf1
269     u1lay(i) = u(i, 1)*zx_alf1 + u(i, 2)*zx_alf2
270     v1lay(i) = v(i, 1)*zx_alf1 + v(i, 2)*zx_alf2
271     END DO
272 guez 15
273 guez 40 ! Initialization:
274     rugmer = 0.
275     cdragh = 0.
276     cdragm = 0.
277     dflux_t = 0.
278     dflux_q = 0.
279     zu1 = 0.
280     zv1 = 0.
281     ypct = 0.
282     yts = 0.
283     ysnow = 0.
284     yqsurf = 0.
285     yalb = 0.
286     yrain_f = 0.
287     ysnow_f = 0.
288     yfder = 0.
289     ysolsw = 0.
290     ysollw = 0.
291     yrugos = 0.
292     yu1 = 0.
293     yv1 = 0.
294     yrads = 0.
295     ypaprs = 0.
296     ypplay = 0.
297     ydelp = 0.
298     yu = 0.
299     yv = 0.
300     yt = 0.
301     yq = 0.
302     pctsrf_new = 0.
303     y_flux_u = 0.
304     y_flux_v = 0.
305     y_dflux_t = 0.
306     y_dflux_q = 0.
307 guez 38 ytsoil = 999999.
308     yrugoro = 0.
309 guez 40 yu10mx = 0.
310     yu10my = 0.
311     ywindsp = 0.
312     d_ts = 0.
313 guez 38 yfluxlat = 0.
314     flux_t = 0.
315     flux_q = 0.
316     flux_u = 0.
317     flux_v = 0.
318 guez 40 d_t = 0.
319     d_q = 0.
320     d_u = 0.
321     d_v = 0.
322 guez 70 ycoefh = 0.
323 guez 15
324 guez 145 ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
325     ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
326     ! (\`a affiner)
327 guez 15
328 guez 38 pctsrf_pot = pctsrf
329     pctsrf_pot(:, is_oce) = 1. - zmasq
330     pctsrf_pot(:, is_sic) = 1. - zmasq
331 guez 15
332 guez 99 ! Boucler sur toutes les sous-fractions du sol:
333    
334 guez 49 loop_surface: DO nsrf = 1, nbsrf
335     ! Chercher les indices :
336 guez 38 ni = 0
337     knon = 0
338     DO i = 1, klon
339 guez 145 ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
340 guez 38 ! "potentielles"
341     IF (pctsrf_pot(i, nsrf) > epsfra) THEN
342     knon = knon + 1
343     ni(knon) = i
344     END IF
345     END DO
346 guez 15
347 guez 62 if_knon: IF (knon /= 0) then
348 guez 38 DO j = 1, knon
349     i = ni(j)
350 guez 62 ypct(j) = pctsrf(i, nsrf)
351     yts(j) = ts(i, nsrf)
352     ytslab(i) = tslab(i)
353     ysnow(j) = snow(i, nsrf)
354     yqsurf(j) = qsurf(i, nsrf)
355     yalb(j) = albe(i, nsrf)
356     yrain_f(j) = rain_fall(i)
357     ysnow_f(j) = snow_f(i)
358     yagesno(j) = agesno(i, nsrf)
359     yfder(j) = fder(i)
360     ysolsw(j) = solsw(i, nsrf)
361     ysollw(j) = sollw(i, nsrf)
362     yrugos(j) = rugos(i, nsrf)
363     yrugoro(j) = rugoro(i)
364     yu1(j) = u1lay(i)
365     yv1(j) = v1lay(i)
366     yrads(j) = ysolsw(j) + ysollw(j)
367     ypaprs(j, klev+1) = paprs(i, klev+1)
368     y_run_off_lic_0(j) = run_off_lic_0(i)
369     yu10mx(j) = u10m(i, nsrf)
370     yu10my(j) = v10m(i, nsrf)
371     ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))
372 guez 38 END DO
373 guez 3
374 guez 99 ! For continent, copy soil water content
375     IF (nsrf == is_ter) THEN
376     yqsol(:knon) = qsol(ni(:knon))
377 guez 62 ELSE
378     yqsol = 0.
379     END IF
380 guez 3
381 guez 62 DO k = 1, nsoilmx
382     DO j = 1, knon
383     i = ni(j)
384     ytsoil(j, k) = ftsoil(i, k, nsrf)
385 guez 38 END DO
386 guez 47 END DO
387 guez 3
388 guez 38 DO k = 1, klev
389     DO j = 1, knon
390     i = ni(j)
391 guez 62 ypaprs(j, k) = paprs(i, k)
392     ypplay(j, k) = pplay(i, k)
393     ydelp(j, k) = delp(i, k)
394     yu(j, k) = u(i, k)
395     yv(j, k) = v(i, k)
396     yt(j, k) = t(i, k)
397     yq(j, k) = q(i, k)
398 guez 38 END DO
399     END DO
400 guez 3
401 guez 62 ! calculer Cdrag et les coefficients d'echange
402     CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &
403     yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))
404     IF (iflag_pbl == 1) THEN
405     CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
406     coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
407     coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
408     END IF
409 guez 3
410 guez 70 ! on met un seuil pour coefm et coefh
411 guez 62 IF (nsrf == is_oce) THEN
412     coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)
413     coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)
414 guez 38 END IF
415 guez 3
416 guez 62 IF (ok_kzmin) THEN
417     ! Calcul d'une diffusion minimale pour les conditions tres stables
418     CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
419 guez 70 coefm(:knon, 1), ycoefm0, ycoefh0)
420 guez 62 coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
421     coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
422 guez 98 END IF
423 guez 3
424 guez 62 IF (iflag_pbl >= 3) THEN
425 guez 145 ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
426     ! Fr\'ed\'eric Hourdin
427 guez 62 yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
428     + ypplay(:knon, 1))) &
429     * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
430     DO k = 2, klev
431     yzlay(1:knon, k) = yzlay(1:knon, k-1) &
432     + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &
433     / ypaprs(1:knon, k) &
434     * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
435     END DO
436     DO k = 1, klev
437     yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &
438     / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))
439     END DO
440     yzlev(1:knon, 1) = 0.
441     yzlev(:knon, klev+1) = 2. * yzlay(:knon, klev) &
442     - yzlay(:knon, klev - 1)
443     DO k = 2, klev
444     yzlev(1:knon, k) = 0.5*(yzlay(1:knon, k)+yzlay(1:knon, k-1))
445     END DO
446     DO k = 1, klev + 1
447     DO j = 1, knon
448     i = ni(j)
449     yq2(j, k) = q2(i, k, nsrf)
450     END DO
451     END DO
452    
453     CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
454 guez 99 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
455 guez 62
456 guez 145 ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
457 guez 62
458     IF (iflag_pbl >= 11) THEN
459 guez 145 CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
460     yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
461     iflag_pbl)
462 guez 62 ELSE
463     CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
464     coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
465     END IF
466    
467     coefm(:knon, 2:) = ykmm(:knon, 2:klev)
468     coefh(:knon, 2:) = ykmn(:knon, 2:klev)
469 guez 38 END IF
470 guez 3
471 guez 62 ! calculer la diffusion des vitesses "u" et "v"
472 guez 70 CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
473     ypplay, ydelp, y_d_u, y_flux_u)
474     CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
475     ypplay, ydelp, y_d_v, y_flux_v)
476 guez 3
477 guez 62 ! calculer la diffusion de "q" et de "h"
478 guez 118 CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &
479     pctsrf, ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, yu1, &
480     yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &
481 guez 154 yrads, yalb, yalblw(:knon), ysnow, yqsurf, yrain_f, ysnow_f, &
482     yfder, ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, &
483 guez 118 y_d_ts(:knon), yz0_new, y_flux_t, y_flux_q, y_dflux_t, &
484     y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, &
485     y_flux_g)
486 guez 3
487 guez 62 ! calculer la longueur de rugosite sur ocean
488     yrugm = 0.
489     IF (nsrf == is_oce) THEN
490     DO j = 1, knon
491     yrugm(j) = 0.018*coefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &
492     0.11*14E-6/sqrt(coefm(j, 1)*(yu1(j)**2+yv1(j)**2))
493     yrugm(j) = max(1.5E-05, yrugm(j))
494     END DO
495     END IF
496 guez 38 DO j = 1, knon
497 guez 62 y_dflux_t(j) = y_dflux_t(j)*ypct(j)
498     y_dflux_q(j) = y_dflux_q(j)*ypct(j)
499     yu1(j) = yu1(j)*ypct(j)
500     yv1(j) = yv1(j)*ypct(j)
501 guez 38 END DO
502 guez 3
503 guez 62 DO k = 1, klev
504     DO j = 1, knon
505     i = ni(j)
506     coefh(j, k) = coefh(j, k)*ypct(j)
507     coefm(j, k) = coefm(j, k)*ypct(j)
508     y_d_t(j, k) = y_d_t(j, k)*ypct(j)
509     y_d_q(j, k) = y_d_q(j, k)*ypct(j)
510     flux_t(i, k, nsrf) = y_flux_t(j, k)
511     flux_q(i, k, nsrf) = y_flux_q(j, k)
512     flux_u(i, k, nsrf) = y_flux_u(j, k)
513     flux_v(i, k, nsrf) = y_flux_v(j, k)
514     y_d_u(j, k) = y_d_u(j, k)*ypct(j)
515     y_d_v(j, k) = y_d_v(j, k)*ypct(j)
516     END DO
517 guez 38 END DO
518 guez 3
519 guez 62 evap(:, nsrf) = -flux_q(:, 1, nsrf)
520 guez 15
521 guez 62 albe(:, nsrf) = 0.
522     alblw(:, nsrf) = 0.
523     snow(:, nsrf) = 0.
524     qsurf(:, nsrf) = 0.
525     rugos(:, nsrf) = 0.
526     fluxlat(:, nsrf) = 0.
527 guez 38 DO j = 1, knon
528     i = ni(j)
529 guez 62 d_ts(i, nsrf) = y_d_ts(j)
530     albe(i, nsrf) = yalb(j)
531     alblw(i, nsrf) = yalblw(j)
532     snow(i, nsrf) = ysnow(j)
533     qsurf(i, nsrf) = yqsurf(j)
534     rugos(i, nsrf) = yz0_new(j)
535     fluxlat(i, nsrf) = yfluxlat(j)
536     IF (nsrf == is_oce) THEN
537     rugmer(i) = yrugm(j)
538     rugos(i, nsrf) = yrugm(j)
539     END IF
540     agesno(i, nsrf) = yagesno(j)
541     fqcalving(i, nsrf) = y_fqcalving(j)
542     ffonte(i, nsrf) = y_ffonte(j)
543     cdragh(i) = cdragh(i) + coefh(j, 1)
544     cdragm(i) = cdragm(i) + coefm(j, 1)
545     dflux_t(i) = dflux_t(i) + y_dflux_t(j)
546     dflux_q(i) = dflux_q(i) + y_dflux_q(j)
547     zu1(i) = zu1(i) + yu1(j)
548     zv1(i) = zv1(i) + yv1(j)
549 guez 38 END DO
550 guez 62 IF (nsrf == is_ter) THEN
551 guez 99 qsol(ni(:knon)) = yqsol(:knon)
552     else IF (nsrf == is_lic) THEN
553 guez 62 DO j = 1, knon
554     i = ni(j)
555     run_off_lic_0(i) = y_run_off_lic_0(j)
556     END DO
557     END IF
558 guez 118
559 guez 62 ftsoil(:, :, nsrf) = 0.
560     DO k = 1, nsoilmx
561     DO j = 1, knon
562     i = ni(j)
563     ftsoil(i, k, nsrf) = ytsoil(j, k)
564     END DO
565     END DO
566    
567 guez 38 DO j = 1, knon
568     i = ni(j)
569 guez 62 DO k = 1, klev
570     d_t(i, k) = d_t(i, k) + y_d_t(j, k)
571     d_q(i, k) = d_q(i, k) + y_d_q(j, k)
572     d_u(i, k) = d_u(i, k) + y_d_u(j, k)
573     d_v(i, k) = d_v(i, k) + y_d_v(j, k)
574 guez 70 ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)
575 guez 62 END DO
576 guez 38 END DO
577 guez 62
578 guez 99 ! diagnostic t, q a 2m et u, v a 10m
579 guez 62
580 guez 38 DO j = 1, knon
581     i = ni(j)
582 guez 62 uzon(j) = yu(j, 1) + y_d_u(j, 1)
583     vmer(j) = yv(j, 1) + y_d_v(j, 1)
584     tair1(j) = yt(j, 1) + y_d_t(j, 1)
585     qair1(j) = yq(j, 1) + y_d_q(j, 1)
586     zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &
587     1)))*(ypaprs(j, 1)-ypplay(j, 1))
588     tairsol(j) = yts(j) + y_d_ts(j)
589     rugo1(j) = yrugos(j)
590     IF (nsrf == is_oce) THEN
591     rugo1(j) = rugos(i, nsrf)
592     END IF
593     psfce(j) = ypaprs(j, 1)
594     patm(j) = ypplay(j, 1)
595 guez 15
596 guez 62 qairsol(j) = yqsurf(j)
597 guez 38 END DO
598 guez 15
599 guez 62 CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, &
600     zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, &
601     yt10m, yq10m, yu10m, yustar)
602 guez 3
603 guez 62 DO j = 1, knon
604     i = ni(j)
605     t2m(i, nsrf) = yt2m(j)
606     q2m(i, nsrf) = yq2m(j)
607 guez 3
608 guez 62 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
609     u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)
610     v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)
611 guez 15
612 guez 62 END DO
613 guez 15
614 guez 149 CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, &
615 guez 62 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &
616     ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
617 guez 15
618 guez 38 DO j = 1, knon
619     i = ni(j)
620 guez 62 pblh(i, nsrf) = ypblh(j)
621     plcl(i, nsrf) = ylcl(j)
622     capcl(i, nsrf) = ycapcl(j)
623     oliqcl(i, nsrf) = yoliqcl(j)
624     cteicl(i, nsrf) = ycteicl(j)
625     pblt(i, nsrf) = ypblt(j)
626     therm(i, nsrf) = ytherm(j)
627     trmb1(i, nsrf) = ytrmb1(j)
628     trmb2(i, nsrf) = ytrmb2(j)
629     trmb3(i, nsrf) = ytrmb3(j)
630 guez 38 END DO
631 guez 3
632 guez 38 DO j = 1, knon
633 guez 62 DO k = 1, klev + 1
634     i = ni(j)
635     q2(i, k, nsrf) = yq2(j, k)
636     END DO
637 guez 38 END DO
638 guez 62 !IM "slab" ocean
639 guez 47 IF (nsrf == is_oce) THEN
640 guez 62 DO j = 1, knon
641     ! on projette sur la grille globale
642     i = ni(j)
643     IF (pctsrf_new(i, is_oce)>epsfra) THEN
644     flux_o(i) = y_flux_o(j)
645     ELSE
646     flux_o(i) = 0.
647     END IF
648     END DO
649 guez 38 END IF
650 guez 62
651     IF (nsrf == is_sic) THEN
652     DO j = 1, knon
653     i = ni(j)
654 guez 145 ! On pond\`ere lorsque l'on fait le bilan au sol :
655 guez 62 IF (pctsrf_new(i, is_sic)>epsfra) THEN
656     flux_g(i) = y_flux_g(j)
657     ELSE
658     flux_g(i) = 0.
659     END IF
660     END DO
661    
662     END IF
663     end IF if_knon
664 guez 49 END DO loop_surface
665 guez 15
666 guez 38 ! On utilise les nouvelles surfaces
667 guez 15
668 guez 38 rugos(:, is_oce) = rugmer
669     pctsrf = pctsrf_new
670 guez 15
671 guez 38 END SUBROUTINE clmain
672 guez 15
673 guez 38 end module clmain_m
  ViewVC Help
Powered by ViewVC 1.1.21