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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 227 - (hide annotations)
Thu Nov 2 15:47:03 2017 UTC (6 years, 6 months ago) by guez
File size: 20092 byte(s)
Rename phisinit to phis in restart.nc: clearer, same name as Fortran variable.

In aaam_bud, use rlat and rlon from phyetat0_m instead of having these
module variables associated to actual arguments in physiq.

In clmain, too many wind variables make the procedure hard to
understand. Use yu(:knon, 1) and yv(:knon, 1) instead of u1lay(:knon)
and v1lay(:knon). Note that when yu(:knon, 1) and yv(:knon, 1) are
used as actual arguments, they are probably copied to new arrays since
the elements are not contiguous. Rename yu10m to wind10m because this
is the norm of wind vector, not its zonal component. Rename yustar to
ustar. Rename uzon and vmer to u1 and v1 since these are wind
components at first layer and u1 and v1 are the names of corresponding
dummy arguments in stdlevvar.

In clmain, rename yzlev to zlev.

In clmain, screenc, stdlevvar and coefcdrag, remove the code
corresponding to zxli true (not used in LMDZ either).

Subroutine ustarhb becomes a function. Simplifications using the fact
that zx_alf2 = 0 and zx_alf1 = 1 (discarding the possibility to change
this).

In procedure vdif_kcay, remove unused dummy argument plev. Remove
useless computations of sss and sssq.

In clouds_gno, exp(100.) would overflow in single precision. Set
maximum to exp(80.) instead.

In physiq, use u(:, 1) and v(:, 1) as arguments to phytrac instead of
creating ad hoc variables yu1 and yv1.

In stdlevvar, rename dummy argument u_10m to wind10m, following the
corresponding modification in clmain. Simplifications using the fact
that ok_pred = 0 and ok_corr = 1 (discarding the possibility to change
this).

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 227 USE conf_gcm_m, ONLY: 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 REAL snow(klon), yqsurf(klon), yagesno(klon)
156 guez 225 real yqsol(klon) ! column-density of water in soil, in kg m-2
157     REAL yrain_f(klon) ! liquid water mass flux (kg / m2 / s), positive down
158     REAL ysnow_f(klon) ! solid water mass flux (kg / m2 / s), positive down
159 guez 38 REAL yrugm(klon), yrads(klon), yrugoro(klon)
160     REAL yfluxlat(klon)
161     REAL y_d_ts(klon)
162     REAL y_d_t(klon, klev), y_d_q(klon, klev)
163     REAL y_d_u(klon, klev), y_d_v(klon, klev)
164 guez 206 REAL y_flux_t(klon), y_flux_q(klon)
165     REAL y_flux_u(klon), y_flux_v(klon)
166 guez 38 REAL y_dflux_t(klon), y_dflux_q(klon)
167 guez 62 REAL coefh(klon, klev), coefm(klon, klev)
168 guez 38 REAL yu(klon, klev), yv(klon, klev)
169     REAL yt(klon, klev), yq(klon, klev)
170 guez 225 REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
171 guez 15
172 guez 38 REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
173 guez 15
174 guez 227 REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)
175 guez 225 REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
176     REAL ykmq(klon, klev + 1)
177     REAL yq2(klon, klev + 1)
178     REAL q2diag(klon, klev + 1)
179 guez 15
180 guez 38 REAL delp(klon, klev)
181     INTEGER i, k, nsrf
182 guez 15
183 guez 38 INTEGER ni(klon), knon, j
184 guez 40
185 guez 38 REAL pctsrf_pot(klon, nbsrf)
186 guez 145 ! "pourcentage potentiel" pour tenir compte des \'eventuelles
187 guez 40 ! apparitions ou disparitions de la glace de mer
188 guez 15
189 guez 227 REAL yt2m(klon), yq2m(klon), wind10m(klon)
190     REAL ustar(klon)
191 guez 15
192 guez 38 REAL yt10m(klon), yq10m(klon)
193     REAL ypblh(klon)
194     REAL ylcl(klon)
195     REAL ycapcl(klon)
196     REAL yoliqcl(klon)
197     REAL ycteicl(klon)
198     REAL ypblt(klon)
199     REAL ytherm(klon)
200     REAL ytrmb1(klon)
201     REAL ytrmb2(klon)
202     REAL ytrmb3(klon)
203 guez 227 REAL u1(klon), v1(klon)
204 guez 38 REAL tair1(klon), qair1(klon), tairsol(klon)
205     REAL psfce(klon), patm(klon)
206 guez 15
207 guez 38 REAL qairsol(klon), zgeo1(klon)
208     REAL rugo1(klon)
209 guez 15
210 guez 38 !------------------------------------------------------------
211 guez 15
212 guez 38 ytherm = 0.
213 guez 15
214 guez 38 DO k = 1, klev ! epaisseur de couche
215     DO i = 1, klon
216 guez 225 delp(i, k) = paprs(i, k) - paprs(i, k + 1)
217 guez 38 END DO
218     END DO
219 guez 15
220 guez 40 ! Initialization:
221     rugmer = 0.
222     cdragh = 0.
223     cdragm = 0.
224     dflux_t = 0.
225     dflux_q = 0.
226     ypct = 0.
227     yqsurf = 0.
228     yrain_f = 0.
229     ysnow_f = 0.
230     yrugos = 0.
231     ypaprs = 0.
232     ypplay = 0.
233     ydelp = 0.
234     yu = 0.
235     yv = 0.
236     yt = 0.
237     yq = 0.
238     y_dflux_t = 0.
239     y_dflux_q = 0.
240 guez 38 yrugoro = 0.
241 guez 40 d_ts = 0.
242 guez 38 flux_t = 0.
243     flux_q = 0.
244     flux_u = 0.
245     flux_v = 0.
246 guez 214 fluxlat = 0.
247 guez 40 d_t = 0.
248     d_q = 0.
249     d_u = 0.
250     d_v = 0.
251 guez 70 ycoefh = 0.
252 guez 15
253 guez 145 ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
254     ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
255     ! (\`a affiner)
256 guez 15
257 guez 202 pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
258     pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
259 guez 38 pctsrf_pot(:, is_oce) = 1. - zmasq
260     pctsrf_pot(:, is_sic) = 1. - zmasq
261 guez 15
262 guez 202 ! Tester si c'est le moment de lire le fichier:
263     if (mod(itap - 1, lmt_pas) == 0) then
264 guez 221 CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
265 guez 202 endif
266    
267 guez 99 ! Boucler sur toutes les sous-fractions du sol:
268    
269 guez 49 loop_surface: DO nsrf = 1, nbsrf
270     ! Chercher les indices :
271 guez 38 ni = 0
272     knon = 0
273     DO i = 1, klon
274 guez 145 ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
275 guez 38 ! "potentielles"
276     IF (pctsrf_pot(i, nsrf) > epsfra) THEN
277     knon = knon + 1
278     ni(knon) = i
279     END IF
280     END DO
281 guez 15
282 guez 62 if_knon: IF (knon /= 0) then
283 guez 38 DO j = 1, knon
284     i = ni(j)
285 guez 62 ypct(j) = pctsrf(i, nsrf)
286 guez 207 yts(j) = ftsol(i, nsrf)
287 guez 215 snow(j) = fsnow(i, nsrf)
288 guez 62 yqsurf(j) = qsurf(i, nsrf)
289 guez 155 yalb(j) = falbe(i, nsrf)
290 guez 62 yrain_f(j) = rain_fall(i)
291     ysnow_f(j) = snow_f(i)
292     yagesno(j) = agesno(i, nsrf)
293 guez 222 yrugos(j) = frugs(i, nsrf)
294 guez 62 yrugoro(j) = rugoro(i)
295 guez 222 yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
296 guez 225 ypaprs(j, klev + 1) = paprs(i, klev + 1)
297 guez 62 y_run_off_lic_0(j) = run_off_lic_0(i)
298 guez 38 END DO
299 guez 3
300 guez 99 ! For continent, copy soil water content
301 guez 225 IF (nsrf == is_ter) yqsol(:knon) = qsol(ni(:knon))
302 guez 3
303 guez 208 ytsoil(:knon, :) = ftsoil(ni(:knon), :, nsrf)
304 guez 3
305 guez 38 DO k = 1, klev
306     DO j = 1, knon
307     i = ni(j)
308 guez 62 ypaprs(j, k) = paprs(i, k)
309     ypplay(j, k) = pplay(i, k)
310     ydelp(j, k) = delp(i, k)
311     yu(j, k) = u(i, k)
312     yv(j, k) = v(i, k)
313     yt(j, k) = t(i, k)
314     yq(j, k) = q(i, k)
315 guez 38 END DO
316     END DO
317 guez 3
318 guez 62 ! calculer Cdrag et les coefficients d'echange
319 guez 221 CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
320     yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
321     coefh(:knon, :))
322 guez 227
323 guez 62 IF (iflag_pbl == 1) THEN
324     CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
325     coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
326     coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
327     END IF
328 guez 3
329 guez 70 ! on met un seuil pour coefm et coefh
330 guez 62 IF (nsrf == is_oce) THEN
331     coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)
332     coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)
333 guez 38 END IF
334 guez 3
335 guez 62 IF (ok_kzmin) THEN
336     ! Calcul d'une diffusion minimale pour les conditions tres stables
337     CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
338 guez 70 coefm(:knon, 1), ycoefm0, ycoefh0)
339 guez 62 coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
340     coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
341 guez 98 END IF
342 guez 3
343 guez 62 IF (iflag_pbl >= 3) THEN
344 guez 145 ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
345     ! Fr\'ed\'eric Hourdin
346 guez 62 yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
347     + ypplay(:knon, 1))) &
348     * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
349 guez 227
350 guez 62 DO k = 2, klev
351 guez 227 yzlay(:knon, k) = yzlay(:knon, k-1) &
352 guez 62 + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &
353     / ypaprs(1:knon, k) &
354     * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
355     END DO
356 guez 227
357 guez 62 DO k = 1, klev
358 guez 225 yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
359     / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
360 guez 62 END DO
361 guez 227
362     zlev(:knon, 1) = 0.
363     zlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
364 guez 62 - yzlay(:knon, klev - 1)
365 guez 227
366 guez 62 DO k = 2, klev
367 guez 227 zlev(:knon, k) = 0.5 * (yzlay(:knon, k) + yzlay(:knon, k-1))
368 guez 62 END DO
369 guez 227
370 guez 62 DO k = 1, klev + 1
371     DO j = 1, knon
372     i = ni(j)
373     yq2(j, k) = q2(i, k, nsrf)
374     END DO
375     END DO
376    
377 guez 227 ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), coefm(:knon, 1))
378 guez 62
379 guez 145 ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
380 guez 62
381     IF (iflag_pbl >= 11) THEN
382 guez 227 CALL vdif_kcay(knon, dtime, rg, zlev, yzlay, yu, yv, yteta, &
383     coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, ustar(:knon), &
384 guez 145 iflag_pbl)
385 guez 62 ELSE
386 guez 227 CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &
387     yu(:knon, :), yv(:knon, :), yteta(:knon, :), &
388     coefm(:knon, 1), yq2(:knon, :), ykmm(:knon, :), &
389     ykmn(:knon, :), ykmq(:knon, :), ustar(:knon), iflag_pbl)
390 guez 62 END IF
391    
392     coefm(:knon, 2:) = ykmm(:knon, 2:klev)
393     coefh(:knon, 2:) = ykmn(:knon, 2:klev)
394 guez 38 END IF
395 guez 3
396 guez 62 ! calculer la diffusion des vitesses "u" et "v"
397 guez 227 CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &
398 guez 225 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &
399     y_flux_u(:knon))
400 guez 227 CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &
401 guez 225 coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &
402     y_flux_v(:knon))
403 guez 3
404 guez 62 ! calculer la diffusion de "q" et de "h"
405 guez 221 CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
406 guez 225 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
407 guez 227 yu(:knon, 1), yv(:knon, 1), coefh(:knon, :), yt, yq, &
408 guez 225 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &
409     snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &
410     pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
411     yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &
412     y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)
413 guez 3
414 guez 62 ! calculer la longueur de rugosite sur ocean
415     yrugm = 0.
416     IF (nsrf == is_oce) THEN
417     DO j = 1, knon
418 guez 227 yrugm(j) = 0.018 * coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2) &
419 guez 225 / rg + 0.11 * 14E-6 &
420 guez 227 / sqrt(coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2))
421 guez 62 yrugm(j) = max(1.5E-05, yrugm(j))
422     END DO
423     END IF
424 guez 38 DO j = 1, knon
425 guez 225 y_dflux_t(j) = y_dflux_t(j) * ypct(j)
426     y_dflux_q(j) = y_dflux_q(j) * ypct(j)
427 guez 38 END DO
428 guez 3
429 guez 62 DO k = 1, klev
430     DO j = 1, knon
431     i = ni(j)
432 guez 225 coefh(j, k) = coefh(j, k) * ypct(j)
433     coefm(j, k) = coefm(j, k) * ypct(j)
434     y_d_t(j, k) = y_d_t(j, k) * ypct(j)
435     y_d_q(j, k) = y_d_q(j, k) * ypct(j)
436     y_d_u(j, k) = y_d_u(j, k) * ypct(j)
437     y_d_v(j, k) = y_d_v(j, k) * ypct(j)
438 guez 62 END DO
439 guez 38 END DO
440 guez 3
441 guez 214 flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
442     flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
443     flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
444     flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
445 guez 15
446 guez 206 evap(:, nsrf) = -flux_q(:, nsrf)
447    
448 guez 155 falbe(:, nsrf) = 0.
449 guez 215 fsnow(:, nsrf) = 0.
450 guez 62 qsurf(:, nsrf) = 0.
451 guez 222 frugs(:, nsrf) = 0.
452 guez 38 DO j = 1, knon
453     i = ni(j)
454 guez 62 d_ts(i, nsrf) = y_d_ts(j)
455 guez 155 falbe(i, nsrf) = yalb(j)
456 guez 215 fsnow(i, nsrf) = snow(j)
457 guez 62 qsurf(i, nsrf) = yqsurf(j)
458 guez 222 frugs(i, nsrf) = yz0_new(j)
459 guez 62 fluxlat(i, nsrf) = yfluxlat(j)
460     IF (nsrf == is_oce) THEN
461     rugmer(i) = yrugm(j)
462 guez 222 frugs(i, nsrf) = yrugm(j)
463 guez 62 END IF
464     agesno(i, nsrf) = yagesno(j)
465     fqcalving(i, nsrf) = y_fqcalving(j)
466     ffonte(i, nsrf) = y_ffonte(j)
467     cdragh(i) = cdragh(i) + coefh(j, 1)
468     cdragm(i) = cdragm(i) + coefm(j, 1)
469     dflux_t(i) = dflux_t(i) + y_dflux_t(j)
470     dflux_q(i) = dflux_q(i) + y_dflux_q(j)
471 guez 38 END DO
472 guez 62 IF (nsrf == is_ter) THEN
473 guez 99 qsol(ni(:knon)) = yqsol(:knon)
474     else IF (nsrf == is_lic) THEN
475 guez 62 DO j = 1, knon
476     i = ni(j)
477     run_off_lic_0(i) = y_run_off_lic_0(j)
478     END DO
479     END IF
480 guez 118
481 guez 62 ftsoil(:, :, nsrf) = 0.
482 guez 208 ftsoil(ni(:knon), :, nsrf) = ytsoil(:knon, :)
483 guez 62
484 guez 38 DO j = 1, knon
485     i = ni(j)
486 guez 62 DO k = 1, klev
487     d_t(i, k) = d_t(i, k) + y_d_t(j, k)
488     d_q(i, k) = d_q(i, k) + y_d_q(j, k)
489     d_u(i, k) = d_u(i, k) + y_d_u(j, k)
490     d_v(i, k) = d_v(i, k) + y_d_v(j, k)
491 guez 70 ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)
492 guez 62 END DO
493 guez 38 END DO
494 guez 62
495 guez 99 ! diagnostic t, q a 2m et u, v a 10m
496 guez 62
497 guez 38 DO j = 1, knon
498     i = ni(j)
499 guez 227 u1(j) = yu(j, 1) + y_d_u(j, 1)
500     v1(j) = yv(j, 1) + y_d_v(j, 1)
501 guez 62 tair1(j) = yt(j, 1) + y_d_t(j, 1)
502     qair1(j) = yq(j, 1) + y_d_q(j, 1)
503 guez 225 zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &
504     1))) * (ypaprs(j, 1)-ypplay(j, 1))
505 guez 62 tairsol(j) = yts(j) + y_d_ts(j)
506     rugo1(j) = yrugos(j)
507     IF (nsrf == is_oce) THEN
508 guez 222 rugo1(j) = frugs(i, nsrf)
509 guez 62 END IF
510     psfce(j) = ypaprs(j, 1)
511     patm(j) = ypplay(j, 1)
512 guez 15
513 guez 62 qairsol(j) = yqsurf(j)
514 guez 38 END DO
515 guez 15
516 guez 227 CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &
517     qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &
518     yq2m, yt10m, yq10m, wind10m(:knon), ustar)
519 guez 3
520 guez 62 DO j = 1, knon
521     i = ni(j)
522     t2m(i, nsrf) = yt2m(j)
523     q2m(i, nsrf) = yq2m(j)
524 guez 3
525 guez 227 u10m_srf(i, nsrf) = (wind10m(j) * u1(j)) &
526     / sqrt(u1(j)**2 + v1(j)**2)
527     v10m_srf(i, nsrf) = (wind10m(j) * v1(j)) &
528     / sqrt(u1(j)**2 + v1(j)**2)
529 guez 62 END DO
530 guez 15
531 guez 227 CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
532 guez 206 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
533     yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
534 guez 15
535 guez 38 DO j = 1, knon
536     i = ni(j)
537 guez 62 pblh(i, nsrf) = ypblh(j)
538     plcl(i, nsrf) = ylcl(j)
539     capcl(i, nsrf) = ycapcl(j)
540     oliqcl(i, nsrf) = yoliqcl(j)
541     cteicl(i, nsrf) = ycteicl(j)
542     pblt(i, nsrf) = ypblt(j)
543     therm(i, nsrf) = ytherm(j)
544     trmb1(i, nsrf) = ytrmb1(j)
545     trmb2(i, nsrf) = ytrmb2(j)
546     trmb3(i, nsrf) = ytrmb3(j)
547 guez 38 END DO
548 guez 3
549 guez 38 DO j = 1, knon
550 guez 62 DO k = 1, klev + 1
551     i = ni(j)
552     q2(i, k, nsrf) = yq2(j, k)
553     END DO
554 guez 38 END DO
555 guez 215 else
556     fsnow(:, nsrf) = 0.
557 guez 62 end IF if_knon
558 guez 49 END DO loop_surface
559 guez 15
560 guez 38 ! On utilise les nouvelles surfaces
561 guez 222 frugs(:, is_oce) = rugmer
562 guez 202 pctsrf(:, is_oce) = pctsrf_new_oce
563     pctsrf(:, is_sic) = pctsrf_new_sic
564 guez 15
565 guez 202 firstcal = .false.
566    
567 guez 38 END SUBROUTINE clmain
568 guez 15
569 guez 38 end module clmain_m

  ViewVC Help
Powered by ViewVC 1.1.21