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

Diff of /trunk/phylmd/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 276 by guez, Thu Jul 12 14:49:20 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 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 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
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, rkappa      USE suphec_m, ONLY: rd, rg
37      use time_phylmdz, only: itap      use time_phylmdz, only: itap
     use ustarhb_m, only: ustarhb  
     use yamada4_m, only: yamada4  
38    
39      REAL, INTENT(IN):: dtime ! interval du temps (secondes)      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
40    
# Line 52  contains Line 48  contains
48      REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal    
49      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)
50      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  
51    
52      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
53      ! soil temperature of surface fraction      ! soil temperature of surface fraction
# Line 126  contains Line 120  contains
120      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
121      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
122      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  
123      REAL plcl(klon, nbsrf)      REAL plcl(klon, nbsrf)
124      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
125      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
# Line 171  contains Line 159  contains
159      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
160      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
161      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)  
162      REAL yq2(klon, klev + 1)      REAL yq2(klon, klev + 1)
163      REAL delp(klon, klev)      REAL delp(klon, klev)
164      INTEGER i, k, nsrf      INTEGER i, k, nsrf
# Line 193  contains Line 179  contains
179      REAL ycteicl(klon)      REAL ycteicl(klon)
180      REAL ypblt(klon)      REAL ypblt(klon)
181      REAL ytherm(klon)      REAL ytherm(klon)
     REAL ytrmb1(klon)  
     REAL ytrmb2(klon)  
     REAL ytrmb3(klon)  
182      REAL u1(klon), v1(klon)      REAL u1(klon), v1(klon)
183      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
184      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
# Line 323  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))
           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, :))  
313    
314            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, :))  
315               ycdragm(:knon) = max(ycdragm(:knon), 0.)               ycdragm(:knon) = max(ycdragm(:knon), 0.)
316               ycdragh(:knon) = max(ycdragh(:knon), 0.)               ycdragh(:knon) = max(ycdragh(:knon), 0.)
317            END IF            end IF
318    
319            ! on met un seuil pour ycdragm et ycdragh            ! on met un seuil pour ycdragm et ycdragh
320            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
# Line 347  contains Line 322  contains
322               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)
323            END IF            END IF
324    
325            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  
   
326               DO k = 1, klev + 1               DO k = 1, klev + 1
327                  DO j = 1, knon                  DO j = 1, knon
328                     i = ni(j)                     i = ni(j)
329                     yq2(j, k) = q2(i, k, nsrf)                     yq2(j, k) = q2(i, k, nsrf)
330                  END DO                  END DO
331               END DO               END DO
332              end IF
333    
334               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), ycdragm(:knon))            call coef_diff_turb(dtime, nsrf, ni(:knon), ypaprs(:knon, :), &
335               CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &                 ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &
336                    yu(:knon, :), yv(:knon, :), yteta(:knon, :), yq2(:knon, :), &                 yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &
337                    ycoefm(:knon, :), ycoefh(:knon, :), ustar(:knon))                 ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))
           END IF  
338    
339            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
340                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
# Line 518  contains Line 458  contains
458               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
459            END DO            END DO
460    
461            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &
462                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, &
463                 yq2m, yt10m, yq10m, wind10m(:knon), ustar(:knon))                 yq10m, wind10m(:knon), ustar(:knon))
464    
465            DO j = 1, knon            DO j = 1, knon
466               i = ni(j)               i = ni(j)
# Line 535  contains Line 475  contains
475    
476            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
477                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
478                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ylcl)
479    
480            DO j = 1, knon            DO j = 1, knon
481               i = ni(j)               i = ni(j)
# Line 546  contains Line 486  contains
486               cteicl(i, nsrf) = ycteicl(j)               cteicl(i, nsrf) = ycteicl(j)
487               pblt(i, nsrf) = ypblt(j)               pblt(i, nsrf) = ypblt(j)
488               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)  
489            END DO            END DO
490    
491            DO j = 1, knon            DO j = 1, knon
# Line 569  contains Line 506  contains
506    
507      firstcal = .false.      firstcal = .false.
508    
509    END SUBROUTINE clmain    END SUBROUTINE pbl_surface
510    
511  end module clmain_m  end module pbl_surface_m
Legend:
Removed from v.248  
changed lines
  Added in v.276
  ViewVC Help
Powered by ViewVC 1.1.21