/[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 248 by guez, Fri Jan 5 16:40:13 2018 UTC trunk/phylmd/pbl_surface.f revision 267 by guez, Thu May 3 16:14:08 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, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &         cdmmax, cdhmax, ftsoil, qsol, paprs, pplay, fsnow, qsurf, evap, falbe, &
9         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, &         fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, agesno, rugoro, d_t, &
10         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &
11         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, coefh, t2m, q2m, &         q2, dflux_t, dflux_q, coefh, t2m, q2m, u10m_srf, v10m_srf, pblh, capcl, &
12         u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &         oliqcl, cteicl, pblt, therm, plcl, fqcalving, ffonte, run_off_lic_0)
        trmb2, trmb3, 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/08/18
# Line 24  contains Line 23  contains
23      use clcdrag_m, only: clcdrag      use clcdrag_m, only: clcdrag
24      use clqh_m, only: clqh      use clqh_m, only: clqh
25      use clvent_m, only: clvent      use clvent_m, only: clvent
26      use coefkz_m, only: coefkz      use coef_diff_turb_m, only: coef_diff_turb
     use coefkzmin_m, only: coefkzmin  
     use coefkz2_m, only: coefkz2  
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, zmasq
# Line 35  contains Line 32  contains
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 stdlevvar_m, only: stdlevvar      use stdlevvar_m, only: stdlevvar
35      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg
36      use time_phylmdz, only: itap      use time_phylmdz, only: itap
     use ustarhb_m, only: ustarhb  
     use yamada4_m, only: yamada4  
37    
38      REAL, INTENT(IN):: dtime ! interval du temps (secondes)      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
39    
# Line 52  contains Line 47  contains
47      REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal    
48      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)
49      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
     REAL, INTENT(IN):: ksta, ksta_ter  
     LOGICAL, INTENT(IN):: ok_kzmin  
50    
51      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
52      ! soil temperature of surface fraction      ! soil temperature of surface fraction
# Line 126  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)      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
124      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
# Line 171  contains Line 158  contains
158      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
159      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
160      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
     REAL ycoefm0(klon, 2:klev), ycoefh0(klon, 2:klev)  
     REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)  
161      REAL yq2(klon, klev + 1)      REAL yq2(klon, klev + 1)
162      REAL delp(klon, klev)      REAL delp(klon, klev)
163      INTEGER i, k, nsrf      INTEGER i, k, nsrf
# Line 193  contains Line 178  contains
178      REAL ycteicl(klon)      REAL ycteicl(klon)
179      REAL ypblt(klon)      REAL ypblt(klon)
180      REAL ytherm(klon)      REAL ytherm(klon)
     REAL ytrmb1(klon)  
     REAL ytrmb2(klon)  
     REAL ytrmb3(klon)  
181      REAL u1(klon), v1(klon)      REAL u1(klon), v1(klon)
182      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
183      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
# Line 327  contains Line 309  contains
309                 yq(:knon, 1), zgeop(:knon, 1), yts(:knon), yqsurf(:knon), &                 yq(:knon, 1), zgeop(:knon, 1), yts(:knon), yqsurf(:knon), &
310                 yrugos(:knon), ycdragm(:knon), ycdragh(:knon))                 yrugos(:knon), ycdragm(:knon), ycdragh(:knon))
311    
           CALL coefkz(nsrf, ypaprs(:knon, :), ypplay(:knon, :), ksta, &  
                ksta_ter, yts(:knon), yu(:knon, :), yv(:knon, :), yt(:knon, :), &  
                yq(:knon, :), zgeop(:knon, :), ycoefm(:knon, :), &  
                ycoefh(:knon, :))  
   
312            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
              CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0(:knon, :), &  
                   ycoefh0(:knon, :))  
              ycoefm(:knon, :) = max(ycoefm(:knon, :), ycoefm0(:knon, :))  
              ycoefh(:knon, :) = max(ycoefh(:knon, :), ycoefh0(:knon, :))  
313               ycdragm(:knon) = max(ycdragm(:knon), 0.)               ycdragm(:knon) = max(ycdragm(:knon), 0.)
314               ycdragh(:knon) = max(ycdragh(:knon), 0.)               ycdragh(:knon) = max(ycdragh(:knon), 0.)
315            END IF            end IF
316    
317            ! on met un seuil pour ycdragm et ycdragh            ! on met un seuil pour ycdragm et ycdragh
318            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
# Line 347  contains Line 320  contains
320               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)
321            END IF            END IF
322    
323            IF (ok_kzmin) THEN            IF (iflag_pbl >= 6) then
              ! Calcul d'une diffusion minimale pour les conditions tres stables  
              CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &  
                   ycdragm(:knon), ycoefh0(:knon, :))  
              ycoefm0(:knon, :) = ycoefh0(:knon, :)  
              ycoefm(:knon, :) = max(ycoefm(:knon, :), ycoefm0(:knon, :))  
              ycoefh(:knon, :) = max(ycoefh(:knon, :), ycoefh0(:knon, :))  
           END IF  
   
           IF (iflag_pbl >= 6) THEN  
              ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et  
              ! Fr\'ed\'eric Hourdin  
              yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &  
                   + ypplay(:knon, 1))) &  
                   * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg  
   
              DO k = 2, klev  
                 yzlay(:knon, k) = yzlay(:knon, k-1) &  
                      + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &  
                      / ypaprs(1:knon, k) &  
                      * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg  
              END DO  
   
              DO k = 1, klev  
                 yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &  
                      / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))  
              END DO  
   
              zlev(:knon, 1) = 0.  
              zlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &  
                   - yzlay(:knon, klev - 1)  
   
              DO k = 2, klev  
                 zlev(:knon, k) = 0.5 * (yzlay(:knon, k) + yzlay(:knon, k-1))  
              END DO  
   
324               DO k = 1, klev + 1               DO k = 1, klev + 1
325                  DO j = 1, knon                  DO j = 1, knon
326                     i = ni(j)                     i = ni(j)
327                     yq2(j, k) = q2(i, k, nsrf)                     yq2(j, k) = q2(i, k, nsrf)
328                  END DO                  END DO
329               END DO               END DO
330              end IF
331    
332               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), ycdragm(:knon))            call coef_diff_turb(dtime, nsrf, ni(:knon), ypaprs(:knon, :), &
333               CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &                 ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &
334                    yu(:knon, :), yv(:knon, :), yteta(:knon, :), yq2(:knon, :), &                 yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &
335                    ycoefm(:knon, :), ycoefh(:knon, :), ustar(:knon))                 ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))
           END IF  
336    
337            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
338                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
# Line 535  contains Line 473  contains
473    
474            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
475                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
476                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ylcl)
477    
478            DO j = 1, knon            DO j = 1, knon
479               i = ni(j)               i = ni(j)
# Line 546  contains Line 484  contains
484               cteicl(i, nsrf) = ycteicl(j)               cteicl(i, nsrf) = ycteicl(j)
485               pblt(i, nsrf) = ypblt(j)               pblt(i, nsrf) = ypblt(j)
486               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)  
487            END DO            END DO
488    
489            DO j = 1, knon            DO j = 1, knon
# Line 569  contains Line 504  contains
504    
505      firstcal = .false.      firstcal = .false.
506    
507    END SUBROUTINE clmain    END SUBROUTINE pbl_surface
508    
509  end module clmain_m  end module pbl_surface_m
Legend:
Removed from v.248  
changed lines
  Added in v.267
  ViewVC Help
Powered by ViewVC 1.1.21