Ignore:
Timestamp:
Feb 3, 2021, 8:58:55 PM (3 years ago)
Author:
musat
Message:

Nouvelle formulation des calculs a 2m

File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/trunk/libf/phylmd/pbl_surface_mod.F90

    r3815 r3817  
    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 stdlevvar_mod
    2527  USE wx_pbl_mod,          ONLY : wx_pbl_init, wx_pbl_final, &
    2628!!                                  wx_pbl_fuse_no_dts, wx_pbl_split_no_dts, &
     
    4345  INTEGER, SAVE :: iflag_pbl_surface_t2m_bug
    4446  !$OMP THREADPRIVATE(iflag_pbl_surface_t2m_bug)
     47  integer, save :: iflag_new_t2mq2m
     48  !$OMP THREADPRIVATE(iflag_new_t2mq2m)
     49
    4550!FC
    4651!  integer, save :: iflag_frein
     
    178183       alb_dir_m,    alb_dif_m,  zxsens,   zxevap,    &
    179184       alb3_lic,  runoff,    snowhgt,   qsnow,     to_ice,    sissnow,  &
    180        zxtsol,    zxfluxlat, zt2m,     qsat2m,       &
     185       zxtsol,    zxfluxlat, zt2m,     qsat2m, zn2mout, &
    181186       d_t,       d_q,       d_u,      d_v, d_t_diss, &
    182187!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
     
    404409    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxfluxlat  ! latent flux, mean for each grid point
    405410    REAL, DIMENSION(klon),        INTENT(OUT)       :: zt2m       ! temperature at 2m, mean for each grid point
     411    INTEGER, DIMENSION(klon, 6),  INTENT(OUT)       :: zn2mout    ! number of times the 2m temperature is out of the [tsol,temp]
    406412    REAL, DIMENSION(klon),        INTENT(OUT)       :: qsat2m
    407413    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_t        ! change in temperature
     
    547553    REAL, DIMENSION(klon)              :: y_flux_u1, y_flux_v1
    548554    REAL, DIMENSION(klon)              :: yt2m, yq2m, yu10m
     555    INTEGER, DIMENSION(klon, nbsrf, 6) :: yn2mout, yn2mout_x, yn2mout_w
     556    INTEGER, DIMENSION(klon, nbsrf, 6) :: n2mout, n2mout_x, n2mout_w
    549557    REAL, DIMENSION(klon)              :: yustar
    550558    REAL, DIMENSION(klon)              :: ywstar
     
    853861
    854862    IF (first_call) THEN
     863
     864       iflag_new_t2mq2m=1
     865       CALL getin_p('iflag_new_t2mq2m',iflag_new_t2mq2m)
     866       print*,'pbl_iflag_new_t2mq2m=',iflag_new_t2mq2m
     867
    855868       print*,'PBL SURFACE AVEC GUSTINESS'
    856869       first_call=.FALSE.
     
    919932 zxfluxlat(:)=0.
    920933 zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0.
     934 zn2mout(:,:)=0 ;
    921935 d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
    922936 zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0.
     
    18571871
    18581872          ! Calculate the temperature et relative humidity at 2m and the wind at 10m
     1873          IF (iflag_new_t2mq2m==1) THEN
     1874           CALL stdlevvarn(klon, knon, is_ter, zxli, &
     1875               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
     1876               yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
     1877               yt2m, yq2m, yt10m, yq10m, yu10m, yn2mout(:, nsrf, :))
     1878          ELSE
    18591879          CALL stdlevvar(klon, knon, is_ter, zxli, &
    18601880               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
    18611881               yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
    18621882               yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
     1883          ENDIF
    18631884         
    18641885       ENDIF
     
    26862707!!! jyg le 07/02/2012
    26872708       IF (iflag_split .eq.0) THEN
     2709        IF (iflag_new_t2mq2m==1) THEN
     2710         CALL stdlevvarn(klon, knon, nsrf, zxli, &
     2711            uzon, vmer, tair1, qair1, zgeo1, &
     2712            tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
     2713            yt2m, yq2m, yt10m, yq10m, yu10m, yn2mout(:, nsrf, :))
     2714        ELSE
    26882715        CALL stdlevvar(klon, knon, nsrf, zxli, &
    26892716            uzon, vmer, tair1, qair1, zgeo1, &
    26902717            tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
    26912718            yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
     2719        ENDIF
    26922720       ELSE  !(iflag_split .eq.0)
     2721        IF (iflag_new_t2mq2m==1) THEN
     2722         CALL stdlevvarn(klon, knon, nsrf, zxli, &
     2723            uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
     2724            tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
     2725            yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yn2mout_x(:, nsrf, :))
     2726         CALL stdlevvarn(klon, knon, nsrf, zxli, &
     2727            uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
     2728            tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
     2729            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yn2mout_w(:, nsrf, :))
     2730        ELSE
    26932731        CALL stdlevvar(klon, knon, nsrf, zxli, &
    26942732            uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
     
    26992737            tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
    27002738            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w)
     2739        ENDIF
    27012740!!!
    27022741       ENDIF  ! (iflag_split .eq.0)
     
    27122751          u10m(i,nsrf)=(yu10m(j) * uzon(j))/SQRT(uzon(j)**2+vmer(j)**2)
    27132752          v10m(i,nsrf)=(yu10m(j) * vmer(j))/SQRT(uzon(j)**2+vmer(j)**2)
     2753!
     2754          DO k = 1, 6
     2755           n2mout(i,nsrf,k) = yn2mout(j,nsrf,k)
     2756          END DO 
     2757!
    27142758        ENDDO
    27152759       ELSE  !(iflag_split .eq.0)
     
    27222766          u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
    27232767          v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
     2768!
     2769          DO k = 1, 6
     2770           n2mout_x(i,nsrf,k) = yn2mout_x(j,nsrf,k)
     2771          END DO 
     2772!
    27242773        ENDDO
    27252774        DO j=1, knon
     
    27352784          u10m(i,nsrf) = u10m_x(i,nsrf) + wake_s(i)*(u10m_w(i,nsrf)-u10m_x(i,nsrf))
    27362785          v10m(i,nsrf) = v10m_x(i,nsrf) + wake_s(i)*(v10m_w(i,nsrf)-v10m_x(i,nsrf))
     2786!
     2787          DO k = 1, 6
     2788           n2mout_w(i,nsrf,k) = yn2mout_w(j,nsrf,k)
     2789          END DO 
     2790!
    27372791        ENDDO
    27382792!!!
     
    29913045!
    29923046    zxtsol(:) = 0.0  ; zxfluxlat(:) = 0.0
    2993     zt2m(:) = 0.0    ; zq2m(:) = 0.0
     3047    zt2m(:) = 0.0    ; zq2m(:) = 0.0 ; zn2mout(:,:) = 0
    29943048    zustar(:)=0.0 ; zu10m(:) = 0.0   ; zv10m(:) = 0.0
    29953049    s_pblh(:) = 0.0  ; s_plcl(:) = 0.0
     
    30443098          zt2m(i)  = zt2m(i)  + t2m(i,nsrf)  * pctsrf(i,nsrf)
    30453099          zq2m(i)  = zq2m(i)  + q2m(i,nsrf)  * pctsrf(i,nsrf)
     3100!
     3101          DO k = 1, 6
     3102           zn2mout(i,k)  = zn2mout(i,k)  + n2mout(i,nsrf,k)  * pctsrf(i,nsrf)
     3103          ENDDO 
     3104!
    30463105          zustar(i) = zustar(i) + ustar(i,nsrf) * pctsrf(i,nsrf)
    30473106          wstar(i,is_ave)=wstar(i,is_ave)+wstar(i,nsrf)*pctsrf(i,nsrf)
     
    30753134          zt2m(i)  = zt2m(i)  + (t2m_x(i,nsrf)+wake_s(i)*(t2m_w(i,nsrf)-t2m_x(i,nsrf))) * pctsrf(i,nsrf)
    30763135          zq2m(i)  = zq2m(i)  + q2m_x(i,nsrf)  * pctsrf(i,nsrf)
     3136!
     3137          DO k = 1, 6
     3138           zn2mout(i,k)  = zn2mout(i,k)  + n2mout_x(i,nsrf,k)  * pctsrf(i,nsrf)
     3139          ENDDO
     3140!
    30773141          zustar(i) = zustar(i) + ustar_x(i,nsrf) * pctsrf(i,nsrf)
    30783142          wstar(i,is_ave)=wstar(i,is_ave)+wstar_x(i,nsrf)*pctsrf(i,nsrf)
     
    31533217    DO nsrf = 1, nbsrf
    31543218       DO i = 1, klon
    3155           zxqsurf(i) = zxqsurf(i) + qsurf(i,nsrf) * pctsrf(i,nsrf)
     3219          zxqsurf(i) = zxqsurf(i) + MAX(qsurf(i,nsrf),0.0) * pctsrf(i,nsrf)
    31563220          zxsnow(i)  = zxsnow(i)  + snow(i,nsrf)  * pctsrf(i,nsrf)
    31573221       ENDDO
Note: See TracChangeset for help on using the changeset viewer.