Changeset 2952 for LMDZ5/trunk/libf/phylmd/pbl_surface_mod.F90

Timestamp:

Jul 14, 2017, 10:23:40 PM (7 years ago)

Author:

Laurent Fairhead

Message:

Parametrization of drag by copses
Need version 4465 of ORCHIDEE at least

6. Cheruy

Location:

LMDZ5/trunk

Files:

• . (modified) (1 prop)
• libf/phylmd/pbl_surface_mod.F90 (modified) (14 diffs)

LMDZ5/trunk/libf/phylmd/pbl_surface_mod.F90

@@ -39 +39 @@
   integer, save :: iflag_pbl_surface_t2m_bug
   !$OMP THREADPRIVATE(iflag_pbl_surface_t2m_bug)
+!FC
+!  integer, save :: iflag_frein
+!  !$OMP THREADPRIVATE(iflag_frein)
 
 CONTAINS
@@ -138 +141 @@
     iflag_pbl_surface_t2m_bug=0
     CALL getin_p('iflag_pbl_surface_t2m_bug',iflag_pbl_surface_t2m_bug)
-
+!FC
+!    iflag_frein = 0
+!    CALL getin_p('iflag_frein',iflag_frein)
+!
   END SUBROUTINE pbl_surface_init
 !  
@@ -196 +202 @@
 !!        tke_x,     tke_w                              &
        wake_dltke                                     &
+        , treedrg                                   &
+!FC
 !!!
                         )
@@ -281 +289 @@
     INCLUDE "compbl.h"
     INCLUDE "flux_arp.h"
+!FC 
+    INCLUDE "dimpft.h"
+
 !****************************************************************************************
     REAL,                         INTENT(IN)        :: dtime   ! time interval (s)
@@ -447 +458 @@
     REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_u     ! u wind tension (kg m/s)/(m**2 s) or Pascal
     REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v     ! v wind tension (kg m/s)/(m**2 s) or Pascal
+!FC
+    REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT)  :: treedrg      ! tree drag (m)               
+
 
 ! Output not needed
@@ -548 +562 @@
     REAL, DIMENSION(klon,klev+1)       :: ytke
     REAL, DIMENSION(klon,nsoilmx)      :: ytsoil
+!FC 
+    REAL, DIMENSION(klon,nvm_lmdz)          :: yveget
+    REAL, DIMENSION(klon,nvm_lmdz)          :: ylai
+    REAL, DIMENSION(klon,nvm_lmdz)          :: yheight
+    REAL, DIMENSION(klon,klev)              :: y_d_u_frein
+    REAL, DIMENSION(klon,klev)              :: y_d_v_frein
+    REAL, DIMENSION(klon,klev)              :: y_treedrg
+!FC
+
+
     CHARACTER(len=80)                  :: abort_message
     CHARACTER(len=20)                  :: modname = 'pbl_surface'
@@ -929 +953 @@
     yqsol = 0.0    
     ytherm = 0.0  ; ytke=0.
+!FC 
+    y_treedrg=0.
+
     ! Martin
     ysnowhgt = 0.0; yqsnow = 0.0     ; yrunoff = 0.0   ; ytoice =0.0
@@ -952 +979 @@
 !!!
     ytsoil = 999999. 
+!FC
+    y_d_u_frein(:,:)=0.
+    y_d_v_frein(:,:)=0.
+!FC
+
+
 
 
@@ -1240 +1273 @@
              ytke(j,k)   = tke_x(i,k,nsrf)
 !>jyg
+!FC
+             y_treedrg(j,k) =  treedrg(i,k,nsrf)
+!            print*,nsrf, "treedrg ",y_treedrg(j,k),j,k
+!FC
+
              yu(j,k) = u(i,k)
              yv(j,k) = v(i,k)
@@ -1435 +1473 @@
         CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
             ypaprs, ypplay, yu, yv, yq, yt, yts, yqsurf, ycdragm, &
-            ycoefm, ycoefh, ytke)
+            ycoefm, ycoefh, ytke, y_treedrg)
+!            ycoefm, ycoefh, ytke)
+!FC y_treedrg ajouté
        IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
 ! In this case, coef_diff_turb is called for the Cd only
@@ -1462 +1502 @@
         CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
             ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yqsurf, ycdragm_x, &
-            ycoefm_x, ycoefh_x, ytke_x)
+            ycoefm_x, ycoefh_x, ytke_x,y_treedrg)
+!            ycoefm_x, ycoefh_x, ytke_x)
+!FC doit on le mettre ( on ne l utilise pas si il y a du spliting)
        IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
 ! In this case, coef_diff_turb is called for the Cd only
@@ -1488 +1530 @@
         CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
             ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yqsurf, ycdragm_w, &
-            ycoefm_w, ycoefh_w, ytke_w)
+            ycoefm_w, ycoefh_w, ytke_w,y_treedrg)
+!            ycoefm_w, ycoefh_w, ytke_w)
        IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
 ! In this case, coef_diff_turb is called for the Cd only
@@ -1775 +1818 @@
                yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
                yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
-               y_flux_u1, y_flux_v1 )
+               y_flux_u1, y_flux_v1, &
+               yveget,ylai,yheight )
+!FC quid qd yveget ylai yheight ne sont pas definit
+!FC  yveget,ylai,yheight, &
+            if (ifl_pbltree .ge. 1) then
+            CALL   freinage(knon, yu, yv, yt, &
+!              yveget,ylai, yheight,ypaprs,ypplay,y_d_u_frein,y_d_v_frein)
+              yveget,ylai, yheight,ypaprs,ypplay,y_treedrg, y_d_u_frein,y_d_v_frein)
+             endif
+
                
 ! Special DICE MPL 05082013 puis BOMEX
@@ -2182 +2234 @@
              y_d_u(j,k)  = y_d_u(j,k) * ypct(j)
              y_d_v(j,k)  = y_d_v(j,k) * ypct(j)
+!FC
+              if  (nsrf .EQ. is_ter .and. ifl_pbltree .ge. 1  ) then
+!            if (y_d_u_frein(j,k).ne.0. ) then
+!        print*, nsrf,'IS_TER ++', y_d_u_frein(j,k)*ypct(j),y_d_u(j,k),j,k
+!            endif
+             y_d_u(j,k) =y_d_u(j,k) + y_d_u_frein(j,k)*ypct(j)
+             y_d_v(j,k) =y_d_v(j,k) + y_d_v_frein(j,k)*ypct(j)
+             treedrg(i,k,nsrf)=y_treedrg(j,k)
+             else 
+             treedrg(i,k,nsrf)=0.
+               endif
+!FC
 
              flux_t(i,k,nsrf) = y_flux_t(j,k)