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

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

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

revision 303 by guez, Thu Sep 6 14:25:07 2018 UTC revision 307 by guez, Tue Sep 11 12:52:28 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, pplay, fsnow, qsurf, 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)
# Line 58  contains Line 59  contains
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):: pplay(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):: qsurf(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 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        ! rayonnement infrarouge montant \`a la surface
134        
135        REAL, intent(in):: solsw(:) ! (klon)
136        REAL, intent(in):: tsol(:) ! (klon)
137    
138      ! Local:      ! Local:
139    
140        REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
141        REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
142    
143      ! la nouvelle repartition des surfaces sortie de l'interface      ! la nouvelle repartition des surfaces sortie de l'interface
144      REAL, save:: pctsrf_new_oce(klon)      REAL, save:: pctsrf_new_oce(klon)
145      REAL, save:: pctsrf_new_sic(klon)      REAL, save:: pctsrf_new_sic(klon)
# Line 143  contains Line 154  contains
154      REAL yalb(klon)      REAL yalb(klon)
155      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
156      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
157      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
158      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
159      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
160      REAL yfluxlat(klon)      REAL yfluxlat(klon)
161      REAL y_d_ts(klon)      REAL y_d_ts(klon)
# Line 181  contains Line 192  contains
192      REAL u1(klon), v1(klon)      REAL u1(klon), v1(klon)
193      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
194      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
195        REAL zgeo1(klon)
     REAL qairsol(klon), zgeo1(klon)  
196      REAL rugo1(klon)      REAL rugo1(klon)
197      REAL zgeop(klon, klev)      REAL zgeop(klon, klev)
198    
199      !------------------------------------------------------------      !------------------------------------------------------------
200    
201        albsol = sum(falbe * pctsrf, dim = 2)
202    
203        ! R\'epartition sous maille des flux longwave et shortwave
204        ! R\'epartition du longwave par sous-surface lin\'earis\'ee
205    
206        forall (nsrf = 1:nbsrf)
207           fsollw(:, nsrf) = sollw + 4. * RSIGMA * tsol**3 &
208                * (tsol - ftsol(:, nsrf))
209           fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
210        END forall
211    
212      ytherm = 0.      ytherm = 0.
213    
214      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
# Line 203  contains Line 224  contains
224      dflux_t = 0.      dflux_t = 0.
225      dflux_q = 0.      dflux_q = 0.
226      ypct = 0.      ypct = 0.
     yqsurf = 0.  
     yrain_f = 0.  
     ysnow_f = 0.  
227      yrugos = 0.      yrugos = 0.
228      ypaprs = 0.      ypaprs = 0.
229      ypplay = 0.      ypplay = 0.
# Line 264  contains Line 282  contains
282               snow(j) = fsnow(i, nsrf)               snow(j) = fsnow(i, nsrf)
283               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
284               yalb(j) = falbe(i, nsrf)               yalb(j) = falbe(i, nsrf)
285               yrain_f(j) = rain_fall(i)               yrain_fall(j) = rain_fall(i)
286               ysnow_f(j) = snow_f(i)               ysnow_fall(j) = snow_fall(i)
287               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
288               yrugos(j) = frugs(i, nsrf)               yrugos(j) = frugs(i, nsrf)
289               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
# Line 339  contains Line 357  contains
357                 yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), yt(:knon, :), &                 yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), yt(:knon, :), &
358                 yq(:knon, :), yts(:knon), ypaprs(:knon, :), ypplay(:knon, :), &                 yq(:knon, :), yts(:knon), ypaprs(:knon, :), ypplay(:knon, :), &
359                 ydelp(:knon, :), yrads(:knon), yalb(:knon), snow(:knon), &                 ydelp(:knon, :), yrads(:knon), yalb(:knon), snow(:knon), &
360                 yqsurf(:knon), yrain_f(:knon), ysnow_f(:knon), yfluxlat(:knon), &                 yqsurf(:knon), yrain_fall(:knon), ysnow_fall(:knon), &
361                 pctsrf_new_sic(ni(:knon)), yagesno(:knon), y_d_t(:knon, :), &                 yfluxlat(:knon), pctsrf_new_sic(ni(:knon)), yagesno(:knon), &
362                 y_d_q(:knon, :), y_d_ts(:knon), yz0_new(:knon), &                 y_d_t(:knon, :), y_d_q(:knon, :), y_d_ts(:knon), &
363                 y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &                 yz0_new(:knon), y_flux_t(:knon), y_flux_q(:knon), &
364                 y_dflux_q(:knon), y_fqcalving(:knon), y_ffonte(:knon), &                 y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving(:knon), &
365                 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))
366    
367            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
368    
# Line 374  contains Line 392  contains
392            flux_u(ni(:knon), nsrf) = y_flux_u(:knon)            flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
393            flux_v(ni(:knon), nsrf) = y_flux_v(:knon)            flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
394    
           evap(:, nsrf) = -flux_q(:, nsrf)  
   
395            falbe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
396            fsnow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
397            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
# Line 443  contains Line 459  contains
459               END IF               END IF
460               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
461               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
   
              qairsol(j) = yqsurf(j)  
462            END DO            END DO
463    
464            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &
465                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, &                 zgeo1, tairsol, yqsurf(:knon), rugo1, psfce, patm, yt2m, yq2m, &
466                 yq10m, wind10m(:knon), ustar(:knon))                 yt10m, yq10m, wind10m(:knon), ustar(:knon))
467    
468            DO j = 1, knon            DO j = 1, knon
469               i = ni(j)               i = ni(j)
Legend:
Removed from v.303  
changed lines
  Added in v.307
  ViewVC Help
Powered by ViewVC 1.1.21