Changeset 3179


Ignore:
Timestamp:
Feb 3, 2018, 9:52:04 AM (6 years ago)
Author:
jyg
Message:

New structure for the representation of vdf
splitting in pbl_surface. Computations are
gathered in two subroutines included in the module
wx_pbl_mod: wx_pbl0_fuse, called before the
sub-surfaces, determines the single column
equivalent to the (w) and (x) columns.
wx_pbl0_split, called after the subsurfaces,
determines the distinct (w) and (x) surface
fluxes.

This is a first version with no surface
temperature difference between (w) and (x) (hence
the index 0).

Location:
LMDZ6/trunk/libf/phylmd
Files:
1 added
4 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/pbl_surface_mod.F90

    r3102 r3179  
    2323  USE climb_wind_mod,      ONLY : climb_wind_down, climb_wind_up
    2424  USE coef_diff_turb_mod,  ONLY : coef_diff_turb
    25 
     25  USE wx_pbl_mod,          ONLY : wx_pbl_init, wx_pbl_final, &
     26!!                                  wx_pbl_fuse_no_dts, wx_pbl_split_no_dts, &
     27!!                                  wx_pbl_fuse, wx_pbl_split
     28                                  wx_pbl0_fuse, wx_pbl0_split
    2629
    2730  IMPLICIT NONE
    … …  
    145148!    CALL getin_p('iflag_frein',iflag_frein)
    146149!
     150!jyg<
     151!****************************************************************************************
     152! Allocate variables for pbl splitting
     153!
     154!****************************************************************************************
     155
     156    CALL wx_pbl_init
     157!>jyg
     158
    147159  END SUBROUTINE pbl_surface_init
    148160! 
    … …  
    201213!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
    202214!!        tke_x,     tke_w                              &
    203        wake_dltke                                     &
    204         , treedrg                                   &
     215       wake_dltke,                                     &
     216        treedrg                                   &
    205217!FC
    206218!!!
    … …  
    273285! pblh-----output-R- HCL
    274286! pblT-----output-R- T au nveau HCL
    275 !
    276     USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
     287! treedrg--output-R- tree drag (m)               
     288!
     289    USE carbon_cycle_mod,   ONLY : carbon_cycle_cpl, co2_send
    277290    USE indice_sol_mod
    278     USE time_phylmdz_mod, ONLY: day_ini,annee_ref,itau_phy
    279     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    280     USE print_control_mod, ONLY: prt_level,lunout
     291    USE time_phylmdz_mod,   ONLY : day_ini,annee_ref,itau_phy
     292    USE mod_grid_phy_lmdz,  ONLY : nbp_lon, nbp_lat
     293    USE print_control_mod,  ONLY : prt_level,lunout
     294    USE ioipsl_getin_p_mod, ONLY : getin_p
    281295
    282296    IMPLICIT NONE
    … …  
    490504    CHARACTER(len=8), DIMENSION(nbsrf), SAVE :: cl_surf
    491505!$OMP THREADPRIVATE(cl_surf)
     506    REAL, SAVE                               :: beta_land         ! beta for wx_dts
     507!$OMP THREADPRIVATE(beta_land)
    492508
    493509! Other local variables
    … …  
    507523    REAL, DIMENSION(klon)              :: yalb,yalb_vis
    508524!albedo SB <<<
    509     REAL, DIMENSION(klon)              :: yu1, yv1
     525    REAL, DIMENSION(klon)              :: yt1, yq1, yu1, yv1
    510526    REAL, DIMENSION(klon)              :: ysnow, yqsurf, yagesno, yqsol
    511527    REAL, DIMENSION(klon)              :: yrain_f, ysnow_f
    … …  
    716732!!! jyg le 25/03/2013
    717733!!    Variables intermediaires pour le raccord des deux colonnes \`a la surface
    718     REAL   ::   dd_Ch
    719     REAL   ::   dd_Cm
    720     REAL   ::   dd_Kh
    721     REAL   ::   dd_Km
    722     REAL   ::   dd_u
    723     REAL   ::   dd_v
    724     REAL   ::   dd_t
    725     REAL   ::   dd_q
    726     REAL   ::   dd_AH
    727     REAL   ::   dd_AQ
    728     REAL   ::   dd_AU
    729     REAL   ::   dd_AV
    730     REAL   ::   dd_BH
    731     REAL   ::   dd_BQ
    732     REAL   ::   dd_BU
    733     REAL   ::   dd_BV
    734 
    735     REAL   ::   dd_KHp
    736     REAL   ::   dd_KQp
    737     REAL   ::   dd_KUp
    738     REAL   ::   dd_KVp
     734!jyg<
     735!!    REAL   ::   dd_Ch
     736!!    REAL   ::   dd_Cm
     737!!    REAL   ::   dd_Kh
     738!!    REAL   ::   dd_Km
     739!!    REAL   ::   dd_u
     740!!    REAL   ::   dd_v
     741!!    REAL   ::   dd_t
     742!!    REAL   ::   dd_q
     743!!    REAL   ::   dd_AH
     744!!    REAL   ::   dd_AQ
     745!!    REAL   ::   dd_AU
     746!!    REAL   ::   dd_AV
     747!!    REAL   ::   dd_BH
     748!!    REAL   ::   dd_BQ
     749!!    REAL   ::   dd_BU
     750!!    REAL   ::   dd_BV
     751!!
     752!!    REAL   ::   dd_KHp
     753!!    REAL   ::   dd_KQp
     754!!    REAL   ::   dd_KUp
     755!!    REAL   ::   dd_KVp
     756!>jyg
    739757
    740758!!!
    … …  
    743761    REAL, DIMENSION(klon)              :: y_delta_tsurf,delta_coef,tau_eq
    744762    REAL, PARAMETER                    :: facteur=2./sqrt(3.14)
    745     REAL, PARAMETER                    :: effusivity=2000.
     763    REAL, PARAMETER                    :: inertia=2000.
    746764    REAL, DIMENSION(klon)              :: ytsurf_th_x,ytsurf_th_w,yqsatsurf_x,yqsatsurf_w
    747765    REAL, DIMENSION(klon)              :: ydtsurf_th
    … …  
    755773    REAL, DIMENSION(klon)              :: Kech_m_x, Kech_m_w
    756774    REAL, DIMENSION(klon)              :: yts_x,yts_w
    757     REAL, DIMENSION(klon)              :: Kech_Hp, Kech_H_xp, Kech_H_wp
    758     REAL, DIMENSION(klon)              :: Kech_Qp, Kech_Q_xp, Kech_Q_wp
    759     REAL, DIMENSION(klon)              :: Kech_Up, Kech_U_xp, Kech_U_wp
    760     REAL, DIMENSION(klon)              :: Kech_Vp, Kech_V_xp, Kech_V_wp
     775!jyg<
     776!!    REAL, DIMENSION(klon)              :: Kech_Hp, Kech_H_xp, Kech_H_wp
     777!!    REAL, DIMENSION(klon)              :: Kech_Qp, Kech_Q_xp, Kech_Q_wp
     778!!    REAL, DIMENSION(klon)              :: Kech_Up, Kech_U_xp, Kech_U_wp
     779!!    REAL, DIMENSION(klon)              :: Kech_Vp, Kech_V_xp, Kech_V_wp
     780!>jyg
     781!jyg<
     782    REAL, DIMENSION(klon)              :: ah, bh     ! coefficients of the delta_Tsurf equation
     783!>jyg
    761784
    762785    REAL                               :: vent
    … …  
    824847       ! Initialize ok_flux_surf (for 1D model)
    825848       if (klon_glo>1) ok_flux_surf=.FALSE.
     849
     850       ! intialize beta_land
     851       beta_land = 0.5
     852       call getin_p('beta_land', beta_land)
    826853       
    827854       ! Initilize debug IO
    … …  
    881908 zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0.
    882909 d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
     910 zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0.
    883911 zxsens_x(:)=0. ; zxsens_w(:)=0. ; zxfluxlat_x(:)=0. ; zxfluxlat_w(:)=0.
    884912 cdragh_x(:)=0. ; cdragh_w(:)=0. ; cdragm_x(:)=0. ; cdragm_w(:)=0.
    … …  
    13011329          ENDDO
    13021330        ENDDO
     1331        IF (prt_level .ge. 10) THEN
     1332          print *,'pbl_surface, wake_s(1), wake_dlt(1,:) ', wake_s(1), wake_dlt(1,:)
     1333          print *,'pbl_surface, wake_s(1), wake_dlq(1,:) ', wake_s(1), wake_dlq(1,:)
     1334        ENDIF
    13031335!!! nrlmd le 02/05/2011
    13041336        DO k = 1, klev+1
    … …  
    14341466            yts_w, yqsurf, yz0m, yz0h, &
    14351467            ycdragm_w, ycdragh_w, zri1_w, pref_w )
     1468!
     1469        zgeo1(:) = wake_s(:)*zgeo1_w(:) + (1.-wake_s(:))*zgeo1_x(:)
    14361470
    14371471! --- special Dice. JYG+MPL 25112013 puis BOMEX
    … …  
    14751509            ycoefm, ycoefh, ytke, y_treedrg)
    14761510!            ycoefm, ycoefh, ytke)
    1477 !FC y_treedrg ajouté
     1511!FC y_treedrg ajoute
    14781512       IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
    14791513! In this case, coef_diff_turb is called for the Cd only
    … …  
    15871621!!!
    15881622            AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x)
     1623!!!
     1624       IF (prt_level >=10) THEN
     1625         PRINT *,'pbl_surface (climb_hq_down.x->) AcoefH_x ',AcoefH_x
     1626         PRINT *,'pbl_surface (climb_hq_down.x->) AcoefQ_x ',AcoefQ_x
     1627         PRINT *,'pbl_surface (climb_hq_down.x->) BcoefH_x ',BcoefH_x
     1628         PRINT *,'pbl_surface (climb_hq_down.x->) BcoefQ_x ',BcoefQ_x
     1629       ENDIF
    15891630!
    15901631        CALL climb_hq_down(knon, ycoefh_w, ypaprs, ypplay, &
    … …  
    15951636!!!
    15961637            AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w)
     1638!!!
     1639       IF (prt_level >=10) THEN
     1640         PRINT *,'pbl_surface (climb_hq_down.w->) AcoefH_w ',AcoefH_w
     1641         PRINT *,'pbl_surface (climb_hq_down.w->) AcoefQ_w ',AcoefQ_w
     1642         PRINT *,'pbl_surface (climb_hq_down.w->) BcoefH_w ',BcoefH_w
     1643         PRINT *,'pbl_surface (climb_hq_down.w->) BcoefQ_w ',BcoefQ_w
     1644       ENDIF
    15971645!!!
    15981646       ENDIF  ! (iflag_split .eq.0)
    … …  
    16451693       END IF
    16461694
    1647 !!! nrlmd le 13/06/2011
    1648 !----- On finit le calcul des coefficients d'\'echange:on multiplie le cdrag par le module du vent et la densit\'e dans la premi\`ere couche
    1649 !          Kech_h_x(j) = ycdragh_x(j) * &
    1650 !             (1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2)) * &
    1651 !             ypplay(j,1)/(RD*yt_x(j,1))
    1652 !          Kech_h_w(j) = ycdragh_w(j) * &
    1653 !             (1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2)) * &
    1654 !             ypplay(j,1)/(RD*yt_w(j,1))
    1655 !          Kech_h(j) = (1.-ywake_s(j))*Kech_h_x(j)+ywake_s(j)*Kech_h_w(j)
    1656 !
    1657 !          Kech_m_x(j) = ycdragm_x(j) * &
    1658 !             (1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2)) * &
    1659 !             ypplay(j,1)/(RD*yt_x(j,1))
    1660 !          Kech_m_w(j) = ycdragm_w(j) * &
    1661 !             (1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2)) * &
    1662 !             ypplay(j,1)/(RD*yt_w(j,1))
    1663 !          Kech_m(j) = (1.-ywake_s(j))*Kech_m_x(j)+ywake_s(j)*Kech_m_w(j)
    1664 !!!
    16651695
    16661696!!! nrlmd le 02/05/2011  -----------------------On raccorde les 2 colonnes dans la couche 1
    16671697!----------------------------------------------------------------------------------------
    16681698!!! jyg le 07/02/2012
    1669        IF (iflag_split .eq.1) THEN
    1670 !!!
    1671 !!! jyg le 09/04/2013 ; passage aux nouvelles expressions en differences
    1672 
    1673         DO j=1,knon
    1674 !
    1675 ! Calcul des coefficients d echange
    1676          mod_wind_x = 1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2)
    1677          mod_wind_w = 1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2)
    1678          rho1 = ypplay(j,1)/(RD*yt(j,1))
    1679          Kech_h_x(j) = ycdragh_x(j) * mod_wind_x * rho1
    1680          Kech_h_w(j) = ycdragh_w(j) * mod_wind_w * rho1
    1681          Kech_m_x(j) = ycdragm_x(j) * mod_wind_x * rho1
    1682          Kech_m_w(j) = ycdragm_w(j) * mod_wind_w * rho1
    1683 !
    1684          dd_Kh = Kech_h_w(j) - Kech_h_x(j)
    1685          dd_Km = Kech_m_w(j) - Kech_m_x(j)
    1686          IF (prt_level >=10) THEN
    1687           print *,' mod_wind_x, mod_wind_w ', mod_wind_x, mod_wind_w
    1688           print *,' rho1 ',rho1
    1689           print *,' ycdragh_x(j),ycdragm_x(j) ',ycdragh_x(j),ycdragm_x(j)
    1690           print *,' ycdragh_w(j),ycdragm_w(j) ',ycdragh_w(j),ycdragm_w(j)
    1691           print *,' dd_Kh: ',dd_KH
    1692          ENDIF
    1693 !
    1694          Kech_h(j) = Kech_h_x(j) + ywake_s(j)*dd_Kh
    1695          Kech_m(j) = Kech_m_x(j) + ywake_s(j)*dd_Km
    1696 !
    1697 ! Calcul des coefficients d echange corriges des retroactions
    1698         Kech_H_xp(j) = Kech_h_x(j)/(1.-BcoefH_x(j)*Kech_h_x(j)*dtime)
    1699         Kech_H_wp(j) = Kech_h_w(j)/(1.-BcoefH_w(j)*Kech_h_w(j)*dtime)
    1700         Kech_Q_xp(j) = Kech_h_x(j)/(1.-BcoefQ_x(j)*Kech_h_x(j)*dtime)
    1701         Kech_Q_wp(j) = Kech_h_w(j)/(1.-BcoefQ_w(j)*Kech_h_w(j)*dtime)
    1702         Kech_U_xp(j) = Kech_m_x(j)/(1.-BcoefU_x(j)*Kech_m_x(j)*dtime)
    1703         Kech_U_wp(j) = Kech_m_w(j)/(1.-BcoefU_w(j)*Kech_m_w(j)*dtime)
    1704         Kech_V_xp(j) = Kech_m_x(j)/(1.-BcoefV_x(j)*Kech_m_x(j)*dtime)
    1705         Kech_V_wp(j) = Kech_m_w(j)/(1.-BcoefV_w(j)*Kech_m_w(j)*dtime)
    1706 !
    1707          dd_KHp = Kech_H_wp(j) - Kech_H_xp(j)
    1708          dd_KQp = Kech_Q_wp(j) - Kech_Q_xp(j)
    1709          dd_KUp = Kech_U_wp(j) - Kech_U_xp(j)
    1710          dd_KVp = Kech_V_wp(j) - Kech_V_xp(j)
    1711 !
    1712         Kech_Hp(j) = Kech_H_xp(j) + ywake_s(j)*dd_KHp
    1713         Kech_Qp(j) = Kech_Q_xp(j) + ywake_s(j)*dd_KQp
    1714         Kech_Up(j) = Kech_U_xp(j) + ywake_s(j)*dd_KUp
    1715         Kech_Vp(j) = Kech_V_xp(j) + ywake_s(j)*dd_KVp
    1716 !
    1717 ! Calcul des differences w-x
    1718        dd_CM = ycdragm_w(j) - ycdragm_x(j)
    1719        dd_CH = ycdragh_w(j) - ycdragh_x(j)
    1720        dd_u = yu_w(j,1) - yu_x(j,1)
    1721        dd_v = yv_w(j,1) - yv_x(j,1)
    1722        dd_t = yt_w(j,1) - yt_x(j,1)
    1723        dd_q = yq_w(j,1) - yq_x(j,1)
    1724        dd_AH = AcoefH_w(j) - AcoefH_x(j)
    1725        dd_AQ = AcoefQ_w(j) - AcoefQ_x(j)
    1726        dd_AU = AcoefU_w(j) - AcoefU_x(j)
    1727        dd_AV = AcoefV_w(j) - AcoefV_x(j)
    1728        dd_BH = BcoefH_w(j) - BcoefH_x(j)
    1729        dd_BQ = BcoefQ_w(j) - BcoefQ_x(j)
    1730        dd_BU = BcoefU_w(j) - BcoefU_x(j)
    1731        dd_BV = BcoefV_w(j) - BcoefV_x(j)
    1732 !
     1699!!! jyg le 01/02/2017
     1700       IF (iflag_split .eq. 0) THEN
     1701         yt1(:) = yt(:,1)
     1702         yq1(:) = yq(:,1)
     1703!!       ELSE IF (iflag_split .eq. 1) THEN
     1704!!!
     1705!jyg<
     1706!!         CALL wx_pbl_fuse_no_dts(knon, dtime, ypplay, ywake_s, &
     1707!!                                 yt_x, yt_w, yq_x, yq_w, &
     1708!!                                 yu_x, yu_w, yv_x, yv_w, &
     1709!!                                 ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, &
     1710!!                                 AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
     1711!!                                 AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
     1712!!                                 BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
     1713!!                                 BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
     1714!!                                 AcoefH, AcoefQ, AcoefU, AcoefV, &
     1715!!                                 BcoefH, BcoefQ, BcoefU, BcoefV, &
     1716!!                                 ycdragh, ycdragm, &
     1717!!                                 yt1, yq1, yu1, yv1 &
     1718!!                                 )
     1719       ELSE IF (iflag_split .ge. 1) THEN
     1720         CALL wx_pbl0_fuse(knon, dtime, ypplay, ywake_s, &
     1721                         yt_x, yt_w, yq_x, yq_w, &
     1722                         yu_x, yu_w, yv_x, yv_w, &
     1723                         ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, &
     1724                         AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
     1725                         AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
     1726                         BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
     1727                         BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
     1728                         AcoefH, AcoefQ, AcoefU, AcoefV, &
     1729                         BcoefH, BcoefQ, BcoefU, BcoefV, &
     1730                         ycdragh, ycdragm, &
     1731                         yt1, yq1, yu1, yv1 &
     1732                         )
     1733!!       ELSE IF (iflag_split .ge.2) THEN
     1734!!!    Provisoire
     1735!!         ah(:) = 0.
     1736!!         bh(:) = 0.
     1737!!         IF (nsrf == is_oce) THEN
     1738!!           ybeta(:) = 1.
     1739!!         ELSE
     1740!!           ybeta(:) = beta_land
     1741!!         ENDIF
     1742!!         ycdragh(:) = ywake_s(:)*ycdragh_w(:) + (1.-ywake_s(:))*ycdragh_x(:)
     1743!!         CALL wx_dts(knon, nsrf, ywake_cstar, ywake_s, ywake_dens, &
     1744!!                     yts, ypplay(:,1), ybeta, ycdragh , ypaprs(:,1), &
     1745!!                     yq(:,1), yt(:,1), yu(:,1), yv(:,1), ygustiness, &
     1746!!                     ah, bh &
     1747!!                     )
     1748!!!
     1749!!         CALL wx_pbl_fuse(knon, dtime, ypplay, ywake_s, &
     1750!!                         yt_x, yt_w, yq_x, yq_w, &
     1751!!                         yu_x, yu_w, yv_x, yv_w, &
     1752!!                         ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, &
     1753!!                         AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
     1754!!                         AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
     1755!!                         BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
     1756!!                         BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
     1757!!                         ah, bh, &
     1758!!                         AcoefH, AcoefQ, AcoefU, AcoefV, &
     1759!!                         BcoefH, BcoefQ, BcoefU, BcoefV, &
     1760!!                         ycdragh, ycdragm, &
     1761!!                         yt1, yq1, yu1, yv1 &
     1762!!                         )
     1763!>jyg
     1764!!!
     1765         ENDIF  ! (iflag_split .eq.0)
     1766!!!
    17331767       IF (prt_level >=10) THEN
    1734           print *,'Variables pour la fusion : Kech_H_xp(j)' ,Kech_H_xp(j)
    1735           print *,'Variables pour la fusion : Kech_H_wp(j)' ,Kech_H_wp(j)
    1736           print *,'Variables pour la fusion : Kech_Hp(j)' ,Kech_Hp(j)
    1737           print *,'Variables pour la fusion : Kech_h(j)' ,Kech_h(j)
     1768         PRINT *,'pbl_surface (fuse->): yt(1,:) ',yt(1,:)
     1769         PRINT *,'pbl_surface (fuse->): yq(1,:) ',yq(1,:)
     1770         PRINT *,'pbl_surface (fuse->): yu(1,:) ',yu(1,:)
     1771         PRINT *,'pbl_surface (fuse->): yv(1,:) ',yv(1,:)
     1772         PRINT *,'pbl_surface (fuse->): AcoefH(1) ',AcoefH(1)
     1773         PRINT *,'pbl_surface (fuse->): BcoefH(1) ',BcoefH(1)
    17381774       ENDIF
    1739 !
    1740 ! Calcul des coef A, B \'equivalents dans la couche 1
    1741 !
    1742        AcoefH(j) = AcoefH_x(j) + ywake_s(j)*(Kech_H_wp(j)/Kech_Hp(j))*dd_AH
    1743        AcoefQ(j) = AcoefQ_x(j) + ywake_s(j)*(Kech_Q_wp(j)/Kech_Qp(j))*dd_AQ
    1744        AcoefU(j) = AcoefU_x(j) + ywake_s(j)*(Kech_U_wp(j)/Kech_Up(j))*dd_AU
    1745        AcoefV(j) = AcoefV_x(j) + ywake_s(j)*(Kech_V_wp(j)/Kech_Vp(j))*dd_AV
    1746 !
    1747        BcoefH(j) = BcoefH_x(j) + ywake_s(j)*BcoefH_x(j)*(dd_Kh/Kech_h(j))*(1.+Kech_H_wp(j)/Kech_Hp(j)) &
    1748                                + ywake_s(j)*(Kech_H_wp(j)/Kech_Hp(j))*(Kech_h_w(j)/Kech_h(j))*dd_BH
    1749 
    1750        BcoefQ(j) = BcoefQ_x(j) + ywake_s(j)*BcoefQ_x(j)*(dd_Kh/Kech_h(j))*(1.+Kech_Q_wp(j)/Kech_Qp(j)) &
    1751                                + ywake_s(j)*(Kech_Q_wp(j)/Kech_Qp(j))*(Kech_h_w(j)/Kech_h(j))*dd_BQ
    1752 
    1753        BcoefU(j) = BcoefU_x(j) + ywake_s(j)*BcoefU_x(j)*(dd_Km/Kech_h(j))*(1.+Kech_U_wp(j)/Kech_Up(j)) &
    1754                                + ywake_s(j)*(Kech_U_wp(j)/Kech_Up(j))*(Kech_m_w(j)/Kech_m(j))*dd_BU
    1755 
    1756        BcoefV(j) = BcoefV_x(j) + ywake_s(j)*BcoefV_x(j)*(dd_Km/Kech_h(j))*(1.+Kech_V_wp(j)/Kech_Vp(j)) &
    1757                                + ywake_s(j)*(Kech_V_wp(j)/Kech_Vp(j))*(Kech_m_w(j)/Kech_m(j))*dd_BV
    1758 
    1759 !
    1760 ! Calcul des cdrag \'equivalents dans la couche
    1761 !
    1762        ycdragm(j) = ycdragm_x(j) + ywake_s(j)*dd_CM
    1763        ycdragh(j) = ycdragh_x(j) + ywake_s(j)*dd_CH
    1764 !
    1765 ! Calcul de T, q, u et v \'equivalents dans la couche 1
    1766        yt(j,1) = yt_x(j,1) + ywake_s(j)*(Kech_h_w(j)/Kech_h(j))*dd_t
    1767        yq(j,1) = yq_x(j,1) + ywake_s(j)*(Kech_h_w(j)/Kech_h(j))*dd_q
    1768        yu(j,1) = yu_x(j,1) + ywake_s(j)*(Kech_m_w(j)/Kech_m(j))*dd_u
    1769        yv(j,1) = yv_x(j,1) + ywake_s(j)*(Kech_m_w(j)/Kech_m(j))*dd_v
    1770 
    1771 
    1772         ENDDO
    1773 !!!
    1774        ENDIF  ! (iflag_split .eq.1)
    1775 !!!
    17761775
    17771776!****************************************************************************************
    … …  
    18101809               rlon, rlat, yrmu0, &
    18111810               debut, lafin, ydelp(:,1), r_co2_ppm, ysolsw, ysollw, yalb, &
    1812                yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
     1811!!jyg               yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
     1812               yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
    18131813               AcoefH, AcoefQ, BcoefH, BcoefQ, &
    18141814               AcoefU, AcoefV, BcoefU, BcoefV, &
    … …  
    18561856               yrmu0, ylwdown, yalb, ypphi(:,1), &
    18571857               ysolsw, ysollw, yts, ypplay(:,1), &
    1858                ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
     1858!!jyg               ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
     1859               ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
    18591860               AcoefH, AcoefQ, BcoefH, BcoefQ, &
    18601861               AcoefU, AcoefV, BcoefU, BcoefV, &
    … …  
    18931894               ywindsp, rmu0, yfder, yts, &
    18941895               itap, dtime, jour, knon, ni, &
    1895                ypplay(:,1), zgeo1/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
     1896!!jyg               ypplay(:,1), zgeo1/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
     1897               ypplay(:,1), zgeo1/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
    18961898               AcoefH, AcoefQ, BcoefH, BcoefQ, &
    18971899               AcoefU, AcoefV, BcoefU, BcoefV, &
    … …  
    19311933               itap, dtime, jour, knon, ni, &
    19321934               lafin, &
    1933                yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
     1935!!jyg               yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
     1936               yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
    19341937               AcoefH, AcoefQ, BcoefH, BcoefQ, &
    19351938               AcoefU, AcoefV, BcoefU, BcoefV, &
    … …  
    19901993          yfluxlat(:) =  flat
    19911994!
    1992           IF (iflag_split .eq.0) THEN
     1995!!  Test sur iflag_split retire le 2/02/2018, sans vraiment comprendre la raison de ce test. (jyg)
     1996!!          IF (iflag_split .eq.0) THEN
    19931997             do j=1,knon
    19941998             Kech_h(j) = ycdragh(j) * (1.0+SQRT(yu(j,1)**2+yv(j,1)**2)) * &
    19951999                  ypplay(j,1)/(RD*yt(j,1))
    19962000             enddo
    1997           ENDIF ! (iflag_split .eq.0)
     2001!!          ENDIF ! (iflag_split .eq.0)
    19982002
    19992003          DO j = 1, knon
    … …  
    20182022 &             ,  y_flux_t1(j), yfluxlat(j), ywake_s(j)
    20192023         print*,'beta,ytsurf_new', ybeta(j), ytsurf_new(j)
    2020          print*,'effusivity,facteur,cstar', effusivity, facteur,wake_cstar(j)
     2024         print*,'inertia,facteur,cstar', inertia, facteur,wake_cstar(j)
    20212025        ENDDO
    20222026       ENDIF
    20232027
    20242028!!! jyg le 07/02/2012 puis le 10/04/2013
    2025        IF (iflag_split .eq.1) THEN
    2026 !!!
    2027         DO j=1,knon
    2028          y_delta_flux_t1(j) = ( Kech_H_wp(j)*Kech_H_xp(j)*(AcoefH_w(j)-AcoefH_x(j)) + &
    2029                                 y_flux_t1(j)*(Kech_H_wp(j)-Kech_H_xp(j)) ) / Kech_Hp(j)
    2030          y_delta_flux_q1(j) = ( Kech_Q_wp(j)*Kech_Q_xp(j)*(AcoefQ_w(j)-AcoefQ_x(j)) + &
    2031                                 y_flux_q1(j)*(Kech_Q_wp(j)-Kech_Q_xp(j)) ) / Kech_Qp(j)
    2032          y_delta_flux_u1(j) = ( Kech_U_wp(j)*Kech_U_xp(j)*(AcoefU_w(j)-AcoefU_x(j)) + &
    2033                                 y_flux_u1(j)*(Kech_U_wp(j)-Kech_U_xp(j)) ) / Kech_Up(j)
    2034          y_delta_flux_v1(j) = ( Kech_V_wp(j)*Kech_V_xp(j)*(AcoefV_w(j)-AcoefV_x(j)) + &
    2035                                 y_flux_v1(j)*(Kech_V_wp(j)-Kech_V_xp(j)) ) / Kech_Vp(j)
    2036 !
    2037          y_flux_t1_x(j)=y_flux_t1(j) - ywake_s(j)*y_delta_flux_t1(j)
    2038          y_flux_t1_w(j)=y_flux_t1(j) + (1.-ywake_s(j))*y_delta_flux_t1(j)
    2039          y_flux_q1_x(j)=y_flux_q1(j) - ywake_s(j)*y_delta_flux_q1(j)
    2040          y_flux_q1_w(j)=y_flux_q1(j) + (1.-ywake_s(j))*y_delta_flux_q1(j)
    2041          y_flux_u1_x(j)=y_flux_u1(j) - ywake_s(j)*y_delta_flux_u1(j)
    2042          y_flux_u1_w(j)=y_flux_u1(j) + (1.-ywake_s(j))*y_delta_flux_u1(j)
    2043          y_flux_v1_x(j)=y_flux_v1(j) - ywake_s(j)*y_delta_flux_v1(j)
    2044          y_flux_v1_w(j)=y_flux_v1(j) + (1.-ywake_s(j))*y_delta_flux_v1(j)
    2045 !
    2046          yfluxlat_x(j)=y_flux_q1_x(j)*RLVTT
    2047          yfluxlat_w(j)=y_flux_q1_w(j)*RLVTT
    2048 
    2049         ENDDO
     2029!!       IF (iflag_split .eq.1) THEN
     2030!!!!!
     2031!!!jyg<
     2032!!         CALL wx_pbl_split_no_dts(knon, ywake_s, &
     2033!!                                AcoefH_x, AcoefH_w, &
     2034!!                                AcoefQ_x, AcoefQ_w, &
     2035!!                                AcoefU_x, AcoefU_w, &
     2036!!                                AcoefV_x, AcoefV_w, &
     2037!!                                y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, &
     2038!!                                y_flux_t1_x, y_flux_t1_w, &
     2039!!                                y_flux_q1_x, y_flux_q1_w, &
     2040!!                                y_flux_u1_x, y_flux_u1_w, &
     2041!!                                y_flux_v1_x, y_flux_v1_w, &
     2042!!                                yfluxlat_x, yfluxlat_w &
     2043!!                                )
     2044!!       ELSE IF (iflag_split .ge. 2) THEN
     2045       IF (iflag_split .GE. 1) THEN
     2046         CALL wx_pbl0_split(knon, dtime, ywake_s, &
     2047                       y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, &
     2048                       y_flux_t1_x, y_flux_t1_w, &
     2049                       y_flux_q1_x, y_flux_q1_w, &
     2050                       y_flux_u1_x, y_flux_u1_w, &
     2051                       y_flux_v1_x, y_flux_v1_w, &
     2052                       yfluxlat_x, yfluxlat_w, &
     2053                       y_delta_tsurf &
     2054                       )
     2055       ENDIF  ! (iflag_split .ge. 1)
     2056!>jyg
    20502057!
    20512058 
    … …  
    20602067!!jyg!!          tau_eq(j)=(ywake_s(j)/2.)*(1./max(wake_cstar(j),0.01))*sqrt(0.4/(3.14*max(wake_dens(j),8e-12)))
    20612068!!jyg!!
    2062 !!jyg!!!          delta_coef(j)=dtime/(effusivity*sqrt(tau_eq(j)))
    2063 !!jyg!!          delta_coef(j)=facteur*sqrt(tau_eq(j))/effusivity
     2069!!jyg!!!          delta_coef(j)=dtime/(inertia*sqrt(tau_eq(j)))
     2070!!jyg!!          delta_coef(j)=facteur*sqrt(tau_eq(j))/inertia
    20642071!!jyg!!!          delta_coef(j)=0.
    20652072!!jyg!!       ELSE
    … …  
    20902097!!jyg!!!!! fin nrlmd le 13/06/2011
    20912098!!jyg!!
     2099       IF (iflag_split .ge. 1) THEN
    20922100       IF (prt_level >=10) THEN
    20932101        DO j = 1, knon
    … …  
    21052113 &             , y_flux_t1_x(j), y_flux_t1_w(j), y_flux_t1(j), y_flux_q1_x(j)*RLVTT, y_flux_q1_w(j)*RLVTT, yfluxlat(j), ywake_s(j)
    21062114         print*,'beta,ytsurf_new,yqsatsurf', ybeta(j), ytsurf_new(j), yqsatsurf(j)
    2107          print*,'effusivity,facteur,cstar', effusivity, facteur,wake_cstar(j)
     2115         print*,'inertia,facteur,cstar', inertia, facteur,wake_cstar(j)
    21082116        ENDDO
    21092117       ENDIF  ! (prt_level >=10)
    21102118
    21112119!!! jyg le 07/02/2012
    2112        ENDIF  ! (iflag_split .eq.1)
     2120       ENDIF  ! (iflag_split .ge.1)
    21132121!!!
    21142122
    … …  
    23632371!!!
    23642372!!! nrlmd le 13/06/2011
    2365           delta_tsurf(i,nsrf)=y_delta_tsurf(j)*ypct(j)
     2373!!jyg20170131          delta_tsurf(i,nsrf)=y_delta_tsurf(j)*ypct(j)
     2374          delta_tsurf(i,nsrf)=y_delta_tsurf(j)
     2375!
    23662376          cdragh_x(i) = cdragh_x(i) + ycdragh_x(j)*ypct(j)
    23672377          cdragh_w(i) = cdragh_w(i) + ycdragh_w(j)*ypct(j)
    … …  
    25732583!      print*, tair1,yt(:,1),y_d_t(:,1)
    25742584
    2575 ! Calculate the temperatureflag_pbl_surface_t2m_bugiflag_pbl_surface_t2m_bug et relative humidity at 2m and the wind at 10m
     2585! Calculate the temperature and relative humidity at 2m and the wind at 10m
    25762586!!! jyg le 07/02/2012
    25772587       IF (iflag_split .eq.0) THEN
    … …  
    30893099    IF (ALLOCATED(qsurf)) DEALLOCATE(qsurf)
    30903100    IF (ALLOCATED(ftsoil)) DEALLOCATE(ftsoil)
     3101
     3102!jyg<
     3103!****************************************************************************************
     3104! Deallocate variables for pbl splitting
     3105!
     3106!****************************************************************************************
     3107
     3108    CALL wx_pbl_final
     3109!>jyg
    30913110
    30923111  END SUBROUTINE pbl_surface_final

  • LMDZ6/trunk/libf/phylmd/phys_local_var_mod.F90

    r3148 r3179  
    347347!!!$OMP THREADPRIVATE(q_x, q_w)
    348348!>jyg
    349 !!! Sorties ferret
    350       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: dtvdf_x, dtvdf_w
    351 !$OMP THREADPRIVATE(dtvdf_x, dtvdf_w)
    352       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: dqvdf_x, dqvdf_w
    353 !$OMP THREADPRIVATE(dqvdf_x, dqvdf_w)
    354349! Variables suppl\E9mentaires dans physiq.F relative au splitting de la surface
    355350      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: pbl_tke_input
    … …  
    579574      ALLOCATE(plul_st(klon),plul_th(klon))
    580575      ALLOCATE(d_t_vdf(klon,klev),d_q_vdf(klon,klev),d_t_diss(klon,klev))
    581 !nrlmd+jyg<
    582       ALLOCATE(d_t_vdf_w(klon,klev),d_q_vdf_w(klon,klev))
    583       ALLOCATE(d_t_vdf_x(klon,klev),d_q_vdf_x(klon,klev))
    584 !>nrlmd+jyg
    585576      ALLOCATE(d_u_vdf(klon,klev),d_v_vdf(klon,klev))
    586577      ALLOCATE(d_t_oli(klon,klev),d_t_oro(klon,klev))
    … …  
    724715!!      ALLOCATE(q_x(klon,klev), q_w(klon,klev))
    725716!>jyg
    726       ALLOCATE(dtvdf_x(klon,klev), dtvdf_w(klon,klev))
    727       ALLOCATE(dqvdf_x(klon,klev), dqvdf_w(klon,klev))
     717      ALLOCATE(d_t_vdf_x(klon,klev), d_t_vdf_w(klon,klev))
     718      ALLOCATE(d_q_vdf_x(klon,klev), d_q_vdf_w(klon,klev))
    728719      ALLOCATE(pbl_tke_input(klon,klev+1,nbsrf))
    729720      ALLOCATE(t_therm(klon,klev), q_therm(klon,klev),u_therm(klon,klev), v_therm(klon,klev))
    … …  
    881872      DEALLOCATE(plul_st,plul_th)
    882873      DEALLOCATE(d_t_vdf,d_q_vdf,d_t_diss)
    883 !nrlmd+jyg<
    884       DEALLOCATE(d_t_vdf_w,d_q_vdf_w)
    885       DEALLOCATE(d_t_vdf_x,d_q_vdf_x)
    886 !>nrlmd+jyg
    887874      DEALLOCATE(d_u_vdf,d_v_vdf)
    888875      DEALLOCATE(d_t_oli,d_t_oro)
    … …  
    10161003!!      DEALLOCATE(q_x, q_w)
    10171004!>jyg
    1018       DEALLOCATE(dtvdf_x, dtvdf_w)
    1019       DEALLOCATE(dqvdf_x, dqvdf_w)
     1005      DEALLOCATE(d_t_vdf_x, d_t_vdf_w)
     1006      DEALLOCATE(d_q_vdf_x, d_q_vdf_w)
    10201007      DEALLOCATE(pbl_tke_input)
    10211008      DEALLOCATE(t_therm, q_therm, u_therm, v_therm)

  • LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90

    r3171 r3179  
    258258         vwriteSTD, wwriteSTD, phiwriteSTD, qwriteSTD, &
    259259         twriteSTD, alp_wake, &
    260          dtvdf_x    ,dtvdf_w    ,dqvdf_x    ,dqvdf_w    , &
     260!!         dtvdf_x    ,dtvdf_w    ,dqvdf_x    ,dqvdf_w    , &
     261         d_t_vdf_x    ,d_t_vdf_w    ,d_q_vdf_x    ,d_q_vdf_w    , &
    261262         sens_x     ,sens_w     ,zxfluxlat_x,zxfluxlat_w, &
    262263         cdragh_x   ,cdragh_w   ,cdragm_x   ,cdragm_w   , &
    … …  
    11021103             CALL histwrite_phy(o_alp_wk, alp_wake)
    11031104             IF (iflag_pbl_split>=1) THEN
    1104                IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=dtvdf_x(1:klon,1:klev)/pdtphys
     1105!!               IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=dtvdf_x(1:klon,1:klev)/pdtphys
     1106!!               CALL histwrite_phy(o_dtvdf_x    ,zx_tmp_fi3d)
     1107!!               IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=dtvdf_w(1:klon,1:klev)/pdtphys
     1108!!               CALL histwrite_phy(o_dtvdf_w    ,zx_tmp_fi3d)
     1109!!               IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=dqvdf_x(1:klon,1:klev)/pdtphys
     1110!!               CALL histwrite_phy(o_dqvdf_x    ,zx_tmp_fi3d)
     1111!!               IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=dqvdf_w(1:klon,1:klev)/pdtphys
     1112!
     1113               IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf_x(1:klon,1:klev)/pdtphys
    11051114               CALL histwrite_phy(o_dtvdf_x    ,zx_tmp_fi3d)
    1106                IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=dtvdf_w(1:klon,1:klev)/pdtphys
     1115               IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf_w(1:klon,1:klev)/pdtphys
    11071116               CALL histwrite_phy(o_dtvdf_w    ,zx_tmp_fi3d)
    1108                IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=dqvdf_x(1:klon,1:klev)/pdtphys
     1117               IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_vdf_x(1:klon,1:klev)/pdtphys
    11091118               CALL histwrite_phy(o_dqvdf_x    ,zx_tmp_fi3d)
    1110                IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=dqvdf_w(1:klon,1:klev)/pdtphys
     1119               IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_vdf_w(1:klon,1:klev)/pdtphys
     1120!
    11111121               CALL histwrite_phy(o_dqvdf_w    ,zx_tmp_fi3d)
    11121122               CALL histwrite_phy(o_sens_x     ,sens_x     )

  • LMDZ6/trunk/libf/phylmd/physiq_mod.F90

    r3178 r3179  
    6363       !
    6464       d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_t_diss, &
    65        d_t_vdf_w,d_q_vdf_w, &
    66        d_t_vdf_x,d_q_vdf_x, &
    6765       d_ts, &
    6866       !
    … …  
    135133       zxfluxlat_x, zxfluxlat_w, &
    136134       !
    137        dtvdf_x, dtvdf_w, &
    138        dqvdf_x, dqvdf_w, &
     135       d_t_vdf_x, d_t_vdf_w, &
     136       d_q_vdf_x, d_q_vdf_w, &
    139137       pbl_tke_input, &
    140138       t_therm, q_therm, u_therm, v_therm, &
    … …  
    22712269!!jyg       IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,2) .eq. 1) THEN
    22722270       IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,10) .ge. 1) THEN
    2273           print *,'debut du splitting de la PBL'
     2271          print *,'debut du splitting de la PBL, wake_s = ', wake_s(:)
     2272          print *,'debut du splitting de la PBL, wake_deltat = ', wake_deltat(:,1)
     2273          print *,'debut du splitting de la PBL, wake_deltaq = ', wake_deltaq(:,1)
    22742274       ENDIF
    22752275       ! !!
    … …  
    29842984          call prt_enerbil('wake',itap)
    29852985       ENDIF   ! (iflag_wake_tend .GT. 0.)
     2986       !
     2987       IF (prt_level .GE. 10) THEN
     2988         print *,' physiq, after calwake, wake_s: ',wake_s(:)
     2989         print *,' physiq, after calwake, wake_deltat: ',wake_deltat(:,1)
     2990         print *,' physiq, after calwake, wake_deltaq: ',wake_deltaq(:,1)
     2991       ENDIF
    29862992
    29872993       IF (iflag_alp_wk_cond .GT. 0.) THEN
Note: See TracChangeset for help on using the changeset viewer.