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

revision 226 by guez, Mon Oct 16 13:04:05 2017 UTC revision 227 by guez, Thu Nov 2 15:47:03 2017 UTC
# Line 25  contains Line 25  contains
25      use clvent_m, only: clvent      use clvent_m, only: clvent
26      use coefkz_m, only: coefkz      use coefkz_m, only: coefkz
27      use coefkzmin_m, only: coefkzmin      use coefkzmin_m, only: coefkzmin
28      USE conf_gcm_m, ONLY: prt_level, lmt_pas      USE conf_gcm_m, ONLY: lmt_pas
29      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
30      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
31      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
# Line 152  contains Line 152  contains
152      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
153      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
154      REAL yalb(klon)      REAL yalb(klon)
   
     REAL u1lay(klon), v1lay(klon) ! vent dans la premi\`ere couche, pour  
                               ! une sous-surface donnée  
       
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_f(klon) ! liquid water mass flux (kg / m2 / s), positive down
# Line 175  contains Line 171  contains
171    
172      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
173    
174      REAL yzlay(klon, klev), yzlev(klon, klev + 1), yteta(klon, klev)      REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)
175      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
176      REAL ykmq(klon, klev + 1)      REAL ykmq(klon, klev + 1)
177      REAL yq2(klon, klev + 1)      REAL yq2(klon, klev + 1)
# Line 190  contains Line 186  contains
186      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
187      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
188    
189      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), wind10m(klon)
190      REAL yustar(klon)      REAL ustar(klon)
191    
192      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
193      REAL ypblh(klon)      REAL ypblh(klon)
# Line 204  contains Line 200  contains
200      REAL ytrmb1(klon)      REAL ytrmb1(klon)
201      REAL ytrmb2(klon)      REAL ytrmb2(klon)
202      REAL ytrmb3(klon)      REAL ytrmb3(klon)
203      REAL uzon(klon), vmer(klon)      REAL u1(klon), v1(klon)
204      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
205      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
206    
207      REAL qairsol(klon), zgeo1(klon)      REAL qairsol(klon), zgeo1(klon)
208      REAL rugo1(klon)      REAL rugo1(klon)
209    
     ! utiliser un jeu de fonctions simples                
     LOGICAL zxli  
     PARAMETER (zxli=.FALSE.)  
   
210      !------------------------------------------------------------      !------------------------------------------------------------
211    
212      ytherm = 0.      ytherm = 0.
# Line 300  contains Line 292  contains
292               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
293               yrugos(j) = frugs(i, nsrf)               yrugos(j) = frugs(i, nsrf)
294               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
              u1lay(j) = u(i, 1)  
              v1lay(j) = v(i, 1)  
295               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
296               ypaprs(j, klev + 1) = paprs(i, klev + 1)               ypaprs(j, klev + 1) = paprs(i, klev + 1)
297               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
# Line 329  contains Line 319  contains
319            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
320                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
321                 coefh(:knon, :))                 coefh(:knon, :))
322              
323            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
324               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
325               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 355  contains Line 346  contains
346               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
347                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
348                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
349                
350               DO k = 2, klev               DO k = 2, klev
351                  yzlay(1:knon, k) = yzlay(1:knon, k-1) &                  yzlay(:knon, k) = yzlay(:knon, k-1) &
352                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &
353                       / ypaprs(1:knon, k) &                       / ypaprs(1:knon, k) &
354                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
355               END DO               END DO
356    
357               DO k = 1, klev               DO k = 1, klev
358                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
359                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
360               END DO               END DO
361               yzlev(1:knon, 1) = 0.  
362               yzlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &               zlev(:knon, 1) = 0.
363                 zlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
364                    - yzlay(:knon, klev - 1)                    - yzlay(:knon, klev - 1)
365    
366               DO k = 2, klev               DO k = 2, klev
367                  yzlev(1:knon, k) = 0.5 * (yzlay(1:knon, k) + yzlay(1:knon, k-1))                  zlev(:knon, k) = 0.5 * (yzlay(:knon, k) + yzlay(:knon, k-1))
368               END DO               END DO
369    
370               DO k = 1, klev + 1               DO k = 1, klev + 1
371                  DO j = 1, knon                  DO j = 1, knon
372                     i = ni(j)                     i = ni(j)
# Line 378  contains Line 374  contains
374                  END DO                  END DO
375               END DO               END DO
376    
377               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), coefm(:knon, 1))
              IF (prt_level > 9) PRINT *, 'USTAR = ', yustar  
378    
379               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
380    
381               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
382                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &                  CALL vdif_kcay(knon, dtime, rg, zlev, yzlay, yu, yv, yteta, &
383                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &                       coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, ustar(:knon), &
384                       iflag_pbl)                       iflag_pbl)
385               ELSE               ELSE
386                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &
387                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       yu(:knon, :), yv(:knon, :), yteta(:knon, :), &
388                         coefm(:knon, 1), yq2(:knon, :), ykmm(:knon, :), &
389                         ykmn(:knon, :), ykmq(:knon, :), ustar(:knon), iflag_pbl)
390               END IF               END IF
391    
392               coefm(:knon, 2:) = ykmm(:knon, 2:klev)               coefm(:knon, 2:) = ykmm(:knon, 2:klev)
# Line 397  contains Line 394  contains
394            END IF            END IF
395    
396            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
397            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &            CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &
398                 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &                 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &
399                 y_flux_u(:knon))                 y_flux_u(:knon))
400            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &            CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &
401                 coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &                 coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &
402                 y_flux_v(:knon))                 y_flux_v(:knon))
403    
404            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
405            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
406                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
407                 u1lay(:knon), v1lay(:knon), coefh(:knon, :), yt, yq, &                 yu(:knon, 1), yv(:knon, 1), coefh(:knon, :), yt, yq, &
408                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &
409                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &
410                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
# Line 418  contains Line 415  contains
415            yrugm = 0.            yrugm = 0.
416            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
417               DO j = 1, knon               DO j = 1, knon
418                  yrugm(j) = 0.018 * coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2) &                  yrugm(j) = 0.018 * coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2) &
419                       / rg + 0.11 * 14E-6 &                       / rg + 0.11 * 14E-6 &
420                       / sqrt(coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2))                       / sqrt(coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2))
421                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
422               END DO               END DO
423            END IF            END IF
# Line 499  contains Line 496  contains
496    
497            DO j = 1, knon            DO j = 1, knon
498               i = ni(j)               i = ni(j)
499               uzon(j) = yu(j, 1) + y_d_u(j, 1)               u1(j) = yu(j, 1) + y_d_u(j, 1)
500               vmer(j) = yv(j, 1) + y_d_v(j, 1)               v1(j) = yv(j, 1) + y_d_v(j, 1)
501               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
502               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
503               zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &               zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &
# Line 516  contains Line 513  contains
513               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
514            END DO            END DO
515    
516            CALL stdlevvar(klon, knon, nsrf, zxli, uzon(:knon), vmer(:knon), &            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &
517                 tair1, qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, &                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &
518                 yt2m, yq2m, yt10m, yq10m, yu10m, yustar)                 yq2m, yt10m, yq10m, wind10m(:knon), ustar)
519    
520            DO j = 1, knon            DO j = 1, knon
521               i = ni(j)               i = ni(j)
522               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
523               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
524    
525               u10m_srf(i, nsrf) = (yu10m(j) * uzon(j)) &               u10m_srf(i, nsrf) = (wind10m(j) * u1(j)) &
526                    / sqrt(uzon(j)**2 + vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
527               v10m_srf(i, nsrf) = (yu10m(j) * vmer(j)) &               v10m_srf(i, nsrf) = (wind10m(j) * v1(j)) &
528                    / sqrt(uzon(j)**2 + vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
529            END DO            END DO
530    
531            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
532                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
533                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
534    
Legend:
Removed from v.226  
changed lines
  Added in v.227
  ViewVC Help
Powered by ViewVC 1.1.21