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

trunk/Sources/phylmd/clmain.f revision 251 by guez, Mon Jan 8 14:12:02 2018 UTC trunk/phylmd/Interface_surf/pbl_surface.f revision 297 by guez, Thu Jul 26 16:02:11 2018 UTC
# Line 1  Line 1 
1  module clmain_m  module pbl_surface_m
2    
3    IMPLICIT NONE    IMPLICIT NONE
4    
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &    SUBROUTINE pbl_surface(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, &
8         cdhmax, ftsoil, qsol, paprs, pplay, fsnow, qsurf, evap, falbe, fluxlat, &         cdmmax, cdhmax, ftsoil, qsol, paprs, pplay, fsnow, qsurf, evap, falbe, &
9         rain_fall, snow_f, fsolsw, fsollw, frugs, agesno, rugoro, d_t, d_q, &         fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, agesno, rugoro, d_t, &
10         d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &
11         dflux_t, dflux_q, coefh, t2m, q2m, u10m_srf, v10m_srf, pblh, capcl, &         q2, dflux_t, dflux_q, coefh, t2m, q2m, u10m_srf, v10m_srf, pblh, capcl, &
12         oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, fqcalving, &         oliqcl, cteicl, pblt, therm, plcl, fqcalving, ffonte, run_off_lic_0)
        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 21  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
# Line 74  contains Line 74  contains
74      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
75      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
76    
77      REAL d_t(klon, klev), d_q(klon, klev)      REAL, intent(out):: d_t(klon, klev), d_q(klon, klev)
78      ! d_t------output-R- le changement pour "t"      ! changement pour t et q
     ! d_q------output-R- le changement pour "q"  
79    
80      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
81      ! changement pour "u" et "v"      ! changement pour "u" et "v"
# Line 120  contains Line 119  contains
119      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
120      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
121      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
     REAL trmb1(klon, nbsrf)  
     ! trmb1-------deep_cape  
     REAL trmb2(klon, nbsrf)  
     ! trmb2--------inhibition  
     REAL trmb3(klon, nbsrf)  
     ! trmb3-------Point Omega  
122      REAL plcl(klon, nbsrf)      REAL plcl(klon, nbsrf)
123      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)  
124        REAL, intent(out):: fqcalving(klon, nbsrf)
125        ! flux d'eau "perdue" par la surface et necessaire pour limiter la
126        ! hauteur de neige, en kg / m2 / s
127    
128        real ffonte(klon, nbsrf)
129      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
     ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la  
     !           hauteur de neige, en kg / m2 / s  
130      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
131    
132      ! Local:      ! Local:
# Line 146  contains Line 142  contains
142      REAL rugmer(klon)      REAL rugmer(klon)
143      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
144      REAL yts(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), ypct(klon), yz0_new(klon)
145      real yrugos(klon) ! longeur de rugosite (en m)      real yrugos(klon) ! longueur de rugosite (en m)
146      REAL yalb(klon)      REAL yalb(klon)
147      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
148      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 185  contains Line 181  contains
181      REAL ycteicl(klon)      REAL ycteicl(klon)
182      REAL ypblt(klon)      REAL ypblt(klon)
183      REAL ytherm(klon)      REAL ytherm(klon)
     REAL ytrmb1(klon)  
     REAL ytrmb2(klon)  
     REAL ytrmb3(klon)  
184      REAL u1(klon), v1(klon)      REAL u1(klon), v1(klon)
185      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
186      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
# Line 222  contains Line 215  contains
215      ydelp = 0.      ydelp = 0.
216      yu = 0.      yu = 0.
217      yv = 0.      yv = 0.
     yt = 0.  
218      yq = 0.      yq = 0.
     y_dflux_t = 0.  
     y_dflux_q = 0.  
219      yrugoro = 0.      yrugoro = 0.
220      d_ts = 0.      d_ts = 0.
221      flux_t = 0.      flux_t = 0.
# Line 238  contains Line 228  contains
228      d_u = 0.      d_u = 0.
229      d_v = 0.      d_v = 0.
230      coefh = 0.      coefh = 0.
231        fqcalving = 0.
232    
233      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
234      ! 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 315  contains Line 306  contains
306                    * (ypplay(:knon, k - 1) - ypplay(:knon, k))                    * (ypplay(:knon, k - 1) - ypplay(:knon, k))
307            ENDDO            ENDDO
308    
309            CALL clcdrag(nsrf, yu(:knon, 1), yv(:knon, 1), yt(:knon, 1), &            CALL cdrag(nsrf, sqrt(yu(:knon, 1)**2 + yv(:knon, 1)**2), &
310                 yq(:knon, 1), zgeop(:knon, 1), yts(:knon), yqsurf(:knon), &                 yt(:knon, 1), yq(:knon, 1), zgeop(:knon, 1), ypaprs(:knon, 1), &
311                 yrugos(:knon), ycdragm(:knon), ycdragh(:knon))                 yts(:knon), yqsurf(:knon), yrugos(:knon), ycdragm(:knon), &
312                   ycdragh(:knon))
313    
314            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
315               ycdragm(:knon) = max(ycdragm(:knon), 0.)               ycdragm(:knon) = max(ycdragm(:knon), 0.)
# Line 353  contains Line 345  contains
345                 ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &                 ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
346                 y_flux_v(:knon))                 y_flux_v(:knon))
347    
           ! calculer la diffusion de "q" et de "h"  
348            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
349                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos(:knon), &
350                 yu(:knon, 1), yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), &                 yrugoro(:knon), yu(:knon, 1), yv(:knon, 1), ycoefh(:knon, :), &
351                 yt, yq, yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), &                 ycdragh(:knon), yt(:knon, :), yq(:knon, :), yts(:knon), &
352                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &                 ypaprs(:knon, :), ypplay(:knon, :), ydelp(:knon, :), &
353                 yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, &                 yrads(:knon), yalb(:knon), snow(:knon), yqsurf(:knon), yrain_f, &
354                 y_d_ts(:knon), yz0_new, y_flux_t(:knon), y_flux_q(:knon), &                 ysnow_f, yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), &
355                 y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving, y_ffonte, &                 y_d_t(:knon, :), y_d_q(:knon, :), y_d_ts(:knon), &
356                 y_run_off_lic_0)                 yz0_new(:knon), y_flux_t(:knon), y_flux_q(:knon), &
357                   y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving(:knon), &
358                   y_ffonte, y_run_off_lic_0)
359    
360            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
361    
362            yrugm = 0.            yrugm = 0.
363    
364            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
365               DO j = 1, knon               DO j = 1, knon
366                  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 374  contains Line 369  contains
369                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
370               END DO               END DO
371            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  
372    
373            DO k = 1, klev            DO k = 1, klev
374               DO j = 1, knon               DO j = 1, knon
# Line 417  contains Line 408  contains
408               ffonte(i, nsrf) = y_ffonte(j)               ffonte(i, nsrf) = y_ffonte(j)
409               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)
410               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)
411               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j) * ypct(j)
412               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j) * ypct(j)
413            END DO            END DO
414            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
415               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 466  contains Line 457  contains
457               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
458            END DO            END DO
459    
460            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &
461                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, &
462                 yq2m, yt10m, yq10m, wind10m(:knon), ustar(:knon))                 yq10m, wind10m(:knon), ustar(:knon))
463    
464            DO j = 1, knon            DO j = 1, knon
465               i = ni(j)               i = ni(j)
# Line 482  contains Line 473  contains
473            END DO            END DO
474    
475            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
476                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu, yv, yt(:knon, :), yq, ypblh(:knon), &
477                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 ycapcl, yoliqcl, ycteicl, ypblt, ytherm, ylcl)
478    
479            DO j = 1, knon            DO j = 1, knon
480               i = ni(j)               i = ni(j)
# Line 494  contains Line 485  contains
485               cteicl(i, nsrf) = ycteicl(j)               cteicl(i, nsrf) = ycteicl(j)
486               pblt(i, nsrf) = ypblt(j)               pblt(i, nsrf) = ypblt(j)
487               therm(i, nsrf) = ytherm(j)               therm(i, nsrf) = ytherm(j)
              trmb1(i, nsrf) = ytrmb1(j)  
              trmb2(i, nsrf) = ytrmb2(j)  
              trmb3(i, nsrf) = ytrmb3(j)  
488            END DO            END DO
489    
490            DO j = 1, knon            DO j = 1, knon
# Line 517  contains Line 505  contains
505    
506      firstcal = .false.      firstcal = .false.
507    
508    END SUBROUTINE clmain    END SUBROUTINE pbl_surface
509    
510  end module clmain_m  end module pbl_surface_m
Legend:
Removed from v.251  
changed lines
  Added in v.297
  ViewVC Help
Powered by ViewVC 1.1.21