Ignore:
Timestamp:
Oct 19, 2023, 4:02:57 PM (13 months ago)
Author:
idelkadi
Message:

Merged trunk changes -r4488:4726 LMDZ_ECRad branch

Location:
LMDZ6/branches/LMDZ_ECRad
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/LMDZ_ECRad

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/pbl_surface_mod.F90

    r4482 r4727  
    2121  USE cpl_mod,             ONLY : gath2cpl
    2222  USE climb_hq_mod,        ONLY : climb_hq_down, climb_hq_up
     23  USE climb_qbs_mod,       ONLY : climb_qbs_down, climb_qbs_up
    2324  USE climb_wind_mod,      ONLY : climb_wind_down, climb_wind_up
    2425  USE coef_diff_turb_mod,  ONLY : coef_diff_turb
    25   USE atke_exchange_coeff_mod, ONLY :  atke_compute_km_kh
     26  USE lmdz_call_atke,      ONLY :  call_atke
    2627  USE ioipsl_getin_p_mod,  ONLY : getin_p
    2728  USE cdrag_mod
    … …  
    261262       rlon,      rlat,      rugoro,   rmu0,          &
    262263       lwdown_m,  cldt,          &
    263        rain_f,    snow_f,    solsw_m,  solswfdiff_m, sollw_m,       &
     264       rain_f,    snow_f,    bs_f, solsw_m,  solswfdiff_m, sollw_m,       &
    264265       gustiness,                                     &
    265        t,         q,        u,        v,             &
     266       t,         q,        qbs, u,        v,             &
    266267!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
    267268!!       t_x,       q_x,       t_w,      q_w,           &
    … …  
    275276       beta, &
    276277!>jyg
    277        alb_dir_m,    alb_dif_m,  zxsens,   zxevap,    &
     278       alb_dir_m,    alb_dif_m,  zxsens,   zxevap,  zxsnowerosion,  &
    278279       alb3_lic,  runoff,    snowhgt,   qsnow,     to_ice,    sissnow,  &
    279280       zxtsol,    zxfluxlat, zt2m,     qsat2m, zn2mout, &
    280        d_t,       d_q,       d_u,      d_v, d_t_diss, &
     281       d_t,       d_q,    d_qbs,    d_u,      d_v, d_t_diss, &
    281282!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
    282283       d_t_w,     d_q_w,                              &
    … …  
    301302       rh2m,      zxfluxu,  zxfluxv,               &
    302303       z0m, z0h,   agesno,  sollw,    solsw,         &
    303        d_ts,      evap,    fluxlat,  t2m,           &
     304       d_ts,      evap,    fluxlat,   t2m,           &
    304305       wfbils,    wfbilo, wfevap, wfrain, wfsnow,   &
    305306       flux_t,   flux_u, flux_v,                    &
    … …  
    307308!jyg<
    308309!!       zxfluxt,   zxfluxq,   q2m,      flux_q, tke,   &
    309        zxfluxt,   zxfluxq,   q2m,      flux_q, tke_x,  &
     310       zxfluxt,   zxfluxq, zxfluxqbs,   q2m, flux_q, flux_qbs, tke_x,  &
    310311!>jyg
    311312!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
    … …  
    410411         dser, dt_ds, zsig, zmea
    411412    use phys_output_var_mod, only: tkt, tks, taur, sss
    412 #ifdef CPP_XIOS
    413     USE wxios, ONLY: missing_val
    414 #else
    415     use netcdf, only: missing_val => nf90_fill_real
    416 #endif
    417 
    418      
    419 
     413    use lmdz_blowing_snow_ini, only : zeta_bs
     414    USE wxios, ONLY: missing_val_xios => missing_val, using_xios
     415    use netcdf, only: nf90_fill_real
    420416
    421417    IMPLICIT NONE
    … …  
    442438    REAL, DIMENSION(klon),        INTENT(IN)        :: rugoro  ! rugosity length
    443439    REAL, DIMENSION(klon),        INTENT(IN)        :: rmu0    ! cosine of solar zenith angle
    444     REAL, DIMENSION(klon),        INTENT(IN)        :: rain_f  ! rain fall
     440    REAL, DIMENSION(klon),        INTENT(INOUT)     :: rain_f  ! rain fall
    445441    REAL, DIMENSION(klon),        INTENT(IN)        :: snow_f  ! snow fall
     442    REAL, DIMENSION(klon),        INTENT(IN)        :: bs_f  ! blowing snow fall
    446443    REAL, DIMENSION(klon),        INTENT(IN)        :: solsw_m ! net shortwave radiation at mean surface
    447444    REAL, DIMENSION(klon),        INTENT(IN)        :: solswfdiff_m ! diffuse fraction fordownward shortwave radiation at mean surface
    … …  
    449446    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: t       ! temperature (K)
    450447    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: q       ! water vapour (kg/kg)
     448    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: qbs       ! blowing snow specific content (kg/kg)
    451449    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: u       ! u speed
    452450    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: v       ! v speed
    … …  
    521519                                                                  ! (=> positive sign upwards)
    522520    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxevap     ! water vapour flux at surface, positiv upwards
     521    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxsnowerosion     ! blowing snow flux at surface
    523522    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxtsol     ! temperature at surface, mean for each grid point
    524523!!! jyg le ???
    … …  
    537536    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_u        ! change in u speed
    538537    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_v        ! change in v speed
     538    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_qbs        ! change in blowing snow specific content
     539
    539540
    540541    REAL, INTENT(OUT):: zcoefh(:, :, :) ! (klon, klev, nbsrf + 1)
    … …  
    604605    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: sollw      ! net longwave radiation at surface
    605606    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: d_ts       ! change in temperature at surface
    606     REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: evap     ! evaporation at surface
     607    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: evap       ! evaporation at surface
    607608    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: fluxlat    ! latent flux
    608609    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: t2m        ! temperature at 2 meter height
    … …  
    631632    REAL, DIMENSION(klon, klev), INTENT(OUT)        :: zxfluxt    ! sensible heat flux, mean for each grid point
    632633    REAL, DIMENSION(klon, klev), INTENT(OUT)        :: zxfluxq    ! water vapour flux, mean for each grid point
     634    REAL, DIMENSION(klon, klev), INTENT(OUT)        :: zxfluxqbs    ! blowing snow flux, mean for each grid point
    633635    REAL, DIMENSION(klon, nbsrf),INTENT(OUT)        :: q2m        ! water vapour at 2 meter height
    634636    REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_q     ! water vapour flux(latent flux) (kg/m**2/s)
     637    REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_qbs   ! blowind snow vertical flux (kg/m**2
     638
    635639#ifdef ISO   
    636640    REAL, DIMENSION(ntraciso,klon),       INTENT(OUT)        :: dflux_xt    ! change of water vapour flux
    … …  
    683687    REAL, DIMENSION(klon)              :: yalb,yalb_vis
    684688!albedo SB <<<
    685     REAL, DIMENSION(klon)              :: yt1, yq1, yu1, yv1
     689    REAL, DIMENSION(klon)              :: yt1, yq1, yu1, yv1, yqbs1
    686690    REAL, DIMENSION(klon)              :: yqa
    687691    REAL, DIMENSION(klon)              :: ysnow, yqsurf, yagesno, yqsol
    688     REAL, DIMENSION(klon)              :: yrain_f, ysnow_f
     692    REAL, DIMENSION(klon)              :: yrain_f, ysnow_f, ybs_f
    689693#ifdef ISO
    690694    REAL, DIMENSION(ntraciso,klon)              :: yxt1
    … …  
    699703    REAL, DIMENSION(klon)              :: yrugoro
    700704    REAL, DIMENSION(klon)              :: yfluxlat
     705    REAL, DIMENSION(klon)              :: yfluxbs
    701706    REAL, DIMENSION(klon)              :: y_d_ts
    702707    REAL, DIMENSION(klon)              :: y_flux_t1, y_flux_q1
    … …  
    707712#endif
    708713    REAL, DIMENSION(klon)              :: y_flux_u1, y_flux_v1
     714    REAL, DIMENSION(klon)              :: y_flux_bs, y_flux0
    709715    REAL, DIMENSION(klon)              :: yt2m, yq2m, yu10m
    710716    INTEGER, DIMENSION(klon, nbsrf, 6) :: yn2mout, yn2mout_x, yn2mout_w
    … …  
    736742#endif
    737743    REAL, DIMENSION(klon)              :: AcoefU, AcoefV, BcoefU, BcoefV
     744    REAL, DIMENSION(klon)              :: AcoefQBS, BcoefQBS
    738745    REAL, DIMENSION(klon)              :: ypsref
    739746    REAL, DIMENSION(klon)              :: yevap, yevap_pot, ytsurf_new, yalb3_new
    … …  
    744751    REAL, DIMENSION(klon)              :: meansqT ! mean square deviation of subsurface temperatures
    745752    REAL, DIMENSION(klon)              :: alb_m  ! mean albedo for whole SW interval
    746     REAL, DIMENSION(klon,klev)         :: y_d_t, y_d_q, y_d_t_diss
     753    REAL, DIMENSION(klon,klev)         :: y_d_t, y_d_q, y_d_t_diss, y_d_qbs
    747754    REAL, DIMENSION(klon,klev)         :: y_d_u, y_d_v
    748     REAL, DIMENSION(klon,klev)         :: y_flux_t, y_flux_q
     755    REAL, DIMENSION(klon,klev)         :: y_flux_t, y_flux_q, y_flux_qbs
    749756    REAL, DIMENSION(klon,klev)         :: y_flux_u, y_flux_v
    750     REAL, DIMENSION(klon,klev)         :: ycoefh, ycoefm,ycoefq
     757    REAL, DIMENSION(klon,klev)         :: ycoefh, ycoefm,ycoefq, ycoefqbs
    751758    REAL, DIMENSION(klon)              :: ycdragh, ycdragq, ycdragm
    752759    REAL, DIMENSION(klon,klev)         :: yu, yv
    753     REAL, DIMENSION(klon,klev)         :: yt, yq
     760    REAL, DIMENSION(klon,klev)         :: yt, yq, yqbs
    754761#ifdef ISO
    755762    REAL, DIMENSION(ntraciso,klon)              :: yxtevap
    … …  
    819826    REAL, DIMENSION(klon,klev)         :: CcoefH, CcoefQ, DcoefH, DcoefQ
    820827    REAL, DIMENSION(klon,klev)         :: CcoefU, CcoefV, DcoefU, DcoefV
     828    REAL, DIMENSION(klon,klev)         :: CcoefQBS, DcoefQBS
    821829    REAL, DIMENSION(klon,klev)         :: CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x
    822830    REAL, DIMENSION(klon,klev)         :: CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w
    … …  
    824832    REAL, DIMENSION(klon,klev)         :: CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w
    825833    REAL, DIMENSION(klon,klev)         :: Kcoef_hq, Kcoef_m, gama_h, gama_q
     834    REAL, DIMENSION(klon,klev)         :: gama_qbs, Kcoef_qbs
    826835    REAL, DIMENSION(klon,klev)         :: Kcoef_hq_x, Kcoef_m_x, gama_h_x, gama_q_x
    827836    REAL, DIMENSION(klon,klev)         :: Kcoef_hq_w, Kcoef_m_w, gama_h_w, gama_q_w
    … …  
    929938    REAL, DIMENSION(klon)       :: uzon_w, vmer_w, speed_w, zri1_w, pref_w !speed_w, zri1_w, pref_w, added by Fuxing WANG, 04/03/2015
    930939    REAL, DIMENSION(klon)       :: zgeo1_w, tair1_w, qair1_w, tairsol_w
    931 
     940    REAL, DIMENSION(klon)       :: yus0, yvs0
     941   
    932942!!! jyg le 25/03/2013
    933943!!    Variables intermediaires pour le raccord des deux colonnes \`a la surface
    … …  
    10161026    REAL, DIMENSION(klon,nbsrf)        :: zx_t1
    10171027    REAL, DIMENSION(klon, nbsrf)       :: alb          ! mean albedo for whole SW interval
     1028    REAL, DIMENSION(klon,nbsrf)        :: snowerosion   
    10181029    REAL, DIMENSION(klon)              :: ylwdown      ! jg : temporary (ysollwdown)
    10191030    REAL, DIMENSION(klon)              :: ygustiness      ! jg : temporary (ysollwdown)
    … …  
    10351046    ! compression of delta_sst, delta_sal, ds_ns, dt_ns, dter, dser,
    10361047    ! dt_ds, tkt, tks, taur, sss on ocean points
    1037 
     1048    REAL :: missing_val
    10381049#ifdef ISO
    10391050    REAL, DIMENSION(klon)       :: h1
    … …  
    10471058! End of declarations
    10481059!****************************************************************************************
    1049 
     1060   
    10501061      IF (prt_level >=10) print *,' -> pbl_surface, itap ',itap
     1062     
     1063      IF (using_xios) THEN
     1064        missing_val = missing_val_xios
     1065      ELSE
     1066        missing_val = nf90_fill_real
     1067      ENDIF
    10511068!
    10521069!!jyg      iflag_split = mod(iflag_pbl_split,2)
    … …  
    11891206  alb_dir_m=0. ; alb_dif_m=0. ; alb3_lic(:)=0.
    11901207!albedo SB <<<
    1191  zxsens(:)=0. ; zxevap(:)=0. ; zxtsol(:)=0.
     1208 zxsens(:)=0. ; zxevap(:)=0. ; zxtsol(:)=0. ; zxsnowerosion(:)=0.
    11921209 d_t_w(:,:)=0. ; d_q_w(:,:)=0. ; d_t_x(:,:)=0. ; d_q_x(:,:)=0.
    11931210 zxfluxlat(:)=0.
    11941211 zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0.
    11951212 zn2mout(:,:)=0 ;
    1196  d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
     1213 d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_qbs(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
    11971214 zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0.
    11981215 zxsens_x(:)=0. ; zxsens_w(:)=0. ; zxfluxlat_x(:)=0. ; zxfluxlat_w(:)=0.
    … …  
    12141231 d_ts(:,:)=0.
    12151232 evap(:,:)=0.
     1233 snowerosion(:,:)=0.
    12161234 fluxlat(:,:)=0.
    12171235 wfbils(:,:)=0. ; wfbilo(:,:)=0.
    12181236 wfevap(:,:)=0. ; wfrain(:,:)=0. ; wfsnow(:,:)=0.
    12191237 flux_t(:,:,:)=0. ; flux_q(:,:,:)=0. ; flux_u(:,:,:)=0. ; flux_v(:,:,:)=0.
     1238 flux_qbs(:,:,:)=0.
    12201239 dflux_t(:)=0. ; dflux_q(:)=0.
    12211240 zxsnow(:)=0.
    1222  zxfluxt(:,:)=0. ; zxfluxq(:,:)=0.
     1241 zxfluxt(:,:)=0. ; zxfluxq(:,:)=0.; zxfluxqbs(:,:)=0.
    12231242 qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0.
    12241243 runoff(:)=0.
    … …  
    12661285    yqsurf = 0.0  ; yalb = 0.0 ; yalb_vis = 0.0
    12671286!albedo SB <<<
    1268     yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0
    1269     ysollw = 0.0  ; yz0m = 0.0 ; yz0h = 0.0    ; yu1 = 0.0   
    1270     yv1 = 0.0     ; ypaprs = 0.0     ; ypplay = 0.0
     1287    yrain_f = 0.0 ; ysnow_f = 0.0  ; ybs_f=0.0  ; yfder = 0.0     ; ysolsw = 0.0
     1288    ysollw = 0.0  ; yz0m = 0.0 ; yz0h = 0.0    ; yz0h_oupas = 0.0 ; yu1 = 0.0   
     1289    yv1 = 0.0     ; ypaprs = 0.0     ; ypplay = 0.0     ; yqbs1 = 0.0
    12711290    ydelp = 0.0   ; yu = 0.0         ; yv = 0.0        ; yt = 0.0         
    12721291    yq = 0.0      ; y_dflux_t = 0.0  ; y_dflux_q = 0.0
     1292    yqbs(:,:)=0.0 
    12731293    yrugoro = 0.0 ; ywindsp = 0.0   
    12741294!!    d_ts = 0.0    ; yfluxlat=0.0     ; flux_t = 0.0    ; flux_q = 0.0     
    1275     yfluxlat=0.0
     1295    yfluxlat=0.0 ; y_flux0(:)=0.0
    12761296!!    flux_u = 0.0  ; flux_v = 0.0     ; d_t = 0.0       ; d_q = 0.0     
    12771297!!    d_t_diss= 0.0 ;d_u = 0.0     ; d_v = 0.0
    … …  
    12881308    ycldt = 0.0      ; yrmu0 = 0.0
    12891309    ! Martin
     1310    y_d_qbs(:,:)=0.0
    12901311
    12911312!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
    … …  
    16291650          yrain_f(j) = rain_f(i)
    16301651          ysnow_f(j) = snow_f(i)
     1652          ybs_f(j)   = bs_f(i)
    16311653          yagesno(j) = agesno(i,nsrf)
    16321654          yfder(j)   = fder(i)
    … …  
    16401662          yu1(j)     = u(i,1)
    16411663          yv1(j)     = v(i,1)
     1664          yqbs1(j)   = qbs(i,1)
    16421665          ypaprs(j,klev+1) = paprs(i,klev+1)
    16431666!jyg<
    … …  
    16531676!!! nrlmd le 13/06/2011
    16541677          y_delta_tsurf(j)=delta_tsurf(i,nsrf)
     1678          yfluxbs(j)=0.0
     1679          y_flux_bs(j) = 0.0
    16551680!!!
    16561681#ifdef ISO
    … …  
    17211746             yt(j,k) = t(i,k)
    17221747             yq(j,k) = q(i,k)
     1748             yqbs(j,k)=qbs(i,k)
    17231749#ifdef ISO
    17241750             do ixt=1,ntraciso   
    … …  
    18491875        ENDDO
    18501876        CALL cdrag(knon, nsrf, &
    1851             speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1),&
     1877            speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1), s_pblh, &
    18521878            yts, yqsurf, yz0m, yz0h, yri0, 0, &
    1853             ycdragm, ycdragh, zri1, pref )
     1879            ycdragm, ycdragh, zri1, pref, rain_f, zxtsol, ypplay(:,1))
    18541880
    18551881! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
    … …  
    18831909
    18841910            CALL cdrag(knon, nsrf, &
    1885             speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),&
     1911            speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),s_pblh_x,&
    18861912            yts_x, yqsurf_x, yz0m, yz0h, yri0, 0, &
    1887             ycdragm_x, ycdragh_x, zri1_x, pref_x )
     1913            ycdragm_x, ycdragh_x, zri1_x, pref_x, rain_f, zxtsol, ypplay(:,1) )
    18881914
    18891915! --- special Dice. JYG+MPL 25112013
    … …  
    19101936        ENDDO
    19111937        CALL cdrag(knon, nsrf, &
    1912             speed_w, yt_w(:,1), yq_w(:,1), zgeo1_w, ypaprs(:,1),&
     1938            speed_w, yt_w(:,1), yq_w(:,1), zgeo1_w, ypaprs(:,1),s_pblh_w,&
    19131939            yts_w, yqsurf_w, yz0m, yz0h, yri0, 0, &
    1914             ycdragm_w, ycdragh_w, zri1_w, pref_w )
    1915 !
    1916         zgeo1(:) = wake_s(:)*zgeo1_w(:) + (1.-wake_s(:))*zgeo1_x(:)
     1940            ycdragm_w, ycdragh_w, zri1_w, pref_w, rain_f, zxtsol, ypplay(:,1) )
     1941!
     1942!!!bug !!        zgeo1(:) = wake_s(:)*zgeo1_w(:) + (1.-wake_s(:))*zgeo1_x(:)
     1943        zgeo1(1:knon) = wake_s(1:knon)*zgeo1_w(1:knon) + (1.-wake_s(1:knon))*zgeo1_x(1:knon)
    19171944
    19181945! --- special Dice. JYG+MPL 25112013 puis BOMEX
    … …  
    19511978      print *,' args coef_diff_turb: ycdragh ', ycdragh
    19521979      print *,' args coef_diff_turb: ytke ', ytke
    1953 
    19541980       ENDIF
    19551981
    19561982        IF (iflag_pbl>=50) THEN
    19571983
    1958         CALL atke_compute_km_kh(knon,klev,yu,yv,yt, &
     1984        CALL call_atke(dtime,knon,klev,ycdragm, ycdragh,yus0,yvs0,yts,yu,yv,yt,yq, &
    19591985             ypplay,ypaprs,ytke,ycoefm, ycoefh)
    19601986
    19611987        ELSE
    1962 
    19631988
    19641989        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
    … …  
    19812006
    19822007        IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh ',ycoefh
    1983 !
     2008
     2009
    19842010       ELSE  !(iflag_split .eq.0)
     2011
    19852012      IF (prt_level >=10) THEN
    19862013      print *,' args coef_diff_turb: yu_x ',  yu_x 
    … …  
    19982025        IF (iflag_pbl>=50) THEN
    19992026
    2000         CALL atke_compute_km_kh(knon,klev,yu_x,yv_x,yt_x, &
     2027        CALL call_atke(dtime,knon,klev,ycdragm_x,ycdragh_x,yus0,yvs0,yts_x,yu_x,yv_x,yt_x,yq_x, &
    20012028             ypplay,ypaprs,ytke_x,ycoefm_x, ycoefh_x)
    20022029
    … …  
    20202047       ENDIF
    20212048
    2022        ENDIF ! iflag_pbl >= 50
     2049        ENDIF ! iflag_pbl >= 50
    20232050
    20242051        IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_x ',ycoefh_x
    … …  
    20342061      print *,' args coef_diff_turb: ycdragh_w ', ycdragh_w
    20352062      print *,' args coef_diff_turb: ytke_w ', ytke_w
    2036        ENDIF
     2063      ENDIF
    20372064
    20382065        IF (iflag_pbl>=50) THEN
    20392066
    2040         CALL atke_compute_km_kh(knon,klev,yu_w,yv_w,yt_w, &
     2067        CALL call_atke(dtime,knon,klev,ycdragm_w,ycdragh_w,yus0,yvs0,yts_w,yu_w,yv_w,yt_w,yq_w, &
    20412068             ypplay,ypaprs,ytke_w,ycoefm_w, ycoefh_w)
    20422069
    … …  
    20622089
    20632090        IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_w ',ycoefh_w
    2064 !
     2091
    20652092!!!jyg le 10/04/2013
    20662093!!   En attendant de traiter le transport des traceurs dans les poches froides, formule
    … …  
    20722099        ENDDO
    20732100      ENDDO
    2074 !!!
    20752101       ENDIF  ! (iflag_split .eq.0)
    2076 !!!
    20772102       
    20782103!****************************************************************************************
    … …  
    21712196       ENDIF  ! (iflag_split .eq.0)
    21722197!!!
     2198
     2199 ! For blowing snow:
     2200    IF (ok_bs) THEN
     2201     ! following Bintanja et al 2000, part II
     2202     ! we assume that the eddy diffsivity coefficient for
     2203     ! suspended particles is larger than Km by a factor zeta_bs
     2204     ! which is equal to 3 by default
     2205     do k=1,klev
     2206        do j=1,knon
     2207           ycoefqbs(j,k)=ycoefm(j,k)*zeta_bs
     2208        enddo
     2209     enddo
     2210     CALL climb_qbs_down(knon, ycoefqbs, ypaprs, ypplay, &
     2211     ydelp, yt, yqbs, dtime, &
     2212     CcoefQBS, DcoefQBS, &
     2213     Kcoef_qbs, gama_qbs, &
     2214     AcoefQBS, BcoefQBS)
     2215    ENDIF
     2216
     2217
    21732218
    21742219!****************************************************************************************
    … …  
    23362381               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
    23372382               yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
    2338                yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
     2383               yt2m, yq2m, yt10m, yq10m, yu10m, yustar, ypblh, rain_f, zxtsol)
    23392384          ENDIF
    23402385         
    … …  
    23562401               debut, lafin, ydelp(:,1), r_co2_ppm, ysolsw, ysollw, yalb, &
    23572402!!jyg               yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
    2358                yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
     2403               yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt1, yq1,&
    23592404               AcoefH, AcoefQ, BcoefH, BcoefQ, &
    23602405               AcoefU, AcoefV, BcoefU, BcoefV, &
    … …  
    23622407               ylwdown, yq2m, yt2m, &
    23632408               ysnow, yqsol, yagesno, ytsoil, &
    2364                yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
     2409               yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,yfluxbs,&
    23652410               yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
    23662411               y_flux_u1, y_flux_v1, &
    … …  
    24072452            call iso_verif_noNaN(yxtevap(ixt,j), &
    24082453         &      'pbl_surface 1056a: apres surf_land')
     2454          enddo
     2455          do ixt=1,niso
    24092456            call iso_verif_noNaN(yxtsol(ixt,j), &
    24102457         &      'pbl_surface 1056b: apres surf_land')
    … …  
    24312478                  yrmu0, ylwdown, yalb, zgeo1, &
    24322479                  ysolsw, ysollw, yts, ypplay(:,1), &
    2433                   !!jyg               ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
    2434                   ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
     2480                  ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt1, yq1,&
    24352481                  AcoefH, AcoefQ, BcoefH, BcoefQ, &
    24362482                  AcoefU, AcoefV, BcoefU, BcoefV, &
     2483                  AcoefQBS, BcoefQBS, &
    24372484                  ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
    2438                   ysnow, yqsurf, yqsol, yagesno, &
     2485                  ysnow, yqsurf, yqsol,yqbs1, yagesno, &
    24392486                  ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
    2440                   ytsurf_new, y_dflux_t, y_dflux_q, &
     2487                  yfluxbs, ytsurf_new, y_dflux_t, y_dflux_q, &
    24412488                  yzmea, yzsig, ycldt, &
    24422489                  ysnowhgt, yqsnow, ytoice, ysissnow, &
    … …  
    24752522                   call iso_verif_noNaN(yxtevap(ixt,j), &
    24762523                        &      'pbl_surface 1095a: apres surf_landice')
     2524                enddo
     2525                do ixt=1,niso
    24772526                   call iso_verif_noNaN(yxtsol(ixt,j), &
    24782527                        &      'pbl_surface 1095b: apres surf_landice')
    … …  
    24952544               itap, dtime, jour, knon, ni, &
    24962545!!jyg               ypplay(:,1), zgeo1/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
    2497                ypplay(:,1), zgeo1(1:knon)/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&    ! ym missing init
     2546               ypplay(:,1), zgeo1(1:knon)/RG, ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt(:,1), yq(:,1),&    ! ym missing init
    24982547               AcoefH, AcoefQ, BcoefH, BcoefQ, &
    24992548               AcoefU, AcoefV, BcoefU, BcoefV, &
    … …  
    25702619            call iso_verif_noNaN(yxtevap(ixt,j), &
    25712620         &      'pbl_surface 1165a: apres surf_seaice')
     2621          enddo
     2622          do ixt=1,niso
    25722623            call iso_verif_noNaN(yxtsol(ixt,j), &
    25732624         &      'pbl_surface 1165b: apres surf_seaice')
    … …  
    26582709          ENDDO
    26592710        ENDIF ! (ok_flux_surf)
     2711
     2712        ! flux of blowing snow at the first level
     2713        IF (ok_bs) THEN
     2714        DO j=1,knon
     2715        y_flux_bs(j)=yfluxbs(j)
     2716        ENDDO
     2717        ENDIF
    26602718!
    26612719! ------------------------------------------------------------------------------
    … …  
    29853043!
    29863044       ENDIF  ! (iflag_split .eq.0)
     3045
     3046       IF (ok_bs) THEN
     3047            CALL climb_qbs_up(knon, dtime, yqbs, &
     3048            y_flux_bs, ypaprs, ypplay, &
     3049            AcoefQBS, BcoefQBS, &
     3050            CcoefQBS, DcoefQBS, &
     3051            Kcoef_qbs, gama_qbs, &
     3052            y_flux_qbs(:,:), y_d_qbs(:,:))
     3053       ENDIF
     3054
    29873055!!!
    29883056!!
    … …  
    31513219!!!
    31523220
    3153 !      print*,'Dans pbl OK1'
    3154 
    3155 !jyg<
    3156 !!       evap(:,nsrf) = - flux_q(:,1,nsrf)
    3157 !>jyg
     3221       ! tendencies of blowing snow
     3222       IF (ok_bs) THEN
     3223           DO k = 1, klev   
     3224            DO j = 1, knon
     3225                i = ni(j)
     3226                y_d_qbs(j,k)=y_d_qbs(j,k) * ypct(j)
     3227                flux_qbs(i,k,nsrf) = y_flux_qbs(j,k)
     3228            ENDDO
     3229          ENDDO
     3230       ENDIF
     3231
     3232
    31583233       DO j = 1, knon
    31593234          i = ni(j)
    31603235          evap(i,nsrf) = - flux_q(i,1,nsrf)                  !jyg
     3236          if (ok_bs) then ; snowerosion(i,nsrf)=flux_qbs(i,1,nsrf); endif
    31613237          beta(i,nsrf) = ybeta(j)                             !jyg
    31623238          d_ts(i,nsrf) = y_d_ts(j)
    … …  
    33863462          ENDDO
    33873463       ENDDO
     3464
     3465
     3466       IF (ok_bs) THEN
     3467         DO k = 1, klev
     3468         DO j = 1, knon
     3469         i = ni(j)
     3470         d_qbs(i,k) = d_qbs(i,k) + y_d_qbs(j,k)
     3471         ENDDO
     3472         ENDDO
     3473        ENDIF
     3474
    33883475
    33893476#ifdef ISO
    … …  
    35223609       IF (iflag_split .eq.0) THEN
    35233610        IF (iflag_new_t2mq2m==1) THEN
    3524          CALL stdlevvarn(klon, knon, nsrf, zxli, &
     3611           CALL stdlevvarn(klon, knon, nsrf, zxli, &
    35253612            uzon, vmer, tair1, qair1, zgeo1, &
    35263613            tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
    … …  
    35313618            uzon, vmer, tair1, qair1, zgeo1, &
    35323619            tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
    3533             yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
     3620            yt2m, yq2m, yt10m, yq10m, yu10m, yustar, ypblh, rain_f, zxtsol)
    35343621        ENDIF
    35353622       ELSE  !(iflag_split .eq.0)
    … …  
    35493636            uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
    35503637            tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
    3551             yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x)
     3638            yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x, ypblh_x, rain_f, zxtsol)
    35523639        CALL stdlevvar(klon, knon, nsrf, zxli, &
    35533640            uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
    35543641            tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
    3555             yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w)
     3642            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w, ypblh_w, rain_f, zxtsol)
    35563643        ENDIF
    35573644!!!
    … …  
    38883975       fder_print(i) = fder(i) + dflux_t(i) + dflux_q(i)
    38893976    ENDDO
     3977
     3978    ! if blowing snow
     3979    if (ok_bs) then 
     3980       DO nsrf = 1, nbsrf
     3981       DO k = 1, klev
     3982       DO i = 1, klon
     3983         zxfluxqbs(i,k) = zxfluxqbs(i,k) + flux_qbs(i,k,nsrf) * pctsrf(i,nsrf)
     3984       ENDDO
     3985       ENDDO
     3986       ENDDO
     3987
     3988       DO i = 1, klon
     3989        zxsnowerosion(i)     = zxfluxqbs(i,1) ! blowings snow flux at the surface
     3990       END DO
     3991    endif
     3992
     3993   
     3994   
    38903995#ifdef ISO
    38913996    DO i = 1, klon
Note: See TracChangeset for help on using the changeset viewer.