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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 191 - (hide annotations)
Mon May 9 19:56:28 2016 UTC (7 years, 11 months ago) by guez
File size: 20683 byte(s)
Extracted the call to read_comdissnew out of conf_gcm.

Made ok_instan a variable of module clesphys, itau_phy a variable of
module phyetat0_m, nid_ins a variable of module ini_histins_m, itap a
variable of new module time_phylmdz, so that histwrite_phy can be
called from any procedure without the need to cascade those variables
into that procedure. Made itau_w a variable of module time_phylmdz so
that it is computed only once per time step of physics.

Extracted variables of module clesphys which were in namelist
conf_phys_nml into their own namelist, clesphys_nml, and created
procedure read_clesphys reading clesphys_nml, to avoid side effect.

No need for double precision in procedure getso4fromfile. Assume there
is a single variable for the whole year in the NetCDF file instead of
one variable per month.

Created generic procedure histwrite_phy and removed procedure
write_histins, following LMDZ. histwrite_phy has only two arguments,
can be called from anywhere, and should manage the logic of writing or
not writing into various history files with various operations. So the
test on ok_instan goes inside histwrite_phy.

Test for raz_date in phyetat0 instead of physiq to avoid side effect.

Created procedure increment_itap to avoid side effect.

Removed unnecessary differences between procedures readsulfate and
readsulfate_pi.

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

  ViewVC Help
Powered by ViewVC 1.1.21