Changeset 4669 for LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd

Timestamp:

Sep 4, 2023, 10:17:16 AM (17 months ago)

Author:

Laurent Fairhead

Message:

Merged with trunk revision 4586 corresponding to june 2023 testing

Location:

LMDZ6/branches/LMDZ_cdrag_LSCE

Files:

• . (modified) (1 prop)
• libf/phylmd/add_phys_tend_mod.F90 (modified) (37 diffs)
• libf/phylmd/atke_turbulence_ini_mod.F90 (modified) (2 diffs)
• libf/phylmd/blowing_snow_ini_mod.F90 (copied) (copied from LMDZ6/trunk/libf/phylmd/blowing_snow_ini_mod.F90)
• libf/phylmd/blowing_snow_sublim_sedim.F90 (copied) (copied from LMDZ6/trunk/libf/phylmd/blowing_snow_sublim_sedim.F90)
• libf/phylmd/calcratqs.F90 (modified) (4 diffs)
• libf/phylmd/calcul_divers.h (modified) (1 diff)
• libf/phylmd/call_atke_mod.F90 (copied) (copied from LMDZ6/trunk/libf/phylmd/call_atke_mod.F90)
• libf/phylmd/call_blowing_snow_sublim_sedim.F90 (copied) (copied from LMDZ6/trunk/libf/phylmd/call_blowing_snow_sublim_sedim.F90)
• libf/phylmd/clesphys.h (modified) (3 diffs)
• libf/phylmd/climb_qbs_mod.F90 (copied) (copied from LMDZ6/trunk/libf/phylmd/climb_qbs_mod.F90)
• libf/phylmd/cloudth_mod.F90 (modified) (14 diffs)
• libf/phylmd/conf_phys_m.F90 (modified) (19 diffs)
• libf/phylmd/dyn1d/mod_1D_cases_read2.F90 (modified) (5 diffs)
• libf/phylmd/dyn1d/old_lmdz1d.F90 (modified) (4 diffs)
• libf/phylmd/dyn1d/scm.F90 (modified) (3 diffs)
• libf/phylmd/ecrad/radiation_aerosol_optics.F90 (modified) (2 diffs)
• libf/phylmd/ecrad/radiation_cloud_generator.F90 (modified) (1 diff)
• libf/phylmd/ecrad/radiation_scheme.F90 (modified) (9 diffs)
• libf/phylmd/ecrad/setup_aerosol_optics_lmdz_m.F90 (modified) (4 diffs)
• libf/phylmd/ecrad/setup_config_from_lmdz.F90 (copied) (copied from LMDZ6/trunk/libf/phylmd/ecrad/setup_config_from_lmdz.F90)
• libf/phylmd/fisrtilp.F90 (modified) (3 diffs)
• libf/phylmd/fisrtilp.h (deleted)
• libf/phylmd/fonte_neige_mod.F90 (modified) (1 diff)
• libf/phylmd/ice_sursat_mod.F90 (modified) (1 diff)
• libf/phylmd/icefrac_lsc_mod.F90 (modified) (1 diff)
• libf/phylmd/infotrac_phy.F90 (modified) (2 diffs)
• libf/phylmd/ini_COSP.F90 (copied) (copied from LMDZ6/trunk/libf/phylmd/ini_COSP.F90)
• libf/phylmd/ini_COSP.h (copied) (copied from LMDZ6/trunk/libf/phylmd/ini_COSP.h)
• libf/phylmd/lscp_ini_mod.F90 (modified) (5 diffs)
• libf/phylmd/lscp_mod.F90 (modified) (33 diffs)
• libf/phylmd/lscp_tools_mod.F90 (modified) (10 diffs)
• libf/phylmd/newmicro.F90 (modified) (5 diffs)
• libf/phylmd/nuage.F90 (modified) (3 diffs)
• libf/phylmd/nuage.h (modified) (1 diff)
• libf/phylmd/ocean_forced_mod.F90 (modified) (1 diff)
• libf/phylmd/output_physiqex_mod.F90 (copied) (copied from LMDZ6/trunk/libf/phylmd/output_physiqex_mod.F90)
• libf/phylmd/pbl_surface_mod.F90 (modified) (56 diffs)
• libf/phylmd/phyaqua_mod.F90 (modified) (2 diffs)
• libf/phylmd/phyetat0_mod.F90 (modified) (7 diffs)
• libf/phylmd/phyredem.F90 (modified) (3 diffs)
• libf/phylmd/phys_local_var_mod.F90 (modified) (26 diffs, 1 prop)
• libf/phylmd/phys_output_ctrlout_mod.F90 (modified) (9 diffs)
• libf/phylmd/phys_output_var_mod.F90 (modified) (4 diffs)
• libf/phylmd/phys_output_write_mod.F90 (modified) (29 diffs)
• libf/phylmd/phys_state_var_mod.F90 (modified) (8 diffs)
• libf/phylmd/physiq_mod.F90 (modified) (64 diffs)
• libf/phylmd/physiqex_mod.F90 (copied) (copied from LMDZ6/trunk/libf/phylmd/physiqex_mod.F90)
• libf/phylmd/surf_land_mod.F90 (modified) (9 diffs)
• libf/phylmd/surf_land_orchidee_mod.F90 (modified) (1 diff)
• libf/phylmd/surf_landice_mod.F90 (modified) (13 diffs)
• libf/phylmd/surf_ocean_mod.F90 (modified) (8 diffs)

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/add_phys_tend_mod.F90

@@ -16 +16 @@
 CONTAINS
 
-SUBROUTINE add_pbl_tend(zdu, zdv, zdt, zdq, zdql, zdqi, paprs, text,abortphy,flag_inhib_tend, itap)
+SUBROUTINE add_pbl_tend(zdu, zdv, zdt, zdq, zdql, zdqi, zdqbs, paprs, text,abortphy,flag_inhib_tend, itap)
   ! ======================================================================
   ! Ajoute les tendances de couche limite, soit determinees par la
@@ -49 +49 @@
   ! ------------
   REAL zdu(klon, klev), zdv(klon, klev)
-  REAL zdt(klon, klev), zdq(klon, klev), zdql(klon, klev), zdqi(klon, klev)
+  REAL zdt(klon, klev), zdq(klon, klev), zdql(klon, klev), zdqi(klon, klev), zdqbs(klon,klev)
   CHARACTER *(*) text
   REAL paprs(klon,klev+1)
@@ -76 +76 @@
     PRINT *, ' add_pbl_tend, zzdt ', zzdt
     PRINT *, ' add_pbl_tend, zzdq ', zzdq
-    CALL add_phys_tend(zdu, zdv, zzdt, zzdq, zdql, zdqi, paprs, text,abortphy,flag_inhib_tend, itap, 0)
+    CALL add_phys_tend(zdu, zdv, zzdt, zzdq, zdql, zdqi, zdqbs, paprs, text,abortphy,flag_inhib_tend, itap, 0)
   ELSE
-    CALL add_phys_tend(zdu, zdv, zdt, zdq, zdql, zdqi, paprs, text,abortphy,flag_inhib_tend, itap, 0)
+    CALL add_phys_tend(zdu, zdv, zdt, zdq, zdql, zdqi, zdqbs, paprs, text,abortphy,flag_inhib_tend, itap, 0)
   END IF
 
@@ -87 +87 @@
 ! $Id: add_phys_tend.F90 2611 2016-08-03 15:41:26Z jyg $
 !
-SUBROUTINE add_phys_tend (zdu,zdv,zdt,zdq,zdql,zdqi,paprs,text, &
+SUBROUTINE add_phys_tend (zdu,zdv,zdt,zdq,zdql,zdqi,zdqbs,paprs,text, &
                           abortphy,flag_inhib_tend, itap, diag_mode)
 !======================================================================
@@ -102 +102 @@
 USE dimphy, ONLY: klon, klev
 USE phys_state_var_mod, ONLY : phys_tstep
-USE phys_local_var_mod, ONLY: u_seri, v_seri, ql_seri, qs_seri, q_seri, t_seri
+USE phys_local_var_mod, ONLY: u_seri, v_seri, ql_seri, qs_seri, qbs_seri, q_seri, t_seri
 USE phys_state_var_mod, ONLY: ftsol
 USE geometry_mod, ONLY: longitude_deg, latitude_deg
 USE print_control_mod, ONLY: prt_level
 USE cmp_seri_mod
-USE phys_output_var_mod, ONLY : d_qw_col, d_ql_col, d_qs_col, d_qt_col, d_ek_col, d_h_dair_col &
-  &           , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_col
+USE phys_output_var_mod, ONLY : d_qw_col, d_ql_col, d_qs_col, d_qbs_col, d_qt_col, d_ek_col, d_h_dair_col &
+  &           , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_qbs_col, d_h_col
 IMPLICIT none
   include "YOMCST.h"
@@ -116 +116 @@
 !------------
 REAL, DIMENSION(klon,klev),     INTENT(IN)    :: zdu, zdv
-REAL, DIMENSION(klon,klev),     INTENT(IN)    :: zdt, zdql, zdqi
+REAL, DIMENSION(klon,klev),     INTENT(IN)    :: zdt, zdql, zdqi, zdqbs
 REAL, DIMENSION(klon,klev+1),   INTENT(IN)    :: paprs
 CHARACTER*(*),                  INTENT(IN)    :: text
@@ -136 +136 @@
 ! Save variables, used in diagnostic mode (diag_mode=1).
 REAL, DIMENSION(klon,klev)   :: sav_u_seri, sav_v_seri
-REAL, DIMENSION(klon,klev)   :: sav_ql_seri, sav_qs_seri, sav_q_seri
+REAL, DIMENSION(klon,klev)   :: sav_ql_seri, sav_qs_seri, sav_qbs_seri, sav_q_seri
 REAL, DIMENSION(klon,klev)   :: sav_t_seri
 REAL, DIMENSION(klon,klev)   :: sav_zdq
@@ -163 +163 @@
 ! zh_ql_col----  total enthalpy of liquid watter (J/m2)
 ! zh_qs_col----  total enthalpy of solid watter  (J/m2)
+! zh_qbs_col----  total enthalpy of blowing snow  (J/m2)
 ! zqw_col------  total mass of watter vapour (kg/m2)
 ! zql_col------  total mass of liquid watter (kg/m2)
-! zqs_col------  total mass of solid watter (kg/m2)
+! zqs_col------  total mass of cloud ice (kg/m2)
+! zqbs_col------  total mass of blowing snow (kg/m2)
 ! zek_col------  total kinetic energy (kg/m2)
 !
@@ -172 +174 @@
 REAL zql_col(klon,2)
 REAL zqs_col(klon,2)
+REAL zqbs_col(klon,2)
 REAL zek_col(klon,2)
 REAL zh_dair_col(klon,2)
-REAL zh_qw_col(klon,2), zh_ql_col(klon,2), zh_qs_col(klon,2)
+REAL zh_qw_col(klon,2), zh_ql_col(klon,2), zh_qs_col(klon,2), zh_qbs_col(klon,2)
 REAL zh_col(klon,2)
 
@@ -213 +216 @@
     sav_ql_seri(:,:) = ql_seri(:,:)
     sav_qs_seri(:,:) = qs_seri(:,:)
+    sav_qbs_seri(:,:) = qbs_seri(:,:)
     sav_q_seri(:,:)  = q_seri(:,:)
     sav_t_seri(:,:)  = t_seri(:,:)
@@ -236 +240 @@
 
     CALL integr_v(klon, klev, zcpvap, &
-                  t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, zairm, &
-                    zqw_col(:,n), zql_col(:,n), zqs_col(:,n), zek_col(:,n), zh_dair_col(:,n), &
-                    zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_col(:,n))
+                  t_seri, q_seri, ql_seri, qs_seri, qbs_seri, u_seri, v_seri, zairm, &
+                    zqw_col(:,n), zql_col(:,n), zqs_col(:,n), zqbs_col(:,n), zek_col(:,n), zh_dair_col(:,n), &
+                    zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_qbs_col(:,n), zh_col(:,n))
 
   end if ! end if (fl_ebil .GT. 0)
@@ -250 +254 @@
      ql_seri(:,:)=ql_seri(:,:)+zdql(:,:)
      qs_seri(:,:)=qs_seri(:,:)+zdqi(:,:)
+     qbs_seri(:,:)=qbs_seri(:,:)+zdqbs(:,:)
 
 !======================================================================
@@ -432 +437 @@
         ql_seri(:,:)=ql_seri(:,:)-zdql(:,:)
         qs_seri(:,:)=qs_seri(:,:)-zdqi(:,:)
+        qbs_seri(:,:)=qbs_seri(:,:)-zdqbs(:,:)
       ENDIF
 
@@ -446 +452 @@
 
     CALL integr_v(klon, klev, zcpvap, &
-                  t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, zairm, &
-                    zqw_col(:,n), zql_col(:,n), zqs_col(:,n), zek_col(:,n), zh_dair_col(:,n), &
-                    zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_col(:,n))
+                  t_seri, q_seri, ql_seri, qs_seri, qbs_seri, u_seri, v_seri, zairm, &
+                    zqw_col(:,n), zql_col(:,n), zqs_col(:,n), zqbs_col(:,n), zek_col(:,n), zh_dair_col(:,n), &
+                    zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_qbs_col(:,n), zh_col(:,n))
 
     ! ------------------------------------------------
@@ -457 +463 @@
     d_ql_col(:) = (zql_col(:,2)-zql_col(:,1))/phys_tstep
     d_qs_col(:) = (zqs_col(:,2)-zqs_col(:,1))/phys_tstep
-    d_qt_col(:) = d_qw_col(:) + d_ql_col(:) + d_qs_col(:)
+    d_qbs_col(:) = (zqbs_col(:,2)-zqbs_col(:,1))/phys_tstep
+    d_qt_col(:) = d_qw_col(:) + d_ql_col(:) + d_qs_col(:) + d_qbs_col(:)
 
     d_ek_col(:) = (zek_col(:,2)-zek_col(:,1))/phys_tstep
@@ -465 +472 @@
     d_h_ql_col(:) = (zh_ql_col(:,2)-zh_ql_col(:,1))/phys_tstep
     d_h_qs_col(:) = (zh_qs_col(:,2)-zh_qs_col(:,1))/phys_tstep
+    d_h_qbs_col(:) = (zh_qbs_col(:,2)-zh_qbs_col(:,1))/phys_tstep
 
     d_h_col = (zh_col(:,2)-zh_col(:,1))/phys_tstep 
@@ -476 +484 @@
     ql_seri(:,:) = sav_ql_seri(:,:)
     qs_seri(:,:) = sav_qs_seri(:,:)
+    qbs_seri(:,:) = sav_qbs_seri(:,:)
     q_seri(:,:)  = sav_q_seri(:,:)
     t_seri(:,:)  = sav_t_seri(:,:)
@@ -484 +493 @@
 END SUBROUTINE add_phys_tend
 
-SUBROUTINE diag_phys_tend (nlon, nlev, uu, vv, temp, qv, ql, qs, &
-                          zdu,zdv,zdt,zdq,zdql,zdqs,paprs,text)
+SUBROUTINE diag_phys_tend (nlon, nlev, uu, vv, temp, qv, ql, qs, qbs, &
+                          zdu,zdv,zdt,zdq,zdql,zdqs,zdqbs,paprs,text)
 !======================================================================
 ! Ajoute les tendances des variables physiques aux variables 
@@ -501 +510 @@
 USE print_control_mod, ONLY: prt_level
 USE cmp_seri_mod
-USE phys_output_var_mod, ONLY : d_qw_col, d_ql_col, d_qs_col, d_qt_col, d_ek_col, d_h_dair_col &
-  &           , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_col
+USE phys_output_var_mod, ONLY : d_qw_col, d_ql_col, d_qs_col, d_qbs_col, d_qt_col, d_ek_col, d_h_dair_col &
+  &           , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_qbs_col, d_h_col
 IMPLICIT none
   include "YOMCST.h"
@@ -511 +520 @@
 INTEGER, INTENT(IN)                           :: nlon, nlev
 REAL, DIMENSION(nlon,nlev),     INTENT(IN)    :: uu, vv
-REAL, DIMENSION(nlon,nlev),     INTENT(IN)    :: temp, qv, ql, qs
+REAL, DIMENSION(nlon,nlev),     INTENT(IN)    :: temp, qv, ql, qs, qbs
 REAL, DIMENSION(nlon,nlev),     INTENT(IN)    :: zdu, zdv
-REAL, DIMENSION(nlon,nlev),     INTENT(IN)    :: zdt, zdq, zdql, zdqs
+REAL, DIMENSION(nlon,nlev),     INTENT(IN)    :: zdt, zdq, zdql, zdqs, zdqbs
 REAL, DIMENSION(nlon,nlev+1),   INTENT(IN)    :: paprs
 CHARACTER*(*),                  INTENT(IN)    :: text
@@ -520 +529 @@
 !--------
 REAL, DIMENSION(nlon,nlev)      :: uu_n, vv_n
-REAL, DIMENSION(nlon,nlev)      :: temp_n, qv_n, ql_n, qs_n
+REAL, DIMENSION(nlon,nlev)      :: temp_n, qv_n, ql_n, qs_n, qbs_n
 
 
@@ -543 +552 @@
 ! zqw_col------  total mass of watter vapour (kg/m2)
 ! zql_col------  total mass of liquid watter (kg/m2)
-! zqs_col------  total mass of solid watter (kg/m2)
+! zqs_col------  total mass of cloud ice (kg/m2)
+! zqbs_col------  total mass of blowing snow (kg/m2)
 ! zek_col------  total kinetic energy (kg/m2)
 !
@@ -550 +560 @@
 REAL zql_col(nlon,2)
 REAL zqs_col(nlon,2)
+REAL zqbs_col(nlon,2)
 REAL zek_col(nlon,2)
 REAL zh_dair_col(nlon,2)
-REAL zh_qw_col(nlon,2), zh_ql_col(nlon,2), zh_qs_col(nlon,2)
+REAL zh_qw_col(nlon,2), zh_ql_col(nlon,2), zh_qs_col(nlon,2), zh_qbs_col(nlon,2)
 REAL zh_col(nlon,2)
 
@@ -585 +596 @@
 
     CALL integr_v(nlon, nlev, rcpv, &
-                  temp, qv, ql, qs, uu, vv, zairm, &
-                    zqw_col(:,n), zql_col(:,n), zqs_col(:,n), zek_col(:,n), zh_dair_col(:,n), &
-                    zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_col(:,n))
+                  temp, qv, ql, qs, qbs, uu, vv, zairm, &
+                    zqw_col(:,n), zql_col(:,n), zqs_col(:,n), zqbs_col(:,n), zek_col(:,n), zh_dair_col(:,n), &
+                    zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_qbs_col(:,n), zh_col(:,n))
 
   end if ! end if (fl_ebil .GT. 0)
@@ -600 +611 @@
      ql_n(:,:)=ql(:,:)+zdql(:,:)
      qs_n(:,:)=qs(:,:)+zdqs(:,:)
+     qbs_n(:,:)=qbs(:,:)+zdqbs(:,:)
      temp_n(:,:)=temp(:,:)+zdt(:,:)
 
@@ -616 +628 @@
 
     CALL integr_v(nlon, nlev, rcpv, &
-                  temp_n, qv_n, ql_n, qs_n, uu_n, vv_n, zairm, &
-                    zqw_col(:,n), zql_col(:,n), zqs_col(:,n), zek_col(:,n), zh_dair_col(:,n), &
-                    zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_col(:,n))
+                  temp_n, qv_n, ql_n, qs_n, qbs_n, uu_n, vv_n, zairm, &
+                    zqw_col(:,n), zql_col(:,n), zqs_col(:,n), zqbs_col(:,n), zek_col(:,n), zh_dair_col(:,n), &
+                    zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_qbs_col(:,n), zh_col(:,n))
 
     ! ------------------------------------------------
@@ -627 +639 @@
     d_ql_col(:) = (zql_col(:,2)-zql_col(:,1))/phys_tstep
     d_qs_col(:) = (zqs_col(:,2)-zqs_col(:,1))/phys_tstep
-    d_qt_col(:) = d_qw_col(:) + d_ql_col(:) + d_qs_col(:)
+    d_qbs_col(:) = (zqbs_col(:,2)-zqbs_col(:,1))/phys_tstep
+    d_qt_col(:) = d_qw_col(:) + d_ql_col(:) + d_qs_col(:) + d_qbs_col(:)
 
     d_ek_col(:) = (zek_col(:,2)-zek_col(:,1))/phys_tstep
@@ -639 +652 @@
     d_h_ql_col(:) = (zh_ql_col(:,2)-zh_ql_col(:,1))/phys_tstep
     d_h_qs_col(:) = (zh_qs_col(:,2)-zh_qs_col(:,1))/phys_tstep
+    d_h_qbs_col(:) = (zh_qbs_col(:,2)-zh_qbs_col(:,1))/phys_tstep
 
     d_h_col = (zh_col(:,2)-zh_col(:,1))/phys_tstep 
@@ -649 +663 @@
 
 SUBROUTINE integr_v(nlon, nlev, zcpvap, &
-                    temp, qv, ql, qs, uu, vv, zairm,  &
-                    zqw_col, zql_col, zqs_col, zek_col, zh_dair_col, &
-                    zh_qw_col, zh_ql_col, zh_qs_col, zh_col)
+                    temp, qv, ql, qs, qbs, uu, vv, zairm,  &
+                    zqw_col, zql_col, zqs_col, zqbs_col, zek_col, zh_dair_col, &
+                    zh_qw_col, zh_ql_col, zh_qs_col, zh_qbs_col, zh_col)
 
 IMPLICIT none
@@ -658 +672 @@
 INTEGER,                    INTENT(IN)    :: nlon,nlev
 REAL,                       INTENT(IN)    :: zcpvap
-REAL, DIMENSION(nlon,nlev), INTENT(IN)    :: temp, qv, ql, qs, uu, vv
+REAL, DIMENSION(nlon,nlev), INTENT(IN)    :: temp, qv, ql, qs, qbs, uu, vv
 REAL, DIMENSION(nlon,nlev), INTENT(IN)    :: zairm
 REAL, DIMENSION(nlon),      INTENT(OUT)   :: zqw_col
 REAL, DIMENSION(nlon),      INTENT(OUT)   :: zql_col
-REAL, DIMENSION(nlon),      INTENT(OUT)   :: zqs_col
+REAL, DIMENSION(nlon),      INTENT(OUT)   :: zqs_col, zqbs_col
 REAL, DIMENSION(nlon),      INTENT(OUT)   :: zek_col
 REAL, DIMENSION(nlon),      INTENT(OUT)   :: zh_dair_col
 REAL, DIMENSION(nlon),      INTENT(OUT)   :: zh_qw_col
 REAL, DIMENSION(nlon),      INTENT(OUT)   :: zh_ql_col
-REAL, DIMENSION(nlon),      INTENT(OUT)   :: zh_qs_col
+REAL, DIMENSION(nlon),      INTENT(OUT)   :: zh_qs_col, zh_qbs_col
 REAL, DIMENSION(nlon),      INTENT(OUT)   :: zh_col
 
@@ -677 +691 @@
     zql_col(:) = 0.
     zqs_col(:) = 0.
+    zqbs_col(:) = 0.
     zek_col(:) = 0.
     zh_dair_col(:) = 0.
@@ -682 +697 @@
     zh_ql_col(:) = 0.
     zh_qs_col(:) = 0.
+    zh_qbs_col(:) = 0.
 
 !JLD    write (*,*) "rcpd, zcpvap, zcwat, zcice ",rcpd, zcpvap, zcwat, zcice
@@ -694 +710 @@
         zql_col(i) = zql_col(i) + ql(i, k)*zairm(i, k)
         zqs_col(i) = zqs_col(i) + qs(i, k)*zairm(i, k)
+        zqbs_col(i)= zqbs_col(i) + qbs(i,k)*zairm(i,k)
         ! Kinetic Energy
         zek_col(i) = zek_col(i) + 0.5*(uu(i,k)**2+vv(i,k)**2)*zairm(i, k)
@@ -702 +719 @@
         zh_ql_col(i) = zh_ql_col(i) + (zcpvap*temp(i, k) - rlvtt)*ql(i, k)*zairm(i, k)   !jyg
         zh_qs_col(i) = zh_qs_col(i) + (zcpvap*temp(i, k) - rlstt)*qs(i, k)*zairm(i, k)   !jyg
+        zh_qbs_col(i) = zh_qbs_col(i) + (zcpvap*temp(i, k) - rlstt)*qbs(i, k)*zairm(i, k)   !jyg
       END DO
     END DO
     ! compute total air enthalpy
-    zh_col(:) = zh_dair_col(:) + zh_qw_col(:) + zh_ql_col(:) + zh_qs_col(:)
+    zh_col(:) = zh_dair_col(:) + zh_qw_col(:) + zh_ql_col(:) + zh_qs_col(:) + zh_qbs_col(:)
 
 END SUBROUTINE integr_v
@@ -720 +738 @@
 USE dimphy, ONLY: klon, klev
 USE phys_state_var_mod, ONLY : phys_tstep
-USE phys_state_var_mod, ONLY : topsw, toplw, solsw, sollw, rain_con, snow_con
+USE phys_state_var_mod, ONLY : topsw, toplw, solsw, sollw, rain_con, snow_con, bs_fall
 USE geometry_mod, ONLY: longitude_deg, latitude_deg
 USE print_control_mod, ONLY: prt_level
 USE cmp_seri_mod
-USE phys_output_var_mod, ONLY : d_qw_col, d_ql_col, d_qs_col, d_qt_col, d_ek_col, d_h_dair_col &
-  &           , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_col
+USE phys_output_var_mod, ONLY : d_qw_col, d_ql_col, d_qs_col, d_qbs_col, d_qt_col, d_ek_col, d_h_dair_col &
+  &           , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_qbs_col, d_h_col
 USE phys_local_var_mod, ONLY: evap, sens
-USE phys_local_var_mod, ONLY: u_seri, v_seri, ql_seri, qs_seri, q_seri, t_seri &
+USE phys_local_var_mod, ONLY: u_seri, v_seri, ql_seri, qs_seri, qbs_seri, q_seri, t_seri &
    &  , rain_lsc, snow_lsc
 USE climb_hq_mod, ONLY : d_h_col_vdf, f_h_bnd
@@ -764 +782 @@
       bilh_bnd = (-(rcw-rcpd)*t_seri(1,1) + rlvtt) * rain_lsc(1) &
     &         + (-(rcs-rcpd)*t_seri(1,1) + rlstt) * snow_lsc(1)
+  CASE("bs") param
+      bilq_bnd = - bs_fall(1)
+      bilh_bnd = (-(rcs-rcpd)*t_seri(1,1) + rlstt) * bs_fall(1)
   CASE("convection") param
       bilq_bnd = - rain_con(1) - snow_con(1)
@@ -800 +821 @@
   if ( prt_level .GE. 5) then
     write(*,9000) text,"enerbil at boundaries: Q, H",bilq_bnd, bilh_bnd
-    write(*,9000) text,"enerbil: water budget",d_qt_col(1),d_qw_col(1),d_ql_col(1),d_qs_col(1)
-    write(*,9000) text,"enerbil: enthalpy budget",d_h_col(1),d_h_dair_col(1),d_h_qw_col(1),d_h_ql_col(1),d_h_qs_col(1)
+    write(*,9000) text,"enerbil: water budget",d_qt_col(1),d_qw_col(1),d_ql_col(1),d_qs_col(1), d_qbs_col(1)
+    write(*,9000) text,"enerbil: enthalpy budget",d_h_col(1),d_h_dair_col(1),d_h_qw_col(1),d_h_ql_col(1),d_h_qs_col(1),d_h_qbs_col(1)
   end if
 

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/atke_turbulence_ini_mod.F90

@@ -5 +5 @@
 save
 
-  integer :: iflag_atke
-  !$OMP THREADPRIVATE(iflag_atke)
+integer :: iflag_atke, iflag_num_atke
+!$OMP THREADPRIVATE(iflag_atke, iflag_num_atke)
   real :: kappa = 0.4 ! Von Karman constant
   !$OMP THREADPRIVATE(kappa)
@@ -45 +45 @@
   CALL getin_p('iflag_atke',iflag_atke)
 
+  ! flag that controls the numerical treatment of diffusion coeffiient calculation
+  iflag_num_atke=0
+  CALL getin_p('iflag_num_atke',iflag_num_atke)
+
   ! asymptotic mixing length [m]
   l0=150.0 

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/calcratqs.F90

@@ -7 +7 @@
            qtc_cv, sigt_cv, zqsat,             &
            tke,tke_dissip,lmix,wprime, &
-           t2m,q2m,fm_therm, &
+           t2m,q2m,fm_therm,cell_area,&
            ratqs,ratqsc,ratqs_inter)
 
@@ -37 +37 @@
 real, dimension(klon,klev),intent(in) :: wake_deltaq,wake_s
 real, dimension(klon,nbsrf),intent(in) :: t2m,q2m
+real, dimension(klon), intent(in) :: cell_area
 ! Output
 real, dimension(klon,klev),intent(inout) :: ratqs,ratqsc,ratqs_inter
@@ -47 +48 @@
 real facteur,zfratqs1,zfratqs2
 real, dimension(klon,klev) :: ratqs_hetero,ratqs_oro,ratqs_tke
-
+real resol,resolmax,fact
 
 !-------------------------------------------------------------------------
@@ -142 +143 @@
            *( tanh( (ratqsp0-pplay(:,k))/ratqsdp) + 1.)
          enddo
+
+
+      else if (iflag_ratqs==5) then
+! Dependency of ratqs on model resolution
+! Audran, Meryl, Lea, Gwendal and Etienne
+! April 2023 
+        resolmax=sqrt(maxval(cell_area))
+         do k=1,klev
+            do i=1,klon
+              resol=sqrt(cell_area(i))
+              fact=sqrt(resol/resolmax)
+              ratqss(i,k)=ratqsbas*fact+0.5*(ratqshaut-ratqsbas)*fact &
+              *( tanh( (ratqsp0-pplay(i,k))/ratqsdp) + 1.)
+           enddo
+         enddo
+
 
        else if (iflag_ratqs .GT. 9) then

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/calcul_divers.h

@@ -2 +2 @@
 ! $Id$
 !
+! itap : nombre de pas de temps de la physique
+! itapm1 : somme du nombre de pas de temps du/des mois precedent/s.
+! (itap - itapm1) : nombre de pas de temps du mois courant
 !
-! Initialisations diverses au tout debut
+! Ne pas modifier les IFs ci-dessous impliquant itapm1,
+! autrement les resultats seront faux !!
+!
+! Ici on utilise MOD(itap - itapm1,NINT(mth_len*un_jour/phys_tstep)).EQ.1)
+! pour detecter le debut de chaque mois lorsque  l on tourne par an.
+!
+! IM, 26.05.2023
+!
+!
+! Initialisations itapm1 du premier mois
       IF(itap.EQ.1) THEN
          itapm1=0
+!        print*,'initialisation itap=1 itapm1 ',itapm1
       ENDIF
 
+!
 ! Initialisation debut de mois
       IF(itap.EQ.itapm1+1) THEN
+         ndayrain_mth(:)=0.
+!        print*,'Initialisation ndayrain_mth ',itap
+      ENDIF
+!
+! Initialisation debut de chaque jour
+      IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.1) THEN
         nday_rain(:)=0.
 !       print*,'initialisation mois suivants day_rain itap',itap
       ENDIF
-
-! Calcul fin de journee : total_rain, nday_rain
-      IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.0) THEN
-!        print*,'calcul nday_rain itap ',itap
+!
+! Calcul a chaque pas de temps de la physique
          DO i = 1, klon
             total_rain(i)=rain_fall(i)+snow_fall(i)  
-            IF(total_rain(i).GT.0.) nday_rain(i)=nday_rain(i)+1.
+            IF(total_rain(i).GT.0.) nday_rain(i)=1.
+         ENDDO
+!
+! Cumul en fin de journee
+      IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.0) THEN
+         DO i = 1, klon
+            ndayrain_mth(i)=ndayrain_mth(i)+nday_rain(i)
          ENDDO
       ENDIF
-
+!
 ! Initialisation fin de mois
+! Ne pas changer le IF ci-dessous, car le compteur itapm1 est augmente
+! apres, dans la boucle !!!
+! IM, 260523
       IF(MOD(itap-itapm1,NINT(mth_len*un_jour/phys_tstep)).EQ.0) THEN
         itapm1=itapm1+NINT(mth_len*un_jour/phys_tstep)
-!       print*,'initialisation itapm1 ',itapm1
+!       print*,'fmois i i1 mjt',itap,itapm1,mth_len,un_jour,phys_tstep
       ENDIF
 !
 ! calcul temperatures minimale et maximale moyennees sur le mois 
 !
-!initialisation debut de mois ou de journee pour les fichiers mensuels
+!initialisation debut de mois pour les fichiers mensuels annuels
   IF(itap.EQ.itapm1+1) THEN
      t2m_min_mon=0.
      t2m_max_mon=0.
   ENDIF
+!
+!initialisation debut de journee pour les fichiers mensuels annuels
   IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.1) THEN
      zt2m_min_mon=zt2m
      zt2m_max_mon=zt2m
   ENDIF
-!calcul a chaque pas de temps pour les fichiers mensuels
+!
+!calcul sur tous les pas de temps pour les fichiers mensuels annuels
      DO i = 1, klon
         zt2m_min_mon(i)=MIN(zt2m(i),zt2m_min_mon(i))
         zt2m_max_mon(i)=MAX(zt2m(i),zt2m_max_mon(i))
      ENDDO
-!fin de journee
+!
+!fin journee
   IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.0) THEN
    t2m_min_mon=t2m_min_mon+zt2m_min_mon 
    t2m_max_mon=t2m_max_mon+zt2m_max_mon 
   ENDIF
+!
 !fin mois
   IF(itap==itapm1) THEN

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/clesphys.h

@@ -18 +18 @@
        REAL co2_ppm, co2_ppm0, solaire
        INTEGER iflag_thermals,nsplit_thermals
+       INTEGER iflag_physiq
        REAL tau_thermals
 
@@ -102 +103 @@
        LOGICAL :: ok_daily_climoz
        LOGICAL :: ok_new_lscp
+       LOGICAL :: ok_bs, ok_rad_bs
 ! flag to bypass or not the phytrac module
        INTEGER :: iflag_phytrac
@@ -154 +156 @@
      &     , ok_chlorophyll,ok_conserv_q, adjust_tropopause             &
      &     , ok_daily_climoz, ok_all_xml, ok_lwoff                      &
-     &     , iflag_phytrac, ok_new_lscp                                 &
-     &     ,  iflag_thermals,nsplit_thermals, tau_thermals    
+     &     , iflag_phytrac, ok_new_lscp, ok_bs, ok_rad_bs               &
+     &     ,  iflag_thermals,nsplit_thermals, tau_thermals              &
+     &     , iflag_physiq
        save /clesphys/
 !$OMP THREADPRIVATE(/clesphys/)

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/cloudth_mod.F90

@@ -1 +1 @@
 MODULE cloudth_mod
+
 
   IMPLICIT NONE
@@ -10 +11 @@
      &           ratqs,zqs,t)
 
+
+      use lscp_ini_mod, only: iflag_cloudth_vert
 
       IMPLICIT NONE
@@ -24 +27 @@
 #include "YOETHF.h"
 #include "FCTTRE.h"
-#include "nuage.h"
 
       INTEGER itap,ind1,ind2
@@ -262 +264 @@
 
       USE ioipsl_getin_p_mod, ONLY : getin_p
+      use lscp_ini_mod, only: iflag_cloudth_vert
 
       IMPLICIT NONE
@@ -268 +271 @@
 #include "YOETHF.h"
 #include "FCTTRE.h"
-#include "nuage.h"
       
       INTEGER itap,ind1,ind2
@@ -593 +595 @@
      &           ratqs,zqs,t)
 
+      use lscp_ini_mod, only: iflag_cloudth_vert
 
       IMPLICIT NONE
@@ -607 +610 @@
 #include "YOETHF.h"
 #include "FCTTRE.h"
-#include "nuage.h"
 
       INTEGER itap,ind1,ind2
@@ -820 +822 @@
 !===========================================================================
 
-
+      use lscp_ini_mod, only: iflag_cloudth_vert
       USE ioipsl_getin_p_mod, ONLY : getin_p
       USE phys_output_var_mod, ONLY : cloudth_sth,cloudth_senv, &
@@ -830 +832 @@
 #include "YOETHF.h"
 #include "FCTTRE.h"
-#include "nuage.h"
       
       INTEGER itap,ind1,ind2
@@ -1283 +1284 @@
      &           ratqs,zqs,T)
 
-
+      use lscp_ini_mod, only: iflag_cloudth_vert
       USE ioipsl_getin_p_mod, ONLY : getin_p
       USE phys_output_var_mod, ONLY : cloudth_sth,cloudth_senv, &
@@ -1293 +1294 @@
 #include "YOETHF.h"
 #include "FCTTRE.h"
-#include "nuage.h"
 
 
@@ -1550 +1550 @@
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
-
+      use lscp_ini_mod, only: iflag_cloudth_vert
       USE ioipsl_getin_p_mod, ONLY : getin_p
       USE phys_output_var_mod, ONLY : cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
@@ -1561 +1561 @@
 #include "YOETHF.h"
 #include "FCTTRE.h"
-#include "nuage.h"
       
 
@@ -2321 +2320 @@
 
     INCLUDE "YOMCST.h"
-    INCLUDE "nuage.h"
 
     INTEGER, INTENT(IN) :: ind1,ind2, klev           ! horizontal and vertical indices and dimensions

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/conf_phys_m.F90

@@ -35 +35 @@
 
     INCLUDE "conema3.h"
-    INCLUDE "fisrtilp.h"
     INCLUDE "nuage.h"
     INCLUDE "YOMCST.h"
@@ -171 +170 @@
     LOGICAL,SAVE :: ok_adj_ema_omp
     INTEGER,SAVE :: iflag_clw_omp
-    REAL,SAVE :: cld_lc_lsc_omp,cld_lc_con_omp,cld_tau_lsc_omp,cld_tau_con_omp
-    REAL,SAVE :: ffallv_lsc_omp, ffallv_con_omp,coef_eva_omp,coef_eva_i_omp
-    LOGICAL,SAVE :: reevap_ice_omp
-    INTEGER,SAVE :: iflag_pdf_omp
     INTEGER,SAVE :: iflag_ice_thermo_omp
     LOGICAL,SAVE :: ok_ice_sursat_omp
     LOGICAL,SAVE :: ok_plane_h2o_omp, ok_plane_contrail_omp
-    INTEGER,SAVE :: iflag_t_glace_omp
-    INTEGER,SAVE :: iflag_cloudth_vert_omp
-    INTEGER,SAVE :: iflag_rain_incloud_vol_omp
-    INTEGER,SAVE :: iflag_vice_omp, iflag_rei_omp
+    INTEGER,SAVE :: iflag_rei_omp
     REAL,SAVE :: rad_froid_omp, rad_chau1_omp, rad_chau2_omp
-    REAL,SAVE :: t_glace_min_omp, t_glace_max_omp
-    REAL,SAVE :: exposant_glace_omp
-    INTEGER,SAVE :: iflag_gammasat_omp
     REAL,SAVE :: rei_min_omp, rei_max_omp
     INTEGER,SAVE :: iflag_sic_omp, iflag_inertie_omp
@@ -200 +189 @@
     REAL, SAVE ::  fmagic_omp, pmagic_omp
     INTEGER,SAVE :: iflag_pbl_omp,lev_histhf_omp,lev_histday_omp,lev_histmth_omp
-    INTEGER,SAVE :: iflag_pbl_split_omp
+    INTEGER,SAVE :: iflag_pbl_split_omp,iflag_physiq_omp
 !FC
     INTEGER,SAVE :: ifl_pbltree_omp
@@ -234 +223 @@
     INTEGER, SAVE :: iflag_ener_conserv_omp
     LOGICAL, SAVE :: ok_conserv_q_omp
-    INTEGER, SAVE :: iflag_fisrtilp_qsat_omp
-    INTEGER, SAVE :: iflag_bergeron_omp
     LOGICAL,SAVE  :: ok_strato_omp
     LOGICAL,SAVE  :: ok_hines_omp, ok_gwd_rando_omp
@@ -259 +246 @@
     INTEGER,SAVE  :: nit_bulk_omp
     INTEGER,SAVE  :: kz0_omp
+    LOGICAL, SAVE :: ok_bs_omp, ok_rad_bs_omp
 
 
@@ -1023 +1011 @@
     CALL getin('ok_conserv_q',ok_conserv_q_omp)
 
-    !Config  Key  = iflag_fisrtilp_qsat
-    !Config  Desc = Flag de fisrtilp
-    !Config  Def  = 0
-    !Config  Help = Flag  pour la pluie grande-échelle les options suivantes existent :
-    !Config         >1 nb iterations pour converger dans le calcul de qsat
-    iflag_fisrtilp_qsat_omp = 0
-    CALL getin('iflag_fisrtilp_qsat',iflag_fisrtilp_qsat_omp)
-
-    !Config  Key  = iflag_bergeron
-    !Config  Desc = Flag de fisrtilp
-    !Config  Def  = 0
-    !Config  Help = Flag  pour la pluie grande-échelle les options suivantes existent :
-    !Config         0 pas d effet Bergeron
-    !Config         1 effet Bergeron pour T<0
-    iflag_bergeron_omp = 0
-    CALL getin('iflag_bergeron',iflag_bergeron_omp)
-
     !
     !
@@ -1098 +1069 @@
     iflag_clw_omp = 0
     CALL getin('iflag_clw',iflag_clw_omp)
-    !
-    !Config Key  = cld_lc_lsc 
-    !Config Desc =  
-    !Config Def  = 2.6e-4
-    !Config Help = 
-    !
-    cld_lc_lsc_omp = 2.6e-4
-    CALL getin('cld_lc_lsc',cld_lc_lsc_omp)
-    !
-    !Config Key  = cld_lc_con
-    !Config Desc =  
-    !Config Def  = 2.6e-4
-    !Config Help = 
-    !
-    cld_lc_con_omp = 2.6e-4
-    CALL getin('cld_lc_con',cld_lc_con_omp)
-    !
-    !Config Key  = cld_tau_lsc
-    !Config Desc =  
-    !Config Def  = 3600.
-    !Config Help = 
-    !
-    cld_tau_lsc_omp = 3600.
-    CALL getin('cld_tau_lsc',cld_tau_lsc_omp)
-    !
-    !Config Key  = cld_tau_con
-    !Config Desc =  
-    !Config Def  = 3600.
-    !Config Help = 
-    !
-    cld_tau_con_omp = 3600.
-    CALL getin('cld_tau_con',cld_tau_con_omp)
-    !
-    !Config Key  = ffallv_lsc
-    !Config Desc =  
-    !Config Def  = 1.
-    !Config Help = 
-    !
-    ffallv_lsc_omp = 1.
-    CALL getin('ffallv_lsc',ffallv_lsc_omp)
-    !
-    !Config Key  = ffallv_con
-    !Config Desc =  
-    !Config Def  = 1.
-    !Config Help = 
-    !
-    ffallv_con_omp = 1.
-    CALL getin('ffallv_con',ffallv_con_omp)
-    !
-    !Config Key  = coef_eva
-    !Config Desc =  
-    !Config Def  = 2.e-5
-    !Config Help = 
-    !
-    coef_eva_omp = 2.e-5
-    CALL getin('coef_eva',coef_eva_omp)
-    !
-    !Config Key  = coef_eva_i
-    !Config Desc =  
-    !Config Def  = 2.e-5
-    !Config Help = 
-    !
-    coef_eva_i_omp = coef_eva_omp
-    CALL getin('coef_eva_i',coef_eva_i_omp)
-    !
-    !Config Key  = reevap_ice
-    !Config Desc =  
-    !Config Def  = .FALSE.
-    !Config Help = 
-    !
-    reevap_ice_omp = .FALSE.
-    CALL getin('reevap_ice',reevap_ice_omp)
+    
 
     !Config Key  = iflag_ratqs
@@ -1285 +1185 @@
 
     !
-    !Config Key  = iflag_pdf 
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_pdf_omp = 0
-    CALL getin('iflag_pdf',iflag_pdf_omp)
-    !
     !Config Key  = fact_cldcon
     !Config Desc =  
@@ -1443 +1335 @@
     CALL getin('rad_chau2',rad_chau2_omp)
 
-    !
-    !Config Key  = t_glace_min
-    !Config Desc =  
-    !Config Def  = 258.
-    !Config Help = 
-    !
-    t_glace_min_omp = 258.
-    CALL getin('t_glace_min',t_glace_min_omp)
-
-    !
-    !Config Key  = t_glace_max
-    !Config Desc =  
-    !Config Def  = 273.13
-    !Config Help = 
-    !
-    t_glace_max_omp = 273.13
-    CALL getin('t_glace_max',t_glace_max_omp)
-
-    !
-    !Config Key  = exposant_glace
-    !Config Desc =  
-    !Config Def  = 2.
-    !Config Help = 
-    !
-    exposant_glace_omp = 1.
-    CALL getin('exposant_glace',exposant_glace_omp)
-
-    !
-    !Config Key  = iflag_gammasat
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_gammasat_omp=0
-    CALL getin('iflag_gammasat',iflag_gammasat_omp)
-
-
-    !
-    !Config Key  = iflag_t_glace
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_t_glace_omp = 0
-    CALL getin('iflag_t_glace',iflag_t_glace_omp)
-
-    !
-    !Config Key  = iflag_cloudth_vert
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_cloudth_vert_omp = 0
-    CALL getin('iflag_cloudth_vert',iflag_cloudth_vert_omp)
-
-    !
-    !Config Key  = iflag_rain_incloud_vol
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_rain_incloud_vol_omp = 0
-    CALL getin('iflag_rain_incloud_vol',iflag_rain_incloud_vol_omp)
-
-    !
-    !Config Key  = iflag_vice
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_vice_omp = 0
-    CALL getin('iflag_vice',iflag_vice_omp)
 
     !Config Key  = iflag_rei
@@ -1695 +1515 @@
     CALL getin('iflag_pbl',iflag_pbl_omp)
 
+    iflag_physiq_omp = 0 ! 0: std, 1: with physiqex output, 2: for physiqex
+    CALL getin('iflag_physiq',iflag_physiq_omp)
+
 !FC
     !Config Key  = ifl_pbltree
@@ -1744 +1567 @@
     nsplit_thermals_omp = 1
     CALL getin('nsplit_thermals',nsplit_thermals_omp)
-
-    !Config Key  = alp_bl_k
-    !Config Desc =
-    !Config Def  = 0.
-    !Config Help =
-    !
+    !
+    !Config Key  = nsplit_thermals
+    !Config Desc =
+    !Config Def  = 0
+    !Config Help =
     alp_bl_k_omp = 1.
     CALL getin('alp_bl_k',alp_bl_k_omp)
@@ -2390 +2212 @@
     !Config Help = ...
 
+
+
+    ok_bs_omp = .FALSE.
+    CALL getin('ok_bs', ok_bs_omp)
+    !
+    !Config Key  = ok_bs_omp
+    !Config Desc = include blowing snow
+    !Config Def  = .FALSE.
+    !Config Help = ...
+
+
+    ok_rad_bs_omp = .FALSE.
+    CALL getin('ok_rad_bs', ok_rad_bs_omp)
+    !
+    !Config Key  = ok_rad_bs_omp
+    !Config Desc = include blowing snow radiative effect
+    !Config Def  = .FALSE.
+    !Config Help = ...
 
     ecrit_LES_omp = 1./8.
@@ -2477 +2317 @@
     iflag_ener_conserv = iflag_ener_conserv_omp
     ok_conserv_q = ok_conserv_q_omp
-    iflag_fisrtilp_qsat = iflag_fisrtilp_qsat_omp
-    iflag_bergeron = iflag_bergeron_omp
-
     epmax = epmax_omp
     coef_epmax_cape = coef_epmax_cape_omp
     ok_adj_ema = ok_adj_ema_omp
     iflag_clw = iflag_clw_omp
-    cld_lc_lsc = cld_lc_lsc_omp
-    cld_lc_con = cld_lc_con_omp
-    cld_tau_lsc = cld_tau_lsc_omp
-    cld_tau_con = cld_tau_con_omp
-    ffallv_lsc = ffallv_lsc_omp
-    ffallv_con = ffallv_con_omp
-    coef_eva = coef_eva_omp
-    coef_eva_i = coef_eva_i_omp
-    reevap_ice = reevap_ice_omp
-    iflag_pdf = iflag_pdf_omp
     solarlong0 = solarlong0_omp
     qsol0 = qsol0_omp
@@ -2504 +2331 @@
     inertie_lic = inertie_lic_omp
     inertie_sno = inertie_sno_omp
+    ok_bs = ok_bs_omp
+    ok_rad_bs=ok_rad_bs_omp
     rad_froid = rad_froid_omp
     rad_chau1 = rad_chau1_omp
     rad_chau2 = rad_chau2_omp
-    t_glace_min = t_glace_min_omp
-    t_glace_max = t_glace_max_omp
-    exposant_glace = exposant_glace_omp
-    iflag_gammasat=iflag_gammasat_omp
-    iflag_t_glace = iflag_t_glace_omp
-    iflag_cloudth_vert=iflag_cloudth_vert_omp
-    iflag_rain_incloud_vol=iflag_rain_incloud_vol_omp
-    iflag_vice=iflag_vice_omp
     iflag_rei=iflag_rei_omp
     iflag_ice_thermo = iflag_ice_thermo_omp
@@ -2533 +2354 @@
     pmagic = pmagic_omp
     iflag_pbl = iflag_pbl_omp
+    iflag_physiq = iflag_physiq_omp
     iflag_pbl_split = iflag_pbl_split_omp
 !FC
@@ -2907 +2729 @@
     WRITE(lunout,*) ' iflag_ener_conserv=',iflag_ener_conserv
     WRITE(lunout,*) ' ok_conserv_q=',ok_conserv_q
-    WRITE(lunout,*) ' iflag_fisrtilp_qsat=',iflag_fisrtilp_qsat
-    WRITE(lunout,*) ' iflag_bergeron=',iflag_bergeron
     WRITE(lunout,*) ' epmax = ', epmax
     WRITE(lunout,*) ' coef_epmax_cape = ', coef_epmax_cape
     WRITE(lunout,*) ' ok_adj_ema = ', ok_adj_ema
     WRITE(lunout,*) ' iflag_clw = ', iflag_clw
-    WRITE(lunout,*) ' cld_lc_lsc = ', cld_lc_lsc
-    WRITE(lunout,*) ' cld_lc_con = ', cld_lc_con
-    WRITE(lunout,*) ' cld_tau_lsc = ', cld_tau_lsc
-    WRITE(lunout,*) ' cld_tau_con = ', cld_tau_con
-    WRITE(lunout,*) ' ffallv_lsc = ', ffallv_lsc
-    WRITE(lunout,*) ' ffallv_con = ', ffallv_con
-    WRITE(lunout,*) ' coef_eva = ', coef_eva
-    WRITE(lunout,*) ' coef_eva_i = ', coef_eva_i
-    WRITE(lunout,*) ' reevap_ice = ', reevap_ice
-    WRITE(lunout,*) ' iflag_pdf = ', iflag_pdf
     WRITE(lunout,*) ' iflag_cld_th = ', iflag_cld_th
     WRITE(lunout,*) ' iflag_cld_cv = ', iflag_cld_cv
@@ -2944 +2754 @@
     WRITE(lunout,*) ' rad_chau1 = ',rad_chau1
     WRITE(lunout,*) ' rad_chau2 = ',rad_chau2
-    WRITE(lunout,*) ' t_glace_min = ',t_glace_min
-    WRITE(lunout,*) ' t_glace_max = ',t_glace_max
-    WRITE(lunout,*) ' exposant_glace = ',exposant_glace
-    WRITE(lunout,*) ' iflag_gammasat = ',iflag_gammasat
-    WRITE(lunout,*) ' iflag_t_glace = ',iflag_t_glace
-    WRITE(lunout,*) ' iflag_cloudth_vert = ',iflag_cloudth_vert
-    WRITE(lunout,*) ' iflag_rain_incloud_vol = ',iflag_rain_incloud_vol
-    WRITE(lunout,*) ' iflag_vice = ',iflag_vice
     WRITE(lunout,*) ' iflag_rei = ',iflag_rei
     WRITE(lunout,*) ' iflag_ice_thermo = ',iflag_ice_thermo
@@ -2992 +2794 @@
     WRITE(lunout,*) ' freq_calNMC = ',freq_calNMC
     WRITE(lunout,*) ' iflag_pbl = ', iflag_pbl
+    WRITE(lunout,*) ' iflag_physiq = ', iflag_physiq
 !FC
     WRITE(lunout,*) ' ifl_pbltree = ', ifl_pbltree
@@ -3017 +2820 @@
     WRITE(lunout,*) ' inertie_lic = ', inertie_lic
     WRITE(lunout,*) ' inertie_sno = ', inertie_sno
+    WRITE(lunout,*) ' ok_bs = ', ok_bs
+    WRITE(lunout,*) ' ok_rad_bs = ', ok_rad_bs
     WRITE(lunout,*) ' f_cdrag_ter = ',f_cdrag_ter
     WRITE(lunout,*) ' f_cdrag_oce = ',f_cdrag_oce

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/dyn1d/mod_1D_cases_read2.F90

@@ -1135 +1135 @@
   !       endif
   timeit=(day-day_ju_ini_cas)*86400
-  print *,'day=',day
-  print *,'day_ju_ini_cas=',day_ju_ini_cas
-  print *,'pdt_cas=',pdt_cas
-  print *,'timeit=',timeit
-  print *,'nt_cas=',nt_cas
+  !print *,'day=',day
+  !print *,'day_ju_ini_cas=',day_ju_ini_cas
+  !print *,'pdt_cas=',pdt_cas
+  !print *,'timeit=',timeit
+  !print *,'nt_cas=',nt_cas
 
   ! Determine the closest observation times:
@@ -1155 +1155 @@
   time_cas1=(it_cas1-1)*pdt_cas
   time_cas2=(it_cas2-1)*pdt_cas
-  print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
+  !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
 
   if (it_cas1 .gt. nt_cas) then
@@ -1350 +1350 @@
   !       endif
   timeit=(day-day_ju_ini_cas)*86400
-  print *,'day=',day
-  print *,'day_ju_ini_cas=',day_ju_ini_cas
-  print *,'pdt_cas=',pdt_cas
-  print *,'timeit=',timeit
-  print *,'nt_cas=',nt_cas
+  !print *,'day=',day
+  !print *,'day_ju_ini_cas=',day_ju_ini_cas
+  !print *,'pdt_cas=',pdt_cas
+  !print *,'timeit=',timeit
+  !print *,'nt_cas=',nt_cas
 
   ! Determine the closest observation times:
@@ -1370 +1370 @@
   time_cas1=(it_cas1-1)*pdt_cas
   time_cas2=(it_cas2-1)*pdt_cas
-  print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
-  print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
+  !print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
+  !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
 
   if (it_cas1 .gt. nt_cas) then 
@@ -1403 +1403 @@
      t_prof_cas(k) = t_cas(k,it_cas2)                                 &        
           -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
-     print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
+     !print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
      theta_prof_cas(k) = theta_cas(k,it_cas2)                         &                      
           -frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1))

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/dyn1d/old_lmdz1d.F90

@@ -13 +13 @@
        ftsol, beta_aridity, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
        rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, &
-       solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, &
+       solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, rneb_ancien, &
        wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
        wake_deltaq, wake_deltat, wake_s, wake_dens, &
@@ -920 +920 @@
         u_ancien(1,:)=u(:)
         v_ancien(1,:)=v(:)
+        rneb_ancien(1,:)=0.
 
         u10m=0.
@@ -945 +946 @@
 !------------------------------------------------------------------------
 !Al1 =============== restart option ==========================
+        iflag_physiq=0
+        call getin('iflag_physiq',iflag_physiq)
+
         if (.not.restart) then
           iflag_pbl = 5
@@ -1248 +1252 @@
 !! Increment state variables
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-print*,'OLDLMDZ1D AANT'
     IF (flag_inhib_forcing == 0) then ! if tendency of forcings should be added
-print*,'OLDLMDZ1D ARES' , forcing_sandu
 
 ! pour les cas sandu et astex, on reclacule u,v,q,temp et teta dans 1D_nudge_sandu_astex.h

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/dyn1d/scm.F90

@@ -9 +9 @@
        ftsol, beta_aridity, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
        rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, &
-       solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, &
+       solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, rneb_ancien, &
        wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
        wake_deltaq, wake_deltat, wake_s, wake_dens, &
@@ -678 +678 @@
         u_ancien(1,:)=u(:)
         v_ancien(1,:)=v(:)
+        rneb_ancien(1,:)=0.
  
         u10m=0.
@@ -703 +704 @@
 !------------------------------------------------------------------------
 !Al1 =============== restart option ======================================
+        iflag_physiq=0
+        call getin('iflag_physiq',iflag_physiq)
+
         if (.not.restart) then
           iflag_pbl = 5

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/ecrad/radiation_aerosol_optics.F90

@@ -53 +53 @@
         ! properties and average to the spectral intervals of the
         ! current gas-optics scheme
-!        call setup_general_aerosol_optics(config)
-        call setup_general_aerosol_optics_lmdz(config,trim(config%aerosol_optics_file_name))
+        call setup_general_aerosol_optics(config)
       else
         ! Read file containing optical properties already in the bands
@@ -334 +333 @@
 
   end subroutine setup_general_aerosol_optics
-
-    !---------------------------------------------------------------------
-  ! Read LMDZ file containing high spectral resolution optical properties
-  ! and average to the spectral intervals of the current gas-optics
-  ! scheme
-  subroutine setup_general_aerosol_optics_lmdz(config,file_name)
-
-    use parkind1,                      only : jprb
-    use yomhook,                       only : lhook, dr_hook
-!    use easy_netcdf,                   only : netcdf_file
-    use radiation_config,              only : config_type
-    use radiation_aerosol_optics_data, only : aerosol_optics_type
-    use radiation_spectral_definition, only : SolarReferenceTemperature, &
-         &                                    TerrestrialReferenceTemperature
-    use radiation_io,                  only : nulout
-    use netcdf95, only: nf95_open, nf95_inq_grp_full_ncid, nf95_close, &
-         nf95_inq_dimid, nf95_inq_varid, nf95_inquire_dimension, &
-         nf95_get_var, nf95_gw_var
-    use netcdf, only: nf90_nowrite
-
-
-    type(config_type), intent(inout), target :: config
-
-!    ! The NetCDF file containing the aerosol optics data
-!    type(netcdf_file)  :: file
-
-    character(len=*), intent(in):: file_name
-    ! NetCDF file containing the aerosol optics data
-
-    ! Wavenumber points in NetCDF file
-    real(jprb), allocatable :: wavenumber(:) ! cm-1
-
-    ! Hydrophilic aerosol properties
-    real(jprb), allocatable :: mass_ext_philic(:,:,:)    ! Mass-ext coefficient (m2 kg-1)
-    real(jprb), allocatable :: ssa_philic(:,:,:)         ! Single-scattering albedo
-    real(jprb), allocatable :: g_philic(:,:,:)           ! Asymmetry factor
-    real(jprb), allocatable :: lidar_ratio_philic(:,:,:) ! Lidar ratio (sr)
-
-    ! Hydrophobic aerosol properties
-    real(jprb), allocatable :: mass_ext_phobic(:,:)      ! Mass-ext coefficient (m2 kg-1)
-    real(jprb), allocatable :: ssa_phobic(:,:)           ! Single-scattering albedo
-    real(jprb), allocatable :: g_phobic(:,:)             ! Asymmetry factor
-    real(jprb), allocatable :: lidar_ratio_phobic(:,:)   ! Lidar ratio (sr)
-
-    ! Mapping matrix between optical properties at the wavenumbers in
-    ! the file, and spectral intervals used by the gas-optics scheme
-    real(jprb), allocatable :: mapping(:,:)
-
-    ! Pointer to the aerosol optics coefficients for brevity of access
-    type(aerosol_optics_type), pointer :: ao
-
-    ! Target monochromatic wavenumber for interpolation (cm-1)
-    real(jprb) :: wavenumber_target
-
-    ! Number of spectral points describing aerosol properties in the
-    ! shortwave and longwave
-    integer    :: nspecsw, nspeclw
-
-    ! Number of monochromatic wavelengths required
-    integer    :: nmono
-
-    integer    :: n_type_philic, n_type_phobic, nrh, nwn
-    integer    :: jtype, jwl, iwn
-
-    ! Weight of first point in interpolation
-    real(jprb) :: weight1
-
-    real(jprb) :: hook_handle
-
-    ! Local:
-    integer ncid, grpid, dimid, varid
-
-    if (lhook) call dr_hook('radiation_aerosol_optics:setup_general_aerosol_optics',0,hook_handle)
-
-    ao => config%aerosol_optics
-
-    ao%use_hydrophilic = .true.
-    ao%use_monochromatic = .true.
-    print*,'file_name= ',file_name
-    call nf95_open(file_name, nf90_nowrite, ncid)
-    call nf95_inq_grp_full_ncid(ncid, "Hydrophilic", grpid)
-    call nf95_inq_dimid(grpid, "hur", dimid)
-    call nf95_inquire_dimension(grpid, dimid, nclen = ao%nrh)
-!    allocate(ao%rh_lower(ao%nrh))
-    call nf95_inq_varid(grpid, "hur_bounds", varid)
-    call nf95_get_var(grpid, varid, ao%rh_lower, count_nc = [1, ao%nrh])
-
-    ! Hydrophilic/LW_bands:
-    call nf95_inq_grp_full_ncid(ncid, "Hydrophilic/LW_bands", grpid)
-    call nf95_inq_varid(grpid, "asymmetry", varid)
-    call nf95_gw_var(grpid, varid, ao%g_lw_philic)
-    call nf95_inq_varid(grpid, "single_scat_alb", varid)
-    call nf95_gw_var(grpid, varid, ao%ssa_lw_philic)
-    call nf95_inq_varid(grpid, "mass_ext", varid)
-    call nf95_gw_var(grpid, varid, ao%mass_ext_lw_philic)
-
-    ! Hydrophilic/SW_bands:
-    call nf95_inq_grp_full_ncid(ncid, "Hydrophilic/SW_bands", grpid)
-    call nf95_inq_varid(grpid, "asymmetry", varid)
-    call nf95_gw_var(grpid, varid, ao%g_sw_philic)
-    ao%g_sw_philic = cshift(ao%g_sw_philic, 1)
-    call nf95_inq_varid(grpid, "single_scat_alb", varid)
-    call nf95_gw_var(grpid, varid, ao%ssa_sw_philic)
-    ao%g_sw_philic = cshift(ao%ssa_sw_philic, 1)
-    call nf95_inq_varid(grpid, "mass_ext", varid)
-    call nf95_gw_var(grpid, varid, ao%mass_ext_sw_philic)
-    ao%g_sw_philic = cshift(ao%mass_ext_sw_philic, 1)
-
-    ! Hydrophilic/Monochromatic:
-    call nf95_inq_grp_full_ncid(ncid, "Hydrophilic/Monochromatic", grpid)
-    call nf95_inq_varid(grpid, "mass_ext", varid)
-    call nf95_gw_var(grpid, varid, ao%mass_ext_mono_philic)
-
-    ! Hydrophobic/LW_bands:
-    call nf95_inq_grp_full_ncid(ncid, "Hydrophobic/LW_bands", grpid)
-    call nf95_inq_varid(grpid, "asymmetry", varid)
-    call nf95_gw_var(grpid, varid, ao%g_lw_phobic)
-    call nf95_inq_varid(grpid, "single_scat_alb", varid)
-    call nf95_gw_var(grpid, varid, ao%ssa_lw_phobic)
-    call nf95_inq_varid(grpid, "mass_ext", varid)
-    call nf95_gw_var(grpid, varid, ao%mass_ext_lw_phobic)
-
-    ! Hydrophobic/SW_bands:
-    call nf95_inq_grp_full_ncid(ncid, "Hydrophobic/SW_bands", grpid)
-    call nf95_inq_varid(grpid, "asymmetry", varid)
-    call nf95_gw_var(grpid, varid, ao%g_sw_phobic)
-    ao%g_sw_phobic = cshift(ao%g_sw_phobic, 1)
-    call nf95_inq_varid(grpid, "single_scat_alb", varid)
-    call nf95_gw_var(grpid, varid, ao%ssa_sw_phobic)
-    ao%g_sw_phobic = cshift(ao%ssa_sw_phobic, 1)
-    call nf95_inq_varid(grpid, "mass_ext", varid)
-    call nf95_gw_var(grpid, varid, ao%mass_ext_sw_phobic)
-    ao%g_sw_phobic = cshift(ao%mass_ext_sw_phobic, 1)
-! AI ATTENTION    
-    call nf95_inq_varid(grpid, "wavenumber", varid)
-    call nf95_gw_var(grpid, varid, wavenumber)
-
-    ! Hydrophobic/Monochromatic:
-    call nf95_inq_grp_full_ncid(ncid, "Hydrophobic/Monochromatic", grpid)
-    call nf95_inq_varid(grpid, "mass_ext", varid)
-    call nf95_gw_var(grpid, varid, ao%mass_ext_mono_phobic)
-
-!    call file%get('wavenumber', wavenumber)
-!    nwn = size(wavenumber)
-
-!    call file%get_global_attribute('description_hydrophobic', &
-!         &                         ao%description_phobic_str)
-
-
-!      call file%get('relative_humidity1',      ao%rh_lower)
-
-!      call file%get_global_attribute('description_hydrophilic', &
-!           &                         ao%description_philic_str)
-
-    ! Close aerosol scattering file
-!    call file%close()
-
-    call nf95_close(ncid)
-
-    ! Get array sizes
-!    ao%n_bands_lw = size(ao%mass_ext_lw_phobic, 1)
-!    ao%n_bands_sw = size(ao%mass_ext_sw_phobic, 1)
-!    ao%n_mono_wl = size(ao%mass_ext_mono_phobic, 1)
-!    ao%n_type_phobic = size(ao%mass_ext_lw_phobic, 2)
-!    ao%n_type_philic = size(ao%mass_ext_lw_philic, 3)
-
-    ! Allocate memory for mapping arrays
-!    ao%ntype = ao%n_type_phobic + ao%n_type_philic
-!    allocate(ao%iclass(ao%ntype))
-!    allocate(ao%itype(ao%ntype))
-
-!    ao%iclass = IAerosolClassUndefined
-!    ao%itype  = 0
-
-    n_type_phobic = size(mass_ext_phobic, 2)
-    if (ao%use_hydrophilic) then
-      n_type_philic = size(mass_ext_philic, 3)
-      nrh = size(ao%rh_lower)
-    else
-      n_type_philic = 0
-      nrh = 0
-    end if
-
-    if (config%do_cloud_aerosol_per_sw_g_point) then
-      nspecsw = config%gas_optics_sw%spectral_def%ng
-    else
-      nspecsw = config%gas_optics_sw%spectral_def%nband
-    end if
-
-    if (config%do_cloud_aerosol_per_lw_g_point) then
-      nspeclw = config%gas_optics_lw%spectral_def%ng
-    else
-      nspeclw = config%gas_optics_lw%spectral_def%nband
-    end if
-
-    if (allocated(ao%wavelength_mono)) then
-      ! Monochromatic wavelengths also required
-      nmono = size(ao%wavelength_mono)
-    else
-      nmono = 0
-    end if
-
-    call ao%allocate(n_type_phobic, n_type_philic, nrh, nspeclw, nspecsw, nmono)
-
-    if (config%do_sw) then
-      call config%gas_optics_sw%spectral_def%calc_mapping(SolarReferenceTemperature, &
-           &  wavenumber, mapping, use_bands=(.not. config%do_cloud_aerosol_per_sw_g_point))
-
-      ao%mass_ext_sw_phobic = matmul(mapping, mass_ext_phobic)
-      ao%ssa_sw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic) &
-           &           / ao%mass_ext_sw_phobic
-      ao%g_sw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic*g_phobic) &
-           &         / (ao%mass_ext_sw_phobic*ao%ssa_sw_phobic)
-
-      if (ao%use_hydrophilic) then
-        do jtype = 1,n_type_philic
-          ao%mass_ext_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype))
-          ao%ssa_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
-               &                                        *ssa_philic(:,:,jtype)) &
-               &           / ao%mass_ext_sw_philic(:,:,jtype)
-          ao%g_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
-               &                       *ssa_philic(:,:,jtype)*g_philic(:,:,jtype)) &
-               &         / (ao%mass_ext_sw_philic(:,:,jtype)*ao%ssa_sw_philic(:,:,jtype))
-        end do
-      end if
-    end if
-    if (config%do_lw) then
-      call config%gas_optics_lw%spectral_def%calc_mapping(TerrestrialReferenceTemperature, &
-           &  wavenumber, mapping, use_bands=(.not. config%do_cloud_aerosol_per_lw_g_point))
-
-      ao%mass_ext_lw_phobic = matmul(mapping, mass_ext_phobic)
-      ao%ssa_lw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic) &
-           &           / ao%mass_ext_lw_phobic
-      ao%g_lw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic*g_phobic) &
-           &         / (ao%mass_ext_lw_phobic*ao%ssa_lw_phobic)
-
-      if (ao%use_hydrophilic) then
-        do jtype = 1,n_type_philic
-          ao%mass_ext_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype))
-          ao%ssa_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
-               &                                        *ssa_philic(:,:,jtype)) &
-               &           / ao%mass_ext_lw_philic(:,:,jtype)
-          ao%g_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
-               &                       *ssa_philic(:,:,jtype)*g_philic(:,:,jtype)) &
-               &         / (ao%mass_ext_lw_philic(:,:,jtype)*ao%ssa_lw_philic(:,:,jtype))
-        end do
-      end if
-    end if
-
-    if (allocated(ao%wavelength_mono)) then
-      ! Monochromatic wavelengths also required
-      do jwl = 1,nmono
-        ! Wavelength (m) to wavenumber (cm-1)
-        wavenumber_target = 0.01_jprb / ao%wavelength_mono(jwl)
-        ! Find index to first interpolation point, and its weight
-        if (wavenumber_target <= wavenumber(1)) then
-          weight1 = 1.0_jprb
-          iwn = 1
-        else if (wavenumber_target >= wavenumber(nwn)) then
-          iwn = nwn-1
-          weight1 = 0.0_jprb
-        else
-          iwn = 1
-          do while (wavenumber(iwn+1) < wavenumber_target .and. iwn < nwn-1)
-            iwn = iwn + 1
-          end do
-          weight1 = (wavenumber(iwn+1)-wavenumber_target) &
-               &  / (wavenumber(iwn+1)-wavenumber(iwn))
-        end if
-        ! Linear interpolation
-        ao%mass_ext_mono_phobic(jwl,:) = weight1 * mass_ext_phobic(iwn,:) &
-             &             + (1.0_jprb - weight1)* mass_ext_phobic(iwn+1,:)
-        ao%ssa_mono_phobic(jwl,:)      = weight1 * ssa_phobic(iwn,:) &
-             &             + (1.0_jprb - weight1)* ssa_phobic(iwn+1,:)
-        ao%g_mono_phobic(jwl,:)        = weight1 * g_phobic(iwn,:) &
-             &             + (1.0_jprb - weight1)* g_phobic(iwn+1,:)
-        ao%lidar_ratio_mono_phobic(jwl,:) = weight1 * lidar_ratio_phobic(iwn,:) &
-             &                + (1.0_jprb - weight1)* lidar_ratio_phobic(iwn+1,:)
-        if (ao%use_hydrophilic) then
-          ao%mass_ext_mono_philic(jwl,:,:) = weight1 * mass_ext_philic(iwn,:,:) &
-               &               + (1.0_jprb - weight1)* mass_ext_philic(iwn+1,:,:)
-          ao%ssa_mono_philic(jwl,:,:)      = weight1 * ssa_philic(iwn,:,:) &
-               &               + (1.0_jprb - weight1)* ssa_philic(iwn+1,:,:)
-          ao%g_mono_philic(jwl,:,:)        = weight1 * g_philic(iwn,:,:) &
-               &               + (1.0_jprb - weight1)* g_philic(iwn+1,:,:)
-          ao%lidar_ratio_mono_philic(jwl,:,:) = weight1 * lidar_ratio_philic(iwn,:,:) &
-               &                  + (1.0_jprb - weight1)* lidar_ratio_philic(iwn+1,:,:)
-        end if
-      end do
-    end if
-
-    ! Deallocate memory local to this routine
-    deallocate(mass_ext_phobic)
-    deallocate(ssa_phobic)
-    deallocate(g_phobic)
-    deallocate(lidar_ratio_phobic)
-    if (ao%use_hydrophilic) then
-      deallocate(mass_ext_philic)
-      deallocate(ssa_philic)
-      deallocate(g_philic)
-      deallocate(lidar_ratio_philic)
-    end if
-
-    if (lhook) call dr_hook('radiation_aerosol_optics:setup_general_aerosol_optics',1,hook_handle)
-
-  end subroutine setup_general_aerosol_optics_lmdz
-    
 
   !---------------------------------------------------------------------

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/ecrad/radiation_cloud_generator.F90

@@ -541 +541 @@
     use radiation_pdf_sampler, only : pdf_sampler_type
     implicit none
-#if defined(__GFORTRAN__) || defined(__PGI) || defined(__NEC__)
-#else
-    !$omp declare simd(sample_from_pdf_simd) uniform(this) &
-    !$omp linear(ref(fsd)) linear(ref(cdf))
-#endif
     type(pdf_sampler_type), intent(in)  :: this
 

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/ecrad/radiation_scheme.F90

@@ -87 +87 @@
      &  NWEIGHT_PAR, IBAND_PAR, WEIGHT_PAR, &
      &  ITYPE_TROP_BG_AER,  TROP_BG_AER_MASS_EXT, &
-     &  ITYPE_STRAT_BG_AER, STRAT_BG_AER_MASS_EXT
+     &  ITYPE_STRAT_BG_AER, STRAT_BG_AER_MASS_EXT, ISolverSpartacus
 ! Commentes : jour, date de la simulation 
 !USE YOMRIP0  , ONLY : NINDAT
@@ -105 +105 @@
 
 USE mod_phys_lmdz_para
+USE setup_config_from_lmdz,   ONLY : driver_config_type
 
 IMPLICIT NONE
@@ -269 +270 @@
 ! Ratio of cloud overlap decorrelation length for cloud water
 ! inhomogeneities to that for cloud boundaries (typically 0.5)
-REAL(KIND=JPRB)           :: ZDECORR_LEN_RATIO
+!REAL(KIND=JPRB)           :: ZDECORR_LEN_RATIO = 0.5_jprb
+
+!AI mai 2023
+! A mettre dans namelist
+!real(jprb) :: high_inv_effective_size
+!real(jprb) :: middle_inv_effective_size
+!real(jprb) :: low_inv_effective_size
+
+!real(jprb) :: cloud_inhom_separation_factor
+!real(jprb) :: cloud_separation_scale_surface
+!real(jprb) :: cloud_separation_scale_toa
+!real(jprb) :: cloud_separation_scale_power
 
 ! The surface net longwave flux if the surface was a black body, used
@@ -290 +302 @@
 
 ! AI ATTENTION
-real(jprb), parameter    :: frac_std = 0.75
+! A mettre dans namelist
+!real(jprb), parameter    :: frac_std = 0.75
 
 ! Name of file names specified on command line
@@ -301 +314 @@
 !$OMP THREADPRIVATE(debut_ecrad)
 
+type(driver_config_type) :: driver_config
 ! Import time functions for iseed calculation
 ! AI ATTENTION propre a ifs
@@ -342 +356 @@
 ! AI appel radiation_setup
 call SETUP_RADIATION_SCHEME(loutput)
+! Read "radiation_driver" namelist into radiation driver config type
+  file_name="namelist_ecrad"
+call driver_config%read(file_name)
+
+if (rad_config%i_solver_sw == ISolverSPARTACUS &
+      & .or.   rad_config%i_solver_lw == ISolverSPARTACUS) then
+       print*,'Solveur SW: ', rad_config%i_solver_sw
+       print*,'Solveur LW: ', rad_config%i_solver_lw
+   if (driver_config%ok_effective_size) then
+       print*,'low_inv_effective_size = ',driver_config%low_inv_effective_size
+       print*,'middle_inv_effective_size = ',driver_config%middle_inv_effective_size
+       print*,'high_inv_effective_size = ',driver_config%high_inv_effective_size
+   else if (driver_config%ok_separation) then   
+       print*,'cloud_separation_scale_surface =',driver_config%cloud_separation_scale_surface
+       print*,'cloud_separation_scale_toa =',driver_config%cloud_separation_scale_toa
+       print*,'cloud_separation_scale_power =',driver_config%cloud_separation_scale_power
+       print*,'cloud_inhom_separation_factor =',driver_config%cloud_inhom_separation_factor
+   endif   
+endif   
 
  if (lprint_config) then
@@ -450 +483 @@
 cloud%fraction(KIDIA:KFDIA,:) = PCLOUD_FRAC(KIDIA:KFDIA,:)
 
-!AI ATTENTION a voir avec JL
-! Compute effective radii and convert to metres
-!CALL LIQUID_EFFECTIVE_RADIUS(KIDIA, KFDIA, KLON, KLEV, &
-!     &  PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_LIQUID, PQ_RAIN, &
-!     &  PLAND_SEA_MASK, PCCN_LAND, PCCN_SEA, &
-!     &  ZRE_LIQUID_UM)
+!!! ok AI ATTENTION a voir avec JL
+! Compute effective radi and convert to metres
+! AI. : on passe directement les champs de LMDZ
 cloud%re_liq(KIDIA:KFDIA,:) = ZRE_LIQUID_UM(KIDIA:KFDIA,:)
-
-!CALL ICE_EFFECTIVE_RADIUS(KIDIA, KFDIA, KLON, KLEV, &
-!     &  PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_ICE, PQ_SNOW, PGEMU, &
-!     &  ZRE_ICE_UM)
 cloud%re_ice(KIDIA:KFDIA,:) = ZRE_ICE_UM(KIDIA:KFDIA,:)
 
@@ -468 +494 @@
 ! decorrelation lengths for cloud water content inhomogeneities and
 ! cloud boundaries, and set it in the "rad_config" object.
+! IFS :
 !CALL CLOUD_OVERLAP_DECORR_LEN(KIDIA, KFDIA, KLON, PGEMU, YRERAD%NDECOLAT, &
 !     &    ZDECORR_LEN_KM, PDECORR_LEN_RATIO=ZDECORR_LEN_RATIO)
-
-! AI ATTENTION (valeur lue dans namelist)
-!ZDECORR_LEN_RATIO = 0.5_JPRB
-!rad_config%cloud_inhom_decorr_scaling = ZDECORR_LEN_RATIO
+! AI valeur dans namelist
+! rad_config%cloud_inhom_decorr_scaling = ZDECORR_LEN_RATIO
+
 !AI ATTENTION meme valeur que dans offline
-ZDECORR_LEN_KM = 2000.0_JPRB
+! A mettre dans namelist
+ZDECORR_LEN_KM = driver_config%overlap_decorr_length
 DO JLON = KIDIA,KFDIA
   CALL cloud%set_overlap_param(thermodynamics, &
-       &                       ZDECORR_LEN_KM(JLON), &
-       &                       istartcol=JLON, iendcol=JLON)
+       &                 ZDECORR_LEN_KM(JLON), &
+       &                 istartcol=JLON, iendcol=JLON)
 ENDDO
 
+! IFS :
 ! Cloud water content fractional standard deviation is configurable
 ! from namelist NAERAD but must be globally constant. Before it was
@@ -487 +515 @@
 !CALL cloud%create_fractional_std(KLON, KLEV, YRERAD%RCLOUD_FRAC_STD)
 ! AI ATTENTION frac_std=0.75 meme valeur que dans la version offline
-CALL cloud%create_fractional_std(KLON, KLEV, frac_std)
-
+CALL cloud%create_fractional_std(KLON, KLEV, driver_config%frac_std)
+
+if (rad_config%i_solver_sw == ISolverSPARTACUS &
+      & .or.   rad_config%i_solver_lw == ISolverSPARTACUS) then
 ! AI ! Read cloud properties needed by SPARTACUS
+!AI ATTENTION meme traitement dans le version offline
+
 ! By default mid and high cloud effective size is 10 km
 !CALL cloud%create_inv_cloud_effective_size(KLON,KLEV,1.0_JPRB/10000.0_JPRB)
-! But for boundary clouds (eta > 0.8) we set it to 1 km
-!DO JLEV = 1,KLEV
-!  DO JLON = KIDIA,KFDIA
-!    IF (PPRESSURE(JLON,JLEV) > 0.8_JPRB * PPRESSURE_H(JLON,KLEV+1)) THEN
-!      cloud%inv_cloud_effective_size(JLON,JLEV) = 1.0e-3_JPRB
-!    ENDIF
-!  ENDDO
-!ENDDO
-!AI ATTENTION meme traitement dans le version offline
-call cloud%create_inv_cloud_effective_size_eta(KLON, KLEV, &
+
+!  if (driver_config%low_inv_effective_size >= 0.0_jprb &
+!     & .or. driver_config%middle_inv_effective_size >= 0.0_jprb &
+!     & .or. driver_config%high_inv_effective_size >= 0.0_jprb) then
+  if (driver_config%ok_effective_size) then
+     call cloud%create_inv_cloud_effective_size_eta(klon, klev, &
                &  thermodynamics%pressure_hl, &
-               &  0.005_JPRB, &
-               &  0.0001_JPRB, &
-               &  0.0001, 0.8_jprb, 0.45_jprb)      
+               &  driver_config%low_inv_effective_size, &
+               &  driver_config%middle_inv_effective_size, &
+               &  driver_config%high_inv_effective_size, 0.8_jprb, 0.45_jprb)
+!  else if (driver_config%cloud_separation_scale_surface > 0.0_jprb &
+!         .and. driver_config%cloud_separation_scale_toa > 0.0_jprb) then
+  else if (driver_config%ok_separation) then
+      call cloud%param_cloud_effective_separation_eta(klon, klev, &
+               &  thermodynamics%pressure_hl, &
+               &  driver_config%cloud_separation_scale_surface, &
+               &  driver_config%cloud_separation_scale_toa, &
+               &  driver_config%cloud_separation_scale_power, &
+               &  driver_config%cloud_inhom_separation_factor)
+  endif
+endif  
 
 print*,'******** AEROSOLS (allocate + input) **************************************'

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/ecrad/setup_aerosol_optics_lmdz_m.F90

@@ -29 +29 @@
     use netcdf95, only: nf95_open, nf95_inq_grp_full_ncid, nf95_close, &
          nf95_inq_dimid, nf95_inq_varid, nf95_inquire_dimension, &
-         nf95_get_var, nf95_gw_var
-    use netcdf, only: nf90_nowrite
+         nf95_get_var, nf95_gw_var, nf95_nowrite
 
     type(aerosol_optics_type), intent(out):: ao
@@ -44 +43 @@
     ao%use_hydrophilic = .true.
     ao%use_monochromatic = .true.
-    print*,'file_name= ',file_name
-    call nf95_open(file_name, nf90_nowrite, ncid)
+    call nf95_open(file_name, nf95_nowrite, ncid)
     call nf95_inq_grp_full_ncid(ncid, "Hydrophilic", grpid)
     call nf95_inq_dimid(grpid, "hur", dimid)
@@ -69 +67 @@
     call nf95_inq_varid(grpid, "single_scat_alb", varid)
     call nf95_gw_var(grpid, varid, ao%ssa_sw_philic)
-    ao%g_sw_philic = cshift(ao%ssa_sw_philic, 1)
+    ao%ssa_sw_philic = cshift(ao%ssa_sw_philic, 1)
     call nf95_inq_varid(grpid, "mass_ext", varid)
     call nf95_gw_var(grpid, varid, ao%mass_ext_sw_philic)
-    ao%g_sw_philic = cshift(ao%mass_ext_sw_philic, 1)
+    ao%mass_ext_sw_philic = cshift(ao%mass_ext_sw_philic, 1)
 
     ! Hydrophilic/Monochromatic:
@@ -95 +93 @@
     call nf95_inq_varid(grpid, "single_scat_alb", varid)
     call nf95_gw_var(grpid, varid, ao%ssa_sw_phobic)
-    ao%g_sw_phobic = cshift(ao%ssa_sw_phobic, 1)
+    ao%ssa_sw_phobic = cshift(ao%ssa_sw_phobic, 1)
     call nf95_inq_varid(grpid, "mass_ext", varid)
     call nf95_gw_var(grpid, varid, ao%mass_ext_sw_phobic)
-    ao%g_sw_phobic = cshift(ao%mass_ext_sw_phobic, 1)
+    ao%mass_ext_sw_phobic = cshift(ao%mass_ext_sw_phobic, 1)
 
     ! Hydrophobic/Monochromatic:

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/fisrtilp.F90

@@ -20 +20 @@
   ! flag to include modifications to ensure energy conservation (if flag >0)
   USE add_phys_tend_mod, only : fl_cor_ebil 
+  USE lscp_ini_mod, ONLY: iflag_t_glace,t_glace_min, t_glace_max, exposant_glace
+  USE lscp_ini_mod, ONLY: iflag_cloudth_vert, iflag_rain_incloud_vol 
+  USE lscp_ini_mod, ONLY: coef_eva, coef_eva_i, ffallv_lsc, ffallv_con
+  USE lscp_ini_mod, ONLY: cld_tau_lsc, cld_tau_con, cld_lc_lsc, cld_lc_con
+  USE lscp_ini_mod, ONLY: reevap_ice, iflag_bergeron, iflag_fisrtilp_qsat, iflag_pdf 
+
+
   IMPLICIT none
   !======================================================================
@@ -47 +54 @@
   !======================================================================
   include "YOMCST.h"
-  include "fisrtilp.h"
-  include "nuage.h" ! JBM (3/14)
-
   !
   ! Principaux inputs:
@@ -228 +232 @@
                      ! (Heymsfield & Donner, 1990)
   REAL zzz
-
   include "YOETHF.h"
   include "FCTTRE.h"

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/fonte_neige_mod.F90

@@ -164 +164 @@
     REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain
     REAL, DIMENSION(klon), INTENT(IN)    :: precip_snow
-    
-! Input/Output variables
+
+    ! Input/Output variables
 !****************************************************************************************
 

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/ice_sursat_mod.F90

@@ -308 +308 @@
   INCLUDE "YOETHF.h"
   INCLUDE "FCTTRE.h"
-  INCLUDE "fisrtilp.h"
   INCLUDE "clesphys.h"
 

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/icefrac_lsc_mod.F90

@@ -17 +17 @@
   
   USE print_control_mod, ONLY: lunout, prt_level
-  INCLUDE "nuage.h"
-
-  ! nuage.h contains:
+  USE lscp_ini_mod, ONLY: t_glace_min, t_glace_max, exposant_glace, iflag_t_glace
+  ! lscp_ini contains:
   ! t_glace_min: if T < Tmin, the cloud is only made of water ice
   ! t_glace_max: if T > Tmax, the cloud is only made of liquid water

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/infotrac_phy.F90

@@ -68 +68 @@
 !  | longName    | Long name (with adv. scheme suffix) for outputs      | ttext       |                        |
 !  | type        | Type (so far: tracer or tag)                         | /           | tracer,tag             |
-!  | phase       | Phases list ("g"as / "l"iquid / "s"olid)             | /           | [g][l][s]              |
+!  | phase       | Phases list ("g"as / "l"iquid / "s"olid / "b"lowing) | /           | [g][l][s][b]           |
 !  | component   | Name(s) of the merged/cumulated section(s)           | /           | coma-separated names   |
 !  | iGeneration | Generation (>=1)                                     | /           |                        |
@@ -93 +93 @@
 !  | trac   | ntiso  | Isotopes + tagging tracers list + number         | / | ntraciso       |                 |
 !  | zone   | nzone  | Geographic tagging zones   list + number         | / | ntraceurs_zone |                 |
-!  | phase  | nphas  | Phases                     list + number         |                    | [g][l][s], 1:3  |
+!  | phase  | nphas  | Phases                     list + number         |                    |[g][l][s][b] 1:4 |
 !  | iqIsoPha        | Index in "qx"           = f(name(1:ntiso)),phas) | iqiso              | 1:nqtot         |
 !  | itZonIso        | Index in "trac(1:ntiso)"= f(zone, name(1:niso))  | index_trac         | 1:ntiso         |

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/lscp_ini_mod.F90

@@ -5 +5 @@
   ! PARAMETERS for lscp:
   !--------------------
-  
+ 
+  REAL RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RG
+  !$OMP THREADPRIVATE(RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RG)
+
   REAL, SAVE :: seuil_neb=0.001                 ! cloud fraction threshold: a cloud really exists when exceeded
   !$OMP THREADPRIVATE(seuil_neb)
 
-  INTEGER, SAVE :: ninter=5                     ! number of iterations to calculate autoconversion to precipitation
-  !$OMP THREADPRIVATE(ninter)
+  INTEGER, SAVE :: niter_lscp=5                 ! number of iterations to calculate autoconversion to precipitation
+  !$OMP THREADPRIVATE(niter_lscp)
 
   INTEGER,SAVE :: iflag_evap_prec=1             ! precipitation evaporation flag. 0: nothing, 1: "old way", 
                                                 ! 2: Max cloud fraction above to calculate the max of reevaporation
-                                                ! 4: LTP'method i.e. evaporation in the clear-sky fraction of the mesh only
+                                                ! >=4: LTP'method i.e. evaporation in the clear-sky fraction of the mesh only
+                                                ! pay attention that iflag_evap_prec=4 may lead to unrealistic and overestimated
+                                                ! evaporation. Use 5 instead
   !$OMP THREADPRIVATE(iflag_evap_prec)
 
@@ -38 +43 @@
   !$OMP THREADPRIVATE(ok_radocond_snow)
 
-  LOGICAL, SAVE :: ok_debug_autoconversion=.true.   ! removes a bug in the autoconversion process
-  !$OMP THREADPRIVATE(ok_debug_autoconversion)
-
+  REAL, SAVE :: t_glace_min=258.0                ! lower-bound temperature parameter for cloud phase determination
+  !$OMP THREADPRIVATE(t_glace_min)
+
+  REAL, SAVE :: t_glace_max=273.15               ! upper-bound temperature parameter for cloud phase determination
+  !$OMP THREADPRIVATE(t_glace_max)
+
+  REAL, SAVE :: exposant_glace=1.0               ! parameter for cloud phase determination
+  !$OMP THREADPRIVATE(exposant_glace)
+
+  INTEGER, SAVE :: iflag_vice=0                  ! which expression for ice crystall fall velocity
+  !$OMP THREADPRIVATE(iflag_vice)
+
+  INTEGER, SAVE :: iflag_t_glace=0               ! which expression for cloud phase partitioning
+  !$OMP THREADPRIVATE(iflag_t_glace)
+
+  INTEGER, SAVE :: iflag_cloudth_vert=0          ! option for determining cloud fraction and content in convective boundary layers
+  !$OMP THREADPRIVATE(iflag_cloudth_vert)
+
+  INTEGER, SAVE :: iflag_gammasat=0              ! which threshold for homogeneous nucleation below -40oC
+  !$OMP THREADPRIVATE(iflag_gammasat)
+
+  INTEGER, SAVE :: iflag_rain_incloud_vol=0      ! use of volume cloud fraction for rain autoconversion 
+  !$OMP THREADPRIVATE(iflag_rain_incloud_vol)
+
+  INTEGER, SAVE :: iflag_bergeron=0              ! bergeron effect for liquid precipitation treatment  
+  !$OMP THREADPRIVATE(iflag_bergeron)
+
+  INTEGER, SAVE :: iflag_fisrtilp_qsat=0         ! qsat adjustment (iterative) during autoconversion
+  !$OMP THREADPRIVATE(iflag_fisrtilp_qsat)
+
+  INTEGER, SAVE :: iflag_pdf=0                   ! type of subgrid scale qtot pdf
+  !$OMP THREADPRIVATE(iflag_pdf)
+
+  INTEGER, SAVE :: iflag_autoconversion=0        ! autoconversion option
+  !$OMP THREADPRIVATE(iflag_autoconversion)
+
+  LOGICAL, SAVE :: reevap_ice=.false.            ! no liquid precip for T< threshold
+  !$OMP THREADPRIVATE(reevap_ice)
+
+  REAL, SAVE :: cld_lc_lsc=2.6e-4                ! liquid autoconversion coefficient, stratiform rain
+  !$OMP THREADPRIVATE(cld_lc_lsc)
+
+  REAL, SAVE :: cld_lc_con=2.6e-4                ! liquid autoconversion coefficient, convective rain
+  !$OMP THREADPRIVATE(cld_lc_con)
+
+  REAL, SAVE :: cld_tau_lsc=3600.                ! liquid autoconversion timescale, stratiform rain
+  !$OMP THREADPRIVATE(cld_tau_lsc)
+
+  REAL, SAVE :: cld_tau_con=3600.                ! liquid autoconversion timescale, convective rain
+  !$OMP THREADPRIVATE(cld_tau_con)
+
+  REAL, SAVE :: cld_expo_lsc=2.                  ! liquid autoconversion threshold exponent, stratiform rain
+  !$OMP THREADPRIVATE(cld_expo_lsc)
+
+  REAL, SAVE :: cld_expo_con=2.                  ! liquid autoconversion threshold exponent, convective rain
+  !$OMP THREADPRIVATE(cld_expo_con)
+
+  REAL, SAVE :: ffallv_lsc=1.                    ! tuning coefficient crystal fall velocity, stratiform 
+  !$OMP THREADPRIVATE(ffallv_lsc)
+
+  REAL, SAVE :: ffallv_con=1.                    ! tuning coefficient crystal fall velocity, convective
+  !$OMP THREADPRIVATE(ffallv_con)
+
+  REAL, SAVE :: coef_eva=2e-5                    ! tuning coefficient liquid precip evaporation
+  !$OMP THREADPRIVATE(coef_eva)
+
+  REAL, SAVE :: coef_eva_i                       ! tuning coefficient ice precip sublimation
+  !$OMP THREADPRIVATE(coef_eva_i)
+
+  REAL cice_velo                                 ! factor in the ice fall velocity formulation
+  PARAMETER (cice_velo=1.645)
+
+  REAL dice_velo                                 ! exponent in the ice fall velocity formulation
+  PARAMETER (dice_velo=0.16)
+
+  REAL, SAVE :: dist_liq=300.                    ! typical deph of cloud-top liquid layer in mpcs
+  !$OMP THREADPRIVATE(dist_liq)
+
+  REAL, SAVE    :: tresh_cl=0.0                  ! cloud fraction threshold for cloud top search
+  !$OMP THREADPRIVATE(tresh_cl)
 
 CONTAINS
 
-SUBROUTINE lscp_ini(dtime,ok_ice_sursat)
+SUBROUTINE lscp_ini(dtime,ok_ice_sursat, RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in, &
+                    RVTMP2_in, RTT_in,RD_in,RG_in)
 
 
@@ -54 +137 @@
    LOGICAL, INTENT(IN)   :: ok_ice_sursat  
 
-    CALL getin_p('ninter',ninter)
+   REAL, INTENT(IN)      :: RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in
+   REAL, INTENT(IN)      ::  RVTMP2_in, RTT_in, RD_in, RG_in
+   character (len=20) :: modname='lscp_ini_mod'
+   character (len=80) :: abort_message
+
+
+    RG=RG_in
+    RD=RD_in
+    RCPD=RCPD_in
+    RLVTT=RLVTT_in
+    RLSTT=RLSTT_in
+    RLMLT=RLMLT_in
+    RTT=RTT_in
+    RG=RG_in
+    RVTMP2=RVTMP2_in
+
+
+
+    CALL getin_p('niter_lscp',niter_lscp)
     CALL getin_p('iflag_evap_prec',iflag_evap_prec)
     CALL getin_p('seuil_neb',seuil_neb)
@@ -60 +161 @@
     CALL getin_p('iflag_mpc_bl',iflag_mpc_bl)
     CALL getin_p('ok_radocond_snow',ok_radocond_snow) 
-    CALL getin_p('ok_debug_autoconversion',ok_debug_autoconversion)    
-    WRITE(lunout,*) 'lscp, ninter:', ninter
+    CALL getin_p('t_glace_max',t_glace_max)
+    CALL getin_p('t_glace_min',t_glace_min)
+    CALL getin_p('exposant_glace',exposant_glace) 
+    CALL getin_p('iflag_vice',iflag_vice)
+    CALL getin_p('iflag_t_glace',iflag_t_glace)
+    CALL getin_p('iflag_cloudth_vert',iflag_cloudth_vert)
+    CALL getin_p('iflag_gammasat',iflag_gammasat)
+    CALL getin_p('iflag_rain_incloud_vol',iflag_rain_incloud_vol)
+    CALL getin_p('iflag_bergeron',iflag_bergeron)
+    CALL getin_p('iflag_fisrtilp_qsat',iflag_fisrtilp_qsat)
+    CALL getin_p('iflag_pdf',iflag_pdf)
+    CALL getin_p('reevap_ice',reevap_ice)
+    CALL getin_p('cld_lc_lsc',cld_lc_lsc)
+    CALL getin_p('cld_lc_con',cld_lc_con)
+    CALL getin_p('cld_tau_lsc',cld_tau_lsc)
+    CALL getin_p('cld_tau_con',cld_tau_con)
+    CALL getin_p('cld_expo_lsc',cld_expo_lsc)
+    CALL getin_p('cld_expo_con',cld_expo_con)
+    CALL getin_p('ffallv_lsc',ffallv_lsc)
+    CALL getin_p('ffallv_lsc',ffallv_con)
+    CALL getin_p('coef_eva',coef_eva)
+    coef_eva_i=coef_eva
+    CALL getin_p('coef_eva_i',coef_eva_i)
+    CALL getin_p('iflag_autoconversion',iflag_autoconversion)
+    CALL getin_p('dist_liq',dist_liq)
+    CALL getin_p('tresh_cl',tresh_cl)
+
+
+
+
+    WRITE(lunout,*) 'lscp, niter_lscp:', niter_lscp
     WRITE(lunout,*) 'lscp, iflag_evap_prec:', iflag_evap_prec
     WRITE(lunout,*) 'lscp, seuil_neb:', seuil_neb
@@ -67 +197 @@
     WRITE(lunout,*) 'lscp, iflag_mpc_bl:', iflag_mpc_bl
     WRITE(lunout,*) 'lscp, ok_radocond_snow:', ok_radocond_snow
-    WRITE(lunout,*) 'lscp, ok_debug_autoconversion:', ok_debug_autoconversion
+    WRITE(lunout,*) 'lscp, t_glace_max:', t_glace_max
+    WRITE(lunout,*) 'lscp, t_glace_min:', t_glace_min
+    WRITE(lunout,*) 'lscp, exposant_glace:', exposant_glace
+    WRITE(lunout,*) 'lscp, iflag_vice:', iflag_vice
+    WRITE(lunout,*) 'lscp, iflag_t_glace:', iflag_t_glace
+    WRITE(lunout,*) 'lscp, iflag_cloudth_vert:', iflag_cloudth_vert
+    WRITE(lunout,*) 'lscp, iflag_gammasat:', iflag_gammasat
+    WRITE(lunout,*) 'lscp, iflag_rain_incloud_vol:', iflag_rain_incloud_vol
+    WRITE(lunout,*) 'lscp, iflag_bergeron:', iflag_bergeron
+    WRITE(lunout,*) 'lscp, iflag_fisrtilp_qsat:', iflag_fisrtilp_qsat
+    WRITE(lunout,*) 'lscp, iflag_pdf', iflag_pdf
+    WRITE(lunout,*) 'lscp, reevap_ice', reevap_ice
+    WRITE(lunout,*) 'lscp, cld_lc_lsc', cld_lc_lsc
+    WRITE(lunout,*) 'lscp, cld_lc_con', cld_lc_con
+    WRITE(lunout,*) 'lscp, cld_tau_lsc', cld_tau_lsc
+    WRITE(lunout,*) 'lscp, cld_tau_con', cld_tau_con
+    WRITE(lunout,*) 'lscp, cld_expo_lsc', cld_expo_lsc
+    WRITE(lunout,*) 'lscp, cld_expo_con', cld_expo_con
+    WRITE(lunout,*) 'lscp, ffallv_lsc', ffallv_lsc
+    WRITE(lunout,*) 'lscp, ffallv_con', ffallv_con
+    WRITE(lunout,*) 'lscp, coef_eva', coef_eva
+    WRITE(lunout,*) 'lscp, coef_eva_i', coef_eva_i
+    WRITE(lunout,*) 'lscp, iflag_autoconversion', iflag_autoconversion
+    WRITE(lunout,*) 'lscp, dist_liq', dist_liq
+    WRITE(lunout,*) 'lscp, tresh_cl', tresh_cl
+
+
+
+
 
     ! check for precipitation sub-time steps
-    IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
+    IF (ABS(dtime/REAL(niter_lscp)-360.0).GT.0.001) THEN
         WRITE(lunout,*) 'lscp: it is not expected, see Z.X.Li', dtime
         WRITE(lunout,*) 'I would prefer a 6 min sub-timestep'
+    ENDIF
+
+    ! check consistency between numerical resolution of autoconversion 
+    ! and other options
+   
+    IF (iflag_autoconversion .EQ. 2) THEN
+        IF ((iflag_vice .NE. 0) .OR. (niter_lscp .GT. 1)) THEN
+           abort_message = 'in lscp, iflag_autoconversion=2 requires iflag_vice=0 and niter_lscp=1'
+           CALL abort_physic (modname,abort_message,1) 
+        ENDIF 
     ENDIF
 

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/lscp_mod.F90

@@ -9 +9 @@
      paprs,pplay,t,q,ptconv,ratqs,                      &
      d_t, d_q, d_ql, d_qi, rneb, rneblsvol, rneb_seri,  &
-     radocond, radicefrac, rain, snow,                    &
+     pfraclr,pfracld,                                   &
+     radocond, radicefrac, rain, snow,                  &
      frac_impa, frac_nucl, beta,                        &
      prfl, psfl, rhcl, zqta, fraca,                     &
      ztv, zpspsk, ztla, zthl, iflag_cld_th,             &
      iflag_ice_thermo, ok_ice_sursat, qsatl, qsats,     &
+     distcltop,                                         &
      qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss,   &
      Tcontr, qcontr, qcontr2, fcontrN, fcontrP)
@@ -89 +91 @@
 USE print_control_mod, ONLY: prt_level, lunout
 USE cloudth_mod, ONLY : cloudth, cloudth_v3, cloudth_v6, cloudth_mpc 
-USE lscp_tools_mod, ONLY : calc_qsat_ecmwf, icefrac_lscp, calc_gammasat, fallice_velocity
+USE lscp_tools_mod, ONLY : calc_qsat_ecmwf, icefrac_lscp, calc_gammasat
+USE lscp_tools_mod, ONLY : fallice_velocity, distance_to_cloud_top
 USE ice_sursat_mod, ONLY : ice_sursat
 
-USE lscp_ini_mod, ONLY : seuil_neb, ninter, iflag_evap_prec, t_coup, DDT0, ztfondue, rain_int_min
-USE lscp_ini_mod, ONLY : iflag_mpc_bl, ok_radocond_snow, a_tr_sca, ok_debug_autoconversion
-
+USE lscp_ini_mod, ONLY : seuil_neb, niter_lscp, iflag_evap_prec, t_coup, DDT0, ztfondue, rain_int_min
+USE lscp_ini_mod, ONLY : iflag_mpc_bl, ok_radocond_snow, a_tr_sca, cld_expo_con, cld_expo_lsc
+USE lscp_ini_mod, ONLY : iflag_cloudth_vert, iflag_rain_incloud_vol, iflag_t_glace, t_glace_min 
+USE lscp_ini_mod, ONLY : coef_eva, coef_eva_i,cld_tau_lsc, cld_tau_con, cld_lc_lsc, cld_lc_con
+USE lscp_ini_mod, ONLY : iflag_bergeron, iflag_fisrtilp_qsat, iflag_vice, cice_velo, dice_velo
+USE lscp_ini_mod, ONLY : iflag_autoconversion, ffallv_con, ffallv_lsc
+USE lscp_ini_mod, ONLY : RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RG
 
 IMPLICIT NONE
@@ -101 +108 @@
 ! VARIABLES DECLARATION
 !===============================================================================
-
-include "YOMCST.h"
-include "YOETHF.h"
-include "fisrtilp.h"
-include "nuage.h" 
 
 ! INPUT VARIABLES:
@@ -125 +127 @@
   LOGICAL, DIMENSION(klon,klev),   INTENT(IN)   :: ptconv          ! grid points where deep convection scheme is active
 
-
   !Inputs associated with thermal plumes
 
@@ -133 +134 @@
   REAL, DIMENSION(klon,klev),      INTENT(IN)   :: zpspsk          ! exner potential (p/100000)**(R/cp) 
   REAL, DIMENSION(klon,klev),      INTENT(IN)   :: ztla            ! liquid temperature within thermals [K]
-  REAL, DIMENSION(klon,klev),      INTENT(INOUT)   :: zthl         ! liquid potential temperature [K]
 
   ! INPUT/OUTPUT variables
   !------------------------
-
+  
+  REAL, DIMENSION(klon,klev),      INTENT(INOUT)   :: zthl         ! liquid potential temperature [K]
   REAL, DIMENSION(klon,klev),      INTENT(INOUT):: ratqs            ! function of pressure that sets the large-scale
   REAL, DIMENSION(klon,klev),      INTENT(INOUT):: beta             ! conversion rate of condensed water
@@ -154 +155 @@
   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rneb             ! cloud fraction [-]
   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rneblsvol        ! cloud fraction per unit volume [-]  
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: pfraclr          ! precip fraction clear-sky part [-]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: pfracld          ! precip fraction cloudy part [-]
   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: radocond         ! condensed water used in the radiation scheme [kg/kg]
   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: radicefrac       ! ice fraction of condensed water for radiation scheme
@@ -163 +166 @@
   REAL, DIMENSION(klon,klev+1),    INTENT(OUT)  :: prfl             ! large-scale rainfall flux in the column [kg/s/m2]
   REAL, DIMENSION(klon,klev+1),    INTENT(OUT)  :: psfl             ! large-scale snowfall flux in the column [kg/s/m2]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: distcltop        ! distance to cloud top [m]
 
   ! fraction of aerosol scavenging through impaction and nucleation (for on-line)
@@ -189 +193 @@
 
   REAL qsl(klon), qsi(klon)
-  REAL zct, zcl
+  REAL zct, zcl,zexpo
   REAL ctot(klon,klev)
   REAL ctot_vol(klon,klev)
@@ -231 +235 @@
   REAL tot_zneb(klon), tot_znebn(klon), d_tot_zneb(klon)
   REAL d_znebprecip_clr_cld(klon), d_znebprecip_cld_clr(klon)
-  REAL velo(klon,klev), vr
+  REAL velo(klon,klev), vr, ffallv
   REAL qlmpc, qimpc, rnebmpc
   REAL radocondi(klon,klev), radocondl(klon,klev)
+  REAL effective_zneb
+  REAL distcltop1D(klon)
+
 
   INTEGER i, k, n, kk
@@ -255 +262 @@
 
 ! Few initial checks
-
-IF (iflag_t_glace.EQ.0) THEN
-    abort_message = 'lscp cannot be used if iflag_t_glace=0'
-    CALL abort_physic(modname,abort_message,1)
-ENDIF
-
-IF (.NOT.((iflag_ice_thermo .EQ. 1).OR.(iflag_ice_thermo .GE. 3))) THEN
-    abort_message = 'lscp cannot be used without ice thermodynamics'
-    CALL abort_physic(modname,abort_message,1)
-ENDIF
 
 IF (iflag_fisrtilp_qsat .LT. 0) THEN
@@ -297 +294 @@
 d_qi(:,:) = 0.0
 rneb(:,:) = 0.0
+pfraclr(:,:)=0.0
+pfracld(:,:)=0.0
 radocond(:,:) = 0.0
 radicefrac(:,:) = 0.0
@@ -320 +319 @@
 d_tot_zneb(:) = 0.0
 qzero(:) = 0.0
+distcltop1D(:)=0.0
 
 !--ice supersaturation
@@ -415 +415 @@
             IF (zrfl(i)+zifl(i).GT.0.) THEN
 
-            ! LudoTP: we only account for precipitation evaporation in the clear-sky (iflag_evap_prec=4).
+            ! LudoTP: we only account for precipitation evaporation in the clear-sky (iflag_evap_prec>=4).
             ! c_iso: likely important to distinguish cs from neb isotope precipitation
 
-                IF (iflag_evap_prec.EQ.4) THEN
+                IF (iflag_evap_prec.GE.4) THEN
                     zrfl(i) = zrflclr(i)
                     zifl(i) = ziflclr(i)
@@ -429 +429 @@
                 ENDIF
 
-                IF (iflag_evap_prec.EQ.4) THEN
+                IF (iflag_evap_prec.GT.4) THEN
+                ! Max evaporation not to saturate the clear sky precip fraction
+                ! i.e. the fraction where evaporation occurs
+                    zqev0 = MAX(0.0, (zqs(i)-zq(i))*znebprecipclr(i))
+                ELSEIF (iflag_evap_prec .EQ. 4) THEN
                 ! Max evaporation not to saturate the whole mesh
+                ! Pay attention -> lead to unrealistic and excessive evaporation
                     zqev0 = MAX(0.0, zqs(i)-zq(i))
                 ELSE
@@ -440 +445 @@
                 ! dP/dz=beta*(1-q/qsat)*sqrt(P)
                 ! formula from Sundquist 1988, Klemp & Wilhemson 1978
-                ! LTP: evaporation only in the clear sky part (iflag_evap_prec=4)
+                ! LTP: evaporation only in the clear sky part (iflag_evap_prec>=4)
 
                 IF (iflag_evap_prec.EQ.3) THEN
@@ -446 +451 @@
                     *SQRT(zrfl(i)/max(1.e-4,znebprecip(i)))        &
                     *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-                ELSE IF (iflag_evap_prec.EQ.4) THEN
+                ELSE IF (iflag_evap_prec.GE.4) THEN
                      zqevt = znebprecipclr(i)*coef_eva*(1.0-zq(i)/qsl(i)) &
                     *SQRT(zrfl(i)/max(1.e-8,znebprecipclr(i))) &
@@ -463 +468 @@
                     *SQRT(zifl(i)/max(1.e-4,znebprecip(i))) &
                     *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-                ELSE IF (iflag_evap_prec.EQ.4) THEN
+                ELSE IF (iflag_evap_prec.GE.4) THEN
                      zqevti = znebprecipclr(i)*coef_eva_i*(1.0-zq(i)/qsi(i)) &
                     *SQRT(zifl(i)/max(1.e-8,znebprecipclr(i))) &
@@ -518 +523 @@
                                            
 
-                IF (iflag_evap_prec.EQ.4) THEN
+                IF (iflag_evap_prec.GE.4) THEN
                     zrflclr(i) = zrfl(i)
                     ziflclr(i) = zifl(i)
@@ -536 +541 @@
 
                 ! update of rainfall and snowfall due to melting
-                IF (iflag_evap_prec.EQ.4) THEN
+                IF (iflag_evap_prec.GE.4) THEN
                     zrflclr(i)=zrflclr(i)+zmelt*ziflclr(i)
                     zrflcld(i)=zrflcld(i)+zmelt*ziflcld(i)
@@ -721 +726 @@
                   ! saturation may occur at a humidity different from qsat (gamma qsat), so gamma correction for dqs
                   zdqs(:) = gammasat(:)*zdqs(:)+zqs(:)*dgammasatdt(:)
-                  CALL icefrac_lscp(klon, zt(:),pplay(:,k)/paprs(:,1),zfice(:),dzfice(:))
+                  ! cloud phase determination
+                  IF (iflag_t_glace.GE.4) THEN
+                  ! For iflag_t_glace GE 4 the phase partition function dependends on temperature AND distance to cloud top
+                       CALL distance_to_cloud_top(klon,klev,k,t,pplay,paprs,rneb,distcltop1D)
+                  ENDIF
+                  CALL icefrac_lscp(klon, zt(:), iflag_ice_thermo, distcltop1D(:),zfice(:),dzfice(:))
 
                   DO i=1,klon !todoan : check if loop in i is needed
@@ -809 +819 @@
         !   zcond: mean condensed water in the mesh
         !   zqn  : mean water vapor in the mesh
+        !   zfice: ice fraction in clouds
         !   zt   : temperature
         !   rhcl : clear-sky relative humidity
         ! ----------------------------------------------------------------
 
+
+        ! For iflag_t_glace GE 4 the phase partition function dependends on temperature AND distance to cloud top
+        IF (iflag_t_glace.GE.4) THEN
+            CALL distance_to_cloud_top(klon,klev,k,t,pplay,paprs,rneb,distcltop1D)
+            distcltop(:,k)=distcltop1D(:)
+        ENDIF   
+
+        ! Partition function in stratiform clouds (will be overwritten in boundary-layer MPCs)
+        CALL icefrac_lscp(klon,zt(:),iflag_ice_thermo,distcltop1D(:),zfice(:), dzfice(:))
+
+
         ! Water vapor update, Phase determination and subsequent latent heat exchange
-
-        ! Partition function in stratiform clouds (will be overwritten in boundary-layer MPCs)
-        CALL icefrac_lscp(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:), dzfice(:))
-
         DO i=1, klon
-
 
             IF (mpc_bl_points(i,k) .GT. 0) THEN
@@ -873 +890 @@
 
     ! LTP:
-    IF (iflag_evap_prec==4) THEN
+    IF (iflag_evap_prec .GE. 4) THEN
 
         !Partitionning between precipitation coming from clouds and that coming from CS
@@ -919 +936 @@
     ENDIF
 
+
+    ! Autoconversion
+    ! -------------------------------------------------------------------------------
+
+
     ! Initialisation of zoliq and radocond variables
 
@@ -930 +952 @@
             iwc(i)   = 0. 
             zneb(i)  = MAX(rneb(i,k),seuil_neb)
-            radocond(i,k) = zoliq(i)/REAL(ninter+1)
+            radocond(i,k) = zoliq(i)/REAL(niter_lscp+1)
             radicefrac(i,k) = zfice(i)
-            radocondi(i,k)=zoliq(i)*zfice(i)/REAL(ninter+1)
-            radocondl(i,k)=zoliq(i)*(1.-zfice(i))/REAL(ninter+1)
+            radocondi(i,k)=zoliq(i)*zfice(i)/REAL(niter_lscp+1)
+            radocondl(i,k)=zoliq(i)*(1.-zfice(i))/REAL(niter_lscp+1)
     ENDDO
 
-    ! Autoconversion
-    ! -------------------------------------------------------------------------------
-     
-    DO n = 1, ninter
+       
+    DO n = 1, niter_lscp
 
         DO i=1,klon
@@ -965 +985 @@
                 ELSE
 
-                    IF (ok_debug_autoconversion) THEN ! if condition to be removed after test phase
-
-                    ! water quantity to remove: zchau (Sundqvist, 1978)
-                    ! same thing for the ice: zfroi (Zender & Kiehl, 1997)
                     IF (ptconv(i,k)) THEN ! if convective point
                         zcl=cld_lc_con
                         zct=1./cld_tau_con
-                        zfroi = dtime/REAL(ninter)/zdz(i)*zoliqi(i)*velo(i,k)
+                        zexpo=cld_expo_con
+                        ffallv=ffallv_con
                     ELSE
                         zcl=cld_lc_lsc
                         zct=1./cld_tau_lsc
-                        zfroi = dtime/REAL(ninter)/zdz(i)*zoliqi(i) &   ! dqice/dt=1/rho*d(rho*wice*qice)/dz
-                            *velo(i,k)
+                        zexpo=cld_expo_lsc
+                        ffallv=ffallv_lsc
                     ENDIF
+
 
                     ! if vertical heterogeneity is taken into account, we use
@@ -985 +1003 @@
                     ! reduces the in-cloud water).
 
+                    ! Liquid water quantity to remove: zchau (Sundqvist, 1978)
+                    ! dqliq/dt=-qliq/tau*(1-exp(-qcin/clw)**2)
+                    !.........................................................
                     IF ((iflag_cloudth_vert.GE.3).AND.(iflag_rain_incloud_vol.EQ.1)) THEN
-                        zchau = zct   *dtime/REAL(ninter) * zoliql(i) &
-                        *(1.0-EXP(-(zoliql(i)/ctot_vol(i,k)/zcl)**2))
-                    ELSE
-                        zchau = zct   *dtime/REAL(ninter) * zoliql(i) &
-                        *(1.0-EXP(-(zoliql(i)/zneb(i)/zcl)**2))        ! dqliq/dt=-qliq/tau*(1-exp(-qcin/clw)**2)
-                    ENDIF
-
-                    ELSE ! with old bug in autoconversion 
-
-                    ! water quantity to remove: zchau (Sundqvist, 1978)
-                    ! same thing for the ice: zfroi (Zender & Kiehl, 1997)
-                    IF (ptconv(i,k)) THEN ! if convective point
-                        zcl=cld_lc_con
-                        zct=1./cld_tau_con
-                        zfroi = dtime/REAL(ninter)/zdz(i)*zoliq(i)*velo(i,k)*zfice(i)
-                    ELSE
-                        zcl=cld_lc_lsc
-                        zct=1./cld_tau_lsc
-                        zfroi = dtime/REAL(ninter)/zdz(i)*zoliq(i) &   ! dqice/dt=1/rho*d(rho*wice*qice)/dz
-                            *velo(i,k) * zfice(i)
-                    ENDIF
 
                     ! if vertical heterogeneity is taken into account, we use
@@ -1012 +1012 @@
                     ! surface fraction (which is larger and artificially
                     ! reduces the in-cloud water).
-
-
-                    IF ((iflag_cloudth_vert.GE.3).AND.(iflag_rain_incloud_vol.EQ.1)) THEN
-                        zchau = zct   *dtime/REAL(ninter) * zoliq(i) &
-                        *(1.0-EXP(-(zoliq(i)/ctot_vol(i,k)/zcl)**2)) *(1.-zfice(i))
+                        effective_zneb=ctot_vol(i,k)
                     ELSE
-                        zchau = zct   *dtime/REAL(ninter) * zoliq(i) &
-                        *(1.0-EXP(-(zoliq(i)/zneb(i)/zcl)**2)) *(1.-zfice(i)) ! dqliq/dt=-qliq/tau*(1-exp(-qcin/clw)**2)
+                        effective_zneb=zneb(i)
+                    ENDIF 
+
+
+                    IF (iflag_autoconversion .EQ. 2) THEN
+                    ! two-steps resolution with niter_lscp=1 sufficient
+                    ! we first treat the second term (with exponential) in an explicit way
+                    ! and then treat the first term (-q/tau) in an exact way
+                        zchau=zoliql(i)*(1.-exp(-dtime/REAL(niter_lscp)*zct &
+                        *(1.-exp(-(zoliql(i)/effective_zneb/zcl)**zexpo))))
+                    ELSE
+                    ! old explicit resolution with subtimesteps
+                        zchau = zct*dtime/REAL(niter_lscp)*zoliql(i) &
+                        *(1.0-EXP(-(zoliql(i)/effective_zneb/zcl)**zexpo))
                     ENDIF
 
-                    ENDIF ! ok_debug_autoconversion
+
+                    ! Ice water quantity to remove (Zender & Kiehl, 1997)
+                    ! dqice/dt=1/rho*d(rho*wice*qice)/dz
+                    !....................................
+                    IF (iflag_autoconversion .EQ. 2) THEN
+                    ! exact resolution, niter_lscp=1 is sufficient but works only
+                    ! with iflag_vice=0
+                       IF (zoliqi(i) .GT. 0.) THEN
+                          zfroi=(zoliqi(i)-((zoliqi(i)**(-dice_velo)) & 
+                          +dice_velo*dtime/REAL(niter_lscp)*cice_velo/zdz(i)*ffallv)**(-1./dice_velo))
+                       ELSE
+                          zfroi=0.
+                       ENDIF
+                    ELSE
+                    ! old explicit resolution with subtimesteps
+                       zfroi = dtime/REAL(niter_lscp)/zdz(i)*zoliqi(i)*velo(i,k) 
+                    ENDIF
 
                     zrain   = MIN(MAX(zchau,0.0),zoliql(i))
@@ -1030 +1054 @@
                 ENDIF
 
-                zoliql(i) = MAX(zoliq(i)*(1.-zfice(i))-1.*zrain  , 0.0)
-                zoliqi(i) = MAX(zoliq(i)*zfice(i)-1.*zsnow  , 0.0)
-                zoliq(i)  = MAX(zoliq(i)-zprecip , 0.0)
+                IF (iflag_autoconversion .GE. 1) THEN
+                   ! debugged version with phase conservation through the autoconversion process
+                   zoliql(i) = MAX(zoliql(i)-1.*zrain  , 0.0)
+                   zoliqi(i) = MAX(zoliqi(i)-1.*zsnow  , 0.0)
+                   zoliq(i)  = MAX(zoliq(i)-zprecip , 0.0)
+                ELSE
+                   ! bugged version with phase resetting
+                   zoliql(i) = MAX(zoliq(i)*(1.-zfice(i))-1.*zrain  , 0.0)
+                   zoliqi(i) = MAX(zoliq(i)*zfice(i)-1.*zsnow  , 0.0)
+                   zoliq(i)  = MAX(zoliq(i)-zprecip , 0.0)
+                ENDIF
 
                 ! c_iso: call isotope_conversion (for readibility) or duplicate 
 
-                radocond(i,k) = radocond(i,k) + zoliq(i)/REAL(ninter+1)
-                radocondl(i,k) = radocondl(i,k) + zoliql(i)/REAL(ninter+1)
-                radocondi(i,k) = radocondi(i,k) + zoliqi(i)/REAL(ninter+1)
+                radocond(i,k) = radocond(i,k) + zoliq(i)/REAL(niter_lscp+1)
+                radocondl(i,k) = radocondl(i,k) + zoliql(i)/REAL(niter_lscp+1)
+                radocondi(i,k) = radocondi(i,k) + zoliqi(i)/REAL(niter_lscp+1)
 
             ENDIF ! rneb >0
@@ -1050 +1082 @@
     DO i = 1, klon
             
-            IF (iflag_evap_prec.EQ.4) THEN
+            IF (iflag_evap_prec.GE.4) THEN
                 ziflprev(i)=ziflcld(i)
             ELSE
@@ -1092 +1124 @@
                     ! c_iso : mv here condensation of isotopes + redispatchage en precip 
 
-                IF (iflag_evap_prec.EQ.4) THEN
+                IF (iflag_evap_prec.GE.4) THEN
                     zrflcld(i) = zrflcld(i)+zqprecl(i) &
                     *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
@@ -1113 +1145 @@
 
     ! LTP: limit of surface cloud fraction covered by precipitation when the local intensity of the flux is below rain_int_min
-    ! if iflag_evap_pre=4
-    IF (iflag_evap_prec.EQ.4) THEN
+    ! if iflag_evap_prec>=4
+    IF (iflag_evap_prec.GE.4) THEN
 
         DO i=1,klon
@@ -1134 +1166 @@
         ENDDO
 
+
     ENDIF
 
@@ -1141 +1174 @@
     ! Outputs:
     ! Precipitation fluxes at layer interfaces
-    ! and temperature and water species tendencies
+    ! + precipitation fractions +
+    ! temperature and water species tendencies
     DO i = 1, klon
         psfl(i,k)=zifl(i) 
         prfl(i,k)=zrfl(i)
+        pfraclr(i,k)=znebprecipclr(i)
+        pfracld(i,k)=znebprecipcld(i)
         d_ql(i,k) = (1-zfice(i))*zoliq(i)
         d_qi(i,k) = zfice(i)*zoliq(i)

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/lscp_tools_mod.F90

@@ -16 +16 @@
     ! 3212–3234. https://doi.org/10.1029/2019MS001642
     
-    
+    use lscp_ini_mod, only: iflag_vice, ffallv_con, ffallv_lsc
+    use lscp_ini_mod, only: cice_velo, dice_velo 
+
     IMPLICIT NONE
-
-    INCLUDE "nuage.h"
-    INCLUDE "fisrtilp.h"
 
     INTEGER, INTENT(IN) :: klon
@@ -33 +32 @@
 
     INTEGER i
-    REAL logvm,iwcg,tempc,phpa,cvel,dvel,fallv_tun
+    REAL logvm,iwcg,tempc,phpa,fallv_tun
     REAL m2ice, m2snow, vmice, vmsnow
     REAL aice, bice, asnow, bsnow
@@ -62 +61 @@
         
         velo(i)=fallv_tun*velo(i)/100.0 ! from cm/s to m/s
-        dvel=0.2
-        cvel=fallv_tun*65.0*(rho(i)**0.2)*(150./phpa)**0.15
 
     ELSE IF (iflag_vice .EQ. 2) THEN
@@ -94 +91 @@
         vmsnow=vmsnow*((1000./phpa)**0.35)
         velo(i)=fallv_tun*min(vmsnow,vmice)/100. ! to m/s
-        dvel=0.2
-        cvel=velo(i)/((iwcg/1000.*rho(i))**dvel)
 
     ELSE
         ! By default, fallspeed velocity of ice crystals according to Heymsfield & Donner 1990
-        velo(i) = fallv_tun*3.29/2.0*((iwcg/1000.)**0.16)
-        dvel=0.16
-        cvel=fallv_tun*3.29/2.0*(rho(i)**0.16)
+        velo(i) = fallv_tun*cice_velo*((iwcg/1000.)**dice_velo)
     ENDIF
     ENDDO
@@ -109 +102 @@
 
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-SUBROUTINE ICEFRAC_LSCP(klon, temp, sig, icefrac, dicefracdT)
+SUBROUTINE ICEFRAC_LSCP(klon, temp, iflag_ice_thermo, distcltop, icefrac, dicefracdT)
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   
@@ -120 +113 @@
 
     USE print_control_mod, ONLY: lunout, prt_level
+    USE lscp_ini_mod, ONLY: t_glace_min, t_glace_max, exposant_glace, iflag_t_glace
+    USE lscp_ini_mod, ONLY : RTT, dist_liq
 
     IMPLICIT NONE
 
-
-    INCLUDE "YOMCST.h"
-    INCLUDE "nuage.h"
-    INCLUDE "clesphys.h"
-
-
-  ! nuage.h contains:
-  ! t_glace_min: if T < Tmin, the cloud is only made of water ice
-  ! t_glace_max: if T > Tmax, the cloud is only made of liquid water
-  ! exposant_glace: controls the sharpness of the transition
 
     INTEGER, INTENT(IN)                 :: klon       ! number of horizontal grid points
     REAL, INTENT(IN), DIMENSION(klon)   :: temp       ! temperature
-    REAL, INTENT(IN), DIMENSION(klon)   :: sig
+    REAL, INTENT(IN), DIMENSION(klon)   :: distcltop       ! distance to cloud top
+    INTEGER, INTENT(IN)                 :: iflag_ice_thermo
     REAL, INTENT(OUT), DIMENSION(klon)  :: icefrac
     REAL, INTENT(OUT), DIMENSION(klon)  :: dicefracdT
@@ -142 +128 @@
 
     INTEGER i
-    REAL    sig0,www,tmin_tmp,liqfrac_tmp
+    REAL    liqfrac_tmp, dicefrac_tmp
     REAL    Dv, denomdep,beta,qsi,dqsidt
-    INTEGER exposant_glace_old
-    REAL t_glace_min_old
     LOGICAL ice_thermo
 
-    sig0=0.8
-    t_glace_min_old = RTT - 15.0
-    ice_thermo = (iflag_ice_thermo .EQ. 1).OR.(iflag_ice_thermo .GE. 3)
-    IF (ice_thermo) THEN
-      exposant_glace_old = 2
-    ELSE
-      exposant_glace_old = 6
+    CHARACTER (len = 20) :: modname = 'lscp_tools'
+    CHARACTER (len = 80) :: abort_message
+
+    IF ((iflag_t_glace.LT.2) .OR. (iflag_t_glace.GT.6)) THEN
+       abort_message = 'lscp cannot be used if iflag_t_glace<2 or >6'
+       CALL abort_physic(modname,abort_message,1)
     ENDIF
 
-
-! calculation of icefrac and dicefrac/dT
+    IF (.NOT.((iflag_ice_thermo .EQ. 1).OR.(iflag_ice_thermo .GE. 3))) THEN
+       abort_message = 'lscp cannot be used without ice thermodynamics'
+       CALL abort_physic(modname,abort_message,1)
+    ENDIF
+
 
     DO i=1,klon
-
-    IF (iflag_t_glace.EQ.1) THEN
-            ! Transition to ice close to surface for T<Tmax
-            ! w=1 at the surface and 0 for sig < sig0
-            www=(max(sig(i)-sig0,0.))/(1.-sig0)
-    ELSEIF (iflag_t_glace.GE.2) THEN
-            ! No convertion to ice close to surface
-            www = 0.
-    ENDIF
-     
-    tmin_tmp=www*t_glace_max+(1.-www)*t_glace_min
-    liqfrac_tmp=  (temp(i)-tmin_tmp) / (t_glace_max-tmin_tmp)
-    liqfrac_tmp = MIN(MAX(liqfrac_tmp,0.0),1.0)
-       
-    IF (iflag_t_glace.GE.3) THEN
-            icefrac(i) = 1.0-liqfrac_tmp**exposant_glace
-            IF ((icefrac(i) .GT.0.) .AND. (liqfrac_tmp .GT. 0)) THEN
-                 dicefracdT(i)= exposant_glace * ((liqfrac_tmp)**(exposant_glace-1.)) &
-                           / (t_glace_min - t_glace_max)
-            ELSE
-
-                 dicefracdT(i)=0.
-            ENDIF
-
-    ELSE
+ 
+        ! old function with sole dependence upon temperature
+        IF (iflag_t_glace .EQ. 2) THEN
+            liqfrac_tmp = (temp(i)-t_glace_min) / (t_glace_max-t_glace_min)
+            liqfrac_tmp = MIN(MAX(liqfrac_tmp,0.0),1.0)
             icefrac(i) = (1.0-liqfrac_tmp)**exposant_glace
             IF (icefrac(i) .GT.0.) THEN
@@ -196 +162 @@
             ENDIF
 
-    ENDIF
-    
-    ENDDO
-
-
-    RETURN
-
+        ENDIF
+
+        ! function of temperature used in CMIP6 physics
+        IF (iflag_t_glace .EQ. 3) THEN
+            liqfrac_tmp = (temp(i)-t_glace_min) / (t_glace_max-t_glace_min)
+            liqfrac_tmp = MIN(MAX(liqfrac_tmp,0.0),1.0)
+            icefrac(i) = 1.0-liqfrac_tmp**exposant_glace
+            IF ((icefrac(i) .GT.0.) .AND. (liqfrac_tmp .GT. 0.)) THEN
+                dicefracdT(i)= exposant_glace * ((liqfrac_tmp)**(exposant_glace-1.)) &
+                          / (t_glace_min - t_glace_max)
+            ELSE
+                dicefracdT(i)=0.
+            ENDIF
+        ENDIF
+
+        ! for iflag_t_glace .GE. 4, the liquid fraction depends upon temperature at cloud top
+        ! and then decreases with decreasing height 
+
+        !with linear function of temperature at cloud top
+        IF (iflag_t_glace .EQ. 4) THEN  
+                liqfrac_tmp = (temp(i)-t_glace_min) / (t_glace_max-t_glace_min)
+                liqfrac_tmp = MIN(MAX(liqfrac_tmp,0.0),1.0)
+                icefrac(i)    =  MAX(MIN(1.,1.0 - liqfrac_tmp*exp(-distcltop(i)/dist_liq)),0.)
+                dicefrac_tmp = - temp(i)/(t_glace_max-t_glace_min)
+                dicefracdT(i) = dicefrac_tmp*exp(-distcltop(i)/dist_liq)
+                IF ((liqfrac_tmp .LE.0) .OR. (liqfrac_tmp .GE. 1)) THEN
+                        dicefracdT(i) = 0.
+                ENDIF
+        ENDIF
+
+        ! with CMIP6 function of temperature at cloud top
+        IF (iflag_t_glace .EQ. 5) THEN 
+                liqfrac_tmp = (temp(i)-t_glace_min) / (t_glace_max-t_glace_min)
+                liqfrac_tmp =  MIN(MAX(liqfrac_tmp,0.0),1.0)
+                liqfrac_tmp = liqfrac_tmp**exposant_glace
+                icefrac(i)  =  MAX(MIN(1.,1.0 - liqfrac_tmp*exp(-distcltop(i)/dist_liq)),0.)
+                IF ((liqfrac_tmp .LE.0) .OR. (liqfrac_tmp .GE. 1)) THEN
+                        dicefracdT(i) = 0.
+                ELSE
+                        dicefracdT(i) = exposant_glace*((liqfrac_tmp)**(exposant_glace-1.))/(t_glace_min- t_glace_max) &
+                                        *exp(-distcltop(i)/dist_liq)
+                ENDIF
+        ENDIF
+
+        ! with modified function of temperature at cloud top 
+        ! to get largere values around 260 K, works well with t_glace_min = 241K
+        IF (iflag_t_glace .EQ. 6) THEN 
+                IF (temp(i) .GT. t_glace_max) THEN
+                        liqfrac_tmp = 1.
+                ELSE
+                        liqfrac_tmp = -((temp(i)-t_glace_max) / (t_glace_max-t_glace_min))**2+1.
+                ENDIF
+                liqfrac_tmp  = MIN(MAX(liqfrac_tmp,0.0),1.0)
+                icefrac(i)   = MAX(MIN(1.,1.0 - liqfrac_tmp*exp(-distcltop(i)/dist_liq)),0.)        
+                IF ((liqfrac_tmp .LE.0) .OR. (liqfrac_tmp .GE. 1)) THEN
+                        dicefracdT(i) = 0.
+                ELSE
+                        dicefracdT(i) = 2*((temp(i)-t_glace_max) / (t_glace_max-t_glace_min))/(t_glace_max-t_glace_min) &
+                                  *exp(-distcltop(i)/dist_liq)
+                ENDIF
+        ENDIF
+
+
+
+     ENDDO ! klon
+ 
+     RETURN
+ 
 END SUBROUTINE ICEFRAC_LSCP
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@@ -276 +303 @@
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
+    use lscp_ini_mod, only: iflag_gammasat, t_glace_min, RTT
 
     IMPLICIT NONE
 
-    include "YOMCST.h"
-    include "YOETHF.h"
-    include "FCTTRE.h"
-    include "nuage.h" 
 
     INTEGER, INTENT(IN) :: klon                       ! number of horizontal grid points
@@ -348 +372 @@
 
 END SUBROUTINE CALC_GAMMASAT
-
-
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+SUBROUTINE DISTANCE_TO_CLOUD_TOP(klon,klev,k,temp,pplay,paprs,rneb,distcltop1D)
+!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+   
+   USE lscp_ini_mod, ONLY : rd,rg,tresh_cl
+
+   IMPLICIT NONE
+   
+   INTEGER, INTENT(IN) :: klon,klev                !number of horizontal and vertical grid points
+   INTEGER, INTENT(IN) :: k                        ! vertical index
+   REAL, INTENT(IN), DIMENSION(klon,klev) :: temp  ! temperature in K
+   REAL, INTENT(IN), DIMENSION(klon,klev) :: pplay ! pressure middle layer in Pa
+   REAL, INTENT(IN), DIMENSION(klon,klev+1) :: paprs ! pressure interfaces in Pa
+   REAL, INTENT(IN), DIMENSION(klon,klev) :: rneb  ! cloud fraction
+
+   REAL, INTENT(OUT), DIMENSION(klon) :: distcltop1D  ! distance from cloud top
+
+   REAL dzlay(klon,klev)
+   REAL zlay(klon,klev)
+   REAL dzinterf
+   INTEGER i,k_top, kvert
+   LOGICAL bool_cl
+
+
+   DO i=1,klon
+         ! Initialization height middle of first layer
+          dzlay(i,1) = Rd * temp(i,1) / rg * log(paprs(i,1)/paprs(i,2))
+          zlay(i,1) = dzlay(i,1)/2
+
+          DO kvert=2,klev
+                 IF (kvert.EQ.klev) THEN
+                       dzlay(i,kvert) = 2*(rd * temp(i,kvert) / rg * log(paprs(i,kvert)/pplay(i,kvert)))
+                 ELSE
+                       dzlay(i,kvert) = rd * temp(i,kvert) / rg * log(paprs(i,kvert)/paprs(i,kvert+1))
+                 ENDIF
+                       dzinterf       = rd * temp(i,kvert) / rg * log(pplay(i,kvert-1)/pplay(i,kvert))
+                       zlay(i,kvert)  = zlay(i,kvert-1) + dzinterf
+           ENDDO
+   ENDDO
+   
+   k_top = k
+   DO i=1,klon
+          IF (rneb(i,k) .LE. tresh_cl) THEN
+                 bool_cl = .FALSE.
+          ELSE
+                 bool_cl = .TRUE.
+          ENDIF
+
+          DO WHILE ((bool_cl) .AND. (k_top .LE. klev))
+          ! find cloud top
+                IF (rneb(i,k_top) .GT. tresh_cl) THEN
+                      k_top = k_top + 1
+                ELSE
+                      bool_cl = .FALSE.
+                      k_top   = k_top - 1
+                ENDIF
+          ENDDO
+          k_top=min(k_top,klev)
+
+          !dist to top is dist between current layer and layer of cloud top (from middle to middle) + dist middle to
+          !interf for layer of cloud top
+          distcltop1D(i) = zlay(i,k_top) - zlay(i,k) + dzlay(i,k_top)/2
+   ENDDO ! klon
+
+END SUBROUTINE DISTANCE_TO_CLOUD_TOP
 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/newmicro.F90

@@ -3 +3 @@
 SUBROUTINE newmicro(flag_aerosol, ok_cdnc, bl95_b0, bl95_b1, paprs, pplay, t, pqlwp, picefra, pclc, &
     pcltau, pclemi, pch, pcl, pcm, pct, pctlwp, xflwp, xfiwp, xflwc, xfiwc, &
-    mass_solu_aero, mass_solu_aero_pi, pcldtaupi, latitude_deg,re, fl, reliq, reice, &
+    mass_solu_aero, mass_solu_aero_pi, pcldtaupi, latitude_deg,distcltop, re, fl, reliq, reice, &
     reliq_pi, reice_pi)
 
@@ -12 +12 @@
   USE phys_state_var_mod, ONLY: rnebcon, clwcon
   USE icefrac_lsc_mod ! computes ice fraction (JBM 3/14)
+  USE lscp_ini_mod, only: iflag_t_glace
   USE ioipsl_getin_p_mod, ONLY : getin_p
   USE print_control_mod, ONLY: lunout
@@ -41 +42 @@
   ! bl95_b1-input-R-a PARAMETER, may be varied for tests (    -"-      )
   ! latitude_deg-input latitude in degrees
+  ! distcltop ---input- distance from cloud top
 
   ! re------output-R-Cloud droplet effective radius multiplied by fl [um]
@@ -97 +99 @@
   REAL pctlwp(klon)
 
+  REAL distcltop(klon,klev)
   LOGICAL lo
 
@@ -241 +244 @@
 
       IF (ok_new_lscp) THEN
-          CALL icefrac_lscp(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:,k),dzfice(:,k))
+          CALL icefrac_lscp(klon,t(:,k),iflag_ice_thermo,distcltop(:,k),zfice(:,k),dzfice(:,k))
       ELSE
           CALL icefrac_lsc(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:,k))

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/nuage.F90

@@ -2 +2 @@
 
 SUBROUTINE nuage(paprs, pplay, t, pqlwp,picefra, pclc, pcltau, pclemi, pch, pcl, pcm, &
-    pct, pctlwp, ok_aie, mass_solu_aero, mass_solu_aero_pi, bl95_b0, bl95_b1, &
+    pct, pctlwp, ok_aie, mass_solu_aero, mass_solu_aero_pi, bl95_b0, bl95_b1, distcltop, &
     cldtaupi, re, fl)
   USE dimphy
   USE lscp_tools_mod, only: icefrac_lscp
   USE icefrac_lsc_mod ! computes ice fraction (JBM 3/14)
+  USE lscp_ini_mod, only : iflag_t_glace
   USE phys_local_var_mod, ONLY: ptconv
   IMPLICIT NONE
@@ -49 +50 @@
 
   REAL pct(klon), pctlwp(klon), pch(klon), pcl(klon), pcm(klon)
-
+  REAL distcltop(klon,klev)
   LOGICAL lo
 
@@ -112 +113 @@
 !                           t_glace_max, exposant_glace)
         IF (ok_new_lscp) THEN
-            CALL icefrac_lscp(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:),dzfice(:))
+            CALL icefrac_lscp(klon,t(:,k),iflag_ice_thermo,distcltop(:,k),zfice(:),dzfice(:))
         ELSE
             CALL icefrac_lsc(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:))

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/nuage.h

@@ -2 +2 @@
 ! $Id$
 !
-      REAL rad_froid, rad_chau1, rad_chau2, t_glace_max, t_glace_min
-      REAL exposant_glace
+      REAL rad_froid, rad_chau1, rad_chau2
       REAL rei_min,rei_max
       REAL tau_cld_cv,coefw_cld_cv
-
       REAL tmax_fonte_cv
-
-      INTEGER iflag_t_glace, iflag_cloudth_vert, iflag_cld_cv
-      INTEGER iflag_rain_incloud_vol
-   
-      INTEGER iflag_gammasat, iflag_vice, iflag_rei
+      INTEGER iflag_cld_cv
+      INTEGER iflag_rei
       LOGICAL ok_icefra_lscp
 
-      common /nuagecom/ rad_froid,rad_chau1, rad_chau2,t_glace_max,     &
-     &                  t_glace_min,exposant_glace,rei_min,rei_max,     &
+      common /nuagecom/ rad_froid,rad_chau1, rad_chau2,                 &
+     &                  rei_min,rei_max,                                &
      &                  tau_cld_cv,coefw_cld_cv,                        &
      &                  tmax_fonte_cv,                                  &
-     &                  iflag_t_glace,iflag_cloudth_vert,iflag_cld_cv,  &
-     &                  iflag_rain_incloud_vol,                         &
-     &                  ok_icefra_lscp,                  &
-     &                  iflag_gammasat, iflag_vice,       &
+     &                  iflag_cld_cv,                                   &
+     &                  ok_icefra_lscp,                                 &
      &                  iflag_rei    
 !$OMP THREADPRIVATE(/nuagecom/)

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/ocean_forced_mod.F90

@@ -167 +167 @@
   SUBROUTINE ocean_forced_ice( &
        itime, dtime, jour, knon, knindex, &
-       tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
+       tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air,spechum, &
        AcoefH, AcoefQ, BcoefH, BcoefQ, &
        AcoefU, AcoefV, BcoefU, BcoefV, &

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

@@ -21 +21 @@
   USE cpl_mod,             ONLY : gath2cpl
   USE climb_hq_mod,        ONLY : climb_hq_down, climb_hq_up
+  USE climb_qbs_mod,       ONLY : climb_qbs_down, climb_qbs_up
   USE climb_wind_mod,      ONLY : climb_wind_down, climb_wind_up
   USE coef_diff_turb_mod,  ONLY : coef_diff_turb
-  USE atke_exchange_coeff_mod, ONLY :  atke_compute_km_kh
+  USE call_atke_mod,       ONLY :  call_atke
   USE ioipsl_getin_p_mod,  ONLY : getin_p
   USE cdrag_mod
@@ -184 +185 @@
        rlon,      rlat,      rugoro,   rmu0,          &
        lwdown_m,  cldt,          &
-       rain_f,    snow_f,    solsw_m,  solswfdiff_m, sollw_m,       &
+       rain_f,    snow_f,    bs_f, solsw_m,  solswfdiff_m, sollw_m,       &
        gustiness,                                     &
-       t,         q,         u,        v,             &
+       t,         q,        qbs,  u,        v,             &
 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
 !!       t_x,       q_x,       t_w,      q_w,           &
@@ -198 +199 @@
        beta, &
 !>jyg
-       alb_dir_m,    alb_dif_m,  zxsens,   zxevap,    &
+       alb_dir_m,    alb_dif_m,  zxsens,   zxevap,  zxsnowerosion,  &
        alb3_lic,  runoff,    snowhgt,   qsnow,     to_ice,    sissnow,  &
        zxtsol,    zxfluxlat, zt2m,     qsat2m, zn2mout, &
-       d_t,       d_q,       d_u,      d_v, d_t_diss, & 
+       d_t,       d_q,    d_qbs,    d_u,      d_v, d_t_diss, & 
 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
        d_t_w,     d_q_w,                              &
@@ -224 +225 @@
        rh2m,      zxfluxu,  zxfluxv,               &
        z0m, z0h,   agesno,  sollw,    solsw,         &
-       d_ts,      evap,    fluxlat,  t2m,           &
+       d_ts,      evap,    fluxlat,   t2m,           &
        wfbils,    wfbilo, wfevap, wfrain, wfsnow,   & 
        flux_t,   flux_u, flux_v,                    &
@@ -230 +231 @@
 !jyg<
 !!       zxfluxt,   zxfluxq,   q2m,      flux_q, tke,   &
-       zxfluxt,   zxfluxq,   q2m,      flux_q, tke_x,  &
+       zxfluxt,   zxfluxq, zxfluxqbs,   q2m, flux_q, flux_qbs, tke_x,  &
 !>jyg
 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
@@ -317 +318 @@
          dser, dt_ds, zsig, zmea
     use phys_output_var_mod, only: tkt, tks, taur, sss
+    use blowing_snow_ini_mod, only : zeta_bs
 #ifdef CPP_XIOS
     USE wxios, ONLY: missing_val
@@ -351 +353 @@
     REAL, DIMENSION(klon),        INTENT(INOUT)     :: rain_f  ! rain fall
     REAL, DIMENSION(klon),        INTENT(IN)        :: snow_f  ! snow fall
+    REAL, DIMENSION(klon),        INTENT(IN)        :: bs_f  ! blowing 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
@@ -356 +359 @@
     REAL, DIMENSION(klon,klev),   INTENT(IN)        :: t       ! temperature (K)
     REAL, DIMENSION(klon,klev),   INTENT(IN)        :: q       ! water vapour (kg/kg)
+    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: qbs       ! blowing snow specific content (kg/kg)
     REAL, DIMENSION(klon,klev),   INTENT(IN)        :: u       ! u speed
     REAL, DIMENSION(klon,klev),   INTENT(IN)        :: v       ! v speed
@@ -420 +424 @@
                                                                   ! (=> positive sign upwards)
     REAL, DIMENSION(klon),        INTENT(OUT)       :: zxevap     ! water vapour flux at surface, positiv upwards
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxsnowerosion     ! blowing snow flux at surface
     REAL, DIMENSION(klon),        INTENT(OUT)       :: zxtsol     ! temperature at surface, mean for each grid point
 !!! jyg le ???
@@ -436 +441 @@
     REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_u        ! change in u speed
     REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_v        ! change in v speed
+    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_qbs        ! change in blowing snow specific content
+
 
     REAL, INTENT(OUT):: zcoefh(:, :, :) ! (klon, klev, nbsrf + 1)
@@ -495 +502 @@
     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
@@ -517 +524 @@
     REAL, DIMENSION(klon, klev), INTENT(OUT)        :: zxfluxt    ! sensible heat flux, mean for each grid point
     REAL, DIMENSION(klon, klev), INTENT(OUT)        :: zxfluxq    ! water vapour flux, mean for each grid point
+    REAL, DIMENSION(klon, klev), INTENT(OUT)        :: zxfluxqbs    ! blowing snow flux, mean for each grid point
     REAL, DIMENSION(klon, nbsrf),INTENT(OUT)        :: q2m        ! water vapour at 2 meter height
     REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_q     ! water vapour flux(latent flux) (kg/m**2/s)
+    REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_qbs   ! blowind snow vertical flux (kg/m**2
+
 
 ! Martin
@@ -563 +573 @@
     REAL, DIMENSION(klon)              :: yalb,yalb_vis
 !albedo SB <<<
-    REAL, DIMENSION(klon)              :: yt1, yq1, yu1, yv1
+    REAL, DIMENSION(klon)              :: yt1, yq1, yu1, yv1, yqbs1
     REAL, DIMENSION(klon)              :: yqa
     REAL, DIMENSION(klon)              :: ysnow, yqsurf, yagesno, yqsol
-    REAL, DIMENSION(klon)              :: yrain_f, ysnow_f
+    REAL, DIMENSION(klon)              :: yrain_f, ysnow_f, ybs_f
     REAL, DIMENSION(klon)              :: ysolsw, ysollw
     REAL, DIMENSION(klon)              :: yfder
     REAL, DIMENSION(klon)              :: yrugoro
     REAL, DIMENSION(klon)              :: yfluxlat
+    REAL, DIMENSION(klon)              :: yfluxbs
     REAL, DIMENSION(klon)              :: y_d_ts
     REAL, DIMENSION(klon)              :: y_flux_t1, y_flux_q1
     REAL, DIMENSION(klon)              :: y_dflux_t, y_dflux_q
     REAL, DIMENSION(klon)              :: y_flux_u1, y_flux_v1
+    REAL, DIMENSION(klon)              :: y_flux_bs, y_flux0
     REAL, DIMENSION(klon)              :: yt2m, yq2m, yu10m
     INTEGER, DIMENSION(klon, nbsrf, 6) :: yn2mout, yn2mout_x, yn2mout_w
@@ -601 +613 @@
     REAL, DIMENSION(klon)              :: AcoefH, AcoefQ, BcoefH, BcoefQ
     REAL, DIMENSION(klon)              :: AcoefU, AcoefV, BcoefU, BcoefV
+    REAL, DIMENSION(klon)              :: AcoefQBS, BcoefQBS
     REAL, DIMENSION(klon)              :: ypsref
     REAL, DIMENSION(klon)              :: yevap, yevap_pot, ytsurf_new, yalb3_new
@@ -609 +622 @@
     REAL, DIMENSION(klon)              :: meansqT ! mean square deviation of subsurface temperatures
     REAL, DIMENSION(klon)              :: alb_m  ! mean albedo for whole SW interval
-    REAL, DIMENSION(klon,klev)         :: y_d_t, y_d_q, y_d_t_diss
+    REAL, DIMENSION(klon,klev)         :: y_d_t, y_d_q, y_d_t_diss, y_d_qbs
     REAL, DIMENSION(klon,klev)         :: y_d_u, y_d_v
-    REAL, DIMENSION(klon,klev)         :: y_flux_t, y_flux_q
+    REAL, DIMENSION(klon,klev)         :: y_flux_t, y_flux_q, y_flux_qbs
     REAL, DIMENSION(klon,klev)         :: y_flux_u, y_flux_v
-    REAL, DIMENSION(klon,klev)         :: ycoefh, ycoefm,ycoefq
+    REAL, DIMENSION(klon,klev)         :: ycoefh,ycoefm,ycoefq,ycoefqbs
     REAL, DIMENSION(klon)              :: ycdragh, ycdragq, ycdragm
     REAL, DIMENSION(klon,klev)         :: yu, yv
-    REAL, DIMENSION(klon,klev)         :: yt, yq
+    REAL, DIMENSION(klon,klev)         :: yt, yq, yqbs
     REAL, DIMENSION(klon,klev)         :: ypplay, ydelp
     REAL, DIMENSION(klon,klev)         :: delp
@@ -678 +691 @@
     REAL, DIMENSION(klon,klev)         :: CcoefH, CcoefQ, DcoefH, DcoefQ
     REAL, DIMENSION(klon,klev)         :: CcoefU, CcoefV, DcoefU, DcoefV
+    REAL, DIMENSION(klon,klev)         :: CcoefQBS, DcoefQBS
     REAL, DIMENSION(klon,klev)         :: CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x
     REAL, DIMENSION(klon,klev)         :: CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w
@@ -683 +697 @@
     REAL, DIMENSION(klon,klev)         :: CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w
     REAL, DIMENSION(klon,klev)         :: Kcoef_hq, Kcoef_m, gama_h, gama_q
+    REAL, DIMENSION(klon,klev)         :: gama_qbs, Kcoef_qbs 
     REAL, DIMENSION(klon,klev)         :: Kcoef_hq_x, Kcoef_m_x, gama_h_x, gama_q_x
     REAL, DIMENSION(klon,klev)         :: Kcoef_hq_w, Kcoef_m_w, gama_h_w, gama_q_w
@@ -775 +790 @@
     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
     REAL, DIMENSION(klon)       :: zgeo1_w, tair1_w, qair1_w, tairsol_w
+    REAL, DIMENSION(klon)       :: yus0, yvs0
 
 !!! jyg le 25/03/2013
@@ -862 +878 @@
     REAL, DIMENSION(klon,nbsrf)        :: zx_t1
     REAL, DIMENSION(klon, nbsrf)       :: alb          ! mean albedo for whole SW interval
+    REAL, DIMENSION(klon,nbsrf)        :: snowerosion    
     REAL, DIMENSION(klon)              :: ylwdown      ! jg : temporary (ysollwdown)
     REAL, DIMENSION(klon)              :: ygustiness      ! jg : temporary (ysollwdown)
@@ -977 +994 @@
  cdragh(:)=0. ; cdragm(:)=0.
  zu1(:)=0. ; zv1(:)=0.
+ yus0(:)=0. ; yvs0(:)=0.
 !albedo SB >>>
   alb_dir_m=0. ; alb_dif_m=0. ; alb3_lic(:)=0.
 !albedo SB <<<
- zxsens(:)=0. ; zxevap(:)=0. ; zxtsol(:)=0.
+ zxsens(:)=0. ; zxevap(:)=0. ; zxtsol(:)=0. ; zxsnowerosion(:)=0.
  d_t_w(:,:)=0. ; d_q_w(:,:)=0. ; d_t_x(:,:)=0. ; d_q_x(:,:)=0.
  zxfluxlat(:)=0.
  zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0.
  zn2mout(:,:)=0 ;
- d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
+ d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_qbs(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
  zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0.
  zxsens_x(:)=0. ; zxsens_w(:)=0. ; zxfluxlat_x(:)=0. ; zxfluxlat_w(:)=0.
@@ -1005 +1023 @@
  d_ts(:,:)=0.
  evap(:,:)=0.
+ snowerosion(:,:)=0. 
  fluxlat(:,:)=0.
  wfbils(:,:)=0. ; wfbilo(:,:)=0.
  wfevap(:,:)=0. ; wfrain(:,:)=0. ; wfsnow(:,:)=0.
  flux_t(:,:,:)=0. ; flux_q(:,:,:)=0. ; flux_u(:,:,:)=0. ; flux_v(:,:,:)=0.
+ flux_qbs(:,:,:)=0.
  dflux_t(:)=0. ; dflux_q(:)=0.
  zxsnow(:)=0.
- zxfluxt(:,:)=0. ; zxfluxq(:,:)=0.
+ zxfluxt(:,:)=0. ; zxfluxq(:,:)=0.; zxfluxqbs(:,:)=0.
  qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0.
  runoff(:)=0.
@@ -1048 +1068 @@
     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  ; ybs_f=0.0  ; yfder = 0.0     ; ysolsw = 0.0
     ysollw = 0.0  ; yz0m = 0.0 ; yz0h = 0.0    ; yz0h_oupas = 0.0 ; yu1 = 0.0    
-    yv1 = 0.0     ; ypaprs = 0.0     ; ypplay = 0.0
+    yv1 = 0.0     ; ypaprs = 0.0     ; ypplay = 0.0     ; yqbs1 = 0.0
     ydelp = 0.0   ; yu = 0.0         ; yv = 0.0        ; yt = 0.0         
     yq = 0.0      ; y_dflux_t = 0.0  ; y_dflux_q = 0.0 
+    yqbs(:,:)=0.0  
     yrugoro = 0.0 ; ywindsp = 0.0   
 !!    d_ts = 0.0    ; yfluxlat=0.0     ; flux_t = 0.0    ; flux_q = 0.0     
-    yfluxlat=0.0 
+    yfluxlat=0.0 ; y_flux0(:)=0.0
 !!    flux_u = 0.0  ; flux_v = 0.0     ; d_t = 0.0       ; d_q = 0.0      
 !!    d_t_diss= 0.0 ;d_u = 0.0     ; d_v = 0.0 
@@ -1070 +1091 @@
     ycldt = 0.0      ; yrmu0 = 0.0
     ! Martin
+    y_d_qbs(:,:)=0.0
 
 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
@@ -1366 +1388 @@
 !   Provisional : set ybeta to standard values
        IF (nsrf .NE. is_ter) THEN
-           ybeta(:) = 1.
+           ybeta(1:knon) = 1.
        ELSE
            IF (iflag_split .EQ. 0) THEN
-              ybeta(:) = 1.
+              ybeta(1:knon) = 1.
            ELSE
              DO j = 1, knon
@@ -1395 +1417 @@
           yrain_f(j) = rain_f(i)
           ysnow_f(j) = snow_f(i)
+          ybs_f(j)   = bs_f(i)
           yagesno(j) = agesno(i,nsrf)
           yfder(j)   = fder(i)
@@ -1406 +1429 @@
           yu1(j)     = u(i,1)
           yv1(j)     = v(i,1)
+          yqbs1(j)   = qbs(i,1)
           ypaprs(j,klev+1) = paprs(i,klev+1)
 !jyg<
@@ -1419 +1443 @@
 !!! nrlmd le 13/06/2011
           y_delta_tsurf(j)=delta_tsurf(i,nsrf)
-!!!
+          yfluxbs(j)=0.0
+          y_flux_bs(j) = 0.0
        ENDDO
 ! >> PC
@@ -1458 +1483 @@
              yt(j,k) = t(i,k)
              yq(j,k) = q(i,k)
+             yqbs(j,k)=qbs(i,k)
           ENDDO
         ENDDO
@@ -1587 +1613 @@
      ENDIF
 
-        IF (prt_level >=10) print *,'clcdrag -> ycdragh ', ycdragh
+        IF (prt_level >=10) print *,'cdrag -> ycdragh ', ycdragh(1:knon)
        ELSE  !(iflag_split .eq.0)
 
@@ -1635 +1661 @@
             ycdragm_w, ycdragh_w, zri1_w, pref_w, rain_f, zxtsol, ypplay(:,1) )
 !
-        zgeo1(:) = wake_s(:)*zgeo1_w(:) + (1.-wake_s(:))*zgeo1_x(:)
+!!!bug !!        zgeo1(:) = wake_s(:)*zgeo1_w(:) + (1.-wake_s(:))*zgeo1_x(:)
+        zgeo1(1:knon) = wake_s(1:knon)*zgeo1_w(1:knon) + (1.-wake_s(1:knon))*zgeo1_x(1:knon)
 
 ! --- special Dice. JYG+MPL 25112013 puis BOMEX
@@ -1661 +1688 @@
 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
       IF (prt_level >=10) THEN
-      print *,' args coef_diff_turb: yu ',  yu  
-      print *,' args coef_diff_turb: yv ',  yv  
-      print *,' args coef_diff_turb: yq ',  yq  
-      print *,' args coef_diff_turb: yt ',  yt  
-      print *,' args coef_diff_turb: yts ', yts  
-      print *,' args coef_diff_turb: yz0m ', yz0m  
-      print *,' args coef_diff_turb: yqsurf ', yqsurf  
-      print *,' args coef_diff_turb: ycdragm ', ycdragm
-      print *,' args coef_diff_turb: ycdragh ', ycdragh
-      print *,' args coef_diff_turb: ytke ', ytke
+      print *,' args coef_diff_turb: yu ',  yu(1:knon,:)  
+      print *,' args coef_diff_turb: yv ',  yv(1:knon,:)    
+      print *,' args coef_diff_turb: yq ',  yq(1:knon,:)    
+      print *,' args coef_diff_turb: yt ',  yt(1:knon,:)    
+      print *,' args coef_diff_turb: yts ', yts(1:knon)
+      print *,' args coef_diff_turb: yz0m ', yz0m(1:knon)
+      print *,' args coef_diff_turb: yqsurf ', yqsurf(1:knon)  
+      print *,' args coef_diff_turb: ycdragm ', ycdragm(1:knon)
+      print *,' args coef_diff_turb: ycdragh ', ycdragh(1:knon)
+      print *,' args coef_diff_turb: ytke ', ytke(1:knon,:)    
        ENDIF
 
         IF (iflag_pbl>=50) THEN
 
-        CALL atke_compute_km_kh(knon,klev,yu,yv,yt, &
+        CALL call_atke(dtime,knon,klev,ycdragm, ycdragh,yus0,yvs0,yts,yu,yv,yt, &
              ypplay,ypaprs,ytke,ycoefm, ycoefh)
 
@@ -1698 +1725 @@
        ENDIF ! iflag_pbl >= 50
 
-        IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh ',ycoefh
+        IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh ',ycoefh(1:knon,:)
 
 
@@ -1705 +1732 @@
       
       IF (prt_level >=10) THEN
-      print *,' args coef_diff_turb: yu_x ',  yu_x  
-      print *,' args coef_diff_turb: yv_x ',  yv_x  
-      print *,' args coef_diff_turb: yq_x ',  yq_x  
-      print *,' args coef_diff_turb: yt_x ',  yt_x  
-      print *,' args coef_diff_turb: yts_x ', yts_x  
-      print *,' args coef_diff_turb: yqsurf ', yqsurf  
-      print *,' args coef_diff_turb: ycdragm_x ', ycdragm_x
-      print *,' args coef_diff_turb: ycdragh_x ', ycdragh_x
-      print *,' args coef_diff_turb: ytke_x ', ytke_x
+      print *,' args coef_diff_turb: yu_x ',  yu_x(1:knon,:)      
+      print *,' args coef_diff_turb: yv_x ',  yv_x(1:knon,:)      
+      print *,' args coef_diff_turb: yq_x ',  yq_x(1:knon,:)      
+      print *,' args coef_diff_turb: yt_x ',  yt_x(1:knon,:)      
+      print *,' args coef_diff_turb: yts_x ', yts_x(1:knon)
+      print *,' args coef_diff_turb: yqsurf ', yqsurf(1:knon)  
+      print *,' args coef_diff_turb: ycdragm_x ', ycdragm_x(1:knon)
+      print *,' args coef_diff_turb: ycdragh_x ', ycdragh_x(1:knon)
+      print *,' args coef_diff_turb: ytke_x ', ytke_x(1:knon,:)    
       ENDIF
 
@@ -1719 +1746 @@
         IF (iflag_pbl>=50) THEN
      
-        CALL atke_compute_km_kh(knon,klev,yu_x,yv_x,yt_x, &
+        CALL call_atke(dtime,knon,klev,ycdragm_x,ycdragh_x,yus0,yvs0,yts_x,yu_x,yv_x,yt_x, &
              ypplay,ypaprs,ytke_x,ycoefm_x, ycoefh_x)
 
@@ -1742 +1769 @@
         ENDIF ! iflag_pbl >= 50
 
-        IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_x ',ycoefh_x
+        IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_x ',ycoefh_x(1:knon,:)
 !
       IF (prt_level >=10) THEN
-      print *,' args coef_diff_turb: yu_w ',  yu_w  
-      print *,' args coef_diff_turb: yv_w ',  yv_w  
-      print *,' args coef_diff_turb: yq_w ',  yq_w  
-      print *,' args coef_diff_turb: yt_w ',  yt_w  
-      print *,' args coef_diff_turb: yts_w ', yts_w  
-      print *,' args coef_diff_turb: yqsurf ', yqsurf  
-      print *,' args coef_diff_turb: ycdragm_w ', ycdragm_w
-      print *,' args coef_diff_turb: ycdragh_w ', ycdragh_w
-      print *,' args coef_diff_turb: ytke_w ', ytke_w
+      print *,' args coef_diff_turb: yu_w ',  yu_w(1:knon,:)
+      print *,' args coef_diff_turb: yv_w ',  yv_w(1:knon,:)  
+      print *,' args coef_diff_turb: yq_w ',  yq_w(1:knon,:)  
+      print *,' args coef_diff_turb: yt_w ',  yt_w(1:knon,:)  
+      print *,' args coef_diff_turb: yts_w ', yts_w(1:knon)
+      print *,' args coef_diff_turb: yqsurf ', yqsurf(1:knon)  
+      print *,' args coef_diff_turb: ycdragm_w ', ycdragm_w(1:knon)
+      print *,' args coef_diff_turb: ycdragh_w ', ycdragh_w(1:knon)
+      print *,' args coef_diff_turb: ytke_w ', ytke_w(1:knon,:)
       ENDIF
       
         IF (iflag_pbl>=50) THEN
         
-        CALL atke_compute_km_kh(knon,klev,yu_w,yv_w,yt_w, &
+        CALL call_atke(dtime,knon,klev,ycdragm_w,ycdragh_w,yus0,yvs0,yts_w,yu_w,yv_w,yt_w, &
              ypplay,ypaprs,ytke_w,ycoefm_w, ycoefh_w)
 
@@ -1781 +1808 @@
 
 
-        IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_w ',ycoefh_w
+        IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_w ',ycoefh_w(1:knon,:)
 
 !!!jyg le 10/04/2013
@@ -1880 +1907 @@
        ENDIF  ! (iflag_split .eq.0)
 !!!
+
+! For blowing snow:
+    IF (ok_bs) THEN
+     ! following Bintanja et al 2000, part II
+     ! we assume that the eddy diffsivity coefficient for
+     ! suspended particles is larger than Km by a factor zeta_bs
+     ! which is equal to 3 by default
+     do k=1,klev
+        do j=1,knon
+           ycoefqbs(j,k)=ycoefm(j,k)*zeta_bs 
+        enddo
+     enddo
+     CALL climb_qbs_down(knon, ycoefqbs, ypaprs, ypplay, &
+     ydelp, yt, yqbs, dtime, & 
+     CcoefQBS, DcoefQBS, &
+     Kcoef_qbs, gama_qbs, &
+     AcoefQBS, BcoefQBS)
+    ENDIF
 
 !****************************************************************************************
@@ -1999 +2044 @@
 !!!
        IF (prt_level >=10) THEN
-         PRINT *,'pbl_surface (merge->): yt(1,:) ',yt(1,:)
-         PRINT *,'pbl_surface (merge->): yq(1,:) ',yq(1,:)
-         PRINT *,'pbl_surface (merge->): yu(1,:) ',yu(1,:)
-         PRINT *,'pbl_surface (merge->): yv(1,:) ',yv(1,:)
-         PRINT *,'pbl_surface (merge->): AcoefH(1), AcoefQ(1), AcoefU(1), AcoefV(1) ', &
-                                         AcoefH(1), AcoefQ(1), AcoefU(1), AcoefV(1)
-         PRINT *,'pbl_surface (merge->): BcoefH(1), BcoefQ(1), BcoefU(1), BcoefV(1) ', &
-                                         BcoefH(1), BcoefQ(1), BcoefU(1), BcoefV(1)
+         DO i = 1, min(1,knon)
+           PRINT *,'pbl_surface (merge->): yt(1,:) ',yt(i,:)
+           PRINT *,'pbl_surface (merge->): yq(1,:) ',yq(i,:)
+           PRINT *,'pbl_surface (merge->): yu(1,:) ',yu(i,:)
+           PRINT *,'pbl_surface (merge->): yv(1,:) ',yv(i,:)
+           PRINT *,'pbl_surface (merge->): AcoefH(1), AcoefQ(1), AcoefU(1), AcoefV(1) ', &
+                                           AcoefH(i), AcoefQ(i), AcoefU(i), AcoefV(i)
+           PRINT *,'pbl_surface (merge->): BcoefH(1), BcoefQ(1), BcoefU(1), BcoefV(1) ', &
+                                           BcoefH(i), BcoefQ(i), BcoefU(i), BcoefV(i)
+         ENDDO
 
        ENDIF
@@ -2057 +2104 @@
                debut, lafin, ydelp(:,1), r_co2_ppm, ysolsw, ysollw, yalb, &
 !!jyg               yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
-               yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
+               yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt1, yq1,&
                AcoefH, AcoefQ, BcoefH, BcoefQ, & 
                AcoefU, AcoefV, BcoefU, BcoefV, & 
@@ -2063 +2110 @@
                ylwdown, yq2m, yt2m, &
                ysnow, yqsol, yagesno, ytsoil, &
-               yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
+               yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,yfluxbs,&
                yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
                y_flux_u1, y_flux_v1, &
@@ -2106 +2153 @@
                   yrmu0, ylwdown, yalb, zgeo1, &
                   ysolsw, ysollw, yts, ypplay(:,1), &
-                  !!jyg               ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
-                  ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
+                  ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt1, yq1,&
                   AcoefH, AcoefQ, BcoefH, BcoefQ, &
                   AcoefU, AcoefV, BcoefU, BcoefV, &
+                  AcoefQBS, BcoefQBS, &
                   ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
-                  ysnow, yqsurf, yqsol, yagesno, &
+                  ysnow, yqsurf, yqsol,yqbs1, yagesno, &
                   ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
-                  ytsurf_new, y_dflux_t, y_dflux_q, &
+                  yfluxbs, ytsurf_new, y_dflux_t, y_dflux_q, &
                   yzmea, yzsig, ycldt, &
                   ysnowhgt, yqsnow, ytoice, ysissnow, &
@@ -2147 +2194 @@
                itap, dtime, jour, knon, ni, &
 !!jyg               ypplay(:,1), zgeo1/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
-               ypplay(:,1), zgeo1(1:knon)/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&    ! ym missing init
+               ypplay(:,1), zgeo1(1:knon)/RG, ycdragh, ycdragm, yrain_f, ysnow_f, ybs_f, yt(:,1), yq(:,1),&    ! ym missing init
                AcoefH, AcoefQ, BcoefH, BcoefQ, &
                AcoefU, AcoefV, BcoefU, BcoefV, &
@@ -2158 +2205 @@
                ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss)
       IF (prt_level >=10) THEN
-          print *,'arg de surf_ocean: ycdragh ',ycdragh
-          print *,'arg de surf_ocean: ycdragm ',ycdragm
-          print *,'arg de surf_ocean: yt ', yt
-          print *,'arg de surf_ocean: yq ', yq
-          print *,'arg de surf_ocean: yts ', yts
-          print *,'arg de surf_ocean: AcoefH ',AcoefH
-          print *,'arg de surf_ocean: AcoefQ ',AcoefQ
-          print *,'arg de surf_ocean: BcoefH ',BcoefH
-          print *,'arg de surf_ocean: BcoefQ ',BcoefQ
-          print *,'arg de surf_ocean: yevap ',yevap
-          print *,'arg de surf_ocean: yfluxsens ',yfluxsens
-          print *,'arg de surf_ocean: yfluxlat ',yfluxlat
-          print *,'arg de surf_ocean: ytsurf_new ',ytsurf_new
+          print *,'arg de surf_ocean: ycdragh ',ycdragh(1:knon)
+          print *,'arg de surf_ocean: ycdragm ',ycdragm(1:knon)
+          print *,'arg de surf_ocean: yt ', yt(1:knon,:)
+          print *,'arg de surf_ocean: yq ', yq(1:knon,:)
+          print *,'arg de surf_ocean: yts ', yts(1:knon)
+          print *,'arg de surf_ocean: AcoefH ',AcoefH(1:knon)
+          print *,'arg de surf_ocean: AcoefQ ',AcoefQ(1:knon)
+          print *,'arg de surf_ocean: BcoefH ',BcoefH(1:knon)
+          print *,'arg de surf_ocean: BcoefQ ',BcoefQ(1:knon)
+          print *,'arg de surf_ocean: yevap ',yevap(1:knon)
+          print *,'arg de surf_ocean: yfluxsens ',yfluxsens(1:knon)
+          print *,'arg de surf_ocean: yfluxlat ',yfluxlat(1:knon)
+          print *,'arg de surf_ocean: ytsurf_new ',ytsurf_new(1:knon)
        ENDIF
 ! Special DICE MPL 05082013 puis BOMEX MPL 20150410
@@ -2220 +2267 @@
 
        IF (evap0>=0.) THEN
-          yevap(:)=evap0
-          yevap(:)=RLVTT*evap0
+          yevap(1:knon)=evap0
+          yevap(1:knon)=RLVTT*evap0
        ENDIF
 
@@ -2277 +2324 @@
           ENDDO
         ENDIF ! (ok_flux_surf)
+
+        ! flux of blowing snow at the first level 
+        IF (ok_bs) THEN 
+        DO j=1,knon
+        y_flux_bs(j)=yfluxbs(j)
+        ENDDO
+        ENDIF
 !
 ! ------------------------------------------------------------------------------
@@ -2421 +2475 @@
        IF (prt_level >= 10) THEN
          print *,'pbl_surface, ybeta , yevap, yevap_pot ', &
-                               ybeta , yevap, yevap_pot
+                               ybeta(1:knon) , yevap(1:knon), yevap_pot(1:knon)
        ENDIF  ! (prt_level >= 10)
 !
@@ -2583 +2637 @@
 !
        ENDIF  ! (iflag_split .eq.0)
+
+       IF (ok_bs) THEN
+            CALL climb_qbs_up(knon, dtime, yqbs, &
+            y_flux_bs, ypaprs, ypplay, &
+            AcoefQBS, BcoefQBS, &
+            CcoefQBS, DcoefQBS, &
+            Kcoef_qbs, gama_qbs, &
+            y_flux_qbs(:,:), y_d_qbs(:,:))
+       ENDIF
+
 !!!
 !!
@@ -2696 +2760 @@
 !!!
 
-!      print*,'Dans pbl OK1'
-
-!jyg<
-!!       evap(:,nsrf) = - flux_q(:,1,nsrf)
-!>jyg
+       ! tendencies of blowing snow 
+       IF (ok_bs) THEN 
+           DO k = 1, klev   
+            DO j = 1, knon 
+                i = ni(j)
+                y_d_qbs(j,k)=y_d_qbs(j,k) * ypct(j)
+                flux_qbs(i,k,nsrf) = y_flux_qbs(j,k) 
+            ENDDO
+          ENDDO
+       ENDIF
+
+
        DO j = 1, knon
           i = ni(j)
           evap(i,nsrf) = - flux_q(i,1,nsrf)                  !jyg
+          if (ok_bs) then ; snowerosion(i,nsrf)=flux_qbs(i,1,nsrf); endif
           beta(i,nsrf) = ybeta(j)                             !jyg
           d_ts(i,nsrf) = y_d_ts(j)
@@ -2874 +2946 @@
        ENDDO
 
+
+       IF (ok_bs) THEN
+         DO k = 1, klev
+         DO j = 1, knon
+         i = ni(j)
+         d_qbs(i,k) = d_qbs(i,k) + y_d_qbs(j,k)
+         ENDDO
+         ENDDO
+        ENDIF
+
 !      print*,'Dans pbl OK4'
 
        IF (prt_level >=10) THEN
          print *, 'pbl_surface tendencies for w: d_t_w, d_t_x, d_t ', &
-          d_t_w(:,1), d_t_x(:,1), d_t(:,1)
+          d_t_w(1:knon,1), d_t_x(1:knon,1), d_t(1:knon,1)
        ENDIF
 
@@ -3124 +3206 @@
        IF (prt_level >=10) THEN
          print *, 'T2m, q2m, RH2m ', &
-          t2m, q2m, rh2m
+          t2m(1:knon,:), q2m(1:knon,:), rh2m(1:knon)
        ENDIF
 
@@ -3137 +3219 @@
             ytherm,ytrmb1,ytrmb2,ytrmb3,ylcl)
           IF (prt_level >=10) THEN
-       print *,' Arg. de HBTM: yt2m ',yt2m
-       print *,' Arg. de HBTM: yt10m ',yt10m
-       print *,' Arg. de HBTM: yq2m ',yq2m
-       print *,' Arg. de HBTM: yq10m ',yq10m
-       print *,' Arg. de HBTM: yustar ',yustar
-       print *,' Arg. de HBTM: y_flux_t ',y_flux_t
-       print *,' Arg. de HBTM: y_flux_q ',y_flux_q
-       print *,' Arg. de HBTM: yu ',yu
-       print *,' Arg. de HBTM: yv ',yv
-       print *,' Arg. de HBTM: yt ',yt
-       print *,' Arg. de HBTM: yq ',yq
+       print *,' Arg. de HBTM: yt2m ',yt2m(1:knon)
+       print *,' Arg. de HBTM: yt10m ',yt10m(1:knon)
+       print *,' Arg. de HBTM: yq2m ',yq2m(1:knon)
+       print *,' Arg. de HBTM: yq10m ',yq10m(1:knon)
+       print *,' Arg. de HBTM: yustar ',yustar(1:knon)
+       print *,' Arg. de HBTM: y_flux_t ',y_flux_t(1:knon,:)
+       print *,' Arg. de HBTM: y_flux_q ',y_flux_q(1:knon,:)
+       print *,' Arg. de HBTM: yu ',yu(1:knon,:)
+       print *,' Arg. de HBTM: yv ',yv(1:knon,:)
+       print *,' Arg. de HBTM: yt ',yt(1:knon,:)
+       print *,' Arg. de HBTM: yq ',yq(1:knon,:)
           ENDIF
        ELSE  ! (iflag_split .eq.0)
@@ -3156 +3238 @@
             ytherm_x,ytrmb1_x,ytrmb2_x,ytrmb3_x,ylcl_x)
           IF (prt_level >=10) THEN
-       print *,' Arg. de HBTM: yt2m_x ',yt2m_x
-       print *,' Arg. de HBTM: yt10m_x ',yt10m_x
-       print *,' Arg. de HBTM: yq2m_x ',yq2m_x
-       print *,' Arg. de HBTM: yq10m_x ',yq10m_x
-       print *,' Arg. de HBTM: yustar_x ',yustar_x
-       print *,' Arg. de HBTM: y_flux_t_x ',y_flux_t_x
-       print *,' Arg. de HBTM: y_flux_q_x ',y_flux_q_x
-       print *,' Arg. de HBTM: yu_x ',yu_x
-       print *,' Arg. de HBTM: yv_x ',yv_x
-       print *,' Arg. de HBTM: yt_x ',yt_x
-       print *,' Arg. de HBTM: yq_x ',yq_x
+       print *,' Arg. de HBTM: yt2m_x ',yt2m_x(1:knon)
+       print *,' Arg. de HBTM: yt10m_x ',yt10m_x(1:knon)
+       print *,' Arg. de HBTM: yq2m_x ',yq2m_x(1:knon)
+       print *,' Arg. de HBTM: yq10m_x ',yq10m_x(1:knon)
+       print *,' Arg. de HBTM: yustar_x ',yustar_x(1:knon)
+       print *,' Arg. de HBTM: y_flux_t_x ',y_flux_t_x(1:knon,:)
+       print *,' Arg. de HBTM: y_flux_q_x ',y_flux_q_x(1:knon,:)
+       print *,' Arg. de HBTM: yu_x ',yu_x(1:knon,:)
+       print *,' Arg. de HBTM: yv_x ',yv_x(1:knon,:)
+       print *,' Arg. de HBTM: yt_x ',yt_x(1:knon,:)
+       print *,' Arg. de HBTM: yq_x ',yq_x(1:knon,:)
           ENDIF
         CALL HBTM(knon, ypaprs, ypplay, &
@@ -3195 +3277 @@
         ENDDO
         IF (prt_level >=10) THEN
-          print *, 'After HBTM: pblh ', pblh
-          print *, 'After HBTM: plcl ', plcl
-          print *, 'After HBTM: cteiCL ', cteiCL
+          print *, 'After HBTM: pblh ', pblh(1:knon,:)
+          print *, 'After HBTM: plcl ', plcl(1:knon,:)
+          print *, 'After HBTM: cteiCL ', cteiCL(1:knon,:)
         ENDIF
        ELSE  !(iflag_split .eq.0)
@@ -3215 +3297 @@
         ENDDO
         IF (prt_level >=10) THEN
-          print *, 'After HBTM: pblh_x ', pblh_x
-          print *, 'After HBTM: plcl_x ', plcl_x
-          print *, 'After HBTM: cteiCL_x ', cteiCL_x
+          print *, 'After HBTM: pblh_x ', pblh_x(1:knon,:)
+          print *, 'After HBTM: plcl_x ', plcl_x(1:knon,:)
+          print *, 'After HBTM: cteiCL_x ', cteiCL_x(1:knon,:)
         ENDIF
         DO j=1, knon
@@ -3234 +3316 @@
         ENDDO
         IF (prt_level >=10) THEN
-          print *, 'After HBTM: pblh_w ', pblh_w
-          print *, 'After HBTM: plcl_w ', plcl_w
-          print *, 'After HBTM: cteiCL_w ', cteiCL_w
+          print *, 'After HBTM: pblh_w ', pblh_w(1:knon,:)
+          print *, 'After HBTM: plcl_w ', plcl_w(1:knon,:)
+          print *, 'After HBTM: cteiCL_w ', cteiCL_w(1:knon,:)
         ENDIF
 !!!
@@ -3327 +3409 @@
        fder_print(i) = fder(i) + dflux_t(i) + dflux_q(i)
     ENDDO
+
+    ! if blowing snow
+    if (ok_bs) then  
+       DO nsrf = 1, nbsrf 
+       DO k = 1, klev
+       DO i = 1, klon 
+         zxfluxqbs(i,k) = zxfluxqbs(i,k) + flux_qbs(i,k,nsrf) * pctsrf(i,nsrf)
+       ENDDO
+       ENDDO
+       ENDDO
+
+       DO i = 1, klon
+        zxsnowerosion(i)     = zxfluxqbs(i,1) ! blowings snow flux at the surface 
+       END DO
+    endif
+
 !!!
 

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/phyaqua_mod.F90

@@ -360 +360 @@
     ql_ancien   = 0.
     qs_ancien   = 0.
+    qbs_ancien  = 0.
     u_ancien    = 0.
     v_ancien    = 0.
@@ -365 +366 @@
     prlw_ancien = 0.
     prsw_ancien = 0.  
+    prbsw_ancien= 0.
 
     ale_wake    = 0.

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/phyetat0_mod.F90

@@ -20 +20 @@
        qsol, fevap, z0m, z0h, agesno, &
        du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
-       falb_dir, falb_dif, prw_ancien, prlw_ancien, prsw_ancien, &
-       ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, rneb_ancien, radpas, radsol, rain_fall, ratqs, &
-       rnebcon, rugoro, sig1, snow_fall, solaire_etat0, sollw, sollwdown, &
+       falb_dir, falb_dif, prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien, &
+       ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, qbs_ancien, rneb_ancien, radpas, radsol, rain_fall, ratqs, &
+       rnebcon, rugoro, sig1, snow_fall, bs_fall, solaire_etat0, sollw, sollwdown, &
        solsw, solswfdiff, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, &
        wake_deltat, wake_delta_pbl_TKE, delta_tsurf, beta_aridity, wake_fip, wake_pe, &
@@ -300 +300 @@
 
 !===================================================================
+! Lecture dans le cas iflag_pbl_surface =1
+!===================================================================
+
+   if ( iflag_physiq <= 1 ) then
+!===================================================================
   ! Lecture des temperatures du sol profond:
 !===================================================================
@@ -327 +332 @@
   found=phyetat0_get(snow_fall,"snow_f","snow fall",0.)
   found=phyetat0_get(rain_fall,"rain_f","rain fall",0.)
-
+  IF (ok_bs) THEN
+     found=phyetat0_get(bs_fall,"bs_f","blowing snow fall",0.)
+  ELSE
+     bs_fall(:)=0.
+  ENDIF
 !=======================================================================
 ! Radiation
@@ -374 +383 @@
   ENDIF
 
+  endif ! iflag_physiq <= 1
+
   ! Lecture de l'age de la neige:
   found=phyetat0_srf(agesno,"AGESNO","SNOW AGE",0.001)
@@ -388 +399 @@
   ancien_ok=ancien_ok.AND.phyetat0_get(prlw_ancien,"PRLWANCIEN","PRLWANCIEN",0.)
   ancien_ok=ancien_ok.AND.phyetat0_get(prsw_ancien,"PRSWANCIEN","PRSWANCIEN",0.)
+
+  ! cas specifique des variables de la neige soufflee
+  IF (ok_bs) THEN
+     ancien_ok=ancien_ok.AND.phyetat0_get(qbs_ancien,"QBSANCIEN","QBSANCIEN",0.)
+     ancien_ok=ancien_ok.AND.phyetat0_get(prbsw_ancien,"PRBSWANCIEN","PRBSWANCIEN",0.)
+  ELSE
+     qbs_ancien(:,:)=0.
+     prbsw_ancien(:)=0.
+  ENDIF
 
   ! Ehouarn: addtional tests to check if t_ancien, q_ancien contain
@@ -401 +421 @@
        (maxval(t_ancien).EQ.minval(t_ancien)) ) THEN
     ancien_ok=.false.
+  ENDIF
+
+  IF (ok_bs) THEN
+    IF ( (maxval(qbs_ancien).EQ.minval(qbs_ancien))       .OR. &
+         (maxval(prbsw_ancien).EQ.minval(prbsw_ancien)) ) THEN
+       ancien_ok=.false.
+    ENDIF
   ENDIF
 
@@ -591 +618 @@
   ! Initialize module pbl_surface_mod 
 
+  if ( iflag_physiq <= 1 ) then
   CALL pbl_surface_init(fder, snow, qsurf, tsoil)
+  endif
 
   ! Initialize module ocean_cpl_mod for the case of coupled ocean

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/phyredem.F90

@@ -15 +15 @@
                                 ftsol, beta_aridity, delta_tsurf, falb_dir,  &
                                 falb_dif, qsol, fevap, radsol, solsw, sollw, &
-                                sollwdown, rain_fall, snow_fall, z0m, z0h,   &
+                                sollwdown, rain_fall, snow_fall, bs_fall, z0m, z0h, &
                                 agesno, zmea, zstd, zsig, zgam, zthe, zpic,  &
                                 zval, rugoro, t_ancien, q_ancien,            &
-                                prw_ancien, prlw_ancien, prsw_ancien,        &
-                                ql_ancien, qs_ancien, rneb_ancien, u_ancien, &
+                                prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien,      &
+                                ql_ancien, qs_ancien, qbs_ancien, rneb_ancien, u_ancien, &
                                 v_ancien, clwcon, rnebcon, ratqs, pbl_tke,   &
                                 wake_delta_pbl_tke, zmax0, f0, sig1, w01,    &
@@ -76 +76 @@
   ! Get variables which will be written to restart file from module 
   ! pbl_surface_mod
-  CALL pbl_surface_final(fder, snow, qsurf,  tsoil)
+  if ( iflag_physiq <= 1 ) then
+     CALL pbl_surface_final(fder, snow, qsurf,  tsoil)
+  endif
 
   ! Get a variable calculated in module fonte_neige_mod
@@ -243 +245 @@
 
     CALL put_field(pass,"QSANCIEN", "QSANCIEN", qs_ancien)
+
+    IF (ok_bs) THEN
+       CALL put_field(pass,"bs_f", "precipitation neige soufflee", bs_fall)
+       CALL put_field(pass,"QBSANCIEN", "QBSANCIEN", qbs_ancien)
+       CALL put_field(pass,"PRBSWANCIEN", "PRBSWANCIEN", prbsw_ancien)
+    ENDIF
 
     CALL put_field(pass,"RNEBANCIEN", "RNEBANCIEN", rneb_ancien)

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/phys_local_var_mod.F90

@@ -14 +14 @@
       REAL, SAVE, ALLOCATABLE :: ql_seri(:,:),qs_seri(:,:)
       !$OMP THREADPRIVATE(ql_seri,qs_seri)
+      REAL, SAVE, ALLOCATABLE :: qbs_seri(:,:)
+      !$OMP THREADPRIVATE(qbs_seri)
       REAL, SAVE, ALLOCATABLE :: u_seri(:,:), v_seri(:,:)
       !$OMP THREADPRIVATE(u_seri, v_seri)
@@ -28 +30 @@
       REAL, SAVE, ALLOCATABLE :: d_t_dyn(:,:), d_q_dyn(:,:)
       !$OMP THREADPRIVATE(d_t_dyn, d_q_dyn)
-      REAL, SAVE, ALLOCATABLE :: d_ql_dyn(:,:), d_qs_dyn(:,:)
-      !$OMP THREADPRIVATE(d_ql_dyn, d_qs_dyn)
-      REAL, SAVE, ALLOCATABLE :: d_q_dyn2d(:), d_ql_dyn2d(:), d_qs_dyn2d(:)
-      !$OMP THREADPRIVATE(d_q_dyn2d, d_ql_dyn2d, d_qs_dyn2d)
+      REAL, SAVE, ALLOCATABLE :: d_ql_dyn(:,:), d_qs_dyn(:,:), d_qbs_dyn(:,:)
+      !$OMP THREADPRIVATE(d_ql_dyn, d_qs_dyn, d_qbs_dyn)
+      REAL, SAVE, ALLOCATABLE :: d_q_dyn2d(:), d_ql_dyn2d(:), d_qs_dyn2d(:), d_qbs_dyn2d(:)
+      !$OMP THREADPRIVATE(d_q_dyn2d, d_ql_dyn2d, d_qs_dyn2d, d_qbs_dyn2d)
       REAL, SAVE, ALLOCATABLE :: d_u_dyn(:,:), d_v_dyn(:,:)
       !$OMP THREADPRIVATE(d_u_dyn, d_v_dyn)
@@ -71 +73 @@
       REAL, SAVE, ALLOCATABLE :: d_u_oli(:,:), d_v_oli(:,:)
       !$OMP THREADPRIVATE(d_u_oli, d_v_oli)
-      REAL, SAVE, ALLOCATABLE :: d_t_vdf(:,:), d_q_vdf(:,:), d_t_diss(:,:)
-      !$OMP THREADPRIVATE( d_t_vdf, d_q_vdf,d_t_diss)
+      REAL, SAVE, ALLOCATABLE :: d_t_vdf(:,:), d_q_vdf(:,:), d_qbs_vdf(:,:), d_t_diss(:,:)
+      !$OMP THREADPRIVATE( d_t_vdf, d_q_vdf, d_qbs_vdf, d_t_diss)
       REAL, SAVE, ALLOCATABLE :: d_u_vdf(:,:), d_v_vdf(:,:)
       !$OMP THREADPRIVATE(d_u_vdf, d_v_vdf)
@@ -80 +82 @@
       REAL, SAVE, ALLOCATABLE :: d_t_vdf_x(:,:), d_q_vdf_x(:,:)
       !$OMP THREADPRIVATE( d_t_vdf_x, d_q_vdf_x)
+      REAL, SAVE, ALLOCATABLE :: d_t_bs(:,:), d_q_bs(:,:), d_qbs_bs(:,:)
+      !$OMP THREADPRIVATE( d_t_bs,d_q_bs, d_qbs_bs)
 !>nrlmd+jyg
       REAL, SAVE, ALLOCATABLE :: d_t_oro(:,:)
@@ -276 +280 @@
 !$OMP THREADPRIVATE(sens, flwp, fiwp)
 !!
+!FC 
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zxfluxt, zxfluxq
+!$OMP THREADPRIVATE(zxfluxt, zxfluxq)
+!FC
 !!         Wake variables
       REAL,ALLOCATABLE,SAVE,DIMENSION(:)            :: alp_wake
@@ -312 +320 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: JrNt
 !$OMP THREADPRIVATE(JrNt)
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: dthmin, evap, fder, plcl, plfc, prw, prlw, prsw
-!$OMP THREADPRIVATE(dthmin, evap, fder, plcl, plfc, prw, prlw, prsw)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: dthmin, evap, snowerosion, fder, plcl, plfc, prw, prlw, prsw, prbsw
+!$OMP THREADPRIVATE(dthmin, evap, snowerosion, fder, plcl, plfc, prw, prlw, prsw, prbsw)
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zustar, zu10m, zv10m, rh2m
 !$OMP THREADPRIVATE(zustar, zu10m, zv10m, rh2m)
@@ -330 +338 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: tpot, tpote, ue, uq, uwat, ve, vq, vwat, zxffonte
 !$OMP THREADPRIVATE(tpot, tpote, ue, uq, uwat, ve, vq, vwat, zxffonte)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxustartlic, zxrhoslic
+!$OMP THREADPRIVATE(zxustartlic, zxrhoslic)
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxfqcalving
 !$OMP THREADPRIVATE(zxfqcalving)
@@ -451 +461 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zx_rh, zx_rhl, zx_rhi
 !$OMP THREADPRIVATE(zx_rh, zx_rhl, zx_rhi)
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: prfl, psfl, fraca
-!$OMP THREADPRIVATE(prfl, psfl, fraca)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: prfl, psfl, fraca, bsfl
+!$OMP THREADPRIVATE(prfl, psfl, fraca, bsfl)
       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: Vprecip, zw2
 !$OMP THREADPRIVATE(Vprecip, zw2)
@@ -470 +480 @@
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rneb,rnebjn,rneblsvol
 !$OMP THREADPRIVATE(rneb,rnebjn,rneblsvol)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pfraclr,pfracld
+!$OMP THREADPRIVATE(pfraclr,pfracld)
 
 ! variables de sorties MM
@@ -523 +535 @@
       REAL, SAVE, ALLOCATABLE :: fcontrP(:,:)
       !$OMP THREADPRIVATE(fcontrP)
+      REAL, SAVE, ALLOCATABLE :: distcltop(:,:)
+      !$OMP THREADPRIVATE(distcltop)
+
 
 #ifdef CPP_StratAer
@@ -608 +623 @@
 
 IMPLICIT NONE
-      ALLOCATE(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev))
+      ALLOCATE(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev), qbs_seri(klon,klev))
       ALLOCATE(u_seri(klon,klev),v_seri(klon,klev))
       ALLOCATE(l_mixmin(klon,klev+1,nbsrf),l_mix(klon,klev+1,nbsrf),tke_dissip(klon,klev+1,nbsrf),wprime(klon,klev+1,nbsrf))
@@ -616 +631 @@
       ALLOCATE(tr_seri(klon,klev,nbtr))
       ALLOCATE(d_t_dyn(klon,klev),d_q_dyn(klon,klev))
-      ALLOCATE(d_ql_dyn(klon,klev),d_qs_dyn(klon,klev))
-      ALLOCATE(d_q_dyn2d(klon),d_ql_dyn2d(klon),d_qs_dyn2d(klon))
+      ALLOCATE(d_ql_dyn(klon,klev),d_qs_dyn(klon,klev), d_qbs_dyn(klon,klev))
+      ALLOCATE(d_q_dyn2d(klon),d_ql_dyn2d(klon),d_qs_dyn2d(klon), d_qbs_dyn2d(klon))
       ALLOCATE(d_u_dyn(klon,klev),d_v_dyn(klon,klev))
       ALLOCATE(d_tr_dyn(klon,klev,nbtr))                   !RomP
@@ -640 +655 @@
       ALLOCATE(plul_st(klon),plul_th(klon))
       ALLOCATE(d_t_vdf(klon,klev),d_q_vdf(klon,klev),d_t_diss(klon,klev))
-
+      ALLOCATE (d_qbs_vdf(klon,klev))
+      ALLOCATE(d_t_bs(klon,klev),d_q_bs(klon,klev),d_qbs_bs(klon,klev))
       ALLOCATE(d_t_vdf_w(klon,klev),d_q_vdf_w(klon,klev))
       ALLOCATE(d_t_vdf_x(klon,klev),d_q_vdf_x(klon,klev))
@@ -769 +785 @@
       ALLOCATE(cldm(klon), cldq(klon), cldt(klon), qsat2m(klon))
       ALLOCATE(JrNt(klon))
-      ALLOCATE(dthmin(klon), evap(klon), fder(klon), plcl(klon), plfc(klon))
-      ALLOCATE(prw(klon), prlw(klon), prsw(klon), zustar(klon), zu10m(klon), zv10m(klon), rh2m(klon))
+      ALLOCATE(dthmin(klon), evap(klon), snowerosion(klon), fder(klon), plcl(klon), plfc(klon))
+      ALLOCATE(prw(klon), prlw(klon), prsw(klon), prbsw(klon), zustar(klon), zu10m(klon), zv10m(klon), rh2m(klon))
       ALLOCATE(s_lcl(klon))
       ALLOCATE(s_pblh(klon), s_pblt(klon), s_therm(klon))
@@ -785 +801 @@
       ALLOCATE(zxtsol(klon), snow_lsc(klon), zxfqfonte(klon), zxqsurf(klon))
       ALLOCATE(zxrunofflic(klon))
+      ALLOCATE(zxustartlic(klon), zxrhoslic(klon))
+      zxustartlic(:)=0. ; zxrhoslic(:)=0.
       ALLOCATE(rain_lsc(klon))
       ALLOCATE(rain_num(klon))
@@ -841 +859 @@
       ALLOCATE(wfevap(klon, nbsrf), wfrain(klon,nbsrf), wfsnow(klon, nbsrf))
       ALLOCATE(evap_pot(klon, nbsrf))
+! FC 
+      ALLOCATE(zxfluxq(klon,klev),zxfluxt(klon,klev))
 !
 !  Deep convective variables used in phytrac
@@ -861 +881 @@
       ALLOCATE(prfl(klon, klev+1))
       ALLOCATE(psfl(klon, klev+1), fraca(klon, klev+1), Vprecip(klon, klev+1))
+      ALLOCATE(bsfl(klon,klev+1))
       ALLOCATE(zw2(klon, klev+1))
 
@@ -874 +895 @@
       ALLOCATE(beta_prec(klon,klev))
       ALLOCATE(rneb(klon,klev),rnebjn(klon,klev),rneblsvol(klon,klev))
+      ALLOCATE(pfraclr(klon,klev),pfracld(klon,klev))
+      pfraclr(:,:)=0. ; pfracld(:,:)=0. ! because not always defined
+      ALLOCATE(distcltop(klon,klev))
 
 
@@ -942 +966 @@
 USE indice_sol_mod
 IMPLICIT NONE
-      DEALLOCATE(t_seri,q_seri,ql_seri,qs_seri)
+      DEALLOCATE(t_seri,q_seri,ql_seri,qs_seri, qbs_seri)
       DEALLOCATE(u_seri,v_seri)
       DEALLOCATE(l_mixmin,l_mix, tke_dissip,wprime)
@@ -949 +973 @@
       DEALLOCATE(tr_seri)
       DEALLOCATE(d_t_dyn,d_q_dyn)
-      DEALLOCATE(d_ql_dyn,d_qs_dyn)
-      DEALLOCATE(d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d)
+      DEALLOCATE(d_ql_dyn,d_qs_dyn, d_qbs_dyn)
+      DEALLOCATE(d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d, d_qbs_dyn2d)
       DEALLOCATE(d_u_dyn,d_v_dyn)
       DEALLOCATE(d_tr_dyn)                      !RomP
@@ -973 +997 @@
       DEALLOCATE(plul_st,plul_th)
       DEALLOCATE(d_t_vdf,d_q_vdf,d_t_diss)
+      DEALLOCATE(d_qbs_vdf)
+      DEALLOCATE(d_t_bs,d_q_bs,d_qbs_bs)
       DEALLOCATE(d_u_vdf,d_v_vdf)
       DEALLOCATE(d_t_oli,d_t_oro)
@@ -1083 +1109 @@
       DEALLOCATE(cldm, cldq, cldt, qsat2m)
       DEALLOCATE(JrNt)
-      DEALLOCATE(dthmin, evap, fder, plcl, plfc)
-      DEALLOCATE(prw, prlw, prsw, zustar, zu10m, zv10m, rh2m, s_lcl)
+      DEALLOCATE(dthmin, evap, snowerosion, fder, plcl, plfc)
+      DEALLOCATE(prw, prlw, prsw, prbsw, zustar, zu10m, zv10m, rh2m, s_lcl)
       DEALLOCATE(s_pblh, s_pblt, s_therm)
 !
@@ -1097 +1123 @@
       DEALLOCATE(zxfqcalving, zxfluxlat)
       DEALLOCATE(zxrunofflic)
+      DEALLOCATE(zxustartlic, zxrhoslic)
       DEALLOCATE(zxtsol, snow_lsc, zxfqfonte, zxqsurf)
       DEALLOCATE(rain_lsc)
@@ -1129 +1156 @@
       DEALLOCATE(alp_bl_stat, n2, s2)
       DEALLOCATE(proba_notrig, random_notrig)
+!FC
+      DEALLOCATE(zxfluxq,zxfluxt)
 
       DEALLOCATE(dnwd0)
@@ -1165 +1194 @@
 
 
-      DEALLOCATE(prfl, psfl, fraca, Vprecip)
+      DEALLOCATE(prfl, psfl, bsfl, fraca, Vprecip)
       DEALLOCATE(zw2)
 
@@ -1178 +1207 @@
       DEALLOCATE(beta_prec)
       DEALLOCATE(rneb)
+      DEALLOCATE(pfraclr,pfracld)
       DEALLOCATE (zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic)
-
+      DEALLOCATE(distcltop)
       DEALLOCATE (p_tropopause)
       DEALLOCATE (z_tropopause)

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/phys_output_ctrlout_mod.F90

@@ -378 +378 @@
   TYPE(ctrl_out), SAVE :: o_snow = ctrl_out((/ 1, 1, 10, 10, 5, 10, 11, 11, 11, 11/), &
     'snow', 'Snow fall', 'kg/(s*m2)', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_bsfall = ctrl_out((/ 10, 10, 10, 10, 5, 10, 11, 11, 11, 11/), &
+    'bsfall', 'Blowing Snow fall', 'kg/(s*m2)', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_evap = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'evap', 'Evaporat', 'kg/(s*m2)', (/ ('', i=1, 10) /))
-
+  TYPE(ctrl_out), SAVE :: o_snowerosion = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+   'snowerosion', 'blowing snow flux', 'kg/(s*m2)', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_ustart_lic = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 
+    'ustart_lic', 'threshold velocity', 'm/s', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_rhosnow_lic = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'rhosnow_lic', 'snow density lic', 'kg/m3', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_sens_prec_liq_oce = ctrl_out((/ 5, 5, 10, 10, 5, 10, 11, 11, 11, 11/), &
     'sens_rain_oce', 'Sensible heat flux of liquid prec. over ocean', 'W/m2', (/ ('', i=1, 10) /))
@@ -743 +750 @@
   TYPE(ctrl_out), SAVE :: o_prsw = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'prsw', 'Precipitable solid water', 'kg/m2', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_prbsw = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'prbsw', 'Precipitable blowing snow', 'kg/m2', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_s_pblh = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     's_pblh', 'Boundary Layer Height', 'm', (/ ('', i=1, 10) /))
@@ -1432 +1441 @@
   TYPE(ctrl_out), SAVE :: o_ocond = ctrl_out((/ 2, 3, 4, 10, 10, 10, 11, 11, 11, 11/), &
     'ocond', 'Condensed water', 'kg/kg', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_qbs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'qbs', 'Specific content of blowing snow', 'kg/kg', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_wvapp = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'wvapp', '', '', (/ ('', i=1, 10) /))
@@ -1462 +1473 @@
   TYPE(ctrl_out), SAVE :: o_rneblsvol = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'rneblsvol', 'LS Cloud fraction by volume', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_pfraclr = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'pfraclr', 'LS precipitation fraction clear-sky part', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_pfracld = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'pfracld', 'LS precipitation fraction cloudy part', '-', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_rhum = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'rhum', 'Relative humidity', '-', (/ ('', i=1, 10) /))
@@ -1494 +1509 @@
   TYPE(ctrl_out), SAVE :: o_dqsphy2d = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'dqsphy2d', 'Physics dQS', '(kg/m2)/s', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_dqbsphy = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'dqbsphy', 'Physics dQBS', '(kg/kg)/s', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_dqbsphy2d = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'dqbsphy2d', 'Physics dQBS', '(kg/m2)/s', (/ ('', i=1, 10) /)) 
   TYPE(ctrl_out), SAVE :: o_pr_con_l = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'pr_con_l', 'Convective precipitation lic', ' ', (/ ('', i=1, 10) /))
@@ -1502 +1521 @@
   TYPE(ctrl_out), SAVE :: o_pr_lsc_i = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'pr_lsc_i', 'Large scale precipitation ice', ' ', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_pr_bs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'pr_bs', 'profile of blowing snow flux', ' ', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_re = ctrl_out((/ 5, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     're', 'Cloud droplet effective radius', 'um', (/ ('', i=1, 10) /))
@@ -1530 +1551 @@
   TYPE(ctrl_out), SAVE :: o_stratomask = ctrl_out((/ 2,  6, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'stratomask', 'Stratospheric fraction', '1', (/ ('', i=1, 10) /))
+!FC
+  TYPE(ctrl_out), SAVE :: o_zxfluxt = ctrl_out((/ 2,  6, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'fluxt', 'flux h ', 'W/m2', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_zxfluxq = ctrl_out((/ 2,  6, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'fluxq', 'flux q ', 'kg/(s*m2)', (/ ('', i=1, 10) /))
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -1599 +1625 @@
   TYPE(ctrl_out), SAVE :: o_dqsdyn2d = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'dqsdyn2d', 'Dynamics dQS', '(kg/m2)/s', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_dqbsdyn = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'dqbsdyn', 'Dynamics dQBS', '(kg/kg)/s', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_dqbsdyn2d = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'dqbsdyn2d', 'Dynamics dQBS', '(kg/m2)/s', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_dudyn = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'dudyn', 'Dynamics dU', 'm/s2', (/ ('', i=1, 10) /))
@@ -1673 +1703 @@
   TYPE(ctrl_out), SAVE :: o_dqeva2d = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'dqeva2d', 'Reevaporation dQ', '(kg/m2)/s', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_dqbsvdf = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'dqbsvdf', 'Boundary-layer dQBS', '(kg/kg)/s', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_dqbsbs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'dqbsbs', 'Blowing snow dQBS', '(kg/kg)/s', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_dtbs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'dtbs', 'Blowing snow dT', '(K)/s', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_dqbs = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
+    'dqbs', 'Blowing snow dQ', '(kg/kg)/s', (/ ('', i=1, 10) /))
 
 !!!!!!!!!!!!!!!! Specifique thermiques

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/phys_output_var_mod.F90

@@ -30 +30 @@
   REAL, SAVE, ALLOCATABLE :: d_qw_col(:)      ! watter vapour mass budget for each column (kg/m2/s)
   REAL, SAVE, ALLOCATABLE :: d_ql_col(:)      ! liquid watter mass budget for each column (kg/m2/s)
-  REAL, SAVE, ALLOCATABLE :: d_qs_col(:)      ! solid watter mass budget for each column (kg/m2/s)
+  REAL, SAVE, ALLOCATABLE :: d_qs_col(:)      ! cloud ice mass budget for each column (kg/m2/s)
+  REAL, SAVE, ALLOCATABLE :: d_qbs_col(:)     ! blowing snow mass budget for each column (kg/m2/s)
   REAL, SAVE, ALLOCATABLE :: d_qt_col(:)      ! total watter mass budget for each column (kg/m2/s)
   REAL, SAVE, ALLOCATABLE :: d_ek_col(:)      ! kinetic energy budget for each column (W/m2)
@@ -36 +37 @@
   REAL, SAVE, ALLOCATABLE :: d_h_qw_col(:)    ! enthalpy budget of watter vapour for each column (W/m2)
   REAL, SAVE, ALLOCATABLE :: d_h_ql_col(:)    ! enthalpy budget of liquid watter for each column (W/m2)
-  REAL, SAVE, ALLOCATABLE :: d_h_qs_col(:)    ! enthalpy budget of solid watter  for each column (W/m2)
+  REAL, SAVE, ALLOCATABLE :: d_h_qs_col(:)    ! enthalpy budget of cloud ice  for each column (W/m2)
+  REAL, SAVE, ALLOCATABLE :: d_h_qbs_col(:)    ! enthalpy budget of blowing snow for each column (W/m2)
   REAL, SAVE, ALLOCATABLE :: d_h_col(:)       ! total enthalpy budget for each column (W/m2)
-  !$OMP THREADPRIVATE(d_qw_col, d_ql_col, d_qs_col, d_qt_col, d_ek_col, d_h_dair_col)
-  !$OMP THREADPRIVATE(d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_col)
+  !$OMP THREADPRIVATE(d_qw_col, d_ql_col, d_qs_col, d_qbs_col, d_qt_col, d_ek_col, d_h_dair_col)
+  !$OMP THREADPRIVATE(d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_qbs_col, d_h_col)
 
   ! Outputs used in cloudth_vert to extract the moments of the horizontal and 
@@ -173 +175 @@
 
     allocate (bils_ec(klon),bils_ech(klon),bils_tke(klon),bils_diss(klon),bils_kinetic(klon),bils_enthalp(klon),bils_latent(klon))
-    allocate (d_qw_col(klon), d_ql_col(klon), d_qs_col(klon), d_qt_col(klon), d_ek_col(klon), d_h_dair_col(klon) &
-  &         , d_h_qw_col(klon), d_h_ql_col(klon), d_h_qs_col(klon), d_h_col(klon))
-    d_qw_col=0. ; d_ql_col=0. ; d_qs_col=0. ; d_qt_col=0. ; d_ek_col=0. ; d_h_dair_col =0.
-    d_h_qw_col=0. ; d_h_ql_col=0. ; d_h_qs_col=0. ; d_h_col=0.
+    allocate (d_qw_col(klon), d_ql_col(klon), d_qs_col(klon), d_qbs_col(klon), d_qt_col(klon), d_ek_col(klon), d_h_dair_col(klon) &
+  &         , d_h_qw_col(klon), d_h_ql_col(klon), d_h_qs_col(klon), d_h_qbs_col(klon), d_h_col(klon))
+    d_qw_col=0. ; d_ql_col=0. ; d_qs_col=0. ; d_qbs_col=0. ; d_qt_col=0. ; d_ek_col=0. ; d_h_dair_col =0.
+    d_h_qw_col=0. ; d_h_ql_col=0. ; d_h_qs_col=0. ; d_h_qbs_col=0. ; d_h_col=0.
 
     ! Outputs used in cloudth_vert
@@ -223 +225 @@
     deallocate(sza_o)
     deallocate (bils_ec,bils_ech,bils_tke,bils_diss,bils_kinetic,bils_enthalp,bils_latent)
-    deallocate (d_qw_col, d_ql_col, d_qs_col, d_qt_col, d_ek_col, d_h_dair_col &
-  &           , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_col)
+    deallocate (d_qw_col, d_ql_col, d_qs_col, d_qbs_col, d_qt_col, d_ek_col, d_h_dair_col &
+  &           , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_qbs_col, d_h_col)
 
     ! Outputs used in cloudth_vert

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/phys_output_write_mod.F90

@@ -17 +17 @@
   SUBROUTINE phys_output_write(itap, pdtphys, paprs, pphis, &
        pplay, lmax_th, aerosol_couple,         &
-       ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ok_sync, &
+       ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ibs, ok_sync, &
        ptconv, read_climoz, clevSTD, ptconvth, &
        d_u, d_t, qx, d_qx, zmasse, flag_aerosol, flag_aerosol_strat, ok_cdnc)
@@ -47 +47 @@
          o_psol, o_mass, o_qsurf, o_qsol, &
          o_precip, o_rain_fall, o_rain_con, o_ndayrain, o_plul, o_pluc, o_plun, &
-         o_snow, o_msnow, o_fsnow, o_evap, o_ep,o_epmax_diag, & ! epmax_cape
+         o_snow, o_msnow, o_fsnow, o_evap, o_snowerosion, o_ustart_lic, o_rhosnow_lic, o_bsfall, & 
+         o_ep,o_epmax_diag, & ! epmax_cape
          o_tops, o_tops0, o_topl, o_topl0, &
          o_SWupTOA, o_SWupTOAclr, o_SWupTOAcleanclr, o_SWdnTOA, o_fdiffSWdnSFC, &
@@ -81 +82 @@
          o_Mipsh, o_Ma, &
          o_dnwd, o_dnwd0, o_ftime_deepcv, o_ftime_con, o_mc, &
-         o_prw, o_prlw, o_prsw, o_s_pblh, o_s_pblt, o_s_lcl, &
+         o_prw, o_prlw, o_prsw, o_prbsw, o_s_pblh, o_s_pblt, o_s_lcl, &
          o_s_therm, o_uSTDlevs, o_vSTDlevs, &
          o_wSTDlevs, o_zSTDlevs, o_qSTDlevs, &
@@ -106 +107 @@
          o_weakinv, o_dthmin, o_cldtau, &
          o_cldemi, o_pr_con_l, o_pr_con_i, &
-         o_pr_lsc_l, o_pr_lsc_i, o_re, o_fl, &
+         o_pr_lsc_l, o_pr_lsc_i, o_pr_bs, o_re, o_fl, &
          o_rh2m, &
          o_qsat2m, o_tpot, o_tpote, o_SWnetOR, &
@@ -134 +135 @@
          o_cldicemxrat, o_cldwatmxrat, o_reffclwtop, o_ec550aer, &
          o_lwcon, o_iwcon, o_temp, o_theta, &
-         o_ovapinit, o_ovap, o_oliq, o_ocond, o_geop, &
+         o_ovapinit, o_ovap, o_oliq, o_ocond, o_geop,o_qbs, &
          o_vitu, o_vitv, o_vitw, o_pres, o_paprs, &
          o_zfull, o_zhalf, o_rneb, o_rnebjn, o_rnebcon, &
          o_rnebls, o_rneblsvol, o_rhum, o_rhl, o_rhi, o_ozone, o_ozone_light, &
+         o_pfraclr, o_pfracld, &
          o_duphy, o_dtphy, o_dqphy, o_dqphy2d, o_dqlphy, o_dqlphy2d, &
-         o_dqsphy, o_dqsphy2d, o_albe_srf, o_z0m_srf, o_z0h_srf, &
+         o_dqsphy, o_dqsphy2d, o_dqbsphy, o_dqbsphy2d, o_albe_srf, o_z0m_srf, o_z0h_srf, &
          o_ages_srf, o_snow_srf, o_alb1, o_alb2, o_tke, o_tke_dissip, &
          o_tke_max, o_kz, o_kz_max, o_clwcon, &
          o_dtdyn, o_dqdyn, o_dqdyn2d, o_dqldyn, o_dqldyn2d, & 
-         o_dqsdyn, o_dqsdyn2d, o_dudyn, o_dvdyn, &
+         o_dqsdyn, o_dqsdyn2d, o_dqbsdyn, o_dqbsdyn2d, o_dudyn, o_dvdyn, &
          o_dtcon, o_tntc, o_ducon, o_dvcon, &
          o_dqcon, o_dqcon2d, o_tnhusc, o_tnhusc, o_dtlsc, &
@@ -151 +153 @@
          o_ptconvth, o_lmaxth, o_dtvdf, &
          o_dtdis, o_dqvdf, o_dqvdf2d, o_dteva, o_dqeva, o_dqeva2d, &
+         o_dqbsvdf, o_dtbs, o_dqbs, o_dqbsbs, &
          o_ptconv, o_ratqs, o_dtthe, & 
          o_duthe, o_dvthe, o_ftime_th, &
@@ -204 +207 @@
          o_dxtajs,o_dxtvdf,o_dxtthe, o_dxtch4, &
          o_dxtprod_nucl,o_dxtcosmo,o_dxtdecroiss, &
+         o_xtevap_srf, &
 #endif
 ! Tropopause
@@ -219 +223 @@
          o_flx_co2_ff, o_flx_co2_bb, & 
          o_delta_sst, o_delta_sal, o_ds_ns, o_dt_ns, o_dter, o_dser, o_tkt, &
-         o_tks, o_taur, o_sss
+         o_tks, o_taur, o_sss, &
+!FC
+         o_zxfluxt,o_zxfluxq
 
 #ifdef CPP_StratAer
@@ -241 +247 @@
     USE phys_state_var_mod, ONLY: heat_volc, cool_volc !NL
 
-    USE phys_state_var_mod, ONLY: pctsrf, rain_fall, snow_fall, &
+    USE phys_state_var_mod, ONLY: pctsrf, rain_fall, snow_fall, bs_fall,&
          qsol, z0m, z0h, fevap, agesno, &
-         nday_rain, rain_con, snow_con, &
+         nday_rain, ndayrain_mth, rain_con, snow_con, &
          topsw, toplw, toplw0, swup, swdn, solswfdiff, &
          topsw0, swupc0, swdnc0, swup0, swdn0, SWup200, SWup200clr, &
@@ -269 +275 @@
          wTSTD, u2STD, v2STD, T2STD, missing_val_nf90, delta_sal, ds_ns, &
 #ifdef ISO
-        xtrain_con, xtsnow_con, xtrain_fall, xtsnow_fall, &
+        xtrain_con, xtsnow_con, xtrain_fall, xtsnow_fall, fxtevap, &
 #endif
          dt_ns, delta_sst, dter, dser
@@ -275 +281 @@
     USE phys_local_var_mod, ONLY: zxfluxlat, slp, ptstar, pt0, zxtsol, zt2m, &
          zn2mout, t2m_min_mon, t2m_max_mon, evap, &
+         snowerosion, zxustartlic, zxrhoslic, &
          l_mixmin,l_mix, tke_dissip, &
          zu10m, zv10m, zq2m, zustar, zxqsurf, &
@@ -288 +295 @@
          uwat, vwat, &
          rneb_seri, d_rneb_dyn, &
-         plcl, plfc, wbeff, convoccur, upwd, dnwd, dnwd0, prw, prlw, prsw, &
+         plcl, plfc, wbeff, convoccur, upwd, dnwd, dnwd0, prw, prlw, prsw,prbsw, &
          s_pblh, s_pblt, s_lcl, s_therm, uwriteSTD, &
          vwriteSTD, wwriteSTD, phiwriteSTD, qwriteSTD, &
@@ -308 +315 @@
          alp_bl_stat, alp_bl_fluct_tke, slab_wfbils, &
          weak_inversion, dthmin, cldtau, cldemi, &
-         pmflxr, pmflxs, prfl, psfl, re, fl, rh2m, &
+         pmflxr, pmflxs, prfl, psfl,bsfl, re, fl, rh2m, &
          qsat2m, tpote, tpot, d_ts, od443aer, od550aer, dryod550aer, &
          od865aer, abs550aer, od550lt1aer, sconcso4, sconcno3, &
@@ -324 +331 @@
          icc3dcon, icc3dstra, zfice, reffclwtop, &
          ec550aer, flwc, fiwc, t_seri, theta, q_seri, &
-         ql_seri, qs_seri, tr_seri, &
+         ql_seri, qs_seri, qbs_seri, tr_seri, qbs_seri,&
          zphi, u_seri, v_seri, omega, cldfra, &
-         rneb, rnebjn, rneblsvol, zx_rh, zx_rhl, zx_rhi, d_t_dyn,  & 
-         d_q_dyn,  d_ql_dyn, d_qs_dyn, &
-         d_q_dyn2d,  d_ql_dyn2d, d_qs_dyn2d, &
+         rneb, rnebjn, rneblsvol, zx_rh, zx_rhl, zx_rhi, &
+         pfraclr, pfracld, d_t_dyn,  & 
+         d_q_dyn,  d_ql_dyn, d_qs_dyn, d_qbs_dyn,  &
+         d_q_dyn2d,  d_ql_dyn2d, d_qs_dyn2d, d_qbs_dyn2d, &
          d_u_dyn, d_v_dyn, d_t_con, d_t_ajsb, d_t_ajs, &
          d_u_ajs, d_v_ajs, &
@@ -336 +344 @@
          d_t_lscst, d_q_lscth, d_q_lscst, plul_th, &
          plul_st, d_t_vdf, d_t_diss, d_q_vdf, d_q_eva, &
+         d_t_bs, d_q_bs, d_qbs_bs, d_qbs_vdf, &
          zw2, fraca, zmax_th, d_q_ajsb, d_t_ec, d_u_vdf, &
          d_v_vdf, d_u_oro, d_v_oro, d_t_oro, d_u_lif, &
@@ -350 +359 @@
 #endif
          ep, epmax_diag, &  ! epmax_cape
-         p_tropopause, t_tropopause, z_tropopause
+         p_tropopause, t_tropopause, z_tropopause, &
+         zxfluxt,zxfluxq
+!FC
 
 #ifdef CPP_StratAer 
@@ -431 +442 @@
 
     ! Input
-    INTEGER :: itap, ivap, iliq, isol, read_climoz
+    INTEGER :: itap, ivap, iliq, isol, ibs, read_climoz
     INTEGER, DIMENSION(klon) :: lmax_th
     LOGICAL :: aerosol_couple, ok_sync
@@ -887 +898 @@
 
        IF (vars_defined) THEN
-          DO i = 1, klon
+          IF (ok_bs) THEN
+             DO i = 1, klon
+             zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i) + bs_fall(i)
+             ENDDO
+          ELSE
+             DO i = 1, klon
              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
-          ENDDO
+             ENDDO
+          ENDIF
        ENDIF
 
        CALL histwrite_phy(o_precip, zx_tmp_fi2d)
        CALL histwrite_phy(o_rain_fall, rain_fall)
-       CALL histwrite_phy(o_ndayrain, nday_rain)
+       CALL histwrite_phy(o_ndayrain, ndayrain_mth)
 
        ! epmax_cape:
@@ -919 +936 @@
        CALL histwrite_phy(o_fsnow, zfra_o)
        CALL histwrite_phy(o_evap, evap)
+
+       IF (ok_bs) THEN
+           CALL histwrite_phy(o_bsfall, bs_fall)     
+           CALL histwrite_phy(o_snowerosion, snowerosion)
+           CALL histwrite_phy(o_ustart_lic, zxustartlic)
+           CALL histwrite_phy(o_rhosnow_lic, zxrhoslic)
+       ENDIF
 
        IF (vars_defined) THEN
@@ -1105 +1129 @@
        ENDIF
        CALL histwrite_phy(o_tauy, zx_tmp_fi2d)
-
-       ! Etienne: test sorties pour compil sur JZ
-!       IF (landice_opt .GE. 1) THEN
-!          CALL histwrite_phy(o_snowsrf, snow_o)
-!          CALL histwrite_phy(o_qsnow, qsnow)
-!          CALL histwrite_phy(o_snowhgt,snowhgt)
-!          CALL histwrite_phy(o_toice,to_ice)
-!          CALL histwrite_phy(o_sissnow,sissnow)
-!          CALL histwrite_phy(o_runoff,runoff)
-!          CALL histwrite_phy(o_albslw3,albsol3_lic)
-!       ENDIF
 
        DO nsrf = 1, nbsrf
@@ -1281 +1294 @@
        CALL histwrite_phy(o_prlw, prlw)
        CALL histwrite_phy(o_prsw, prsw)
+       IF (ok_bs) THEN
+       CALL histwrite_phy(o_prbsw, prbsw)
+       ENDIF
        CALL histwrite_phy(o_s_pblh, s_pblh)
        CALL histwrite_phy(o_s_pblt, s_pblt)
@@ -1526 +1542 @@
        CALL histwrite_phy(o_re, re)
        CALL histwrite_phy(o_fl, fl)
+
+       IF (ok_bs) THEN
+         CALL histwrite_phy(o_pr_bs, bsfl(:,1:klev))
+       ENDIF
+
        IF (vars_defined) THEN
           DO i=1, klon
@@ -1783 +1804 @@
        CALL histwrite_phy(o_ovap, q_seri)
        CALL histwrite_phy(o_oliq, ql_seri)
+       !FC
+       CALL histwrite_phy(o_zxfluxt, zxfluxt)
+       CALL histwrite_phy(o_zxfluxq, zx_tmp_fi3d)
+       !FC
 
        IF (vars_defined) zx_tmp_fi3d = ql_seri+qs_seri
@@ -1796 +1821 @@
        IF (vars_defined) zx_tmp_fi3d = zphi/RG
        CALL histwrite_phy(o_zfull,zx_tmp_fi3d)
+
+       IF (ok_bs) THEN
+          CALL histwrite_phy(o_qbs, qbs_seri)
+       ENDIF
 
 #ifdef CPP_XIOS
@@ -1846 +1875 @@
           IF (vars_defined) zx_tmp_fi3d = zx_rhi * 100.
           CALL histwrite_phy(o_rhi, zx_tmp_fi3d)
+       ENDIF
+     
+       IF (ok_new_lscp) THEN
+           CALL histwrite_phy(o_pfraclr, pfraclr)
+           CALL histwrite_phy(o_pfracld, pfracld)
        ENDIF
 
@@ -1908 +1942 @@
        zx_tmp_fi2d=0.0
        CALL histwrite_phy(o_dqsphy2d,  zx_tmp_fi2d)
+       ENDIF
+
+
+       IF (ok_bs) THEN
+       CALL histwrite_phy(o_dqbsphy,  d_qx(:,:,ibs))
+       IF (vars_defined) CALL water_int(klon,klev,d_qx(:,:,ibs),zmasse,zx_tmp_fi2d)
+       CALL histwrite_phy(o_dqbsphy2d,  zx_tmp_fi2d)
+       ELSE
+       zx_tmp_fi3d=0.0
+       CALL histwrite_phy(o_dqbsphy,  zx_tmp_fi3d)
+       zx_tmp_fi2d=0.0
+       CALL histwrite_phy(o_dqbsphy2d,  zx_tmp_fi2d)
        ENDIF
 
@@ -1958 +2004 @@
 
        CALL histwrite_phy(o_dqsdyn2d, d_qs_dyn2d)
+
+       IF (ok_bs) THEN
+       CALL histwrite_phy(o_dqbsdyn, d_qbs_dyn)
+       CALL histwrite_phy(o_dqbsdyn2d, d_qbs_dyn2d)
+       ENDIF
 
        CALL histwrite_phy(o_dudyn, d_u_dyn)
@@ -2101 +2152 @@
        ENDIF
        CALL histwrite_phy(o_dvthe, zx_tmp_fi3d)
+
+       IF (ok_bs) THEN
+          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_qbs_vdf(1:klon,1:klev)/pdtphys
+          CALL histwrite_phy(o_dqbsvdf, zx_tmp_fi3d)
+          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_qbs_bs(1:klon,1:klev)/pdtphys
+          CALL histwrite_phy(o_dqbsbs, zx_tmp_fi3d)
+          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_bs(1:klon,1:klev)/pdtphys
+          CALL histwrite_phy(o_dqbs, zx_tmp_fi3d)
+          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_bs(1:klon,1:klev)/pdtphys
+          CALL histwrite_phy(o_dtbs, zx_tmp_fi3d)
+       ENDIF
 
        IF (iflag_thermals>=1) THEN
@@ -2614 +2676 @@
         CALL histwrite_phy(o_xtoliq(ixt), xtl_seri(ixt,:,:))
 
+        DO nsrf = 1, nbsrf ! ajout Camille 8 mai 2023
+        IF (vars_defined)       zx_tmp_fi2d(1 : klon) = fxtevap(ixt,:, nsrf)
+        CALL histwrite_phy(o_xtevap_srf(ixt,nsrf), zx_tmp_fi2d)
+        ENDDO
+
         IF (vars_defined) zx_tmp_fi3d(:,:)=xtl_seri(ixt,:,:)+xts_seri(ixt,:,:)
         CALL histwrite_phy(o_xtcond(ixt), zx_tmp_fi3d)

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/phys_state_var_mod.F90

@@ -54 +54 @@
 
 
-      REAL, ALLOCATABLE, SAVE :: rain_fall(:), snow_fall(:)
-!$OMP THREADPRIVATE( rain_fall, snow_fall)
+      REAL, ALLOCATABLE, SAVE :: rain_fall(:), snow_fall(:), bs_fall(:)
+!$OMP THREADPRIVATE( rain_fall, snow_fall, bs_fall)
       REAL, ALLOCATABLE, SAVE :: solsw(:), solswfdiff(:), sollw(:)
 !$OMP THREADPRIVATE(solsw, solswfdiff, sollw)
@@ -82 +82 @@
       REAL, ALLOCATABLE, SAVE :: t_ancien(:,:), q_ancien(:,:)
 !$OMP THREADPRIVATE(t_ancien, q_ancien)
-      REAL, ALLOCATABLE, SAVE :: ql_ancien(:,:), qs_ancien(:,:)
-!$OMP THREADPRIVATE(ql_ancien, qs_ancien)
-      REAL, ALLOCATABLE, SAVE :: prw_ancien(:), prlw_ancien(:), prsw_ancien(:)
-!$OMP THREADPRIVATE(prw_ancien, prlw_ancien, prsw_ancien)
+      REAL, ALLOCATABLE, SAVE :: ql_ancien(:,:), qs_ancien(:,:), qbs_ancien(:,:)
+!$OMP THREADPRIVATE(ql_ancien, qs_ancien, qbs_ancien)
+      REAL, ALLOCATABLE, SAVE :: prw_ancien(:), prlw_ancien(:), prsw_ancien(:), prbsw_ancien(:)
+!$OMP THREADPRIVATE(prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien)
 #ifdef ISO
       REAL, ALLOCATABLE, SAVE :: xt_ancien(:,:,:),xtl_ancien(:,:,:),xts_ancien(:,:,:)
@@ -313 +313 @@
       REAL,ALLOCATABLE,SAVE :: total_rain(:), nday_rain(:)  
 !$OMP THREADPRIVATE(total_rain,nday_rain)
+      REAL,ALLOCATABLE,SAVE :: ndayrain_mth(:)
+!$OMP THREADPRIVATE(ndayrain_mth)
       REAL,ALLOCATABLE,SAVE :: paire_ter(:)
 !$OMP THREADPRIVATE(paire_ter)
@@ -547 +549 @@
       ALLOCATE(rain_fall(klon))
       ALLOCATE(snow_fall(klon))
+      ALLOCATE(bs_fall(klon))
       ALLOCATE(solsw(klon), solswfdiff(klon), sollw(klon))
       sollw=0.0
@@ -556 +559 @@
       ALLOCATE(rugoro(klon))
       ALLOCATE(t_ancien(klon,klev), q_ancien(klon,klev))
-      ALLOCATE(ql_ancien(klon,klev), qs_ancien(klon,klev))
-      ALLOCATE(prw_ancien(klon), prlw_ancien(klon), prsw_ancien(klon))
+      ALLOCATE(ql_ancien(klon,klev), qs_ancien(klon,klev), qbs_ancien(klon,klev))
+      ALLOCATE(prw_ancien(klon), prlw_ancien(klon), prsw_ancien(klon), prbsw_ancien(klon))
       ALLOCATE(u_ancien(klon,klev), v_ancien(klon,klev))
 !!! Rom P >>>
@@ -655 +658 @@
       ALLOCATE(pfrac_1nucl(klon,klev))
       ALLOCATE(total_rain(klon), nday_rain(klon))
+      ALLOCATE(ndayrain_mth(klon))
       ALLOCATE(paire_ter(klon))
       ALLOCATE(albsol1(klon), albsol2(klon))
@@ -763 +767 @@
 !FC
       DEALLOCATE(treedrg)
-      DEALLOCATE(rain_fall, snow_fall, solsw, solswfdiff, sollw, radsol, swradcorr)
+      DEALLOCATE(rain_fall, snow_fall, bs_fall,solsw, solswfdiff, sollw, radsol, swradcorr)
       DEALLOCATE(zmea, zstd, zsig, zgam)
       DEALLOCATE(zthe, zpic, zval)
       DEALLOCATE(rugoro, t_ancien, q_ancien, clwcon, rnebcon)
-      DEALLOCATE(qs_ancien, ql_ancien, rneb_ancien)
-      DEALLOCATE(prw_ancien, prlw_ancien, prsw_ancien)
+      DEALLOCATE(qs_ancien, ql_ancien, qbs_ancien, rneb_ancien)
+      DEALLOCATE(prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien)
       DEALLOCATE(qtc_cv,sigt_cv)
       DEALLOCATE(u_ancien, v_ancien)
@@ -835 +839 @@
       DEALLOCATE(pfrac_1nucl)
       DEALLOCATE(total_rain, nday_rain)
+      DEALLOCATE(ndayrain_mth)
       DEALLOCATE(paire_ter)
       DEALLOCATE(albsol1, albsol2)

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/physiq_mod.F90

@@ -84 +84 @@
     USE atke_turbulence_ini_mod, ONLY : atke_ini
     USE thermcell_ini_mod, ONLY : thermcell_ini
+    USE blowing_snow_ini_mod, ONLY : blowing_snow_ini , qbst_bs 
     USE lscp_ini_mod, ONLY : lscp_ini
 
@@ -141 +142 @@
 !!!!!!!!!!!!!!!!!!  END "USE" for CPP keys !!!!!!!!!!!!!!!!!!!!!!
 
+USE physiqex_mod, ONLY : physiqex
 USE phys_local_var_mod, ONLY: phys_local_var_init, phys_local_var_end, &
        ! [Variables internes non sauvegardees de la physique]
        ! Variables locales pour effectuer les appels en serie
-       t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,tr_seri,rneb_seri, &
+       t_seri,q_seri,ql_seri,qs_seri,qbs_seri,u_seri,v_seri,tr_seri,rneb_seri, &
        rhcl, &        
        ! Dynamic tendencies (diagnostics)
-       d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_u_dyn,d_v_dyn,d_tr_dyn,d_rneb_dyn, &
-       d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d, &
+       d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_qbs_dyn,d_u_dyn,d_v_dyn,d_tr_dyn,d_rneb_dyn, &
+       d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d,d_qbs_dyn2d, &
        ! Physic tendencies
        d_t_con,d_q_con,d_u_con,d_v_con, &
@@ -165 +167 @@
        plul_st,plul_th, &
        !
-       d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_t_diss, &
+       d_t_vdf,d_q_vdf, d_qbs_vdf, d_u_vdf,d_v_vdf,d_t_diss, &
        d_t_vdf_x, d_t_vdf_w, &
        d_q_vdf_x, d_q_vdf_w, &
        d_ts, &
+       !
+       d_t_bs,d_q_bs,d_qbs_bs, &
        !
 !       d_t_oli,d_u_oli,d_v_oli, &
@@ -216 +220 @@
        cldh, cldl,cldm, cldq, cldt,      &
        JrNt,                             &
-       dthmin, evap, fder, plcl, plfc,   &
-       prw, prlw, prsw,                  &
+       dthmin, evap, snowerosion,fder, plcl, plfc,   &
+       prw, prlw, prsw, prbsw,                  &
        s_lcl, s_pblh, s_pblt, s_therm,   &
        cdragm, cdragh,                   &
@@ -290 +294 @@
        !
        rneblsvol, &
+       pfraclr,pfracld, &
+       distcltop, &
        zqsatl, zqsats, &
        qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, &
@@ -305 +311 @@
        fsolsw, wfbils, wfbilo,  &
        wfevap, wfrain, wfsnow,  &  
-       prfl, psfl, fraca, Vprecip,  &
+       prfl, psfl,bsfl, fraca, Vprecip,  &
        zw2,  &
        !
@@ -317 +323 @@
        beta_prec,  &
        rneb,  &
-       zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic
-       !
+       zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic, &
+       zxfluxt,zxfluxq 
+       !
+      USE output_physiqex_mod, ONLY: output_physiqex
+
 
     IMPLICIT NONE
@@ -461 +470 @@
     !======================================================================
     !
-    ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional)
-    INTEGER,SAVE :: ivap, iliq, isol, irneb
-!$OMP THREADPRIVATE(ivap, iliq, isol, irneb)
+    ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional), blowing snow (optional)
+    INTEGER,SAVE :: ivap, iliq, isol, irneb, ibs
+!$OMP THREADPRIVATE(ivap, iliq, isol, irneb, ibs)
     !
     !
@@ -834 +843 @@
     !XXX PB 
     REAL fluxq(klon,klev, nbsrf)   ! flux turbulent d'humidite
-    !
-    REAL zxfluxt(klon, klev)
-    REAL zxfluxq(klon, klev)
+    REAL fluxqbs(klon,klev, nbsrf)   ! flux turbulent de neige soufflee
+    !
+    !FC    REAL zxfluxt(klon, klev)
+    !FC    REAL zxfluxq(klon, klev)
+    REAL zxfluxqbs(klon,klev)
     REAL zxfluxu(klon, klev)
     REAL zxfluxv(klon, klev)
@@ -920 +931 @@
     !
     ! tendance nulles
-    REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0
+    REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0, dqbs0
     REAL, dimension(klon)     :: dsig0, ddens0
     INTEGER, dimension(klon)  :: wkoccur1
@@ -944 +955 @@
     LOGICAL, SAVE :: ok_bug_split_th = .TRUE.
     !$OMP THREADPRIVATE(ok_bug_split_th)
+
+    ! Logical switch to a bug : modifying directly wake_deltat  by adding 
+    ! the (w) dry adjustment tendency to wake_deltat
+    LOGICAL, SAVE :: ok_bug_ajs_cv = .TRUE.
+    !$OMP THREADPRIVATE(ok_bug_ajs_cv)
 
     !
@@ -1061 +1077 @@
     REAL ztsol(klon)
     REAL q2m(klon,nbsrf)  ! humidite a 2m
-
+    REAL fsnowerosion(klon,nbsrf) ! blowing snow flux at surface
+    REAL qbsfra  ! blowing snow fraction
     !IM: t2m, q2m, ustar, u10m, v10m et t2mincels, t2maxcels
     CHARACTER*40 t2mincels, t2maxcels       !t2m min., t2m max
@@ -1136 +1153 @@
     !IM 100106 BEG : pouvoir sortir les ctes de la physique
     include "conema3.h"
-    include "fisrtilp.h"
     include "nuage.h"
     include "compbl.h"
@@ -1144 +1160 @@
     ! Declarations pour Simulateur COSP
     !============================================================
+    ! AI 10-22
+#ifdef CPP_COSP
+    include "ini_COSP.h"
+#endif
     real :: mr_ozone(klon,klev), phicosp(klon,klev)
 
@@ -1218 +1238 @@
     REAL pi
 
+
+    !======================================================================!
+    ! Bifurcation vers un nouveau moniteur physique pour experimenter      !
+    ! des solutions et préparer le couplage avec la physique de MesoNH     !
+    ! 14 mai 2023                                                          !
+    !======================================================================!
+    if (debut) then                                                        !
+       iflag_physiq=0
+       call getin_p('iflag_physiq', iflag_physiq)                          !
+    endif                                                                  !
+    if ( iflag_physiq == 2 ) then                                          !
+       call physiqex (nlon,nlev, &                                         !
+       debut,lafin,pdtphys_, &                                             !
+       paprs,pplay,pphi,pphis,presnivs, &                                  !
+       u,v,rot,t,qx, &                                                     !
+       flxmass_w, &                                                        !
+       d_u, d_v, d_t, d_qx, d_ps)                                          !
+       return                                                              !
+    endif                                                                  !
+    !======================================================================!
+
+
     pi = 4. * ATAN(1.)
 
@@ -1244 +1286 @@
     ! Utilise notamment en 1D mais peut etre active egalement en 3D
     ! en imposant la valeur de igout.
-    !======================================================================d
+    !======================================================================
     IF (prt_level.ge.1) THEN
        igout=klon/2+1/klon
@@ -1275 +1317 @@
        isol = strIdx(tracers(:)%name, addPhase('H2O', 's'))
        irneb= strIdx(tracers(:)%name, addPhase('H2O', 'r'))
+       ibs  = strIdx(tracers(:)%name, addPhase('H2O', 'b'))
        CALL init_etat0_limit_unstruct
        IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
@@ -1324 +1367 @@
        ENDIF
 
-       IF (ok_ice_sursat.AND.(nqo.NE.4)) THEN
+       IF (ok_ice_sursat.AND.(nqo.LT.4)) THEN
           WRITE (lunout, *) ' ok_ice_sursat=y requires 4 H2O tracers ', &
                '(H2O_g, H2O_l, H2O_s, H2O_r) but nqo=', nqo, '. Might as well stop here.'
@@ -1342 +1385 @@
           CALL abort_physic(modname,abort_message,1)
        ENDIF
+
+        IF (ok_bs) THEN
+         IF ((ok_ice_sursat.AND.nqo .LT.5).OR.(.NOT.ok_ice_sursat.AND.nqo.LT.4)) THEN
+             WRITE (lunout, *) 'activation of blowing snow needs a specific H2O tracer', &
+                               'but nqo=', nqo
+             abort_message='see above'
+             CALL abort_physic(modname,abort_message, 1)
+         ENDIF
+        ENDIF
 
        Ncvpaseq1 = 0
@@ -1404 +1456 @@
        CALL getin_p('ok_bug_cv_trac',ok_bug_cv_trac)
        CALL getin_p('ok_bug_split_th',ok_bug_split_th)
+       CALL getin_p('ok_bug_ajs_cv',ok_bug_ajs_cv)
        fl_ebil = 0 ! by default, conservation diagnostics are desactivated
        CALL getin_p('fl_ebil',fl_ebil)
@@ -1676 +1729 @@
       IF (.NOT. create_etat0_limit) CALL init_readaerosolstrato(flag_aerosol_strat)  !! initialise aero strato from file for XIOS interpolation (unstructured_grid)
 
+      if (ok_cosp) then
 #ifdef CPP_COSP
-      IF (ok_cosp) THEN
-!           DO k = 1, klev
-!             DO i = 1, klon
-!               phicosp(i,k) = pphi(i,k) + pphis(i)
-!             ENDDO
-!           ENDDO
+        ! A.I : Initialisations pour le 1er passage a Cosp
+        CALL ini_COSP(ref_liq_cosp0,ref_ice_cosp0,pctsrf_cosp0,zu10m_cosp0,zv10m_cosp0, &
+               zxtsol_cosp0,zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0, &
+               fiwc_cosp0,prfl_cosp0,psfl_cosp0,pmflxr_cosp0,pmflxs_cosp0, &
+               mr_ozone_cosp0,cldtau_cosp0,cldemi_cosp0,JrNt_cosp0)
+
         CALL phys_cosp(itap,phys_tstep,freq_cosp, &
                ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
@@ -1695 +1749 @@
                pmflxr(:,1:klev),pmflxs(:,1:klev), &
                mr_ozone,cldtau, cldemi)
-      ENDIF
 #endif
 
 #ifdef CPP_COSP2
-        IF (ok_cosp) THEN
-!           DO k = 1, klev
-!             DO i = 1, klon
-!               phicosp(i,k) = pphi(i,k) + pphis(i)
-!             ENDDO
-!           ENDDO
           CALL phys_cosp2(itap,phys_tstep,freq_cosp, &
                ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
@@ -1717 +1764 @@
                pmflxr(:,1:klev),pmflxs(:,1:klev), &
                mr_ozone,cldtau, cldemi)
-       ENDIF
 #endif
 
 #ifdef CPP_COSPV2
-        IF (ok_cosp) THEN
-           DO k = 1, klev
-             DO i = 1, klon
-               phicosp(i,k) = pphi(i,k) + pphis(i)
-             ENDDO
-           ENDDO
           CALL lmdz_cosp_interface(itap,phys_tstep,freq_cosp, &
                ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
@@ -1739 +1779 @@
                pmflxr(:,1:klev),pmflxs(:,1:klev), &
                mr_ozone,cldtau, cldemi)
-       ENDIF
 #endif
+      ENDIF 
 
        !
@@ -1756 +1796 @@
        CALL thermcell_ini(iflag_thermals,prt_level,tau_thermals,lunout, &
    &    RG,RD,RCPD,RKAPPA,RLVTT,RETV)
-       IF (ok_new_lscp) then
-           CALL lscp_ini(pdtphys,ok_ice_sursat)
-       endif
+       CALL lscp_ini(pdtphys,ok_ice_sursat, RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT,RD,RG)
+       CALL blowing_snow_ini(prt_level,lunout, &
+                             RCPD, RLSTT, RLVTT, RLMLT, &
+                             RVTMP2, RTT,RD,RG)
+
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -1784 +1826 @@
        CALL phys_output_write(itap, pdtphys, paprs, pphis,                    &
                               pplay, lmax_th, aerosol_couple,                 &
-                              ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ok_sync,&
+                              ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ibs,  ok_sync,&
                               ptconv, read_climoz, clevSTD,                   &
                               ptconvth, d_u, d_t, qx, d_qx, zmasse,           &
@@ -2255 +2297 @@
     dql0(:,:)=0.
     dqi0(:,:)=0.
+    dqbs0(:,:)=0.
     dsig0(:) = 0.
     ddens0(:) = 0.
@@ -2307 +2350 @@
           q_seri(i,k)  = qx(i,k,ivap)
           ql_seri(i,k) = qx(i,k,iliq)
+          qbs_seri(i,k) = 0.
           !CR: ATTENTION, on rajoute la variable glace
           IF (nqo.EQ.2) THEN             !--vapour and liquid only
@@ -2314 +2358 @@
              qs_seri(i,k) = qx(i,k,isol)
              rneb_seri(i,k) = 0.
-          ELSE IF (nqo.EQ.4) THEN        !--vapour, liquid, ice and rneb
+          ELSE IF (nqo.GE.4) THEN        !--vapour, liquid, ice and rneb and blowing snow
              qs_seri(i,k) = qx(i,k,isol)
+             IF (ok_ice_sursat) THEN
              rneb_seri(i,k) = qx(i,k,irneb)
+             ENDIF
+             IF (ok_bs) THEN
+             qbs_seri(i,k)= qx(i,k,ibs)
+             ENDIF
+
           ENDIF
+
+
        ENDDO
     ENDDO
@@ -2326 +2378 @@
     qql1(:)=0.0
     DO k = 1, klev
-      qql1(:)=qql1(:)+(q_seri(:,k)+ql_seri(:,k)+qs_seri(:,k))*zmasse(:,k)
+      qql1(:)=qql1(:)+(q_seri(:,k)+ql_seri(:,k)+qs_seri(:,k)+qbs_seri(:,k))*zmasse(:,k)
     ENDDO
     ENDIF
@@ -2382 +2434 @@
        d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/phys_tstep
        d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/phys_tstep
+       d_qbs_dyn(:,:) = (qbs_seri(:,:)-qbs_ancien(:,:))/phys_tstep
        CALL water_int(klon,klev,q_seri,zmasse,zx_tmp_fi2d)
        d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/phys_tstep
@@ -2388 +2441 @@
        CALL water_int(klon,klev,qs_seri,zmasse,zx_tmp_fi2d)
        d_qs_dyn2d(:)=(zx_tmp_fi2d(:)-prsw_ancien(:))/phys_tstep
+       CALL water_int(klon,klev,qbs_seri,zmasse,zx_tmp_fi2d)
+       d_qbs_dyn2d(:)=(zx_tmp_fi2d(:)-prbsw_ancien(:))/phys_tstep
        ! !! RomP >>>   td dyn traceur
        IF (nqtot > nqo) d_tr_dyn(:,:,:)=(tr_seri(:,:,:)-tr_ancien(:,:,:))/phys_tstep
@@ -2403 +2458 @@
        d_ql_dyn2d(:) = 0.0
        d_qs_dyn2d(:) = 0.0
+       d_qbs_dyn2d(:)= 0.0
        ! !! RomP >>>   td dyn traceur
        IF (nqtot > nqo) d_tr_dyn(:,:,:)= 0.0
        ! !! RomP <<<
        d_rneb_dyn(:,:)=0.0
+       d_qbs_dyn(:,:)=0.0
        ancien_ok = .TRUE.
     ENDIF
@@ -2522 +2579 @@
 
      CALL add_phys_tend &
-            (du0,dv0,d_t_eva,d_q_eva,d_ql_eva,d_qi_eva,paprs,&
+            (du0,dv0,d_t_eva,d_q_eva,d_ql_eva,d_qi_eva,dqbs0,paprs,&
                'eva',abortphy,flag_inhib_tend,itap,0)
     CALL prt_enerbil('eva',itap)
@@ -2698 +2755 @@
             longitude_deg, latitude_deg, rugoro,  zrmu0,      &
             sollwdown,    cldt,      &
-            rain_fall, snow_fall, solsw,   solswfdiff, sollw,     &
+            rain_fall, snow_fall, bs_fall, solsw,   solswfdiff, sollw,     &
             gustiness,                                &
-            t_seri,    q_seri,    u_seri,  v_seri,    &
+            t_seri,    q_seri,   qbs_seri,  u_seri,  v_seri,    &
                                 !nrlmd+jyg<
             wake_deltat, wake_deltaq, wake_cstar, wake_s, &
@@ -2711 +2768 @@
                                 !albedo SB >>>
                                 ! albsol1,   albsol2,   sens,    evap,      &
-            albsol_dir,   albsol_dif,   sens,    evap,   &  
+            albsol_dir,   albsol_dif,   sens,    evap, snowerosion, &  
                                 !albedo SB <<<
             albsol3_lic,runoff,   snowhgt,   qsnow, to_ice, sissnow, &
             zxtsol,    zxfluxlat, zt2m,    qsat2m,  zn2mout, &
-            d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf, d_t_diss, &
+            d_t_vdf,   d_q_vdf, d_qbs_vdf,  d_u_vdf, d_v_vdf, d_t_diss, &
                                 !nrlmd<
                                 !jyg<
@@ -2741 +2798 @@
             fluxt,   fluxu,  fluxv, &
             dsens,     devap,     zxsnow, &
-            zxfluxt,   zxfluxq,   q2m,     fluxq, pbl_tke, &
+            zxfluxt,   zxfluxq,  zxfluxqbs,  q2m, fluxq, fluxqbs, pbl_tke, &
                                 !nrlmd+jyg<
             wake_delta_pbl_TKE, &
@@ -2766 +2823 @@
        IF (klon_glo==1) THEN
           CALL add_pbl_tend &
-               (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,&
+               (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,d_qbs_vdf,paprs,&
                'vdf',abortphy,flag_inhib_tend,itap)
        ELSE
           CALL add_phys_tend &
-               (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,&
+               (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,d_qbs_vdf,paprs,&
                'vdf',abortphy,flag_inhib_tend,itap,0)
        ENDIF
        CALL prt_enerbil('vdf',itap)
+
        !--------------------------------------------------------------------
 
@@ -2824 +2882 @@
 
     ENDIF
+
+    ! ==================================================================
+    ! Blowing snow sublimation and sedimentation
+
+    d_t_bs(:,:)=0.
+    d_q_bs(:,:)=0.
+    d_qbs_bs(:,:)=0.
+    bsfl(:,:)=0.
+    bs_fall(:)=0.
+    IF (ok_bs) THEN
+
+     CALL call_blowing_snow_sublim_sedim(klon,klev,phys_tstep,t_seri,q_seri,qbs_seri,pplay,paprs, &
+                                        d_t_bs,d_q_bs,d_qbs_bs,bsfl,bs_fall)
+
+     CALL add_phys_tend &
+               (du0,dv0,d_t_bs,d_q_bs,dql0,dqi0,d_qbs_bs,paprs,&
+               'bs',abortphy,flag_inhib_tend,itap,0)
+
+    ENDIF
+
     ! =================================================================== c
     !   Calcul de Qsat
@@ -2994 +3072 @@
                 ENDDO
              ENDDO
-             IF (iflag_adjwk == 2) THEN
+             IF (iflag_adjwk == 2 .AND. OK_bug_ajs_cv) THEN
                CALL add_wake_tend &
                  (d_deltat_ajs_cv, d_deltaq_ajs_cv, dsig0, ddens0, ddens0, wkoccur1, 'ajs_cv', abortphy) 
-             ENDIF  ! (iflag_adjwk == 2)
+             ENDIF  ! (iflag_adjwk == 2 .AND. OK_bug_ajs_cv)
           ENDIF  ! (iflag_adjwk >= 1)
        ENDIF ! (iflag_wake>=1)
@@ -3248 +3326 @@
 !!
 !!
-    CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, paprs, &
+    CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, dqbs0, paprs, &
          'convection',abortphy,flag_inhib_tend,itap,0)
     CALL prt_enerbil('convection',itap)
@@ -3379 +3457 @@
        !-----------------------------------------------------------------------
        ! ajout des tendances des poches froides
-       CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,paprs,'wake', &
+       CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,dqbs0,paprs,'wake', &
             abortphy,flag_inhib_tend,itap,0)
        CALL prt_enerbil('wake',itap)
@@ -3537 +3615 @@
           !
           CALL add_phys_tend(d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs,  &
-                             dql0,dqi0,paprs,'thermals', abortphy,flag_inhib_tend,itap,0)
+                             dql0,dqi0,dqbs0,paprs,'thermals', abortphy,flag_inhib_tend,itap,0)
           CALL prt_enerbil('thermals',itap)
           !
@@ -3599 +3677 @@
           !--------------------------------------------------------------------
           ! ajout des tendances de l'ajustement sec ou des thermiques
-          CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,paprs, &
+          CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,dqbs0,paprs, &
                'ajsb',abortphy,flag_inhib_tend,itap,0)
           CALL prt_enerbil('ajsb',itap)
@@ -3633 +3711 @@
          ptconv,ptconvth,clwcon0th, rnebcon0th,     &
          paprs,pplay,t_seri,q_seri, qtc_cv, sigt_cv, zqsat, &
-         pbl_tke(:,:,is_ave),tke_dissip_ave,l_mix_ave,wprime_ave,t2m,q2m,fm_therm, &
+         pbl_tke(:,:,is_ave),tke_dissip_ave,l_mix_ave,wprime_ave,t2m,q2m,fm_therm,cell_area, &
          ratqs,ratqsc,ratqs_inter)
 
@@ -3657 +3735 @@
          t_seri, q_seri,ptconv,ratqs, &
          d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, rneb_seri, & 
+         pfraclr,pfracld, &
          radocond, picefra, rain_lsc, snow_lsc, &
          frac_impa, frac_nucl, beta_prec_fisrt, &
          prfl, psfl, rhcl,  &
          zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
-         iflag_ice_thermo, ok_ice_sursat, zqsatl, zqsats, &
+         iflag_ice_thermo, ok_ice_sursat, zqsatl, zqsats, distcltop, &
          qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, &
          Tcontr, qcontr, qcontr2, fcontrN, fcontrP )
@@ -3688 +3767 @@
 !    write(*,9000) "rcpv","rcw",rcpv,rcw,rcs,t_seri(1,1)
 !-JLD 
-    CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,paprs, &
+    CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,dqbs0,paprs, &
          'lsc',abortphy,flag_inhib_tend,itap,0)
     CALL prt_enerbil('lsc',itap)
@@ -3711 +3790 @@
     ENDIF
 
-    !---------------------------------------------------------------------------
+
+!---------------------------------------------------------------------------
     DO k = 1, klev
        DO i = 1, klon
           cldfra(i,k) = rneb(i,k)
           !CR: a quoi ca sert? Faut-il ajouter qs_seri?
+          !EV: en effet etrange, j'ajouterais aussi qs_seri
+          !    plus largement, je nettoierais (enleverrais) ces lignes
           IF (.NOT.new_oliq) radocond(i,k) = ql_seri(i,k)
        ENDDO
     ENDDO
+
+
+    ! Option to activate the radiative effect of blowing snow (ok_rad_bs)
+    ! makes sense only if the new large scale condensation scheme is active
+    ! with the ok_icefra_lscp flag active as well
+
+    IF (ok_bs .AND. ok_rad_bs) THEN
+       IF (ok_new_lscp .AND. ok_icefra_lscp) THEN
+           DO k=1,klev
+             DO i=1,klon
+                radocond(i,k)=radocond(i,k)+qbs_seri(i,k)
+                picefra(i,k)=(radocond(i,k)*picefra(i,k)+qbs_seri(i,k))/(radocond(i,k))
+                qbsfra=min(qbs_seri(i,k)/qbst_bs,1.0) 
+                cldfra(i,k)=max(cldfra(i,k),qbsfra)
+             ENDDO
+           ENDDO
+       ELSE
+          WRITE(lunout,*)"PAY ATTENTION, you try to activate the radiative effect of blowing snow"
+          WRITE(lunout,*)"with ok_new_lscp=false and/or ok_icefra_lscp=false"
+          abort_message='inconsistency in cloud phase for blowing snow'
+          CALL abort_physic(modname,abort_message,1)
+       ENDIF
+
+    ENDIF
+
     IF (check) THEN
        za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
@@ -4206 +4313 @@
                flwp, fiwp, flwc, fiwc, &
                mass_solu_aero, mass_solu_aero_pi, &
-               cldtaupi, latitude_deg, re, fl, ref_liq, ref_ice, &
+               cldtaupi, latitude_deg, distcltop, re, fl, ref_liq, ref_ice, &
                ref_liq_pi, ref_ice_pi)
        ELSE
@@ -4214 +4321 @@
                ok_aie, &
                mass_solu_aero, mass_solu_aero_pi, &
-               bl95_b0, bl95_b1, &
+               bl95_b0, bl95_b1, distcltop, &
                cldtaupi, re, fl)
        ENDIF
@@ -4519 +4626 @@
     ENDDO
 
-    CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,paprs,'SW',abortphy,flag_inhib_tend,itap,0)
+    CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,dqbs0,paprs,'SW',abortphy,flag_inhib_tend,itap,0)
     CALL prt_enerbil('SW',itap)
-    CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,paprs,'LW',abortphy,flag_inhib_tend,itap,0)
+    CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,dqbs0,paprs,'LW',abortphy,flag_inhib_tend,itap,0)
     CALL prt_enerbil('LW',itap)
 
@@ -4596 +4703 @@
        !-----------------------------------------------------------------------
        ! ajout des tendances de la trainee de l'orographie
-       CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,paprs,'oro', &
+       CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,dqbs0,paprs,'oro', &
             abortphy,flag_inhib_tend,itap,0)
        CALL prt_enerbil('oro',itap)
@@ -4647 +4754 @@
 
        ! ajout des tendances de la portance de l'orographie
-       CALL add_phys_tend(d_u_lif, d_v_lif, d_t_lif, dq0, dql0, dqi0, paprs, &
+       CALL add_phys_tend(d_u_lif, d_v_lif, d_t_lif, dq0, dql0, dqi0, dqbs0,paprs, &
             'lif', abortphy,flag_inhib_tend,itap,0)
        CALL prt_enerbil('lif',itap)
@@ -4672 +4779 @@
        d_t_hin(:, :)=0.
        CALL add_phys_tend(du_gwd_hines, dv_gwd_hines, d_t_hin, dq0, dql0, &
-            dqi0, paprs, 'hin', abortphy,flag_inhib_tend,itap,0)
+            dqi0, dqbs0, paprs, 'hin', abortphy,flag_inhib_tend,itap,0)
        CALL prt_enerbil('hin',itap)
     ENDIF
@@ -4690 +4797 @@
        ENDDO
 
-       CALL add_phys_tend(du_gwd_front, dv_gwd_front, dt0, dq0, dql0, dqi0, &
+       CALL add_phys_tend(du_gwd_front, dv_gwd_front, dt0, dq0, dql0, dqi0, dqbs0, &
             paprs, 'front_gwd_rando', abortphy,flag_inhib_tend,itap,0)
        CALL prt_enerbil('front_gwd_rando',itap)
@@ -4699 +4806 @@
             rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, &
             du_gwd_rando, dv_gwd_rando, east_gwstress, west_gwstress)
-       CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, dqi0, &
+       CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, dqi0, dqbs0, &
             paprs, 'flott_gwd_rando', abortphy,flag_inhib_tend,itap,0)
        CALL prt_enerbil('flott_gwd_rando',itap)
@@ -4751 +4858 @@
        ! ajout de la tendance d'humidite due au methane
        d_q_ch4_dtime(:,:) = d_q_ch4(:,:)*phys_tstep
-       CALL add_phys_tend(du0, dv0, dt0, d_q_ch4_dtime, dql0, dqi0, paprs, &
+       CALL add_phys_tend(du0, dv0, dt0, d_q_ch4_dtime, dql0, dqi0, dqbs0, paprs, &
             'q_ch4', abortphy,flag_inhib_tend,itap,0)
        d_q_ch4(:,:) = d_q_ch4_dtime(:,:)/phys_tstep
@@ -5056 +5163 @@
 
      CALL add_phys_tend &
-            (du0,dv0,dt0,d_q_rep,d_ql_rep,d_qi_rep,paprs,&
+            (du0,dv0,dt0,d_q_rep,d_ql_rep,d_qi_rep,dqbs0,paprs,&
              'rep',abortphy,flag_inhib_tend,itap,0)
         IF (abortphy==1) Print*,'ERROR ABORT REP'
@@ -5133 +5240 @@
     !   prlw = colonne eau liquide 
     !   prlw = colonne eau solide
+    !   prbsw = colonne neige soufflee
     prw(:) = 0.
     prlw(:) = 0.
     prsw(:) = 0.
+    prbsw(:) = 0.
     DO k = 1, klev
        prw(:)  = prw(:)  + q_seri(:,k)*zmasse(:,k)
        prlw(:) = prlw(:) + ql_seri(:,k)*zmasse(:,k)
        prsw(:) = prsw(:) + qs_seri(:,k)*zmasse(:,k)
+       prbsw(:)= prbsw(:) + qbs_seri(:,k)*zmasse(:,k)
     ENDDO
     !
@@ -5198 +5308 @@
           ENDIF
           !--ice_sursat: nqo=4, on ajoute rneb
-          IF (nqo == 4) THEN
+          IF (nqo.ge.4 .and. ok_ice_sursat) THEN
              d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep
           ENDIF
+
+           IF (nqo.ge.4 .and. ok_bs) THEN
+             d_qx(i,k,ibs) = ( qbs_seri(i,k) - qx(i,k,ibs) ) / phys_tstep
+          ENDIF
+
        ENDDO
     ENDDO
@@ -5247 +5362 @@
     ql_ancien(:,:) = ql_seri(:,:)
     qs_ancien(:,:) = qs_seri(:,:)
+    qbs_ancien(:,:) = qbs_seri(:,:)
     rneb_ancien(:,:) = rneb_seri(:,:)
     CALL water_int(klon,klev,q_ancien,zmasse,prw_ancien)
     CALL water_int(klon,klev,ql_ancien,zmasse,prlw_ancien)
     CALL water_int(klon,klev,qs_ancien,zmasse,prsw_ancien)
+    CALL water_int(klon,klev,qbs_ancien,zmasse,prbsw_ancien)
     ! !! RomP >>>
     IF (nqtot > nqo) tr_ancien(:,:,:) = tr_seri(:,:,:)
@@ -5375 +5492 @@
     CALL phys_output_write(itap, pdtphys, paprs, pphis,  &
          pplay, lmax_th, aerosol_couple,                 &
-         ok_ade, ok_aie, ok_volcan, ivap, iliq, isol,    & 
+         ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ibs,   & 
          ok_sync, ptconv, read_climoz, clevSTD,          &
          ptconvth, d_u, d_t, qx, d_qx, zmasse,           &
@@ -5386 +5503 @@
 
 #endif
+    ! Petit appelle de sorties pour accompagner le travail sur phyex
+    if ( iflag_physiq == 1 ) then
+        call output_physiqex(debut,jD_eq,pdtphys,presnivs,paprs,u,v,t,qx,cldfra,0.*t,0.*t,0.*t,pbl_tke,theta)
+    endif
 
     !====================================================================
@@ -5406 +5527 @@
     ! Disabling calls to the prt_alerte function
     alert_first_call = .FALSE.
+
     
     IF (lafin) THEN

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/surf_land_mod.F90

@@ -11 +11 @@
        rlon, rlat, yrmu0, &
        debut, lafin, zlev, ccanopy, swnet, lwnet, albedo, &
-       tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
+       tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, precip_bs, temp_air, spechum, &
        AcoefH, AcoefQ, BcoefH, BcoefQ, &
        AcoefU, AcoefV, BcoefU, BcoefV, & 
@@ -17 +17 @@
        lwdown_m, q2m, t2m, &
        snow, qsol, agesno, tsoil, &
-       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &   
+       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, fluxbs, &   
        qsurf, tsurf_new, dflux_s, dflux_l, &
        flux_u1, flux_v1 , & 
@@ -81 +81 @@
     REAL, DIMENSION(klon), INTENT(IN)       :: p1lay
     REAL, DIMENSION(klon), INTENT(IN)       :: cdragh, cdragm
-    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow
+    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow, precip_bs
     REAL, DIMENSION(klon), INTENT(IN)       :: temp_air, spechum
     REAL, DIMENSION(klon), INTENT(IN)       :: AcoefH, AcoefQ, BcoefH, BcoefQ
@@ -109 +109 @@
 !albedo SB <<<
     REAL, DIMENSION(klon), INTENT(OUT)       :: evap
-    REAL, DIMENSION(klon), INTENT(OUT)       :: fluxsens, fluxlat
+    REAL, DIMENSION(klon), INTENT(OUT)       :: fluxsens, fluxlat, fluxbs
     REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
     REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
@@ -125 +125 @@
     REAL, DIMENSION(klon) :: tsol_rad, emis_new ! output from interfsol not used
     REAL, DIMENSION(klon) :: u0, v0     ! surface speed
+    REAL, DIMENSION(klon) :: precip_totsnow     ! total solid precip
     INTEGER               :: i
 
@@ -130 +131 @@
     REAL, DIMENSION(klon)      :: alb1_new,alb2_new
 !albedo SB <<<
+
+
+!****************************************************************************************
+!Total solid precip
+
+IF (ok_bs) THEN
+precip_totsnow(:)=precip_snow(:)+precip_bs(:)
+ELSE
+precip_totsnow(:)=precip_snow(:)
+ENDIF
+!****************************************************************************************
+
 
 !**************************************************************************************** 
@@ -165 +178 @@
             zlev,  u1, v1, gustiness, temp_air, spechum, epot_air, ccanopy, & 
             cdragh, AcoefH, AcoefQ, BcoefH, BcoefQ, &
-            precip_rain, precip_snow, lwdown_m, swnet, swdown, &
+            precip_rain, precip_totsnow, lwdown_m, swnet, swdown, &
             pref_tmp, q2m, t2m, &
-            evap, fluxsens, fluxlat, &              
+            evap, fluxsens, fluxlat,  &              
             tsol_rad, tsurf_new, alb1_new, alb2_new, &
             emis_new, z0m, z0h, qsurf, &
@@ -184 +197 @@
 !****************************************************************************************
        CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
-            tsurf, p1lay, cdragh, precip_rain, precip_snow, temp_air, &
+            tsurf, p1lay, cdragh, precip_rain, precip_totsnow, temp_air, &
             spechum, AcoefH, AcoefQ, BcoefH, BcoefQ, pref, &
             u1, v1, gustiness, rugoro, swnet, lwnet, &
@@ -192 +205 @@
         z0h(1:knon)=z0m(1:knon) ! En attendant mieux
 
+
     ENDIF ! ok_veget
+
+        ! blowing snow not treated yet over land
+        fluxbs(:)=0.
+
 
 !****************************************************************************************

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/surf_land_orchidee_mod.F90

@@ -632 +632 @@
     fluxsens(1:knon) = -1. * fluxsens(1:knon)
     fluxlat(1:knon)  = -1. * fluxlat(1:knon)
-    
+   
 !  evap     = -1. * evap
 

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/surf_landice_mod.F90

@@ -12 +12 @@
        rmu0, lwdownm, albedo, pphi1, &
        swnet, lwnet, tsurf, p1lay, &
-       cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
+       cdragh, cdragm, precip_rain, precip_snow, precip_bs, temp_air, spechum, &
        AcoefH, AcoefQ, BcoefH, BcoefQ, &
        AcoefU, AcoefV, BcoefU, BcoefV, &
+       AcoefQBS, BcoefQBS, &
        ps, u1, v1, gustiness, rugoro, pctsrf, &
-       snow, qsurf, qsol, agesno, &
-       tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, &
+       snow, qsurf, qsol, qbs1, agesno, &
+       tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, fluxbs, &
        tsurf_new, dflux_s, dflux_l, &
        alt, slope, cloudf, &
@@ -30 +31 @@
     USE cpl_mod,          ONLY : cpl_send_landice_fields
     USE calcul_fluxs_mod
+    USE phys_local_var_mod, ONLY : zxrhoslic, zxustartlic
     USE phys_output_var_mod, ONLY : snow_o,zfra_o
 !FC
     USE ioipsl_getin_p_mod, ONLY : getin_p
-
+    USE blowing_snow_ini_mod, ONLY : zeta_bs, pbst_bs, prt_bs, iflag_saltation_bs
 
 #ifdef CPP_INLANDSIS
@@ -56 +58 @@
     REAL, DIMENSION(klon), INTENT(IN)             :: p1lay
     REAL, DIMENSION(klon), INTENT(IN)             :: cdragh, cdragm
-    REAL, DIMENSION(klon), INTENT(IN)             :: precip_rain, precip_snow
+    REAL, DIMENSION(klon), INTENT(IN)             :: precip_rain, precip_snow, precip_bs
     REAL, DIMENSION(klon), INTENT(IN)             :: temp_air, spechum
     REAL, DIMENSION(klon), INTENT(IN)             :: AcoefH, AcoefQ
     REAL, DIMENSION(klon), INTENT(IN)             :: BcoefH, BcoefQ
     REAL, DIMENSION(klon), INTENT(IN)             :: AcoefU, AcoefV, BcoefU, BcoefV
+    REAL, DIMENSION(klon), INTENT(IN)             :: AcoefQBS, BcoefQBS
     REAL, DIMENSION(klon), INTENT(IN)             :: ps
-    REAL, DIMENSION(klon), INTENT(IN)             :: u1, v1, gustiness
+    REAL, DIMENSION(klon), INTENT(IN)             :: u1, v1, gustiness, qbs1
     REAL, DIMENSION(klon), INTENT(IN)             :: rugoro
     REAL, DIMENSION(klon,nbsrf), INTENT(IN)       :: pctsrf
@@ -94 +97 @@
 !albedo SB <<<
     REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
+    REAL, DIMENSION(klon), INTENT(OUT)            :: fluxbs
     REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
     REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l      
@@ -134 +138 @@
 
     REAL,DIMENSION(klon) :: alb1,alb2
+    REAL,DIMENSION(klon) :: precip_totsnow, evap_totsnow
     REAL, DIMENSION (klon,6) :: alb6
+    REAL                   :: rho0, rhoice, ustart0, hsalt, esalt, rhod
+    REAL                   :: lambdasalt,fluxsalt, csalt, nunu, aa, bb, cc
+    REAL                   :: tau_dens, tau_dens0, tau_densmin, rhomax, rhohard
+    REAL, DIMENSION(klon)  :: ws1, rhos, ustart, qsalt
 ! End definition
 !****************************************************************************************
@@ -165 +174 @@
     alb2(:) = 999999.
     alb1(:) = 999999.
-    
+    fluxbs(:)=0.  
     runoff(:) = 0.
 !****************************************************************************************
@@ -173 +182 @@
     radsol(:) = 0.0
     radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
+
+!****************************************************************************************
 
 !****************************************************************************************
@@ -264 +275 @@
 
 
-
     ELSE 
 
@@ -314 +324 @@
          flux_u1, flux_v1)
 
-!****************************************************************************************
-! Calculate snow height, age, run-off,..
-!    
-!****************************************************************************************
-    CALL fonte_neige(knon, is_lic, knindex, dtime, &
-         tsurf, precip_rain, precip_snow, &
-         snow, qsol, tsurf_new, evap)
-
 
 !****************************************************************************************
@@ -327 +329 @@
 !
 !****************************************************************************************
+ 
     CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))  
 
-    WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
-    zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0)))
-    alb1(1:knon) = alb_neig(1:knon)*zfra(1:knon) + &
-         0.6 * (1.0-zfra(1:knon))
+
+! EV: following lines are obsolete since we set alb1 and alb2 to constant values
+! I therefore comment them
+!    alb1(1:knon) = alb_neig(1:knon)*zfra(1:knon) + &
+!         0.6 * (1.0-zfra(1:knon))
 !
 !IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux"
@@ -354 +358 @@
     !z0m = SQRT(z0m**2+rugoro**2)
 
+
+
+  ! Simple blowing snow param
+  if (ok_bs) then
+       ustart0 = 0.211
+       rhoice = 920.0
+       rho0 = 200.0
+       rhomax=450.0
+       rhohard=400.0
+       tau_dens0=86400.0*10.  ! 10 days by default, in s
+       tau_densmin=86400.0 ! 1 days according to in situ obs by C. Amory
+
+       ! computation of threshold friction velocity
+       ! which depends on surface snow density
+       do i = 1, knon
+           ! estimation of snow density
+           ! snow density increases with snow age and
+           ! increases even faster in case of sedimentation of blowing snow
+           tau_dens=max(tau_densmin, tau_dens0*exp(-abs(precip_bs(i))/pbst_bs-abs(precip_rain(i))/prt_bs))
+           rhos(i)=rho0+(rhohard-rho0)*(1.-exp(-agesno(i)*86400.0/tau_dens))
+           ! blowing snow flux formula used in MAR
+           ws1(i)=(u1(i)**2+v1(i)**2)**0.5
+           ustar(i)=(cdragm(i)*(u1(i)**2+v1(i)**2))**0.5
+           ustart(i)=ustart0*exp(max(rhoice/rho0-rhoice/rhos(i),0.))*exp(max(0.,rhos(i)-rhomax)) 
+           ! we have multiplied by exp to prevent erosion when rhos>rhomax (usefull till
+           ! rhohard<450)
+       enddo
+       
+       ! computation of qbs at the top of the saltation layer
+       ! two formulations possible
+       ! pay attention that qbs is a mixing ratio and has to be converted
+       ! to specific content
+       
+       if (iflag_saltation_bs .eq. 1) then
+       ! expression from CRYOWRF (Sharma et al. 2022)
+          aa=2.6
+          bb=2.5
+          cc=2.0
+          lambdasalt=0.45
+          do i =1, knon
+               rhod=p1lay(i)/RD/temp_air(i)
+               nunu=max(ustar(i)/ustart(i),1.e-3)
+               fluxsalt=rhod/RG*(ustar(i)**3)*(1.-nunu**(-2)) * &
+                        (aa+bb*nunu**(-2)+cc*nunu**(-1))  
+               csalt=fluxsalt/(2.8*ustart(i))
+               hsalt=0.08436*ustar(i)**1.27
+               qsalt(i)=1./rhod*csalt*lambdasalt*RG/(max(ustar(i)**2,1E-6)) &
+                       * exp(-lambdasalt*RG*hsalt/max(ustar(i)**2,1E-6))
+               qsalt(i)=max(qsalt(i),0.)
+          enddo
+
+
+       else
+       ! default formulation from MAR model (Amory et al. 2021, Gallee et al. 2001)        
+          do i=1, knon
+              esalt=1./(3.25*max(ustar(i),0.001))
+              hsalt=0.08436*ustar(i)**1.27
+              qsalt(i)=(max(ustar(i)**2-ustart(i)**2,0.))/(RG*hsalt)*esalt
+              !ep=qsalt*cdragm(i)*sqrt(u1(i)**2+v1(i)**2)
+          enddo
+       endif
+
+        ! calculation of erosion (emission flux towards the first atmospheric level)
+        ! consistent with implicit resolution of turbulent mixing equation
+       do i=1, knon
+              rhod=p1lay(i)/RD/temp_air(i)
+              fluxbs(i)=rhod*ws1(i)*cdragm(i)*zeta_bs*(AcoefQBS(i)-qsalt(i)) &
+                       / (1.-rhod*ws1(i)*zeta_bs*cdragm(i)*BcoefQBS(i)*dtime)
+              !fluxbs(i)= zeta_bs*rhod*ws1(i)*cdragm(i)*(qbs1(i)-qsalt(i))
+       enddo
+
+       ! for outputs
+       do j = 1, knon
+          i = knindex(j)
+          zxustartlic(i) = ustart(j)
+          zxrhoslic(i) = rhos(j)
+       enddo
+
+  endif
+
+
+
+!****************************************************************************************
+! Calculate surface snow amount
+!    
+!****************************************************************************************
+    IF (ok_bs) THEN
+      precip_totsnow(:)=precip_snow(:)+precip_bs(:)
+      evap_totsnow(:)=evap(:)-fluxbs(:) ! flux bs is positive towards the surface (snow erosion)
+    ELSE
+      precip_totsnow(:)=precip_snow(:)
+      evap_totsnow(:)=evap(:)
+    ENDIF
+
+    CALL fonte_neige(knon, is_lic, knindex, dtime, &
+         tsurf, precip_rain, precip_totsnow,  &
+         snow, qsol, tsurf_new, evap_totsnow)
+
+    WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.                                         
+    zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0)))  
 
 
@@ -378 +482 @@
     runoff(1:knon)=run_off_lic(1:knon)/dtime
 
-  
-!****************************************************************************************
        snow_o=0.
        zfra_o = 0.
@@ -420 +522 @@
 !albedo SB <<<
 
-  
-  
 
   END SUBROUTINE surf_landice

LMDZ6/branches/LMDZ_cdrag_LSCE/libf/phylmd/surf_ocean_mod.F90

@@ -13 +13 @@
        windsp, rmu0, fder, tsurf_in, &
        itime, dtime, jour, knon, knindex, &
-       p1lay, z1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
+       p1lay, z1lay, cdragh, cdragm, precip_rain, precip_snow, precip_bs, temp_air, spechum, &
        AcoefH, AcoefQ, BcoefH, BcoefQ, &
        AcoefU, AcoefV, BcoefU, BcoefV, &
@@ -60 +60 @@
     REAL, DIMENSION(klon), INTENT(IN)        :: cdragh
     REAL, DIMENSION(klon), INTENT(IN)        :: cdragm
-    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
+    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow, precip_bs
     REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
     REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
@@ -144 +144 @@
     REAL, DIMENSION(klon) :: radsol
     REAL, DIMENSION(klon) :: cdragq ! Cdrag pour l'evaporation
+    REAL, DIMENSION(klon) :: precip_totsnow
     CHARACTER(len=20),PARAMETER :: modname="surf_ocean"
     real rhoa(knon) ! density of moist air  (kg / m3)
@@ -160 +161 @@
     radsol(1:klon) = 0.0 ! initialisation a priori inutile
     radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
+
+
+    !****************************************************************************************
+    !Total solid precip
+
+    IF (ok_bs) THEN
+       precip_totsnow(:)=precip_snow(:)+precip_bs(:)
+    ELSE
+       precip_totsnow(:)=precip_snow(:)
+    ENDIF
+
 
     !******************************************************************************
@@ -188 +200 @@
             windsp, fder, & 
             itime, dtime, knon, knindex, &
-            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow,temp_air,spechum,& 
+            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_totsnow,temp_air,spechum,& 
             AcoefH, AcoefQ, BcoefH, BcoefQ, &
             AcoefU, AcoefV, BcoefU, BcoefV, &
@@ -200 +212 @@
        CALL ocean_slab_noice( &
             itime, dtime, jour, knon, knindex, &
-            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum,&
+            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_totsnow, temp_air, spechum,&
             AcoefH, AcoefQ, BcoefH, BcoefQ, &
             AcoefU, AcoefV, BcoefU, BcoefV, &
@@ -211 +223 @@
        CALL ocean_forced_noice( &
             itime, dtime, jour, knon, knindex, &
-            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, &
+            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_totsnow, &
             temp_air, spechum, &
             AcoefH, AcoefQ, BcoefH, BcoefQ, &
@@ -326 +338 @@
        call bulk_flux(tkt, tks, taur, dter, dser, t_int, s_int, ds_ns, dt_ns, &
             u = windsp(:knon), t_ocean_1 = tsurf_new(:knon), s1 = sss(:knon), &
-            rain = precip_rain(:knon) + precip_snow(:knon), &
+            rain = precip_rain(:knon) + precip_totsnow(:knon), &
             hf = - fluxsens(:knon), hlb = - fluxlat(:knon), &
             rnl = - lwnet(:knon), &