Ignore:
Timestamp:
Feb 5, 2021, 10:00:13 AM (3 years ago)
Author:
musat
Message:

Nouveaux calculs a 2m et 10m

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/IPSL-CM6A-MR/libf/phylmd/pbl_surface_mod.F90

    r3435 r3823  
    2323  USE climb_wind_mod,      ONLY : climb_wind_down, climb_wind_up
    2424  USE coef_diff_turb_mod,  ONLY : coef_diff_turb
     25  USE ioipsl_getin_p_mod,  ONLY : getin_p
     26  USE cdrag_mod
     27  USE stdlevvar_mod
    2528  USE wx_pbl_mod,          ONLY : wx_pbl_init, wx_pbl_final, &
    2629!!                                  wx_pbl_fuse_no_dts, wx_pbl_split_no_dts, &
    … …  
    4245  INTEGER, SAVE :: iflag_pbl_surface_t2m_bug
    4346  !$OMP THREADPRIVATE(iflag_pbl_surface_t2m_bug)
     47  integer, save :: iflag_new_t2mq2m
     48  !$OMP THREADPRIVATE(iflag_new_t2mq2m)
    4449!FC
    4550!  integer, save :: iflag_frein
    … …  
    177182       alb_dir_m,    alb_dif_m,  zxsens,   zxevap,    &
    178183       alb3_lic,  runoff,    snowhgt,   qsnow,     to_ice,    sissnow,  &
    179        zxtsol,    zxfluxlat, zt2m,     qsat2m,       &
     184       zxtsol,    zxfluxlat, zt2m,     qsat2m, zn2mout, &
    180185       d_t,       d_q,       d_u,      d_v, d_t_diss, &
    181186!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
    … …  
    394399    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxfluxlat  ! latent flux, mean for each grid point
    395400    REAL, DIMENSION(klon),        INTENT(OUT)       :: zt2m       ! temperature at 2m, mean for each grid point
     401    INTEGER, DIMENSION(klon, 6),  INTENT(OUT)       :: zn2mout ! nb of times t2m is out of the [tsol,temp]
    396402    REAL, DIMENSION(klon),        INTENT(OUT)       :: qsat2m
    397403    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_t        ! change in temperature
    … …  
    537543    REAL, DIMENSION(klon)              :: y_flux_u1, y_flux_v1
    538544    REAL, DIMENSION(klon)              :: yt2m, yq2m, yu10m
     545    INTEGER, DIMENSION(klon, nbsrf, 6) :: yn2mout, yn2mout_x, yn2mout_w
     546    INTEGER, DIMENSION(klon, nbsrf, 6) :: n2mout, n2mout_x, n2mout_w
    539547    REAL, DIMENSION(klon)              :: yustar
    540548    REAL, DIMENSION(klon)              :: ywstar
    … …  
    838846
    839847    IF (first_call) THEN
     848
     849       iflag_new_t2mq2m=0
     850       CALL getin_p('iflag_new_t2mq2m',iflag_new_t2mq2m)
     851       print*,'pbl_iflag_new_t2mq2m=',iflag_new_t2mq2m
     852
    840853       print*,'PBL SURFACE AVEC GUSTINESS'
    841854       first_call=.FALSE.
    … …  
    903916 zxfluxlat(:)=0.
    904917 zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0.
     918 zn2mout(:,:)=0 ;
    905919 d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
    906920 zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0.
    … …  
    18211835
    18221836          ! Calculate the temperature et relative humidity at 2m and the wind at 10m
     1837          IF (iflag_new_t2mq2m==1) THEN
     1838           CALL stdlevvarn(klon, knon, is_ter, zxli, &
     1839               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
     1840               yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
     1841               yt2m, yq2m, yt10m, yq10m, yu10m, yn2mout(:, nsrf, :))
     1842          ELSE
    18231843          CALL stdlevvar(klon, knon, is_ter, zxli, &
    18241844               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
    18251845               yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
    18261846               yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
    1827          
     1847          ENDIF
    18281848       ENDIF
    18291849
    … …  
    26142634!!! jyg le 07/02/2012
    26152635       IF (iflag_split .eq.0) THEN
     2636        IF (iflag_new_t2mq2m==1) THEN
     2637         CALL stdlevvarn(klon, knon, nsrf, zxli, &
     2638            uzon, vmer, tair1, qair1, zgeo1, &
     2639            tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
     2640            yt2m, yq2m, yt10m, yq10m, yu10m, yn2mout(:, nsrf, :))
     2641        ELSE
    26162642        CALL stdlevvar(klon, knon, nsrf, zxli, &
    26172643            uzon, vmer, tair1, qair1, zgeo1, &
    26182644            tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
    26192645            yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
     2646        ENDIF
    26202647       ELSE  !(iflag_split .eq.0)
     2648        IF (iflag_new_t2mq2m==1) THEN
     2649         CALL stdlevvarn(klon, knon, nsrf, zxli, &
     2650            uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
     2651            tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
     2652            yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yn2mout_x(:, nsrf, :))
     2653         CALL stdlevvarn(klon, knon, nsrf, zxli, &
     2654            uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
     2655            tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
     2656            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yn2mout_w(:, nsrf, :))
     2657        ELSE
    26212658        CALL stdlevvar(klon, knon, nsrf, zxli, &
    26222659            uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
    … …  
    26272664            tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
    26282665            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w)
     2666        ENDIF
    26292667!!!
    26302668       ENDIF  ! (iflag_split .eq.0)
    … …  
    26402678          u10m(i,nsrf)=(yu10m(j) * uzon(j))/SQRT(uzon(j)**2+vmer(j)**2)
    26412679          v10m(i,nsrf)=(yu10m(j) * vmer(j))/SQRT(uzon(j)**2+vmer(j)**2)
     2680!
     2681          DO k = 1, 6
     2682           n2mout(i,nsrf,k) = yn2mout(j,nsrf,k)
     2683          END DO
     2684!
    26422685        ENDDO
    26432686       ELSE  !(iflag_split .eq.0)
    … …  
    26502693          u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
    26512694          v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
     2695!
     2696          DO k = 1, 6
     2697           n2mout_x(i,nsrf,k) = yn2mout_x(j,nsrf,k)
     2698          END DO
     2699!
    26522700        ENDDO
    26532701        DO j=1, knon
    … …  
    26632711          u10m(i,nsrf) = u10m_x(i,nsrf) + wake_s(i)*(u10m_w(i,nsrf)-u10m_x(i,nsrf))
    26642712          v10m(i,nsrf) = v10m_x(i,nsrf) + wake_s(i)*(v10m_w(i,nsrf)-v10m_x(i,nsrf))
     2713!
     2714          DO k = 1, 6
     2715           n2mout_w(i,nsrf,k) = yn2mout_w(j,nsrf,k)
     2716          END DO
     2717!
    26652718        ENDDO
    26662719!!!
    … …  
    29192972!
    29202973    zxtsol(:) = 0.0  ; zxfluxlat(:) = 0.0
    2921     zt2m(:) = 0.0    ; zq2m(:) = 0.0
     2974    zt2m(:) = 0.0    ; zq2m(:) = 0.0 ; zn2mout(:,:) = 0
    29222975    zustar(:)=0.0 ; zu10m(:) = 0.0   ; zv10m(:) = 0.0
    29232976    s_pblh(:) = 0.0  ; s_plcl(:) = 0.0
    … …  
    29723025          zt2m(i)  = zt2m(i)  + t2m(i,nsrf)  * pctsrf(i,nsrf)
    29733026          zq2m(i)  = zq2m(i)  + q2m(i,nsrf)  * pctsrf(i,nsrf)
     3027!
     3028          DO k = 1, 6
     3029           zn2mout(i,k)  = zn2mout(i,k)  + n2mout(i,nsrf,k)  * pctsrf(i,nsrf)
     3030          ENDDO
     3031!
    29743032          zustar(i) = zustar(i) + ustar(i,nsrf) * pctsrf(i,nsrf)
    29753033          wstar(i,is_ave)=wstar(i,is_ave)+wstar(i,nsrf)*pctsrf(i,nsrf)
    … …  
    30033061          zt2m(i)  = zt2m(i)  + (t2m_x(i,nsrf)+wake_s(i)*(t2m_w(i,nsrf)-t2m_x(i,nsrf))) * pctsrf(i,nsrf)
    30043062          zq2m(i)  = zq2m(i)  + q2m_x(i,nsrf)  * pctsrf(i,nsrf)
     3063!
     3064          DO k = 1, 6
     3065           zn2mout(i,k)  = zn2mout(i,k)  + n2mout_x(i,nsrf,k)  * pctsrf(i,nsrf)
     3066          ENDDO
     3067!
    30053068          zustar(i) = zustar(i) + ustar_x(i,nsrf) * pctsrf(i,nsrf)
    30063069          wstar(i,is_ave)=wstar(i,is_ave)+wstar_x(i,nsrf)*pctsrf(i,nsrf)
    … …  
    30813144    DO nsrf = 1, nbsrf
    30823145       DO i = 1, klon
    3083           zxqsurf(i) = zxqsurf(i) + qsurf(i,nsrf) * pctsrf(i,nsrf)
     3146          zxqsurf(i) = zxqsurf(i) + MAX(qsurf(i,nsrf),0.0) * pctsrf(i,nsrf)
    30843147          zxsnow(i)  = zxsnow(i)  + snow(i,nsrf)  * pctsrf(i,nsrf)
    30853148       ENDDO
Note: See TracChangeset for help on using the changeset viewer.