Changeset 3798 for LMDZ6/branches/Ocean_skin/libf/phylmd/pbl_surface_mod.F90

Timestamp:

Jan 11, 2021, 11:24:08 PM (4 years ago)

Author:

lguez

Message:

Sync latest trunk changes to Ocean_skin

Location:

LMDZ6/branches/Ocean_skin

Files:

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

LMDZ6/branches/Ocean_skin/libf/phylmd/pbl_surface_mod.F90

@@ -165 +165 @@
        rlon,      rlat,      rugoro,   rmu0,          &
        zsig,      lwdown_m,  pphi,     cldt,          &
-       rain_f,    snow_f,    solsw_m,  sollw_m,       &
+       rain_f,    snow_f,    solsw_m,  solswfdiff_m, sollw_m,       &
        gustiness,                                     &
        t,         q,         u,        v,             &
@@ -207 +207 @@
 !jyg<
 !!       zxfluxt,   zxfluxq,   q2m,      flux_q, tke,   &
-       zxfluxt,   zxfluxq,   q2m,      flux_q, tke_x,   &
+       zxfluxt,   zxfluxq,   q2m,      flux_q, tke_x,  &
 !>jyg
 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
@@ -287 +287 @@
     USE carbon_cycle_mod,   ONLY : carbon_cycle_cpl, carbon_cycle_tr, level_coupling_esm 
     USE carbon_cycle_mod,   ONLY : co2_send, nbcf_out, fields_out, yfields_out, cfname_out
+    use hbtm_mod, only: hbtm
     USE indice_sol_mod
     USE time_phylmdz_mod,   ONLY : day_ini,annee_ref,itau_phy
@@ -326 +327 @@
     REAL, DIMENSION(klon),        INTENT(IN)        :: snow_f  ! snow fall
     REAL, DIMENSION(klon),        INTENT(IN)        :: solsw_m ! net shortwave radiation at mean surface
+    REAL, DIMENSION(klon),        INTENT(IN)        :: solswfdiff_m ! diffuse fraction fordownward shortwave radiation at mean surface
     REAL, DIMENSION(klon),        INTENT(IN)        :: sollw_m ! net longwave radiation at mean surface
     REAL, DIMENSION(klon,klev),   INTENT(IN)        :: t       ! temperature (K)
@@ -461 +463 @@
     REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxu    ! u wind tension, mean for each grid point
     REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxv    ! v wind tension, mean for each grid point
-    REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT)     :: z0m,z0h      ! rugosity length (m)
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)       :: agesno   ! age of snow at surface
+    REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT)   :: z0m,z0h      ! rugosity length (m)
+    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: agesno   ! age of snow at surface
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: solsw      ! net shortwave radiation at surface 
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: sollw      ! net longwave radiation at surface
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: d_ts       ! change in temperature at surface
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)       :: evap     ! evaporation at surface
+    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: evap     ! evaporation at surface
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: fluxlat    ! latent flux
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: t2m        ! temperature at 2 meter height
@@ -856 +858 @@
        ! Initialize ok_flux_surf (for 1D model)
        if (klon_glo>1) ok_flux_surf=.FALSE.
+       if (klon_glo>1) ok_forc_tsurf=.FALSE.
 
        ! intialize beta_land
@@ -958 +961 @@
 !!    tke(:,:,is_ave)=0.
     tke_x(:,:,is_ave)=0.
+
     wake_dltke(:,:,is_ave)=0.
 !>jyg
@@ -977 +981 @@
     yqsurf = 0.0  ; yalb = 0.0 ; yalb_vis = 0.0
 !albedo SB <<<
-    yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0    
+    yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0
     ysollw = 0.0  ; yz0m = 0.0 ; yz0h = 0.0    ; yu1 = 0.0    
     yv1 = 0.0     ; ypaprs = 0.0     ; ypplay = 0.0
@@ -988 +992 @@
 !!    d_t_diss= 0.0 ;d_u = 0.0     ; d_v = 0.0 
     yqsol = 0.0    
-    ytherm = 0.0  ; ytke=0.
+
+    ytke=0.
 !FC 
     y_treedrg=0.
@@ -1195 +1200 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+!--OB this line is not satisfactory because alb is the direct albedo not total albedo
           solsw(i,nsrf) = solsw_m(i) * (1.-alb(i,nsrf)) / (1.-alb_m(i))
        ENDDO
@@ -1217 +1223 @@
 !>al1
 
+!--OB add diffuse fraction of SW down
+   DO n=1,nbcf_out
+       IF (cfname_out(n) == "swdownfdiff" ) fields_out(:,n) = solswfdiff_m(:)
+   ENDDO
 ! >> PC
    IF (carbon_cycle_cpl .AND. carbon_cycle_tr .AND. nbcf_out.GT.0 ) THEN
@@ -1393 +1403 @@
              ytke_w(j,k)      = tke_x(i,k,nsrf)+wake_dltke(i,k,nsrf)
              ywake_dltke(j,k) = wake_dltke(i,k,nsrf)
+            
 !>jyg
           ENDDO
@@ -1477 +1488 @@
       ENDDO
      ENDIF
+
         IF (prt_level >=10) print *,'clcdrag -> ycdragh ', ycdragh
        ELSE  !(iflag_split .eq.0)
@@ -1560 +1572 @@
       print *,' args coef_diff_turb: ycdragh ', ycdragh
       print *,' args coef_diff_turb: ytke ', ytke
+
        ENDIF
         CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
@@ -1589 +1602 @@
       print *,' args coef_diff_turb: ycdragh_x ', ycdragh_x
       print *,' args coef_diff_turb: ytke_x ', ytke_x
+
        ENDIF
         CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
@@ -2037 +2051 @@
 !
 !****************************************************************************************
-
-!!!
-!!! jyg le 10/04/2013
+!!
+!!!
+!!! jyg le 10/04/2013 et EV 10/2020
+
+        IF (ok_forc_tsurf) THEN
+            DO j=1,knon
+                ytsurf_new(j)=tg
+                y_d_ts(j) = ytsurf_new(j) - yts(j) 
+            ENDDO
+        ENDIF ! ok_forc_tsurf
+
 !!!
         IF (ok_flux_surf) THEN
@@ -2468 +2490 @@
               tke_x(i,k,nsrf)    = ytke(j,k)
               tke_x(i,k,is_ave) = tke_x(i,k,is_ave) + ytke(j,k)*ypct(j)
+
 !>jyg
            ENDDO
@@ -2481 +2504 @@
 !!            tke(i,k,is_ave) = tke(i,k,is_ave) + tke(i,k,nsrf)*ypct(j)
             tke_x(i,k,nsrf)   = ytke_x(j,k)
-            tke_x(i,k,is_ave)   = tke_x(i,k,is_ave) + tke_x(i,k,nsrf)*ypct(j)
+            tke_x(i,k,is_ave)   = tke_x(i,k,is_ave) + tke_x(i,k,nsrf)*ypct(j)        
             wake_dltke(i,k,is_ave)   = wake_dltke(i,k,is_ave) + wake_dltke(i,k,nsrf)*ypct(j)
+            
 
 !>jyg