/[lmdze]/trunk/phylmd/Interface_surf/pbl_surface.f
ViewVC logotype

Diff of /trunk/phylmd/Interface_surf/pbl_surface.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 303 by guez, Thu Sep 6 14:25:07 2018 UTC revision 309 by guez, Thu Sep 27 14:58:10 2018 UTC
# Line 5  module pbl_surface_m Line 5  module pbl_surface_m
5  contains  contains
6    
7    SUBROUTINE pbl_surface(pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &    SUBROUTINE pbl_surface(pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &
8         cdhmax, ftsoil, qsol, paprs, pplay, fsnow, qsurf, evap, falbe, fluxlat, &         cdhmax, ftsoil, qsol, paprs, play, fsnow, fqsurf, falbe, fluxlat, &
9         rain_fall, snow_f, fsolsw, fsollw, frugs, agesno, rugoro, d_t, d_q, &         rain_fall, snow_fall, frugs, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, &
10         d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &         flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, &
11         dflux_t, dflux_q, coefh, t2m, q2m, u10m_srf, v10m_srf, pblh, capcl, &         coefh, t2m, q2m, u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, &
12         oliqcl, cteicl, pblt, therm, plcl, fqcalving, ffonte, run_off_lic_0)         therm, plcl, fqcalving, ffonte, run_off_lic_0, albsol, sollw, solsw, &
13           tsol)
14    
15      ! From phylmd/clmain.F, version 1.6, 2005/11/16 14:47:19      ! From phylmd/clmain.F, version 1.6, 2005/11/16 14:47:19
16      ! Author: Z. X. Li (LMD/CNRS)      ! Author: Z. X. Li (LMD/CNRS)
# Line 35  contains Line 36  contains
36      USE interfoce_lim_m, ONLY: interfoce_lim      USE interfoce_lim_m, ONLY: interfoce_lim
37      use phyetat0_m, only: zmasq      use phyetat0_m, only: zmasq
38      use stdlevvar_m, only: stdlevvar      use stdlevvar_m, only: stdlevvar
39      USE suphec_m, ONLY: rd, rg      USE suphec_m, ONLY: rd, rg, rsigma
40      use time_phylmdz, only: itap      use time_phylmdz, only: itap
41    
42      REAL, INTENT(inout):: pctsrf(klon, nbsrf)      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
43      ! tableau des pourcentages de surface de chaque maille      ! pourcentages de surface de chaque maille
44    
45      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)
46      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg / kg)      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg / kg)
# Line 56  contains Line 57  contains
57      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
58    
59      REAL, INTENT(IN):: paprs(klon, klev + 1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev + 1) ! pression a intercouche (Pa)
60      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: play(klon, klev) ! pression au milieu de couche (Pa)
61      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
62      REAL qsurf(klon, nbsrf)      REAL, INTENT(inout):: fqsurf(klon, nbsrf)
     REAL evap(klon, nbsrf)  
63      REAL, intent(inout):: falbe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
64      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
65    
66      REAL, intent(in):: rain_fall(klon)      REAL, intent(in):: rain_fall(klon)
67      ! liquid water mass flux (kg / m2 / s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
68    
69      REAL, intent(in):: snow_f(klon)      REAL, intent(in):: snow_fall(klon)
70      ! solid water mass flux (kg / m2 / s), positive down      ! solid water mass flux (kg / m2 / s), positive down
71    
     REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)  
72      REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)      REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
73      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
74      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
# Line 89  contains Line 88  contains
88      REAL, intent(out):: flux_q(klon, nbsrf)      REAL, intent(out):: flux_q(klon, nbsrf)
89      ! flux de vapeur d'eau (kg / m2 / s) à la surface      ! flux de vapeur d'eau (kg / m2 / s) à la surface
90    
91      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)      REAL, intent(out):: flux_u(:, :), flux_v(:, :) ! (klon, nbsrf)
92      ! tension du vent (flux turbulent de vent) à la surface, en Pa      ! tension du vent (flux turbulent de vent) à la surface, en Pa
93    
94      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
# Line 127  contains Line 126  contains
126      real ffonte(klon, nbsrf) ! flux thermique utilise pour fondre la neige      real ffonte(klon, nbsrf) ! flux thermique utilise pour fondre la neige
127      REAL, intent(inout):: run_off_lic_0(:) ! (klon)      REAL, intent(inout):: run_off_lic_0(:) ! (klon)
128    
129        REAL, intent(out):: albsol(:) ! (klon)
130        ! albedo du sol total, visible, moyen par maille
131    
132        REAL, intent(in):: sollw(:) ! (klon)
133        ! surface net downward longwave flux, in W m-2
134    
135        REAL, intent(in):: solsw(:) ! (klon)
136        ! surface net downward shortwave flux, in W m-2
137    
138        REAL, intent(in):: tsol(:) ! (klon)
139    
140      ! Local:      ! Local:
141    
142        REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
143        REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
144    
145      ! la nouvelle repartition des surfaces sortie de l'interface      ! la nouvelle repartition des surfaces sortie de l'interface
146      REAL, save:: pctsrf_new_oce(klon)      REAL, save:: pctsrf_new_oce(klon)
147      REAL, save:: pctsrf_new_sic(klon)      REAL, save:: pctsrf_new_sic(klon)
# Line 138  contains Line 151  contains
151      REAL run_off_lic(klon) ! ruissellement total      REAL run_off_lic(klon) ! ruissellement total
152      REAL rugmer(klon)      REAL rugmer(klon)
153      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
154      REAL yts(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), ypctsrf(klon), yz0_new(klon)
155      real yrugos(klon) ! longueur de rugosite (en m)      real yrugos(klon) ! longueur de rugosite (en m)
156      REAL yalb(klon)      REAL yalb(klon)
157      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
158      real yqsol(klon) ! column-density of water in soil, in kg m-2      real yqsol(klon) ! column-density of water in soil, in kg m-2
159      REAL yrain_f(klon) ! liquid water mass flux (kg / m2 / s), positive down      REAL yrain_fall(klon) ! liquid water mass flux (kg / m2 / s), positive down
160      REAL ysnow_f(klon) ! solid water mass flux (kg / m2 / s), positive down      REAL ysnow_fall(klon) ! solid water mass flux (kg / m2 / s), positive down
161      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), radsol(klon), yrugoro(klon)
162      REAL yfluxlat(klon)      REAL yfluxlat(klon)
163      REAL y_d_ts(klon)      REAL y_d_ts(klon)
164      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
# Line 181  contains Line 194  contains
194      REAL u1(klon), v1(klon)      REAL u1(klon), v1(klon)
195      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
196      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
197        REAL zgeo1(klon)
     REAL qairsol(klon), zgeo1(klon)  
198      REAL rugo1(klon)      REAL rugo1(klon)
199      REAL zgeop(klon, klev)      REAL zgeop(klon, klev)
200    
201      !------------------------------------------------------------      !------------------------------------------------------------
202    
203        albsol = sum(falbe * pctsrf, dim = 2)
204    
205        ! R\'epartition sous maille des flux longwave et shortwave
206        ! R\'epartition du longwave par sous-surface lin\'earis\'ee
207    
208        forall (nsrf = 1:nbsrf)
209           fsollw(:, nsrf) = sollw + 4. * RSIGMA * tsol**3 &
210                * (tsol - ftsol(:, nsrf))
211           fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
212        END forall
213    
214      ytherm = 0.      ytherm = 0.
215    
216      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
# Line 202  contains Line 225  contains
225      cdragm = 0.      cdragm = 0.
226      dflux_t = 0.      dflux_t = 0.
227      dflux_q = 0.      dflux_q = 0.
     ypct = 0.  
     yqsurf = 0.  
     yrain_f = 0.  
     ysnow_f = 0.  
228      yrugos = 0.      yrugos = 0.
229      ypaprs = 0.      ypaprs = 0.
230      ypplay = 0.      ypplay = 0.
# Line 243  contains Line 262  contains
262    
263      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
264         ! Define ni and knon:         ! Define ni and knon:
265          
266         ni = 0         ni = 0
267         knon = 0         knon = 0
268    
# Line 257  contains Line 276  contains
276         END DO         END DO
277    
278         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
279            DO j = 1, knon            ypctsrf(:knon) = pctsrf(ni(:knon), nsrf)
280               i = ni(j)            yts(:knon) = ftsol(ni(:knon), nsrf)
281               ypct(j) = pctsrf(i, nsrf)            snow(:knon) = fsnow(ni(:knon), nsrf)
282               yts(j) = ftsol(i, nsrf)            yqsurf(:knon) = fqsurf(ni(:knon), nsrf)
283               snow(j) = fsnow(i, nsrf)            yalb(:knon) = falbe(ni(:knon), nsrf)
284               yqsurf(j) = qsurf(i, nsrf)            yrain_fall(:knon) = rain_fall(ni(:knon))
285               yalb(j) = falbe(i, nsrf)            ysnow_fall(:knon) = snow_fall(ni(:knon))
286               yrain_f(j) = rain_fall(i)            yagesno(:knon) = agesno(ni(:knon), nsrf)
287               ysnow_f(j) = snow_f(i)            yrugos(:knon) = frugs(ni(:knon), nsrf)
288               yagesno(j) = agesno(i, nsrf)            yrugoro(:knon) = rugoro(ni(:knon))
289               yrugos(j) = frugs(i, nsrf)            radsol(:knon) = fsolsw(ni(:knon), nsrf) + fsollw(ni(:knon), nsrf)
290               yrugoro(j) = rugoro(i)            ypaprs(:knon, klev + 1) = paprs(ni(:knon), klev + 1)
291               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)            y_run_off_lic_0(:knon) = run_off_lic_0(ni(:knon))
              ypaprs(j, klev + 1) = paprs(i, klev + 1)  
              y_run_off_lic_0(j) = run_off_lic_0(i)  
           END DO  
292    
293            ! For continent, copy soil water content            ! For continent, copy soil water content
294            IF (nsrf == is_ter) yqsol(:knon) = qsol(ni(:knon))            IF (nsrf == is_ter) yqsol(:knon) = qsol(ni(:knon))
# Line 283  contains Line 299  contains
299               DO j = 1, knon               DO j = 1, knon
300                  i = ni(j)                  i = ni(j)
301                  ypaprs(j, k) = paprs(i, k)                  ypaprs(j, k) = paprs(i, k)
302                  ypplay(j, k) = pplay(i, k)                  ypplay(j, k) = play(i, k)
303                  ydelp(j, k) = delp(i, k)                  ydelp(j, k) = delp(i, k)
304                  yu(j, k) = u(i, k)                  yu(j, k) = u(i, k)
305                  yv(j, k) = v(i, k)                  yv(j, k) = v(i, k)
# Line 324  contains Line 340  contains
340                 ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &                 ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &
341                 yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &                 yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &
342                 ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))                 ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))
343              
344            CALL clvent(yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &            CALL clvent(yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
345                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
346                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
# Line 338  contains Line 354  contains
354                 mu0(ni(:knon)), yrugos(:knon), yrugoro(:knon), yu(:knon, 1), &                 mu0(ni(:knon)), yrugos(:knon), yrugoro(:knon), yu(:knon, 1), &
355                 yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), yt(:knon, :), &                 yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), yt(:knon, :), &
356                 yq(:knon, :), yts(:knon), ypaprs(:knon, :), ypplay(:knon, :), &                 yq(:knon, :), yts(:knon), ypaprs(:knon, :), ypplay(:knon, :), &
357                 ydelp(:knon, :), yrads(:knon), yalb(:knon), snow(:knon), &                 ydelp(:knon, :), radsol(:knon), yalb(:knon), snow(:knon), &
358                 yqsurf(:knon), yrain_f(:knon), ysnow_f(:knon), yfluxlat(:knon), &                 yqsurf(:knon), yrain_fall(:knon), ysnow_fall(:knon), &
359                 pctsrf_new_sic(ni(:knon)), yagesno(:knon), y_d_t(:knon, :), &                 yfluxlat(:knon), pctsrf_new_sic(ni(:knon)), yagesno(:knon), &
360                 y_d_q(:knon, :), y_d_ts(:knon), yz0_new(:knon), &                 y_d_t(:knon, :), y_d_q(:knon, :), y_d_ts(:knon), &
361                 y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &                 yz0_new(:knon), y_flux_t(:knon), y_flux_q(:knon), &
362                 y_dflux_q(:knon), y_fqcalving(:knon), y_ffonte(:knon), &                 y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving(:knon), &
363                 y_run_off_lic_0(:knon), y_run_off_lic(:knon))                 y_ffonte(:knon), y_run_off_lic_0(:knon), y_run_off_lic(:knon))
364    
365            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
366    
# Line 362  contains Line 378  contains
378            DO k = 1, klev            DO k = 1, klev
379               DO j = 1, knon               DO j = 1, knon
380                  i = ni(j)                  i = ni(j)
381                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypctsrf(j)
382                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypctsrf(j)
383                  y_d_u(j, k) = y_d_u(j, k) * ypct(j)                  y_d_u(j, k) = y_d_u(j, k) * ypctsrf(j)
384                  y_d_v(j, k) = y_d_v(j, k) * ypct(j)                  y_d_v(j, k) = y_d_v(j, k) * ypctsrf(j)
385               END DO               END DO
386            END DO            END DO
387    
# Line 374  contains Line 390  contains
390            flux_u(ni(:knon), nsrf) = y_flux_u(:knon)            flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
391            flux_v(ni(:knon), nsrf) = y_flux_v(:knon)            flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
392    
           evap(:, nsrf) = -flux_q(:, nsrf)  
   
393            falbe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
394            fsnow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
395            qsurf(:, nsrf) = 0.            fqsurf(:, nsrf) = 0.
396            frugs(:, nsrf) = 0.            frugs(:, nsrf) = 0.
397            DO j = 1, knon            DO j = 1, knon
398               i = ni(j)               i = ni(j)
399               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
400               falbe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
401               fsnow(i, nsrf) = snow(j)               fsnow(i, nsrf) = snow(j)
402               qsurf(i, nsrf) = yqsurf(j)               fqsurf(i, nsrf) = yqsurf(j)
403               frugs(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
404               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
405               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
# Line 395  contains Line 409  contains
409               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
410               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
411               ffonte(i, nsrf) = y_ffonte(j)               ffonte(i, nsrf) = y_ffonte(j)
412               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)               cdragh(i) = cdragh(i) + ycdragh(j) * ypctsrf(j)
413               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)               cdragm(i) = cdragm(i) + ycdragm(j) * ypctsrf(j)
414               dflux_t(i) = dflux_t(i) + y_dflux_t(j) * ypct(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j) * ypctsrf(j)
415               dflux_q(i) = dflux_q(i) + y_dflux_q(j) * ypct(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j) * ypctsrf(j)
416            END DO            END DO
417            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
418               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 424  contains Line 438  contains
438            END DO            END DO
439    
440            forall (k = 2:klev) coefh(ni(:knon), k) &            forall (k = 2:klev) coefh(ni(:knon), k) &
441                 = coefh(ni(:knon), k) + ycoefh(:knon, k) * ypct(:knon)                 = coefh(ni(:knon), k) + ycoefh(:knon, k) * ypctsrf(:knon)
442    
443            ! diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
444    
# Line 443  contains Line 457  contains
457               END IF               END IF
458               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
459               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
   
              qairsol(j) = yqsurf(j)  
460            END DO            END DO
461    
462            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &
463                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, &                 zgeo1, tairsol, yqsurf(:knon), rugo1, psfce, patm, yt2m, yq2m, &
464                 yq10m, wind10m(:knon), ustar(:knon))                 yt10m, yq10m, wind10m(:knon), ustar(:knon))
465    
466            DO j = 1, knon            DO j = 1, knon
467               i = ni(j)               i = ni(j)
Legend:
Removed from v.303  
changed lines
  Added in v.309
  ViewVC Help
Powered by ViewVC 1.1.21