/[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

trunk/phylmd/pbl_surface.f revision 271 by guez, Wed Jul 11 13:22:39 2018 UTC trunk/phylmd/Interface_surf/pbl_surface.f revision 300 by guez, Thu Aug 2 15:55:01 2018 UTC
# Line 4  module pbl_surface_m Line 4  module pbl_surface_m
4    
5  contains  contains
6    
7    SUBROUTINE pbl_surface(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, &    SUBROUTINE pbl_surface(pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &
8         cdmmax, cdhmax, ftsoil, qsol, paprs, pplay, fsnow, qsurf, evap, falbe, &         cdhmax, ftsoil, qsol, paprs, pplay, fsnow, qsurf, evap, falbe, fluxlat, &
9         fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, agesno, rugoro, d_t, &         rain_fall, snow_f, fsolsw, fsollw, frugs, agesno, rugoro, d_t, d_q, &
10         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &         d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &
11         q2, dflux_t, dflux_q, coefh, t2m, q2m, u10m_srf, v10m_srf, pblh, capcl, &         dflux_t, dflux_q, coefh, t2m, q2m, u10m_srf, v10m_srf, pblh, capcl, &
12         oliqcl, cteicl, pblt, therm, plcl, fqcalving, ffonte, run_off_lic_0)         oliqcl, cteicl, pblt, therm, plcl, fqcalving, ffonte, run_off_lic_0)
13    
14      ! 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
15      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18      ! Author: Z. X. Li (LMD/CNRS), date: 1993 Aug. 18th
16      ! Objet : interface de couche limite (diffusion verticale)      ! Objet : interface de couche limite (diffusion verticale)
17    
18      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul
# Line 20  contains Line 20  contains
20      ! ne tient pas compte de la diff\'erentiation des sous-fractions      ! ne tient pas compte de la diff\'erentiation des sous-fractions
21      ! de sol.      ! de sol.
22    
23      use clcdrag_m, only: clcdrag      use cdrag_m, only: cdrag
24      use clqh_m, only: clqh      use clqh_m, only: clqh
25      use clvent_m, only: clvent      use clvent_m, only: clvent
26      use coef_diff_turb_m, only: coef_diff_turb      use coef_diff_turb_m, only: coef_diff_turb
27      USE conf_gcm_m, ONLY: lmt_pas      USE conf_gcm_m, ONLY: lmt_pas
28      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
29      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon
30      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
31      use hbtm_m, only: hbtm      use hbtm_m, only: hbtm
32      USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf      USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
33      USE interfoce_lim_m, ONLY: interfoce_lim      USE interfoce_lim_m, ONLY: interfoce_lim
34        use phyetat0_m, only: zmasq
35      use stdlevvar_m, only: stdlevvar      use stdlevvar_m, only: stdlevvar
36      USE suphec_m, ONLY: rd, rg      USE suphec_m, ONLY: rd, rg
37      use time_phylmdz, only: itap      use time_phylmdz, only: itap
38    
     REAL, INTENT(IN):: dtime ! interval du temps (secondes)  
   
39      REAL, INTENT(inout):: pctsrf(klon, nbsrf)      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
40      ! tableau des pourcentages de surface de chaque maille      ! tableau des pourcentages de surface de chaque maille
41    
# Line 73  contains Line 72  contains
72      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
73      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
74    
75      REAL d_t(klon, klev), d_q(klon, klev)      REAL, intent(out):: d_t(:, :), d_q(:, :) ! (klon, klev)
76      ! d_t------output-R- le changement pour "t"      ! changement pour t et q
     ! d_q------output-R- le changement pour "q"  
77    
78      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
79      ! changement pour "u" et "v"      ! changement pour "u" et "v"
# Line 120  contains Line 118  contains
118      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
119      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
120      REAL plcl(klon, nbsrf)      REAL plcl(klon, nbsrf)
121      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)  
122        REAL, intent(out):: fqcalving(klon, nbsrf)
123        ! flux d'eau "perdue" par la surface et necessaire pour limiter la
124        ! hauteur de neige, en kg / m2 / s
125    
126        real ffonte(klon, nbsrf)
127      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
128      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la      REAL, intent(inout):: run_off_lic_0(:) ! (klon)
     !           hauteur de neige, en kg / m2 / s  
     REAL run_off_lic_0(klon)  
129    
130      ! Local:      ! Local:
131    
# Line 139  contains Line 140  contains
140      REAL rugmer(klon)      REAL rugmer(klon)
141      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
142      REAL yts(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), ypct(klon), yz0_new(klon)
143      real yrugos(klon) ! longeur de rugosite (en m)      real yrugos(klon) ! longueur de rugosite (en m)
144      REAL yalb(klon)      REAL yalb(klon)
145      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
146      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
# Line 210  contains Line 211  contains
211      ypaprs = 0.      ypaprs = 0.
212      ypplay = 0.      ypplay = 0.
213      ydelp = 0.      ydelp = 0.
     yu = 0.  
     yv = 0.  
     yt = 0.  
     yq = 0.  
     y_dflux_t = 0.  
     y_dflux_q = 0.  
214      yrugoro = 0.      yrugoro = 0.
215      d_ts = 0.      d_ts = 0.
216      flux_t = 0.      flux_t = 0.
# Line 228  contains Line 223  contains
223      d_u = 0.      d_u = 0.
224      d_v = 0.      d_v = 0.
225      coefh = 0.      coefh = 0.
226        fqcalving = 0.
227    
228      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
229      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
# Line 305  contains Line 301  contains
301                    * (ypplay(:knon, k - 1) - ypplay(:knon, k))                    * (ypplay(:knon, k - 1) - ypplay(:knon, k))
302            ENDDO            ENDDO
303    
304            CALL clcdrag(nsrf, sqrt(yu(:knon, 1)**2 + yv(:knon, 1)**2), &            CALL cdrag(nsrf, sqrt(yu(:knon, 1)**2 + yv(:knon, 1)**2), &
305                 yt(:knon, 1), yq(:knon, 1), zgeop(:knon, 1), yts(:knon), &                 yt(:knon, 1), yq(:knon, 1), zgeop(:knon, 1), ypaprs(:knon, 1), &
306                 yqsurf(:knon), yrugos(:knon), ycdragm(:knon), ycdragh(:knon))                 yts(:knon), yqsurf(:knon), yrugos(:knon), ycdragm(:knon), &
307                   ycdragh(:knon))
308    
309            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
310               ycdragm(:knon) = max(ycdragm(:knon), 0.)               ycdragm(:knon) = max(ycdragm(:knon), 0.)
# Line 329  contains Line 326  contains
326               END DO               END DO
327            end IF            end IF
328    
329            call coef_diff_turb(dtime, nsrf, ni(:knon), ypaprs(:knon, :), &            call coef_diff_turb(nsrf, ni(:knon), ypaprs(:knon, :), &
330                 ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &                 ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &
331                 yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &                 yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &
332                 ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))                 ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))
333    
334            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &            CALL clvent(yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
335                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
336                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
337                 y_flux_u(:knon))                 y_flux_u(:knon))
338            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &            CALL clvent(yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
339                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
340                 ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &                 ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
341                 y_flux_v(:knon))                 y_flux_v(:knon))
342    
343            ! calculer la diffusion de "q" et de "h"            CALL clqh(julien, firstcal, nsrf, ni(:knon), ytsoil(:knon, :), &
344            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &                 yqsol(:knon), mu0(ni(:knon)), yrugos(:knon), yrugoro(:knon), &
                ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &  
345                 yu(:knon, 1), yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), &                 yu(:knon, 1), yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), &
346                 yt, yq, yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), &                 yt(:knon, :), yq(:knon, :), yts(:knon), ypaprs(:knon, :), &
347                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &                 ypplay(:knon, :), ydelp(:knon, :), yrads(:knon), yalb(:knon), &
348                 yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, &                 snow(:knon), yqsurf(:knon), yrain_f(:knon), ysnow_f(:knon), &
349                 y_d_ts(:knon), yz0_new, y_flux_t(:knon), y_flux_q(:knon), &                 yfluxlat(:knon), pctsrf_new_sic(ni(:knon)), yagesno(:knon), &
350                 y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving, y_ffonte, &                 y_d_t(:knon, :), y_d_q(:knon, :), y_d_ts(:knon), &
351                 y_run_off_lic_0)                 yz0_new(:knon), y_flux_t(:knon), y_flux_q(:knon), &
352                   y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving(:knon), &
353                   y_ffonte(:knon), y_run_off_lic_0(:knon))
354    
355            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
356    
357            yrugm = 0.            yrugm = 0.
358    
359            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
360               DO j = 1, knon               DO j = 1, knon
361                  yrugm(j) = 0.018 * ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2) &                  yrugm(j) = 0.018 * ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2) &
# Line 364  contains Line 364  contains
364                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
365               END DO               END DO
366            END IF            END IF
           DO j = 1, knon  
              y_dflux_t(j) = y_dflux_t(j) * ypct(j)  
              y_dflux_q(j) = y_dflux_q(j) * ypct(j)  
           END DO  
367    
368            DO k = 1, klev            DO k = 1, klev
369               DO j = 1, knon               DO j = 1, knon
# Line 407  contains Line 403  contains
403               ffonte(i, nsrf) = y_ffonte(j)               ffonte(i, nsrf) = y_ffonte(j)
404               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)
405               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)
406               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j) * ypct(j)
407               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j) * ypct(j)
408            END DO            END DO
409            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
410               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 456  contains Line 452  contains
452               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
453            END DO            END DO
454    
455            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &
456                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, &
457                 yq2m, yt10m, yq10m, wind10m(:knon), ustar(:knon))                 yq10m, wind10m(:knon), ustar(:knon))
458    
459            DO j = 1, knon            DO j = 1, knon
460               i = ni(j)               i = ni(j)
# Line 472  contains Line 468  contains
468            END DO            END DO
469    
470            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
471                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu(:knon, :), yv(:knon, :), yt(:knon, :), &
472                 yoliqcl, ycteicl, ypblt, ytherm, ylcl)                 yq(:knon, :), ypblh(:knon), ycapcl, yoliqcl, ycteicl, ypblt, &
473                   ytherm, ylcl)
474    
475            DO j = 1, knon            DO j = 1, knon
476               i = ni(j)               i = ni(j)
Legend:
Removed from v.271  
changed lines
  Added in v.300
  ViewVC Help
Powered by ViewVC 1.1.21