Index: /LMDZ6/branches/LMDZ_ECRad/DefLists/context_lmdz.xml
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/DefLists/context_lmdz.xml	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/DefLists/context_lmdz.xml	(revision 4727)
@@ -27,4 +27,5 @@
   <file_definition src="./file_def_histstrataer_lmdz.xml"/>
   <file_definition src="./file_def_histdaystrataer_lmdz.xml"/>
+<!--  <file_definition src="./file_def_phystoke_lmdz.xml"/>-->
 
   <!-- Define domains and groups of domains -->
Index: /LMDZ6/branches/LMDZ_ECRad/DefLists/field_def_lmdz.xml
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/DefLists/field_def_lmdz.xml	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/DefLists/field_def_lmdz.xml	(revision 4727)
@@ -112,6 +112,10 @@
         <field id="pluc"    long_name="Convective Precip."      unit="kg/(s*m2)" />
         <field id="snow"    long_name="Snow fall"               unit="kg/(s*m2)" />
-        <field id="evap"    long_name="Evaporat"                unit="kg/(s*m2)" />
-        <field id="evap_ter"    long_name="evaporation at surface ter"    unit="kg/(s*m2)" />
+	<field id="evap"    long_name="Evaporat"                unit="kg/(s*m2)" />
+        <field id="snowerosion"    long_name="blowing snow erosion"                unit="kg/(s*m2)" />
+	<field id="bsfall"    long_name="blowing snow precipitation"                unit="kg/(s*m2)" />
+	<field id="rhosnow_lic"    long_name="snow density lic"                unit="kg/m3" />
+        <field id="ustart_lic"    long_name="ustar threshold for snow erosion"                unit="m/s" />
+	<field id="evap_ter"    long_name="evaporation at surface ter"    unit="kg/(s*m2)" />
         <field id="evap_lic"    long_name="evaporation at surface lic"    unit="kg/(s*m2)" />
         <field id="evap_oce"    long_name="evaporation at surface oce"    unit="kg/(s*m2)" />
@@ -275,5 +279,6 @@
         <field id="prw"    long_name="Precipitable water"    unit="kg/m2" />
         <field id="prlw"   long_name="Precipitable liquid water"  unit="kg/m2" />
-        <field id="prsw"   long_name="Precipitable solid water"  unit="kg/m2" />
+	<field id="prsw"   long_name="Precipitable solid water"  unit="kg/m2" />
+	<field id="prbsw"   long_name="Precipitable blowing snow"  unit="kg/m2" />
         <field id="s_pblh"    long_name="Boundary Layer Height"    unit="m" />
         <field id="s_pblt"    long_name="t at Boundary Layer Height"    unit="K" />
@@ -505,9 +510,11 @@
         <field id="dqphy2d"    long_name="Physics dQ"    unit="(kg/m2)/s" />
         <field id="dqlphy2d"    long_name="Physics dQL"    unit="(kg/m2)/s" />
-        <field id="dqsphy2d"    long_name="Physics dQS"    unit="(kg/m2)/s" />
+	<field id="dqsphy2d"    long_name="Physics dQS"    unit="(kg/m2)/s" />
+	<field id="dqbsphy2d"    long_name="Physics dQBS"    unit="(kg/m2)/s" />
         <field id="dqdyn2d"    long_name="Dynamics dQ"    unit="(kg/m2)/s" />
         <field id="dqldyn2d"   long_name="Dynamics dQL"    unit="(kg/m2)/s" />
         <field id="dqsdyn2d"   long_name="Dynamics dQS"    unit="(kg/m2)/s" />
-        <field id="dqcon2d"    long_name="Convection dQ"    unit="(kg/m2)/s" />
+        <field id="dqbsdyn2d"   long_name="Dynamics dQBS"    unit="(kg/m2)/s" />
+	<field id="dqcon2d"    long_name="Convection dQ"    unit="(kg/m2)/s" />
         <field id="dqwak2d"    long_name="Wake dQ"    unit="(kg/m2)/s" />
         <field id="dqlsc2d"    long_name="Condensation dQ"    unit="(kg/m2)/s" />
@@ -590,5 +597,6 @@
         <field id="ovapinit"    long_name="Specific humidity (begin of timestep)"    unit="kg/kg" />
         <field id="oliq"    long_name="Liquid water"    unit="kg/kg" />
-        <field id="ocond"    long_name="Condensed water"    unit="kg/kg" />
+	<field id="ocond"    long_name="Condensed water"    unit="kg/kg" />
+	<field id="qbs"    long_name="specific content of blowing snow"    unit="kg/kg" />
         <field id="geop"    long_name="Geopotential height"    unit="m2/s2" />
         <field id="geoph" field_ref="geop" long_name="Geopotential height" unit="m" > geop/9.80665 </field>
@@ -604,5 +612,7 @@
         <field id="rnebcon"    long_name="Convective Cloud Fraction"    unit="-" />
         <field id="rnebls"    long_name="LS Cloud fraction"    unit="-" />
-        <field id="rneblsvol" long_name="LS Cloud fraction by volume"    unit="-" />
+	<field id="rneblsvol" long_name="LS Cloud fraction by volume"    unit="-" />
+        <field id="pfraclr" long_name="LS precip fraction clear-sky part"    unit="-" />		
+        <field id="pfracld" long_name="LS precip fraction cloudy part"    unit="-" />   
         <field id="rhum"    long_name="Relative humidity"    unit="-" />
 	<field id="rhl" long_name="Relative humidity wrt liquid" unit="%" />
@@ -616,9 +626,11 @@
         <field id="dqphy"    long_name="Physics dQ"    unit="(kg/kg)/s" />
         <field id="dqlphy"   long_name="Physics dQL"    unit="(kg/kg)/s" />
-        <field id="dqsphy"   long_name="Physics dQS"    unit="(kg/kg)/s" />
+	<field id="dqsphy"   long_name="Physics dQS"    unit="(kg/kg)/s" />
+	<field id="dqbsphy"   long_name="Physics dQBS"    unit="(kg/kg)/s" />
         <field id="pr_con_l"    long_name="Convective precipitation lic"    unit="-" />
         <field id="pr_con_i"    long_name="Convective precipitation ice"    unit="-" />
         <field id="pr_lsc_l"    long_name="Large scale precipitation lic"    unit="-" />
-        <field id="pr_lsc_i"    long_name="Large scale precipitation ice"    unit="-" />
+	<field id="pr_lsc_i"    long_name="Large scale precipitation ice"    unit="-" />
+	<field id="pr_bs"    long_name="precipitation blowing snow"    unit="-" />
         <field id="re"    long_name="Cloud droplet effective radius"    unit="um" />
         <field id="fl"    long_name="Denominator of Cloud droplet effective radius"    unit="-" />
@@ -643,5 +655,6 @@
         <field id="dqldyn"    long_name="Dynamics dQL"    unit="(kg/kg)/s" />
         <field id="dqsdyn"    long_name="Dynamics dQS"    unit="(kg/kg)/s" />
-        <field id="dudyn"    long_name="Dynamics dU"    unit="m/s2" />
+        <field id="dqbsdyn"    long_name="Dynamics dQBS"    unit="(kg/kg)/s" />       
+	<field id="dudyn"    long_name="Dynamics dU"    unit="m/s2" />
         <field id="dvdyn"    long_name="Dynamics dV"    unit="m/s2" />
         <field id="dtcon"    long_name="Convection dT"    unit="K/s" />
@@ -673,5 +686,9 @@
         <field id="dqvdf_w" long_name="dqvdf within_wake" unit="(kg/kg)/s" />
         <field id="dteva"    long_name="Reevaporation dT"    unit="K/s" />
-        <field id="dqeva"    long_name="Reevaporation dQ"    unit="(kg/kg)/s" />
+	<field id="dqeva"    long_name="Reevaporation dQ"    unit="(kg/kg)/s" />
+        <field id="dqbsvdf"    long_name="Boundary-layer dQBS"    unit="(kg/kg)/s" />
+        <field id="dqbsbs"    long_name="Blowing snow dQBS"    unit="(kg/kg)/s" />
+        <field id="dqbs"    long_name="Blowing snow dQ"    unit="(kg/kg)/s" />
+        <field id="dtbs"    long_name="Blowing snow dT"    unit="(K)/s" />
         <field id="dqlscth"    long_name="dQ therm."    unit="(kg/kg)/s" />
         <field id="dqlscst"    long_name="dQ strat."    unit="(kg/kg)/s" />
@@ -732,4 +749,5 @@
         <field id="heat_volc"    long_name="SW heating rate from volcano"    unit="K/s" />
         <field id="cool_volc"    long_name="LW cooling rate from volcano"    unit="K/s" />
+	<field id="dqch4"        long_name="H2O due to CH4 oxidation and photolysis" unit="(kg/kg)/s" />
         <field id="pvap"    long_name="pvap intermediary variable" unit="-">pres*ovap*461.5 / (287.04*(1.+ (10.9491/18.0153)*ovap)) </field>
         <field id="oclr"    long_name="Clear sky total water"    unit="kg/kg" />
@@ -756,4 +774,6 @@
         <field id="qcontr2"     long_name="Contrail qcontr2"     unit="kg/kg" />
         <field id="Tcontr"     long_name="Contrail Tcontr"     unit="K" />
+	<field id="fluxt"     long_name="flux h"     unit="W/m2" />
+        <field id="fluxq"     long_name="flux q"     unit="-" />
     </field_group>
 
@@ -850,4 +870,27 @@
     </field_group>
 
+
+
+    <field_group id="fields_phystokenc_3D" domain_ref="dom_glo" axis_ref="klev"   >
+      <field id="t_stok"         long_name="Temperature" unit="K" />
+      <field id="coefh_stok"     long_name="coeff de melange dans la couche limite" unit="-" />
+      <field id="fm_th_stok"     long_name="Mass flux thermals" unit="kg m-2.s-1" />
+      <field id="en_th_stok"     long_name="Thermal plume entrainment" unit="kg m-1.s-1" />
+      <field id="da_stok"        long_name="adiabatic ascen" unit="kg m-2.s-1" />
+      <field id="mp_stok"        long_name="precipitating downdraft mass flux under hydrostatic approximation" unit="kg m-2.s-1" />
+      <field id="wght_stok"      long_name="weights of the layers feeding convection" unit="-" />
+      <field id="upwd_stok"      long_name="saturated updraft mass flux" unit="kg m-2.s-1" />
+      <field id="dnwd_stok"      long_name="saturated downdraft mass flux" unit="kg m-2.s-1" />
+    </field_group>
+    
+    <field_group id="philev_grp" long_name="mass flow environmental mixing" unit="kg m-2 s-1" domain_ref="dom_glo" axis_ref="klev" operation="average"/>
+
+    <field_group id="fields_phystokenc_2D" grid_ref="grid_glo" >
+      <field id="yu1_stok"       long_name="zonal surface wind" unit="m.s-1" />
+      <field id="yv1_stok"       long_name="wind meridian surface" unit="m.s-1" />
+    </field_group>
+
+
+    
     <field_group id="fields_trac_2D" grid_ref="grid_glo" >
           <field id="cumRN"    long_name="Cumulated tracer  RNVL1"    unit="-" />
Index: /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_histdaystrataer_lmdz.xml
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_histdaystrataer_lmdz.xml	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_histdaystrataer_lmdz.xml	(revision 4727)
@@ -1,12 +1,96 @@
 <file_definition>
-    <file_group id="defile">
-        <file id="histdaystrataer" name="histdaystrataer" output_freq="1d" output_level="5" enabled="_AUTO_" compression_level="4">
+  <file_group id="defile">
+    <file id="histdaystrataer" name="histdaystrataer" output_freq="1d" output_level="_AUTO_" enabled="_AUTO_" compression_level="4">
+      
+      <field_group grid_ref="grid_out"  level="3">
+	<field field_ref="OD550_strat_only" level="1" />
+	<field field_ref="OD1020_strat_only" level="1" />
+	<field field_ref="surf_PM25_sulf" level="2" />
+	<field field_ref="budg_dep_dry_ocs" level="3" />
+	<field field_ref="budg_dep_wet_ocs" level="3" />
+	<field field_ref="budg_dep_dry_so2" level="3" />
+	<field field_ref="budg_dep_wet_so2" level="3" />
+	<field field_ref="budg_dep_dry_h2so4" level="3" />
+	<field field_ref="budg_dep_wet_h2so4" level="3" />
+	<field field_ref="budg_dep_dry_part" level="3" />
+	<field field_ref="budg_dep_wet_part" level="3" />
+	<field field_ref="budg_emi_ocs" level="3" />
+	<field field_ref="budg_emi_so2" level="3" />
+	<field field_ref="budg_emi_h2so4" level="3" />
+	<field field_ref="budg_emi_part" level="3" />
+	<field field_ref="budg_ocs_to_so2" level="3" />
+	<field field_ref="budg_so2_to_h2so4" level="3" />
+	<field field_ref="budg_h2so4_to_part" level="3" />
+	<field field_ref="budg_sed_part" level="3" />
+	<field field_ref="p_tropopause" level="1" />
+	<field field_ref="z_tropopause" level="1" />
+	<field field_ref="t_tropopause" level="3" />
+      </field_group>
+      
+      <field_group grid_ref="grid_out_presnivs" level="10">
+	<field field_ref="ext_strat_550" level="1" />
+	<field field_ref="ext_strat_1020" level="5" />
+	<field field_ref="budg_3D_nucl" level="10" />
+	<field field_ref="budg_3D_cond_evap" level="10" />
+	<field field_ref="budg_3D_ocs_to_so2" level="10" />
+	<field field_ref="budg_3D_so2_to_h2so4" level="10" />
+	<field field_ref="budg_3D_backgr_ocs"  level="10" />
+	<field field_ref="budg_3D_backgr_so2" level="10" />
+	<field field_ref="R2SO4" level="1" />
+	<field field_ref="OCS_lifetime" level="10" />
+	<field field_ref="SO2_lifetime" level="10" />
+	<field field_ref="vsed_aer" level="10" />
+	<field field_ref="f_r_wet" level="2" />
+	<field field_ref="mass"  level="10" />
+	<field field_ref="temp"  level="10" />
+	<field field_ref="pres"    level="10" />
+        <field field_ref="h2o"     level="1" />
+	<field field_ref="dqch4" level="5" />
+      </field_group>
+      
+      <field_group grid_ref="grid_out_presnivs" level="10">
+	<field field_ref="GASOCS"  level="1" />
+	<field field_ref="GASSO2"  level="1" />
+	<field field_ref="GASH2SO4"  level="1" />
+        <field field_ref="BIN01" level="2" />
+        <field field_ref="BIN02" level="2" />
+        <field field_ref="BIN03" level="2" />
+        <field field_ref="BIN04" level="2" />
+        <field field_ref="BIN05" level="2" />
+        <field field_ref="BIN06" level="2" />
+        <field field_ref="BIN07" level="2" />
+        <field field_ref="BIN08" level="2" />
+        <field field_ref="BIN09" level="2" />
+        <field field_ref="BIN10" level="2" />
+        <field field_ref="BIN11" level="2" />
+        <field field_ref="BIN12" level="2" />
+        <field field_ref="BIN13" level="2" />
+        <field field_ref="BIN14" level="2" />
+        <field field_ref="BIN15" level="2" />
+        <field field_ref="BIN16" level="2" />
+        <field field_ref="BIN17" level="2" />
+        <field field_ref="BIN18" level="2" />
+        <field field_ref="BIN19" level="2" />
+        <field field_ref="BIN20" level="2" />
+        <field field_ref="BIN21" level="2" />
+        <field field_ref="BIN22" level="2" />
+        <field field_ref="BIN23" level="2" />
+        <field field_ref="BIN24" level="2" />
+        <field field_ref="BIN25" level="2" />
+        <field field_ref="BIN26" level="2" />
+        <field field_ref="BIN27" level="2" />
+        <field field_ref="BIN28" level="2" />
+        <field field_ref="BIN29" level="2" />
+        <field field_ref="BIN30" level="2" />
+        <field field_ref="BIN31" level="2" />
+        <field field_ref="BIN32" level="2" />
+        <field field_ref="BIN33" level="2" />
+        <field field_ref="BIN34" level="2" />
+        <field field_ref="BIN35" level="2" />
+        <field field_ref="BIN36" level="2" />
+      </field_group>
+      
+    </file>
+  </file_group>
+</file_definition>
 
-            <field_group group_ref="fields_strataer_3D" operation="average" freq_op="1ts" level="1" />
-            <field_group group_ref="fields_strataer_2D" operation="average" freq_op="1ts" level="1" />
-            <field_group group_ref="fields_strataer_trac_3D" operation="average" freq_op="1ts" level="1" />
-            <field_group group_ref="fields_strataer_trac_2D" operation="average" freq_op="1ts" level="1" />
-            
-        </file>
-    </file_group>
-</file_definition>
Index: /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_histhf_lmdz.xml
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_histhf_lmdz.xml	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_histhf_lmdz.xml	(revision 4727)
@@ -2,5 +2,5 @@
 <file_definition>
     <file_group id="defile">
-        <file id="histhf" name="histhf" output_freq="3h" output_level="_AUTO_" enabled="_AUTO_" compression_level="2" sync_freq="3h">
+        <file id="histhf" name="histhf" output_freq="1h" output_level="_AUTO_" enabled="_AUTO_" compression_level="2" sync_freq="1h">
             
             <!-- VARS 1D -->
@@ -12,16 +12,16 @@
         
             <!-- VARS 2D -->
-            <field_group group_ref="remap_3h" >
+            <field_group group_ref="remap_1h" >
               <field_group grid_ref="grid_out" > 
-                <field field_ref="phis" level="10" />
+                <field field_ref="phis" level="5" />
                 <field field_ref="aire" level="10" operation="once" />
                 <field field_ref="contfracATM" level="5" operation="once" />
                 <field field_ref="contfracOR" level="5" />
-                <field field_ref="flat" level="10" />
-                <field field_ref="slp" level="10" />
+                <field field_ref="flat" level="5" />
+                <field field_ref="slp" level="5" />
                 <field field_ref="sza" level="10" />
                 <field field_ref="ptstar" level="10" />
                 <field field_ref="pt0" level="10" />
-                <field field_ref="tsol" level="10" />
+                <field field_ref="tsol" level="5" />
                 <field field_ref="t2m" level="5" />
                 <field field_ref="t2m_min" level="10" operation="minimum" />
@@ -32,10 +32,10 @@
                 <field field_ref="t2m_sic" level="10" />
                 <field field_ref="gusts" level="10" />
-                <field field_ref="wind10m" level="10" />
+                <field field_ref="wind10m" level="5" />
                 <field field_ref="wind100m" level="10" />
                 <field field_ref="wind10max" level="10" operation="maximum" />
                 <field field_ref="sicf" level="10" />
                 <field field_ref="q2m" level="5" />
-                <field field_ref="ustar" level="10" />
+                <field field_ref="ustar" level="5" />
                 <field field_ref="u10m" level="5" />
                 <field field_ref="v10m" level="5" />
@@ -67,11 +67,15 @@
                 <field field_ref="plun" level="10" />
                 <field field_ref="pluc" level="10" />
-                <field field_ref="snow" level="5" />
-                <field field_ref="evap" level="10" />
-                <field field_ref="evap_ter" level="10" />
+		<field field_ref="snow" level="5" />
+		<field field_ref="bsfall" level="5" />
+		<field field_ref="evap" level="5" />
+		<field field_ref="snowerosion" level="5" />
+		<field field_ref="rhosnow_lic" level="5" />
+                <field field_ref="ustart_lic" level="5" />
+		<field field_ref="evap_ter" level="10" />
                 <field field_ref="evap_lic" level="10" />
                 <field field_ref="evap_oce" level="10" />
                 <field field_ref="evap_sic" level="10" />
-                <field field_ref="msnow" level="10" />
+                <field field_ref="msnow" level="5" />
                 <field field_ref="fsnow" level="10" />
                 <field field_ref="tops" level="10" />
@@ -99,9 +103,9 @@
                 <field field_ref="SWupSFC" level="10" />
                 <field field_ref="SWupSFCclr" level="10" />
-                <field field_ref="SWdnSFC" level="10" />
+                <field field_ref="SWdnSFC" level="5" />
                 <field field_ref="SWdnSFCclr" level="10" />
                 <field field_ref="LWupSFC" level="10" />
                 <field field_ref="LWupSFCclr" level="10" />
-                <field field_ref="LWdnSFC" level="10" />
+                <field field_ref="LWdnSFC" level="5" />
                 <field field_ref="LWdnSFCclr" level="10" />
                 <field field_ref="bils" level="10" />
@@ -112,5 +116,5 @@
                 <field field_ref="bils_enthalp" level="10" />
                 <field field_ref="bils_latent" level="10" />
-                <field field_ref="sens" level="10" />
+                <field field_ref="sens" level="5" />
                 <field field_ref="sens_x" level="11" />
                 <field field_ref="sens_w" level="11" />
@@ -198,5 +202,5 @@
                 <field field_ref="cldm" level="10" />
                 <field field_ref="cldh" level="10" />
-                <field field_ref="cldt" level="10" />
+                <field field_ref="cldt" level="5" />
                 <field field_ref="cldq" level="10" />
                 <field field_ref="lwp" level="10" />
@@ -214,7 +218,8 @@
                 <field field_ref="wbeff" level="10" />
                 <field field_ref="convoccur" level="10" />
-                <field field_ref="prw" level="10" />
+                <field field_ref="prw" level="5" />
                 <field field_ref="prlw" level="10" />
-                <field field_ref="prsw" level="10" />
+		<field field_ref="prsw" level="10" />
+                <field field_ref="prbsw" level="5" />
                 <field field_ref="s_pblh" level="10" />
                 <field field_ref="s_pblt" level="10" />
@@ -246,5 +251,5 @@
                     <field field_ref="u850" level="10" />
                     <field field_ref="u700" level="10" />
-                    <field field_ref="u500" level="10" />
+                    <field field_ref="u500" level="5" />
                     <field field_ref="u200" level="10" />
                     <field field_ref="u100" level="10" />
@@ -253,5 +258,5 @@
                     <field field_ref="v850" level="10" />
                     <field field_ref="v700" level="10" />
-                    <field field_ref="v500" level="10" />
+                    <field field_ref="v500" level="5" />
                     <field field_ref="v200" level="10" />
                     <field field_ref="v100" level="10" />
@@ -267,5 +272,5 @@
                     <field field_ref="t850" level="10" />
                     <field field_ref="t700" level="10" />
-                    <field field_ref="t500" level="10" />
+                    <field field_ref="t500" level="5" />
                     <field field_ref="t200" level="10" />
                     <field field_ref="t100" level="10" />
@@ -281,5 +286,5 @@
                     <field field_ref="z850" level="10" />
                     <field field_ref="z700" level="10" />
-                    <field field_ref="z500" level="10" />
+                    <field field_ref="z500" level="5" />
                     <field field_ref="z200" level="10" />
                     <field field_ref="z100" level="10" />
@@ -299,5 +304,5 @@
                 <field field_ref="v10_oce" level="10" />
                 <field field_ref="v10_sic" level="10" />
-                <field field_ref="rh2m" level="10" />
+                <field field_ref="rh2m" level="5" />
                 <field field_ref="rh2m_min" level="10" operation="minimum" />
                 <field field_ref="rh2m_max" level="10" operation="maximum" />
@@ -503,21 +508,22 @@
                 <field field_ref="concno3" level="10" />
                 <field field_ref="ec550aer" level="10" />
-                <field field_ref="lwcon" level="10" />
-                <field field_ref="iwcon" level="10" />
+                <field field_ref="lwcon" level="5" />
+                <field field_ref="iwcon" level="5" />
                 <field field_ref="temp" level="4" />
                 <field field_ref="theta" level="10" />
-                <field field_ref="ovap" level="10" />
+                <field field_ref="ovap" level="5" />
                 <field field_ref="ovapinit" level="10" />
-                <field field_ref="oliq" level="10" />
-                <field field_ref="ocond" level="10" />
+                <field field_ref="oliq" level="5" />
+		<field field_ref="ocond" level="5" />
+		<field field_ref="qbs" level="5" />
                 <field field_ref="geop" level="10" />
                 <field field_ref="geoph" level="10" />
-                <field field_ref="vitu" level="10" />
-                <field field_ref="vitv" level="10" />
+                <field field_ref="vitu" level="5" />
+                <field field_ref="vitv" level="5" />
                 <field field_ref="vitw" level="6" />
-                <field field_ref="pres" level="10" />
+                <field field_ref="pres" level="5" />
                 <field field_ref="paprs" level="10" />
                 <field field_ref="mass" level="10" />
-                <field field_ref="zfull" level="10" />
+                <field field_ref="zfull" level="5" />
                 <field field_ref="zhalf" level="10" />
                 <field field_ref="rneb" level="10" />
@@ -525,11 +531,12 @@
                 <field field_ref="rnebls" level="10" />
                 <field field_ref="rneblsvol" level="10" />
-                <field field_ref="rhum" level="10" />
+		<field field_ref="rhum" level="10" />
+		<field field_ref="rhi" level="5" />
                 <field field_ref="ozone" level="10" />
                 <field field_ref="upwd" level="10" />
                 <field field_ref="ep" level="10" />
                 <field field_ref="duphy" level="10" />
-                <field field_ref="dtphy" level="10" />
-                <field field_ref="dqphy" level="10" />
+                <field field_ref="dtphy" level="5" />
+                <field field_ref="dqphy" level="5" />
                 <field field_ref="dqlphy" level="10" />
                 <field field_ref="dqsphy" level="10" />
@@ -537,5 +544,6 @@
                 <field field_ref="pr_con_i" level="10" />
                 <field field_ref="pr_lsc_l" level="10" />
-                <field field_ref="pr_lsc_i" level="10" />
+		<field field_ref="pr_lsc_i" level="10" />
+		<field field_ref="pr_bs" level="5" />
                 <field field_ref="re" level="10" />
                 <field field_ref="fl" level="10" />
@@ -555,6 +563,6 @@
                 <field field_ref="dnwd0" level="10" />
                 <field field_ref="mc" level="10" />
-                <field field_ref="dtdyn" level="10" />
-                <field field_ref="dqdyn" level="10" />
+                <field field_ref="dtdyn" level="5" />
+                <field field_ref="dqdyn" level="5" />
                 <field field_ref="dqldyn" level="10" />
                 <field field_ref="dqsdyn" level="10" />
@@ -576,5 +584,7 @@
                 <field field_ref="dtlsc" level="10" />
                 <field field_ref="dtlschr" level="10" />
-                <field field_ref="dqlsc" level="10" />
+		<field field_ref="dqlsc" level="10" />
+		<field field_ref="dtbs" level="5" />
+                <field field_ref="dqbs" level="5" />
                 <field field_ref="beta_prec" level="10" />
                 <field field_ref="dtvdf" level="10" />
Index: /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_histmth_lmdz.xml
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_histmth_lmdz.xml	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_histmth_lmdz.xml	(revision 4727)
@@ -675,4 +675,5 @@
                 <field field_ref="cool_volc" level="1" />
                 <field field_ref="heat_volc" level="1" />
+		<field field_ref="dqch4"     level="10" />
             </field_group>
 
Index: /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_histstrataer_lmdz.xml
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_histstrataer_lmdz.xml	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_histstrataer_lmdz.xml	(revision 4727)
@@ -1,15 +1,99 @@
 <!-- $Id$ -->
 <file_definition>
-    <file_group id="defile">
-        <file id="histstrataer" name="histstrataer" output_freq="1mo" output_level="_AUTO_" enabled="_AUTO_" compression_level="2">
-
-            <field_group group_ref="remap_1d">
-              <field_group group_ref="fields_strataer_3D" grid_ref="grid_out_presnivs" level="1" />
-              <field_group group_ref="fields_strataer_2D" grid_ref="grid_out"  level="1" />
-              <field_group group_ref="fields_strataer_trac_3D"  grid_ref="grid_out_presnivs" level="1" />
-              <field_group group_ref="fields_strataer_trac_2D" grid_ref="grid_out" level="1" />
-           </field_group> 
-           
-        </file>
-    </file_group>
+  <file_group id="defile">
+    <file id="histstrataer" name="histstrataer" output_freq="1mo" output_level="_AUTO_" enabled="_AUTO_" compression_level="2">
+      
+      <field_group group_ref="remap_1mo" operation="average">
+	
+        <field_group grid_ref="grid_out"  level="3">
+	  <field field_ref="OD550_strat_only" level="1" />
+	  <field field_ref="OD1020_strat_only" level="1" />
+	  <field field_ref="surf_PM25_sulf" level="1" />
+	  <field field_ref="budg_dep_dry_ocs" level="3" />
+	  <field field_ref="budg_dep_wet_ocs" level="3" />
+	  <field field_ref="budg_dep_dry_so2" level="3" />
+	  <field field_ref="budg_dep_wet_so2" level="3" />
+	  <field field_ref="budg_dep_dry_h2so4" level="1" />
+	  <field field_ref="budg_dep_wet_h2so4" level="1" />
+	  <field field_ref="budg_dep_dry_part" level="1" />
+	  <field field_ref="budg_dep_wet_part" level="1" />
+	  <field field_ref="budg_emi_ocs" level="1" />
+	  <field field_ref="budg_emi_so2" level="1" />
+	  <field field_ref="budg_emi_h2so4" level="1" />
+	  <field field_ref="budg_emi_part" level="1" />
+	  <field field_ref="budg_ocs_to_so2" level="1" />
+	  <field field_ref="budg_so2_to_h2so4" level="1" />
+	  <field field_ref="budg_h2so4_to_part" level="1" />
+	  <field field_ref="budg_sed_part" level="1" />
+	  <field field_ref="p_tropopause" level="1" />
+	  <field field_ref="z_tropopause" level="1" />
+	  <field field_ref="t_tropopause" level="3" />
+	</field_group>
+	
+        <field_group grid_ref="grid_out_presnivs" level="5">
+	  <field field_ref="ext_strat_550"  level="1" />
+	  <field field_ref="ext_strat_1020" level="1" />
+	  <field field_ref="budg_3D_nucl" level="1" />
+	  <field field_ref="budg_3D_cond_evap" level="1" />
+	  <field field_ref="budg_3D_ocs_to_so2" level="1" />
+	  <field field_ref="budg_3D_so2_to_h2so4" level="1" />
+	  <field field_ref="budg_3D_backgr_ocs" level="1" />
+	  <field field_ref="budg_3D_backgr_so2" level="1" />
+	  <field field_ref="R2SO4" level="1" />
+	  <field field_ref="OCS_lifetime" level="1" />
+	  <field field_ref="SO2_lifetime" level="1" />
+	  <field field_ref="vsed_aer" level="2" />
+	  <field field_ref="f_r_wet" level="1" />
+	  <field field_ref="mass" level="2" />
+	  <field field_ref="temp" level="2" />
+	  <field field_ref="pres" level="2" />
+          <field field_ref="h2o"  level="1" />
+	  <field field_ref="dqch4" level="1" />
+	</field_group>
+	
+        <field_group grid_ref="grid_out_presnivs" level="5">
+          <field field_ref="BIN01" level="1" />
+          <field field_ref="BIN02" level="1" />
+          <field field_ref="BIN03" level="1" />
+          <field field_ref="BIN04" level="1" />
+          <field field_ref="BIN05" level="1" />
+          <field field_ref="BIN06" level="1" />
+          <field field_ref="BIN07" level="1" />
+          <field field_ref="BIN08" level="1" />
+          <field field_ref="BIN09" level="1" />
+          <field field_ref="BIN10" level="1" />
+          <field field_ref="BIN11" level="1" />
+          <field field_ref="BIN12" level="1" />
+          <field field_ref="BIN13" level="1" />
+          <field field_ref="BIN14" level="1" />
+          <field field_ref="BIN15" level="1" />
+          <field field_ref="BIN16" level="1" />
+          <field field_ref="BIN17" level="1" />
+          <field field_ref="BIN18" level="1" />
+          <field field_ref="BIN19" level="1" />
+          <field field_ref="BIN20" level="1" />
+          <field field_ref="BIN21" level="1" />
+          <field field_ref="BIN22" level="1" />
+          <field field_ref="BIN23" level="1" />
+          <field field_ref="BIN24" level="1" />
+          <field field_ref="BIN25" level="1" />
+          <field field_ref="BIN26" level="1" />
+          <field field_ref="BIN27" level="1" />
+          <field field_ref="BIN28" level="1" />
+          <field field_ref="BIN29" level="1" />
+          <field field_ref="BIN30" level="1" />
+          <field field_ref="BIN31" level="1" />
+          <field field_ref="BIN32" level="1" />
+          <field field_ref="BIN33" level="1" />
+          <field field_ref="BIN34" level="1" />
+          <field field_ref="BIN35" level="1" />
+          <field field_ref="BIN36" level="1" />
+	  <field field_ref="GASOCS"  level="1" />
+	  <field field_ref="GASSO2"  level="1" />
+	  <field field_ref="GASH2SO4"  level="1" />
+	</field_group>
+	
+      </field_group> 
+    </file>
+  </file_group>
 </file_definition>
Index: /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_phystoke_lmdz.xml
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_phystoke_lmdz.xml	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/DefLists/file_def_phystoke_lmdz.xml	(revision 4727)
@@ -0,0 +1,79 @@
+<file_definition>
+  <file id="phystoke" name="phystoke" output_freq="3h" enabled=".TRUE." >
+
+    <field_group operation="average" freq_op="900s" domain_ref="dom_out" axis_ref="klev">
+      
+      <field field_ref="coefh_stok"      /> 
+      <field field_ref="fm_th_stok"      /> 
+      <field field_ref="en_th_stok"      /> 
+      <field field_ref="da_stok"         /> 
+      <field field_ref="mp_stok"         /> 
+      <field field_ref="upwd_stok"       /> 
+      <field field_ref="dnwd_stok"       /> 
+      <field field_ref="wght_stok"       />
+      <field field_ref="t_stok"       /> 
+
+
+      <field field_ref="phi_lev1"   /> 
+      <field field_ref="phi_lev2"   /> 
+      <field field_ref="phi_lev3"   /> 
+      <field field_ref="phi_lev4"   /> 
+      <field field_ref="phi_lev5"   /> 
+      <field field_ref="phi_lev6"   /> 
+      <field field_ref="phi_lev7"   /> 
+      <field field_ref="phi_lev8"   /> 
+      <field field_ref="phi_lev9"   /> 
+      <field field_ref="phi_lev10"  /> 
+      <field field_ref="phi_lev11"  /> 
+      <field field_ref="phi_lev12"  /> 
+      <field field_ref="phi_lev13"  /> 
+      <field field_ref="phi_lev14"  /> 
+      <field field_ref="phi_lev15"  /> 
+      <field field_ref="phi_lev16"  /> 
+      <field field_ref="phi_lev17"  /> 
+      <field field_ref="phi_lev18"  /> 
+      <field field_ref="phi_lev19"  /> 
+      <field field_ref="phi_lev20"  /> 
+      <field field_ref="phi_lev21"  /> 
+      <field field_ref="phi_lev22"  /> 
+      <field field_ref="phi_lev23"  /> 
+      <field field_ref="phi_lev24"  /> 
+      <field field_ref="phi_lev25"  /> 
+      <field field_ref="phi_lev26"  /> 
+      <field field_ref="phi_lev27"  /> 
+      <field field_ref="phi_lev28"  /> 
+      <field field_ref="phi_lev29"  /> 
+      <field field_ref="phi_lev30"  /> 
+      <field field_ref="phi_lev31"  /> 
+      <field field_ref="phi_lev32"  /> 
+      <field field_ref="phi_lev33"  /> 
+      <field field_ref="phi_lev34"  /> 
+      <field field_ref="phi_lev35"  /> 
+      <field field_ref="phi_lev36"  /> 
+      <field field_ref="phi_lev37"  /> 
+      <field field_ref="phi_lev38"  /> 
+      <field field_ref="phi_lev39"  /> 
+      <field field_ref="phi_lev40"  /> 
+      <field field_ref="phi_lev41"  /> 
+      <field field_ref="phi_lev42"  /> 
+      <field field_ref="phi_lev43"  /> 
+      <field field_ref="phi_lev44"  /> 
+      <field field_ref="phi_lev45"  /> 
+      <field field_ref="phi_lev46"  /> 
+      <field field_ref="phi_lev47"  /> 
+      <field field_ref="phi_lev48"  /> 
+      <field field_ref="phi_lev49"  /> 
+
+    </field_group>
+
+    <field_group operation="average"  grid_ref="grid_out" >
+      <field field_ref="yu1_stok"   />
+      <field field_ref="yv1_stok"   />
+      <field field_ref="aire" /> 
+      <field field_ref="phis" /> 
+    </field_group>
+
+  </file>
+
+
+</file_definition>
Index: /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_ECSexp1
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_ECSexp1	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_ECSexp1	(revision 4727)
@@ -0,0 +1,536 @@
+#
+# $Id: physiq.def_NPv6.0.15_S 3593 2018-02-20 10:07:02Z jgipsl $
+#
+
+##############################################################
+# PARAMETRES ET CLES DE LA PHYSIQUE LMDZ
+# Cette version correspond à l'expérience Exp1 de l'article
+# sur l'exploration paramétrique de l'ECS :
+# Hourdin, F , et al., Science Advances, 2023, DOI: 10.1126/sciadv.adf2758
+##############################################################
+# D: Valeur par default
+#
+
+###########################################################
+# divers. Devrait aller dans config.def ?
+###########################################################
+##   Si=.T. ,  lecture du fichier limit avec la bonne annee 
+ok_limitvrai=n
+
+###########################################################
+# Parametres couche limite de surface
+###########################################################
+
+          #  ...
+f_cdrag_stable=1
+
+          # Facteur sur les coefficients de trainee terrestres
+f_cdrag_ter=1
+
+          # Vitesse minimum dans les calculs de trainee Cd ( || V || + Vmin )
+min_wind_speed=0.1
+
+          #  Modelisation des bosquets
+ifl_pbltree=1
+Cd_frein=0.016
+
+###########################################################
+# parameter des flux air-mer
+###########################################################
+
+          # Facteur sur les flux sensibles et latent
+          # Introduit pour reduire l evaporation quand on avait z0h=z0m
+          # CONSEILLE : 1
+f_cdrag_oce=1
+
+          # Flag controlant le calcul des z0
+iflag_z0_oce=1
+
+          # Rapport entre les Z0 latent et sensible
+f_z0qh_oce=1.55
+
+          # Activation des rafales : Oui 1 ou non 0
+iflag_gusts=2
+
+          # facteur pour les rafales des thermiques (bounary layer)
+f_gust_bl=0.845
+
+          # facteur pour les poches (wake)
+f_gust_wk=0.2
+
+          # facteur sur qsat pour tenir compte de la salinite
+f_qsat_oce=0.98
+
+          #cdmmax : valeur max de Cd moment. Sur ocean seulement
+cdmmax=0.2
+
+          #cdhmax : valeur max de Cd evap/sensible. Sur ocean seulement
+cdhmax=0.2
+
+####################################################################
+# Couche limite turbulente
+####################################################################
+
+          # Nouvelle version de Mellor et Yamada
+new_yamada4=y
+
+          # Choix du schema numerique pour new_yamada4=y
+          #  1 schema de MAR. Bien pour CL stables mais detruit les stratocu
+          #  5 schema de MAR modifie. Precaunise.
+yamada4_num=5
+
+          # Flag de controle de la couche limite stable
+iflag_corr_sta=4
+
+          # min sur les fonction de stabilite a la surface
+f_ri_cd_min=0.01
+
+          # max du Ric pour Kz. Decouplage plus grand pour Ric plus grand.
+yamada4_ric=0.18
+
+          # Longueur de melange minimum pour Kz
+lmixmin=0
+
+          #shema de la couche de surface (D:1, 1:LMD, 8:Mellor-Yamada) 
+iflag_pbl=12
+
+          # Seuils pour la diffusion turbulente
+ksta_ter=1e-07
+ksta=1e-10
+
+          #ok_kzmin : calcul Kzmin dans la CL de surface (D: y)
+ok_kzmin=n
+
+          # Creation de TKE par orographie sous-maille
+addtkeoro=2
+alphatkeoro=1
+smallscales_tkeoro=y
+
+
+####################################################################
+# Ondes de gravite / Orographie sous maille
+####################################################################
+
+          #  Orodr  ou  non   pour l orographie
+ok_orodr=y
+
+          #  Orolf  ou  non   pour l orographie              
+ok_orolf=y
+
+          #Rugoro : inclusion de l orographie sous maille dans le Cd de surface
+          # Obsolete avec l activation des ondes de gravite
+f_rugoro=0
+
+          # Parametres controlant l effet de l orographie sous maille
+sso_gfrcri=0.7
+sso_gkdrag=0.6
+sso_gkwake=0.4
+sso_gklift=0.1
+
+          # Random gravity waves
+          #Activitate the stochastic parameterization of convective GWs
+          # (should be equal to ok_strato)
+ok_gwd_rando=y
+
+          # Scale the momentum fluxes due to convective GWs
+gwd_rando_ruwmax=0.5
+
+          #Scale the saturated momentum flux of  convective GWs 
+gwd_rando_sat=0.6
+
+          # Important pour controler la periode de la QBO
+gwd_front_ruwmax=3
+
+
+###############################################################
+# Rayonnement
+###############################################################
+          # activation du nouveau code de rayonnement RRTM
+          # 0 : Ancien code et 1 : RRTM (D=0)
+iflag_rrtm=1
+
+          # Nombre de bandes pour le SW. Mettre 2 si iflag_rrtm=0
+NSW=6
+
+    # Albedo et inertie des calottes
+alb_vis_sno_lic=0.96
+alb_nir_sno_lic=0.68
+    # Controle de l'inertie des glaciers et banquises
+    # inertie_sno : pour la neige (y compris sur les points "ter"
+    #      quand orchidee n'est pas actif utilisé)
+    # inertie_lic/sic : pour les "land ice" et "sea ice"
+inertie_sno=350
+    # iflag_sic=1 pour forcer à garder l'inertie des "sea ice"
+    # a inertie_sic meme si la surface est couverte de neige
+iflag_sic=1
+inertie_lic=2000
+inertie_sic=2000
+
+
+          # ???
+iflag_albedo=1
+
+          # Frequence appel rayonnement. Nombre appels par jour
+nbapp_cv=48
+
+          # Pour pouvoir revenir a un bug purement informatique de duplication
+          # des constantes thermodynamiques entre LMDZ et RRTM
+          # n : FORTEMENT CONSEILLE
+ok_bad_ecmwf_thermo=n
+
+###############################################################
+# Parametres nuages
+###############################################################
+
+          #seuils de la precipitation des nuages strateformes (D: 2.6e-4 2.6e-4)
+cld_lc_lsc=0.000635780517230841
+cld_lc_con=0.000635780517230841
+
+          #constante de temps pour eleminer eau lsc et convective
+          # (D: 3600. 3600.)
+cld_tau_lsc=900
+cld_tau_con=900
+
+          #facteurs correctifs sur la vitesse de chute des cristaux de glace (D: 1 1)
+ffallv_lsc=0.599395588187729
+ffallv_con=0.599395588187729
+
+          # coefficient sur la reevaporation de la pluie (D: 2.e-5 n)
+          # regle a 3.e-5 sur des cas de cumulus en 1D
+coef_eva=0.0001
+
+          # flag pour la reevaporation de la pluie
+          # 0: rien
+          # 1: a l ancienne
+          # 2: prend en compte la surface nuageuse max au dessus pour calculer
+          #    le max de reevaporation, comme ecart a la saturation. CONSEILLE
+iflag_evap_prec=2
+
+          # Modification de la plage de temperature pour la phase mixte
+          # liquide/glace des nuages
+          # Controle par les t_glace_min/max, exposant_glace,
+          # iflag_t_glace (D=0)
+t_glace_min=243.15
+t_glace_max=273.15
+exposant_glace=0.5
+iflag_t_glace=3
+
+          # Activation de la thermodynamique de la glace
+iflag_ice_thermo=1
+
+          # normalement elle ne sert plus a rien dans fisrtilp
+          # sinon elle est un peu toxique:
+          # IF (zt(i) .LT. t_coup.and.reevap_ice) zrfln(i)=0. (Jean-Baptiste)
+reevap_ice=n
+
+          #Bergeron
+iflag_bergeron=2
+
+          # temperature dependency of qsat for iterative procedure
+          # temporary flag to switch between the old (CMIP5, D=0)
+          # and new versions (=1) versions 
+iflag_fisrtilp_qsat=4
+
+          #calcul des proprietes des nuages convectifs (D:1 0.375 1.e-4) 
+iflag_cldcon=6
+fact_cldcon=0.812371295615361
+
+          # ?????
+facttemps=0
+
+          #calcul eau condensee et fraction nuageuse a partir des PDF
+          # (D:0, 0:version avec ratqs sinon nouvelles PDFs)  
+iflag_pdf=1
+
+          #calcul epaisseur optique et emmissivite des nuages (D: y 1 0.01 0.3)
+ok_newmicro=y
+
+          # Controle des ratqs grande echelle
+iflag_ratqs=4
+ratqsp0=34307.7121680875
+ratqsdp=25423.2097520433
+ratqsbas=0.002
+ratqshaut=0.509392871644901
+
+          #rayon effectif pour les nuages de glace (D:35)
+rad_froid=35
+
+          # Rayons effectif des gouttes nuageuses
+          # ACTIF SI ok_cdnc=0 dans config.def. (D~9 a 12 microns)
+rad_chau1=12
+rad_chau2=11
+
+	  # Rayon effectif des gouttes si ok_cdnc=0
+          # Parameters in CDNC-maer link (Boucher&Lohmann 1995)
+bl95_b0=1.17451309137369
+bl95_b1=0.2
+
+          #  Choix ou non  de  New oliq               
+new_oliq=y
+
+          # Seuils oliqmax, oicemax (en g/kg).
+          # Au dela on precipite directement au sol
+oliqmax=0.0015
+oicemax=0.0015
+
+          #Rayons min et max effectifs des particules des nuages
+rei_min=18.9435
+rei_max=72.5654
+
+          # Distribution vetricale sous maille pour le schema de de nuages.
+          # 0: rien
+          # 1: Premiere version A. Jam,
+          # 2 : J. Jouhaud, parametre cloudth_vert_alpha D=0.5
+          # 3 : J. Jouhaud, parametre cloudth_vert_alpha D=0.5/C= 1.32
+          #                           cloudth_vert_alpha_th C=2:91
+iflag_cloudth_vert=3
+cloudth_vert_alpha=0.5
+cloudth_vert_alpha_th=0.5
+
+
+######################################################################
+# Convection 
+######################################################################
+
+          #Convection scheme switch
+          # (D:2, 1:LMD, 2:Tiedtke, 3:KE New Physics, 30:KE AR4)
+iflag_con=3
+
+          #output level of energy conservation diagnostics
+if_ebil=0
+
+          #maximum efficiency of cld water->precipitation conversion (D: 0.993)
+epmax=0.999534
+
+          #dry convective adjustment at beginning of Emanuel convective scheme (D: n 0)
+ok_adj_ema=n
+iflag_clw=0
+
+          #Convective closure (D:1, 0:AR4, 2:ALE and ALP)
+iflag_clos=2
+
+          #Convective entrainment mixing law (D:1, 0:AR4=flat PDF, 1=PDF)
+iflag_mix=1
+
+          #weights of the bell shaped and flat PDF (used only if iflag_mix=1) (D: 1 0)
+qqa1=1
+qqa2=0
+
+          #Parameters of the bell shaped PDF; Fmax=center (D= 0.65), Gammas=width (D=0.05)
+cvl_corr=1
+
+          #Multiplicative factor of Emanuel convective scheme precipitation (D: 1.)
+Fmax=0.65
+
+          #altitude, in hPa, above LCL at which buoybase is computed,
+          # def = original: -40
+dpbase=-40
+
+          #reference fractional area of precipitating downdraughts,
+          # def = original: 0.01
+sigdz=0.00572853968455156
+
+          #unsaturated fraction of precipitating downdraughts, def = original: 0.15
+spfac=0.15
+
+          #relaxation time of cloud base mass flux, def = original: 8000
+tau=8000
+
+          #flag for wb (= vert velocity at LFC);
+          # 0->wb=wbmax=2.71287437770784
+          # Si iflag_wb=50.018
+          # wbmax=2.71287437770784
+flag_wb=50.018
+wbmax=2.71287437770784
+
+          # Divers tests
+ok_convstop=n
+tau_stop=15000
+ok_intermittent=n
+
+          # nouvel epluchage de C.Rio
+          #shedding coefficient (used when iflag_mix_adiab=1)
+iflag_mix_adiab=0
+coef_peel=0.25
+
+          #Conversion cld water->precip: Ep=f(pressure) if 0; Ep=f(temperature)
+          #if 1, def=1
+flag_epKEorig=1
+
+          # Case : flag_epKEorig=1
+          # elcrit=0.000189125727371951
+          # tlcrit=-52.6524333022965
+          # original: 0.0011, used only if flag_epKEorig=1
+elcrit=0.000189125727371951
+tlcrit=-52.6524333022965
+
+          # Case : flag_epKEorig=0
+          # pbcrit : pressure (hPa), above LCL below which Ep=0, D=150 (original)
+          # ptcrit : pressure (hPa), above LCL above which Ep=Epmax, D=500 (original)
+pbcrit=150
+ptcrit=500
+
+          # Prevent some crashes
+          # Filter out bad wakes
+flag_wk_check_trgl=n
+iflag_wk_check_trgl=2
+iflag_alp_wk_cond=1
+
+
+          # Check whether parcel level temperature and specific humidity
+          # are reasonable and demand that LCL be high enough
+cv_flag_feed=2
+
+          # save 20% CPU 
+ok_optim_yield=y
+
+          # Convective clouds
+iflag_cld_cv=0
+
+          # To get back to bug where convective output variables
+          # were set to 0 at the start of the physics
+ok_bug_cv_trac=n
+
+##########################################################
+# Fermeture convective et couplages
+##########################################################
+
+          # Appel separe des thermiques 
+iflag_pbl_split=10
+
+          #rendement sur la puissance fournie par les thermiques a la convection
+alp_bl_k=0.33710920313038
+
+          #Constant value to be added to Alp (D: 0.)
+alp_offset=0
+
+          #Convection must reach a level at which T<t_top_max to be active
+t_top_max=1000
+
+          ### nrlmd le 10/04/2012: Declenchement ###
+          #Declenchement par couche-limite (0: deterministe, 1: stochastique)
+iflag_trig_bl=1
+
+          #Surface critique au LCL
+s_trig=12000000
+
+          #Temps de decorrelation entre scenes de cumulus
+tau_trig_shallow=1200
+
+          #Temps de decorrelation entre scenes de cumulonimbus
+tau_trig_deep=1200
+
+          # Pour la stabilisation
+random_notrig_max=0.99
+
+          # Temperature a la quelle on fond les descentes glacees
+tmax_fonte_cv=278.15
+
+          #Fermeture par couche-limite (Nicolas Rochetin)
+          #(0: deterministe, 1: statistique, 2: statistique+convergence
+          # grande echelle)
+iflag_clos_bl=1
+
+          #coefficient in Wape->C_star formula: C_star=stark*sqrt(2*Wape),
+          # def: 0.33
+stark=0.33
+
+          #lifting efficiency of wakes; Alp=Alpk*Fip, Fip=power provided
+          # by wakes, def: 0.25
+alpk=0.0817240860702295
+
+#
+##########################################################
+# Couche limite convective / modele du thermique
+##########################################################
+
+          # Convection seche (D:0, 0:ajustement sec,=>1:modele du thermique) 
+iflag_thermals=18
+
+          # pas de temps du spliting pour les thermiques
+          # TOURNE MAIS POSE PLUS DE PROBLEME QU ELLE N EN RESOUD
+nsplit_thermals=1
+
+          # tau_thermals pour avoir une constante de temps sur les thermiques.
+          # Non valide
+tau_thermals=0
+
+          # Flag controlant le detrainement et l entrainement
+iflag_thermals_ed=8
+
+          # On va chercher l air a z * ( 1+fact_thermals_ed_dz=0.0655773728288594
+          # le detrainement (A. Jam)
+fact_thermals_ed_dz=0.0655773728288594
+
+          # Une option de plus sur les thermiques.
+iflag_thermals_optflux=0
+
+          #couplage ou non avec la convection
+iflag_coupl=5
+
+          # Seuil pour desactiver les thermiques en cas de forte inversion
+          # en sommet de couche limite. Actif si iflag_thermals impair.
+seuil_inversion=-0.08
+
+          # Reactivation du calcul d un zmax continu pour les thermiques
+          # reactivation d une fermeture humide des thermiques
+          # iflag_thermals_closure=2 (D=1)
+iflag_thermals_closure=2
+
+
+##########################################################
+# Flags wakes
+##########################################################
+
+          #Wake scheme switch (D:0, 0:AR4, 1:New Physics)
+iflag_wake=1
+
+          #multiplicative factor of the damping by gravity waves, def: 4.
+coefgw=4
+
+          #wake density = number of wake centers per m2, def: 8.E-12
+          #wdens_ref=8.E-12
+wdens_ref_o=1.67071191724488e-11
+wdens_ref_l=8e-12
+
+          # Ajustement convectif prealable au calcul des poches
+ok_adjwk=y
+
+
+####################################################################
+#  Conservation 
+####################################################################
+
+          # The source terms of the TKE prognostic equation are diagnosed
+          # from tendencies (du, dv, dT) 
+          # associated with subrgrid scaleamotions and treated as an 
+          # additional heat source.
+          # Controled by a key, iflag_ener_conserv (D=-1):
+          # 0 : no conservation, -1 : old adhoc correction for kinetic E only
+          # (used for CMIP5) 
+          # 1 : conservation, 101 : conversion from kinetic to heat only,
+          # 110 conversion from potential to heat only
+iflag_ener_conserv=10
+
+          #Activation of corrections for water conservation (D: n). 
+          ##The default is n for compatibility with earlier versions.
+          ##generally it should be y.
+ok_conserv_q=y
+
+fl_cor_ebil=1
+
+####################################################################
+# Ozone
+####################################################################
+          # new treatment for ozone into the tropopause
+adjust_tropopause=y
+
+####################################################################
+#  Conservation de l'eau
+#####################################################################
+          # conservation de l eau sur les calottes
+ok_lic_cond=y
+
+cdnc_min=10.
+
+
Index: /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_ECSexp2
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_ECSexp2	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_ECSexp2	(revision 4727)
@@ -0,0 +1,538 @@
+#
+# $Id: physiq.def_NPv6.0.15_S 3593 2018-02-20 10:07:02Z jgipsl $
+#
+
+##############################################################
+# PARAMETRES ET CLES DE LA PHYSIQUE LMDZ
+# Cette version correspond à l'expérience Exp2 de l'article
+# sur l'exploration paramétrique de l'ECS :
+# Hourdin, F , et al., Science Advances, 2023, DOI: 10.1126/sciadv.adf2758
+##############################################################
+
+##############################################################
+# D: Valeur par default
+#
+
+###########################################################
+# divers. Devrait aller dans config.def ?
+###########################################################
+##   Si=.T. ,  lecture du fichier limit avec la bonne annee 
+ok_limitvrai=n
+
+###########################################################
+# Parametres couche limite de surface
+###########################################################
+
+          #  ...
+f_cdrag_stable=1
+
+          # Facteur sur les coefficients de trainee terrestres
+f_cdrag_ter=1
+
+          # Vitesse minimum dans les calculs de trainee Cd ( || V || + Vmin )
+min_wind_speed=0.1
+
+          #  Modelisation des bosquets
+ifl_pbltree=1
+Cd_frein=0.016
+
+###########################################################
+# parameter des flux air-mer
+###########################################################
+
+          # Facteur sur les flux sensibles et latent
+          # Introduit pour reduire l evaporation quand on avait z0h=z0m
+          # CONSEILLE : 1
+f_cdrag_oce=1
+
+          # Flag controlant le calcul des z0
+iflag_z0_oce=1
+
+          # Rapport entre les Z0 latent et sensible
+f_z0qh_oce=1.55
+
+          # Activation des rafales : Oui 1 ou non 0
+iflag_gusts=2
+
+          # facteur pour les rafales des thermiques (bounary layer)
+f_gust_bl=0.845
+
+          # facteur pour les poches (wake)
+f_gust_wk=0.2
+
+          # facteur sur qsat pour tenir compte de la salinite
+f_qsat_oce=0.98
+
+          #cdmmax : valeur max de Cd moment. Sur ocean seulement
+cdmmax=0.2
+
+          #cdhmax : valeur max de Cd evap/sensible. Sur ocean seulement
+cdhmax=0.2
+
+####################################################################
+# Couche limite turbulente
+####################################################################
+
+          # Nouvelle version de Mellor et Yamada
+new_yamada4=y
+
+          # Choix du schema numerique pour new_yamada4=y
+          #  1 schema de MAR. Bien pour CL stables mais detruit les stratocu
+          #  5 schema de MAR modifie. Precaunise.
+yamada4_num=5
+
+          # Flag de controle de la couche limite stable
+iflag_corr_sta=4
+
+          # min sur les fonction de stabilite a la surface
+f_ri_cd_min=0.01
+
+          # max du Ric pour Kz. Decouplage plus grand pour Ric plus grand.
+yamada4_ric=0.18
+
+          # Longueur de melange minimum pour Kz
+lmixmin=0
+
+          #shema de la couche de surface (D:1, 1:LMD, 8:Mellor-Yamada) 
+iflag_pbl=12
+
+          # Seuils pour la diffusion turbulente
+ksta_ter=1e-07
+ksta=1e-10
+
+          #ok_kzmin : calcul Kzmin dans la CL de surface (D: y)
+ok_kzmin=n
+
+          # Creation de TKE par orographie sous-maille
+addtkeoro=2
+alphatkeoro=1
+smallscales_tkeoro=y
+
+
+####################################################################
+# Ondes de gravite / Orographie sous maille
+####################################################################
+
+          #  Orodr  ou  non   pour l orographie
+ok_orodr=y
+
+          #  Orolf  ou  non   pour l orographie              
+ok_orolf=y
+
+          #Rugoro : inclusion de l orographie sous maille dans le Cd de surface
+          # Obsolete avec l activation des ondes de gravite
+f_rugoro=0
+
+          # Parametres controlant l effet de l orographie sous maille
+sso_gfrcri=0.7
+sso_gkdrag=0.6
+sso_gkwake=0.4
+sso_gklift=0.1
+
+          # Random gravity waves
+          #Activitate the stochastic parameterization of convective GWs
+          # (should be equal to ok_strato)
+ok_gwd_rando=y
+
+          # Scale the momentum fluxes due to convective GWs
+gwd_rando_ruwmax=0.5
+
+          #Scale the saturated momentum flux of  convective GWs 
+gwd_rando_sat=0.6
+
+          # Important pour controler la periode de la QBO
+gwd_front_ruwmax=3
+
+
+###############################################################
+# Rayonnement
+###############################################################
+          # activation du nouveau code de rayonnement RRTM
+          # 0 : Ancien code et 1 : RRTM (D=0)
+iflag_rrtm=1
+
+          # Nombre de bandes pour le SW. Mettre 2 si iflag_rrtm=0
+NSW=6
+
+    # Albedo et inertie des calottes
+alb_vis_sno_lic=0.96
+alb_nir_sno_lic=0.68
+    # Controle de l'inertie des glaciers et banquises
+    # inertie_sno : pour la neige (y compris sur les points "ter"
+    #      quand orchidee n'est pas actif utilisé)
+    # inertie_lic/sic : pour les "land ice" et "sea ice"
+inertie_sno=350
+    # iflag_sic=1 pour forcer à garder l'inertie des "sea ice"
+    # a inertie_sic meme si la surface est couverte de neige
+iflag_sic=1
+inertie_lic=2000
+inertie_sic=2000
+
+
+          # ???
+iflag_albedo=1
+
+          # Frequence appel rayonnement. Nombre appels par jour
+nbapp_cv=48
+
+          # Pour pouvoir revenir a un bug purement informatique de duplication
+          # des constantes thermodynamiques entre LMDZ et RRTM
+          # n : FORTEMENT CONSEILLE
+ok_bad_ecmwf_thermo=n
+
+###############################################################
+# Parametres nuages
+###############################################################
+
+          #seuils de la precipitation des nuages strateformes (D: 2.6e-4 2.6e-4)
+cld_lc_lsc=0.000122394742408727
+cld_lc_con=0.000122394742408727
+
+          #constante de temps pour eleminer eau lsc et convective
+          # (D: 3600. 3600.)
+cld_tau_lsc=900
+cld_tau_con=900
+
+          #facteurs correctifs sur la vitesse de chute des cristaux de glace (D: 1 1)
+ffallv_lsc=1.42963136508413
+ffallv_con=1.42963136508413
+
+          # coefficient sur la reevaporation de la pluie (D: 2.e-5 n)
+          # regle a 3.e-5 sur des cas de cumulus en 1D
+coef_eva=0.0001
+
+          # flag pour la reevaporation de la pluie
+          # 0: rien
+          # 1: a l ancienne
+          # 2: prend en compte la surface nuageuse max au dessus pour calculer
+          #    le max de reevaporation, comme ecart a la saturation. CONSEILLE
+iflag_evap_prec=2
+
+          # Modification de la plage de temperature pour la phase mixte
+          # liquide/glace des nuages
+          # Controle par les t_glace_min/max, exposant_glace,
+          # iflag_t_glace (D=0)
+t_glace_min=243.15
+t_glace_max=273.15
+exposant_glace=0.5
+iflag_t_glace=3
+
+          # Activation de la thermodynamique de la glace
+iflag_ice_thermo=1
+
+          # normalement elle ne sert plus a rien dans fisrtilp
+          # sinon elle est un peu toxique:
+          # IF (zt(i) .LT. t_coup.and.reevap_ice) zrfln(i)=0. (Jean-Baptiste)
+reevap_ice=n
+
+          #Bergeron
+iflag_bergeron=2
+
+          # temperature dependency of qsat for iterative procedure
+          # temporary flag to switch between the old (CMIP5, D=0)
+          # and new versions (=1) versions 
+iflag_fisrtilp_qsat=4
+
+          #calcul des proprietes des nuages convectifs (D:1 0.375 1.e-4) 
+iflag_cldcon=6
+fact_cldcon=1.08083694005934
+
+          # ?????
+facttemps=0
+
+          #calcul eau condensee et fraction nuageuse a partir des PDF
+          # (D:0, 0:version avec ratqs sinon nouvelles PDFs)  
+iflag_pdf=1
+
+          #calcul epaisseur optique et emmissivite des nuages (D: y 1 0.01 0.3)
+ok_newmicro=y
+
+          # Controle des ratqs grande echelle
+iflag_ratqs=4
+ratqsp0=54767.3023688978
+ratqsdp=11474.3530652062
+ratqsbas=0.002
+ratqshaut=0.541154922614529
+
+          #rayon effectif pour les nuages de glace (D:35)
+rad_froid=35
+
+          # Rayons effectif des gouttes nuageuses
+          # ACTIF SI ok_cdnc=0 dans config.def. (D~9 a 12 microns)
+rad_chau1=12
+rad_chau2=11
+
+	  # Rayon effectif des gouttes si ok_cdnc=0
+          # Parameters in CDNC-maer link (Boucher&Lohmann 1995)
+bl95_b0=0.802077222730812
+bl95_b1=0.2
+
+          #  Choix ou non  de  New oliq               
+new_oliq=y
+
+          # Seuils oliqmax, oicemax (en g/kg).
+          # Au dela on precipite directement au sol
+oliqmax=0.0015
+oicemax=0.0015
+
+          #Rayons min et max effectifs des particules des nuages
+rei_min=18.9761
+rei_max=72.6905
+
+          # Distribution vetricale sous maille pour le schema de de nuages.
+          # 0: rien
+          # 1: Premiere version A. Jam,
+          # 2 : J. Jouhaud, parametre cloudth_vert_alpha D=0.5
+          # 3 : J. Jouhaud, parametre cloudth_vert_alpha D=0.5/C= 1.32
+          #                           cloudth_vert_alpha_th C=2:91
+iflag_cloudth_vert=3
+cloudth_vert_alpha=0.5
+cloudth_vert_alpha_th=0.5
+
+
+######################################################################
+# Convection 
+######################################################################
+
+          #Convection scheme switch
+          # (D:2, 1:LMD, 2:Tiedtke, 3:KE New Physics, 30:KE AR4)
+iflag_con=3
+
+          #output level of energy conservation diagnostics
+if_ebil=0
+
+          #maximum efficiency of cld water->precipitation conversion (D: 0.993)
+epmax=0.993778
+
+          #dry convective adjustment at beginning of Emanuel convective scheme (D: n 0)
+ok_adj_ema=n
+iflag_clw=0
+
+          #Convective closure (D:1, 0:AR4, 2:ALE and ALP)
+iflag_clos=2
+
+          #Convective entrainment mixing law (D:1, 0:AR4=flat PDF, 1=PDF)
+iflag_mix=1
+
+          #weights of the bell shaped and flat PDF (used only if iflag_mix=1) (D: 1 0)
+qqa1=1
+qqa2=0
+
+          #Parameters of the bell shaped PDF; Fmax=center (D= 0.65), Gammas=width (D=0.05)
+cvl_corr=1
+
+          #Multiplicative factor of Emanuel convective scheme precipitation (D: 1.)
+Fmax=0.65
+
+          #altitude, in hPa, above LCL at which buoybase is computed,
+          # def = original: -40
+dpbase=-40
+
+          #reference fractional area of precipitating downdraughts,
+          # def = original: 0.01
+sigdz=0.0017493242905631
+
+          #unsaturated fraction of precipitating downdraughts, def = original: 0.15
+spfac=0.15
+
+          #relaxation time of cloud base mass flux, def = original: 8000
+tau=8000
+
+          #flag for wb (= vert velocity at LFC);
+          # 0->wb=wbmax=4.80116711879874
+          # Si iflag_wb=67.2032
+          # wbmax=4.80116711879874
+flag_wb=67.2032
+wbmax=4.80116711879874
+
+          # Divers tests
+ok_convstop=n
+tau_stop=15000
+ok_intermittent=n
+
+          # nouvel epluchage de C.Rio
+          #shedding coefficient (used when iflag_mix_adiab=1)
+iflag_mix_adiab=0
+coef_peel=0.25
+
+          #Conversion cld water->precip: Ep=f(pressure) if 0; Ep=f(temperature)
+          #if 1, def=1
+flag_epKEorig=1
+
+          # Case : flag_epKEorig=1
+          # elcrit=0.000282126616657347
+          # tlcrit=-56.3544740493864
+          # original: 0.0011, used only if flag_epKEorig=1
+elcrit=0.000282126616657347
+tlcrit=-56.3544740493864
+
+          # Case : flag_epKEorig=0
+          # pbcrit : pressure (hPa), above LCL below which Ep=0, D=150 (original)
+          # ptcrit : pressure (hPa), above LCL above which Ep=Epmax, D=500 (original)
+pbcrit=150
+ptcrit=500
+
+          # Prevent some crashes
+          # Filter out bad wakes
+flag_wk_check_trgl=n
+iflag_wk_check_trgl=2
+iflag_alp_wk_cond=1
+
+
+          # Check whether parcel level temperature and specific humidity
+          # are reasonable and demand that LCL be high enough
+cv_flag_feed=2
+
+          # save 20% CPU 
+ok_optim_yield=y
+
+          # Convective clouds
+iflag_cld_cv=0
+
+          # To get back to bug where convective output variables
+          # were set to 0 at the start of the physics
+ok_bug_cv_trac=n
+
+##########################################################
+# Fermeture convective et couplages
+##########################################################
+
+          # Appel separe des thermiques 
+iflag_pbl_split=10
+
+          #rendement sur la puissance fournie par les thermiques a la convection
+alp_bl_k=0.588479941947037
+
+          #Constant value to be added to Alp (D: 0.)
+alp_offset=0
+
+          #Convection must reach a level at which T<t_top_max to be active
+t_top_max=1000
+
+          ### nrlmd le 10/04/2012: Declenchement ###
+          #Declenchement par couche-limite (0: deterministe, 1: stochastique)
+iflag_trig_bl=1
+
+          #Surface critique au LCL
+s_trig=12000000
+
+          #Temps de decorrelation entre scenes de cumulus
+tau_trig_shallow=1200
+
+          #Temps de decorrelation entre scenes de cumulonimbus
+tau_trig_deep=1200
+
+          # Pour la stabilisation
+random_notrig_max=0.99
+
+          # Temperature a la quelle on fond les descentes glacees
+tmax_fonte_cv=278.15
+
+          #Fermeture par couche-limite (Nicolas Rochetin)
+          #(0: deterministe, 1: statistique, 2: statistique+convergence
+          # grande echelle)
+iflag_clos_bl=1
+
+          #coefficient in Wape->C_star formula: C_star=stark*sqrt(2*Wape),
+          # def: 0.33
+stark=0.33
+
+          #lifting efficiency of wakes; Alp=Alpk*Fip, Fip=power provided
+          # by wakes, def: 0.25
+alpk=0.493712460059079
+
+#
+##########################################################
+# Couche limite convective / modele du thermique
+##########################################################
+
+          # Convection seche (D:0, 0:ajustement sec,=>1:modele du thermique) 
+iflag_thermals=18
+
+          # pas de temps du spliting pour les thermiques
+          # TOURNE MAIS POSE PLUS DE PROBLEME QU ELLE N EN RESOUD
+nsplit_thermals=1
+
+          # tau_thermals pour avoir une constante de temps sur les thermiques.
+          # Non valide
+tau_thermals=0
+
+          # Flag controlant le detrainement et l entrainement
+iflag_thermals_ed=8
+
+          # On va chercher l air a z * ( 1+fact_thermals_ed_dz=0.0676863943828353
+          # le detrainement (A. Jam)
+fact_thermals_ed_dz=0.0676863943828353
+
+          # Une option de plus sur les thermiques.
+iflag_thermals_optflux=0
+
+          #couplage ou non avec la convection
+iflag_coupl=5
+
+          # Seuil pour desactiver les thermiques en cas de forte inversion
+          # en sommet de couche limite. Actif si iflag_thermals impair.
+seuil_inversion=-0.08
+
+          # Reactivation du calcul d un zmax continu pour les thermiques
+          # reactivation d une fermeture humide des thermiques
+          # iflag_thermals_closure=2 (D=1)
+iflag_thermals_closure=2
+
+
+##########################################################
+# Flags wakes
+##########################################################
+
+          #Wake scheme switch (D:0, 0:AR4, 1:New Physics)
+iflag_wake=1
+
+          #multiplicative factor of the damping by gravity waves, def: 4.
+coefgw=4
+
+          #wake density = number of wake centers per m2, def: 8.E-12
+          #wdens_ref=8.E-12
+wdens_ref_o=4.35655188627899e-11
+wdens_ref_l=8e-12
+
+          # Ajustement convectif prealable au calcul des poches
+ok_adjwk=y
+
+
+####################################################################
+#  Conservation 
+####################################################################
+
+          # The source terms of the TKE prognostic equation are diagnosed
+          # from tendencies (du, dv, dT) 
+          # associated with subrgrid scaleamotions and treated as an 
+          # additional heat source.
+          # Controled by a key, iflag_ener_conserv (D=-1):
+          # 0 : no conservation, -1 : old adhoc correction for kinetic E only
+          # (used for CMIP5) 
+          # 1 : conservation, 101 : conversion from kinetic to heat only,
+          # 110 conversion from potential to heat only
+iflag_ener_conserv=10
+
+          #Activation of corrections for water conservation (D: n). 
+          ##The default is n for compatibility with earlier versions.
+          ##generally it should be y.
+ok_conserv_q=y
+
+fl_cor_ebil=1
+
+####################################################################
+# Ozone
+####################################################################
+          # new treatment for ozone into the tropopause
+adjust_tropopause=y
+
+####################################################################
+#  Conservation de l'eau
+#####################################################################
+          # conservation de l eau sur les calottes
+ok_lic_cond=y
+
+cdnc_min=10.
+
+
Index: /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_ECSexp3
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_ECSexp3	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_ECSexp3	(revision 4727)
@@ -0,0 +1,538 @@
+#
+# $Id: physiq.def_NPv6.0.15_S 3593 2018-02-20 10:07:02Z jgipsl $
+#
+
+##############################################################
+# PARAMETRES ET CLES DE LA PHYSIQUE LMDZ
+# Cette version correspond à l'expérience Exp3 de l'article
+# sur l'exploration paramétrique de l'ECS :
+# Hourdin, F , et al., Science Advances, 2023, DOI: 10.1126/sciadv.adf2758
+##############################################################
+
+##############################################################
+# D: Valeur par default
+#
+
+###########################################################
+# divers. Devrait aller dans config.def ?
+###########################################################
+##   Si=.T. ,  lecture du fichier limit avec la bonne annee 
+ok_limitvrai=n
+
+###########################################################
+# Parametres couche limite de surface
+###########################################################
+
+          #  ...
+f_cdrag_stable=1
+
+          # Facteur sur les coefficients de trainee terrestres
+f_cdrag_ter=1
+
+          # Vitesse minimum dans les calculs de trainee Cd ( || V || + Vmin )
+min_wind_speed=0.1
+
+          #  Modelisation des bosquets
+ifl_pbltree=1
+Cd_frein=0.016
+
+###########################################################
+# parameter des flux air-mer
+###########################################################
+
+          # Facteur sur les flux sensibles et latent
+          # Introduit pour reduire l evaporation quand on avait z0h=z0m
+          # CONSEILLE : 1
+f_cdrag_oce=1
+
+          # Flag controlant le calcul des z0
+iflag_z0_oce=1
+
+          # Rapport entre les Z0 latent et sensible
+f_z0qh_oce=1.55
+
+          # Activation des rafales : Oui 1 ou non 0
+iflag_gusts=2
+
+          # facteur pour les rafales des thermiques (bounary layer)
+f_gust_bl=0.845
+
+          # facteur pour les poches (wake)
+f_gust_wk=0.2
+
+          # facteur sur qsat pour tenir compte de la salinite
+f_qsat_oce=0.98
+
+          #cdmmax : valeur max de Cd moment. Sur ocean seulement
+cdmmax=0.2
+
+          #cdhmax : valeur max de Cd evap/sensible. Sur ocean seulement
+cdhmax=0.2
+
+####################################################################
+# Couche limite turbulente
+####################################################################
+
+          # Nouvelle version de Mellor et Yamada
+new_yamada4=y
+
+          # Choix du schema numerique pour new_yamada4=y
+          #  1 schema de MAR. Bien pour CL stables mais detruit les stratocu
+          #  5 schema de MAR modifie. Precaunise.
+yamada4_num=5
+
+          # Flag de controle de la couche limite stable
+iflag_corr_sta=4
+
+          # min sur les fonction de stabilite a la surface
+f_ri_cd_min=0.01
+
+          # max du Ric pour Kz. Decouplage plus grand pour Ric plus grand.
+yamada4_ric=0.18
+
+          # Longueur de melange minimum pour Kz
+lmixmin=0
+
+          #shema de la couche de surface (D:1, 1:LMD, 8:Mellor-Yamada) 
+iflag_pbl=12
+
+          # Seuils pour la diffusion turbulente
+ksta_ter=1e-07
+ksta=1e-10
+
+          #ok_kzmin : calcul Kzmin dans la CL de surface (D: y)
+ok_kzmin=n
+
+          # Creation de TKE par orographie sous-maille
+addtkeoro=2
+alphatkeoro=1
+smallscales_tkeoro=y
+
+
+####################################################################
+# Ondes de gravite / Orographie sous maille
+####################################################################
+
+          #  Orodr  ou  non   pour l orographie
+ok_orodr=y
+
+          #  Orolf  ou  non   pour l orographie              
+ok_orolf=y
+
+          #Rugoro : inclusion de l orographie sous maille dans le Cd de surface
+          # Obsolete avec l activation des ondes de gravite
+f_rugoro=0
+
+          # Parametres controlant l effet de l orographie sous maille
+sso_gfrcri=0.7
+sso_gkdrag=0.6
+sso_gkwake=0.4
+sso_gklift=0.1
+
+          # Random gravity waves
+          #Activitate the stochastic parameterization of convective GWs
+          # (should be equal to ok_strato)
+ok_gwd_rando=y
+
+          # Scale the momentum fluxes due to convective GWs
+gwd_rando_ruwmax=0.5
+
+          #Scale the saturated momentum flux of  convective GWs 
+gwd_rando_sat=0.6
+
+          # Important pour controler la periode de la QBO
+gwd_front_ruwmax=3
+
+
+###############################################################
+# Rayonnement
+###############################################################
+          # activation du nouveau code de rayonnement RRTM
+          # 0 : Ancien code et 1 : RRTM (D=0)
+iflag_rrtm=1
+
+          # Nombre de bandes pour le SW. Mettre 2 si iflag_rrtm=0
+NSW=6
+
+    # Albedo et inertie des calottes
+alb_vis_sno_lic=0.96
+alb_nir_sno_lic=0.68
+    # Controle de l'inertie des glaciers et banquises
+    # inertie_sno : pour la neige (y compris sur les points "ter"
+    #      quand orchidee n'est pas actif utilisé)
+    # inertie_lic/sic : pour les "land ice" et "sea ice"
+inertie_sno=350
+    # iflag_sic=1 pour forcer à garder l'inertie des "sea ice"
+    # a inertie_sic meme si la surface est couverte de neige
+iflag_sic=1
+inertie_lic=2000
+inertie_sic=2000
+
+
+          # ???
+iflag_albedo=1
+
+          # Frequence appel rayonnement. Nombre appels par jour
+nbapp_cv=48
+
+          # Pour pouvoir revenir a un bug purement informatique de duplication
+          # des constantes thermodynamiques entre LMDZ et RRTM
+          # n : FORTEMENT CONSEILLE
+ok_bad_ecmwf_thermo=n
+
+###############################################################
+# Parametres nuages
+###############################################################
+
+          #seuils de la precipitation des nuages strateformes (D: 2.6e-4 2.6e-4)
+cld_lc_lsc=0.000678900670664023
+cld_lc_con=0.000678900670664023
+
+          #constante de temps pour eleminer eau lsc et convective
+          # (D: 3600. 3600.)
+cld_tau_lsc=900
+cld_tau_con=900
+
+          #facteurs correctifs sur la vitesse de chute des cristaux de glace (D: 1 1)
+ffallv_lsc=1.57692483628955
+ffallv_con=1.57692483628955
+
+          # coefficient sur la reevaporation de la pluie (D: 2.e-5 n)
+          # regle a 3.e-5 sur des cas de cumulus en 1D
+coef_eva=0.0001
+
+          # flag pour la reevaporation de la pluie
+          # 0: rien
+          # 1: a l ancienne
+          # 2: prend en compte la surface nuageuse max au dessus pour calculer
+          #    le max de reevaporation, comme ecart a la saturation. CONSEILLE
+iflag_evap_prec=2
+
+          # Modification de la plage de temperature pour la phase mixte
+          # liquide/glace des nuages
+          # Controle par les t_glace_min/max, exposant_glace,
+          # iflag_t_glace (D=0)
+t_glace_min=243.15
+t_glace_max=273.15
+exposant_glace=0.5
+iflag_t_glace=3
+
+          # Activation de la thermodynamique de la glace
+iflag_ice_thermo=1
+
+          # normalement elle ne sert plus a rien dans fisrtilp
+          # sinon elle est un peu toxique:
+          # IF (zt(i) .LT. t_coup.and.reevap_ice) zrfln(i)=0. (Jean-Baptiste)
+reevap_ice=n
+
+          #Bergeron
+iflag_bergeron=2
+
+          # temperature dependency of qsat for iterative procedure
+          # temporary flag to switch between the old (CMIP5, D=0)
+          # and new versions (=1) versions 
+iflag_fisrtilp_qsat=4
+
+          #calcul des proprietes des nuages convectifs (D:1 0.375 1.e-4) 
+iflag_cldcon=6
+fact_cldcon=1.2750060916059
+
+          # ?????
+facttemps=0
+
+          #calcul eau condensee et fraction nuageuse a partir des PDF
+          # (D:0, 0:version avec ratqs sinon nouvelles PDFs)  
+iflag_pdf=1
+
+          #calcul epaisseur optique et emmissivite des nuages (D: y 1 0.01 0.3)
+ok_newmicro=y
+
+          # Controle des ratqs grande echelle
+iflag_ratqs=4
+ratqsp0=32739.2977787255
+ratqsdp=12228.1360455112
+ratqsbas=0.002
+ratqshaut=0.495840653828554
+
+          #rayon effectif pour les nuages de glace (D:35)
+rad_froid=35
+
+          # Rayons effectif des gouttes nuageuses
+          # ACTIF SI ok_cdnc=0 dans config.def. (D~9 a 12 microns)
+rad_chau1=12
+rad_chau2=11
+
+	  # Rayon effectif des gouttes si ok_cdnc=0
+          # Parameters in CDNC-maer link (Boucher&Lohmann 1995)
+bl95_b0=1.21705684711552
+bl95_b1=0.2
+
+          #  Choix ou non  de  New oliq               
+new_oliq=y
+
+          # Seuils oliqmax, oicemax (en g/kg).
+          # Au dela on precipite directement au sol
+oliqmax=0.0015
+oicemax=0.0015
+
+          #Rayons min et max effectifs des particules des nuages
+rei_min=15.9379
+rei_max=61.0521
+
+          # Distribution vetricale sous maille pour le schema de de nuages.
+          # 0: rien
+          # 1: Premiere version A. Jam,
+          # 2 : J. Jouhaud, parametre cloudth_vert_alpha D=0.5
+          # 3 : J. Jouhaud, parametre cloudth_vert_alpha D=0.5/C= 1.32
+          #                           cloudth_vert_alpha_th C=2:91
+iflag_cloudth_vert=3
+cloudth_vert_alpha=0.5
+cloudth_vert_alpha_th=0.5
+
+
+######################################################################
+# Convection 
+######################################################################
+
+          #Convection scheme switch
+          # (D:2, 1:LMD, 2:Tiedtke, 3:KE New Physics, 30:KE AR4)
+iflag_con=3
+
+          #output level of energy conservation diagnostics
+if_ebil=0
+
+          #maximum efficiency of cld water->precipitation conversion (D: 0.993)
+epmax=0.996024
+
+          #dry convective adjustment at beginning of Emanuel convective scheme (D: n 0)
+ok_adj_ema=n
+iflag_clw=0
+
+          #Convective closure (D:1, 0:AR4, 2:ALE and ALP)
+iflag_clos=2
+
+          #Convective entrainment mixing law (D:1, 0:AR4=flat PDF, 1=PDF)
+iflag_mix=1
+
+          #weights of the bell shaped and flat PDF (used only if iflag_mix=1) (D: 1 0)
+qqa1=1
+qqa2=0
+
+          #Parameters of the bell shaped PDF; Fmax=center (D= 0.65), Gammas=width (D=0.05)
+cvl_corr=1
+
+          #Multiplicative factor of Emanuel convective scheme precipitation (D: 1.)
+Fmax=0.65
+
+          #altitude, in hPa, above LCL at which buoybase is computed,
+          # def = original: -40
+dpbase=-40
+
+          #reference fractional area of precipitating downdraughts,
+          # def = original: 0.01
+sigdz=0.0184390595109981
+
+          #unsaturated fraction of precipitating downdraughts, def = original: 0.15
+spfac=0.15
+
+          #relaxation time of cloud base mass flux, def = original: 8000
+tau=8000
+
+          #flag for wb (= vert velocity at LFC);
+          # 0->wb=wbmax=3.03416525524042
+          # Si iflag_wb=88.6915
+          # wbmax=3.03416525524042
+flag_wb=88.6915
+wbmax=3.03416525524042
+
+          # Divers tests
+ok_convstop=n
+tau_stop=15000
+ok_intermittent=n
+
+          # nouvel epluchage de C.Rio
+          #shedding coefficient (used when iflag_mix_adiab=1)
+iflag_mix_adiab=0
+coef_peel=0.25
+
+          #Conversion cld water->precip: Ep=f(pressure) if 0; Ep=f(temperature)
+          #if 1, def=1
+flag_epKEorig=1
+
+          # Case : flag_epKEorig=1
+          # elcrit=0.000103621318662918
+          # tlcrit=-53.2653786737205
+          # original: 0.0011, used only if flag_epKEorig=1
+elcrit=0.000103621318662918
+tlcrit=-53.2653786737205
+
+          # Case : flag_epKEorig=0
+          # pbcrit : pressure (hPa), above LCL below which Ep=0, D=150 (original)
+          # ptcrit : pressure (hPa), above LCL above which Ep=Epmax, D=500 (original)
+pbcrit=150
+ptcrit=500
+
+          # Prevent some crashes
+          # Filter out bad wakes
+flag_wk_check_trgl=n
+iflag_wk_check_trgl=2
+iflag_alp_wk_cond=1
+
+
+          # Check whether parcel level temperature and specific humidity
+          # are reasonable and demand that LCL be high enough
+cv_flag_feed=2
+
+          # save 20% CPU 
+ok_optim_yield=y
+
+          # Convective clouds
+iflag_cld_cv=0
+
+          # To get back to bug where convective output variables
+          # were set to 0 at the start of the physics
+ok_bug_cv_trac=n
+
+##########################################################
+# Fermeture convective et couplages
+##########################################################
+
+          # Appel separe des thermiques 
+iflag_pbl_split=10
+
+          #rendement sur la puissance fournie par les thermiques a la convection
+alp_bl_k=0.591759723111345
+
+          #Constant value to be added to Alp (D: 0.)
+alp_offset=0
+
+          #Convection must reach a level at which T<t_top_max to be active
+t_top_max=1000
+
+          ### nrlmd le 10/04/2012: Declenchement ###
+          #Declenchement par couche-limite (0: deterministe, 1: stochastique)
+iflag_trig_bl=1
+
+          #Surface critique au LCL
+s_trig=12000000
+
+          #Temps de decorrelation entre scenes de cumulus
+tau_trig_shallow=1200
+
+          #Temps de decorrelation entre scenes de cumulonimbus
+tau_trig_deep=1200
+
+          # Pour la stabilisation
+random_notrig_max=0.99
+
+          # Temperature a la quelle on fond les descentes glacees
+tmax_fonte_cv=278.15
+
+          #Fermeture par couche-limite (Nicolas Rochetin)
+          #(0: deterministe, 1: statistique, 2: statistique+convergence
+          # grande echelle)
+iflag_clos_bl=1
+
+          #coefficient in Wape->C_star formula: C_star=stark*sqrt(2*Wape),
+          # def: 0.33
+stark=0.33
+
+          #lifting efficiency of wakes; Alp=Alpk*Fip, Fip=power provided
+          # by wakes, def: 0.25
+alpk=0.4247368370795
+
+#
+##########################################################
+# Couche limite convective / modele du thermique
+##########################################################
+
+          # Convection seche (D:0, 0:ajustement sec,=>1:modele du thermique) 
+iflag_thermals=18
+
+          # pas de temps du spliting pour les thermiques
+          # TOURNE MAIS POSE PLUS DE PROBLEME QU ELLE N EN RESOUD
+nsplit_thermals=1
+
+          # tau_thermals pour avoir une constante de temps sur les thermiques.
+          # Non valide
+tau_thermals=0
+
+          # Flag controlant le detrainement et l entrainement
+iflag_thermals_ed=8
+
+          # On va chercher l air a z * ( 1+fact_thermals_ed_dz=0.102873956132005
+          # le detrainement (A. Jam)
+fact_thermals_ed_dz=0.102873956132005
+
+          # Une option de plus sur les thermiques.
+iflag_thermals_optflux=0
+
+          #couplage ou non avec la convection
+iflag_coupl=5
+
+          # Seuil pour desactiver les thermiques en cas de forte inversion
+          # en sommet de couche limite. Actif si iflag_thermals impair.
+seuil_inversion=-0.08
+
+          # Reactivation du calcul d un zmax continu pour les thermiques
+          # reactivation d une fermeture humide des thermiques
+          # iflag_thermals_closure=2 (D=1)
+iflag_thermals_closure=2
+
+
+##########################################################
+# Flags wakes
+##########################################################
+
+          #Wake scheme switch (D:0, 0:AR4, 1:New Physics)
+iflag_wake=1
+
+          #multiplicative factor of the damping by gravity waves, def: 4.
+coefgw=4
+
+          #wake density = number of wake centers per m2, def: 8.E-12
+          #wdens_ref=8.E-12
+wdens_ref_o=1.62188237000386e-10
+wdens_ref_l=8e-12
+
+          # Ajustement convectif prealable au calcul des poches
+ok_adjwk=y
+
+
+####################################################################
+#  Conservation 
+####################################################################
+
+          # The source terms of the TKE prognostic equation are diagnosed
+          # from tendencies (du, dv, dT) 
+          # associated with subrgrid scaleamotions and treated as an 
+          # additional heat source.
+          # Controled by a key, iflag_ener_conserv (D=-1):
+          # 0 : no conservation, -1 : old adhoc correction for kinetic E only
+          # (used for CMIP5) 
+          # 1 : conservation, 101 : conversion from kinetic to heat only,
+          # 110 conversion from potential to heat only
+iflag_ener_conserv=10
+
+          #Activation of corrections for water conservation (D: n). 
+          ##The default is n for compatibility with earlier versions.
+          ##generally it should be y.
+ok_conserv_q=y
+
+fl_cor_ebil=1
+
+####################################################################
+# Ozone
+####################################################################
+          # new treatment for ozone into the tropopause
+adjust_tropopause=y
+
+####################################################################
+#  Conservation de l'eau
+#####################################################################
+          # conservation de l eau sur les calottes
+ok_lic_cond=y
+
+cdnc_min=10.
+
+
Index: /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_ECSexp4
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_ECSexp4	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_ECSexp4	(revision 4727)
@@ -0,0 +1,538 @@
+#
+# $Id: physiq.def_NPv6.0.15_S 3593 2018-02-20 10:07:02Z jgipsl $
+#
+
+##############################################################
+# PARAMETRES ET CLES DE LA PHYSIQUE LMDZ
+# Cette version correspond à l'expérience Exp4 de l'article
+# sur l'exploration paramétrique de l'ECS :
+# Hourdin, F , et al., Science Advances, 2023, DOI: 10.1126/sciadv.adf2758
+##############################################################
+
+##############################################################
+# D: Valeur par default
+#
+
+###########################################################
+# divers. Devrait aller dans config.def ?
+###########################################################
+##   Si=.T. ,  lecture du fichier limit avec la bonne annee 
+ok_limitvrai=n
+
+###########################################################
+# Parametres couche limite de surface
+###########################################################
+
+          #  ...
+f_cdrag_stable=1
+
+          # Facteur sur les coefficients de trainee terrestres
+f_cdrag_ter=1
+
+          # Vitesse minimum dans les calculs de trainee Cd ( || V || + Vmin )
+min_wind_speed=0.1
+
+          #  Modelisation des bosquets
+ifl_pbltree=1
+Cd_frein=0.016
+
+###########################################################
+# parameter des flux air-mer
+###########################################################
+
+          # Facteur sur les flux sensibles et latent
+          # Introduit pour reduire l evaporation quand on avait z0h=z0m
+          # CONSEILLE : 1
+f_cdrag_oce=1
+
+          # Flag controlant le calcul des z0
+iflag_z0_oce=1
+
+          # Rapport entre les Z0 latent et sensible
+f_z0qh_oce=1.55
+
+          # Activation des rafales : Oui 1 ou non 0
+iflag_gusts=2
+
+          # facteur pour les rafales des thermiques (bounary layer)
+f_gust_bl=0.845
+
+          # facteur pour les poches (wake)
+f_gust_wk=0.2
+
+          # facteur sur qsat pour tenir compte de la salinite
+f_qsat_oce=0.98
+
+          #cdmmax : valeur max de Cd moment. Sur ocean seulement
+cdmmax=0.2
+
+          #cdhmax : valeur max de Cd evap/sensible. Sur ocean seulement
+cdhmax=0.2
+
+####################################################################
+# Couche limite turbulente
+####################################################################
+
+          # Nouvelle version de Mellor et Yamada
+new_yamada4=y
+
+          # Choix du schema numerique pour new_yamada4=y
+          #  1 schema de MAR. Bien pour CL stables mais detruit les stratocu
+          #  5 schema de MAR modifie. Precaunise.
+yamada4_num=5
+
+          # Flag de controle de la couche limite stable
+iflag_corr_sta=4
+
+          # min sur les fonction de stabilite a la surface
+f_ri_cd_min=0.01
+
+          # max du Ric pour Kz. Decouplage plus grand pour Ric plus grand.
+yamada4_ric=0.18
+
+          # Longueur de melange minimum pour Kz
+lmixmin=0
+
+          #shema de la couche de surface (D:1, 1:LMD, 8:Mellor-Yamada) 
+iflag_pbl=12
+
+          # Seuils pour la diffusion turbulente
+ksta_ter=1e-07
+ksta=1e-10
+
+          #ok_kzmin : calcul Kzmin dans la CL de surface (D: y)
+ok_kzmin=n
+
+          # Creation de TKE par orographie sous-maille
+addtkeoro=2
+alphatkeoro=1
+smallscales_tkeoro=y
+
+
+####################################################################
+# Ondes de gravite / Orographie sous maille
+####################################################################
+
+          #  Orodr  ou  non   pour l orographie
+ok_orodr=y
+
+          #  Orolf  ou  non   pour l orographie              
+ok_orolf=y
+
+          #Rugoro : inclusion de l orographie sous maille dans le Cd de surface
+          # Obsolete avec l activation des ondes de gravite
+f_rugoro=0
+
+          # Parametres controlant l effet de l orographie sous maille
+sso_gfrcri=0.7
+sso_gkdrag=0.6
+sso_gkwake=0.4
+sso_gklift=0.1
+
+          # Random gravity waves
+          #Activitate the stochastic parameterization of convective GWs
+          # (should be equal to ok_strato)
+ok_gwd_rando=y
+
+          # Scale the momentum fluxes due to convective GWs
+gwd_rando_ruwmax=0.5
+
+          #Scale the saturated momentum flux of  convective GWs 
+gwd_rando_sat=0.6
+
+          # Important pour controler la periode de la QBO
+gwd_front_ruwmax=3
+
+
+###############################################################
+# Rayonnement
+###############################################################
+          # activation du nouveau code de rayonnement RRTM
+          # 0 : Ancien code et 1 : RRTM (D=0)
+iflag_rrtm=1
+
+          # Nombre de bandes pour le SW. Mettre 2 si iflag_rrtm=0
+NSW=6
+
+    # Albedo et inertie des calottes
+alb_vis_sno_lic=0.96
+alb_nir_sno_lic=0.68
+    # Controle de l'inertie des glaciers et banquises
+    # inertie_sno : pour la neige (y compris sur les points "ter"
+    #      quand orchidee n'est pas actif utilisé)
+    # inertie_lic/sic : pour les "land ice" et "sea ice"
+inertie_sno=350
+    # iflag_sic=1 pour forcer à garder l'inertie des "sea ice"
+    # a inertie_sic meme si la surface est couverte de neige
+iflag_sic=1
+inertie_lic=2000
+inertie_sic=2000
+
+
+          # ???
+iflag_albedo=1
+
+          # Frequence appel rayonnement. Nombre appels par jour
+nbapp_cv=48
+
+          # Pour pouvoir revenir a un bug purement informatique de duplication
+          # des constantes thermodynamiques entre LMDZ et RRTM
+          # n : FORTEMENT CONSEILLE
+ok_bad_ecmwf_thermo=n
+
+###############################################################
+# Parametres nuages
+###############################################################
+
+          #seuils de la precipitation des nuages strateformes (D: 2.6e-4 2.6e-4)
+cld_lc_lsc=0.000213588421214307
+cld_lc_con=0.000213588421214307
+
+          #constante de temps pour eleminer eau lsc et convective
+          # (D: 3600. 3600.)
+cld_tau_lsc=900
+cld_tau_con=900
+
+          #facteurs correctifs sur la vitesse de chute des cristaux de glace (D: 1 1)
+ffallv_lsc=1.50255471138715
+ffallv_con=1.50255471138715
+
+          # coefficient sur la reevaporation de la pluie (D: 2.e-5 n)
+          # regle a 3.e-5 sur des cas de cumulus en 1D
+coef_eva=0.0001
+
+          # flag pour la reevaporation de la pluie
+          # 0: rien
+          # 1: a l ancienne
+          # 2: prend en compte la surface nuageuse max au dessus pour calculer
+          #    le max de reevaporation, comme ecart a la saturation. CONSEILLE
+iflag_evap_prec=2
+
+          # Modification de la plage de temperature pour la phase mixte
+          # liquide/glace des nuages
+          # Controle par les t_glace_min/max, exposant_glace,
+          # iflag_t_glace (D=0)
+t_glace_min=243.15
+t_glace_max=273.15
+exposant_glace=0.5
+iflag_t_glace=3
+
+          # Activation de la thermodynamique de la glace
+iflag_ice_thermo=1
+
+          # normalement elle ne sert plus a rien dans fisrtilp
+          # sinon elle est un peu toxique:
+          # IF (zt(i) .LT. t_coup.and.reevap_ice) zrfln(i)=0. (Jean-Baptiste)
+reevap_ice=n
+
+          #Bergeron
+iflag_bergeron=2
+
+          # temperature dependency of qsat for iterative procedure
+          # temporary flag to switch between the old (CMIP5, D=0)
+          # and new versions (=1) versions 
+iflag_fisrtilp_qsat=4
+
+          #calcul des proprietes des nuages convectifs (D:1 0.375 1.e-4) 
+iflag_cldcon=6
+fact_cldcon=1.48955385469797
+
+          # ?????
+facttemps=0
+
+          #calcul eau condensee et fraction nuageuse a partir des PDF
+          # (D:0, 0:version avec ratqs sinon nouvelles PDFs)  
+iflag_pdf=1
+
+          #calcul epaisseur optique et emmissivite des nuages (D: y 1 0.01 0.3)
+ok_newmicro=y
+
+          # Controle des ratqs grande echelle
+iflag_ratqs=4
+ratqsp0=39530.6889612427
+ratqsdp=8733.72841485625
+ratqsbas=0.002
+ratqshaut=0.552985007363904
+
+          #rayon effectif pour les nuages de glace (D:35)
+rad_froid=35
+
+          # Rayons effectif des gouttes nuageuses
+          # ACTIF SI ok_cdnc=0 dans config.def. (D~9 a 12 microns)
+rad_chau1=12
+rad_chau2=11
+
+	  # Rayon effectif des gouttes si ok_cdnc=0
+          # Parameters in CDNC-maer link (Boucher&Lohmann 1995)
+bl95_b0=1.38618158776815
+bl95_b1=0.2
+
+          #  Choix ou non  de  New oliq               
+new_oliq=y
+
+          # Seuils oliqmax, oicemax (en g/kg).
+          # Au dela on precipite directement au sol
+oliqmax=0.0015
+oicemax=0.0015
+
+          #Rayons min et max effectifs des particules des nuages
+rei_min=13.8965
+rei_max=53.2323
+
+          # Distribution vetricale sous maille pour le schema de de nuages.
+          # 0: rien
+          # 1: Premiere version A. Jam,
+          # 2 : J. Jouhaud, parametre cloudth_vert_alpha D=0.5
+          # 3 : J. Jouhaud, parametre cloudth_vert_alpha D=0.5/C= 1.32
+          #                           cloudth_vert_alpha_th C=2:91
+iflag_cloudth_vert=3
+cloudth_vert_alpha=0.5
+cloudth_vert_alpha_th=0.5
+
+
+######################################################################
+# Convection 
+######################################################################
+
+          #Convection scheme switch
+          # (D:2, 1:LMD, 2:Tiedtke, 3:KE New Physics, 30:KE AR4)
+iflag_con=3
+
+          #output level of energy conservation diagnostics
+if_ebil=0
+
+          #maximum efficiency of cld water->precipitation conversion (D: 0.993)
+epmax=0.997521
+
+          #dry convective adjustment at beginning of Emanuel convective scheme (D: n 0)
+ok_adj_ema=n
+iflag_clw=0
+
+          #Convective closure (D:1, 0:AR4, 2:ALE and ALP)
+iflag_clos=2
+
+          #Convective entrainment mixing law (D:1, 0:AR4=flat PDF, 1=PDF)
+iflag_mix=1
+
+          #weights of the bell shaped and flat PDF (used only if iflag_mix=1) (D: 1 0)
+qqa1=1
+qqa2=0
+
+          #Parameters of the bell shaped PDF; Fmax=center (D= 0.65), Gammas=width (D=0.05)
+cvl_corr=1
+
+          #Multiplicative factor of Emanuel convective scheme precipitation (D: 1.)
+Fmax=0.65
+
+          #altitude, in hPa, above LCL at which buoybase is computed,
+          # def = original: -40
+dpbase=-40
+
+          #reference fractional area of precipitating downdraughts,
+          # def = original: 0.01
+sigdz=0.00196436925136631
+
+          #unsaturated fraction of precipitating downdraughts, def = original: 0.15
+spfac=0.15
+
+          #relaxation time of cloud base mass flux, def = original: 8000
+tau=8000
+
+          #flag for wb (= vert velocity at LFC);
+          # 0->wb=wbmax=3.17037663543109
+          # Si iflag_wb=43.0746
+          # wbmax=3.17037663543109
+flag_wb=43.0746
+wbmax=3.17037663543109
+
+          # Divers tests
+ok_convstop=n
+tau_stop=15000
+ok_intermittent=n
+
+          # nouvel epluchage de C.Rio
+          #shedding coefficient (used when iflag_mix_adiab=1)
+iflag_mix_adiab=0
+coef_peel=0.25
+
+          #Conversion cld water->precip: Ep=f(pressure) if 0; Ep=f(temperature)
+          #if 1, def=1
+flag_epKEorig=1
+
+          # Case : flag_epKEorig=1
+          # elcrit=0.000374048865678933
+          # tlcrit=-49.1734913393274
+          # original: 0.0011, used only if flag_epKEorig=1
+elcrit=0.000374048865678933
+tlcrit=-49.1734913393274
+
+          # Case : flag_epKEorig=0
+          # pbcrit : pressure (hPa), above LCL below which Ep=0, D=150 (original)
+          # ptcrit : pressure (hPa), above LCL above which Ep=Epmax, D=500 (original)
+pbcrit=150
+ptcrit=500
+
+          # Prevent some crashes
+          # Filter out bad wakes
+flag_wk_check_trgl=n
+iflag_wk_check_trgl=2
+iflag_alp_wk_cond=1
+
+
+          # Check whether parcel level temperature and specific humidity
+          # are reasonable and demand that LCL be high enough
+cv_flag_feed=2
+
+          # save 20% CPU 
+ok_optim_yield=y
+
+          # Convective clouds
+iflag_cld_cv=0
+
+          # To get back to bug where convective output variables
+          # were set to 0 at the start of the physics
+ok_bug_cv_trac=n
+
+##########################################################
+# Fermeture convective et couplages
+##########################################################
+
+          # Appel separe des thermiques 
+iflag_pbl_split=10
+
+          #rendement sur la puissance fournie par les thermiques a la convection
+alp_bl_k=0.351393119821448
+
+          #Constant value to be added to Alp (D: 0.)
+alp_offset=0
+
+          #Convection must reach a level at which T<t_top_max to be active
+t_top_max=1000
+
+          ### nrlmd le 10/04/2012: Declenchement ###
+          #Declenchement par couche-limite (0: deterministe, 1: stochastique)
+iflag_trig_bl=1
+
+          #Surface critique au LCL
+s_trig=12000000
+
+          #Temps de decorrelation entre scenes de cumulus
+tau_trig_shallow=1200
+
+          #Temps de decorrelation entre scenes de cumulonimbus
+tau_trig_deep=1200
+
+          # Pour la stabilisation
+random_notrig_max=0.99
+
+          # Temperature a la quelle on fond les descentes glacees
+tmax_fonte_cv=278.15
+
+          #Fermeture par couche-limite (Nicolas Rochetin)
+          #(0: deterministe, 1: statistique, 2: statistique+convergence
+          # grande echelle)
+iflag_clos_bl=1
+
+          #coefficient in Wape->C_star formula: C_star=stark*sqrt(2*Wape),
+          # def: 0.33
+stark=0.33
+
+          #lifting efficiency of wakes; Alp=Alpk*Fip, Fip=power provided
+          # by wakes, def: 0.25
+alpk=0.114697210513523
+
+#
+##########################################################
+# Couche limite convective / modele du thermique
+##########################################################
+
+          # Convection seche (D:0, 0:ajustement sec,=>1:modele du thermique) 
+iflag_thermals=18
+
+          # pas de temps du spliting pour les thermiques
+          # TOURNE MAIS POSE PLUS DE PROBLEME QU ELLE N EN RESOUD
+nsplit_thermals=1
+
+          # tau_thermals pour avoir une constante de temps sur les thermiques.
+          # Non valide
+tau_thermals=0
+
+          # Flag controlant le detrainement et l entrainement
+iflag_thermals_ed=8
+
+          # On va chercher l air a z * ( 1+fact_thermals_ed_dz=0.0995450338618185
+          # le detrainement (A. Jam)
+fact_thermals_ed_dz=0.0995450338618185
+
+          # Une option de plus sur les thermiques.
+iflag_thermals_optflux=0
+
+          #couplage ou non avec la convection
+iflag_coupl=5
+
+          # Seuil pour desactiver les thermiques en cas de forte inversion
+          # en sommet de couche limite. Actif si iflag_thermals impair.
+seuil_inversion=-0.08
+
+          # Reactivation du calcul d un zmax continu pour les thermiques
+          # reactivation d une fermeture humide des thermiques
+          # iflag_thermals_closure=2 (D=1)
+iflag_thermals_closure=2
+
+
+##########################################################
+# Flags wakes
+##########################################################
+
+          #Wake scheme switch (D:0, 0:AR4, 1:New Physics)
+iflag_wake=1
+
+          #multiplicative factor of the damping by gravity waves, def: 4.
+coefgw=4
+
+          #wake density = number of wake centers per m2, def: 8.E-12
+          #wdens_ref=8.E-12
+wdens_ref_o=6.25455839877873e-11
+wdens_ref_l=8e-12
+
+          # Ajustement convectif prealable au calcul des poches
+ok_adjwk=y
+
+
+####################################################################
+#  Conservation 
+####################################################################
+
+          # The source terms of the TKE prognostic equation are diagnosed
+          # from tendencies (du, dv, dT) 
+          # associated with subrgrid scaleamotions and treated as an 
+          # additional heat source.
+          # Controled by a key, iflag_ener_conserv (D=-1):
+          # 0 : no conservation, -1 : old adhoc correction for kinetic E only
+          # (used for CMIP5) 
+          # 1 : conservation, 101 : conversion from kinetic to heat only,
+          # 110 conversion from potential to heat only
+iflag_ener_conserv=10
+
+          #Activation of corrections for water conservation (D: n). 
+          ##The default is n for compatibility with earlier versions.
+          ##generally it should be y.
+ok_conserv_q=y
+
+fl_cor_ebil=1
+
+####################################################################
+# Ozone
+####################################################################
+          # new treatment for ozone into the tropopause
+adjust_tropopause=y
+
+####################################################################
+#  Conservation de l'eau
+#####################################################################
+          # conservation de l eau sur les calottes
+ok_lic_cond=y
+
+cdnc_min=10.
+
+
Index: /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_L95PartIIBest1
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_L95PartIIBest1	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_L95PartIIBest1	(revision 4727)
@@ -0,0 +1,539 @@
+#
+# $Id: physiq.def_NPv6.0.15_S 3593 2018-02-20 10:07:02Z jgipsl $
+#
+
+##############################################################
+# PARAMETRES ET CLES DE LA PHYSIQUE LMDZ
+##############################################################
+# D: Valeur par default
+#
+
+###########################################################
+# divers. Devrait aller dans config.def ?
+###########################################################
+##   Si=.T. ,  lecture du fichier limit avec la bonne annee 
+ok_limitvrai=n
+
+###########################################################
+# Parametres couche limite de surface
+###########################################################
+
+          #  ...
+f_cdrag_stable=1
+
+          # Facteur sur les coefficients de trainee terrestres
+f_cdrag_ter=1
+
+          # Vitesse minimum dans les calculs de trainee Cd ( || V || + Vmin )
+min_wind_speed=0.1
+
+          #  Modelisation des bosquets
+ifl_pbltree=0
+Cd_frein=0.016
+
+###########################################################
+# parameter des flux air-mer
+###########################################################
+
+          # Facteur sur les flux sensibles et latent
+          # Introduit pour reduire l evaporation quand on avait z0h=z0m
+          # CONSEILLE : 1
+f_cdrag_oce=1
+
+          # Flag controlant le calcul des z0
+iflag_z0_oce=1
+
+          # Rapport entre les Z0 latent et sensible
+f_z0qh_oce=1.55
+
+          # Activation des rafales : Oui 1 ou non 0
+iflag_gusts=2
+
+          # facteur pour les rafales des thermiques (bounary layer)
+f_gust_bl=0.845
+
+          # facteur pour les poches (wake)
+f_gust_wk=0.2
+
+          # facteur sur qsat pour tenir compte de la salinite
+f_qsat_oce=0.98
+
+          #cdmmax : valeur max de Cd moment. Sur ocean seulement
+cdmmax=0.2
+
+          #cdhmax : valeur max de Cd evap/sensible. Sur ocean seulement
+cdhmax=0.2
+
+####################################################################
+# Couche limite turbulente
+####################################################################
+
+          # Nouvelle version de Mellor et Yamada
+new_yamada4=y
+
+          # Choix du schema numerique pour new_yamada4=y
+          #  1 schema de MAR. Bien pour CL stables mais detruit les stratocu
+          #  5 schema de MAR modifie. Precaunise.
+yamada4_num=5
+
+          # Flag de controle de la couche limite stable
+iflag_corr_sta=4
+
+          # min sur les fonction de stabilite a la surface
+f_ri_cd_min=0.01
+
+          # max du Ric pour Kz. Decouplage plus grand pour Ric plus grand.
+yamada4_ric=0.18
+
+          # Longueur de melange minimum pour Kz
+lmixmin=0
+
+          #shema de la couche de surface (D:1, 1:LMD, 8:Mellor-Yamada) 
+iflag_pbl=12
+
+          # Seuils pour la diffusion turbulente
+ksta_ter=1e-07
+ksta=1e-10
+
+          #ok_kzmin : calcul Kzmin dans la CL de surface (D: y)
+ok_kzmin=n
+
+          # Creation de TKE par orographie sous-maille
+addtkeoro=2
+alphatkeoro=1
+smallscales_tkeoro=y
+
+
+####################################################################
+# Ondes de gravite / Orographie sous maille
+####################################################################
+
+          #  Orodr  ou  non   pour l orographie
+ok_orodr=y
+
+          #  Orolf  ou  non   pour l orographie              
+ok_orolf=y
+
+          #Rugoro : inclusion de l orographie sous maille dans le Cd de surface
+          # Obsolete avec l activation des ondes de gravite
+f_rugoro=0
+
+          # Parametres controlant l effet de l orographie sous maille
+sso_gfrcri=0.7
+sso_gkdrag=0.6
+sso_gkwake=0.4
+sso_gklift=0.1
+
+          # Random gravity waves
+          #Activitate the stochastic parameterization of convective GWs
+          # (should be equal to ok_strato)
+ok_gwd_rando=y
+
+          # Scale the momentum fluxes due to convective GWs
+gwd_rando_ruwmax=0.5
+
+          #Scale the saturated momentum flux of  convective GWs 
+gwd_rando_sat=0.6
+
+          # Important pour controler la periode de la QBO
+gwd_front_ruwmax=3
+
+
+###############################################################
+# Rayonnement
+###############################################################
+          # activation du nouveau code de rayonnement RRTM
+          # 0 : Ancien code et 1 : RRTM (D=0)
+iflag_rrtm=1
+
+          # Nombre de bandes pour le SW. Mettre 2 si iflag_rrtm=0
+NSW=6
+
+    # Albedo et inertie des calottes
+alb_vis_sno_lic=0.96
+alb_nir_sno_lic=0.68
+    # Controle de l'inertie des glaciers et banquises
+    # inertie_sno : pour la neige (y compris sur les points "ter"
+    #      quand orchidee n'est pas actif utilisé)
+    # inertie_lic/sic : pour les "land ice" et "sea ice"
+inertie_sno=350
+    # iflag_sic=1 pour forcer à garder l'inertie des "sea ice"
+    # a inertie_sic meme si la surface est couverte de neige
+iflag_sic=1
+inertie_lic=2000
+inertie_sic=2000
+
+
+          # ???
+iflag_albedo=1
+
+          # Frequence appel rayonnement. Nombre appels par jour
+nbapp_cv=48
+
+          # Pour pouvoir revenir a un bug purement informatique de duplication
+          # des constantes thermodynamiques entre LMDZ et RRTM
+          # n : FORTEMENT CONSEILLE
+ok_bad_ecmwf_thermo=n
+
+###############################################################
+# Parametres nuages
+###############################################################
+
+          #seuils de la precipitation des nuages strateformes (D: 2.6e-4 2.6e-4)
+cld_lc_lsc=0.0006
+cld_lc_con=0.0006
+
+          #constante de temps pour eleminer eau lsc et convective
+          # (D: 3600. 3600.)
+cld_tau_lsc=900
+cld_tau_con=900
+
+          #facteurs correctifs sur la vitesse de chute des cristaux de glace (D: 1 1)
+ffallv_lsc=0.8
+ffallv_con=0.8
+
+          # coefficient sur la reevaporation de la pluie (D: 2.e-5 n)
+          # regle a 3.e-5 sur des cas de cumulus en 1D
+coef_eva=0.000271439771914082
+
+          # flag pour la reevaporation de la pluie
+          # 0: rien
+          # 1: a l ancienne
+          # 2: prend en compte la surface nuageuse max au dessus pour calculer
+          #    le max de reevaporation, comme ecart a la saturation. CONSEILLE
+iflag_evap_prec=2
+
+          # Modification de la plage de temperature pour la phase mixte
+          # liquide/glace des nuages
+          # Controle par les t_glace_min/max, exposant_glace,
+          # iflag_t_glace (D=0)
+t_glace_min=243.15
+t_glace_max=273.15
+exposant_glace=0.5
+iflag_t_glace=3
+
+          # Activation de la thermodynamique de la glace
+iflag_ice_thermo=1
+
+          # normalement elle ne sert plus a rien dans fisrtilp
+          # sinon elle est un peu toxique:
+          # IF (zt(i) .LT. t_coup.and.reevap_ice) zrfln(i)=0. (Jean-Baptiste)
+reevap_ice=n
+
+          #Bergeron
+iflag_bergeron=2
+
+          # temperature dependency of qsat for iterative procedure
+          # temporary flag to switch between the old (CMIP5, D=0)
+          # and new versions (=1) versions 
+iflag_fisrtilp_qsat=4
+
+          #calcul des proprietes des nuages convectifs (D:1 0.375 1.e-4) 
+iflag_cldcon=6
+fact_cldcon=1
+
+          # ?????
+facttemps=0
+
+          #calcul eau condensee et fraction nuageuse a partir des PDF
+          # (D:0, 0:version avec ratqs sinon nouvelles PDFs)  
+iflag_pdf=1
+
+          #calcul epaisseur optique et emmissivite des nuages (D: y 1 0.01 0.3)
+ok_newmicro=y
+
+          # Controle des ratqs grande echelle
+iflag_ratqs=4
+ratqsp0=45000
+ratqsdp=10000
+ratqsbas=0.002
+ratqshaut=0.4
+
+          #rayon effectif pour les nuages de glace (D:35)
+rad_froid=35
+
+          # Rayons effectif des gouttes nuageuses
+          # ACTIF SI ok_cdnc=0 dans config.def. (D~9 a 12 microns)
+rad_chau1=12
+rad_chau2=11
+
+	  # Rayon effectif des gouttes si ok_cdnc=0
+          # Parameters in CDNC-maer link (Boucher&Lohmann 1995)
+bl95_b0=1.3
+bl95_b1=0.2
+
+          #  Choix ou non  de  New oliq               
+new_oliq=y
+
+          # Seuils oliqmax, oicemax (en g/kg).
+          # Au dela on precipite directement au sol
+oliqmax=0.0015
+oicemax=0.0015
+
+          #Rayons min et max effectifs des particules des nuages
+rei_min=16
+rei_max=61.29
+
+          # Distribution vetricale sous maille pour le schema de de nuages.
+          # 0: rien
+          # 1: Premiere version A. Jam,
+          # 2 : J. Jouhaud, parametre cloudth_vert_alpha D=0.5
+          # 3 : J. Jouhaud, parametre cloudth_vert_alpha D=0.5/C= 1.32
+          #                           cloudth_vert_alpha_th C=2:91
+iflag_cloudth_vert=3
+cloudth_vert_alpha=0.5
+cloudth_vert_alpha_th=0.5
+
+
+######################################################################
+# Convection 
+######################################################################
+
+          #Convection scheme switch
+          # (D:2, 1:LMD, 2:Tiedtke, 3:KE New Physics, 30:KE AR4)
+iflag_con=3
+
+          #output level of energy conservation diagnostics
+if_ebil=0
+
+          #maximum efficiency of cld water->precipitation conversion (D: 0.993)
+epmax=0.999
+
+          #dry convective adjustment at beginning of Emanuel convective scheme (D: n 0)
+ok_adj_ema=n
+iflag_clw=0
+
+          #Convective closure (D:1, 0:AR4, 2:ALE and ALP)
+iflag_clos=2
+
+          #Convective entrainment mixing law (D:1, 0:AR4=flat PDF, 1=PDF)
+iflag_mix=1
+
+          #weights of the bell shaped and flat PDF (used only if iflag_mix=1) (D: 1 0)
+qqa1=1
+qqa2=0
+
+          #Parameters of the bell shaped PDF; Fmax=center (D= 0.65), Gammas=width (D=0.05)
+cvl_corr=1
+
+          #Multiplicative factor of Emanuel convective scheme precipitation (D: 1.)
+Fmax=0.65
+
+          #altitude, in hPa, above LCL at which buoybase is computed,
+          # def = original: -40
+dpbase=-40
+
+          #reference fractional area of precipitating downdraughts,
+          # def = original: 0.01
+sigdz=0.003
+
+          #unsaturated fraction of precipitating downdraughts, def = original: 0.15
+spfac=0.15
+
+          #relaxation time of cloud base mass flux, def = original: 8000
+tau=8000
+
+          #flag for wb (= vert velocity at LFC);
+          # 0->wb=wbmax, 1->wb=f(plfc) bounded, 2->wb=f(plfc) linear, D=1
+          # Si iflag_wb>=10 : wbeff_min=iflag_wb*0.1
+          # wbmax : assymptotic value 
+flag_wb=50
+wbmax=2.8
+
+          # Divers tests
+ok_convstop=n
+tau_stop=15000
+ok_intermittent=n
+
+          # nouvel epluchage de C.Rio
+          #shedding coefficient (used when iflag_mix_adiab=1)
+iflag_mix_adiab=0
+coef_peel=0.25
+
+          #Conversion cld water->precip: Ep=f(pressure) if 0; Ep=f(temperature)
+          #if 1, def=1
+flag_epKEorig=1
+
+          # Case : flag_epKEorig=1
+          # elcrit : max condensed water concentration in kg/kg, D=0.0003,
+          # tlcrit : temperature in degre Celsius, at which Ep=Epmax, D=-55. (original)
+          # original: 0.0011, used only if flag_epKEorig=1
+elcrit=0.0003
+tlcrit=-55
+
+          # Case : flag_epKEorig=0
+          # pbcrit : pressure (hPa), above LCL below which Ep=0, D=150 (original)
+          # ptcrit : pressure (hPa), above LCL above which Ep=Epmax, D=500 (original)
+pbcrit=150
+ptcrit=500
+
+          # Prevent some crashes
+          # Filter out bad wakes
+flag_wk_check_trgl=n
+iflag_wk_check_trgl=2
+iflag_alp_wk_cond=1
+
+
+          # Check whether parcel level temperature and specific humidity
+          # are reasonable and demand that LCL be high enough
+cv_flag_feed=2
+
+          # save 20% CPU 
+ok_optim_yield=y
+
+          # Convective clouds
+iflag_cld_cv=0
+
+          # To get back to bug where convective output variables
+          # were set to 0 at the start of the physics
+ok_bug_cv_trac=n
+
+##########################################################
+# Fermeture convective et couplages
+##########################################################
+
+          # Appel separe des thermiques 
+iflag_pbl_split=10
+
+          #rendement sur la puissance fournie par les thermiques a la convection
+alp_bl_k=0.5
+
+          #Constant value to be added to Alp (D: 0.)
+alp_offset=0
+
+          #Convection must reach a level at which T<t_top_max to be active
+t_top_max=1000
+
+          ### nrlmd le 10/04/2012: Declenchement ###
+          #Declenchement par couche-limite (0: deterministe, 1: stochastique)
+iflag_trig_bl=1
+
+          #Surface critique au LCL
+s_trig=12000000
+
+          #Temps de decorrelation entre scenes de cumulus
+tau_trig_shallow=1200
+
+          #Temps de decorrelation entre scenes de cumulonimbus
+tau_trig_deep=1200
+
+          # Pour la stabilisation
+random_notrig_max=0.99
+
+          # Temperature a la quelle on fond les descentes glacees
+tmax_fonte_cv=278.15
+
+          #Fermeture par couche-limite (Nicolas Rochetin)
+          #(0: deterministe, 1: statistique, 2: statistique+convergence
+          # grande echelle)
+iflag_clos_bl=1
+
+          #coefficient in Wape->C_star formula: C_star=stark*sqrt(2*Wape),
+          # def: 0.33
+stark=0.33
+
+          #lifting efficiency of wakes; Alp=Alpk*Fip, Fip=power provided
+          # by wakes, def: 0.25
+alpk=0.25
+
+#
+##########################################################
+# Couche limite convective / modele du thermique
+##########################################################
+
+          # Convection seche (D:0, 0:ajustement sec,=>1:modele du thermique) 
+iflag_thermals=18
+
+          # pas de temps du spliting pour les thermiques
+          # TOURNE MAIS POSE PLUS DE PROBLEME QU ELLE N EN RESOUD
+nsplit_thermals=1
+
+          # tau_thermals pour avoir une constante de temps sur les thermiques.
+          # Non valide
+tau_thermals=0
+
+          # Flag controlant le detrainement et l entrainement
+iflag_thermals_ed=8
+
+          # On va chercher l air a z * ( 1+fact_thermals_ed_dz=0.115742314484222
+          # le detrainement (A. Jam)
+fact_thermals_ed_dz=0.115742314484222
+
+          # Une option de plus sur les thermiques.
+iflag_thermals_optflux=0
+
+          #couplage ou non avec la convection
+iflag_coupl=5
+
+          # Seuil pour desactiver les thermiques en cas de forte inversion
+          # en sommet de couche limite. Actif si iflag_thermals impair.
+seuil_inversion=-0.08
+
+          # Reactivation du calcul d un zmax continu pour les thermiques
+          # reactivation d une fermeture humide des thermiques
+          # iflag_thermals_closure=2 (D=1)
+iflag_thermals_closure=2
+
+
+##########################################################
+# Flags wakes
+##########################################################
+
+          #Wake scheme switch (D:0, 0:AR4, 1:New Physics)
+iflag_wake=1
+
+          #multiplicative factor of the damping by gravity waves, def: 4.
+coefgw=4
+
+          #wake density = number of wake centers per m2, def: 8.E-12
+          #wdens_ref=8.E-12
+wdens_ref_o=1e-09
+wdens_ref_l=8e-12
+
+          # Ajustement convectif prealable au calcul des poches
+ok_adjwk=y
+
+
+####################################################################
+#  Conservation 
+####################################################################
+
+          # The source terms of the TKE prognostic equation are diagnosed
+          # from tendencies (du, dv, dT) 
+          # associated with subrgrid scaleamotions and treated as an 
+          # additional heat source.
+          # Controled by a key, iflag_ener_conserv (D=-1):
+          # 0 : no conservation, -1 : old adhoc correction for kinetic E only
+          # (used for CMIP5) 
+          # 1 : conservation, 101 : conversion from kinetic to heat only,
+          # 110 conversion from potential to heat only
+iflag_ener_conserv=10
+
+          #Activation of corrections for water conservation (D: n). 
+          ##The default is n for compatibility with earlier versions.
+          ##generally it should be y.
+ok_conserv_q=y
+
+fl_cor_ebil=1
+
+####################################################################
+# Ozone
+####################################################################
+          # new treatment for ozone into the tropopause
+adjust_tropopause=y
+
+####################################################################
+#  Conservation de l'eau
+#####################################################################
+          # conservation de l eau sur les calottes
+ok_lic_cond=y
+
+cdnc_min=10.
+
+
+thermals_afact=1.11999558474861
+thermals_fact_epsilon=0.00246546968311137
+thermals_betalpha=0.395730326872031
+thermals_detr_q_coef=0.0113315217193354
+cloudth_sigma1s_factor=1.34224269825002
+cloudth_sigma2s_factor=0.140971937884714
Index: /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_NPv7.0.1b
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_NPv7.0.1b	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/DefLists/physiq.def_NPv7.0.1b	(revision 4727)
@@ -0,0 +1,624 @@
+#
+# $Id: physiq.def_NPv6.2_MR1 3867 2021-03-23 16:49:48Z fairhead $
+#
+
+##############################################################
+# PARAMETRES ET CLES DE LA PHYSIQUE LMDZ
+##############################################################
+# D: Valeur par default
+#
+
+###########################################################
+# divers. Devrait aller dans config.def ?
+###########################################################
+##   Si=.T. ,  lecture du fichier limit avec la bonne annee 
+ok_limitvrai=n
+
+###########################################################
+# Parametres couche limite de surface
+###########################################################
+
+          #  ...
+f_cdrag_stable=1
+
+          # Facteur sur les coefficients de trainee terrestres
+f_cdrag_ter=1
+
+          # Vitesse minimum dans les calculs de trainee Cd ( || V || + Vmin )
+min_wind_speed=0.1
+
+          #  Modelisation des bosquets
+ifl_pbltree=1
+Cd_frein=0.016
+
+###########################################################
+# parameter des flux air-mer
+###########################################################
+
+          # Facteur sur les flux sensibles et latent
+          # Introduit pour reduire l evaporation quand on avait z0h=z0m
+          # CONSEILLE : 1
+f_cdrag_oce=1
+
+          # Flag controlant le calcul des z0
+iflag_z0_oce=1
+
+          # Rapport entre les Z0 latent et sensible
+f_z0qh_oce=1.55
+
+          # Activation des rafales : Oui 1 ou non 0
+iflag_gusts=2
+
+          # facteur pour les rafales des thermiques (bounary layer)
+f_gust_bl=0.845
+
+          # facteur pour les poches (wake)
+f_gust_wk=0.2
+
+          # facteur sur qsat pour tenir compte de la salinite
+f_qsat_oce=0.98
+
+          #cdmmax : valeur max de Cd moment. Sur ocean seulement
+cdmmax=0.2
+
+          #cdhmax : valeur max de Cd evap/sensible. Sur ocean seulement
+cdhmax=0.2
+
+####################################################################
+# Couche limite turbulente
+####################################################################
+
+          # Nouvelle version de Mellor et Yamada
+new_yamada4=y
+
+          # Choix du schema numerique pour new_yamada4=y
+          #  1 schema de MAR. Bien pour CL stables mais detruit les stratocu
+          #  5 schema de MAR modifie. Precaunise.
+yamada4_num=5
+
+          # Flag de controle de la couche limite stable
+iflag_corr_sta=4
+
+          # min sur les fonction de stabilite a la surface
+f_ri_cd_min=0.01
+
+          # max du Ric pour Kz. Decouplage plus grand pour Ric plus grand.
+yamada4_ric=0.18
+
+          # Longueur de melange minimum pour Kz
+lmixmin=0
+
+          #shema de la couche de surface (D:1, 1:LMD, 8:Mellor-Yamada) 
+iflag_pbl=12
+
+          # Seuils pour la diffusion turbulente
+ksta_ter=1e-07
+ksta=1e-10
+
+          #ok_kzmin : calcul Kzmin dans la CL de surface (D: y)
+ok_kzmin=n
+
+          # Creation de TKE par orographie sous-maille
+addtkeoro=2
+alphatkeoro=1
+smallscales_tkeoro=y
+
+
+####################################################################
+# Ondes de gravite / Orographie sous maille
+####################################################################
+
+          #  Orodr  ou  non   pour l orographie
+ok_orodr=y
+
+          #  Orolf  ou  non   pour l orographie              
+ok_orolf=y
+
+          #Rugoro : inclusion de l orographie sous maille dans le Cd de surface
+          # Obsolete avec l activation des ondes de gravite
+f_rugoro=0
+
+          # Parametres controlant l effet de l orographie sous maille
+sso_gfrcri=0.7
+sso_gkdrag=0.6
+sso_gkwake=0.4
+sso_gklift=0.1
+
+          # Random gravity waves
+          #Activitate the stochastic parameterization of convective GWs
+          # (should be equal to ok_strato)
+ok_gwd_rando=y
+
+          # Scale the momentum fluxes due to convective GWs
+gwd_rando_ruwmax=0.5
+
+          #Scale the saturated momentum flux of  convective GWs 
+gwd_rando_sat=0.6
+
+          # Important pour controler la periode de la QBO
+gwd_front_ruwmax=3
+
+          # zstd_orodr_t : minimum subgrid orography standard deviation for activation of drag parameterisation (D:10, 0.:CMIP7)
+zstd_orodr_t = 0.
+
+          # zpmm_orodr_t : minimum zpic-zval value for activation of drag parameterisation (D:100., 0.:CMIP7)
+zpmm_orodr_t = 0.
+
+          # zpmm_orolf_t : minimum zpic-zval value for activation of lift parameterisation (D:100., 0.:CMIP7)
+zpmm_orolf_t =0.
+
+###############################################################
+# Rayonnement
+###############################################################
+          # activation du nouveau code de rayonnement RRTM
+          # 0 : Ancien code, 1 : RRTM et 2 : ECRAD (D=0)
+iflag_rrtm=1
+
+          # Nombre de bandes pour le SW. Mettre 2 si iflag_rrtm=0
+NSW=6
+
+    # Albedo et inertie des calottes
+alb_vis_sno_lic=0.96
+alb_nir_sno_lic=0.68
+    # Controle de l'inertie des glaciers et banquises
+    # inertie_sno : pour la neige (y compris sur les points "ter"
+    #      quand orchidee n'est pas actif)
+    # inertie_lic/sic : pour les "land ice" et "sea ice"
+inertie_sno=350
+    # iflag_sic=1 pour forcer a garder l'inertie des "sea ice"
+    # a inertie_sic meme si la surface est couverte de neige
+iflag_sic=1
+inertie_lic=2000
+inertie_sic=2000
+    # tau_gl = constante de rappel de la temperature a la surface de la glace (en nombre de jours)
+    # Utilise selon le forcage : tau_gl=5 pour Clim, tau_gl=2 pour Amip et tau_gl=1 pour Hadisst2
+tau_gl=2
+
+          # ???
+iflag_albedo=1
+
+          # Frequence appel convection. Nombre appels par jour
+          # (nbapp_cv=0 ==> appel tous les pas de temps)
+nbapp_cv=48
+
+          # Pour pouvoir revenir a un bug purement informatique de duplication
+          # des constantes thermodynamiques entre LMDZ et RRTM
+          # n : FORTEMENT CONSEILLE
+ok_bad_ecmwf_thermo=n
+
+###############################################################
+# Parametres nuages
+###############################################################
+
+          # Activation condensation de grande echelle epuree par E.Vignon : ok_new_lscp=y + ok_icefra_lscp=y
+ok_new_lscp=y
+ok_icefra_lscp=y
+
+
+          #seuils de la precipitation des nuages stratiformes (D: 2.6e-4 2.6e-4)
+cld_lc_lsc=0.00096841923606032
+cld_lc_con=0.00096841923606032
+
+          #constante de temps pour eliminer eau lsc et convective
+          # (D: 3600. 3600.)
+cld_tau_lsc=8151.30533480977
+cld_tau_con=8151.30533480977
+
+          #facteurs correctifs sur la vitesse de chute des cristaux de glace (D: 1 1)
+ffallv_lsc=0.451743342889991
+ffallv_con=0.451743342889991
+
+          # coefficient sur la reevaporation de la pluie (D: 2.e-5 n)
+          # regle a 3.e-5 sur des cas de cumulus en 1D
+coef_eva=0.00490135133370158
+          # coefficient sur la sublimation de la glace (D: 2.e-5 n)
+coef_eva_i=0.00490135133370158
+
+### iflag_autoconversion= 0 avec reste de bogue sur l autoconversion (default)
+### iflag_autoconversion= 1, sans bogue sur l autoconversion 
+### iflag_autoconversion= 2 : 1 + new numerical integration of autoconversion
+###                         : have to add niter_lscp=1
+iflag_autoconversion=1
+
+          # flag pour la reevaporation de la pluie
+          # 0: rien
+          # 1: a l ancienne
+          # 2: prend en compte la surface nuageuse max au dessus pour calculer
+          #    le max de reevaporation, comme ecart a la saturation. CONSEILLE
+          # 4: Ludo original
+          # 5: Ludo + correction Etienne
+iflag_evap_prec=5
+
+          # min local intensity for rainfall before decrease of the associated precipitation fraction (mm/s)
+          # rain_int_min is used if iflag_evap_prec>=4
+rain_int_min=1.44716149682657e-5
+
+          # Modification de la plage de temperature pour la phase mixte
+          # liquide/glace des nuages
+          # Controle par les t_glace_min/max, exposant_glace,
+          # iflag_t_glace (D=0)
+t_glace_min=243.15
+t_glace_max=273.15
+exposant_glace=0.5
+iflag_t_glace=3
+
+          # Activation de la thermodynamique de la glace
+iflag_ice_thermo=1
+
+          # normalement elle ne sert plus a rien dans fisrtilp
+          # sinon elle est un peu toxique:
+          # IF (zt(i) .LT. t_coup.and.reevap_ice) zrfln(i)=0. (Jean-Baptiste)
+reevap_ice=n
+
+          #Bergeron
+iflag_bergeron=2
+
+          # temperature dependency of qsat for iterative procedure
+          # temporary flag to switch between the old (CMIP5, D=0)
+          # and new versions (=1) versions 
+iflag_fisrtilp_qsat=4
+
+
+          #calcul des proprietes des nuages convectifs (D:1 0.375 1.e-4) 
+iflag_cld_th=6
+fact_cldcon=1
+
+          # ?????
+facttemps=0
+
+          #calcul eau condensee et fraction nuageuse a partir des PDF
+          # (D:0, 0:version avec ratqs sinon nouvelles PDFs)  
+iflag_pdf=1
+
+          #calcul epaisseur optique et emmissivite des nuages (D: y 1 0.01 0.3)
+ok_newmicro=y
+
+          # Controle des ratqs grande echelle
+iflag_ratqs=4
+ratqsp0=48254.6771101272
+ratqsdp=16383.2736877474
+ratqsbas=0.002
+ratqshaut=0.342148444633161
+
+          #rayon effectif pour les nuages de glace (D:35)
+rad_froid=35
+
+          # Rayons effectif des gouttes nuageuses
+          # ACTIF SI ok_cdnc=0 dans config.def. (D~9 a 12 microns)
+rad_chau1=12
+rad_chau2=11
+
+	  # Rayon effectif des gouttes si ok_cdnc=0
+          # Parameters in CDNC-maer link (Boucher&Lohmann 1995)
+bl95_b0=1.3
+bl95_b1=0.2
+
+          #  Choix ou non  de  New oliq               
+new_oliq=y
+
+          # Seuils oliqmax, oicemax (en g/kg).
+          # Au dela on precipite directement au sol
+oliqmax=0.0015
+oicemax=0.0015
+
+          #Rayons min et max effectifs des particules des nuages
+rei_min=18.1205
+rei_max=69.4129
+
+          # Distribution vetricale sous maille pour le schema de de nuages.
+          # 0: rien
+          # 1: Premiere version A. Jam,
+          # 2 : J. Jouhaud, parametre cloudth_vert_alpha D=0.5
+          # 3 : J. Jouhaud, parametre cloudth_vert_alpha D=0.5/C= 1.32
+          #                           cloudth_vert_alpha_th C=2:91
+iflag_cloudth_vert=3
+cloudth_vert_alpha=0.5
+cloudth_vert_alpha_th=0.5
+
+
+######################################################################
+# Convection 
+######################################################################
+
+          #Convection scheme switch
+          # (D:2, 1:LMD, 2:Tiedtke, 3:KE New Physics, 30:KE AR4)
+iflag_con=3
+
+          # correct convection bug
+          #(default = y)
+keepbug_ice_frac=n
+
+          #output level of energy conservation diagnostics
+if_ebil=0
+
+          #maximum efficiency of cld water->precipitation conversion (D: 0.993)
+epmax=0.999071
+
+          #dry convective adjustment at beginning of Emanuel convective scheme (D: n 0)
+ok_adj_ema=n
+iflag_clw=0
+
+          #Convective closure (D:1, 0:AR4, 2:ALE and ALP)
+iflag_clos=2
+
+          #Convective entrainment mixing law (D:1, 0:AR4=flat PDF, 1=PDF)
+iflag_mix=1
+
+          #weights of the bell shaped and flat PDF (used only if iflag_mix=1) (D: 1 0)
+qqa1=1
+qqa2=0
+
+          #Parameters of the bell shaped PDF; Fmax=center (D= 0.65), Gammas=width (D=0.05)
+cvl_corr=1
+
+          #Multiplicative factor of Emanuel convective scheme precipitation (D: 1.)
+Fmax=0.65
+
+          #altitude, in hPa, above LCL at which buoybase is computed,
+          # def = original: -40
+dpbase=-40
+
+          #reference fractional area of precipitating downdraughts,
+          # def = original: 0.01
+sigdz=0.003
+
+          #unsaturated fraction of precipitating downdraughts, def = original: 0.15
+spfac=0.15
+
+          #relaxation time of cloud base mass flux, def = original: 8000
+tau=8000
+
+          #flag for wb (= vert velocity at LFC);
+          # 0->wb=wbmax, 1->wb=f(plfc) bounded, 2->wb=f(plfc) linear, D=1
+          # Si iflag_wb>=10 : wbeff_min=iflag_wb*0.1
+          # wbmax : assymptotic value 
+flag_wb=50
+wbmax=2.8
+
+          # Divers tests
+ok_convstop=n
+tau_stop=15000
+ok_intermittent=n
+
+          # nouvel epluchage de C.Rio
+          #shedding coefficient (used when iflag_mix_adiab=1)
+iflag_mix_adiab=0
+coef_peel=0.25
+
+          #Conversion cld water->precip: Ep=f(pressure) if 0; Ep=f(temperature)
+          #if 1, def=1
+flag_epKEorig=1
+
+          # Case : flag_epKEorig=1
+          # elcrit : max condensed water concentration in kg/kg, D=0.0003,
+          # tlcrit : temperature in degre Celsius, at which Ep=Epmax, D=-55. (original)
+          # original: 0.0011, used only if flag_epKEorig=1
+elcrit=0.0003
+tlcrit=-55
+
+          # Case : flag_epKEorig=0
+          # pbcrit : pressure (hPa), above LCL below which Ep=0, D=150 (original)
+          # ptcrit : pressure (hPa), above LCL above which Ep=Epmax, D=500 (original)
+pbcrit=150
+ptcrit=500
+
+          # Precipitation ejection from adiabatic ascents
+          # cvflag_prec_eject: when TRUE ejection is activated. Default: False
+          # WARNING ! : cvflag_prec_eject=y is effective only if icvflag_Tpa=1
+          # ejectliq : 0. =>liquid precipitation is carried up in the adiab updraughts
+          #            1. =>liquid precipitation is ejected from adiab updraughts
+          # ejectice   0. =>solid precipitation is carried up in the adiab updraughts
+          #            1. =>solid precipitation is ejected from adiab updraughts
+          # ejectliq may take only 0. and 1. values
+          # ejectice may take any value between 0. and 1.
+          #   Default : cvflag_prec_eject=n, ejectliq=0., ejectice=0.
+cvflag_prec_eject=n
+ejectliq=0.
+ejectice=0.
+
+          # Check whether parcel level temperature and specific humidity
+          # are reasonable and demand that LCL be high enough
+cv_flag_feed=2
+
+          # save 20% CPU 
+ok_optim_yield=y
+
+          # Convective clouds
+iflag_cld_cv=0
+
+          # To get back to bug where convective output variables
+          # were set to 0 at the start of the physics
+ok_bug_cv_trac=n
+
+           # solving of the temperature equation for the adiabatic ascent
+           # 0 -> AJ scheme in two loops ; ice fraction given by envt. temp.
+           # 1 -> JYG scheme in one loop ; ice fraction given by envt. temp.
+           # 2 -> JYG scheme in one loop ; ice fraction given by adiab. asc. temp.
+           # Default: 0
+           # 2 is costly and ill tested; experts only.
+icvflag_Tpa=0
+
+           # taking into account the dependence of qv on qt at saturation
+           # Default: n
+qsat_depends_on_qt=n
+
+##########################################################
+# Fermeture convective et couplages
+##########################################################
+
+          # Decimal code:  + first digit drives the splitting of thermals: 
+          #                                0 = thermals see the average profiles of T and q
+          #                                1 = thermals are only outside wakes
+          #                + second digit drives the splitting of diffuse PBL:
+          #                                0 = The diffuse PBL sees the average profiles of T and q
+          #                                1 = Two BLs, one in (w) and one in (x), with the same
+          #                                    surface temperature and humidity.
+          #                                2 = Two BLs, one in (w) and one in (x), with separate
+          #                                    surface temperature and humidity.
+          #                                3 = same as 1 over ocean; same as 0 everywhere else.
+          # Example: iflag_pbl_split=12 => thermals outside wakes, split BL with Tsurf and qsurf difference
+          # iflag_pbl_split=10 => thermals outside wakes
+iflag_pbl_split=10
+
+          #rendement sur la puissance fournie par les thermiques a la convection
+alp_bl_k=0.5
+
+          #Constant value to be added to Alp (D: 0.)
+alp_offset=0
+
+          #Convection must reach a level at which T<t_top_max to be active
+t_top_max=1000
+
+          ### nrlmd le 10/04/2012: Declenchement ###
+          #Declenchement par couche-limite (0: deterministe, 1: stochastique)
+iflag_trig_bl=1
+
+          #Surface critique au LCL
+s_trig=12000000
+
+          #Temps de decorrelation entre scenes de cumulus
+tau_trig_shallow=1200
+
+          #Temps de decorrelation entre scenes de cumulonimbus
+tau_trig_deep=1200
+
+          # Pour la stabilisation
+random_notrig_max=0.99
+
+          # Temperature a la quelle on fond les descentes glacees
+tmax_fonte_cv=278.15
+
+          #Fermeture par couche-limite (Nicolas Rochetin)
+          #(0: deterministe, 1: statistique, 2: statistique+convergence
+          # grande echelle)
+iflag_clos_bl=1
+
+          #coefficient in Wape->C_star formula: C_star=stark*sqrt(2*Wape),
+          # def: 0.33
+stark=0.33
+
+          #lifting efficiency of wakes; Alp=Alpk*Fip, Fip=power provided
+          # by wakes, def: 0.25
+alpk=0.25
+
+#
+##########################################################
+# Couche limite convective / modele du thermique
+##########################################################
+
+          # Convection seche (D:0, 0:ajustement sec,=>1:modele du thermique) 
+iflag_thermals=18
+
+          # pas de temps du spliting pour les thermiques
+          # TOURNE MAIS POSE PLUS DE PROBLEME QU ELLE N EN RESOUD
+nsplit_thermals=1
+
+          # tau_thermals pour avoir une constante de temps sur les thermiques.
+          # Non valide
+tau_thermals=0
+
+          # Flag controlant le detrainement et l entrainement
+iflag_thermals_ed=8
+
+          # On va chercher l air a z * ( 1+fact_thermals_ed_dz) pour calculer
+          # le detrainement (A. Jam)
+fact_thermals_ed_dz=0.103105610491144
+
+          # Une option de plus sur les thermiques.
+iflag_thermals_optflux=0
+
+          #couplage ou non avec la convection
+iflag_coupl=5
+
+          # Seuil pour desactiver les thermiques en cas de forte inversion
+          # en sommet de couche limite. Actif si iflag_thermals impair.
+seuil_inversion=-0.08
+
+          # Reactivation du calcul d un zmax continu pour les thermiques
+          # reactivation d une fermeture humide des thermiques
+          # iflag_thermals_closure=2 (D=1)
+iflag_thermals_closure=2
+
+          # Flag permettant de garder le bug induisant des wake_deltaT non nuls
+          # a partir des tendances des thermiques, meme en l'absence de poches.
+          # Default : ok_bug_split_th=y ==> le bug est maintenu
+ok_bug_split_th=n
+
+          # contribution of buoyancy to the plume acceleration
+thermals_afact=1.05641487083682
+
+          # drag term in the plume acceleration
+thermals_fact_epsilon=0.00205282352527457
+
+          # scaling factor for entrainment and detrainment
+thermals_betalpha=0.411960019760327
+
+          # width of the environment subgrid scale water distribution
+cloudth_sigma1s_factor=0.673674753185742
+
+##########################################################
+# Flags wakes
+##########################################################
+
+          #Wake scheme switch (D:0, 0:AR4, 1:New Physics)
+iflag_wake=1
+
+          #multiplicative factor of the damping by gravity waves, def: 4.
+coefgw=4
+
+          #wake density = number of wake centers per m2, def: 8.E-12
+          #wdens_ref=8.E-12
+wdens_ref_o=1e-09
+wdens_ref_l=8e-12
+
+          # Ajustement convectif prealable au calcul des poches
+ok_adjwk=y
+
+          # Prevent some crashes
+          # Filter out bad wakes
+flag_wk_check_trgl=n
+iflag_wk_check_trgl=2
+iflag_alp_wk_cond=1
+
+          #Wake population dynamic switch (D:0):
+          # iflag_wk_pop_dyn=0 ==> wake_dens is set to wdens_ref
+          # iflag_wk_pop_dyn=1 ==> wake_dens is a prognostic variable
+iflag_wk_pop_dyn=0
+
+iflag_wk_profile=1
+wk_pupper=0.6
+####################################################################
+#  Conservation 
+####################################################################
+          # The source terms of the TKE prognostic equation are diagnosed
+          # from tendencies (du, dv, dT) 
+          # associated with subrgrid scaleamotions and treated as an 
+          # additional heat source.
+          # Controled by a key, iflag_ener_conserv (D=-1):
+          # 0 : no conservation, -1 : old adhoc correction for kinetic E only
+          # (used for CMIP5) 
+          # 1 : conservation, 101 : conversion from kinetic to heat only,
+          # 110 conversion from potential to heat only
+iflag_ener_conserv=10
+
+          #Activation of corrections for water conservation (D: n). 
+          ##The default is n for compatibility with earlier versions.
+          ##generally it should be y.
+ok_conserv_q=y
+
+fl_cor_ebil=1
+
+####################################################################
+# Ozone
+####################################################################
+          # new treatment for ozone into the tropopause
+adjust_tropopause=y
+
+####################################################################
+#  Conservation de l'eau
+#####################################################################
+          # conservation de l eau sur les calottes
+ok_lic_cond=y
+####################################################################
+          #min cloud droplet number concentration
+cdnc_min=10.
Index: DZ6/branches/LMDZ_ECRad/arch/arch-ES_MOON.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-ES_MOON.fcm	(revision 4726)
+++ 	(revision )
@@ -1,18 +1,0 @@
-%COMPILER            esmpif90
-%LINK                esmpif90
-%AR                  esar
-%ARFLAGS             rs
-%MAKE                gmake
-%FPP_FLAGS           -P -traditional
-%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM FFT_MATHKEISAN
-%BASE_FFLAGS         -P stack -Wf,-pvctl res=whole,-A dbl4,-ptr byte -EP -R5 -float0 -dw -Wf,"-pvctl loopcnt=999999 fullmsg noassume"
-%PROD_FFLAGS         -C vopt
-%DEV_FFLAGS          -C vsafe -gv -Wf,-init stack=nan,-init heap=nan
-%DEBUG_FFLAGS        -C debug -eC -Wf,-init stack=nan,-init heap=nan
-%MPI_FFLAGS
-%OMP_FFLAGS          -P openmp
-%BASE_LD             -lblas -lfft
-%MPI_LD
-%OMP_LD              -P openmp  -Wl,"-ZL 3G"
-
-
Index: DZ6/branches/LMDZ_ECRad/arch/arch-IA64_PLATINE.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-IA64_PLATINE.fcm	(revision 4726)
+++ 	(revision )
@@ -1,16 +1,0 @@
-%COMPILER            mpif90
-%LINK                mpif90
-%AR                  ar
-%ARFLAGS             rs
-%MAKE                gmake
-%FPP_FLAGS           -P -traditional
-%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM FFT_MKL
-%BASE_FFLAGS         -i4 -r8 -automatic -align all -I${MKLROOT}/include
-%PROD_FFLAGS         -O3
-%DEV_FFLAGS          -p -g -O3 -traceback
-%DEBUG_FFLAGS        -p -g -traceback
-%MPI_FFLAGS
-%OMP_FFLAGS          -openmp
-%BASE_LD             -p -i4 -r8 -automatic $MKL_LIBS
-%MPI_LD
-%OMP_LD              -openmp
Index: DZ6/branches/LMDZ_ECRad/arch/arch-PW6_VARGAS.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-PW6_VARGAS.fcm	(revision 4726)
+++ 	(revision )
@@ -1,16 +1,0 @@
-%COMPILER            xlf_r
-%LINK                mpxlf_r
-%AR                  ar
-%ARFLAGS             rs
-%MAKE                gmake
-%FPP_FLAGS           -P -I/usr/local/pub/FFTW/3.2/include
-%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM FFT_FFTW
-%BASE_FFLAGS         -qautodbl=dbl4 -qxlf90=autodealloc -qmaxmem=-1 -qzerosize -I/usr/local/pub/FFTW/3.2/include
-%PROD_FFLAGS         -O3
-%DEV_FFLAGS          -O2 -qfullpath -qinitauto=7FBFFFFF -qfloat=nans -qflttrap=overflow:zerodivide:invalid:enable -qsigtrap
-%DEBUG_FFLAGS        -g -qfullpath -qnooptimize -qinitauto=7FBFFFFF  -qfloat=nans -qflttrap=overflow:zerodivide:invalid:enable -qsigtrap -qcheck
-%MPI_FFLAGS          -I/usr/lpp/ppe.poe/include/thread64
-%OMP_FFLAGS          -qsmp=omp
-%BASE_LD             -lessl -L/usr/local/pub/FFTW/3.2/lib -lfftw3
-%MPI_LD              
-%OMP_LD              -qsmp=omp
Index: DZ6/branches/LMDZ_ECRad/arch/arch-SX8_BRODIE.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-SX8_BRODIE.fcm	(revision 4726)
+++ 	(revision )
@@ -1,17 +1,0 @@
-%COMPILER            sxmpif90
-%LINK                sxmpif90
-%AR                  sxar
-%ARFLAGS             rs
-%MAKE                sxgmake
-%FPP_FLAGS           -P -traditional
-%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM FFT_MATHKEISAN
-%BASE_FFLAGS         -P stack -Wf,-pvctl res=whole,-A dbl4,-ptr byte -EP -R5 -float0 -dw -Wf,"-pvctl loopcnt=999999 fullmsg noassume"
-%PROD_FFLAGS         -C vopt
-%DEV_FFLAGS          -C vsafe -gv -Wf,-init stack=nan,-init heap=nan
-%DEBUG_FFLAGS        -C debug -eR -Wf,-init stack=nan,-init heap=nan
-%MPI_FFLAGS
-%OMP_FFLAGS          -P openmp
-%BASE_LD             -lblas -lfft
-%MPI_LD
-%OMP_LD              -P openmp  -Wl,"-ZL 3G"
-
Index: DZ6/branches/LMDZ_ECRad/arch/arch-SX8_BRODIE.opt
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-SX8_BRODIE.opt	(revision 4726)
+++ 	(revision )
@@ -1,12 +1,0 @@
-%INLINE -pi auto exp=swtt1_lmdar4,swtt_lmdar4,swde_lmdar4,lwttm_lmdar4,lwtt_lmdar4,swr_lmdar4,swclr_lmdar4 noexp=SW_LMDAR4,SWU_LMDAR4,SW1S_LMDAR4,SW2S_LMDAR4,LW_LMDAR4,LWU_LMDAR4,LWBV_LMDAR4,LWC_LMDAR4,LWB_LMDAR4,LWV_LMDAR4,LWVB_LMDAR4,LWVD_LMDAR4,LWVN_LMDAR4 line=2000
-
-bld::tool::fflags::phys::readaerosol         %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt -pi auto
-bld::tool::fflags::phys::aeropt_2bands       %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR
-bld::tool::fflags::phys::radiation_AR4       %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt -Wf,-O,extendreorder %INLINE
-bld::tool::fflags::phys::radiation_AR4_param %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt %INLINE
-bld::tool::fflags::phys::fisrtilp            %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt
-bld::tool::fflags::phys::cv30_routines       %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -Wf,-O,extendreorder
-bld::tool::fflags::phys::cvltr               %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt
-bld::tool::fflags::phys::clouds_gno          %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt
-bld::tool::fflags::dyn::vlsplt_p             %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt
-bld::tool::fflags::dyn::groupeun_p           %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt
Index: DZ6/branches/LMDZ_ECRad/arch/arch-SX8_MERCURE.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-SX8_MERCURE.fcm	(revision 4726)
+++ 	(revision )
@@ -1,16 +1,0 @@
-%COMPILER            sxmpif90
-%LINK                sxmpif90
-%AR                  sxar
-%ARFLAGS             rs
-%MAKE                make
-%FPP_FLAGS           -P -traditional
-%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM FFT_MATHKEISAN
-%BASE_FFLAGS         -P stack -Wf,-pvctl res=whole,-A dbl4,-ptr byte -EP -R5 -float0 -size_t64 -dw -Wf,"-pvctl loopcnt=999999 fullmsg noassume"
-%PROD_FFLAGS         -C vopt
-%DEV_FFLAGS          -C vsafe -gv -Wf,-init stack=nan,-init heap=nan
-%DEBUG_FFLAGS        -C debug -eC -Wf,-init stack=nan,-init heap=nan
-%MPI_FFLAGS
-%OMP_FFLAGS          -P openmp
-%BASE_LD             -size_t64 -lblas -lfft
-%MPI_LD
-%OMP_LD              -P openmp  -Wl,"-ZL 3G"
Index: DZ6/branches/LMDZ_ECRad/arch/arch-SX8_MERCURE.opt
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-SX8_MERCURE.opt	(revision 4726)
+++ 	(revision )
@@ -1,12 +1,0 @@
-%INLINE -pi auto exp=swtt1_lmdar4,swtt_lmdar4,swde_lmdar4,lwttm_lmdar4,lwtt_lmdar4,swr_lmdar4,swclr_lmdar4 noexp=SW_LMDAR4,SWU_LMDAR4,SW1S_LMDAR4,SW2S_LMDAR4,LW_LMDAR4,LWU_LMDAR4,LWBV_LMDAR4,LWC_LMDAR4,LWB_LMDAR4,LWV_LMDAR4,LWVB_LMDAR4,LWVD_LMDAR4,LWVN_LMDAR4 line=2000
-
-bld::tool::fflags::phys::readaerosol         %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt -pi auto
-bld::tool::fflags::phys::aeropt_2bands       %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR
-bld::tool::fflags::phys::radiation_AR4       %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt -Wf,-O,extendreorder %INLINE
-bld::tool::fflags::phys::radiation_AR4_param %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt %INLINE
-bld::tool::fflags::phys::fisrtilp            %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt
-bld::tool::fflags::phys::cv30_routines       %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -Wf,-O,extendreorder
-bld::tool::fflags::phys::cvltr               %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt
-bld::tool::fflags::phys::clouds_gno          %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt
-bld::tool::fflags::dyn::vlsplt_p             %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt
-bld::tool::fflags::dyn::groupeun_p           %BASE_FFLAGS %PARA_FFLAGS %PROD_FFLAGS  %INCDIR -C hopt
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-SX9_MERCURE.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-SX9_MERCURE.fcm	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-SX9_MERCURE.fcm	(revision 4727)
@@ -1,4 +1,5 @@
 %COMPILER            sxmpif90
 %LINK                sxmpif90
+%FPP                 sxcpp
 %AR                  sxar
 %ARFLAGS             rs
Index: DZ6/branches/LMDZ_ECRad/arch/arch-X64_ADA.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_ADA.fcm	(revision 4726)
+++ 	(revision )
@@ -1,17 +1,0 @@
-%COMPILER            mpiifort
-%LINK                mpiifort
-%AR                  ar
-%ARFLAGS             rs
-%MAKE                gmake
-%FPP_FLAGS           -P -traditional -I/smplocal/pub/FFTW/3.3.3_dyn/include/
-%FPP_DEF             NC_DOUBLE FFT_FFTW
-%BASE_FFLAGS         -auto -recursive -mcmodel=large -integer-size 32 -real-size 64 -align all 
-%PROD_FFLAGS         -O2 -ip -fp-model strict -axAVX,SSE4.2
-%DEV_FFLAGS          -p -g -O1 -fpe0 -traceback
-%DEBUG_FFLAGS        -p -g -O0 -fpe-all=0 -traceback -ftrapuv -fp-stack-check -check bounds,format,output_conversion,pointers,uninit -debug -ftz
-%MPI_FFLAGS
-%OMP_FFLAGS          -openmp
-%BASE_LD             -L/smplocal/pub/FFTW/3.3.3_dyn/lib -lfftw3 -shared-intel  -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -lpthread -Wl,-rpath=/smplocal/pub/NetCDF/4.1.3/mpi/lib:/smplocal/pub/HDF5/1.8.9/par/lib:/smplocal/pub/FFTW/3.3.3_dyn/lib
-%MPI_LD              
-%OMP_LD              -openmp
-
Index: DZ6/branches/LMDZ_ECRad/arch/arch-X64_CURIE.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_CURIE.fcm	(revision 4726)
+++ 	(revision )
@@ -1,17 +1,0 @@
-%COMPILER            mpif90
-%LINK                mpif90
-%AR                  ar
-%ARFLAGS             rs
-%MAKE                gmake
-%FPP_FLAGS           -P -traditional
-%FPP_DEF             NC_DOUBLE FFT_MKL
-#%BASE_FFLAGS        -recursive -xHost -i4 -r8 -auto -align all -I$(MKL_INC_DIR) -I$(MKL_INC_DIR)/intel64/lp64
-%BASE_FFLAGS         -i4 -r8 -auto -align all -I$(MKL_INC_DIR) -I$(MKL_INC_DIR)/intel64/lp64 
-%PROD_FFLAGS         -O3 -axAVX,SSE4.2 -fp-model fast=2
-%DEV_FFLAGS          -fp-model strict -p -g -O2 -traceback -fp-stack-check
-%DEBUG_FFLAGS        -fp-model strict -p -g -traceback -fp-stack-check -ftrapuv
-%MPI_FFLAGS
-%OMP_FFLAGS          -openmp
-%BASE_LD             -i4 -r8 -auto $MKL_LIBS
-%MPI_LD
-%OMP_LD              -openmp
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE-AMD.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE-AMD.fcm	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE-AMD.fcm	(revision 4727)
@@ -1,8 +1,9 @@
 %COMPILER            mpif90
 %LINK                mpif90
+%FPP                 mpif90 -E
 %AR                  ar
 %ARFLAGS             rs
 %MAKE                gmake
-%FPP_FLAGS           -P -traditional
+%FPP_FLAGS           
 %FPP_DEF             NC_DOUBLE FFT_MKL
 %BASE_FFLAGS         -i4 -r8 -auto -align all -I$(MKL_INCDIR) -I$(MKL_INCDIR)/intel64/lp64 
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE-AMD.path
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE-AMD.path	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE-AMD.path	(revision 4727)
@@ -1,8 +1,9 @@
+
 NETCDF_INCDIR="-I$NETCDFFORTRAN_INCDIR"
 NETCDF_LIBDIR="-L$NETCDFFORTRAN_LIBDIR -L$NETCDF_LIBDIR"
 NETCDF_LIB="-lnetcdff -lnetcdf"
 
-NETCDF95_INCDIR=-I$LMDGCM/../../include/NetCDF95
-NETCDF95_LIBDIR=-L$LMDGCM/../../lib
+NETCDF95_INCDIR=-I$NETCDF95_INCDIR
+NETCDF95_LIBDIR=-L$NETCDF95_LIBDIR
 NETCDF95_LIB=-lnetcdf95
 
@@ -25,4 +26,2 @@
 INCA_LIBDIR="-L$LMDGCM/../INCA/build/lib"
 INCA_LIB="-lchimie"
-
-
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE.env
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE.env	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE.env	(revision 4727)
@@ -0,0 +1,14 @@
+# Compile and running environement at Irene  
+
+set +e  
+module purge
+module load intel/20.0.0
+module load mpi/openmpi/4.1.4
+module load flavor/hdf5/parallel
+module load hdf5/1.12.0
+module load netcdf-fortran/4.5.3
+module load mkl/20.0.0
+module load feature/bridge/heterogenous_mpmd
+module load c++/gnu/8.3.0
+module load c/gnu/8.3.0
+module load netcdf95
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE.fcm	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE.fcm	(revision 4727)
@@ -1,8 +1,9 @@
 %COMPILER            mpif90
 %LINK                mpif90
+%FPP                 mpif90 -E
 %AR                  ar
 %ARFLAGS             rs
 %MAKE                gmake
-%FPP_FLAGS           -P -traditional
+%FPP_FLAGS           
 %FPP_DEF             NC_DOUBLE FFT_MKL
 #%BASE_FFLAGS        -recursive -xHost -i4 -r8 -auto -align all -I$(MKL_INC_DIR) -I$(MKL_INC_DIR)/intel64/lp64
@@ -13,5 +14,5 @@
 %MPI_FFLAGS
 %OMP_FFLAGS          -qopenmp
-%BASE_LD             -i4 -r8 -auto -L/ccc/products/mkl-17.0.4.196/intel--17.0.4.196__openmpi--2.0.2/default/17.0.4.196/mkl/lib/intel64 -lmkl_intel_lp64 -lmkl_core -lmkl_sequential -lpthread
+%BASE_LD   -i4 -r8 -auto -L/ccc/products/mkl-20.0.0/system/default/20.0.0/mkl/lib/intel64 -lmkl_intel_lp64 -lmkl_core -lmkl_sequential -lpthread
 %MPI_LD
 %OMP_LD              -qopenmp
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE.path
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE.path	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_IRENE.path	(revision 4727)
@@ -4,6 +4,6 @@
 NETCDF_LIB="-lnetcdff -lnetcdf"
 
-NETCDF95_INCDIR=-I$LMDGCM/../../include/NetCDF95
-NETCDF95_LIBDIR=-L$LMDGCM/../../lib
+NETCDF95_INCDIR=-I$NETCDF95_INCDIR
+NETCDF95_LIBDIR=-L$NETCDF95_LIBDIR
 NETCDF95_LIB=-lnetcdf95
 
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY.env
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY.env	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY.env	(revision 4727)
@@ -4,4 +4,5 @@
 module load netcdf/4.7.2-mpi
 module load netcdf-fortran/4.5.2-mpi
+module load netcdf95
 
 module load gcc/6.5.0
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY.fcm	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY.fcm	(revision 4727)
@@ -2,8 +2,9 @@
 %COMPILER            mpiifort
 %LINK                mpiifort
+%FPP                 mpiifort -E
 %AR                  ar
 %ARFLAGS             rs
 %MAKE                gmake
-%FPP_FLAGS           -P -traditional
+%FPP_FLAGS           
 %FPP_DEF             NC_DOUBLE FFT_MKL
 %BASE_FFLAGS         -i4 -r8 -auto -align all -fp-model strict
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY.path
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY.path	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY.path	(revision 4727)
@@ -6,6 +6,6 @@
 NETCDF_LIB="-lnetcdff -lnetcdf"
 
-NETCDF95_INCDIR=-I$LMDGCM/../../include/NetCDF95
-NETCDF95_LIBDIR=-L$LMDGCM/../../lib
+NETCDF95_INCDIR=-I$NETCDF95_ROOT/include/NetCDF95
+NETCDF95_LIBDIR=-L$NETCDF95_ROOT/lib
 NETCDF95_LIB=-lnetcdf95
 
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY_OPENMPI.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY_OPENMPI.fcm	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY_OPENMPI.fcm	(revision 4727)
@@ -0,0 +1,18 @@
+# $Id$
+%COMPILER            mpif90
+%LINK                mpif90
+%FPP                 mpif90 -E
+%AR                  ar
+%ARFLAGS             rs
+%MAKE                gmake
+%FPP_FLAGS           
+%FPP_DEF             NC_DOUBLE FFT_MKL
+%BASE_FFLAGS         -i4 -r8 -auto -align all -fp-model strict
+%PROD_FFLAGS         -O3 -xHost -qopt-zmm-usage=high
+%DEV_FFLAGS          -p -g -O2 -traceback -fp-stack-check
+%DEBUG_FFLAGS        -p -g -O0 -traceback -fp-stack-check -ftrapuv -check bounds,noarg_temp_created,pointers,stack,uninit -debug full -init=arrays -init=snan
+%MPI_FFLAGS
+%OMP_FFLAGS          -qopenmp
+%BASE_LD             -i4 -r8 -auto -lmkl_intel_lp64 -lmkl_core -lmkl_sequential -lpthread
+%MPI_LD
+%OMP_LD              -qopenmp
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY_OPENMPI.path
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY_OPENMPI.path	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_JEANZAY_OPENMPI.path	(revision 4727)
@@ -0,0 +1,30 @@
+# $Id$
+#NETCDF_LIBDIR="-L$NETCDFFORTRAN_LIBDIR -L$NETCDF_LIBDIR -lnetcdf -lnetcdff"
+#NETCDF_INCDIR=-I$NETCDFFORTRAN_INCDIR
+NETCDF_INCDIR=""
+NETCDF_LIBDIR=""
+NETCDF_LIB="-lnetcdff -lnetcdf"
+
+NETCDF95_INCDIR=-I$NETCDF95_ROOT/include/NetCDF95
+NETCDF95_LIBDIR=-L$NETCDF95_ROOT/lib
+NETCDF95_LIB=-lnetcdf95
+
+IOIPSL_INCDIR="-I$LMDGCM/../../lib -I$LMDGCM/../IOIPSL/inc"
+IOIPSL_LIBDIR="-L$LMDGCM/../../lib -L$LMDGCM/../IOIPSL/lib"
+IOIPSL_LIB="-lioipsl"
+
+XIOS_INCDIR="-I$LMDGCM/../XIOS/inc"
+XIOS_LIBDIR="-L$LMDGCM/../XIOS/lib"
+XIOS_LIB="-lxios -lstdc++"
+
+ORCH_INCDIR="-I$LMDGCM/../../lib"
+ORCH_LIBDIR="-L$LMDGCM/../../lib"
+ORCH_LIB=
+
+OASIS_INCDIR="-I$LMDGCM/../../oasis3-mct/BLD/build/lib/psmile.MPI1"
+OASIS_LIBDIR="-L$LMDGCM/../../oasis3-mct/BLD/lib"
+OASIS_LIB="-lpsmile.MPI1 -lscrip -lmct -lmpeu"
+
+INCA_INCDIR="-I$LMDGCM/../INCA/build/inc"
+INCA_LIBDIR="-L$LMDGCM/../INCA/build/lib"
+INCA_LIB="-lchimie"
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_OCCIGEN.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_OCCIGEN.fcm	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_OCCIGEN.fcm	(revision 4727)
@@ -1,4 +1,5 @@
 %COMPILER            mpif90
 %LINK                mpif90
+%FPP                 cpp
 %AR                  ar
 %ARFLAGS             rs
Index: DZ6/branches/LMDZ_ECRad/arch/arch-X64_TITANE.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-X64_TITANE.fcm	(revision 4726)
+++ 	(revision )
@@ -1,16 +1,0 @@
-%COMPILER            mpif90
-%LINK                mpif90
-%AR                  ar
-%ARFLAGS             rs
-%MAKE                gmake
-%FPP_FLAGS           -P -traditional
-%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM FFT_MKL
-%BASE_FFLAGS         -i4 -r8 -automatic -align all -I${MKLROOT}/include
-%PROD_FFLAGS         -O3
-%DEV_FFLAGS          -p -g -O3 -traceback -fp-stack-check -ftrapuv
-%DEBUG_FFLAGS        -p -g -traceback
-%MPI_FFLAGS
-%OMP_FFLAGS          -openmp
-%BASE_LD             -p -i4 -r8 -automatic $MKL_LIBS
-%MPI_LD
-%OMP_LD              -openmp
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-g95.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-g95.fcm	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-g95.fcm	(revision 4727)
@@ -1,4 +1,5 @@
 %COMPILER            g95
 %LINK                g95
+%FPP                 cpp
 %AR                  ar
 %ARFLAGS             rs
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-gfortran.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-gfortran.fcm	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-gfortran.fcm	(revision 4727)
@@ -1,4 +1,5 @@
 %COMPILER            mpifort
 %LINK                mpifort
+%FPP                 cpp
 %AR                  ar
 %ARFLAGS             rs
@@ -6,9 +7,9 @@
 %FPP_FLAGS           -P -traditional
 %FPP_DEF             NC_DOUBLE FFT_FFTW
-%BASE_FFLAGS         -c -fdefault-real-8 -frecursive -ffree-line-length-0
+%BASE_FFLAGS         -c -fdefault-real-8 -frecursive -ffree-line-length-0 -fallow-argument-mismatch
 %PROD_FFLAGS         -O3
 %DEV_FFLAGS          -O
 %DEBUG_FFLAGS        -ffpe-trap=invalid,zero,overflow -fbounds-check -g3 -O0 -fstack-protector-all
-%MPI_FFLAGS -fcray-pointer -fallow-argument-mismatch
+%MPI_FFLAGS -fcray-pointer
 %OMP_FFLAGS      -fopenmp    
 %BASE_LD      -lfftw3
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-gfortran_CICLAD.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-gfortran_CICLAD.fcm	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-gfortran_CICLAD.fcm	(revision 4727)
@@ -1,4 +1,5 @@
 %COMPILER            $MPI_BIN/mpif90
 %LINK                $MPI_BIN/mpif90
+%FPP                 cpp
 %AR                  ar
 %ARFLAGS             rs
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_CICLAD.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_CICLAD.fcm	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_CICLAD.fcm	(revision 4727)
@@ -1,4 +1,5 @@
 %COMPILER            $MPI_BIN/mpif90
 %LINK                $MPI_BIN/mpif90
+%FPP                 cpp
 %AR                  ar
 %ARFLAGS             rs
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_LSCE.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_LSCE.fcm	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_LSCE.fcm	(revision 4727)
@@ -1,4 +1,5 @@
 %COMPILER            mpif90
 %LINK                mpif90
+%FPP                 cpp
 %AR                  ar
 %ARFLAGS             rs
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_LSCE.path
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_LSCE.path	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_LSCE.path	(revision 4727)
@@ -1,14 +1,27 @@
-NETCDF_LIBDIR="-L/usr/local/install/netcdf-4.3.2p/lib -lnetcdff -lnetcdf -L/usr/local/install/hdf5-1.8.9p/lib -lhdf5_hl -lhdf5 -lhdf5 -lz -lcurl"
-NETCDF_INCDIR=-I/usr/local/install/netcdf-4.3.2p/include
-NETCDF95_INCDIR=$LMDGCM/../../include
-NETCDF95_LIBDIR=$LMDGCM/../../lib
-IOIPSL_INCDIR="$LMDGCM/../../lib -I$LMDGCM/../IOIPSL/inc"
-IOIPSL_LIBDIR="$LMDGCM/../../lib -lioipsl -L$LMDGCM/../IOIPSL/lib" 
-ORCH_INCDIR=$LMDGCM/../../lib
-ORCH_LIBDIR=$LMDGCM/../../lib
-OASIS_INCDIR=
-OASIS_LIBDIR=
-INCA_LIBDIR=$LMDGCM/../INCA/config/lib
-INCA_INCDIR=$LMDGCM/../INCA/config/inc
-XIOS_INCDIR=$LMDGCM/../XIOS/inc
-XIOS_LIBDIR=$LMDGCM/../XIOS/lib
+NETCDF_INCDIR="-I/usr/local/install/netcdf-4.3.2p/include"
+NETCDF_LIBDIR="-L/usr/local/install/netcdf-4.3.2p/lib -L/usr/local/install/hdf5-1.8.9p/lib"
+NETCDF_LIB="-lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lhdf5 -lz -lcurl"
+
+NETCDF95_INCDIR=-I/home/orchideeshare/igcmg/Tools/NetCDF95.intel-fcomp.2020/include/NetCDF95
+NETCDF95_LIBDIR=-L/home/orchideeshare/igcmg/Tools/NetCDF95.intel-fcomp.2020/lib
+NETCDF95_LIB=-lnetcdf95
+
+IOIPSL_INCDIR="-I$LMDGCM/../../lib -I$LMDGCM/../IOIPSL/inc"
+IOIPSL_LIBDIR="-L$LMDGCM/../../lib -L$LMDGCM/../IOIPSL/lib"
+IOIPSL_LIB="-lioipsl"
+
+XIOS_INCDIR="-I$LMDGCM/../XIOS/inc"
+XIOS_LIBDIR="-L$LMDGCM/../XIOS/lib"
+XIOS_LIB="-lxios -lstdc++"
+
+ORCH_INCDIR="-I$LMDGCM/../../lib"
+ORCH_LIBDIR="-L$LMDGCM/../../lib"
+ORCH_LIB=
+
+OASIS_INCDIR="-I$LMDGCM/../../oasis3-mct/BLD/build/lib/psmile.MPI1"
+OASIS_LIBDIR="-L$LMDGCM/../../oasis3-mct/BLD/lib"
+OASIS_LIB="-lpsmile.MPI1 -lscrip -lmct -lmpeu"
+
+INCA_INCDIR="-I$LMDGCM/../INCA/build/inc"
+INCA_LIBDIR="-L$LMDGCM/../INCA/build/lib"
+INCA_LIB="-lchimie"
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_LSCE_2023.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_LSCE_2023.fcm	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_LSCE_2023.fcm	(revision 4727)
@@ -0,0 +1,17 @@
+%COMPILER            mpif90
+%LINK                mpif90
+%FPP                 cpp
+%AR                  ar
+%ARFLAGS             rs
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF             NC_DOUBLE 
+%BASE_FFLAGS         -i4 -r8 -auto -align all -fp-model precise -fimf-arch-consistency=true
+%PROD_FFLAGS         -O2 
+%DEV_FFLAGS          -p -g -O2 -traceback -fp-stack-check 
+%DEBUG_FFLAGS        -p -g -traceback -fp-stack-check -ftrapuv -check bounds
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp
+%BASE_LD             -i4 -r8 
+%MPI_LD
+%OMP_LD              -openmp
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_LSCE_2023.path
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_LSCE_2023.path	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_LSCE_2023.path	(revision 4727)
@@ -0,0 +1,27 @@
+NETCDF_INCDIR="-I $NETCDF4_DIR/include"
+NETCDF_LIBDIR="-L $NETCDF4_DIR/lib"
+NETCDF_LIB="-lnetcdff -lnetcdf "
+
+NETCDF95_INCDIR=-I/home/orchideeshare/igcmg/Tools/NetCDF95.intel-fcomp.2020/include/NetCDF95
+NETCDF95_LIBDIR=-L/home/orchideeshare/igcmg/Tools/NetCDF95.intel-fcomp.2020/lib
+NETCDF95_LIB=-lnetcdf95
+
+IOIPSL_INCDIR="-I$LMDGCM/../../lib -I$LMDGCM/../IOIPSL/inc"
+IOIPSL_LIBDIR="-L$LMDGCM/../../lib -L$LMDGCM/../IOIPSL/lib"
+IOIPSL_LIB="-lioipsl"
+
+XIOS_INCDIR="-I$LMDGCM/../XIOS/inc"
+XIOS_LIBDIR="-L$LMDGCM/../XIOS/lib"
+XIOS_LIB="-lxios -lstdc++"
+
+ORCH_INCDIR="-I$LMDGCM/../../lib"
+ORCH_LIBDIR="-L$LMDGCM/../../lib"
+ORCH_LIB=
+
+OASIS_INCDIR="-I$LMDGCM/../../oasis3-mct/BLD/build/lib/psmile.MPI1"
+OASIS_LIBDIR="-L$LMDGCM/../../oasis3-mct/BLD/lib"
+OASIS_LIB="-lpsmile.MPI1 -lscrip -lmct -lmpeu"
+
+INCA_INCDIR="-I$LMDGCM/../INCA/build/inc"
+INCA_LIBDIR="-L$LMDGCM/../INCA/build/lib"
+INCA_LIB="-lchimie"
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_MESOIPSL.env
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_MESOIPSL.env	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_MESOIPSL.env	(revision 4727)
@@ -8,3 +8,3 @@
 module load netcdf-fortran/4.5.3-mpi
 module load netcdf-c/4.7.4-mpi
-
+module load netcdf95
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_MESOIPSL.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_MESOIPSL.fcm	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_MESOIPSL.fcm	(revision 4727)
@@ -1,4 +1,5 @@
 %COMPILER            mpif90
 %LINK                mpif90
+%FPP                 cpp
 %AR                  ar
 %ARFLAGS             rs
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_MESOIPSL.path
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_MESOIPSL.path	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-ifort_MESOIPSL.path	(revision 4727)
@@ -1,5 +1,9 @@
 NETCDF_INCDIR="-I $NETCDF_FORTRAN_ROOT/include -I${HDF5_ROOT}/include"
 NETCDF_LIBDIR="-L${NETCDF_FORTRAN_ROOT}/lib -L${NETCDF_C_ROOT}/lib -L${HDF5_ROOT}"
-NETCDF_LIB="-lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz -lcurl -lstdc++"
+NETCDF_LIB="-lnetcdff -lnetcdf"
+
+NETCDF95_INCDIR=-I$NETCDF95_ROOT/include/NetCDF95
+NETCDF95_LIBDIR=-L$NETCDF95_ROOT/lib
+NETCDF95_LIB=-lnetcdf95
 
 IOIPSL_INCDIR="-I$LMDGCM/../../lib -I$LMDGCM/../IOIPSL/inc"
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-linux-32bit.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-linux-32bit.fcm	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-linux-32bit.fcm	(revision 4727)
@@ -1,4 +1,5 @@
 %COMPILER            pgf95
 %LINK                pgf95
+%FPP                 cpp
 %AR                  ar
 %ARFLAGS             rs
Index: /LMDZ6/branches/LMDZ_ECRad/arch/arch-pgf_CICLAD.fcm
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/arch/arch-pgf_CICLAD.fcm	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/arch/arch-pgf_CICLAD.fcm	(revision 4727)
@@ -1,4 +1,5 @@
 %COMPILER            $MPI_BIN/mpif90
 %LINK                $MPI_BIN/mpif90
+%FPP                 cpp
 %AR                  ar
 %ARFLAGS             rs
Index: /LMDZ6/branches/LMDZ_ECRad/bld.cfg
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/bld.cfg	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/bld.cfg	(revision 4727)
@@ -7,7 +7,4 @@
 # Build information
 # ------------------------------------------------------------------------------
-
-#Default value of FPP fortran preprocessor
-%FPP cpp
 
 inc arch.fcm
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/abort_gcm.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/abort_gcm.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/abort_gcm.F	(revision 4727)
@@ -12,9 +12,6 @@
       USE ioipsl_getincom
 #endif
-
-#ifdef CPP_XIOS
-    ! ug Pour les sorties XIOS
+ ! ug Pour les sorties XIOS
       USE wxios
-#endif
 
 #include "iniprint.h"
@@ -34,8 +31,8 @@
       write(lunout,*) 'in abort_gcm'
 
-#ifdef CPP_XIOS
-    !Fermeture propre de XIOS
-      CALL wxios_close()
-#endif
+      IF (using_xios) THEN
+!Fermeture propre de XIOS
+        CALL wxios_close()
+      ENDIF
 
 #ifdef CPP_IOIPSL
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/conf_gcm.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/conf_gcm.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/conf_gcm.F90	(revision 4727)
@@ -15,5 +15,5 @@
   USE comconst_mod, ONLY: dissip_deltaz, dissip_factz, dissip_zref, &
                           iflag_top_bound, mode_top_bound, tau_top_bound, &
-                          ngroup
+                          ngroup, maxlatfilter
   USE logic_mod, ONLY: fxyhypb, iflag_phys, ok_etat0, ok_gradsfile, &
                        ok_guide, ok_limit, ok_strato, purmats, read_start, &
@@ -310,4 +310,11 @@
   CALL getin('dissip_deltaz',dissip_deltaz )
   CALL getin('dissip_zref',dissip_zref )
+
+  ! maxlatfilter
+  maxlatfilter=-1.0
+  CALL getin('maxlatfilter',maxlatfilter)
+  if (maxlatfilter > 90) &
+       call abort_gcm("conf_gcm", 'maxlatfilter should be <=90', 1)
+
 
   ! ngroup
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/dynetat0.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/dynetat0.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/dynetat0.F90	(revision 4727)
@@ -161,5 +161,14 @@
       ELSE
          CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to its parent isotope concentration.', modname)
-         q(:,:,:,iq) = q(:,:,:,iqIsoPha(iName,iPhase))
+         ! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à
+         ! izone=izone_init (définie dans isotrac_mod) sont initialisés comme
+         ! les parents. Sinon, c'est nul.
+         ! j'ai fait ça en attendant, mais il faudrait initialiser proprement en
+         ! remplacant 1 par izone_init dans la ligne qui suit.
+         IF(tracers(iq)%iso_iZone == 1) THEN
+           q(:,:,:,iq) = q(:,:,:,iqIsoPha(iName,iPhase))
+         ELSE
+           q(:,:,:,iq) = 0.
+         END IF
       END IF
     !--------------------------------------------------------------------------------------------------------------------------
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/gcm.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/gcm.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/gcm.F90	(revision 4727)
@@ -14,8 +14,6 @@
 
 
-#ifdef CPP_XIOS
-  ! ug Pour les sorties XIOS
+! ug Pour les sorties XIOS
   USE wxios
-#endif
 
   USE filtreg_mod
@@ -156,7 +154,7 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-#ifdef CPP_XIOS
-  CALL wxios_init("LMDZ")
-#endif
+  IF (using_xios) THEN
+    CALL wxios_init("LMDZ")
+  ENDIF
 
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/replay3d.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/replay3d.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/replay3d.F90	(revision 4727)
@@ -182,5 +182,5 @@
 ! Initialisation de la parametrisation
 !---------------------------------------------------------------------
-      call get_ini_module
+      call call_ini_replay
 
 !---------------------------------------------------------------------
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/advn.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/advn.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/advn.F	(revision 4727)
@@ -146,7 +146,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "iniprint.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "iniprint.h"
 c
 c
@@ -263,7 +263,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "iniprint.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "iniprint.h"
 c
 c
@@ -359,7 +359,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "iniprint.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "iniprint.h"
 c
 c
@@ -746,8 +746,8 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "iniprint.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
+      INCLUDE "iniprint.h"
 c
 c
@@ -877,8 +877,8 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "iniprint.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
+      INCLUDE "iniprint.h"
 c
 c
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/advz.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/advz.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/advz.F	(revision 4727)
@@ -24,5 +24,5 @@
       include "paramet.h"
 
-C    #include "traceur.h"
+C     INCLUDE "traceur.h"
 
 C  Arguments :
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/comconst_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/comconst_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/comconst_mod.F90	(revision 4727)
@@ -26,4 +26,5 @@
       INTEGER iflag_top_bound ! sponge type
       INTEGER ngroup ! parameter to group points (along longitude) near poles
+      REAL maxlatfilter ! maximum latitude (in degrees) above which filter is active
       INTEGER mode_top_bound  ! sponge mode
       REAL tau_top_bound ! inverse of sponge characteristic time scale (Hz)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/convflu.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/convflu.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/convflu.F	(revision 4727)
@@ -20,6 +20,6 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
       REAL       xflu,yflu,convfl,convpn,convps
       INTEGER    l,ij,nbniv
@@ -30,5 +30,5 @@
 c
 c
-#include "comgeom.h"
+      INCLUDE "comgeom.h"
 c
       DO 5 l = 1,nbniv
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/diagedyn.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/diagedyn.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/diagedyn.F	(revision 4727)
@@ -57,12 +57,12 @@
       IMPLICIT NONE
 C
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "iniprint.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
+      INCLUDE "iniprint.h"
 
 !#ifdef CPP_EARTH
-!#include "../phylmd/YOMCST.h"
-!#include "../phylmd/YOETHF.h"
+!      INCLUDE "../phylmd/YOMCST.h"
+!      INCLUDE "../phylmd/YOETHF.h"
 !#endif
 ! Ehouarn: for now set these parameters to what is in Earth physics...
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/diverg.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/diverg.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/diverg.F	(revision 4727)
@@ -22,7 +22,7 @@
 c
 c   ---------------------------------------------------------------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 c
 c    ..........          variables en arguments    ...................
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/diverg_gam.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/diverg_gam.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/diverg_gam.F	(revision 4727)
@@ -23,7 +23,7 @@
 c
 c   ---------------------------------------------------------------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 c
 c    ..........          variables en arguments    ...................
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/divergf.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/divergf.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/divergf.F	(revision 4727)
@@ -22,7 +22,7 @@
 c
 c   ---------------------------------------------------------------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 c
 c    ..........          variables en arguments    ...................
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/divergst.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/divergst.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/divergst.F	(revision 4727)
@@ -17,7 +17,7 @@
 c   -------------------------------------------------------------------
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
       INTEGER klevel
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/divgrad2.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/divgrad2.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/divgrad2.F	(revision 4727)
@@ -15,8 +15,8 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom2.h"
-#include "comdissipn.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom2.h"
+      INCLUDE "comdissipn.h"
 
 c    .......    variables en arguments   .......
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/fxy.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/fxy.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/fxy.F	(revision 4727)
@@ -27,5 +27,5 @@
      , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
 
-#include "fxy_new.h"
+      INCLUDE "fxy_new.h"
 
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/fxysinus.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/fxysinus.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/fxysinus.F	(revision 4727)
@@ -16,6 +16,6 @@
 c
 c
-#include "dimensions.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
 
        INTEGER i,j
@@ -26,5 +26,5 @@
      , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
 
-#include "fxy_sin.h"
+      INCLUDE "fxy_sin.h"
 
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/gr_u_scal.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/gr_u_scal.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/gr_u_scal.F	(revision 4727)
@@ -30,7 +30,7 @@
 c   ---------------
 
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
 c   Arguments:
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/gr_v_scal.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/gr_v_scal.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/gr_v_scal.F	(revision 4727)
@@ -30,7 +30,7 @@
 c   ---------------
 
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
 c   Arguments:
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/grad.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/grad.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/grad.F	(revision 4727)
@@ -15,6 +15,6 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
       INTEGER klevel
       REAL  pg( ip1jmp1,klevel )
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/gradiv2.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/gradiv2.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/gradiv2.F	(revision 4727)
@@ -18,8 +18,8 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "comdissipn.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
+      INCLUDE "comdissipn.h"
 c
 c     ........    variables en arguments      ........
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/infotrac.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/infotrac.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/infotrac.F90	(revision 4727)
@@ -36,5 +36,5 @@
 !  |--------------------+-----------------------+-----------------+---------------+----------------------------|
 !  | water in different |    water tagging      |  water isotopes | other tracers | additional tracers moments |
-!  | phases: H2O_[gls]  |      isotopes         |                 |               |  for higher order schemes  |
+!  | phases: H2O_[glsb] |      isotopes         |                 |               |  for higher order schemes  |
 !  |--------------------+-----------------------+-----------------+---------------+----------------------------|
 !  |                    |                       |                 |               |                            |
@@ -65,5 +65,5 @@
 !  | 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)                                     | /           |                        |
@@ -91,5 +91,5 @@
 !  | 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         |
@@ -162,4 +162,5 @@
    TYPE(trac_type), POINTER             :: t1, t(:)
    INTEGER :: ierr
+   CHARACTER(LEN=maxlen),   ALLOCATABLE :: types_trac(:)  !--- Keyword for tracers type(s), parsed version
 
    CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac"
@@ -175,4 +176,12 @@
    CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
 
+   lerr=strParse(type_trac, '|', types_trac, n=nt)
+   IF (nt .GT. 1) THEN
+      IF (nt .GT. 2) CALL abort_gcm(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
+      if (nt .EQ. 2) type_trac=types_trac(2)
+   ENDIF
+
+
+   
    !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
    msg1 = 'For type_trac = "'//TRIM(type_trac)//'":'
@@ -227,5 +236,5 @@
       nbtr = nqINCA + nqCO2                                          !--- Number of tracers passed to phytrac
       nqtrue = nbtr + nqo                                            !--- Total number of "true" tracers
-      IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
+      IF(ALL([2,3,4,5] /= nqo)) CALL abort_gcm(modname, 'Only 2, 3, 4 , 5 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
       ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
       ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA),  pbl_flg_inca(nqINCA))
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/inigrads.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/inigrads.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/inigrads.F	(revision 4727)
@@ -16,5 +16,5 @@
       character(len=*),intent(in) :: titlel
 
-#include "gradsdef.h"
+      INCLUDE "gradsdef.h"
 
 c     data unit/66,32,34,36,38,40,42,44,46,48/
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/laplacien.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/laplacien.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/laplacien.F	(revision 4727)
@@ -14,7 +14,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
 c
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/laplacien_gam.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/laplacien_gam.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/laplacien_gam.F	(revision 4727)
@@ -16,7 +16,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
 c
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/laplacien_rot.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/laplacien_rot.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/laplacien_rot.F	(revision 4727)
@@ -15,7 +15,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
 c 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/laplacien_rotgam.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/laplacien_rotgam.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/laplacien_rotgam.F	(revision 4727)
@@ -14,7 +14,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
 c
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/nxgrad.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/nxgrad.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/nxgrad.F	(revision 4727)
@@ -14,7 +14,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
       INTEGER klevel
       REAL rot( ip1jm,klevel ),x( ip1jmp1,klevel ),y(ip1jm,klevel )
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/nxgrad_gam.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/nxgrad_gam.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/nxgrad_gam.F	(revision 4727)
@@ -14,7 +14,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
       INTEGER klevel
       REAL rot( ip1jm,klevel ),x( ip1jmp1,klevel ),y(ip1jm,klevel )
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/nxgradst.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/nxgradst.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/nxgradst.F	(revision 4727)
@@ -13,7 +13,7 @@
 c       x  et y    sont des arguments de sortie pour le s-prog
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
       INTEGER klevel
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/nxgraro2.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/nxgraro2.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/nxgraro2.F	(revision 4727)
@@ -17,7 +17,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comdissipn.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comdissipn.h"
 c
 c    ......  variables en arguments  .......
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/pbar.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/pbar.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/pbar.F	(revision 4727)
@@ -75,8 +75,8 @@
 
 
-#include "dimensions.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
 
-#include "comgeom.h"
+      INCLUDE "comgeom.h"
 
       REAL pext( ip1jmp1 ),  pbarx ( ip1jmp1 )
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/psextbar.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/psextbar.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/psextbar.F	(revision 4727)
@@ -75,7 +75,7 @@
 
 
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
       REAL ps( ip1jmp1 ), psexbarxy ( ip1jm ), pext( ip1jmp1 )
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/rotat.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/rotat.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/rotat.F	(revision 4727)
@@ -15,7 +15,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 c
 c   .....  variables en arguments  ......
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/rotat_nfil.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/rotat_nfil.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/rotat_nfil.F	(revision 4727)
@@ -15,7 +15,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 c
 c   .....  variables en arguments  ......
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/rotatf.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/rotatf.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/rotatf.F	(revision 4727)
@@ -16,7 +16,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 c
 c   .....  variables en arguments  ......
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/rotatst.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/rotatst.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/rotatst.F	(revision 4727)
@@ -16,6 +16,6 @@
 c
       INTEGER klevel
-#include "dimensions.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
 
       REAL rot( ip1jm,klevel )
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/test_period.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/test_period.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/test_period.F	(revision 4727)
@@ -13,6 +13,6 @@
 c     IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
 c
 c    ......  Arguments   ......
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/abort_gcm.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/abort_gcm.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/abort_gcm.F	(revision 4727)
@@ -13,5 +13,5 @@
 #endif
       USE parallel_lmdz
-#include "iniprint.h"
+      INCLUDE "iniprint.h"
  
 C
@@ -47,11 +47,13 @@
       else
         write(lunout,*) 'Houston, we have a problem, ierr = ', ierr
-#ifdef CPP_MPI
+
+        if (using_mpi) THEN
 C$OMP CRITICAL (MPI_ABORT_GCM)
-        call MPI_ABORT(COMM_LMDZ, 1, ierror_mpi)
+          call MPI_ABORT(COMM_LMDZ, 1, ierror_mpi)
 C$OMP END CRITICAL (MPI_ABORT_GCM)
-#else
-        stop 1
-#endif          
+        else
+         stop 1
+        endif          
+      
       endif
       END
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/bilan_dyn_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/bilan_dyn_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/bilan_dyn_loc.F	(revision 4727)
@@ -141,7 +141,6 @@
       character*10 infile
 
-      integer fileid
+      integer, save :: fileid
       integer thoriid, zvertiid
-      save fileid
 
       INTEGER,SAVE,ALLOCATABLE :: ndex3d(:)
@@ -838,4 +837,8 @@
 c/////////////////////////////////////////////////////////////////////
 c=====================================================================
+!$OMP MASTER
+      call histsync(fileid)
+!$OMP END MASTER
+
 
       return
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/conf_gcm.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/conf_gcm.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/conf_gcm.F90	(revision 4727)
@@ -19,5 +19,5 @@
   USE comconst_mod, ONLY: dissip_deltaz, dissip_factz, dissip_zref, &
                           iflag_top_bound, mode_top_bound, tau_top_bound, &
-                          ngroup
+                          ngroup, maxlatfilter
   USE logic_mod, ONLY: fxyhypb, iflag_phys, ok_etat0, ok_gradsfile, &
                        ok_guide, ok_limit, ok_strato, purmats, read_start, &
@@ -25,5 +25,5 @@
   USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, &
                        alphax,alphay,taux,tauy
-  USE temps_mod, ONLY: calend, year_len
+  USE temps_mod, ONLY: calend, year_len, offline_time
 
   IMPLICIT NONE
@@ -341,4 +341,12 @@
   CALL getin('dissip_zref',dissip_zref )
 
+
+  !maxlatfilter
+  maxlatfilter = -1.0
+  CALL getin('maxlatfilter',maxlatfilter)
+  if (maxlatfilter > 90) &
+       call abort_gcm("conf_gcm", 'maxlatfilter should be <=90', 1)
+  
+
   ! ngroup
   ngroup=3
@@ -620,10 +628,18 @@
 
      !Config  Key  = offline
-     !Config  Desc = Nouvelle eau liquide
+     !Config  Desc = ecriture des flux de masse
      !Config  Def  = n
-     !Config  Help = Permet de mettre en route la
-     !Config         nouvelle parametrisation de l'eau liquide !
+     !Config  Help = Permet de sortir les flux de masse sur la grille plev 
      offline = .FALSE.
      CALL getin('offline',offline)
+
+     !Config Key  = offline_time
+     !Config Desc =  Choix des frequences de stockage pour le offline
+     !Config Def  = 8
+     !Config Help = offline_time=12     ! stockage toutes les 2h=1jour/12
+     !Config Help = offline_time=8      ! stockage toutes les 3h=1jour/8
+     offline_time = 8
+     CALL getin('offline_time',offline_time)
+
      IF (offline .AND. adjust) THEN
         WRITE(lunout,*)  &
@@ -714,4 +730,5 @@
      write(lunout,*)' tauyy = ', tauyy
      write(lunout,*)' offline = ', offline
+     write(lunout,*)' offline_time = ', offline_time
      write(lunout,*)' type_trac = ', type_trac
      write(lunout,*)' ok_dynzon = ', ok_dynzon 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/convflu_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/convflu_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/convflu_loc.F	(revision 4727)
@@ -18,6 +18,6 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
       REAL       xflu,yflu,convfl,convpn,convps
       INTEGER    l,ij,nbniv
@@ -30,5 +30,5 @@
 c
 c
-#include "comgeom.h"
+      INCLUDE "comgeom.h"
 c
      
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/covcont_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/covcont_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/covcont_loc.F	(revision 4727)
@@ -17,7 +17,7 @@
 c=======================================================================
 
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
       INTEGER klevel
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/covnat_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/covnat_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/covnat_loc.F	(revision 4727)
@@ -20,7 +20,7 @@
 c=======================================================================
 
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
       INTEGER klevel
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/diverg_gam_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/diverg_gam_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/diverg_gam_loc.F	(revision 4727)
@@ -21,7 +21,7 @@
 c
 c   ---------------------------------------------------------------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 c
 c    ..........          variables en arguments    ...................
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/diverg_p.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/diverg_p.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/diverg_p.F	(revision 4727)
@@ -20,7 +20,7 @@
 c
 c   ---------------------------------------------------------------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 c
 c    ..........          variables en arguments    ...................
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/divergf_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/divergf_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/divergf_loc.F	(revision 4727)
@@ -21,7 +21,7 @@
 c
 c   ---------------------------------------------------------------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 c
 c    ..........          variables en arguments    ...................
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/divgrad2_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/divgrad2_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/divgrad2_loc.F	(revision 4727)
@@ -16,8 +16,8 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom2.h"
-#include "comdissipn.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom2.h"
+      INCLUDE "comdissipn.h"
 
 c    .......    variables en arguments   .......
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/dudv1_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/dudv1_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/dudv1_loc.F	(revision 4727)
@@ -17,6 +17,6 @@
 c-----------------------------------------------------------------------
 
-#include "dimensions.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
 
       REAL vorpot( ijb_v:ije_v,llm ) ,pbaru( ijb_u:ije_u,llm ) ,
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/dynetat0_loc.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/dynetat0_loc.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/dynetat0_loc.F90	(revision 4727)
@@ -183,7 +183,18 @@
          CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized with a simplified Rayleigh distillation law.', modname)
          q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqParent)*tnat*(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal-1.)
+         ! Camille 9 mars 2023: point de vigilence: initialisation incohérente
+         ! avec celle de xt_ancien dans la physiq.
       ELSE
          CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to its parent isotope concentration.', modname)
-         q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase))
+         ! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à
+         ! izone=izone_init (définie dans isotrac_mod) sont initialisés comme
+         ! les parents. Sinon, c'est nul.
+         ! j'ai fait ça en attendant, mais il faudrait initialiser proprement en
+         ! remplacant 1 par izone_init dans la ligne qui suit.
+         IF(tracers(iq)%iso_iZone == 1) THEN
+          q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase))
+         ELSE
+           q(ijb_u:ije_u,:,iq) =  0.
+         ENDIF
       END IF
     !--------------------------------------------------------------------------------------------------------------------------
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/filtreg_p.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/filtreg_p.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/filtreg_p.F	(revision 4727)
@@ -51,7 +51,7 @@
 c
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "coefils.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "coefils.h"
 c
       INTEGER ibeg,iend,nlat,nbniv,ifiltre,iter
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/gcm.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/gcm.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/gcm.F90	(revision 4727)
@@ -28,7 +28,5 @@
                        itau_dyn,itau_phy,day_ini,jD_ref,jH_ref,day_end, &
                        dt,hour_ini,itaufin
-#ifdef CPP_XIOS
   USE mod_xios_dyn3dmem, ONLY: xios_dyn3dmem_init
-#endif
 
   IMPLICIT NONE
@@ -457,10 +455,8 @@
 
 ! setting up DYN3D/XIOS inerface
-#ifdef CPP_XIOS
-   if (ok_dyn_xios) then
-     CALL xios_dyn3dmem_init(xios_cal_type, anref, moisref, jourref,heureref, an,   &
+  if (ok_dyn_xios) then
+      CALL xios_dyn3dmem_init(xios_cal_type, anref, moisref, jourref,heureref, an,   &
           mois, jour, heure, zdtvr)
   endif
-#endif
 
   ! #endif of #ifdef CPP_IOIPSL
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/gr_u_scal_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/gr_u_scal_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/gr_u_scal_loc.F	(revision 4727)
@@ -31,7 +31,7 @@
 c   ---------------
 
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
 c   Arguments:
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/gr_v_scal_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/gr_v_scal_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/gr_v_scal_loc.F	(revision 4727)
@@ -31,7 +31,7 @@
 c   ---------------
 
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
 c   Arguments:
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/grad_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/grad_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/grad_loc.F	(revision 4727)
@@ -13,6 +13,6 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
       INTEGER klevel
       REAL  pg( ijb_u:ije_u,klevel )
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/grad_p.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/grad_p.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/grad_p.F	(revision 4727)
@@ -13,6 +13,6 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
       INTEGER klevel
       REAL  pg( ip1jmp1,klevel )
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/gradiv2_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/gradiv2_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/gradiv2_loc.F	(revision 4727)
@@ -21,8 +21,8 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "comdissipn.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
+      INCLUDE "comdissipn.h"
 c
 c     ........    variables en arguments      ........
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/laplacien_gam_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/laplacien_gam_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/laplacien_gam_loc.F	(revision 4727)
@@ -14,7 +14,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
 c
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/laplacien_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/laplacien_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/laplacien_loc.F	(revision 4727)
@@ -13,7 +13,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
 c
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/laplacien_rot_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/laplacien_rot_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/laplacien_rot_loc.F	(revision 4727)
@@ -14,7 +14,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
 c 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/laplacien_rotgam_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/laplacien_rotgam_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/laplacien_rotgam_loc.F	(revision 4727)
@@ -12,7 +12,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 
 c
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/leapfrog_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/leapfrog_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/leapfrog_loc.F	(revision 4727)
@@ -42,7 +42,8 @@
        USE temps_mod, ONLY: itaufin,jD_ref,jH_ref,day_ini,
      &                        day_ref,start_time,dt
-#ifdef CPP_XIOS
-       USE xios, ONLY: xios_update_calendar 
-#endif
+       USE mod_xios_dyn3dmem, ONLY : dyn3d_ctx_handle
+       USE lmdz_xios, ONLY: xios_update_calendar, 
+     &                      xios_set_current_context, 
+     &                      using_xios
        
       IMPLICIT NONE
@@ -1519,5 +1520,13 @@
 
 #ifdef INCA
-         if (ANY(type_trac == ['inca','inco'])) CALL finalize_inca
+         IF (ANY(type_trac == ['inca','inco'])) THEN
+            CALL finalize_inca
+!     switching back to LMDZDYN context
+!$OMP MASTER
+            IF (ok_dyn_xios) THEN
+               CALL xios_set_current_context(dyn3d_ctx_handle)
+            ENDIF
+!$OMP END MASTER
+         ENDIF
 #endif
 #ifdef REPROBUS
@@ -1568,5 +1577,13 @@
 
 #ifdef INCA
-              if (ANY(type_trac == ['inca','inco'])) CALL finalize_inca
+              IF (ANY(type_trac == ['inca','inco'])) THEN
+                 CALL finalize_inca
+!     switching back to LMDZDYN context
+!$OMP MASTER
+                 IF (ok_dyn_xios) THEN
+                    CALL xios_set_current_context(dyn3d_ctx_handle)
+                 ENDIF
+!$OMP END MASTER
+              ENDIF
 #endif
 #ifdef REPROBUS
@@ -1640,5 +1657,4 @@
 #endif
              
-#ifdef CPP_XIOS
               IF (ok_dyn_xios) THEN
 c$OMP MASTER
@@ -1649,5 +1665,4 @@
      &                 ucov,teta,pk,phi,q,masse,ps,phis)
               ENDIF
-#endif
               
           endif                 ! of if (leapf.or.(.not.leapf.and.(.not.forward)))
@@ -1735,5 +1750,14 @@
 
 #ifdef INCA
-              if (ANY(type_trac == ['inca','inco'])) CALL finalize_inca
+                 IF (ANY(type_trac == ['inca','inco'])) THEN
+                    CALL finalize_inca
+!     switching back to LMDZDYN context
+!$OMP MASTER
+                    IF (ok_dyn_xios) THEN
+                       CALL xios_set_current_context(dyn3d_ctx_handle)
+                    ENDIF
+!$OMP END MASTER
+                 ENDIF
+
 #endif
 #ifdef REPROBUS
@@ -1801,5 +1825,4 @@
 #endif
 
-#ifdef CPP_XIOS
               IF (ok_dyn_xios) THEN
 c$OMP MASTER
@@ -1810,5 +1833,4 @@
      &                 ucov,teta,pk,phi,q,masse,ps,phis)
               ENDIF
-#endif
               
            ENDIF                ! of IF(MOD(itau,iecri).EQ.0)
@@ -1842,5 +1864,14 @@
 
 #ifdef INCA
-      if (ANY(type_trac == ['inca','inco'])) CALL finalize_inca
+      IF (ANY(type_trac == ['inca','inco'])) THEN
+         CALL finalize_inca
+!     switching back to LMDZDYN context
+!$OMP MASTER
+         IF (ok_dyn_xios) THEN
+            CALL xios_set_current_context(dyn3d_ctx_handle)
+         ENDIF
+!$OMP END MASTER
+      ENDIF
+
 #endif
 #ifdef REPROBUS
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/mod_const_mpi.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/mod_const_mpi.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/mod_const_mpi.F90	(revision 4727)
@@ -11,4 +11,6 @@
 
   SUBROUTINE Init_const_mpi
+    USE lmdz_mpi
+
 #ifdef CPP_IOIPSL
     USE IOIPSL, ONLY: getin
@@ -21,11 +23,6 @@
     USE mod_prism
 #endif
-#ifdef CPP_XIOS
-    USE wxios, only: wxios_init
-#endif
+    USE wxios, only: wxios_init, using_xios
     IMPLICIT NONE
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
 
     INTEGER             :: ierr
@@ -41,37 +38,32 @@
 !$OMP BARRIER
 
-    IF (type_ocean=='couple') THEN
+    IF (using_mpi) THEN
+      IF (type_ocean=='couple') THEN
 #ifdef CPP_COUPLE
 !$OMP MASTER
-#ifdef CPP_XIOS
-      CALL wxios_init("LMDZ", outcom=COMM_LMDZ, type_ocean=type_ocean)
-#else
-       CALL prism_init_comp_proto (comp_id, 'LMDZ', ierr)
-       CALL prism_get_localcomm_proto(COMM_LMDZ,ierr)
-#endif
+        IF (using_xios) THEN
+          CALL wxios_init("LMDZ", outcom=COMM_LMDZ, type_ocean=type_ocean)
+        ELSE
+          CALL prism_init_comp_proto (comp_id, 'LMDZ', ierr)
+          CALL prism_get_localcomm_proto(COMM_LMDZ,ierr)
+        ENDIF
 !$OMP END MASTER
 #endif
-#ifdef CPP_MPI
-      MPI_REAL_LMDZ=MPI_REAL8
-#endif
-    ELSE
-      CALL init_mpi
+        MPI_REAL_LMDZ=MPI_REAL8
+      ELSE
+        CALL init_mpi
+      ENDIF
     ENDIF
-
   END SUBROUTINE Init_const_mpi
   
   SUBROUTINE Init_mpi
-#ifdef CPP_XIOS
-    USE wxios, only: wxios_init
-#endif
+    USE lmdz_mpi
+    USE wxios, only: wxios_init, using_xios
+
   IMPLICIT NONE
-#ifdef CPP_MPI
-     INCLUDE 'mpif.h'
-#endif
     INTEGER             :: ierr
     INTEGER             :: thread_required
     INTEGER             :: thread_provided
 
-#ifdef CPP_MPI
 !$OMP MASTER
       thread_required=MPI_THREAD_SERIALIZED
@@ -87,18 +79,11 @@
 ! Initialisation de XIOS
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-#ifdef CPP_XIOS
-      WRITE(*,*)'IN Init_mpi call wxios_init'
-      CALL wxios_init("LMDZ", outcom=COMM_LMDZ)
-#endif
+      IF (using_xios) THEN
+        WRITE(*,*)'IN Init_mpi call wxios_init'
+        CALL wxios_init("LMDZ", outcom=COMM_LMDZ)
+      ENDIF
 !$OMP END MASTER
-#else
-#ifdef CPP_XIOS
-!$OMP MASTER
-      CALL wxios_init("LMDZ")
-!$OMP END MASTER
-#endif
-#endif
 
-   END SUBROUTINE Init_mpi
+END SUBROUTINE Init_mpi
     
 END MODULE mod_const_mpi
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/mod_filtreg_p.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/mod_filtreg_p.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/mod_filtreg_p.F	(revision 4727)
@@ -55,7 +55,7 @@
 c
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "coefils.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "coefils.h"
 c
       INTEGER,INTENT(IN) :: jjb,jje,ibeg,iend,nlat,nbniv,ifiltre,iter
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/mod_hallo.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/mod_hallo.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/mod_hallo.F90	(revision 4727)
@@ -106,15 +106,9 @@
   
   SUBROUTINE create_global_mpi_buffer
+  USE lmdz_mpi
   IMPLICIT NONE
-#ifdef CPP_MPI
-  INCLUDE 'mpif.h'
-#endif  
     POINTER (Pbuffer,MPI_Buffer(MaxBufferSize))
     REAL :: MPI_Buffer
-#ifdef CPP_MPI
     INTEGER(KIND=MPI_ADDRESS_KIND) :: BS 
-#else
-    INTEGER(KIND=8) :: BS
-#endif
     INTEGER :: i,ierr
 
@@ -122,7 +116,5 @@
       Bs=8*MaxBufferSize
 !$OMP CRITICAL (MPI)
-#ifdef CPP_MPI
       CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
-#endif
 !$OMP END CRITICAL (MPI)
       DO i=1,MaxBufferSize
@@ -1157,9 +1149,7 @@
   subroutine Register_Hallo(Field,ij,ll,RUp,Rdown,SUp,SDown,a_request)
   USE dimensions_mod
+  USE lmdz_mpi
       implicit none
 
-#ifdef CPP_MPI
-    include 'mpif.h'
-#endif    
       INTEGER :: ij,ll
       REAL, dimension(ij,ll) :: Field
@@ -1224,8 +1214,6 @@
   subroutine Register_Hallo_u(Field,ll,RUp,Rdown,SUp,SDown,a_request)
   USE dimensions_mod
+  USE lmdz_mpi
       implicit none
-#ifdef CPP_MPI
-    include 'mpif.h'
-#endif    
       INTEGER :: ll
       REAL, dimension(ijb_u:ije_u,ll) :: Field
@@ -1289,8 +1277,6 @@
   subroutine Register_Hallo_v(Field,ll,RUp,Rdown,SUp,SDown,a_request)
   USE dimensions_mod
+  USE lmdz_mpi
       implicit none
-#ifdef CPP_MPI
-    include 'mpif.h'
-#endif    
       INTEGER :: ll
       REAL, dimension(ijb_v:ije_v,ll) :: Field
@@ -1354,9 +1340,6 @@
     subroutine SendRequest(a_Request)
     USE dimensions_mod
+    USE lmdz_mpi
       implicit none
-
-#ifdef CPP_MPI
-      include 'mpif.h'
-#endif
 
       type(request),target :: a_request
@@ -1410,8 +1393,6 @@
 !$OMP CRITICAL (MPI)
          
-#ifdef CPP_MPI
          call MPI_ISEND(Buffer(req%Pos),SizeBuffer,MPI_REAL_LMDZ,rank,a_request%tag+1000*omp_rank,     &
                          COMM_LMDZ,Req%MSG_Request,ierr)
-#endif
          IF (.NOT.using_mpi) THEN
            PRINT *,'Erreur, echange MPI en mode sequentiel !!!'
@@ -1453,8 +1434,7 @@
 !$OMP CRITICAL (MPI)
 
-#ifdef CPP_MPI
              call MPI_IRECV(Buffer(Req%Pos),SizeBuffer,MPI_REAL_LMDZ,rank,a_request%tag+1000*omp_rank,     &
                            COMM_LMDZ,Req%MSG_Request,ierr)
-#endif             
+
              IF (.NOT.using_mpi) THEN
                PRINT *,'Erreur, echange MPI en mode sequentiel !!!'
@@ -1478,9 +1458,6 @@
    subroutine WaitRequest(a_Request)
    USE dimensions_mod
+   USE lmdz_mpi
    implicit none
-   
-#ifdef CPP_MPI
-      include 'mpif.h'   
-#endif
       
       type(request),target :: a_request
@@ -1488,9 +1465,5 @@
       type(Hallo),pointer :: PtrHallo
       integer, dimension(2*mpi_size) :: TabRequest
-#ifdef CPP_MPI
       integer, dimension(MPI_STATUS_SIZE,2*mpi_size) :: TabStatus
-#else
-      integer, dimension(1,2*mpi_size) :: TabStatus
-#endif
       integer :: NbRequest
       integer :: i,rank,pos,ij,l,ierr
@@ -1521,7 +1494,5 @@
 !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
 !        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
-#ifdef CPP_MPI
         call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
-#endif
 !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
 !        PRINT *,"-------------------------------------------------------------------"
@@ -1571,19 +1542,13 @@
      
    subroutine WaitSendRequest(a_Request)
+   USE lmdz_mpi
    USE dimensions_mod
    implicit none
    
-#ifdef CPP_MPI
-      include 'mpif.h'   
-#endif      
       type(request),target :: a_request
       type(request_SR),pointer :: Req
       type(Hallo),pointer :: PtrHallo
       integer, dimension(mpi_size) :: TabRequest
-#ifdef CPP_MPI
       integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus
-#else
-      integer, dimension(1,mpi_size) :: TabStatus
-#endif
       integer :: NbRequest
       integer :: i,rank,pos,ij,l,ierr
@@ -1606,7 +1571,5 @@
 !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
 !        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
-#ifdef CPP_MPI
-        call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
-#endif
+         call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
 !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
 !        PRINT *,"-------------------------------------------------------------------"
@@ -1628,19 +1591,11 @@
    subroutine WaitRecvRequest(a_Request)
    USE dimensions_mod
+   USE lmdz_mpi
    implicit none
-   
-#ifdef CPP_MPI
-      include 'mpif.h'   
-#endif
-      
       type(request),target :: a_request
       type(request_SR),pointer :: Req
       type(Hallo),pointer :: PtrHallo
       integer, dimension(mpi_size) :: TabRequest
-#ifdef CPP_MPI
       integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus
-#else
-      integer, dimension(1,mpi_size) :: TabStatus
-#endif
       integer :: NbRequest
       integer :: i,rank,pos,ij,l,ierr
@@ -1664,7 +1619,5 @@
 !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
 !        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
-#ifdef CPP_MPI
-        call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
-#endif
+         call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
 !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
 !        PRINT *,"-------------------------------------------------------------------"
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/mod_xios_dyn3dmem.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/mod_xios_dyn3dmem.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/mod_xios_dyn3dmem.F90	(revision 4727)
@@ -12,9 +12,8 @@
 !
 !
-#ifdef CPP_XIOS
 
 MODULE mod_xios_dyn3dmem
 
-     USE xios
+     USE lmdz_xios
      USE wxios, ONLY : g_comm
      CHARACTER(len=100), SAVE :: dyn3d_ctx_name = "LMDZDYN"
@@ -259,4 +258,3 @@
    
 END MODULE mod_xios_dyn3dmem 
-#endif
-
+
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/nxgrad_gam_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/nxgrad_gam_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/nxgrad_gam_loc.F	(revision 4727)
@@ -13,7 +13,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
       INTEGER klevel
       REAL rot( ijb_v:ije_v,klevel )
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/nxgrad_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/nxgrad_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/nxgrad_loc.F	(revision 4727)
@@ -12,7 +12,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
       INTEGER klevel
       REAL rot( ijb_v:ije_v,klevel ),x( ijb_u:ije_u,klevel )
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/nxgraro2_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/nxgraro2_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/nxgraro2_loc.F	(revision 4727)
@@ -20,7 +20,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comdissipn.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comdissipn.h"
 c
 c    ......  variables en arguments  .......
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/parallel_lmdz.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/parallel_lmdz.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/parallel_lmdz.F90	(revision 4727)
@@ -4,4 +4,5 @@
   MODULE parallel_lmdz
   USE mod_const_mpi
+  USE lmdz_mpi, ONLY : using_mpi
 #ifdef CPP_IOIPSL
       use IOIPSL
@@ -12,5 +13,4 @@
     INTEGER,PARAMETER :: halo_max=3
     
-    LOGICAL,SAVE :: using_mpi ! .true. if using MPI
     LOGICAL,SAVE :: using_omp ! .true. if using OpenMP
     LOGICAL,SAVE :: is_master ! .true. if the core is both MPI & OpenMP master
@@ -88,11 +88,9 @@
     subroutine init_parallel
     USE vampir
+    USE lmdz_mpi
     implicit none
-#ifdef CPP_MPI
-      include 'mpif.h'
-#endif
-#include "dimensions.h"
-#include "paramet.h"
-#include "iniprint.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "iniprint.h"
 
       integer :: ierr
@@ -111,11 +109,4 @@
 #endif  
 
-#ifdef CPP_MPI
-       using_mpi=.TRUE.
-#else
-       using_mpi=.FALSE.
-#endif
-      
-
 #ifdef CPP_OMP
        using_OMP=.TRUE.
@@ -127,8 +118,6 @@
       
       IF (using_mpi) THEN
-#ifdef CPP_MPI
         call MPI_COMM_SIZE(COMM_LMDZ,mpi_size,ierr)
         call MPI_COMM_RANK(COMM_LMDZ,mpi_rank,ierr)
-#endif
       ELSE
         mpi_size=1
@@ -161,7 +150,6 @@
          write(lunout,*)" ---> diminuez le nombre de CPU ou augmentez la taille en lattitude"
           
-#ifdef CPP_MPI
           IF (using_mpi) call MPI_ABORT(COMM_LMDZ,-1, ierr)
-#endif          
+
         endif
         
@@ -395,8 +383,8 @@
     
     subroutine Finalize_parallel
-#ifdef CPP_XIOS
+    USE lmdz_mpi
     ! ug Pour les sorties XIOS
-	USE wxios
-#endif
+  	USE wxios
+
 #ifdef CPP_COUPLE
 ! Use of Oasis-MCT coupler 
@@ -418,7 +406,4 @@
       include "dimensions.h"
       include "paramet.h"
-#ifdef CPP_MPI
-      include 'mpif.h'
-#endif      
 
       integer :: ierr
@@ -430,23 +415,21 @@
 
       if (type_ocean == 'couple') then
-#ifdef CPP_XIOS
-    !Fermeture propre de XIOS
-      CALL wxios_close()
-#else
+        IF (using_xios) THEN
+          !Fermeture propre de XIOS
+          CALL wxios_close()
+        ELSE
 #ifdef CPP_COUPLE
-         call prism_terminate_proto(ierr)
-         IF (ierr .ne. PRISM_Ok) THEN
-            call abort_gcm('Finalize_parallel',' Probleme dans prism_terminate_proto ',1)
-         endif
+           call prism_terminate_proto(ierr)
+           IF (ierr .ne. PRISM_Ok) THEN
+              call abort_gcm('Finalize_parallel',' Probleme dans prism_terminate_proto ',1)
+           endif
 #endif 
-#endif
+        ENDIF
       else
-#ifdef CPP_XIOS
-    !Fermeture propre de XIOS
-      CALL wxios_close()
-#endif
-#ifdef CPP_MPI
-         IF (using_mpi) call MPI_FINALIZE(ierr)
-#endif
+        IF (using_xios) THEN
+          !Fermeture propre de XIOS
+          CALL wxios_close()
+        ENDIF
+        IF (using_mpi) call MPI_FINALIZE(ierr)
       end if
       
@@ -456,6 +439,6 @@
     implicit none
 
-#include "dimensions.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
 
       integer, intent(in) :: ij,ll,row
@@ -479,6 +462,6 @@
     implicit none
 
-#include "dimensions.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
 
       integer, intent(in) :: ij,ll,row
@@ -502,14 +485,10 @@
     
     SUBROUTINE barrier
+    USE lmdz_mpi
     IMPLICIT NONE
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
     INTEGER :: ierr
     
 !$OMP CRITICAL (MPI)      
-#ifdef CPP_MPI
       IF (using_mpi) CALL MPI_Barrier(COMM_LMDZ,ierr)
-#endif
 !$OMP END CRITICAL (MPI)
     
@@ -518,11 +497,9 @@
       
     subroutine exchange_hallo(Field,ij,ll,up,down)
+    USE lmdz_mpi
     USE Vampir
     implicit none
-#include "dimensions.h"
-#include "paramet.h"    
-#ifdef CPP_MPI
-    include 'mpif.h'
-#endif    
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"    
       INTEGER :: ij,ll
       REAL, dimension(ij,ll) :: Field
@@ -533,9 +510,6 @@
       LOGICAL :: RecvUp,RecvDown
       INTEGER, DIMENSION(4) :: Request
-#ifdef CPP_MPI
       INTEGER, DIMENSION(MPI_STATUS_SIZE,4) :: Status
-#else
-      INTEGER, DIMENSION(1,4) :: Status
-#endif
+
       INTEGER :: NbRequest
       REAL, dimension(:),allocatable :: Buffer_Send_up,Buffer_Send_down
@@ -582,8 +556,6 @@
           call PACK_Data(Field(ij_begin,1),ij,ll,down,Buffer_Send_up)
 !$OMP CRITICAL (MPI)
-#ifdef CPP_MPI
           call MPI_ISEND(Buffer_send_up,Buffer_Size,MPI_REAL8,MPI_Rank-1,1,     &
                           COMM_LMDZ,Request(NbRequest),ierr)
-#endif
 !$OMP END CRITICAL (MPI)
         ENDIF
@@ -597,8 +569,6 @@
         
 !$OMP CRITICAL (MPI)
-#ifdef CPP_MPI
           call MPI_ISEND(Buffer_send_down,Buffer_Size,MPI_REAL8,MPI_Rank+1,1,     &
                           COMM_LMDZ,Request(NbRequest),ierr)
-#endif
 !$OMP END CRITICAL (MPI)
         ENDIF
@@ -611,8 +581,6 @@
               
 !$OMP CRITICAL (MPI)
-#ifdef CPP_MPI
           call MPI_IRECV(Buffer_recv_up,Buffer_size,MPI_REAL8,MPI_Rank-1,1,  &
                           COMM_LMDZ,Request(NbRequest),ierr)
-#endif
 !$OMP END CRITICAL (MPI)
      
@@ -626,15 +594,11 @@
         
 !$OMP CRITICAL (MPI)
-#ifdef CPP_MPI
           call MPI_IRECV(Buffer_recv_down,Buffer_size,MPI_REAL8,MPI_Rank+1,1,     &
                           COMM_LMDZ,Request(NbRequest),ierr)
-#endif
 !$OMP END CRITICAL (MPI)
         
         ENDIF
   
-#ifdef CPP_MPI
         if (NbRequest > 0) call MPI_WAITALL(NbRequest,Request,Status,ierr)
-#endif
         IF (RecvUp)  call Unpack_Data(Field(ij_begin-up*iip1,1),ij,ll,up,Buffer_Recv_up)
         IF (RecvDown) call Unpack_Data(Field(ij_end+1,1),ij,ll,down,Buffer_Recv_down)  
@@ -651,11 +615,9 @@
 
     subroutine Gather_Field(Field,ij,ll,rank)
+    USE lmdz_mpi
     implicit none
-#include "dimensions.h"
-#include "paramet.h" 
-#include "iniprint.h"
-#ifdef CPP_MPI
-    include 'mpif.h'
-#endif    
+    INCLUDE "dimensions.h"
+    INCLUDE "paramet.h" 
+    INCLUDE "iniprint.h"
       INTEGER :: ij,ll,rank
       REAL, dimension(ij,ll) :: Field
@@ -709,8 +671,6 @@
   
 !$OMP CRITICAL (MPI)
-#ifdef CPP_MPI
         call MPI_GATHERV(Buffer_send,(min(ij_end,ij)-ij_begin+1)*ll,MPI_REAL8,   &
                           Buffer_Recv,Recv_count,displ,MPI_REAL8,rank,COMM_LMDZ,ierr)
-#endif
 !$OMP END CRITICAL (MPI)
       
@@ -735,10 +695,8 @@
 
     subroutine AllGather_Field(Field,ij,ll)
+    USE lmdz_mpi
     implicit none
-#include "dimensions.h"
-#include "paramet.h"    
-#ifdef CPP_MPI
-    include 'mpif.h'
-#endif    
+    INCLUDE "dimensions.h"
+    INCLUDE "paramet.h"    
       INTEGER :: ij,ll
       REAL, dimension(ij,ll) :: Field
@@ -748,7 +706,5 @@
         call Gather_Field(Field,ij,ll,0)
 !$OMP CRITICAL (MPI)
-#ifdef CPP_MPI
       call MPI_BCAST(Field,ij*ll,MPI_REAL8,0,COMM_LMDZ,ierr)
-#endif
 !$OMP END CRITICAL (MPI)
       ENDIF
@@ -757,10 +713,8 @@
     
    subroutine Broadcast_Field(Field,ij,ll,rank)
+    USE lmdz_mpi
     implicit none
-#include "dimensions.h"
-#include "paramet.h"    
-#ifdef CPP_MPI
-    include 'mpif.h'
-#endif    
+    INCLUDE "dimensions.h"
+    INCLUDE "paramet.h"    
       INTEGER :: ij,ll
       REAL, dimension(ij,ll) :: Field
@@ -771,7 +725,5 @@
       
 !$OMP CRITICAL (MPI)
-#ifdef CPP_MPI
       call MPI_BCAST(Field,ij*ll,MPI_REAL8,rank,COMM_LMDZ,ierr)
-#endif
 !$OMP END CRITICAL (MPI)
       
@@ -781,8 +733,8 @@
    
 !  Subroutine verif_hallo(Field,ij,ll,up,down)
+!    USE lmdz_mpi
 !    implicit none
-!#include "dimensions.h"
-!#include "paramet.h"    
-!    include 'mpif.h'
+!      INCLUDE "dimensions.h"
+!      INCLUDE "paramet.h"    
 !    
 !      INTEGER :: ij,ll
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/pression_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/pression_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/pression_loc.F	(revision 4727)
@@ -14,6 +14,6 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
 c
       INTEGER,INTENT(IN) :: ngrid ! not used
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/rotat_nfil_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/rotat_nfil_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/rotat_nfil_loc.F	(revision 4727)
@@ -13,7 +13,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 c
 c   .....  variables en arguments  ......
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/rotat_p.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/rotat_p.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/rotat_p.F	(revision 4727)
@@ -13,7 +13,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 c
 c   .....  variables en arguments  ......
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/rotatf_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/rotatf_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/rotatf_loc.F	(revision 4727)
@@ -14,7 +14,7 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comgeom.h"
 c
 c   .....  variables en arguments  ......
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/temps_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/temps_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/temps_mod.F90	(revision 4727)
@@ -19,4 +19,5 @@
   REAL      start_time
   CHARACTER (len=10) :: calend ! calendar type
+  INTEGER   offline_time ! offline frequency storage
 
   ! Additionnal Mars stuff:
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/times.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/times.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/times.F90	(revision 4727)
@@ -27,6 +27,6 @@
     USE parallel_lmdz
     implicit none
-#include "dimensions.h"
-#include "paramet.h"
+    INCLUDE "dimensions.h"
+    INCLUDE "paramet.h"
     
     max_size=jjm+1
@@ -137,8 +137,7 @@
   subroutine allgather_timer
     USE parallel_lmdz
-    implicit none
-#ifdef CPP_MPI    
-    include 'mpif.h'
-#endif
+    USE lmdz_mpi
+    implicit none
+
     integer :: ierr
     integer :: data_size
@@ -155,11 +154,7 @@
     
       tmp_table(:,:)=timer_table(:,:,mpi_rank)
-#ifdef CPP_MPI 
       call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL_LMDZ,timer_table(1,1,0),data_size,MPI_REAL_LMDZ,COMM_LMDZ,ierr)
-#endif
       tmp_table(:,:)=timer_table_sqr(:,:,mpi_rank)
-#ifdef CPP_MPI
       call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL_LMDZ,timer_table_sqr(1,1,0),data_size,MPI_REAL_LMDZ,COMM_LMDZ,ierr)
-#endif    
       deallocate(tmp_table)
     
@@ -172,8 +167,6 @@
   subroutine allgather_timer_average
     USE parallel_lmdz
-    implicit none
-#ifdef CPP_MPI
-    include 'mpif.h'
-#endif
+    USE lmdz_mpi
+    implicit none
     integer :: ierr
     integer :: data_size
@@ -192,15 +185,9 @@
 
       tmp_table(:,:)=timer_average(:,:,mpi_rank)
-#ifdef CPP_MPI
       call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL_LMDZ,timer_average(1,1,0),data_size,MPI_REAL_LMDZ,COMM_LMDZ,ierr)
-#endif
       tmp_table(:,:)=timer_delta(:,:,mpi_rank)
-#ifdef CPP_MPI
       call mpi_allgather(tmp_table(1,1),data_size,MPI_REAL_LMDZ,timer_delta(1,1,0),data_size,MPI_REAL_LMDZ,COMM_LMDZ,ierr)
-#endif
       tmp_iter(:,:)=timer_iteration(:,:,mpi_rank)
-#ifdef CPP_MPI
       call mpi_allgather(tmp_iter(1,1),data_size,MPI_INTEGER,timer_iteration(1,1,0),data_size,MPI_INTEGER,COMM_LMDZ,ierr)
-#endif    
       deallocate(tmp_table)
     
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/top_bound_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/top_bound_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/top_bound_loc.F	(revision 4727)
@@ -54,6 +54,6 @@
 
 
-#include "comdissipn.h"
-#include "iniprint.h"
+      INCLUDE "comdissipn.h"
+      INCLUDE "iniprint.h"
 
 c   Arguments:
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/vlsplt_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/vlsplt_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/vlsplt_loc.F	(revision 4727)
@@ -1207,6 +1207,6 @@
 c      SUBROUTINE minmaxq(zq,qmin,qmax,comment)
 c
-c#include "dimensions.h"
-c#include "paramet.h"
+c      INCLUDE "dimensions.h"
+c      INCLUDE "paramet.h"
 
 c      CHARACTER*(*) comment
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/wrgrads.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/wrgrads.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/wrgrads.F	(revision 4727)
@@ -12,5 +12,5 @@
 c    titlevar   Titre
 
-#include "gradsdef.h"
+      INCLUDE "gradsdef.h"
 
 c   arguments
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/writedyn_xios.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/writedyn_xios.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dyn3dmem/writedyn_xios.F90	(revision 4727)
@@ -5,6 +5,5 @@
      &                           masse,ps,phis)
 
-#ifdef CPP_XIOS
-      USE xios
+      USE lmdz_xios
       USE parallel_lmdz
       USE misc_mod
@@ -180,5 +179,3 @@
       CALL writefield_dyn_u('PS', ps(ijb:ije))
 
-#endif
-
       END
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dynphy_lonlat/calfis_loc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dynphy_lonlat/calfis_loc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dynphy_lonlat/calfis_loc.F	(revision 4727)
@@ -38,4 +38,6 @@
       USE IOPHY
 #endif
+      USE lmdz_mpi
+
 #ifdef CPP_PARA
       USE parallel_lmdz,ONLY:omp_chunk,using_mpi,jjb_u,jje_u,jjb_v,jje_v
@@ -117,7 +119,4 @@
       include "comgeom2.h"
       include "iniprint.h"
-#ifdef CPP_MPI
-      include 'mpif.h'
-#endif
 c    Arguments :
 c    -----------
@@ -233,9 +232,5 @@
       REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv
       INTEGER :: ierr
-#ifdef CPP_MPI
       INTEGER,dimension(MPI_STATUS_SIZE,4) :: Status
-#else
-      INTEGER,dimension(1,4) :: Status
-#endif
       INTEGER, dimension(4) :: Req
       REAL,ALLOCATABLE,SAVE:: zdufi2(:,:),zdvfi2(:,:)
@@ -873,5 +868,5 @@
 
 c$OMP BARRIER
-#ifdef CPP_MPI 
+
 c$OMP MASTER
 !$OMP CRITICAL (MPI)
@@ -882,5 +877,5 @@
 !$OMP END CRITICAL (MPI)
 c$OMP END MASTER
-#endif
+
 c$OMP BARRIER
      
@@ -889,5 +884,5 @@
       if (MPI_rank<MPI_Size-1) then
 c$OMP BARRIER
-#ifdef CPP_MPI 
+
 c$OMP MASTER      
 !$OMP CRITICAL (MPI)
@@ -898,5 +893,5 @@
 !$OMP END CRITICAL (MPI)
 c$OMP END MASTER
-#endif
+
       endif
 
@@ -904,5 +899,4 @@
 
 
-#ifdef CPP_MPI 
 c$OMP MASTER    
 !$OMP CRITICAL (MPI)
@@ -916,5 +910,4 @@
 !$OMP END CRITICAL (MPI)
 c$OMP END MASTER
-#endif
 
 c$OMP BARRIER     
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dynphy_lonlat/phylmd/callphysiq_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dynphy_lonlat/phylmd/callphysiq_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dynphy_lonlat/phylmd/callphysiq_mod.F90	(revision 4727)
@@ -22,8 +22,5 @@
   USE control_mod, ONLY: planet_type, ok_dyn_xios
   USE physiq_mod, ONLY: physiq
-#ifdef CPP_XIOS
-  USE mod_xios_dyn3dmem, ONLY : dyn3d_ctx_handle
-  USE xios, ONLY : xios_set_current_context
-#endif
+  USE lmdz_xios, ONLY : xios_set_current_context, xios_get_current_context, xios_context
   IMPLICIT NONE
 
@@ -56,5 +53,6 @@
   REAL,INTENT(OUT) :: zdqfi_omp(klon,llm,nqtot) ! tendency on tracers
   REAL,INTENT(OUT) :: zdpsrf_omp(klon) ! tendency on surface pressure
-  
+  TYPE(xios_context) :: dyn3d_ctx_handle
+
   ! Local variables
   CHARACTER(len=11) :: modname="call_physiq"
@@ -70,4 +68,9 @@
   ENDIF
 
+  !$OMP MASTER
+  if (ok_dyn_xios) then
+     CALL xios_get_current_context(dyn3d_ctx_handle)
+  endif
+  !$OMP END MASTER
 
 ! Call physics package with required inputs/outputs
@@ -95,5 +98,4 @@
 
 ! switching back to LMDZDYN context
-#ifdef CPP_XIOS
 !$OMP MASTER
   if (ok_dyn_xios) then
@@ -101,5 +103,4 @@
   endif
 !$OMP END MASTER
-#endif  
 
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dynphy_lonlat/phylmd/ce0l.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dynphy_lonlat/phylmd/ce0l.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dynphy_lonlat/phylmd/ce0l.F90	(revision 4727)
@@ -36,7 +36,5 @@
   USE mod_hallo,      ONLY: init_mod_hallo
   USE mod_interface_dyn_phys, ONLY: init_interface_dyn_phys
-#ifdef CPP_XIOS
-  USE xios, only: xios_finalize
-#endif
+  USE lmdz_xios, only: using_xios, xios_finalize
 #endif
 
@@ -46,4 +44,5 @@
   USE comvert_mod, ONLY: pa, preff, pressure_exner
   USE temps_mod, ONLY: calend, day_ini, dt
+  USE lmdz_mpi
 
   IMPLICIT NONE
@@ -55,7 +54,4 @@
   include "comgeom2.h"
   include "iniprint.h"
-#ifdef CPP_MPI
-  include 'mpif.h'
-#endif
   
   REAL               :: masque(iip1,jjp1)             !--- CONTINENTAL MASK
@@ -252,10 +248,6 @@
 #ifdef CPP_PARA
   END IF
-#ifdef CPP_XIOS
-  CALL xios_finalize
-#endif
-#ifdef CPP_MPI
+  IF (using_xios) CALL xios_finalize
   IF (using_mpi) call MPI_FINALIZE(ierr)
-#endif
 #endif
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90	(revision 4727)
@@ -94,5 +94,5 @@
   USE init_ssrf_m, ONLY: start_init_subsurf
   USE phys_state_var_mod, ONLY: beta_aridity, delta_tsurf, awake_dens, cv_gen, &
-       ratqs_inter, rneb_ancien
+       ratqs_inter_, rneb_ancien
   !use ioipsl_getincom
   IMPLICIT NONE
@@ -143,5 +143,5 @@
                    fact_cldcon, facttemps,ok_newmicro,iflag_radia,      &
                    iflag_cldcon,                                        &
-                   iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs,            &
+                   ratqsbas,ratqshaut,tau_ratqs,            &
                    ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan, flag_volc_surfstrat,     &
                    aerosol_couple, chemistry_couple, flag_aerosol, flag_aerosol_strat,  & 
@@ -285,5 +285,5 @@
   end IF
 
-  ratqs_inter = 0.002
+  ratqs_inter_ = 0.002
   rneb_ancien = 0.
   CALL phyredem( "startphy.nc" )
Index: /LMDZ6/branches/LMDZ_ECRad/libf/filtrez/eigen.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/filtrez/eigen.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/filtrez/eigen.F	(revision 4727)
@@ -4,5 +4,5 @@
       SUBROUTINE eigen( e,d)
       IMPLICIT NONE
-#include "dimensions.h"
+      INCLUDE "dimensions.h"
       real :: e( iim,iim ), d( iim )
       real :: asm( iim )
Index: /LMDZ6/branches/LMDZ_ECRad/libf/filtrez/filtreg.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/filtrez/filtreg.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/filtrez/filtreg.F	(revision 4727)
@@ -46,7 +46,7 @@
 c
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "coefils.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "coefils.h"
 
       INTEGER    nlat,nbniv,ifiltre,iter
Index: /LMDZ6/branches/LMDZ_ECRad/libf/filtrez/filtreg_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/filtrez/filtreg_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/filtrez/filtreg_mod.F90	(revision 4727)
@@ -16,4 +16,6 @@
   USE serre_mod, ONLY: alphax
   USE logic_mod, ONLY: fxyhypb, ysinus
+  USE comconst_mod, ONLY: maxlatfilter
+
     !    ... H. Upadhyaya, O.Sharma   ...
     !
@@ -125,4 +127,8 @@
     ! as length dx becomes of the same size as dy 
     !
+    ! if maxlatfilter >0, prescribe the colat0 value from the .def files
+   
+    IF (maxlatfilter .LT. 0.) THEN
+
     colat0  =  MIN( 0.5, dymin/dxmin )
     ! colat0  =  1.
@@ -133,4 +139,13 @@
        alphax = 0.
     ENDIF
+
+    ELSE
+
+    colat0=(90.0-maxlatfilter)/180.0*pi        
+
+    ENDIF
+    
+    
+    
     !
     PRINT 50, colat0,alphax
Index: /LMDZ6/branches/LMDZ_ECRad/libf/grid/dimension/makdim
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/grid/dimension/makdim	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/grid/dimension/makdim	(revision 4727)
@@ -12,5 +12,5 @@
 fi
 
-if ( ( ($1 % 8 != 0)) && (( $# == 3 ) ) || ( $1 == 1 ) )
+if ( (( $1 % 8 != 0 )) && (( $# == 3 )) || (( $1 == 1 )) )
 then
     echo "The number of longitudes must be a multiple of 8."
Index: /LMDZ6/branches/LMDZ_ECRad/libf/misc/lmdz_mpi.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/misc/lmdz_mpi.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/misc/lmdz_mpi.F90	(revision 4727)
@@ -0,0 +1,27 @@
+#ifdef CPP_MPI
+MODULE lmdz_mpi
+
+  INCLUDE 'mpif.h'
+  LOGICAL,PARAMETER :: using_mpi = .TRUE.
+END MODULE lmdz_mpi
+
+#else
+
+MODULE lmdz_mpi
+  LOGICAL,PARAMETER :: using_mpi = .FALSE.
+
+  INTEGER, PARAMETER         :: MPI_REAL8 = 1
+  INTEGER, PARAMETER         :: MPI_INTEGER = 1
+  INTEGER, PARAMETER         :: MPI_CHARACTER = 1
+  INTEGER, PARAMETER         :: MPI_LOGICAL = 1
+  INTEGER, PARAMETER         :: MPI_SUM = 1
+  INTEGER, PARAMETER         :: MPI_MIN = 1
+  INTEGER, PARAMETER         :: MPI_COMM_WORLD = 1
+  INTEGER, PARAMETER         :: MPI_STATUS_SIZE = 1
+  INTEGER, PARAMETER         :: MPI_THREAD_SERIALIZED =1
+  INTEGER(kind=8), PARAMETER :: MPI_ADDRESS_KIND = 1
+  INTEGER, PARAMETER         :: MPI_INFO_NULL = 1
+
+END MODULE lmdz_mpi
+
+#endif
Index: /LMDZ6/branches/LMDZ_ECRad/libf/misc/lmdz_mpi_wrappers.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/misc/lmdz_mpi_wrappers.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/misc/lmdz_mpi_wrappers.F90	(revision 4727)
@@ -0,0 +1,172 @@
+! mpi subroutine wrappers
+
+#ifndef CPP_MPI
+
+SUBROUTINE lmdz_mpi_wrapper_abort
+  STOP 'CPP_MPI key undefined, must not enter in MPI wrappers ==> aborting'
+END SUBROUTINE lmdz_mpi_wrapper_abort
+
+SUBROUTINE MPI_ABORT(COMM, ERRORCODE, IERROR)
+IMPLICIT NONE
+    INTEGER ::       COMM, ERRORCODE, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_ABORT
+
+SUBROUTINE MPI_ALLGATHER(SENDBUF, SENDCOUNT, SENDTYPE, RECVBUF, RECVCOUNT, RECVTYPE, COMM, IERROR)
+USE ISO_C_BINDING
+IMPLICIT NONE
+    TYPE(C_PTR),VALUE  ::   SENDBUF , RECVBUF
+    INTEGER    SENDCOUNT, SENDTYPE, RECVCOUNT, RECVTYPE, COMM
+    INTEGER    IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE   MPI_ALLGATHER
+  
+SUBROUTINE MPI_COMM_SIZE(COMM, SIZE, IERROR)
+IMPLICIT NONE
+    INTEGER    COMM, SIZE, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_COMM_SIZE
+
+SUBROUTINE MPI_COMM_RANK(COMM, RANK, IERROR)
+IMPLICIT NONE
+    INTEGER    COMM, RANK, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_COMM_RANK
+
+SUBROUTINE MPI_BARRIER(COMM, IERROR)
+IMPLICIT NONE
+    INTEGER    COMM, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_BARRIER   
+
+SUBROUTINE MPI_ISEND(BUF, COUNT, DATATYPE, DEST, TAG, COMM, REQUEST, IERROR)
+USE ISO_C_BINDING
+IMPLICIT NONE
+    TYPE(C_PTR),VALUE  ::    BUF
+    INTEGER    COUNT, DATATYPE, DEST, TAG, COMM, REQUEST, IERROR
+    
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_ISEND
+
+SUBROUTINE MPI_ISSEND(BUF, COUNT, DATATYPE, DEST, TAG, COMM, REQUEST, IERROR)
+USE ISO_C_BINDING
+IMPLICIT NONE
+    TYPE(C_PTR),VALUE  ::    BUF
+    INTEGER    COUNT, DATATYPE, DEST, TAG, COMM, REQUEST, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_ISSEND
+
+SUBROUTINE MPI_IRECV(BUF, COUNT, DATATYPE, SOURCE, TAG, COMM, REQUEST, IERROR)
+USE ISO_C_BINDING
+IMPLICIT NONE
+    TYPE(C_PTR),VALUE  ::    BUF
+    INTEGER    COUNT, DATATYPE, SOURCE, TAG, COMM, REQUEST, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_IRECV   
+
+SUBROUTINE MPI_WAITALL(COUNT, ARRAY_OF_REQUESTS, ARRAY_OF_STATUSES, IERROR)
+USE lmdz_mpi, ONLY : MPI_STATUS_SIZE
+IMPLICIT NONE
+    INTEGER    COUNT, ARRAY_OF_REQUESTS(*)
+    INTEGER    ARRAY_OF_STATUSES(MPI_STATUS_SIZE,*), IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE  MPI_WAITALL  
+
+SUBROUTINE MPI_GATHERV(SENDBUF, SENDCOUNT, SENDTYPE, RECVBUF, RECVCOUNTS, DISPLS, RECVTYPE, ROOT, COMM, IERROR)
+USE ISO_C_BINDING
+IMPLICIT NONE
+    TYPE(C_PTR),VALUE  ::    SENDBUF, RECVBUF
+    INTEGER    SENDCOUNT, SENDTYPE, RECVCOUNTS(*), DISPLS(*)
+    INTEGER    RECVTYPE, ROOT, COMM, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_GATHERV
+    
+SUBROUTINE MPI_BCAST(BUFFER, COUNT, DATATYPE, ROOT, COMM, IERROR)
+USE ISO_C_BINDING
+IMPLICIT NONE
+    TYPE(C_PTR),VALUE  ::    BUFFER
+    INTEGER    COUNT, DATATYPE, ROOT, COMM, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_BCAST
+
+SUBROUTINE MPI_ALLREDUCE(SENDBUF, RECVBUF, COUNT, DATATYPE, OP, COMM, IERROR)
+USE ISO_C_BINDING
+IMPLICIT NONE
+    TYPE(C_PTR),VALUE  ::    SENDBUF, RECVBUF
+    INTEGER    COUNT, DATATYPE, OP, COMM, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_ALLREDUCE
+
+SUBROUTINE MPI_INIT_THREAD(REQUIRED, PROVIDED, IERROR)
+IMPLICIT NONE
+    INTEGER    REQUIRED, PROVIDED, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_INIT_THREAD
+
+SUBROUTINE MPI_ALLOC_MEM(SIZE, INFO, BASEPTR, IERROR)
+USE lmdz_mpi, ONLY : MPI_ADDRESS_KIND
+IMPLICIT NONE
+    INTEGER INFO, IERROR
+    INTEGER(KIND=MPI_ADDRESS_KIND) SIZE, BASEPTR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_ALLOC_MEM
+
+SUBROUTINE MPI_SCATTERV(SENDBUF, SENDCOUNTS, DISPLS, SENDTYPE, RECVBUF, RECVCOUNT, RECVTYPE, ROOT, COMM, IERROR)
+USE ISO_C_BINDING
+IMPLICIT NONE
+    TYPE(C_PTR),VALUE  ::    SENDBUF, RECVBUF
+    INTEGER    SENDCOUNTS(*), DISPLS(*), SENDTYPE
+    INTEGER    RECVCOUNT, RECVTYPE, ROOT, COMM, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_SCATTERV
+
+SUBROUTINE MPI_REDUCE(SENDBUF, RECVBUF, COUNT, DATATYPE, OP, ROOT, COMM, IERROR)
+USE ISO_C_BINDING
+IMPLICIT NONE
+    TYPE(C_PTR),VALUE ::    SENDBUF, RECVBUF
+    INTEGER    COUNT, DATATYPE, OP, ROOT, COMM, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_REDUCE
+
+SUBROUTINE MPI_RECV(BUF, COUNT, DATATYPE, SOURCE, TAG, COMM, STATUS, IERROR)
+USE ISO_C_BINDING
+USE lmdz_mpi, ONLY : MPI_STATUS_SIZE
+IMPLICIT NONE
+    TYPE(C_PTR),VALUE ::    BUF
+    INTEGER    COUNT, DATATYPE, SOURCE, TAG, COMM
+    INTEGER    STATUS(MPI_STATUS_SIZE), IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_RECV
+
+SUBROUTINE MPI_SEND(BUF, COUNT, DATATYPE, DEST, TAG, COMM, IERROR)
+USE ISO_C_BINDING
+IMPLICIT NONE
+    TYPE(C_PTR),VALUE  ::  BUF
+    INTEGER    COUNT, DATATYPE, DEST, TAG, COMM, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_SEND
+
+SUBROUTINE MPI_COMM_SPLIT(COMM, COLOR, KEY, NEWCOMM, IERROR)
+IMPLICIT NONE
+    INTEGER    COMM, COLOR, KEY, NEWCOMM, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_COMM_SPLIT
+
+
+SUBROUTINE MPI_GATHER(SENDBUF, SENDCOUNT, SENDTYPE, RECVBUF, RECVCOUNT, RECVTYPE, ROOT, COMM, IERROR)
+USE ISO_C_BINDING
+IMPLICIT NONE
+    TYPE(C_PTR),VALUE  ::  SENDBUF, RECVBUF
+    INTEGER    SENDCOUNT, SENDTYPE, RECVCOUNT, RECVTYPE, ROOT
+    INTEGER    COMM, IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_GATHER
+
+
+SUBROUTINE MPI_FINALIZE(IERROR)
+IMPLICIT NONE
+    INTEGER    IERROR
+    CALL lmdz_mpi_wrapper_abort
+END SUBROUTINE MPI_Finalize
+
+#endif
Index: /LMDZ6/branches/LMDZ_ECRad/libf/misc/lmdz_xios.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/misc/lmdz_xios.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/misc/lmdz_xios.F90	(revision 4727)
@@ -0,0 +1,1213 @@
+#ifdef CPP_XIOS
+
+MODULE lmdz_xios
+  USE xios
+  
+  LOGICAL,PARAMETER :: using_xios = .TRUE.
+
+END MODULE lmdz_xios
+
+#else
+
+MODULE lmdz_xios
+  !!!! Wrapper XIOS
+  !! => must be replaced latter by official xios wrapper when available
+
+  LOGICAL,PARAMETER :: using_xios = .FALSE.
+
+INTERFACE xios_send_field
+  MODULE PROCEDURE xios_send_field_scalar, xios_send_field_1d, xios_send_field_2d, xios_send_field_3d, &
+                   xios_send_field_4d, xios_send_field_5d
+END INTERFACE  xios_send_field
+
+INTERFACE xios_recv_field
+  MODULE PROCEDURE xios_recv_field_scalar, xios_recv_field_1d, xios_recv_field_2d, xios_recv_field_3d, &
+                   xios_recv_field_4d
+END INTERFACE  xios_recv_field
+
+INTERFACE xios_field_is_active
+  MODULE PROCEDURE xios_field_is_active_id,xios_field_is_active_hdl
+END INTERFACE xios_field_is_active
+
+INTERFACE xios_set_attr
+  MODULE PROCEDURE xios_set_fieldgroup_attr_hdl, xios_set_field_attr_hdl, xios_set_domain_attr_hdl, &
+                   xios_set_axis_attr_hdl, xios_set_file_attr_hdl
+END INTERFACE  xios_set_attr
+
+INTERFACE xios_get_handle
+  MODULE PROCEDURE  xios_get_context_handle, xios_get_field_handle, xios_get_fieldgroup_handle, &
+                    xios_get_domain_handle,xios_get_file_handle, xios_get_filegroup_handle 
+END INTERFACE  xios_get_handle
+
+INTERFACE xios_add_child
+  MODULE PROCEDURE xios_fieldgroup_add_child, xios_add_fieldtofile, xios_add_file
+END INTERFACE  xios_add_child
+
+INTERFACE xios_set_current_context
+      MODULE PROCEDURE xios_set_current_context_hdl, xios_set_current_context_id
+END INTERFACE xios_set_current_context
+
+INTERFACE xios_get_current_context
+      MODULE PROCEDURE xios_get_current_context_hdl, xios_get_current_context_id
+END INTERFACE xios_get_current_context
+
+INTERFACE xios_set_start_date
+  MODULE PROCEDURE xios_set_start_date_date, xios_set_start_date_dur
+END INTERFACE xios_set_start_date
+
+INTERFACE xios_set_time_origin
+  MODULE PROCEDURE xios_set_time_origin_date, xios_set_time_origin_dur
+END INTERFACE xios_set_time_origin
+
+INTERFACE xios_is_defined_attr
+  MODULE PROCEDURE xios_is_defined_domain_attr_hdl
+END INTERFACE xios_is_defined_attr
+
+TYPE xios_duration
+  DOUBLE PRECISION :: year=0, month=0, day=0, hour=0, minute=0, second=0, timestep=0
+END TYPE xios_duration
+
+TYPE xios_date
+  INTEGER :: year=0, month=0, day=0, hour=0, minute=0, second=0
+END TYPE xios_date
+
+   
+REAL,PARAMETER :: xios_timestep=1.
+REAL,PARAMETER :: xios_second=1.
+
+TYPE xios_fieldgroup
+END TYPE xios_fieldgroup
+
+TYPE xios_filegroup
+END TYPE xios_filegroup
+
+TYPE xios_context
+END TYPE xios_context
+
+TYPE xios_domain
+END TYPE xios_domain
+
+TYPE xios_axis
+END TYPE xios_axis
+
+TYPE xios_file
+END TYPE xios_file
+
+TYPE xios_field
+END TYPE 
+
+
+CONTAINS  
+  
+  
+  SUBROUTINE  xios_initialize(client_id, local_comm, return_comm)
+   IMPLICIT NONE
+   CHARACTER(LEN=*),INTENT(IN) :: client_id
+   INTEGER,INTENT(IN),OPTIONAL         :: local_comm
+   INTEGER,INTENT(OUT),OPTIONAL        :: return_comm
+   INTEGER :: f_local_comm
+   INTEGER :: f_return_comm
+
+  END SUBROUTINE  xios_initialize 
+
+SUBROUTINE xios_define_calendar(type, timestep, start_date, time_origin, &
+                                    day_length, month_lengths, year_length, &
+                                    leap_year_month, leap_year_drift, leap_year_drift_offset)
+      IMPLICIT NONE
+      CHARACTER(len = *),              INTENT(IN) :: type
+      TYPE(xios_duration), OPTIONAL, INTENT(IN) :: timestep
+      TYPE(xios_date),     OPTIONAL, INTENT(IN) :: start_date
+      TYPE(xios_date),     OPTIONAL, INTENT(IN) :: time_origin
+      INTEGER,               OPTIONAL, INTENT(IN) :: day_length
+      INTEGER,               OPTIONAL, INTENT(IN) :: month_lengths(:)
+      INTEGER,               OPTIONAL, INTENT(IN) :: year_length
+      REAL (KIND=8),         OPTIONAL, INTENT(IN) :: leap_year_drift
+      REAL (KIND=8),         OPTIONAL, INTENT(IN) :: leap_year_drift_offset
+      INTEGER,               OPTIONAL, INTENT(IN) :: leap_year_month
+
+   END SUBROUTINE xios_define_calendar
+   
+  SUBROUTINE xios_duration_convert_to_string(dur, str)
+    IMPLICIT NONE
+    TYPE(xios_duration), INTENT(IN) :: dur
+    CHARACTER(len = *), INTENT(OUT) :: str
+    str=''
+  END SUBROUTINE xios_duration_convert_to_string
+
+  FUNCTION xios_duration_convert_from_string(str) RESULT(res)
+    IMPLICIT NONE
+    CHARACTER(len = *), INTENT(IN) :: str
+    TYPE(xios_duration) :: res
+
+  END FUNCTION xios_duration_convert_from_string
+
+   SUBROUTINE xios_set_timestep(timestep)
+      IMPLICIT NONE
+      TYPE(xios_duration), INTENT(IN) :: timestep
+   END SUBROUTINE xios_set_timestep
+   
+  SUBROUTINE xios_set_start_date_date(start_date)
+      IMPLICIT NONE
+      TYPE(xios_date), INTENT(IN) :: start_date
+   END SUBROUTINE xios_set_start_date_date
+
+   SUBROUTINE xios_set_start_date_dur(start_date)
+      IMPLICIT NONE
+      TYPE(xios_duration), INTENT(IN) :: start_date
+   END SUBROUTINE xios_set_start_date_dur
+   
+   SUBROUTINE xios_set_time_origin_date(time_origin)
+      IMPLICIT NONE
+      TYPE(xios_date), INTENT(IN) :: time_origin
+   END SUBROUTINE xios_set_time_origin_date
+
+   SUBROUTINE xios_set_time_origin_dur(time_origin)
+      IMPLICIT NONE
+      TYPE(xios_duration), INTENT(IN) :: time_origin
+   END SUBROUTINE xios_set_time_origin_dur
+            
+  SUBROUTINE xios_send_field_scalar(name,field)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(IN) :: field
+  END SUBROUTINE xios_send_field_scalar  
+
+  SUBROUTINE xios_send_field_1d(name,field)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(IN) :: field(:)
+  END SUBROUTINE xios_send_field_1d  
+
+  SUBROUTINE xios_send_field_2d(name,field)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(IN) :: field(:,:)
+  END SUBROUTINE xios_send_field_2d  
+
+  SUBROUTINE xios_send_field_3d(name,field)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(IN) :: field(:,:,:)
+  END SUBROUTINE xios_send_field_3d  
+
+  SUBROUTINE xios_send_field_4d(name,field)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(IN) :: field(:,:,:,:)
+  END SUBROUTINE xios_send_field_4d  
+
+  SUBROUTINE xios_send_field_5d(name,field)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(IN) :: field(:,:,:,:,:)
+  END SUBROUTINE xios_send_field_5d  
+
+
+  SUBROUTINE xios_recv_field_scalar(name,field)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(OUT) :: field
+    field=0
+  END SUBROUTINE xios_recv_field_scalar  
+
+  SUBROUTINE xios_recv_field_1d(name,field)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(OUT) :: field(:)
+    field=0
+  END SUBROUTINE xios_recv_field_1d  
+
+  SUBROUTINE xios_recv_field_2d(name,field)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(OUT) :: field(:,:)
+    field=0
+  END SUBROUTINE xios_recv_field_2d  
+
+  SUBROUTINE xios_recv_field_3d(name,field)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(OUT) :: field(:,:,:)
+    field=0
+  END SUBROUTINE xios_recv_field_3d  
+
+  SUBROUTINE xios_recv_field_4d(name,field)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(OUT) :: field(:,:,:,:)
+    field=0
+  END SUBROUTINE xios_recv_field_4d  
+
+
+  FUNCTION xios_is_active_field(field_id)
+  IMPLICIT NONE
+   LOGICAL ::  xios_is_active_field
+   CHARACTER(LEN=*) :: field_id
+    xios_is_active_field = .TRUE.
+  END FUNCTION xios_is_active_field
+
+  LOGICAL FUNCTION xios_is_valid_field(idt)
+    IMPLICIT NONE
+    CHARACTER(len  = *)    , INTENT(IN) :: idt
+    xios_is_valid_field = .FALSE.
+  END FUNCTION  xios_is_valid_field
+
+  LOGICAL FUNCTION xios_is_valid_file(idt)
+    IMPLICIT NONE
+    CHARACTER(len  = *)    , INTENT(IN) :: idt
+    xios_is_valid_file = .FALSE.
+  END FUNCTION  xios_is_valid_file
+
+  LOGICAL FUNCTION xios_is_valid_axis(idt)
+    IMPLICIT NONE
+    CHARACTER(len  = *)    , INTENT(IN) :: idt
+    xios_is_valid_axis = .FALSE.
+  END FUNCTION  xios_is_valid_axis
+
+  LOGICAL FUNCTION xios_is_valid_domain(idt)
+    IMPLICIT NONE
+    CHARACTER(len  = *)    , INTENT(IN) :: idt
+    xios_is_valid_domain = .FALSE.
+  END FUNCTION  xios_is_valid_domain
+
+
+   SUBROUTINE  xios_context_initialize(context_id,comm)
+   IMPLICIT NONE
+   CHARACTER(LEN=*),INTENT(IN)  :: context_id
+   INTEGER, INTENT(IN)          :: comm
+
+   END SUBROUTINE  xios_context_initialize
+
+
+   SUBROUTINE  xios_finalize
+   IMPLICIT NONE
+
+   END SUBROUTINE  xios_finalize
+
+
+   SUBROUTINE  xios_oasis_enddef
+   IMPLICIT NONE
+
+   END SUBROUTINE  xios_oasis_enddef
+
+
+   SUBROUTINE xios_close_context_definition
+   IMPLICIT NONE
+
+   END SUBROUTINE xios_close_context_definition
+
+
+   SUBROUTINE xios_set_current_context_hdl(context, withswap)
+      IMPLICIT NONE
+      TYPE(xios_context)          , INTENT(IN) :: context
+      LOGICAL                     , OPTIONAL, INTENT(IN) :: withswap
+   END SUBROUTINE xios_set_current_context_hdl
+   
+   SUBROUTINE xios_set_current_context_id(idt)
+      IMPLICIT NONE
+
+      CHARACTER(len = *) , INTENT(IN) :: idt
+      LOGICAL           :: withswap
+    END SUBROUTINE xios_set_current_context_id
+    
+
+   SUBROUTINE xios_get_current_context_hdl(context)
+      IMPLICIT NONE
+      TYPE(xios_context), INTENT(OUT) :: context
+   END SUBROUTINE xios_get_current_context_hdl
+
+   SUBROUTINE xios_get_current_context_id(idt)
+      IMPLICIT NONE
+      CHARACTER(len = *) , INTENT(OUT) :: idt
+      TYPE(xios_context) :: context
+   END SUBROUTINE xios_get_current_context_id
+
+   SUBROUTINE xios_context_finalize()
+   IMPLICIT NONE
+
+   END SUBROUTINE xios_context_finalize
+
+
+   SUBROUTINE xios_solve_inheritance()
+   IMPLICIT NONE
+
+   END SUBROUTINE xios_solve_inheritance
+
+
+
+
+  
+  SUBROUTINE xios_update_calendar(step)
+  IMPLICIT NONE
+   INTEGER, INTENT(IN):: step  
+  END SUBROUTINE xios_update_calendar
+
+  SUBROUTINE xios_set_filegroup_attr(name,enabled)
+    CHARACTER(LEN=*) :: name
+    LOGICAL,OPTIONAL          :: enabled
+  END SUBROUTINE xios_set_filegroup_attr
+
+  SUBROUTINE xios_get_axis_attr(name,n_glo,value)
+    CHARACTER(LEN=*) :: name
+    INTEGER,OPTIONAL          :: n_glo
+    REAL,OPTIONAL             :: value(:)
+  END SUBROUTINE xios_get_axis_attr
+
+   SUBROUTINE xios_get_context_handle(idt,ret)
+    IMPLICIT NONE
+    CHARACTER(len = *)  , INTENT(IN)  :: idt
+    TYPE(xios_context), INTENT(OUT):: ret
+    TYPE(xios_context)             :: nothing 
+      
+      ret=nothing
+   END SUBROUTINE xios_get_context_handle
+
+   SUBROUTINE xios_get_domain_handle(idt,ret)
+      IMPLICIT NONE
+      CHARACTER(len = *) , INTENT(IN) :: idt      
+      TYPE(xios_domain), INTENT(OUT):: ret
+      TYPE(xios_domain)             :: hdl
+      ret=hdl
+   END SUBROUTINE xios_get_domain_handle   
+
+   SUBROUTINE xios_get_field_handle(idt,ret)
+      IMPLICIT NONE
+      CHARACTER(len = *) , INTENT(IN) :: idt      
+      TYPE(xios_field), INTENT(OUT):: ret
+      TYPE(xios_field)             :: hdl
+      ret=hdl
+   END SUBROUTINE xios_get_field_handle   
+
+   SUBROUTINE xios_get_fieldgroup_handle(idt,ret)
+      IMPLICIT NONE
+      CHARACTER(len = *) , INTENT(IN) :: idt      
+      TYPE(xios_fieldgroup), INTENT(OUT):: ret
+      TYPE(xios_fieldgroup)             :: hdl
+      ret=hdl
+   END SUBROUTINE xios_get_fieldgroup_handle   
+
+   SUBROUTINE xios_get_file_handle(idt,ret)
+      IMPLICIT NONE
+      CHARACTER(len = *) , INTENT(IN) :: idt      
+      TYPE(xios_file), INTENT(OUT):: ret
+      TYPE(xios_file)             :: hdl
+      ret=hdl
+   END SUBROUTINE xios_get_file_handle   
+
+   SUBROUTINE xios_get_filegroup_handle(idt,ret)
+      IMPLICIT NONE
+      CHARACTER(len = *) , INTENT(IN) :: idt      
+      TYPE(xios_filegroup), INTENT(OUT):: ret
+      TYPE(xios_filegroup)             :: hdl
+      ret=hdl
+   END SUBROUTINE xios_get_filegroup_handle   
+
+
+
+  SUBROUTINE xios_fieldgroup_add_child(fieldgroup_hdl, field_hdl, id)
+    TYPE(xios_fieldgroup)     :: fieldgroup_hdl
+    TYPE(xios_field)          :: field_hdl
+    CHARACTER(LEN=*),OPTIONAL :: id
+  END SUBROUTINE xios_fieldgroup_add_child
+
+  SUBROUTINE xios_add_file(parent_hdl, child_hdl, child_id)
+      TYPE(xios_filegroup)      , INTENT(IN) :: parent_hdl
+      TYPE(xios_file)           , INTENT(OUT):: child_hdl
+      CHARACTER(len = *), OPTIONAL, INTENT(IN)  :: child_id
+      TYPE(xios_file) :: hdl
+      child_hdl = hdl
+  END SUBROUTINE xios_add_file
+
+  SUBROUTINE xios_add_field(parent_hdl, child_hdl, child_id)
+      TYPE(xios_fieldgroup)      , INTENT(IN) :: parent_hdl
+      TYPE(xios_field)           , INTENT(OUT):: child_hdl
+      CHARACTER(len = *), OPTIONAL, INTENT(IN)  :: child_id
+      TYPE(xios_field) :: hdl
+      child_hdl = hdl
+  END SUBROUTINE xios_add_field
+  
+  SUBROUTINE xios_add_fieldtofile(parent_hdl, child_hdl, child_id)
+    TYPE(xios_file)            , INTENT(IN) :: parent_hdl
+    TYPE(xios_field)           , INTENT(OUT):: child_hdl
+    CHARACTER(len = *), OPTIONAL , INTENT(IN) :: child_id
+    TYPE(xios_field) :: hdl
+    child_hdl = hdl
+
+  END SUBROUTINE xios_add_fieldtofile
+   
+  LOGICAL FUNCTION xios_field_is_active_id(field_id, at_current_timestep_arg)
+      IMPLICIT NONE
+      CHARACTER(len  = *) , INTENT(IN) :: field_id
+      LOGICAL, OPTIONAL   , INTENT(IN) :: at_current_timestep_arg
+
+     xios_field_is_active_id=.FALSE.
+   END FUNCTION xios_field_is_active_id
+
+   LOGICAL FUNCTION xios_field_is_active_hdl(field_hdl, at_current_timestep_arg)
+      IMPLICIT NONE
+      TYPE(xios_field) , INTENT(IN) :: field_hdl
+      LOGICAL, OPTIONAL  , INTENT(IN) :: at_current_timestep_arg
+
+     xios_field_is_active_hdl = .FALSE.
+   END FUNCTION xios_field_is_active_hdl
+   
+
+  SUBROUTINE  xios_set_generate_rectilinear_domain_attr(id, bounds_lon_start, bounds_lon_end,  bounds_lat_start,  bounds_lat_end)
+    CHARACTER(LEN=*) :: id
+    REAL, OPTIONAL :: bounds_lon_start
+    REAL, OPTIONAL :: bounds_lon_end
+    REAL, OPTIONAL :: bounds_lat_start
+    REAL, OPTIONAL :: bounds_lat_end
+  END SUBROUTINE  xios_set_generate_rectilinear_domain_attr    
+
+  SUBROUTINE xios_set_domain_attr  &
+    ( domain_id, area, bounds_lat_1d, bounds_lat_2d, bounds_lat_name, bounds_lon_1d, bounds_lon_2d  &
+    , bounds_lon_name, comment, data_dim, data_i_index, data_ibegin, data_j_index, data_jbegin, data_ni  &
+    , data_nj, dim_i_name, dim_j_name, domain_ref, i_index, ibegin, j_index, jbegin, lat_name, latvalue_1d  &
+    , latvalue_2d, lon_name, long_name, lonvalue_1d, lonvalue_2d, mask_1d, mask_2d, name, ni, ni_glo  &
+    , nj, nj_glo, nvertex, prec, radius, standard_name, type )
+
+    IMPLICIT NONE
+      TYPE(xios_domain)  :: domain_hdl
+      CHARACTER(LEN=*), INTENT(IN) ::domain_id
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: area(:,:)
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: bounds_lat_1d(:,:)
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: bounds_lat_2d(:,:,:)
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: bounds_lat_name
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: bounds_lon_1d(:,:)
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: bounds_lon_2d(:,:,:)
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: bounds_lon_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: comment
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_dim
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_i_index(:)
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_ibegin
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_j_index(:)
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_jbegin
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_ni
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_nj
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: dim_i_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: dim_j_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: domain_ref
+      INTEGER  , OPTIONAL, INTENT(IN) :: i_index(:)
+      INTEGER  , OPTIONAL, INTENT(IN) :: ibegin
+      INTEGER  , OPTIONAL, INTENT(IN) :: j_index(:)
+      INTEGER  , OPTIONAL, INTENT(IN) :: jbegin
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: lat_name
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: latvalue_1d(:)
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: latvalue_2d(:,:)
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: lon_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: long_name
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: lonvalue_1d(:)
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: lonvalue_2d(:,:)
+      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_1d(:)
+      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_2d(:,:)
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name
+      INTEGER  , OPTIONAL, INTENT(IN) :: ni
+      INTEGER  , OPTIONAL, INTENT(IN) :: ni_glo
+      INTEGER  , OPTIONAL, INTENT(IN) :: nj
+      INTEGER  , OPTIONAL, INTENT(IN) :: nj_glo
+      INTEGER  , OPTIONAL, INTENT(IN) :: nvertex
+      INTEGER  , OPTIONAL, INTENT(IN) :: prec
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: radius
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: standard_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: type
+
+  END SUBROUTINE xios_set_domain_attr  
+
+  SUBROUTINE xios_set_domain_attr_hdl  &
+    ( domain_hdl, area, bounds_lat_1d, bounds_lat_2d, bounds_lat_name, bounds_lon_1d, bounds_lon_2d  &
+    , bounds_lon_name, comment, data_dim, data_i_index, data_ibegin, data_j_index, data_jbegin, data_ni  &
+    , data_nj, dim_i_name, dim_j_name, domain_ref, i_index, ibegin, j_index, jbegin, lat_name, latvalue_1d  &
+    , latvalue_2d, lon_name, long_name, lonvalue_1d, lonvalue_2d, mask_1d, mask_2d, name, ni, ni_glo  &
+    , nj, nj_glo, nvertex, prec, radius, standard_name, type )
+
+    IMPLICIT NONE
+      TYPE(xios_domain) , INTENT(IN) :: domain_hdl
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: area(:,:)
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: bounds_lat_1d(:,:)
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: bounds_lat_2d(:,:,:)
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: bounds_lat_name
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: bounds_lon_1d(:,:)
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: bounds_lon_2d(:,:,:)
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: bounds_lon_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: comment
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_dim
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_i_index(:)
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_ibegin
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_j_index(:)
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_jbegin
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_ni
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_nj
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: dim_i_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: dim_j_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: domain_ref
+      INTEGER  , OPTIONAL, INTENT(IN) :: i_index(:)
+      INTEGER  , OPTIONAL, INTENT(IN) :: ibegin
+      INTEGER  , OPTIONAL, INTENT(IN) :: j_index(:)
+      INTEGER  , OPTIONAL, INTENT(IN) :: jbegin
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: lat_name
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: latvalue_1d(:)
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: latvalue_2d(:,:)
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: lon_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: long_name
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: lonvalue_1d(:)
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: lonvalue_2d(:,:)
+      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_1d(:)
+      LOGICAL  , OPTIONAL, INTENT(IN) :: mask_2d(:,:)
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name
+      INTEGER  , OPTIONAL, INTENT(IN) :: ni
+      INTEGER  , OPTIONAL, INTENT(IN) :: ni_glo
+      INTEGER  , OPTIONAL, INTENT(IN) :: nj
+      INTEGER  , OPTIONAL, INTENT(IN) :: nj_glo
+      INTEGER  , OPTIONAL, INTENT(IN) :: nvertex
+      INTEGER  , OPTIONAL, INTENT(IN) :: prec
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: radius
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: standard_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: type
+  
+  END SUBROUTINE xios_set_domain_attr_hdl
+
+
+
+  SUBROUTINE xios_set_axis_attr  &
+    ( axis_id, axis_ref, axis_type, begin, bounds, bounds_name, comment, data_begin, data_index  &
+    , data_n, dim_name, formula, formula_bounds, formula_term, formula_term_bounds, index, label  &
+    , long_name, mask, n, n_distributed_partition, n_glo, name, positive, prec, standard_name, unit  &
+    , value )
+
+    IMPLICIT NONE
+      TYPE(xios_axis)  :: axis_hdl
+      CHARACTER(LEN=*), INTENT(IN) ::axis_id
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: axis_ref
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: axis_type
+      INTEGER  , OPTIONAL, INTENT(IN) :: begin
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: bounds(:,:)
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: bounds_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: comment
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_begin
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_index(:)
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_n
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: dim_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: formula
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: formula_bounds
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: formula_term
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: formula_term_bounds
+      INTEGER  , OPTIONAL, INTENT(IN) :: index(:)
+      CHARACTER(len=*) , OPTIONAL, INTENT(IN) :: label(:)
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: long_name
+      LOGICAL  , OPTIONAL, INTENT(IN) :: mask(:)
+      INTEGER  , OPTIONAL, INTENT(IN) :: n
+      INTEGER  , OPTIONAL, INTENT(IN) :: n_distributed_partition
+      INTEGER  , OPTIONAL, INTENT(IN) :: n_glo
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: positive
+      INTEGER  , OPTIONAL, INTENT(IN) :: prec
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: standard_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: unit
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: value(:)
+
+  END SUBROUTINE xios_set_axis_attr
+
+  SUBROUTINE xios_set_axis_attr_hdl  &
+    ( axis_hdl, axis_ref, axis_type, begin, bounds, bounds_name, comment, data_begin, data_index  &
+    , data_n, dim_name, formula, formula_bounds, formula_term, formula_term_bounds, index, label  &
+    , long_name, mask, n, n_distributed_partition, n_glo, name, positive, prec, standard_name, unit  &
+    , value )
+
+    IMPLICIT NONE
+      TYPE(xios_axis) , INTENT(IN) :: axis_hdl
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: axis_ref
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: axis_type
+      INTEGER  , OPTIONAL, INTENT(IN) :: begin
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: bounds(:,:)
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: bounds_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: comment
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_begin
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_index(:)
+      INTEGER  , OPTIONAL, INTENT(IN) :: data_n
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: dim_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: formula
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: formula_bounds
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: formula_term
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: formula_term_bounds
+      INTEGER  , OPTIONAL, INTENT(IN) :: index(:)
+      CHARACTER(len=*) , OPTIONAL, INTENT(IN) :: label(:)
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: long_name
+      LOGICAL  , OPTIONAL, INTENT(IN) :: mask(:)
+      INTEGER  , OPTIONAL, INTENT(IN) :: n
+      INTEGER  , OPTIONAL, INTENT(IN) :: n_distributed_partition
+      INTEGER  , OPTIONAL, INTENT(IN) :: n_glo
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: positive
+      INTEGER  , OPTIONAL, INTENT(IN) :: prec
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: standard_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: unit
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: value(:)
+
+  END SUBROUTINE xios_set_axis_attr_hdl
+
+  SUBROUTINE xios_set_field_attr  &
+    ( field_id, add_offset, axis_ref, build_workflow_graph, cell_methods, cell_methods_mode, check_if_active  &
+    , comment, compression_level, default_value, detect_missing_value, domain_ref, enabled, expr  &
+    , field_ref, freq_offset, freq_op, grid_path, grid_ref, indexed_output, level, long_name, name  &
+    , operation, prec, read_access, scalar_ref, scale_factor, standard_name, ts_enabled, ts_split_freq  &
+    , unit, valid_max, valid_min )
+
+    IMPLICIT NONE
+      TYPE(xios_field)  :: field_hdl
+      CHARACTER(LEN=*), INTENT(IN) ::field_id
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: add_offset
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: axis_ref
+      LOGICAL  , OPTIONAL, INTENT(IN) :: build_workflow_graph
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: cell_methods
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: cell_methods_mode
+      LOGICAL  , OPTIONAL, INTENT(IN) :: check_if_active
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: comment
+      INTEGER  , OPTIONAL, INTENT(IN) :: compression_level
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: default_value
+      LOGICAL  , OPTIONAL, INTENT(IN) :: detect_missing_value
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: domain_ref
+      LOGICAL  , OPTIONAL, INTENT(IN) :: enabled
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: expr
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: field_ref
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: freq_offset
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: freq_op
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: grid_path
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: grid_ref
+      LOGICAL  , OPTIONAL, INTENT(IN) :: indexed_output
+      INTEGER  , OPTIONAL, INTENT(IN) :: level
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: long_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: operation
+      INTEGER  , OPTIONAL, INTENT(IN) :: prec
+      LOGICAL  , OPTIONAL, INTENT(IN) :: read_access
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: scalar_ref
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: scale_factor
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: standard_name
+      LOGICAL  , OPTIONAL, INTENT(IN) :: ts_enabled
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: ts_split_freq
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: unit
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: valid_max
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: valid_min
+
+  END SUBROUTINE xios_set_field_attr
+
+  SUBROUTINE xios_set_field_attr_hdl  &
+    ( field_hdl, add_offset, axis_ref, build_workflow_graph, cell_methods, cell_methods_mode, check_if_active  &
+    , comment, compression_level, default_value, detect_missing_value, domain_ref, enabled, expr  &
+    , field_ref, freq_offset, freq_op, grid_path, grid_ref, indexed_output, level, long_name, name  &
+    , operation, prec, read_access, scalar_ref, scale_factor, standard_name, ts_enabled, ts_split_freq  &
+    , unit, valid_max, valid_min )
+
+    IMPLICIT NONE
+      TYPE(xios_field) , INTENT(IN) :: field_hdl
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: add_offset
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: axis_ref
+      LOGICAL  , OPTIONAL, INTENT(IN) :: build_workflow_graph
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: cell_methods
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: cell_methods_mode
+      LOGICAL  , OPTIONAL, INTENT(IN) :: check_if_active
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: comment
+      INTEGER  , OPTIONAL, INTENT(IN) :: compression_level
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: default_value
+      LOGICAL  , OPTIONAL, INTENT(IN) :: detect_missing_value
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: domain_ref
+      LOGICAL  , OPTIONAL, INTENT(IN) :: enabled
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: expr
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: field_ref
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: freq_offset
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: freq_op
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: grid_path
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: grid_ref
+      LOGICAL  , OPTIONAL, INTENT(IN) :: indexed_output
+      INTEGER  , OPTIONAL, INTENT(IN) :: level
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: long_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: operation
+      INTEGER  , OPTIONAL, INTENT(IN) :: prec
+      LOGICAL  , OPTIONAL, INTENT(IN) :: read_access
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: scalar_ref
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: scale_factor
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: standard_name
+      LOGICAL  , OPTIONAL, INTENT(IN) :: ts_enabled
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: ts_split_freq
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: unit
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: valid_max
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: valid_min
+
+
+  END SUBROUTINE xios_set_field_attr_hdl
+
+
+  SUBROUTINE xios_set_fieldgroup_attr  &
+    ( fieldgroup_id, add_offset, axis_ref, build_workflow_graph, cell_methods, cell_methods_mode  &
+    , check_if_active, comment, compression_level, default_value, detect_missing_value, domain_ref  &
+    , enabled, expr, field_ref, freq_offset, freq_op, grid_path, grid_ref, group_ref, indexed_output  &
+    , level, long_name, name, operation, prec, read_access, scalar_ref, scale_factor, standard_name  &
+    , ts_enabled, ts_split_freq, unit, valid_max, valid_min )
+
+    IMPLICIT NONE
+      TYPE(xios_fieldgroup)  :: fieldgroup_hdl
+      CHARACTER(LEN=*), INTENT(IN) ::fieldgroup_id
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: add_offset
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: axis_ref
+      LOGICAL  , OPTIONAL, INTENT(IN) :: build_workflow_graph
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: cell_methods
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: cell_methods_mode
+      LOGICAL  , OPTIONAL, INTENT(IN) :: check_if_active
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: comment
+      INTEGER  , OPTIONAL, INTENT(IN) :: compression_level
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: default_value
+      LOGICAL  , OPTIONAL, INTENT(IN) :: detect_missing_value
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: domain_ref
+      LOGICAL  , OPTIONAL, INTENT(IN) :: enabled
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: expr
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: field_ref
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: freq_offset
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: freq_op
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: grid_path
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: grid_ref
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: group_ref
+      LOGICAL  , OPTIONAL, INTENT(IN) :: indexed_output
+      INTEGER  , OPTIONAL, INTENT(IN) :: level
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: long_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: operation
+      INTEGER  , OPTIONAL, INTENT(IN) :: prec
+      LOGICAL  , OPTIONAL, INTENT(IN) :: read_access
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: scalar_ref
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: scale_factor
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: standard_name
+      LOGICAL  , OPTIONAL, INTENT(IN) :: ts_enabled
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: ts_split_freq
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: unit
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: valid_max
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: valid_min
+
+  END SUBROUTINE xios_set_fieldgroup_attr
+
+  SUBROUTINE xios_set_fieldgroup_attr_hdl  &
+    ( fieldgroup_hdl, add_offset, axis_ref, build_workflow_graph, cell_methods, cell_methods_mode  &
+    , check_if_active, comment, compression_level, default_value, detect_missing_value, domain_ref  &
+    , enabled, expr, field_ref, freq_offset, freq_op, grid_path, grid_ref, group_ref, indexed_output  &
+    , level, long_name, name, operation, prec, read_access, scalar_ref, scale_factor, standard_name  &
+    , ts_enabled, ts_split_freq, unit, valid_max, valid_min )
+
+    IMPLICIT NONE
+      TYPE(xios_fieldgroup) , INTENT(IN) :: fieldgroup_hdl
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: add_offset
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: axis_ref
+      LOGICAL  , OPTIONAL, INTENT(IN) :: build_workflow_graph
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: cell_methods
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: cell_methods_mode
+      LOGICAL  , OPTIONAL, INTENT(IN) :: check_if_active
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: comment
+      INTEGER  , OPTIONAL, INTENT(IN) :: compression_level
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: default_value
+      LOGICAL  , OPTIONAL, INTENT(IN) :: detect_missing_value
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: domain_ref
+      LOGICAL  , OPTIONAL, INTENT(IN) :: enabled
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: expr
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: field_ref
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: freq_offset
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: freq_op
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: grid_path
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: grid_ref
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: group_ref
+      LOGICAL  , OPTIONAL, INTENT(IN) :: indexed_output
+      INTEGER  , OPTIONAL, INTENT(IN) :: level
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: long_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: operation
+      INTEGER  , OPTIONAL, INTENT(IN) :: prec
+      LOGICAL  , OPTIONAL, INTENT(IN) :: read_access
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: scalar_ref
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: scale_factor
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: standard_name
+      LOGICAL  , OPTIONAL, INTENT(IN) :: ts_enabled
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: ts_split_freq
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: unit
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: valid_max
+      REAL (KIND=8) , OPTIONAL, INTENT(IN) :: valid_min
+
+  END SUBROUTINE xios_set_fieldgroup_attr_hdl
+
+
+  SUBROUTINE xios_set_file_attr  &
+    ( file_id, append, comment, compression_level, convention, convention_str, cyclic, description  &
+    , enabled, format, min_digits, mode, name, name_suffix, output_freq, output_level, par_access  &
+    , read_metadata_par, record_offset, split_end_offset, split_freq, split_freq_format, split_last_date  &
+    , split_start_offset, sync_freq, time_counter, time_counter_name, time_stamp_format, time_stamp_name  &
+    , time_units, timeseries, ts_prefix, type, uuid_format, uuid_name )
+
+    IMPLICIT NONE
+      TYPE(xios_file)  :: file_hdl
+      CHARACTER(LEN=*), INTENT(IN) ::file_id
+      LOGICAL  , OPTIONAL, INTENT(IN) :: append
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: comment
+      INTEGER  , OPTIONAL, INTENT(IN) :: compression_level
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: convention
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: convention_str
+      LOGICAL  , OPTIONAL, INTENT(IN) :: cyclic
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: description
+      LOGICAL  , OPTIONAL, INTENT(IN) :: enabled
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: format
+      INTEGER  , OPTIONAL, INTENT(IN) :: min_digits
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: mode
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name_suffix
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: output_freq
+      INTEGER  , OPTIONAL, INTENT(IN) :: output_level
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: par_access
+      LOGICAL  , OPTIONAL, INTENT(IN) :: read_metadata_par
+      INTEGER  , OPTIONAL, INTENT(IN) :: record_offset
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: split_end_offset
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: split_freq
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: split_freq_format
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: split_last_date
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: split_start_offset
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: sync_freq
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: time_counter
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: time_counter_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: time_stamp_format
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: time_stamp_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: time_units
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: timeseries
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: ts_prefix
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: type
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: uuid_format
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: uuid_name
+
+  END SUBROUTINE xios_set_file_attr
+
+  SUBROUTINE xios_set_file_attr_hdl  &
+    ( file_hdl, append, comment, compression_level, convention, convention_str, cyclic, description  &
+    , enabled, format, min_digits, mode, name, name_suffix, output_freq, output_level, par_access  &
+    , read_metadata_par, record_offset, split_end_offset, split_freq, split_freq_format, split_last_date  &
+    , split_start_offset, sync_freq, time_counter, time_counter_name, time_stamp_format, time_stamp_name  &
+    , time_units, timeseries, ts_prefix, type, uuid_format, uuid_name )
+
+    IMPLICIT NONE
+      TYPE(xios_file) , INTENT(IN) :: file_hdl
+      LOGICAL  , OPTIONAL, INTENT(IN) :: append
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: comment
+      INTEGER  , OPTIONAL, INTENT(IN) :: compression_level
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: convention
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: convention_str
+      LOGICAL  , OPTIONAL, INTENT(IN) :: cyclic
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: description
+      LOGICAL  , OPTIONAL, INTENT(IN) :: enabled
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: format
+      INTEGER  , OPTIONAL, INTENT(IN) :: min_digits
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: mode
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: name_suffix
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: output_freq
+      INTEGER  , OPTIONAL, INTENT(IN) :: output_level
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: par_access
+      LOGICAL  , OPTIONAL, INTENT(IN) :: read_metadata_par
+      INTEGER  , OPTIONAL, INTENT(IN) :: record_offset
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: split_end_offset
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: split_freq
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: split_freq_format
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: split_last_date
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: split_start_offset
+      TYPE(xios_duration)  , OPTIONAL, INTENT(IN) :: sync_freq
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: time_counter
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: time_counter_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: time_stamp_format
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: time_stamp_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: time_units
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: timeseries
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: ts_prefix
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: type
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: uuid_format
+      CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: uuid_name
+
+  END SUBROUTINE xios_set_file_attr_hdl
+
+
+  SUBROUTINE xios_is_defined_domain_attr  &
+    ( domain_id, area, bounds_lat_1d, bounds_lat_2d, bounds_lat_name, bounds_lon_1d, bounds_lon_2d  &
+    , bounds_lon_name, comment, data_dim, data_i_index, data_ibegin, data_j_index, data_jbegin, data_ni  &
+    , data_nj, dim_i_name, dim_j_name, domain_ref, i_index, ibegin, j_index, jbegin, lat_name, latvalue_1d  &
+    , latvalue_2d, lon_name, long_name, lonvalue_1d, lonvalue_2d, mask_1d, mask_2d, name, ni, ni_glo  &
+    , nj, nj_glo, nvertex, prec, radius, standard_name, type )
+
+    IMPLICIT NONE
+      CHARACTER(LEN=*), INTENT(IN) ::domain_id
+      LOGICAL, OPTIONAL, INTENT(OUT) :: area
+      LOGICAL, OPTIONAL, INTENT(OUT) :: bounds_lat_1d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: bounds_lat_2d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: bounds_lat_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: bounds_lon_1d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: bounds_lon_2d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: bounds_lon_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: comment
+      LOGICAL, OPTIONAL, INTENT(OUT) :: data_dim
+      LOGICAL, OPTIONAL, INTENT(OUT) :: data_i_index
+      LOGICAL, OPTIONAL, INTENT(OUT) :: data_ibegin
+      LOGICAL, OPTIONAL, INTENT(OUT) :: data_j_index
+      LOGICAL, OPTIONAL, INTENT(OUT) :: data_jbegin
+      LOGICAL, OPTIONAL, INTENT(OUT) :: data_ni
+      LOGICAL, OPTIONAL, INTENT(OUT) :: data_nj
+      LOGICAL, OPTIONAL, INTENT(OUT) :: dim_i_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: dim_j_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: domain_ref
+      LOGICAL, OPTIONAL, INTENT(OUT) :: i_index
+      LOGICAL, OPTIONAL, INTENT(OUT) :: ibegin
+      LOGICAL, OPTIONAL, INTENT(OUT) :: j_index
+      LOGICAL, OPTIONAL, INTENT(OUT) :: jbegin
+      LOGICAL, OPTIONAL, INTENT(OUT) :: lat_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: latvalue_1d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: latvalue_2d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: lon_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: long_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: lonvalue_1d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: lonvalue_2d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_1d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_2d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: ni
+      LOGICAL, OPTIONAL, INTENT(OUT) :: ni_glo
+      LOGICAL, OPTIONAL, INTENT(OUT) :: nj
+      LOGICAL, OPTIONAL, INTENT(OUT) :: nj_glo
+      LOGICAL, OPTIONAL, INTENT(OUT) :: nvertex
+      LOGICAL, OPTIONAL, INTENT(OUT) :: prec
+      LOGICAL, OPTIONAL, INTENT(OUT) :: radius
+      LOGICAL, OPTIONAL, INTENT(OUT) :: standard_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: type
+
+      area = .FALSE.
+      bounds_lat_1d = .FALSE.
+      bounds_lat_2d = .FALSE.
+      bounds_lat_name = .FALSE.
+      bounds_lon_1d = .FALSE.
+      bounds_lon_2d = .FALSE.
+      bounds_lon_name = .FALSE.
+      comment = .FALSE.
+      data_dim = .FALSE.
+      data_i_index = .FALSE.
+      data_ibegin = .FALSE.
+      data_j_index = .FALSE.
+      data_jbegin = .FALSE.
+      data_ni = .FALSE.
+      data_nj = .FALSE.
+      dim_i_name = .FALSE.
+      dim_j_name = .FALSE.
+      domain_ref = .FALSE.
+      i_index = .FALSE.
+      ibegin = .FALSE.
+      j_index = .FALSE.
+      jbegin = .FALSE.
+      lat_name = .FALSE.
+      latvalue_1d = .FALSE.
+      latvalue_2d = .FALSE.
+      lon_name = .FALSE.
+      long_name = .FALSE.
+      lonvalue_1d = .FALSE.
+      lonvalue_2d = .FALSE.
+      mask_1d = .FALSE.
+      mask_2d = .FALSE.
+      name = .FALSE.
+      ni = .FALSE.
+      ni_glo = .FALSE.
+      nj = .FALSE.
+      nj_glo = .FALSE.
+      nvertex = .FALSE.
+      prec = .FALSE.
+      radius = .FALSE.
+      standard_name = .FALSE.
+      type = .FALSE.
+
+  END SUBROUTINE xios_is_defined_domain_attr
+
+  SUBROUTINE xios_is_defined_domain_attr_hdl  &
+    ( domain_hdl, area, bounds_lat_1d, bounds_lat_2d, bounds_lat_name, bounds_lon_1d, bounds_lon_2d  &
+    , bounds_lon_name, comment, data_dim, data_i_index, data_ibegin, data_j_index, data_jbegin, data_ni  &
+    , data_nj, dim_i_name, dim_j_name, domain_ref, i_index, ibegin, j_index, jbegin, lat_name, latvalue_1d  &
+    , latvalue_2d, lon_name, long_name, lonvalue_1d, lonvalue_2d, mask_1d, mask_2d, name, ni, ni_glo  &
+    , nj, nj_glo, nvertex, prec, radius, standard_name, type )
+
+    IMPLICIT NONE 
+      TYPE(xios_domain), INTENT(IN) :: domain_hdl
+      LOGICAL, OPTIONAL, INTENT(OUT) :: area
+      LOGICAL, OPTIONAL, INTENT(OUT) :: bounds_lat_1d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: bounds_lat_2d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: bounds_lat_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: bounds_lon_1d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: bounds_lon_2d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: bounds_lon_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: comment
+      LOGICAL, OPTIONAL, INTENT(OUT) :: data_dim
+      LOGICAL, OPTIONAL, INTENT(OUT) :: data_i_index
+      LOGICAL, OPTIONAL, INTENT(OUT) :: data_ibegin
+      LOGICAL, OPTIONAL, INTENT(OUT) :: data_j_index
+      LOGICAL, OPTIONAL, INTENT(OUT) :: data_jbegin
+      LOGICAL, OPTIONAL, INTENT(OUT) :: data_ni
+      LOGICAL, OPTIONAL, INTENT(OUT) :: data_nj
+      LOGICAL, OPTIONAL, INTENT(OUT) :: dim_i_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: dim_j_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: domain_ref
+      LOGICAL, OPTIONAL, INTENT(OUT) :: i_index
+      LOGICAL, OPTIONAL, INTENT(OUT) :: ibegin
+      LOGICAL, OPTIONAL, INTENT(OUT) :: j_index
+      LOGICAL, OPTIONAL, INTENT(OUT) :: jbegin
+      LOGICAL, OPTIONAL, INTENT(OUT) :: lat_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: latvalue_1d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: latvalue_2d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: lon_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: long_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: lonvalue_1d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: lonvalue_2d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_1d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: mask_2d
+      LOGICAL, OPTIONAL, INTENT(OUT) :: name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: ni
+      LOGICAL, OPTIONAL, INTENT(OUT) :: ni_glo
+      LOGICAL, OPTIONAL, INTENT(OUT) :: nj
+      LOGICAL, OPTIONAL, INTENT(OUT) :: nj_glo
+      LOGICAL, OPTIONAL, INTENT(OUT) :: nvertex
+      LOGICAL, OPTIONAL, INTENT(OUT) :: prec
+      LOGICAL, OPTIONAL, INTENT(OUT) :: radius
+      LOGICAL, OPTIONAL, INTENT(OUT) :: standard_name
+      LOGICAL, OPTIONAL, INTENT(OUT) :: type
+
+      area = .FALSE.
+      bounds_lat_1d = .FALSE.
+      bounds_lat_2d = .FALSE.
+      bounds_lat_name = .FALSE.
+      bounds_lon_1d = .FALSE.
+      bounds_lon_2d = .FALSE.
+      bounds_lon_name = .FALSE.
+      comment = .FALSE.
+      data_dim = .FALSE.
+      data_i_index = .FALSE.
+      data_ibegin = .FALSE.
+      data_j_index = .FALSE.
+      data_jbegin = .FALSE.
+      data_ni = .FALSE.
+      data_nj = .FALSE.
+      dim_i_name = .FALSE.
+      dim_j_name = .FALSE.
+      domain_ref = .FALSE.
+      i_index = .FALSE.
+      ibegin = .FALSE.
+      j_index = .FALSE.
+      jbegin = .FALSE.
+      lat_name = .FALSE.
+      latvalue_1d = .FALSE.
+      latvalue_2d = .FALSE.
+      lon_name = .FALSE.
+      long_name = .FALSE.
+      lonvalue_1d = .FALSE.
+      lonvalue_2d = .FALSE.
+      mask_1d = .FALSE.
+      mask_2d = .FALSE.
+      name = .FALSE.
+      ni = .FALSE.
+      ni_glo = .FALSE.
+      nj = .FALSE.
+      nj_glo = .FALSE.
+      nvertex = .FALSE.
+      prec = .FALSE.
+      radius = .FALSE.
+      standard_name = .FALSE.
+      type = .FALSE.
+
+  END SUBROUTINE xios_is_defined_domain_attr_hdl
+
+  SUBROUTINE xios_get_field_attr  &
+    ( field_id, add_offset, axis_ref, build_workflow_graph, cell_methods, cell_methods_mode, check_if_active  &
+    , comment, compression_level, default_value, detect_missing_value, domain_ref, enabled, expr  &
+    , field_ref, freq_offset, freq_op, grid_path, grid_ref, indexed_output, level, long_name, name  &
+    , operation, prec, read_access, scalar_ref, scale_factor, standard_name, ts_enabled, ts_split_freq  &
+    , unit, valid_max, valid_min )
+
+    IMPLICIT NONE
+      TYPE(xios_field)  :: field_hdl
+      CHARACTER(LEN=*), INTENT(IN) ::field_id
+      REAL (KIND=8) , OPTIONAL, INTENT(OUT) :: add_offset
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: axis_ref
+      LOGICAL  , OPTIONAL, INTENT(OUT) :: build_workflow_graph
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: cell_methods
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: cell_methods_mode
+      LOGICAL  , OPTIONAL, INTENT(OUT) :: check_if_active
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: comment
+      INTEGER  , OPTIONAL, INTENT(OUT) :: compression_level
+      REAL (KIND=8) , OPTIONAL, INTENT(OUT) :: default_value
+      LOGICAL  , OPTIONAL, INTENT(OUT) :: detect_missing_value
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: domain_ref
+      LOGICAL  , OPTIONAL, INTENT(OUT) :: enabled
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: expr
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: field_ref
+      TYPE(xios_duration)  , OPTIONAL, INTENT(OUT) :: freq_offset
+      TYPE(xios_duration)  , OPTIONAL, INTENT(OUT) :: freq_op
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: grid_path
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: grid_ref
+      LOGICAL  , OPTIONAL, INTENT(OUT) :: indexed_output
+      INTEGER  , OPTIONAL, INTENT(OUT) :: level
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: long_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: name
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: operation
+      INTEGER  , OPTIONAL, INTENT(OUT) :: prec
+      LOGICAL  , OPTIONAL, INTENT(OUT) :: read_access
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: scalar_ref
+      REAL (KIND=8) , OPTIONAL, INTENT(OUT) :: scale_factor
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: standard_name
+      LOGICAL  , OPTIONAL, INTENT(OUT) :: ts_enabled
+      TYPE(xios_duration)  , OPTIONAL, INTENT(OUT) :: ts_split_freq
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: unit
+      REAL (KIND=8) , OPTIONAL, INTENT(OUT) :: valid_max
+      REAL (KIND=8) , OPTIONAL, INTENT(OUT) :: valid_min
+
+  END SUBROUTINE xios_get_field_attr
+
+  SUBROUTINE xios_get_field_attr_hdl  &
+    ( field_hdl, add_offset, axis_ref, build_workflow_graph, cell_methods, cell_methods_mode, check_if_active  &
+    , comment, compression_level, default_value, detect_missing_value, domain_ref, enabled, expr  &
+    , field_ref, freq_offset, freq_op, grid_path, grid_ref, indexed_output, level, long_name, name  &
+    , operation, prec, read_access, scalar_ref, scale_factor, standard_name, ts_enabled, ts_split_freq  &
+    , unit, valid_max, valid_min )
+
+    IMPLICIT NONE
+      TYPE(xios_field) , INTENT(IN) :: field_hdl
+      REAL (KIND=8) , OPTIONAL, INTENT(OUT) :: add_offset
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: axis_ref
+      LOGICAL  , OPTIONAL, INTENT(OUT) :: build_workflow_graph
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: cell_methods
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: cell_methods_mode
+      LOGICAL  , OPTIONAL, INTENT(OUT) :: check_if_active
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: comment
+      INTEGER  , OPTIONAL, INTENT(OUT) :: compression_level
+      REAL (KIND=8) , OPTIONAL, INTENT(OUT) :: default_value
+      LOGICAL  , OPTIONAL, INTENT(OUT) :: detect_missing_value
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: domain_ref
+      LOGICAL  , OPTIONAL, INTENT(OUT) :: enabled
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: expr
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: field_ref
+      TYPE(xios_duration)  , OPTIONAL, INTENT(OUT) :: freq_offset
+      TYPE(xios_duration)  , OPTIONAL, INTENT(OUT) :: freq_op
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: grid_path
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: grid_ref
+      LOGICAL  , OPTIONAL, INTENT(OUT) :: indexed_output
+      INTEGER  , OPTIONAL, INTENT(OUT) :: level
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: long_name
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: name
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: operation
+      INTEGER  , OPTIONAL, INTENT(OUT) :: prec
+      LOGICAL  , OPTIONAL, INTENT(OUT) :: read_access
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: scalar_ref
+      REAL (KIND=8) , OPTIONAL, INTENT(OUT) :: scale_factor
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: standard_name
+      LOGICAL  , OPTIONAL, INTENT(OUT) :: ts_enabled
+      TYPE(xios_duration)  , OPTIONAL, INTENT(OUT) :: ts_split_freq
+      CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: unit
+      REAL (KIND=8) , OPTIONAL, INTENT(OUT) :: valid_max
+      REAL (KIND=8) , OPTIONAL, INTENT(OUT) :: valid_min
+
+  END SUBROUTINE xios_get_field_attr_hdl
+      
+END MODULE lmdz_xios
+
+#endif 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/misc/readTracFiles_mod.f90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/misc/readTracFiles_mod.f90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/misc/readTracFiles_mod.f90	(revision 4727)
@@ -114,9 +114,9 @@
   !--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
   CHARACTER(LEN=maxlen), SAVE      :: tran0        = 'air'      !--- Default transporting fluid
-  CHARACTER(LEN=maxlen), PARAMETER :: old_phases   = 'vlir'     !--- Old phases for water (no separator)
-  CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsr'     !--- Known phases initials
+  CHARACTER(LEN=maxlen), PARAMETER :: old_phases   = 'vlirb'     !--- Old phases for water (no separator)
+  CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsrb'     !--- Known phases initials
   INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases)        !--- Number of phases
   CHARACTER(LEN=maxlen), SAVE      :: phases_names(nphases) &   !--- Known phases names
-                                             = ['gaseous', 'liquid ', 'solid  ', 'cloud  ']
+                                = ['gaseous', 'liquid ', 'solid  ', 'cloud  ','blosno ']
   CHARACTER(LEN=1), SAVE :: phases_sep  =  '_'                  !--- Phase separator
   LOGICAL,          SAVE :: tracs_merge = .TRUE.                !--- Merge/stack tracers lists
Index: /LMDZ6/branches/LMDZ_ECRad/libf/misc/wxios.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/misc/wxios.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/misc/wxios.F90	(revision 4727)
@@ -1,14 +1,6 @@
 ! $Id$
-#ifdef CPP_XIOS
+
 MODULE wxios
-    USE xios
-    USE iaxis
-    USE iaxis_attr
-    USE icontext_attr
-    USE idate
-    USE idomain_attr
-    USE ifield_attr
-    USE ifile_attr
-    USE ixml_tree
+    USE lmdz_xios
 
     !Variables disponibles pendant toute l'execution du programme:
@@ -159,4 +151,6 @@
         g_ctx = xios_ctx
 
+        CALL wxios_add_group_init
+        
         IF (prt_level >= 10) THEN
           WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
@@ -168,4 +162,116 @@
     END SUBROUTINE wxios_context_init
 
+
+    
+    SUBROUTINE wxios_add_group_init
+
+      ! routine create by Anne Cozic (2023)
+      ! This routine will create field associated to group defined without description of fields in field.xml file
+      ! This routine need to be call before "xios_sole_inheritance" after an !$OMP MASTER directive 
+      
+      USE infotrac_phy, ONLY: nbtr, nqtot, nqo, type_trac, tracers, niso, ntiso
+      USE strings_mod,  ONLY: maxlen
+
+      IMPLICIT NONE
+
+      TYPE(xios_fieldgroup) :: group_handle, philev_hdl
+      TYPE(xios_field) :: child
+      INTEGER :: k, iq
+      CHARACTER(len=12) :: nvar, name_phi    
+      CHARACTER(LEN=maxlen) :: varname, dn
+      CHARACTER(LEN=maxlen) :: unt
+    
+
+      ! group create for StratAER variables 
+      !On ajoute les variables 3D traceurs par l interface fortran 
+      CALL xios_get_handle("fields_strataer_trac_3D", group_handle)
+      ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
+      DO iq = 1, nqtot
+         IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
+         dn = 'd'//TRIM(tracers(iq)%name)//'_'
+
+         unt = "kg kg-1"
+         varname=trim(tracers(iq)%name)
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         
+         unt = "kg kg-1 s-1"
+         varname=TRIM(dn)//'vdf'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'the'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'con'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'lessi_impa'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'lessi_nucl'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'insc'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'bcscav'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'evapls'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'ls'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'trsp'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'sscav'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'sat'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         varname=TRIM(dn)//'uscav'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+      END DO
+      !On ajoute les variables 2D traceurs par l interface fortran 
+      CALL xios_get_handle("fields_strataer_trac_2D", group_handle)
+      ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
+      DO iq = 1, nqtot
+         IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
+         
+         unt = "kg m-2"
+         varname='cum'//trim(tracers(iq)%name)
+         
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+         
+         unt = "kg m-2 s-1"
+         varname='cumd'//trim(tracers(iq)%name)//'_dry'
+         CALL xios_add_child(group_handle, child, varname)
+         CALL xios_set_attr(child, name=varname, unit=unt)
+      ENDDO
+      
+
+      ! group create for offline mass flow variables
+      CALL xios_get_handle("philev_grp", philev_hdl)
+
+      DO k=1,79
+         IF (k<10) THEN
+            WRITE(nvar,'(i1)') k
+         ELSE IF (k<100) THEN
+            WRITE(nvar,'(i2)') k
+         ELSE
+            WRITE(nvar,'(i3)') k
+         END IF
+         name_phi= "phi_lev"//TRIM(nvar)
+         CALL xios_add_child(philev_hdl, child, "phi_lev"//TRIM(nvar)) 
+         CALL xios_set_attr(child, name=trim(name_phi))
+      ENDDO
+
+
+    END SUBROUTINE wxios_add_group_init
 
     SUBROUTINE wxios_set_context()
@@ -297,10 +403,10 @@
         
         !On récupère le handle:
-        CALL xios_get_domain_handle(dom_id, dom)
+        CALL xios_get_handle(dom_id, dom)
         
         !On parametrise le domaine:
-        CALL xios_set_domain_attr_hdl(dom, ni_glo=nbp_lon, ibegin=0, ni=nbp_lon, type="rectilinear")
-        CALL xios_set_domain_attr_hdl(dom, nj_glo=nbp_lat, jbegin=jj_begin-1, nj=jj_nb, data_dim=2)
-        CALL xios_set_domain_attr_hdl(dom, lonvalue_1d=io_lon(1:nbp_lon), latvalue_1d=io_lat(jj_begin:jj_end))
+        CALL xios_set_attr(dom, ni_glo=nbp_lon, ibegin=0, ni=nbp_lon, type="rectilinear")
+        CALL xios_set_attr(dom, nj_glo=nbp_lat, jbegin=jj_begin-1, nj=jj_nb, data_dim=2)
+        CALL xios_set_attr(dom, lonvalue_1d=io_lon(1:nbp_lon), latvalue_1d=io_lat(jj_begin:jj_end))
         CALL xios_set_domain_attr("dom_out", domain_ref=dom_id)
 
@@ -324,8 +430,8 @@
               WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,jj_nb)=",mask(:,jj_nb)
             ENDIF
-            CALL xios_set_domain_attr_hdl(dom, mask_2d=mask)
-        END IF
-
-         CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool)
+            CALL xios_set_attr(dom, mask_2d=mask)
+        END IF
+
+         CALL xios_is_defined_attr(dom,ni_glo=boool)
         !Vérification:
         IF (xios_is_valid_domain(dom_id)) THEN
@@ -366,5 +472,5 @@
 
 !$OMP MASTER
-        CALL xios_get_domain_handle(dom_id, dom)
+        CALL xios_get_handle(dom_id, dom)
         
         !On parametrise le domaine:
@@ -466,6 +572,6 @@
         IF (.NOT.xios_is_valid_file(fname)) THEN
             !On créé le noeud:
-            CALL xios_get_filegroup_handle("defile", x_fg)
-            CALL xios_add_file(x_fg, x_file, fname)
+            CALL xios_get_handle("defile", x_fg)
+            CALL xios_add_child(x_fg, x_file, fname)
         
             !On reformate la fréquence:
@@ -473,5 +579,5 @@
         
             !On configure:
-            CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
+            CALL xios_set_attr(x_file, name="X"//fname,&
                 output_freq=nffreq, output_level=flvl, enabled=.TRUE.)
        
@@ -522,9 +628,9 @@
         
         !On ajoute le champ:
-        CALL xios_add_field(fieldgroup, field, fieldname)
+        CALL xios_add_child(fieldgroup, field, fieldname)
         !IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
         
         !On rentre ses paramètres:
-        CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
+        CALL xios_set_attr(field, standard_name=fieldlongname, unit=newunit, default_value=def)
         IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
         IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: long_name=",trim(fieldlongname),"; unit=",trim(newunit),";  default_value=",nf90_fill_real
@@ -577,7 +683,7 @@
         !On selectionne le bon groupe de champs:
         IF (fdim.EQ.2) THEN
-          CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
+          CALL xios_get_handle("fields_2D", fieldgroup)
         ELSE
-          CALL xios_get_fieldgroup_handle("fields_3D", fieldgroup)
+          CALL xios_get_handle("fields_3D", fieldgroup)
         ENDIF
         
@@ -608,15 +714,15 @@
             !Champ existe déjà, mais pas XML, alors on l'ajoute
             !On ajoute le champ:
-            CALL xios_get_file_handle(fname, f)
-            CALL xios_add_fieldtofile(f, field)
+            CALL xios_get_handle(fname, f)
+            CALL xios_add_child(f, field)
             
             
             !L'operation, sa frequence:
             freq_op%timestep=1
-            CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op=freq_op, prec=4)
+            CALL xios_set_attr(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op=freq_op, prec=4)
 
             
             !On rentre ses paramètres:
-            CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
+            CALL xios_set_attr(field, level=field_level, enabled=.TRUE.)
             
             IF (fdim.EQ.2) THEN
@@ -630,5 +736,5 @@
                 !Si 3D :
                 !On ajoute l'axe vertical qui va bien:
-                CALL xios_set_field_attr_hdl(field, axis_ref=TRIM(ADJUSTL(axis_id)))
+                CALL xios_set_attr(field, axis_ref=TRIM(ADJUSTL(axis_id)))
                 
                 IF (prt_level >= 10) THEN
@@ -678,3 +784,3 @@
      END SUBROUTINE wxios_close
 END MODULE wxios
-#endif
+
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phy_common/abort_physic.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phy_common/abort_physic.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phy_common/abort_physic.F90	(revision 4727)
@@ -38,20 +38,20 @@
       if (ierr .eq. 0) then
         write(lunout,*) 'Everything is cool'
-#ifdef CPP_MPI
-        !$OMP CRITICAL (MPI_ABORT_PHYSIC)
-        call MPI_ABORT(COMM_LMDZ_PHY, 0, ierror_mpi)
-        !$OMP END CRITICAL (MPI_ABORT_PHYSIC)
-#else
-        stop 0
-#endif          
+        if (using_mpi) then
+          !$OMP CRITICAL (MPI_ABORT_PHYSIC)
+          call MPI_ABORT(COMM_LMDZ_PHY, 0, ierror_mpi)
+          !$OMP END CRITICAL (MPI_ABORT_PHYSIC)
+        else
+          stop 0
+        endif          
       else
         write(lunout,*) 'Houston, we have a problem, ierr = ', ierr
-#ifdef CPP_MPI
-!$OMP CRITICAL (MPI_ABORT_PHYSIC)
-        call MPI_ABORT(COMM_LMDZ_PHY, 1, ierror_mpi)
-!$OMP END CRITICAL (MPI_ABORT_PHYSIC)
-#else
-        stop 1
-#endif          
+        if (using_mpi) then
+          !$OMP CRITICAL (MPI_ABORT_PHYSIC)
+          call MPI_ABORT(COMM_LMDZ_PHY, 1, ierror_mpi)
+          !$OMP END CRITICAL (MPI_ABORT_PHYSIC)
+        else
+          stop 1
+        endif          
       endif
       END
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phy_common/mod_phys_lmdz_mpi_data.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phy_common/mod_phys_lmdz_mpi_data.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phy_common/mod_phys_lmdz_mpi_data.F90	(revision 4727)
@@ -3,5 +3,6 @@
 !
 MODULE mod_phys_lmdz_mpi_data
-  
+  USE lmdz_mpi 
+
   INTEGER,SAVE :: ii_begin
   INTEGER,SAVE :: ii_end
@@ -47,9 +48,6 @@
   
   SUBROUTINE init_phys_lmdz_mpi_data(nbp, nbp_lon, nbp_lat, nbp_lev, grid_type, nvertex, communicator)
-
+  USE lmdz_mpi
   IMPLICIT NONE
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
     INTEGER,INTENT(IN) :: nbp
     INTEGER,INTENT(IN) :: nbp_lon
@@ -65,9 +63,5 @@
     INTEGER :: i
     
-#ifdef CPP_MPI
-    is_using_mpi=.TRUE.
-#else
-    is_using_mpi=.FALSE.
-#endif
+    is_using_mpi = using_mpi
     
     if ((nbp_lon.eq.1).and.(nbp_lat.eq.1)) then ! running 1D column model
@@ -82,9 +76,7 @@
 
     IF (is_using_mpi) THEN    
-#ifdef CPP_MPI
       MPI_REAL_LMDZ=MPI_REAL8
       CALL MPI_COMM_SIZE(COMM_LMDZ_PHY,mpi_size,ierr)    
       CALL MPI_COMM_RANK(COMM_LMDZ_PHY,mpi_rank,ierr)
-#endif
     ELSE
       mpi_size=1
@@ -95,7 +87,5 @@
 
     IF (is_using_mpi) THEN    
-#ifdef CPP_MPI
-    CALL MPI_ALLGATHER(nbp,1,MPI_INTEGER,distrib,1,MPI_INTEGER,COMM_LMDZ_PHY,ierr)
-#endif
+      CALL MPI_ALLGATHER(nbp,1,MPI_INTEGER,distrib,1,MPI_INTEGER,COMM_LMDZ_PHY,ierr)
     ELSE
      distrib(:)=nbp
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phy_common/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phy_common/mod_phys_lmdz_mpi_transfert.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phy_common/mod_phys_lmdz_mpi_transfert.F90	(revision 4727)
@@ -1367,4 +1367,5 @@
   SUBROUTINE bcast_mpi_cgen(var,nb)
     USE mod_phys_lmdz_mpi_data 
+    USE lmdz_mpi
     IMPLICIT NONE
     
@@ -1372,14 +1373,9 @@
     INTEGER,INTENT(IN) :: nb
     
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
     INTEGER :: ierr
 
     IF (.not.is_using_mpi) RETURN
     
-#ifdef CPP_MPI
     CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_master,COMM_LMDZ_PHY,ierr)
-#endif
         
   END SUBROUTINE bcast_mpi_cgen
@@ -1389,4 +1385,5 @@
   SUBROUTINE bcast_mpi_igen(var,nb)
     USE mod_phys_lmdz_mpi_data
+    USE lmdz_mpi
     IMPLICIT NONE
     
@@ -1394,14 +1391,9 @@
     INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
     
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
     INTEGER :: ierr
 
     IF (.not.is_using_mpi) RETURN
 
-#ifdef CPP_MPI
     CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_master,COMM_LMDZ_PHY,ierr)
-#endif
         
   END SUBROUTINE bcast_mpi_igen
@@ -1412,4 +1404,5 @@
   SUBROUTINE bcast_mpi_rgen(var,nb)
     USE mod_phys_lmdz_mpi_data
+    USE lmdz_mpi
     IMPLICIT NONE
     
@@ -1417,14 +1410,9 @@
     REAL,DIMENSION(nb),INTENT(INOUT) :: Var
     
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
     INTEGER :: ierr
 
     IF (.not.is_using_mpi) RETURN
 
-#ifdef CPP_MPI
     CALL MPI_BCAST(Var,nb,MPI_REAL_LMDZ,mpi_master,COMM_LMDZ_PHY,ierr)
-#endif
     
   END SUBROUTINE bcast_mpi_rgen
@@ -1435,4 +1423,5 @@
   SUBROUTINE bcast_mpi_lgen(var,nb)
     USE mod_phys_lmdz_mpi_data
+    USE lmdz_mpi
     IMPLICIT NONE
     
@@ -1440,14 +1429,9 @@
     LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
     
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
     INTEGER :: ierr
 
     IF (.not.is_using_mpi) RETURN
 
-#ifdef CPP_MPI
     CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_master,COMM_LMDZ_PHY,ierr)
-#endif
 
   END SUBROUTINE bcast_mpi_lgen
@@ -1458,4 +1442,5 @@
     USE mod_phys_lmdz_mpi_data 
     USE mod_grid_phy_lmdz
+    USE lmdz_mpi
     IMPLICIT NONE
   
@@ -1464,7 +1449,4 @@
     INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
   
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
     INTEGER,DIMENSION(0:mpi_size-1) :: displs
     INTEGER,DIMENSION(0:mpi_size-1) :: counts
@@ -1493,8 +1475,6 @@
     ENDIF
       
-#ifdef CPP_MPI 
     CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INTEGER,VarOut,klon_mpi*dimsize,   &
                       MPI_INTEGER,mpi_master, COMM_LMDZ_PHY,ierr)
-#endif
 
   END SUBROUTINE scatter_mpi_igen
@@ -1503,4 +1483,5 @@
     USE mod_phys_lmdz_mpi_data 
     USE mod_grid_phy_lmdz
+    USE lmdz_mpi
     IMPLICIT NONE
   
@@ -1508,8 +1489,4 @@
     REAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
     REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
-  
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
 
     INTEGER,DIMENSION(0:mpi_size-1) :: displs
@@ -1537,10 +1514,7 @@
     ENDIF
       
-#ifdef CPP_MPI 
     CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_LMDZ,VarOut,klon_mpi*dimsize,   &
                       MPI_REAL_LMDZ,mpi_master, COMM_LMDZ_PHY,ierr)
 
-#endif
-
   END SUBROUTINE scatter_mpi_rgen
 
@@ -1549,4 +1523,5 @@
     USE mod_phys_lmdz_mpi_data 
     USE mod_grid_phy_lmdz
+    USE lmdz_mpi
     IMPLICIT NONE
   
@@ -1555,7 +1530,4 @@
     LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
   
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
 
     INTEGER,DIMENSION(0:mpi_size-1) :: displs
@@ -1583,8 +1555,6 @@
     ENDIF
       
-#ifdef CPP_MPI
     CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,klon_mpi*dimsize,   &
                       MPI_LOGICAL,mpi_master, COMM_LMDZ_PHY,ierr)
-#endif
 
   END SUBROUTINE scatter_mpi_lgen  
@@ -1596,10 +1566,7 @@
     USE mod_phys_lmdz_mpi_data
     USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-  
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-    
+    USE lmdz_mpi
+    IMPLICIT NONE
+  
     INTEGER,INTENT(IN) :: dimsize
     INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
@@ -1628,8 +1595,6 @@
     ENDIF
     
-#ifdef CPP_MPI
     CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_INTEGER,VarTmp,counts,displs,   &
                      MPI_INTEGER,mpi_master, COMM_LMDZ_PHY,ierr)
-#endif
 
                           
@@ -1650,10 +1615,7 @@
     USE mod_phys_lmdz_mpi_data 
     USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-  
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-    
+    USE lmdz_mpi
+    IMPLICIT NONE
+  
     INTEGER,INTENT(IN) :: dimsize
     REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
@@ -1681,8 +1643,6 @@
     ENDIF
 
-#ifdef CPP_MPI
     CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_REAL_LMDZ,VarTmp,counts,displs,   &
                       MPI_REAL_LMDZ,mpi_master, COMM_LMDZ_PHY,ierr)
-#endif
                           
     IF (is_mpi_root) THEN
@@ -1702,4 +1662,5 @@
     USE mod_phys_lmdz_mpi_data
     USE mod_grid_phy_lmdz
+    USE lmdz_mpi
     IMPLICIT NONE
   
@@ -1707,8 +1668,4 @@
     LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
     LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
-  
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
 
     INTEGER,DIMENSION(0:mpi_size-1) :: displs
@@ -1734,8 +1691,6 @@
     
 
-#ifdef CPP_MPI
     CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
                       MPI_LOGICAL,mpi_master, COMM_LMDZ_PHY,ierr)
-#endif
                           
     IF (is_mpi_root) THEN
@@ -1757,9 +1712,6 @@
     USE mod_phys_lmdz_mpi_data 
     USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-    
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
+    USE lmdz_mpi
+    IMPLICIT NONE
    
     INTEGER,INTENT(IN) :: nb
@@ -1774,7 +1726,5 @@
 
 
-#ifdef CPP_MPI
     CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_SUM,mpi_master,COMM_LMDZ_PHY,ierr)
-#endif
             
   END SUBROUTINE reduce_sum_mpi_igen
@@ -1783,11 +1733,7 @@
     USE mod_phys_lmdz_mpi_data 
     USE mod_grid_phy_lmdz
-
-    IMPLICIT NONE
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-    
+    USE lmdz_mpi
+    IMPLICIT NONE
+
     INTEGER,INTENT(IN) :: nb
     REAL,DIMENSION(nb),INTENT(IN) :: VarIn
@@ -1800,7 +1746,5 @@
     ENDIF
    
-#ifdef CPP_MPI
     CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_SUM,mpi_master,COMM_LMDZ_PHY,ierr)
-#endif
         
   END SUBROUTINE reduce_sum_mpi_rgen
@@ -1811,10 +1755,7 @@
     USE mod_phys_lmdz_mpi_data 
     USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-    
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-   
+    USE lmdz_mpi
+    IMPLICIT NONE
+    
     INTEGER,INTENT(IN) :: nb
     INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn
@@ -1828,7 +1769,5 @@
 
 
-#ifdef CPP_MPI
     CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_MIN,mpi_master,COMM_LMDZ_PHY,ierr)
-#endif
             
   END SUBROUTINE reduce_min_mpi_igen
@@ -1837,11 +1776,8 @@
     USE mod_phys_lmdz_mpi_data 
     USE mod_grid_phy_lmdz
-
-    IMPLICIT NONE
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-    
+    USE lmdz_mpi
+
+    IMPLICIT NONE
+
     INTEGER,INTENT(IN) :: nb
     REAL,DIMENSION(nb),INTENT(IN) :: VarIn
@@ -1854,7 +1790,5 @@
     ENDIF
    
-#ifdef CPP_MPI
     CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_MIN,mpi_master,COMM_LMDZ_PHY,ierr)
-#endif
         
   END SUBROUTINE reduce_min_mpi_rgen
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phydev/iophy.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phydev/iophy.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phydev/iophy.F90	(revision 4727)
@@ -13,27 +13,13 @@
   
 
-#ifdef CPP_XIOS
 ! interfaces for both IOIPSL and XIOS
   INTERFACE histwrite_phy
     MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_xios,histwrite3d_xios
   END INTERFACE
-#else
-! interfaces for IOIPSL
-  INTERFACE histwrite_phy
-    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy
-  END INTERFACE
-#endif
-
-#ifdef CPP_XIOS
+
 ! interfaces for both IOIPSL and XIOS
   INTERFACE histbeg_phy_all
     MODULE PROCEDURE histbeg_phy, histbeg_phyxios
   END INTERFACE
-#else
-! interfaces for IOIPSL
-  INTERFACE histbeg_phy_all
-    MODULE PROCEDURE histbeg_phy
-  END INTERFACE
-#endif
 
 contains
@@ -51,7 +37,5 @@
   USE ioipsl, only: flio_dom_set
 #endif
-#ifdef CPP_XIOS
-  use wxios, only: wxios_domain_param
-#endif
+  use wxios, only: wxios_domain_param, using_xios
   implicit none
     real,dimension(klon),intent(in) :: rlon
@@ -122,32 +106,32 @@
                       'APPLE',phys_domain_id)
 #endif
-#ifdef CPP_XIOS
-    ! Set values for the mask:
-    IF (mpi_rank == 0) THEN
-        data_ibegin = 0
-    ELSE 
-        data_ibegin = ii_begin - 1
-    END IF
-
-    IF (mpi_rank == mpi_size-1) THEN
-        data_iend = nbp_lon
-    ELSE
-        data_iend = ii_end + 1
-    END IF
-
-    if (prt_level>=10) then
-      write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
-      write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
-      write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
-      write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
-      write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn
-    endif
-
-    ! Initialize the XIOS domain coreesponding to this process:
-    CALL wxios_domain_param("dom_glo", is_sequential, nbp_lon, jj_nb, nbp_lon, nbp_lat, &
-                            1, nbp_lon, ii_begin, ii_end, jj_begin, jj_end,             &
-                            klon_mpi+2*(nbp_lon-1), data_ibegin, data_iend,             &
-                            io_lat, io_lon,is_south_pole_dyn,mpi_rank)
-#endif
+    IF (using_xios) THEN
+      ! Set values for the mask:
+      IF (mpi_rank == 0) THEN
+          data_ibegin = 0
+      ELSE 
+          data_ibegin = ii_begin - 1
+      END IF
+
+      IF (mpi_rank == mpi_size-1) THEN
+          data_iend = nbp_lon
+      ELSE
+          data_iend = ii_end + 1
+      END IF
+
+      if (prt_level>=10) then
+        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
+        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
+        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
+        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
+        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn
+      endif
+
+      ! Initialize the XIOS domain coreesponding to this process:
+      CALL wxios_domain_param("dom_glo", is_sequential, nbp_lon, jj_nb, nbp_lon, nbp_lat, &
+                              1, nbp_lon, ii_begin, ii_end, jj_begin, jj_end,             &
+                              klon_mpi+2*(nbp_lon-1), data_ibegin, data_iend,             &
+                              io_lat, io_lon,is_south_pole_dyn,mpi_rank)
+    ENDIF
 !$OMP END MASTER
       
@@ -184,5 +168,4 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-#ifdef CPP_XIOS
 
 ! SUBROUTINE histbeg_phyxios(name,itau0,zjulian,dtime,ffreq,lev,nhori,nid_day)
@@ -213,5 +196,4 @@
   END SUBROUTINE histbeg_phyxios
 
-#endif
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -339,10 +321,10 @@
 
 ! VERSION DES HISTWRITE DEDIEES AU TOUT-XIOS-XML DEJA UTILISEE DANS PHYDEV
-#ifdef CPP_XIOS
+
   SUBROUTINE histwrite2d_xios(field_name,field)
   USE dimphy, only: klon
   USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
                                 jj_nb, klon_mpi
-  USE xios, only: xios_send_field
+  USE lmdz_xios, only: xios_send_field
   USE print_control_mod, ONLY: prt_level, lunout
   USE mod_grid_phy_lmdz, ONLY: nbp_lon
@@ -368,15 +350,14 @@
     IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',trim(field_name)
   END SUBROUTINE histwrite2d_xios
-#endif
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 ! VERSION DES HISTWRITE DEDIEES AU TOUT-XIOS-XML DEJA UTILISEE DANS PHYDEV
-#ifdef CPP_XIOS
+
   SUBROUTINE histwrite3d_xios(field_name, field)
   USE dimphy, only: klon, klev
   USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
                                 jj_nb, klon_mpi
-  USE xios, only: xios_send_field
+  USE lmdz_xios, only: xios_send_field
   USE print_control_mod, ONLY: prt_level,lunout
   USE mod_grid_phy_lmdz, ONLY: nbp_lon
@@ -407,5 +388,4 @@
     IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',trim(field_name)
   END SUBROUTINE histwrite3d_xios
-#endif
 
 end module iophy
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phydev/physiq_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phydev/physiq_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phydev/physiq_mod.F90	(revision 4727)
@@ -23,9 +23,7 @@
       USE mod_grid_phy_lmdz, ONLY: nbp_lon,nbp_lat
 
-#ifdef CPP_XIOS
-      USE xios, ONLY: xios_update_calendar
+      USE lmdz_xios, ONLY: xios_update_calendar, using_xios
       USE wxios, only: wxios_add_vaxis, wxios_set_cal, wxios_closedef
       USE iophy, ONLY: histwrite_phy
-#endif
 
       IMPLICIT none
@@ -126,15 +124,15 @@
 #endif
 
-#ifdef CPP_XIOS
+    IF (using_xios) THEN
 !XIOS
-    ! Declare available vertical axes to be used in output files:    
-    CALL wxios_add_vaxis("presnivs", klev, presnivs)
+      ! Declare available vertical axes to be used in output files:    
+      CALL wxios_add_vaxis("presnivs", klev, presnivs)
 
-    ! Declare calendar and time step
-    CALL wxios_set_cal(dtime,"earth_360d",1,1,1,0.0,1,1,1,0.0)
+      ! Declare calendar and time step
+      CALL wxios_set_cal(dtime,"earth_360d",1,1,1,0.0,1,1,1,0.0)
     
-    !Finalize the context:
-    CALL wxios_closedef()
-#endif
+      !Finalize the context:
+      CALL wxios_closedef()
+    ENDIF
 !$OMP END MASTER
 !$OMP BARRIER
@@ -176,10 +174,10 @@
 
 !XIOS
-#ifdef CPP_XIOS
-!$OMP MASTER
+IF (using_xios) THEN
+  !$OMP MASTER
     !Increment XIOS time
     CALL xios_update_calendar(itau)
-!$OMP END MASTER
-!$OMP BARRIER
+  !$OMP END MASTER
+  !$OMP BARRIER
 
     !Send fields to XIOS: (NB these fields must also be defined as
@@ -190,5 +188,5 @@
     CALL histwrite_phy("v",v)
     CALL histwrite_phy("ps",paprs(:,1))
-#endif
+ENDIF
 
 ! if lastcall, then it is time to write "restartphy.nc" file
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/aeropt_spl.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/aeropt_spl.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/aeropt_spl.F	(revision 4727)
@@ -12,8 +12,8 @@
       IMPLICIT none
 c
-#include "chem.h"
-#include "dimensions.h"
-c #include "dimphy.h"
-#include "YOMCST.h"
+      INCLUDE "chem.h"
+      INCLUDE "dimensions.h"
+cINCLUDE "dimphy.h"
+      INCLUDE "YOMCST.h"
 c
 c Arguments:
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/bcscav_spl.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/bcscav_spl.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/bcscav_spl.F	(revision 4727)
@@ -9,8 +9,8 @@
 c=====================================================================
 c
-#include "dimensions.h"
-#include "chem.h"
-#include "YOMCST.h"
-#include "YOECUMF.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOECUMF.h"
 c
       REAL pdtime, alpha_r, alpha_s, R_r, R_s 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/bl_for_dms.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/bl_for_dms.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/bl_for_dms.F	(revision 4727)
@@ -17,8 +17,8 @@
 c===================================================================
 c
-#include "dimensions.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOETHF.h"
+      INCLUDE "FCTTRE.h"
 c
 c Arguments :
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/blcloud_scav.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/blcloud_scav.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/blcloud_scav.F	(revision 4727)
@@ -10,8 +10,8 @@
       IMPLICIT NONE
 
-#include "dimensions.h"
-#include "chem.h"
-#include "YOMCST.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "paramet.h"
 
 c============================= INPUT ===================================
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/blcloud_scav_lsc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/blcloud_scav_lsc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/blcloud_scav_lsc.F	(revision 4727)
@@ -10,8 +10,8 @@
       IMPLICIT NONE
 
-#include "dimensions.h"
-#include "chem.h"
-#include "YOMCST.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "paramet.h"
 
 c============================= INPUT ===================================
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/checkmass.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/checkmass.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/checkmass.F90	(revision 4727)
@@ -4,5 +4,5 @@
   IMPLICIT NONE
 
-#include "YOMCST.h"
+  INCLUDE "YOMCST.h"
 
 ! Entrees
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/cltrac_spl.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/cltrac_spl.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/cltrac_spl.F	(revision 4727)
@@ -26,5 +26,5 @@
 c flux_tr--output-R- flux de tr
 c======================================================================
-#include "dimensions.h"
+      INCLUDE "dimensions.h"
       REAL dtime
       REAL coef(klon,klev)
@@ -36,5 +36,5 @@
 c      REAL flux_tr(klon,klev)
 c======================================================================
-#include "YOMCST.h"
+      INCLUDE "YOMCST.h"
 c======================================================================
       INTEGER i, k
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/cm3_to_kg.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/cm3_to_kg.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/cm3_to_kg.F	(revision 4727)
@@ -7,6 +7,6 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "YOMCST.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "YOMCST.h"
 c      
       REAL t_seri(klon,klev), pplay(klon,klev)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/coarsemission.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/coarsemission.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/coarsemission.F	(revision 4727)
@@ -33,9 +33,9 @@
       IMPLICIT NONE
 
-#include "dimensions.h"
-#include "chem.h"
-#include "chem_spla.h"
-#include "YOMCST.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+      INCLUDE "chem_spla.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "paramet.h"
       
 c============================== INPUT ==================================
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/condsurfc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/condsurfc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/condsurfc.F	(revision 4727)
@@ -9,6 +9,7 @@
 ! --------------------------------------------------------
 !
-#include "dimensions.h"
-#include "netcdf.inc"
+      INCLUDE "dimensions.h"
+      INCLUDE "netcdf.inc"
+      
       REAL lmt_bcff(klon), lmt_bcbb(klon),lmt_bc_penner(klon)
       REAL lmt_omff(klon), lmt_ombb(klon)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/condsurfc_new.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/condsurfc_new.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/condsurfc_new.F	(revision 4727)
@@ -11,6 +11,7 @@
 c --------------------------------------------------------
 c
-#include "dimensions.h"
-#include "netcdf.inc"
+      INCLUDE "dimensions.h"
+      INCLUDE "netcdf.inc"
+      
       REAL lmt_bcff(klon), lmt_bcnff(klon), lmt_bcba(klon)
       REAL lmt_omff(klon), lmt_omnff(klon), lmt_ombb(klon)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/condsurfs.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/condsurfs.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/condsurfs.F	(revision 4727)
@@ -9,6 +9,6 @@
 c --------------------------------------------------------
 c
-#include "dimensions.h"
-#include "netcdf.inc"
+      INCLUDE "dimensions.h"
+      INCLUDE "netcdf.inc"
 c
       REAL lmt_so2h(klon), lmt_so2b(klon), lmt_so2bb(klon)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/condsurfs_new.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/condsurfs_new.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/condsurfs_new.F	(revision 4727)
@@ -14,6 +14,6 @@
 c --------------------------------------------------------
 c
-#include "dimensions.h"
-#include "netcdf.inc"
+      INCLUDE "dimensions.h"
+      INCLUDE "netcdf.inc"
 c
       REAL lmt_so2b(klon), lmt_so2h(klon), lmt_so2nff(klon)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/deposition.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/deposition.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/deposition.F	(revision 4727)
@@ -12,8 +12,8 @@
       IMPLICIT NONE
 
-#include "dimensions.h"
-#include "chem.h"
-#include "YOMCST.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "paramet.h"
 
 c----------------------------- INPUT -----------------------------------
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/finemission.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/finemission.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/finemission.F	(revision 4727)
@@ -17,8 +17,8 @@
       IMPLICIT NONE
 
-#include "dimensions.h"
-#include "chem.h"
-#include "YOMCST.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "paramet.h"
 
       INTEGER i, k, kminbc, kmaxbc
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/gastoparticle.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/gastoparticle.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/gastoparticle.F	(revision 4727)
@@ -10,9 +10,9 @@
       IMPLICIT NONE 
 c
-#include "dimensions.h"
-#include "chem.h"
-#include "chem_spla.h"
-#include "YOMCST.h"
-#include "YOECUMF.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+      INCLUDE "chem_spla.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOECUMF.h"
 c
       REAL pdtphys
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/incloud_scav.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/incloud_scav.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/incloud_scav.F	(revision 4727)
@@ -11,8 +11,8 @@
       IMPLICIT NONE
 
-#include "dimensions.h"
-#include "chem.h"
-#include "YOMCST.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "paramet.h"
 
 c============================= INPUT ===================================
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/incloud_scav_lsc.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/incloud_scav_lsc.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/incloud_scav_lsc.F	(revision 4727)
@@ -11,8 +11,8 @@
       IMPLICIT NONE
 
-#include "dimensions.h"
-#include "chem.h"
-#include "YOMCST.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "paramet.h"
 
 c============================= INPUT ===================================
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/inscav_spl.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/inscav_spl.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/inscav_spl.F	(revision 4727)
@@ -10,8 +10,8 @@
 c=====================================================================
 c
-#include "dimensions.h"
-#include "chem.h"
-#include "YOMCST.h"
-#include "YOECUMF.h" 
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOECUMF.h" 
 c
       INTEGER it
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/kg_to_cm3.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/kg_to_cm3.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/kg_to_cm3.F	(revision 4727)
@@ -5,6 +5,6 @@
       IMPLICIT NONE
 c
-#include "dimensions.h"
-#include "YOMCST.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "YOMCST.h"
 c      
       REAL t_seri(klon,klev), pplay(klon,klev)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/minmaxqfi2.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/minmaxqfi2.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/minmaxqfi2.F	(revision 4727)
@@ -3,5 +3,5 @@
       USE dimphy
       USE infotrac
-#include "dimensions.h"
+      INCLUDE "dimensions.h"
 
 !      character*20 comment
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/minmaxsource.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/minmaxsource.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/minmaxsource.F	(revision 4727)
@@ -4,5 +4,5 @@
       USE infotrac
 
-#include "dimensions.h"
+      INCLUDE "dimensions.h"
 
 !      character*20 comment
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/neutral.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/neutral.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/neutral.F	(revision 4727)
@@ -28,5 +28,5 @@
 c
       USE dimphy
-#include "dimensions.h"
+      INCLUDE "dimensions.h"
 c
         real u10_mps(klon),ustar_mps(klon),obklen_m(klon)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/nightingale.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/nightingale.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/nightingale.F	(revision 4727)
@@ -7,6 +7,6 @@
       IMPLICIT NONE 
 c
-#include "dimensions.h"
-#include "YOMCST.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "YOMCST.h"
 c
       REAL u(klon,klev), v(klon,klev)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/phys_output_write_spl_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/phys_output_write_spl_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/phys_output_write_spl_mod.F90	(revision 4727)
@@ -389,10 +389,7 @@
     USE iophy, ONLY: set_itau_iophy, histwrite_phy
     USE netcdf, ONLY: nf90_fill_real
-
-#ifdef CPP_XIOS
     ! ug Pour les sorties XIOS
-    USE xios, ONLY: xios_update_calendar
-    USE wxios, ONLY: wxios_closedef, missing_val
-#endif
+    USE lmdz_xios, ONLY: xios_update_calendar, using_xios
+    USE wxios, ONLY: wxios_closedef, missing_val_xios => missing_val
     USE phys_cal_mod, ONLY : mth_len
 
@@ -438,9 +435,12 @@
     INTEGER, DIMENSION(iim*jjmp1*klev) :: ndex3d
     REAL, PARAMETER :: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
-!   REAL, PARAMETER :: missing_val=nf90_fill_real
-#ifndef CPP_XIOS
     REAL :: missing_val
-#endif
     REAL, PARAMETER :: un_jour=86400.
+
+    IF (using_xios) THEN
+      missing_val=missing_val_xios
+    ELSE
+      missing_val=nf90_fill_real
+    ENDIF
 
     ! On calcul le nouveau tau:
@@ -460,16 +460,17 @@
     ! ug la boucle qui suit ne sert qu'une fois, pour l'initialisation, sinon il n'y a toujours qu'un seul passage:
     DO iinit=1, iinitend
-#ifdef CPP_XIOS
-       !$OMP MASTER
-       IF (vars_defined) THEN
-          IF (prt_level >= 10) THEN
-             write(lunout,*)"phys_output_write: call xios_update_calendar, itau_w=",itau_w
-          ENDIF
-!          CALL xios_update_calendar(itau_w)
-          CALL xios_update_calendar(itap)
-       ENDIF
-       !$OMP END MASTER
-       !$OMP BARRIER
-#endif
+       IF (using_xios) THEN
+         !$OMP MASTER
+         IF (vars_defined) THEN
+            IF (prt_level >= 10) THEN
+               write(lunout,*)"phys_output_write: call xios_update_calendar, itau_w=",itau_w
+            ENDIF
+!           CALL xios_update_calendar(itau_w)
+            CALL xios_update_calendar(itap)
+         ENDIF
+         !$OMP END MASTER
+         !$OMP BARRIER
+       ENDIF !using_xios
+
        ! On procède à l'écriture ou à la définition des nombreuses variables:
 !!! Champs 1D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -489,5 +490,5 @@
 !!! Champs 2D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! JE20141223 <<
-#include "spla_output_write.h"
+       INCLUDE "spla_output_write.h"
 ! JE20141223 >>
 
@@ -828,38 +829,37 @@
 
 #ifdef CPP_IOIPSL
-#ifndef CPP_XIOS
-  IF (.NOT.ok_all_xml) THEN
-       ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX:
-       ! Champs interpolles sur des niveaux de pression
-       missing_val=missing_val_nf90
-       DO iff=1, nfiles
-          ll=0
-          DO k=1, nlevSTD
-             bb2=clevSTD(k) 
-             IF (bb2.EQ."850".OR.bb2.EQ."700".OR. &
-                  bb2.EQ."500".OR.bb2.EQ."200".OR. &
-                  bb2.EQ."100".OR. &
-                  bb2.EQ."50".OR.bb2.EQ."10") THEN
-
-                ! a refaire correctement !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-                ll=ll+1
-                CALL histwrite_phy(o_uSTDlevs(ll),uwriteSTD(:,k,iff), iff)
-                CALL histwrite_phy(o_vSTDlevs(ll),vwriteSTD(:,k,iff), iff)
-                CALL histwrite_phy(o_wSTDlevs(ll),wwriteSTD(:,k,iff), iff)
-                CALL histwrite_phy(o_zSTDlevs(ll),phiwriteSTD(:,k,iff), iff)
-                CALL histwrite_phy(o_qSTDlevs(ll),qwriteSTD(:,k,iff), iff)
-                CALL histwrite_phy(o_tSTDlevs(ll),twriteSTD(:,k,iff), iff)
-
-             ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR.
-          ENDDO
-       ENDDO
-  ENDIF
+  IF (.NOT. using_xios) THEN
+    IF (.NOT.ok_all_xml) THEN
+         ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX:
+         ! Champs interpolles sur des niveaux de pression
+         DO iff=1, nfiles
+           ll=0
+            DO k=1, nlevSTD
+               bb2=clevSTD(k) 
+               IF (bb2.EQ."850".OR.bb2.EQ."700".OR. &
+                    bb2.EQ."500".OR.bb2.EQ."200".OR. &
+                    bb2.EQ."100".OR. &
+                    bb2.EQ."50".OR.bb2.EQ."10") THEN
+
+                  ! a refaire correctement !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+                  ll=ll+1
+                  CALL histwrite_phy(o_uSTDlevs(ll),uwriteSTD(:,k,iff), iff)
+                  CALL histwrite_phy(o_vSTDlevs(ll),vwriteSTD(:,k,iff), iff)
+                  CALL histwrite_phy(o_wSTDlevs(ll),wwriteSTD(:,k,iff), iff)
+                  CALL histwrite_phy(o_zSTDlevs(ll),phiwriteSTD(:,k,iff), iff)
+                  CALL histwrite_phy(o_qSTDlevs(ll),qwriteSTD(:,k,iff), iff)
+                  CALL histwrite_phy(o_tSTDlevs(ll),twriteSTD(:,k,iff), iff)
+
+               ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR.
+            ENDDO
+         ENDDO
+    ENDIF
+  ENDIF !.NOT.using_xios
 #endif
-#endif
-
-#ifdef CPP_XIOS
-  IF (ok_all_xml) THEN
-!XIOS  CALL xios_get_field_attr("u850",default_value=missing_val)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  IF (using_xios) THEN
+    IF (ok_all_xml) THEN
+  !XIOS  CALL xios_get_field_attr("u850",default_value=missing_val)
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
           ll=0
           DO k=1, nlevSTD
@@ -878,6 +878,6 @@
              ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR.
           ENDDO
-  ENDIF
-#endif
+    ENDIF
+  ENDIF !using_xios
        IF (vars_defined) THEN
           DO i=1, klon
@@ -1471,9 +1471,9 @@
 !!!!!!!!!!!! Sorties niveaux de pression NMC !!!!!!!!!!!!!!!!!!!!
 #ifdef CPP_IOIPSL
-#ifndef CPP_XIOS
-  IF (.NOT.ok_all_xml) THEN 
-       ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX:
-       ! Champs interpolles sur des niveaux de pression
-       missing_val=missing_val_nf90
+
+  IF (.NOT. using_xios) THEN
+    IF (.NOT.ok_all_xml) THEN 
+         ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX:
+         ! Champs interpolles sur des niveaux de pression
        DO iff=7, nfiles-1 !--here we deal with files 7,8 and 9
 
@@ -1539,8 +1539,9 @@
           CALL histwrite_phy(o_TxT,T2sumSTD(:,:,iff-6),iff)
        ENDDO !nfiles
+    ENDIF
   ENDIF
 #endif
-#endif
-#ifdef CPP_XIOS
+
+IF (using_xios) THEN
   IF (ok_all_xml) THEN 
 !      DO iff=7, nfiles
@@ -1607,6 +1608,6 @@
           CALL histwrite_phy(o_TxT,T2STD(:,:))
 !      ENDDO !nfiles
-  ENDIF
-#endif
+    ENDIF
+  ENDIF !using_xios
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
            itr = 0
@@ -1651,8 +1652,6 @@
           ENDDO !  iff
 #endif
-#ifdef CPP_XIOS
           !On finalise l'initialisation:
-          CALL wxios_closedef()
-#endif
+          IF (using_xios) CALL wxios_closedef()
 
           !$OMP END MASTER
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/phytracr_spl_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/phytracr_spl_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/phytracr_spl_mod.F90	(revision 4727)
@@ -804,7 +804,7 @@
 
       USE mod_phys_lmdz_transfert_para
-
-  USE phys_cal_mod, only: jD_1jan,year_len, mth_len, days_elapsed, jh_1jan, year_cur, &
-       mth_cur, phys_cal_update
+      USE lmdz_thermcell_dq,  ONLY : thermcell_dq
+      USE phys_cal_mod, only: jD_1jan,year_len, mth_len, days_elapsed, jh_1jan, year_cur, &
+                              mth_cur, phys_cal_update
 
 !
@@ -823,11 +823,11 @@
 !!   et c'est encore different avec le parser de DC ?
 !======================================================================
-#include "dimensions.h"
-#include "chem.h"
-#include "chem_spla.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "paramet.h"
-#include "alpale.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+      INCLUDE "chem_spla.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOETHF.h"
+      INCLUDE "paramet.h"
+      INCLUDE "alpale.h"
 
 !======================================================================
@@ -1070,5 +1070,5 @@
 !----------
       REAL,DIMENSION(klon,klev+1),INTENT(IN)   :: fm_therm
-      REAL,DIMENSION(klon,klev),INTENT(IN)     :: entr_therm
+      REAL,DIMENSION(klon,klev),INTENT(INOUT)     :: entr_therm
 
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/precuremission.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/precuremission.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/precuremission.F	(revision 4727)
@@ -22,9 +22,9 @@
       IMPLICIT NONE
 
-#include "dimensions.h"
-#include "chem.h"
-#include "chem_spla.h"
-#include "YOMCST.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+      INCLUDE "chem_spla.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "paramet.h"
 
 c============================= INPUT ===================================
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/read_dust.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/read_dust.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/read_dust.F	(revision 4727)
@@ -5,7 +5,7 @@
       IMPLICIT NONE 
 c
-#include "dimensions.h"
-#include "paramet.h"
-#include "netcdf.inc"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "netcdf.inc"
 c
       INTEGER step, nbjour
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/read_newemissions.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/read_newemissions.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/read_newemissions.F	(revision 4727)
@@ -26,5 +26,5 @@
 
 
-#include "dimensions.h"
+      INCLUDE "dimensions.h"
 c      INCLUDE 'dimphy.h'      
       INCLUDE 'paramet.h'      
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/read_surface.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/read_surface.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/read_surface.F90	(revision 4727)
@@ -13,7 +13,7 @@
        IMPLICIT NONE
 
-       include "netcdf.inc"
-#include "dimensions.h"
-#include "paramet.h"
+       INCLUDE "netcdf.inc"
+       INCLUDE "dimensions.h"
+       INCLUDE "paramet.h"
 
        character*10 name
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/read_vent.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/read_vent.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/read_vent.F	(revision 4727)
@@ -5,8 +5,8 @@
 !      USE write_field_phy
       IMPLICIT NONE 
-#include "dimensions.h"
-c #include "dimphy.h"
-#include "paramet.h"
-#include "netcdf.inc"
+      INCLUDE "dimensions.h"
+c       INCLUDE "dimphy.h"
+      INCLUDE "paramet.h"
+      INCLUDE "netcdf.inc"
 c
       INTEGER step, nbjour
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/seasalt.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/seasalt.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/seasalt.F	(revision 4727)
@@ -7,9 +7,9 @@
       IMPLICIT NONE 
 c
-#include "dimensions.h"
-#include "chem.h"
-#include "chem_spla.h"
-#include "YOMCST.h"
-#include "YOECUMF.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+      INCLUDE "chem_spla.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOECUMF.h"
 c
       INTEGER i, bin                 !local variables
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/sediment_mod.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/sediment_mod.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/sediment_mod.F	(revision 4727)
@@ -12,9 +12,9 @@
       IMPLICIT NONE 
 c
-#include "dimensions.h"
-#include "chem.h"
-c #include "dimphy.h"
-#include "YOMCST.h"
-#include "YOECUMF.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+c       INCLUDE "dimphy.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOECUMF.h"
 c
        REAL RHcl(klon,klev)     ! humidite relative ciel clair
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/tiedqneg.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/tiedqneg.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/tiedqneg.F	(revision 4727)
@@ -15,6 +15,6 @@
 c======================================================================
 c
-#include "dimensions.h"
-c #include "dimphy.h"
+      INCLUDE "dimensions.h"
+c       INCLUDE "dimphy.h"
       REAL pres_h(klon,klev+1)
       REAL q(klon,klev)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/trconvect.F
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/trconvect.F	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/Dust/trconvect.F	(revision 4727)
@@ -10,8 +10,8 @@
       IMPLICIT NONE
 
-#include "dimensions.h"
-#include "chem.h"
-#include "YOMCST.h"
-#include "paramet.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "chem.h"
+      INCLUDE "YOMCST.h"
+      INCLUDE "paramet.h"
 
 c============================= INPUT ===================================
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/aerophys.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/aerophys.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/aerophys.F90	(revision 4727)
@@ -17,4 +17,11 @@
   REAL, PARAMETER                        :: mSatom=32.06*1.66E-27    ! Mass of a S atom [kg]
   REAL, PARAMETER                        :: mOCSmol=60.07*1.66E-27   ! Mass of an OCS molecule [kg]
+  REAL, PARAMETER                        :: mClatom=35.45*1.66E-27   ! Mass of an Cl atom [kg]
+  REAL, PARAMETER                        :: mHClmol=36.46*1.66E-27   ! Mass of an HCl molecule [kg]
+  REAL, PARAMETER                        :: mBratom=79.90*1.66E-27   ! Mass of an Br atom [kg]
+  REAL, PARAMETER                        :: mHBrmol=80.92*1.66E-27   ! Mass of an HBr molecule [kg]
+  REAL, PARAMETER                        :: mNOmol=30.01*1.66E-27    ! Mass of an NO molecule [kg]
+  REAL, PARAMETER                        :: mNO2mol=46.01*1.66E-27   ! Mass of an NO2 molecule [kg]
+  REAL, PARAMETER                        :: mNatome=14.0067*1.66E-27 ! Mass of an N atome [kg] 
 !
 END MODULE aerophys
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/interp_sulf_input.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/interp_sulf_input.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/interp_sulf_input.F90	(revision 4727)
@@ -12,5 +12,5 @@
   USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
   USE phys_local_var_mod, ONLY : budg_3D_backgr_ocs, budg_3D_backgr_so2
-  USE phys_local_var_mod, ONLY : OCS_lifetime, SO2_lifetime
+  USE phys_local_var_mod, ONLY : OCS_lifetime, SO2_lifetime, H2SO4_lifetime, O3_clim
   USE mod_phys_lmdz_para 
   USE dimphy
@@ -19,4 +19,5 @@
   USE aerophys
   USE YOMCST
+  USE strataer_local_var_mod, ONLY : flag_newclim_file,flag_verbose_strataer
 
   IMPLICIT NONE
@@ -42,14 +43,14 @@
   REAL paprs_glo(klon_glo,klev+1)
 
-  REAL, POINTER:: latitude(:)
+  REAL, ALLOCATABLE :: latitude(:)
 ! (of input data sorted in strictly ascending order)
 
-  REAL, POINTER:: longitude(:)
+  REAL, ALLOCATABLE :: longitude(:)
 ! (of input data sorted in strictly ascending order)
 
-  REAL, POINTER:: time(:)
+  REAL, ALLOCATABLE :: time(:)
 ! (of input data sorted in strictly ascending order)
 
-  REAL, POINTER:: lev(:)
+  REAL, ALLOCATABLE :: lev(:)
 ! levels of input data
 
@@ -62,4 +63,11 @@
   REAL OCS_clim_glo(klon_glo,klev)
   REAL SO2_clim_glo(klon_glo,klev)
+  
+  REAL, ALLOCATABLE :: O3_clim_in(:, :, :, :)
+  REAL, ALLOCATABLE :: O3_clim_mth(:, :, :)
+  REAL, ALLOCATABLE :: O3_clim_tmp(:, :)
+  REAL O3_clim_glo(klon_glo,klev)
+  
+  ! fixed climatos
   REAL, ALLOCATABLE :: OCS_lifetime_in(:, :, :, :)
   REAL, ALLOCATABLE :: SO2_lifetime_in(:, :, :, :)
@@ -70,4 +78,10 @@
   REAL OCS_lifetime_glo(klon_glo,klev)
   REAL SO2_lifetime_glo(klon_glo,klev)
+  
+  REAL, ALLOCATABLE :: H2SO4_lifetime_in(:, :, :, :)
+  REAL, ALLOCATABLE :: H2SO4_lifetime_mth(:, :, :)
+  REAL, ALLOCATABLE :: H2SO4_lifetime_tmp(:, :)
+
+  REAL H2SO4_lifetime_glo(klon_glo,klev)
 !
   REAL, ALLOCATABLE, SAVE :: OCS_clim(:,:)
@@ -79,6 +93,8 @@
 
 ! For NetCDF:
-  INTEGER ncid_in  ! IDs for input files
-  INTEGER varid, ncerr
+  INTEGER             :: ncid_in  ! IDs for input files
+  INTEGER             :: varid, ncerr
+  CHARACTER (LEN=3)   :: nc_lat, nc_lon
+  CHARACTER (LEN=256) :: nc_fname
     
   INTEGER, PARAMETER :: lev_input=17
@@ -103,44 +119,70 @@
   IF (is_mpi_root.AND.is_omp_root) THEN
 
-!--reading emission files
-    CALL nf95_open("ocs_so2_annual_lmdz.nc", nf90_nowrite, ncid_in)
-
+    !--init ncdf variables
+    IF(flag_newclim_file) THEN
+      nc_fname = "ocs_so2_h2so4_annual_lmdz.nc"
+      nc_lat   = "LAT"
+      nc_lon   = "LON"
+    ELSE
+      ! old file for retro compatibility
+      nc_fname = "ocs_so2_annual_lmdz.nc"
+      nc_lat   = "lat"
+      nc_lon   = "lon"
+    ENDIF
+
+    !--reading emission files
+    CALL nf95_open(nc_fname, nf90_nowrite, ncid_in)
+    IF(flag_verbose_strataer) print *, "Open file ", nc_fname
+    
     CALL nf95_inq_varid(ncid_in, "LEV", varid)
     CALL nf95_gw_var(ncid_in, varid, lev)
     n_lev = size(lev)
-
-    CALL nf95_inq_varid(ncid_in, "lat", varid)
+    
+    CALL nf95_inq_varid(ncid_in, nc_lat, varid)
     CALL nf95_gw_var(ncid_in, varid, latitude)
     n_lat = size(latitude)
-
-    CALL nf95_inq_varid(ncid_in, "lon", varid)
+    
+    CALL nf95_inq_varid(ncid_in, nc_lon, varid)
     CALL nf95_gw_var(ncid_in, varid, longitude)
     n_lon = size(longitude)
-
+    
     CALL nf95_inq_varid(ncid_in, "TIME", varid)
     CALL nf95_gw_var(ncid_in, varid, time)
     n_mth = size(time)
-
+    
     IF (.NOT.ALLOCATED(OCS_clim_in))     ALLOCATE(OCS_clim_in(n_lon, n_lat, n_lev, n_mth))
     IF (.NOT.ALLOCATED(SO2_clim_in))     ALLOCATE(SO2_clim_in(n_lon, n_lat, n_lev, n_mth))
+    IF (.NOT.ALLOCATED(O3_clim_in))      ALLOCATE(O3_clim_in(n_lon, n_lat, n_lev, n_mth))
+    
     IF (.NOT.ALLOCATED(OCS_lifetime_in)) ALLOCATE(OCS_lifetime_in(n_lon, n_lat, n_lev, n_mth))
     IF (.NOT.ALLOCATED(SO2_lifetime_in)) ALLOCATE(SO2_lifetime_in(n_lon, n_lat, n_lev, n_mth))
-
+    IF (.NOT.ALLOCATED(H2SO4_lifetime_in)) ALLOCATE(H2SO4_lifetime_in(n_lon, n_lat, n_lev, n_mth))
+    
     CALL nf95_inq_varid(ncid_in, "OCS", varid)
     ncerr = nf90_get_var(ncid_in, varid, OCS_clim_in)
-    print *,'code erreur OCS=', ncerr, varid
+    IF(flag_verbose_strataer) print *,'code erreur OCS=', ncerr, varid
 
     CALL nf95_inq_varid(ncid_in, "SO2", varid)
     ncerr = nf90_get_var(ncid_in, varid, SO2_clim_in)
-    print *,'code erreur SO2=', ncerr, varid
+    IF(flag_verbose_strataer) print *,'code erreur SO2=', ncerr, varid
 
     CALL nf95_inq_varid(ncid_in, "OCS_LIFET", varid)
     ncerr = nf90_get_var(ncid_in, varid, OCS_lifetime_in)
-    print *,'code erreur OCS_lifetime_in=', ncerr, varid
+    IF(flag_verbose_strataer) print *,'code erreur OCS_lifetime_in=', ncerr, varid
 
     CALL nf95_inq_varid(ncid_in, "SO2_LIFET", varid)
     ncerr = nf90_get_var(ncid_in, varid, SO2_lifetime_in)
-    print *,'code erreur SO2_lifetime_in=', ncerr, varid
-
+    IF(flag_verbose_strataer) print *,'code erreur SO2_lifetime_in=', ncerr, varid
+    
+    IF(flag_newclim_file) THEN
+       CALL nf95_inq_varid(ncid_in, "O3", varid)
+       ncerr = nf90_get_var(ncid_in, varid, O3_clim_in)
+       IF(flag_verbose_strataer) print *,'code erreur O3=', ncerr, varid
+       
+       CALL nf95_inq_varid(ncid_in, "H2SO4_LIFET", varid)
+       ncerr = nf90_get_var(ncid_in, varid, H2SO4_lifetime_in)
+       IF(flag_verbose_strataer) print *,'code erreur H2SO4_lifetime_in=', ncerr, varid
+    ENDIF
+    
     CALL nf95_close(ncid_in)
 
@@ -149,9 +191,14 @@
     IF (.NOT.ALLOCATED(OCS_clim_tmp)) ALLOCATE(OCS_clim_tmp(klon_glo, n_lev))
     IF (.NOT.ALLOCATED(SO2_clim_tmp)) ALLOCATE(SO2_clim_tmp(klon_glo, n_lev))
+    IF (.NOT.ALLOCATED(O3_clim_mth))  ALLOCATE(O3_clim_mth(n_lon, n_lat, n_lev))
+    IF (.NOT.ALLOCATED(O3_clim_tmp))  ALLOCATE(O3_clim_tmp(klon_glo, n_lev))
+    
     IF (.NOT.ALLOCATED(OCS_lifetime_mth)) ALLOCATE(OCS_lifetime_mth(n_lon, n_lat, n_lev))
     IF (.NOT.ALLOCATED(SO2_lifetime_mth)) ALLOCATE(SO2_lifetime_mth(n_lon, n_lat, n_lev))
     IF (.NOT.ALLOCATED(OCS_lifetime_tmp)) ALLOCATE(OCS_lifetime_tmp(klon_glo, n_lev))
     IF (.NOT.ALLOCATED(SO2_lifetime_tmp)) ALLOCATE(SO2_lifetime_tmp(klon_glo, n_lev))
-
+    IF (.NOT.ALLOCATED(H2SO4_lifetime_mth)) ALLOCATE(H2SO4_lifetime_mth(n_lon, n_lat, n_lev))
+    IF (.NOT.ALLOCATED(H2SO4_lifetime_tmp)) ALLOCATE(H2SO4_lifetime_tmp(klon_glo, n_lev))
+    
 !---select the correct month, undo multiplication with 1.e12 (precision reasons)
 !---correct latitudinal order and convert input from volume mixing ratio to mass mixing ratio
@@ -161,4 +208,14 @@
       SO2_lifetime_mth(:,j,:) = SO2_lifetime_in(:,n_lat+1-j,:,mth_cur)
       OCS_lifetime_mth(:,j,:) = OCS_lifetime_in(:,n_lat+1-j,:,mth_cur)
+      
+      ! O3 from 2d model is not tracer, in VMR
+      IF(flag_newclim_file) THEN
+         H2SO4_lifetime_mth(:,j,:) = H2SO4_lifetime_in(:,n_lat+1-j,:,mth_cur)
+         ! new input files
+         O3_clim_mth(:,j,:) = 1.e-6*O3_clim_in(:,n_lat+1-j,:,mth_cur)
+      ELSE
+         H2SO4_lifetime_mth(:,j,:) = 1.e-6
+         O3_clim_mth(:,j,:) = 1.e-6
+      ENDIF
     ENDDO
 
@@ -166,10 +223,25 @@
     CALL grid2dTo1d_glo(OCS_clim_mth,OCS_clim_tmp)
     CALL grid2dTo1d_glo(SO2_clim_mth,SO2_clim_tmp)
+    CALL grid2dTo1d_glo(O3_clim_mth,O3_clim_tmp)
+    
     CALL grid2dTo1d_glo(OCS_lifetime_mth,OCS_lifetime_tmp)
     CALL grid2dTo1d_glo(SO2_lifetime_mth,SO2_lifetime_tmp)
+    CALL grid2dTo1d_glo(H2SO4_lifetime_mth,H2SO4_lifetime_tmp)
 
 !--set lifetime to very high value in uninsolated areas
     DO i=1, klon_glo
       DO kk=1, n_lev
+!--added tests on VMR of species for realism
+        IF (OCS_clim_tmp(i,kk).LT.1.e-20) THEN
+          OCS_clim_tmp(i,kk)=1.0e-20
+        ENDIF
+        IF (SO2_clim_tmp(i,kk).LT.1.e-20) THEN
+          SO2_clim_tmp(i,kk)=1.0e-20
+        ENDIF
+        !       50 ppbv min for O3
+        IF (O3_clim_tmp(i,kk).LT.50.0e-9) THEN
+           O3_clim_tmp(i,kk)=50.0e-9
+        ENDIF
+        
         IF (OCS_lifetime_tmp(i,kk)==0.0) THEN
           OCS_lifetime_tmp(i,kk)=1.0e12
@@ -178,4 +250,7 @@
           SO2_lifetime_tmp(i,kk)=1.0e12
         ENDIF
+       IF (H2SO4_lifetime_tmp(i,kk)==0.0) THEN
+          H2SO4_lifetime_tmp(i,kk)=1.0e12
+       ENDIF
       ENDDO
     ENDDO
@@ -186,6 +261,10 @@
      OCS_lifetime_glo(i,k)=0.0
      SO2_lifetime_glo(i,k)=0.0
+     O3_clim_glo(i,k)=0.0
+     
      OCS_clim_glo(i,k)=0.0
      SO2_clim_glo(i,k)=0.0
+     H2SO4_lifetime_glo(i,k)=0.0
+     
      DO kk=1, n_lev
       OCS_lifetime_glo(i,k)=OCS_lifetime_glo(i,k)+ &
@@ -195,4 +274,11 @@
            MAX(0.0,MIN(paprs_glo(i,k),paprs_input(kk))-MAX(paprs_glo(i,k+1),paprs_input(kk+1))) &
            *SO2_lifetime_tmp(i,kk)/(paprs_glo(i,k)-paprs_glo(i,k+1))
+      IF(flag_newclim_file) THEN
+         H2SO4_lifetime_glo(i,k)=H2SO4_lifetime_glo(i,k)+ &
+              MAX(0.0,MIN(paprs_glo(i,k),paprs_input(kk)) &
+              -MAX(paprs_glo(i,k+1),paprs_input(kk+1))) &
+              *H2SO4_lifetime_tmp(i,kk)/(paprs_glo(i,k)-paprs_glo(i,k+1))
+      ENDIF
+      
       OCS_clim_glo(i,k)=OCS_clim_glo(i,k)+ &
            MAX(0.0,MIN(paprs_glo(i,k),paprs_input(kk))-MAX(paprs_glo(i,k+1),paprs_input(kk+1))) &
@@ -201,4 +287,10 @@
            MAX(0.0,MIN(paprs_glo(i,k),paprs_input(kk))-MAX(paprs_glo(i,k+1),paprs_input(kk+1))) &
            *SO2_clim_tmp(i,kk)/(paprs_glo(i,k)-paprs_glo(i,k+1))
+      IF(flag_newclim_file) THEN
+         O3_clim_glo(i,k)=O3_clim_glo(i,k)+ &
+              MAX(0.0,MIN(paprs_glo(i,k),paprs_input(kk)) &
+              -MAX(paprs_glo(i,k+1),paprs_input(kk+1))) &
+              *O3_clim_tmp(i,kk)/(paprs_glo(i,k)-paprs_glo(i,k+1))
+      ENDIF
       ENDDO
     ENDDO
@@ -213,15 +305,17 @@
   CALL scatter(OCS_clim_glo, OCS_clim)
   CALL scatter(SO2_clim_glo, SO2_clim)
+  CALL scatter(O3_clim_glo, O3_clim)
   CALL scatter(OCS_lifetime_glo, OCS_lifetime)
   CALL scatter(SO2_lifetime_glo, SO2_lifetime)
-
+  CALL scatter(H2SO4_lifetime_glo, H2SO4_lifetime)
+  
   IF (is_mpi_root.AND.is_omp_root) THEN
 !
-    DEALLOCATE(OCS_clim_in,SO2_clim_in)
-    DEALLOCATE(OCS_clim_mth,SO2_clim_mth)
-    DEALLOCATE(OCS_clim_tmp,SO2_clim_tmp)
-    DEALLOCATE(OCS_lifetime_in,SO2_lifetime_in)
-    DEALLOCATE(OCS_lifetime_mth,SO2_lifetime_mth)
-    DEALLOCATE(OCS_lifetime_tmp,SO2_lifetime_tmp)
+    DEALLOCATE(OCS_clim_in,SO2_clim_in,O3_clim_in)
+    DEALLOCATE(OCS_clim_mth,SO2_clim_mth,O3_clim_mth)
+    DEALLOCATE(OCS_clim_tmp,SO2_clim_tmp,O3_clim_tmp)
+    DEALLOCATE(OCS_lifetime_in, SO2_lifetime_in, H2SO4_lifetime_in)
+    DEALLOCATE(OCS_lifetime_mth, SO2_lifetime_mth, H2SO4_lifetime_mth)
+    DEALLOCATE(OCS_lifetime_tmp, SO2_lifetime_tmp, H2SO4_lifetime_tmp)
 !
   ENDIF !--is_mpi_root and is_omp_root
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/micphy_tstep.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/micphy_tstep.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/micphy_tstep.F90	(revision 4727)
@@ -14,5 +14,5 @@
   USE YOMCST, ONLY : RPI, RD, RG
   USE print_control_mod, ONLY: lunout
-  USE strataer_mod
+  USE strataer_local_var_mod
   
   IMPLICIT NONE
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/nucleation_tstep_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/nucleation_tstep_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/nucleation_tstep_mod.F90	(revision 4727)
@@ -11,9 +11,9 @@
   USE infotrac_phy
   USE YOMCST, ONLY : RPI, RD, RMD, RKBOL, RNAVO
-
+  USE strataer_local_var_mod, ONLY : flag_new_nucl
+  
   IMPLICIT NONE
 
   ! input variables
-  LOGICAL, PARAMETER :: flag_new_nucl=.TRUE.
   REAL rhoa    ! H2SO4 number density [molecules/cm3]
   REAL t_seri  ! temperature (K)
@@ -170,31 +170,24 @@
 
   IF (t < 190.15) THEN
-!     print *,'Warning (ilon=',ilon,'ilev=',ilev,'): temperature < 190.15 K, using 190.15 K (T=',t,'K)'
      t=190.15
   ENDIF
 
   IF (t > 300.15) THEN
-!     print *,'Warning (ilon=',ilon,'ilev=',ilev,'): temperature > 300.15 K, using 300.15 K'
      t=300.15
   ENDIF
 
   IF (rh < 0.0001) THEN
-!     print *,'Warning (ilon=',ilon,'ilev=',ilev,'): saturation ratio of water < 0.0001, using 0.0001'
      rh=0.0001
   ENDIF
 
   IF (rh > 1.0) THEN
-!     print *,'Warning (ilon=',ilon,'ilev=',ilev,'): saturation ratio of water > 1 using 1'
-!     print *, 'rh=',rh
      rh=1.0
   ENDIF
 
   IF (rhoa < 1.e4) THEN
-!     print *,'Warning (ilon=',ilon,'ilev=',ilev,'): sulfuric acid concentration < 1e4 1/cm3, using 1e4 1/cm3'
      rhoa=1.e4
   ENDIF
 
   IF (rhoa > 1.e11) THEN
-!     print *,'Warning (ilon=',ilon,'ilev=',ilev,'): sulfuric acid concentration > 1e11 1/cm3, using 1e11 1/cm3'
      rhoa=1.e11
   ENDIF
@@ -281,11 +274,8 @@
 
   IF (jnuc < 1.E-7) THEN
-!     print *,'Warning (ilon=',ilon,'ilev=',ilev'): nucleation rate < 1E-7/cm3s, using 0.0/cm3s,'
      jnuc=0.0
   ENDIF
 
   IF (jnuc > 1.e10) THEN
-!     print *,'Warning (ilon=',ilon,'ilev=',ilev, &
-!        & '): nucleation rate > 1e10/cm3s, using 1e10/cm3s'
      jnuc=1.e10
   ENDIF
@@ -425,13 +415,10 @@
   !Temperature bounds
   IF (t.LE.165.) THEN
-!     print *,'Warning: temperature < 165.0 K, using 165.0 K in neutral nucleation calculation'
      tln=165.0
   ENDIF
   IF (t.LE.195.) THEN
-!     print *,'Warning: temperature < 195.0 K, using 195.0 K in ion-induced nucleation calculation'
      tli=195.0
   ENDIF
   IF (t.GE.400.) THEN
-!     print *,'Warning: temperature > 400. K, using 400. K in nucleation calculations'
      tln=400.
      tli=400.
@@ -440,17 +427,13 @@
   ! Saturation ratio bounds
   IF (satrat.LT.1.E-7) THEN
-!     print *,'Warning: saturation ratio of water < 1.E-7, using 1.E-7 in ion-induced nucleation calculation'
      satratli=1.E-7
   ENDIF
   IF (satrat.LT.1.E-5) THEN
-!     print *,'Warning: saturation ratio of water < 1.E-5, using 1.E-5 in neutral nucleation calculation'
      satratln=1.E-5
   ENDIF
   IF (satrat.GT.0.95) THEN
-!     print *,'Warning: saturation ratio of water > 0.95, using 0.95 in ion-induced nucleation calculation'
      satratli=0.95
   ENDIF
   IF (satrat.GT.1.0) THEN
-!     print *,'Warning: saturation ratio of water > 1 using 1 in neutral nucleation calculation'
      satratln=1.0
   ENDIF
@@ -458,14 +441,11 @@
   ! Sulfuric acid concentration bounds
   IF (rhoa.LE.1.E4) THEN
-!     print *,'Warning: sulfuric acid < 1e4 1/cm3, using 1e4 1/cm3 in nucleation calculation'
      rhoaln=1.E4
      rhoali=1.E4
   ENDIF
   IF (rhoa.GT.1.E13) THEN
-!     print *,'Warning: sulfuric acid > 1e13 1/cm3, using 1e13 1/cm3 in neutral nucleation calculation'
      rhoaln=1.E13
   ENDIF
   IF (rhoa.GT.1.E16) THEN
-!     print *,'Warning: sulfuric acid concentration > 1e16 1/cm3, using 1e16 1/cm3 in ion-induced nucleation calculation'
      rhoali=1.E16
   ENDIF
@@ -521,5 +501,4 @@
      ! Dimer formation rate
      jnuc_n=1.E6*(2.*0.3E-9)**2.*SQRT(8.*RPI*RKBOL*(1./mH2SO4mol+1./mH2SO4mol))/2.*SQRT(t)*rhoa**2.
-!     jnuc_n=1.E6*(2.*0.3E-9)**2.*SQRT(8.*3.141593*1.38E-23*(1./(1.661E-27*98.07)+1./(1.661E-27*98.07)))/2.*SQRT(t)*rhoa**2.
      ntot_n=1. !set to 1 
      na_n=1.   ! The critical cluster contains one molecules but the produced cluster contains 2 molecules
@@ -604,5 +583,4 @@
      na_n=x_n*ntot_n
      IF (na_n .LT. 1.) THEN
-!        print *, 'Warning: number of acid molecules < 1 in nucleation regime, setting na_n=1'
         na_n=1.0
      ENDIF
@@ -664,5 +642,4 @@
      
      IF (kinetic_i) THEN    
-!        jnuc_i1=1.0E6*(0.3E-9 + 0.487E-9)**2.*SQRT(8.*3.141593*1.38E-23*(1./(1.661E-27*98.07)+1./(1.661E-27*98.07)))*  &
         jnuc_i1=1.0E6*(0.3E-9 + 0.487E-9)**2.*SQRT(8.*RPI*RKBOL*(1./mH2SO4mol+1./mH2SO4mol))*  &
              &  SQRT(tli)*rhoali !1/cm3s  
@@ -816,5 +793,4 @@
         na_i=x_i*ntot_i
         IF (na_i .LT. 1.) THEN
-!           print *, 'Warning: number of acid molecules < 1 in nucleation regime, setting na_n=1'
            na_n=1.0
         ENDIF
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/ocs_to_so2.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/ocs_to_so2.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/ocs_to_so2.F90	(revision 4727)
@@ -8,5 +8,6 @@
   USE infotrac_phy
   USE YOMCST, ONLY : RG
-  USE phys_local_var_mod, ONLY : OCS_lifetime, budg_3D_ocs_to_so2, budg_ocs_to_so2 
+  USE phys_local_var_mod, ONLY : OCS_lifetime, budg_3D_ocs_to_so2, budg_ocs_to_so2
+  USE strataer_local_var_mod, ONLY : flag_min_rreduce
 
   IMPLICIT NONE
@@ -23,5 +24,6 @@
   ! local variables
   INTEGER                                       :: i,j,k,nb,ilon,ilev
-
+  REAL                                          :: rreduce
+  
 !--convert OCS to SO2
   budg_3D_ocs_to_so2(:,:)=0.0
@@ -29,17 +31,24 @@
 
   DO ilon=1, klon
-  DO ilev=1, klev
-  !only in the stratosphere
-  IF (is_strato(ilon,ilev)) THEN
-    IF (OCS_lifetime(ilon,ilev).GT.0.0) THEN
-      budg_3D_ocs_to_so2(ilon,ilev)=tr_seri(ilon,ilev,id_OCS_strat)*(1.0-exp(-pdtphys/OCS_lifetime(ilon,ilev)))
-    ENDIF
-    tr_seri(ilon,ilev,id_OCS_strat)=tr_seri(ilon,ilev,id_OCS_strat) - budg_3D_ocs_to_so2(ilon,ilev)
-    tr_seri(ilon,ilev,id_SO2_strat)=tr_seri(ilon,ilev,id_SO2_strat) + mSO2mol/mOCSmol*budg_3D_ocs_to_so2(ilon,ilev)
-    !convert budget from kg(OCS)/kgA to kg(S)/m2/layer/s for saving as diagnostic
-    budg_3D_ocs_to_so2(ilon,ilev)=budg_3D_ocs_to_so2(ilon,ilev)*mSatom/mOCSmol*(paprs(ilon,ilev)-paprs(ilon,ilev+1))/RG/pdtphys
-    budg_ocs_to_so2(ilon)=budg_ocs_to_so2(ilon)+budg_3D_ocs_to_so2(ilon,ilev) 
-  ENDIF
-  ENDDO
+     DO ilev=1, klev
+        !only in the stratosphere
+        IF (is_strato(ilon,ilev)) THEN
+          IF (OCS_lifetime(ilon,ilev).GT.0.0.AND.OCS_lifetime(ilon,ilev).LT.1.E10) THEN
+            rreduce = OCS_lifetime(ilon,ilev)
+            ! Check lifetime rreduce < timestep*3 (such as H2SO4 loss > 0.28*H2SO4) with exp(-1/3)=0.72
+            IF(flag_min_rreduce) THEN
+               IF (rreduce .LT. (3.*pdtphys)) rreduce = 3.*pdtphys
+            ENDIF
+            budg_3D_ocs_to_so2(ilon,ilev)=tr_seri(ilon,ilev,id_OCS_strat)*(1.0-exp(-pdtphys/rreduce))
+            tr_seri(ilon,ilev,id_OCS_strat)=tr_seri(ilon,ilev,id_OCS_strat) - budg_3D_ocs_to_so2(ilon,ilev)
+            tr_seri(ilon,ilev,id_SO2_strat)=tr_seri(ilon,ilev,id_SO2_strat) + mSO2mol/mOCSmol*budg_3D_ocs_to_so2(ilon,ilev)
+            !convert budget from kg(OCS)/kgA to kg(S)/m2/layer/s for saving as diagnostic
+            budg_3D_ocs_to_so2(ilon,ilev)=budg_3D_ocs_to_so2(ilon,ilev)*mSatom/mOCSmol*(paprs(ilon,ilev)-paprs(ilon,ilev+1))/RG/pdtphys
+            budg_ocs_to_so2(ilon)=budg_ocs_to_so2(ilon)+budg_3D_ocs_to_so2(ilon,ilev)
+         ENDIF
+         ! END IF(OCS_lifetime(ilon,ilev).GT.0.0.AND.OCS_lifetime(ilon,ilev).LT.1.E10)
+      ENDIF
+      ! END IF(is_strato(ilon,ilev))
+   ENDDO
   ENDDO
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/so2_to_h2so4.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/so2_to_h2so4.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/so2_to_h2so4.F90	(revision 4727)
@@ -7,7 +7,9 @@
   USE aerophys
   USE infotrac_phy
-  USE YOMCST, ONLY : RG
-  USE phys_local_var_mod, ONLY : SO2_lifetime, budg_3D_so2_to_h2so4, budg_so2_to_h2so4
-
+  USE YOMCST, ONLY : RG, RD
+  ! lifetime (sec) et O3_clim (VMR)
+  USE phys_local_var_mod, ONLY : SO2_lifetime, H2SO4_lifetime, O3_clim, budg_3D_so2_to_h2so4, budg_so2_to_h2so4
+  USE strataer_local_var_mod, ONLY : flag_OH_reduced, flag_H2SO4_photolysis, flag_min_rreduce
+  
   IMPLICIT NONE
 
@@ -24,5 +26,7 @@
   ! local variables in coagulation routine
   INTEGER                                       :: i,j,k,nb,ilon,ilev
-
+  REAL                                          :: dummyso4toso2,rkho2o3,rkoho3,rkso2oh
+  REAL                                          :: rmairdens,rrak0,rrak1,rrate,rreduce
+  
 !--convert SO2 to H2SO4
   budg_3D_so2_to_h2so4(:,:)=0.0
@@ -30,18 +34,119 @@
 
   DO ilon=1, klon
-  DO ilev=1, klev
-  !only in the stratosphere
-  IF (is_strato(ilon,ilev)) THEN
-    IF (SO2_lifetime(ilon,ilev).GT.0.0) THEN
-      budg_3D_so2_to_h2so4(ilon,ilev)=tr_seri(ilon,ilev,id_SO2_strat)*(1.0-exp(-pdtphys/SO2_lifetime(ilon,ilev)))
-    ENDIF
-    tr_seri(ilon,ilev,id_SO2_strat)=tr_seri(ilon,ilev,id_SO2_strat) - budg_3D_so2_to_h2so4(ilon,ilev)
-    tr_seri(ilon,ilev,id_H2SO4_strat)=tr_seri(ilon,ilev,id_H2SO4_strat) + mH2SO4mol/mSO2mol*budg_3D_so2_to_h2so4(ilon,ilev)
-    !convert budget from kg(SO2)/kgA to kg(S)/m2/layer/s for saving as diagnostic
-    budg_3D_so2_to_h2so4(ilon,ilev)=budg_3D_so2_to_h2so4(ilon,ilev)*mSatom/mSO2mol*(paprs(ilon,ilev)-paprs(ilon,ilev+1))/RG/pdtphys
-    budg_so2_to_h2so4(ilon)=budg_so2_to_h2so4(ilon)+budg_3D_so2_to_h2so4(ilon,ilev)
-  ENDIF
-  ENDDO
-  ENDDO
-
+     DO ilev=1, klev
+     !only in the stratosphere
+        IF (is_strato(ilon,ilev)) THEN
+           IF (SO2_lifetime(ilon,ilev).GT.0.0 .AND. SO2_lifetime(ilon,ilev).LT.1.E10) THEN
+              IF (flag_OH_reduced) THEN
+                 !--convert SO2 to H2SO4 (slimane)
+                 ! Reduce OH because of SO2
+                 ! d[OH]/dt = k1[HO2][O] +k2[HO2][O3] +k3[HO2][NO]
+                 ! − (k4[O] +k5[O3] +k6[CO] +ks[SO2])[OH]
+                 ! In steady-state: d[OH]/dt = 0, so the ratio [OH]/[HO2] =
+                 ! (k1[O] +k2[O3] +k3[NO]) / (k4[O] +k5[O3] +k6[CO] +ks[SO2])
+                 ! In the lower and middle stratosphere,
+                 ! [OH]/[HO2] ~(k2[O3] +k3[NO]) / (k5[O3] +k6[CO] +ks[SO2])
+                 ! CO is only important near the tropopause. NO should not dominate over O3.
+                 ! So when consideringthe big terms: [OH]/[HO2] ~ ~ k2[O3] / (k5[O3] +ks[SO2])
+                 ! For c: control run c (no effect of SO2), [OHc]/[HO2c] ~ ~ k2[O3] / k5[O3] = 1/ Rc
+                 ! For p: perturbed run (high SO2), [OHp]/[HO2p] ~ ~ k2[O3] / (k5[O3] +ks[SO2]) =1/Rp
+                 ! If HOx = OH + HO2 = constante,
+                 ! OHc + HO2c = OHp + HO2p
+                 ! OHc (1+Rc) = OHp (1+Rp)
+                 ! OHp = OHc (1+Rc) / (1+Rp)
+                 ! 1+Rc = (k2[O3] +k5[O3] ) / k2[O3]
+                 ! 1+Rp = (k2[O3] +k5[O3] +ks[SO2]) / k2[O3]
+                 ! (1+Rc) / (1+Rp)= (k2[O3] +k5[O3] )/ (k2[O3] +k5[O3] +ks[SO2])
+                 ! OHp = OHc * (k(HO2+OH)*[O3] +k(OH+O3)[O3] ) /
+                 ! (k(HO2+OH)*[O3] +k(OH+O3)[O3] +k(SO2+OH)[SO2])
+                 ! Final: OHp = OHc * (k(HO2+O3)*[O3] +k(OH+O3)[O3] ) /
+                 !  (k(HO2+O3)*[O3] +k(OH+O3)[O3] +k(SO2+OH)[SO2])
+                 
+                 !   latest jpl 2020
+                 rkho2o3 = 1.0e-14*exp( -490./t_seri(ilon,ilev) )
+                 rkoho3 = 1.7e-12*exp( -940./t_seri(ilon,ilev) )
+                 
+                 ! rkso2oh= so2 + oh + m  ->hso3 + m-> h2so4 + m
+                 ! air density M(molecule/cm3) = Pa/(K*1.38e-19)
+                 rmairdens =  pplay(ilon,ilev)/(t_seri(ilon,ilev)*1.38e-19)
+                 ! JPL 2020
+                 rrak0 = 3.3e-31*( (300./t_seri(ilon,ilev))**4.3 )
+                 rrak1 = 1.6e-12
+                 rrate = (rrak0*rmairdens) / ( 1. + rrak0*rmairdens/rrak1 )
+                 rreduce = 1./( 1. + log10((rrak0*rmairdens)/rrak1)**2 )
+                 rkso2oh = rrate*(0.6**rreduce)
+                 
+                 ! O3 (molec/cm3): O3_clim in vmr
+                 rrak0 = O3_clim(ilon,ilev)*rmairdens
+                 ! SO2 (molec/cm3): convert from kg/kgA
+                 rrak1 = tr_seri(ilon,ilev,id_SO2_strat) &
+                      & *pplay(ilon,ilev)/t_seri(ilon,ilev)/RD/1.E6/mSO2mol
+                 
+                 IF (rrak1 .GE. 0.0) THEN
+                    rreduce =( (rkho2o3+rkoho3)*rrak0 + rkso2oh*rrak1 ) / &
+                         (  (rkho2o3+rkoho3)*rrak0 )
+                    ! reduce OH, so extend SO2 lifetime
+                    rreduce = rreduce*SO2_lifetime(ilon,ilev)
+                 ELSE
+                    rreduce =  SO2_lifetime(ilon,ilev)
+                 ENDIF
+                 ! end of IF (rrak1) THEN
+              ELSE
+                 rreduce =  SO2_lifetime(ilon,ilev)
+              ENDIF
+              ! end of IF (flag_OH_reduced) THEN
+              
+              ! Check lifetime rreduce < timestep*1.5 (such as SO2 loss > 0.5*SO2) with exp(-1/1.5)=0.52
+              ! Check lifetime rreduce < timestep*3 (such as SO2 loss > 0.28*SO2) with exp(-1/3)=0.72
+              IF(flag_min_rreduce) THEN
+                 IF (rreduce .LT. (3.*pdtphys)) rreduce = 3.*pdtphys
+              ENDIF
+              budg_3D_so2_to_h2so4(ilon,ilev)=tr_seri(ilon,ilev,id_SO2_strat)*(1.0-exp(-pdtphys/rreduce))
+              tr_seri(ilon,ilev,id_SO2_strat)=tr_seri(ilon,ilev,id_SO2_strat) - budg_3D_so2_to_h2so4(ilon,ilev)
+              tr_seri(ilon,ilev,id_H2SO4_strat)=tr_seri(ilon,ilev,id_H2SO4_strat) + mH2SO4mol/mSO2mol*budg_3D_so2_to_h2so4(ilon,ilev)
+           ENDIF
+           ! IF (SO2_lifetime(ilon,ilev).GT.0.0 .AND. SO2_lifetime(ilon,ilev).LT.1.E10) THEN
+           
+           
+           IF (flag_H2SO4_photolysis) THEN
+              !--convert H2SO4 to SO2 using HCl photolysis (Rinsland et al, 1995)
+              ! 4.6e-8 sec-1: J strato taken from Feierabend, et al., Chem. Phys. Lett., 2006.
+              ! error before:  ...exp(-pdtphys/4.6e-8) so negligible photolysis,
+              !                 should have been exp(-pdtphys*4.6e-8)
+              ! Also: Lane and Kjaergaard: ,J. Phys. Chem. A, 2008
+              ! We find that the dominant photodissociation mechanism of H2SO4
+              ! below 70 km is absorption in the visible region by OH stretching overtone
+              ! transitions, whereas above 70 km, absorption of Lyman-R ...
+              ! In 2D model, 0.3 Rinsland et al, 1995 but Burkholder, Mills and McKeen say 0.016
+              ! JH2SO4=JHCL*0.3   (*0.016 would be too slow)
+              ! test: quick sequential integration for SO2 to H2SO4 and reverse
+              
+              IF (H2SO4_lifetime(ilon,ilev).GT.0.0 .AND. H2SO4_lifetime(ilon,ilev).LT.1.E10) THEN
+                 
+                 rreduce = H2SO4_lifetime(ilon,ilev)
+                 dummyso4toso2 = 0.0
+                 
+                 ! Check lifetime rreduce < timestep*1.5 (such as H2SO4 loss > 0.5*H2SO4) with exp(-1/1.5)=0.52
+                 ! Check lifetime rreduce < timestep*3 (such as H2SO4 loss > 0.28*H2SO4) with exp(-1/3)=0.72
+                 IF(flag_min_rreduce) THEN
+                    IF (rreduce .LT. (3.*pdtphys)) rreduce = 3.*pdtphys
+                 ENDIF
+                 dummyso4toso2 = (mSO2mol/mH2SO4mol)*tr_seri(ilon,ilev,id_H2SO4_strat)*(1.0-exp(-pdtphys/rreduce))
+                 budg_3D_so2_to_h2so4(ilon,ilev) = budg_3D_so2_to_h2so4(ilon,ilev) + dummyso4toso2
+                 tr_seri(ilon,ilev,id_SO2_strat)=tr_seri(ilon,ilev,id_SO2_strat) + dummyso4toso2
+                 tr_seri(ilon,ilev,id_H2SO4_strat)=tr_seri(ilon,ilev,id_H2SO4_strat) - (mH2SO4mol/mSO2mol)*dummyso4toso2
+              ENDIF
+              ! IF (H2SO4_lifetime(ilon,ilev).GT.0.0 .AND. H2SO4_lifetime(ilon,ilev).LT.1.E10) THEN
+           ENDIF
+           ! end of IF (flag_H2SO4_photolysis) THEN
+           
+           !convert budget from kg(SO2)/kgA to kg(S)/m2/layer/s for saving as diagnostic
+           budg_3D_so2_to_h2so4(ilon,ilev)=budg_3D_so2_to_h2so4(ilon,ilev)*mSatom/mSO2mol* &
+                (paprs(ilon,ilev)-paprs(ilon,ilev+1))/RG/pdtphys
+           budg_so2_to_h2so4(ilon)=budg_so2_to_h2so4(ilon)+budg_3D_so2_to_h2so4(ilon,ilev)
+        ENDIF
+        ! IF (is_strato(ilon,ilev)) THEN
+     ENDDO ! DO (klev)
+  ENDDO ! DO (klon)
+  
 END SUBROUTINE SO2_TO_H2SO4
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/stratH2O_methox.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/stratH2O_methox.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/stratH2O_methox.F90	(revision 4727)
@@ -0,0 +1,162 @@
+!
+! $Id: stratH2O_methox.F90 3677 2020-05-06 15:18:32Z oboucher $
+!
+SUBROUTINE stratH2O_methox(debutphy,paprs,dq_ch4mmr)
+!
+! output: CH4VMR in mmr (mass mixing ratio/sec: kg H2O/kg air)
+
+  USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, & 
+                      nf95_inq_varid, nf95_inquire_dimension, nf95_open
+  USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
+
+  USE mod_grid_phy_lmdz
+  USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+  USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
+
+  USE mod_phys_lmdz_para 
+  USE dimphy
+  USE phys_cal_mod, ONLY : mth_cur
+  USE infotrac_phy
+  USE aerophys
+  USE YOMCST
+  USE strataer_local_var_mod, ONLY : flag_newclim_file
+  
+  IMPLICIT NONE
+  
+  include "dimensions.h"
+  
+! Variable input
+  REAL paprs(klon,klev+1)
+  LOGICAL, INTENT(IN) :: debutphy   ! le flag de l'initialisation de la physique
+! Variable output
+! tendance buffer pour appel de add_phys_tend
+  REAL, INTENT(INOUT), DIMENSION(klon,klev)  :: dq_ch4mmr
+  
+! Variables locales
+  INTEGER n_lat   ! number of latitudes in the input data
+  INTEGER n_lon   ! number of longitudes in the input data
+  INTEGER, SAVE :: n_lev   ! number of levels in the input data
+!$OMP THREADPRIVATE(n_lev)
+  INTEGER n_mth   ! number of months in the input data
+  INTEGER, SAVE :: mth_pre
+!$OMP THREADPRIVATE(mth_pre)
+  
+! Champs reconstitues
+  REAL paprs_glo(klon_glo,klev+1)
+  
+  REAL, ALLOCATABLE:: latitude(:)
+! (of input data sorted in strictly ascending order)
+  REAL, ALLOCATABLE:: longitude(:)
+! (of input data sorted in strictly ascending order)
+  REAL, ALLOCATABLE:: time(:)
+! (of input data sorted in strictly ascending order)
+  REAL, ALLOCATABLE:: lev(:)
+! levels of input data
+  
+!stratospheric H2O source from CH4 oxidation
+! fixed climatos
+! H2O production in VMR/sec)
+  REAL, ALLOCATABLE :: CH4RVMR_in(:, :, :, :)
+  REAL, ALLOCATABLE :: CH4RVMR_mth(:, :, :)
+  REAL, ALLOCATABLE :: CH4RVMR_tmp(:, :)
+  REAL CH4RVMR_glo(klon_glo,klev)
+!
+  INTEGER i, k, kk, j
+  
+! For NetCDF:
+  INTEGER ncid_in  ! IDs for input files
+  INTEGER varid, ncerr
+    
+  INTEGER, PARAMETER :: lev_input=17
+!--pressure at interfaces of input data (in Pa)
+  REAL, DIMENSION(lev_input+1), PARAMETER ::          & 
+                    paprs_input=(/                    &
+  1.00000002e+05,   6.06530673e+04,   3.67879449e+04, &
+  2.23130165e+04,   1.35335286e+04,   8.20850004e+03, &
+  4.97870695e+03,   3.01973841e+03,   1.83156393e+03, &
+  1.11089968e+03,   6.73794715e+02,   4.08677153e+02, &
+  2.47875223e+02,   1.50343923e+02,   9.11881985e+01, &
+  5.53084382e+01,   3.35462635e+01,   0.0           /)
+!
+  
+  IF (debutphy .OR. mth_cur .NE. mth_pre) THEN
+     
+!--preparation of global fields
+     CALL gather(paprs, paprs_glo)
+     
+     IF (is_mpi_root.AND.is_omp_root) THEN
+        
+        print *,'In stratH2O_methox read file: ch4r_annual_lmdz.nc'
+        
+        !--reading strat. H2O source (CH4 oxidation) files
+        CALL nf95_open("ch4r_annual_lmdz.nc", nf90_nowrite, ncid_in)
+        
+        CALL  nf95_inq_varid(ncid_in, "LEV", varid)
+        CALL nf95_gw_var(ncid_in, varid, lev)
+        n_lev = size(lev)
+        
+        CALL nf95_inq_varid(ncid_in, "LAT", varid)
+        CALL nf95_gw_var(ncid_in, varid, latitude)
+        n_lat = size(latitude)
+        
+        CALL nf95_inq_varid(ncid_in, "LON", varid)
+        CALL nf95_gw_var(ncid_in, varid, longitude)
+        n_lon = size(longitude)
+        
+        CALL nf95_inq_varid(ncid_in, "TIME", varid)
+        CALL nf95_gw_var(ncid_in, varid, time)
+        n_mth = size(time)
+        
+        IF (.NOT.ALLOCATED(CH4RVMR_in)) ALLOCATE(CH4RVMR_in(n_lon, n_lat, n_lev, n_mth))
+        
+        CALL nf95_inq_varid(ncid_in, "CH4RVMR", varid)
+        ncerr = nf90_get_var(ncid_in, varid, CH4RVMR_in)
+        print *,'code erreur CH4RVMR=', ncerr, varid
+        
+        CALL nf95_close(ncid_in)
+        
+        IF (.NOT.ALLOCATED(CH4RVMR_mth)) ALLOCATE(CH4RVMR_mth(n_lon, n_lat, n_lev))
+        IF (.NOT.ALLOCATED(CH4RVMR_tmp)) ALLOCATE(CH4RVMR_tmp(klon_glo, n_lev))
+        
+        !---select the correct month,
+        !---correct latitudinal order,convert input from volume mixing ratio to mass mixing ratio
+        DO j=1,n_lat
+           ! convert VMR/sec in mmr (mass mixing ratio/sec: kg H2O/kg air)
+           ! x2 because CH4->2*H2O
+           CH4RVMR_mth(:,j,:) = 2*CH4RVMR_in(:,n_lat+1-j,:,mth_cur)*mH2Omol/mAIRmol
+        ENDDO
+        
+        !---reduce to a klon_glo grid but keep the levels
+        CALL grid2dTo1d_glo(CH4RVMR_mth,CH4RVMR_tmp)
+        
+        !---regrid weighted climatologies
+        DO i=1, klon_glo
+           DO k=1, klev
+              
+              CH4RVMR_glo(i,k)=0.0
+              
+              DO kk=1, n_lev
+                 !
+                 CH4RVMR_glo(i,k)=CH4RVMR_glo(i,k)+ &
+                      MAX(0.0,MIN(paprs_glo(i,k),paprs_input(kk)) &
+                      -MAX(paprs_glo(i,k+1),paprs_input(kk+1))) &
+                      *CH4RVMR_tmp(i,kk)/(paprs_glo(i,k)-paprs_glo(i,k+1))
+              ENDDO ! kk loop
+           ENDDO ! k loop
+        ENDDO ! i loop
+     ENDIF !--is_mpi_root and is_omp_root
+     
+     !--keep memory of previous month
+     mth_pre=mth_cur
+     
+     !--scatter global fields around
+     CALL scatter(CH4RVMR_glo, dq_ch4mmr)
+     
+     IF (is_mpi_root.AND.is_omp_root) THEN
+        DEALLOCATE(CH4RVMR_in,CH4RVMR_mth,CH4RVMR_tmp)
+     ENDIF !--is_mpi_root and is_omp_root
+  ENDIF ! debutphy.OR.new month
+  
+  RETURN
+  
+END SUBROUTINE stratH2O_methox
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/strataer_emiss_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/strataer_emiss_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/strataer_emiss_mod.F90	(revision 4727)
@@ -0,0 +1,248 @@
+MODULE strataer_emiss_mod
+! This module contains information about strato microphysic model emission parameters
+  
+CONTAINS
+    
+  SUBROUTINE strataer_emiss_init()
+    
+    USE strataer_local_var_mod
+    USE ioipsl_getin_p_mod, ONLY : getin_p
+    USE print_control_mod, ONLY : lunout
+    USE mod_phys_lmdz_para, ONLY : is_master
+    
+    ! Local variables
+    INTEGER                  :: ispec
+    
+    WRITE(lunout,*) 'IN STRATAER_EMISS INIT WELCOME!'
+    
+    IF (flag_emit.EQ.1 .OR. flag_emit.EQ.4) THEN ! Volcano
+       CALL getin_p('nErupt',nErupt) !eruption nb
+       CALL getin_p('injdur',injdur) !injection duration
+       
+       IF (flag_emit==1) THEN
+          CALL getin_p('nAerErupt', nAerErupt) !sulfur aer nb
+       ELSEIF (flag_emit==4) THEN
+          CALL getin_p('nSpeciesErupt', nSpeciesErupt) !chimical species nb
+       ENDIF
+       
+       IF (nErupt.GT.0) THEN
+          ALLOCATE(year_emit_vol(nErupt),mth_emit_vol(nErupt),day_emit_vol(nErupt))
+          ALLOCATE(altemiss_vol(nErupt),sigma_alt_vol(nErupt))
+          ALLOCATE(xlat_min_vol(nErupt),xlon_min_vol(nErupt))
+          ALLOCATE(xlat_max_vol(nErupt),xlon_max_vol(nErupt))
+          IF (flag_emit==1) THEN
+             ALLOCATE(m_sulf_emiss_vol(nErupt))
+             ALLOCATE(m_aer_emiss_vol(nErupt,nAerErupt))
+             IF (ok_qemiss) then
+                ALLOCATE(m_H2O_emiss_vol(nErupt))
+                ALLOCATE(m_H2O_emiss_vol_daily(nErupt))
+!                ALLOCATE(d_q_emiss(klon,klev))
+                ALLOCATE(budg_emi(klon,nAerErupt+1))
+                m_H2O_emiss_vol(:)=0.
+                m_H2O_emiss_vol_daily(:)=0.
+!                d_q_emiss(:,:)=0.
+             ELSE
+                ALLOCATE(budg_emi(klon,nAerErupt))
+             ENDIF
+             budg_emi(:,:)=0.
+          ELSEIF (flag_emit==4) THEN
+             ALLOCATE(m_Chlore_emiss_vol(nErupt))
+             ALLOCATE(id_HCl) 
+             ALLOCATE(m_Brome_emiss_vol(nErupt))
+             ALLOCATE(id_HBr)
+             ALLOCATE(id_species(nSpeciesErupt))
+             ALLOCATE(m_species_emiss_vol(nErupt,nSpeciesErupt))
+             ALLOCATE(m_NOx_emiss_vol(nErupt))
+             ALLOCATE(m_H2O_emiss_vol(nErupt))
+             ALLOCATE(id_NOx)
+             ALLOCATE(id_H2O)
+             ALLOCATE(budg_emi(klon,nSpeciesErupt))
+             budg_emi(:,:)=0.
+          ENDIF
+       ELSE
+          WRITE(lunout,*) 'ERROR : Using flag_emit=1 or 4 (ie Volcanic eruption) but nErupt (',nErupt,') <=0 !'
+          CALL abort_physic('strataer_emiss_mod', &
+               'No eruption define in physiq_def (nErupt=0). Add at one eruption or use background condition.',1)
+       ENDIF ! fin if nerupt
+       
+       ! injection params (dates, loc, injections params)
+       CALL getin_p('year_emit_vol',year_emit_vol)
+       CALL getin_p('mth_emit_vol',mth_emit_vol)
+       CALL getin_p('day_emit_vol',day_emit_vol)
+       CALL getin_p('altemiss_vol',altemiss_vol)
+       CALL getin_p('sigma_alt_vol',sigma_alt_vol)
+       CALL getin_p('xlon_min_vol',xlon_min_vol)
+       CALL getin_p('xlon_max_vol',xlon_max_vol)
+       CALL getin_p('xlat_min_vol',xlat_min_vol)
+       CALL getin_p('xlat_max_vol',xlat_max_vol)
+       IF (flag_emit==1) THEN
+          CALL getin_p('m_sulf_emiss_vol',m_sulf_emiss_vol)
+        if (ok_qemiss) then
+         CALL getin_p('m_H2O_emiss_vol',m_H2O_emiss_vol)
+        endif
+       ELSEIF (flag_emit==4) THEN
+          CALL getin_p('id_species',id_species)
+          CALL getin_p('m_Chlore_emiss_vol',m_Chlore_emiss_vol)  
+          CALL getin_p('id_HCl',id_HCl)
+          CALL getin_p('m_Brome_emiss_vol',m_Brome_emiss_vol)
+          CALL getin_p('id_HBr',id_HBr)
+          CALL getin_p('m_NOx_emiss_vol',m_NOx_emiss_vol)
+          CALL getin_p('id_NOx',id_NOx)
+          CALL getin_p('m_H2O_emiss_vol',m_H2O_emiss_vol)
+          CALL getin_p('id_H2O',id_H2O)
+       ENDIF
+       
+    ELSEIF (flag_emit == 2) THEN ! SAI
+       CALL getin_p('m_aer_emiss_sai',m_aer_emiss_sai)
+       CALL getin_p('altemiss_sai',altemiss_sai)
+       CALL getin_p('sigma_alt_sai',sigma_alt_sai)
+       CALL getin_p('xlat_sai',xlat_sai)
+       CALL getin_p('xlon_sai',xlon_sai)
+       CALL getin_p('year_emit_sai_start',year_emit_sai_start)
+       CALL getin_p('year_emit_sai_end',year_emit_sai_end)
+       CALL getin_p('mth_emit_sai_start',mth_emit_sai_start)
+       CALL getin_p('mth_emit_sai_end',mth_emit_sai_end)
+       CALL getin_p('day_emit_sai_start',day_emit_sai_start)
+       CALL getin_p('day_emit_sai_end',day_emit_sai_end)
+       
+    ELSEIF (flag_emit == 3) THEN ! SAI between latitudes
+       CALL getin_p('m_aer_emiss_sai',m_aer_emiss_sai)
+       CALL getin_p('altemiss_sai',altemiss_sai)
+       CALL getin_p('sigma_alt_sai',sigma_alt_sai)
+       CALL getin_p('xlon_sai',xlon_sai)
+       CALL getin_p('xlat_max_sai',xlat_max_sai)
+       CALL getin_p('xlat_min_sai',xlat_min_sai)
+    ENDIF
+    
+    IF (flag_emit == 1) THEN
+       DO ispec=1,nAerErupt
+          m_aer_emiss_vol(:,ispec) = m_sulf_emiss_vol(:)
+       ENDDO
+    ELSEIF (flag_emit== 4) THEN
+       DO ispec=1,nSpeciesErupt
+          IF(id_species(ispec) == id_HCl) THEN
+             m_species_emiss_vol(:,ispec) = m_Chlore_emiss_vol(:)
+          ENDIF
+          IF (id_species(ispec) == id_HBr) THEN 
+             m_species_emiss_vol(:,ispec) = m_Brome_emiss_vol(:)
+          ENDIF
+          IF (id_species(ispec) == id_NOx) THEN
+             m_species_emiss_vol(:,ispec) = m_NOx_emiss_vol(:)
+          ENDIF
+          IF (id_species(ispec) == id_H2O) THEN
+             m_species_emiss_vol(:,ispec) = m_H2O_emiss_vol(:)
+          ENDIF
+       ENDDO
+    ENDIF
+    
+    !============= Injection ponderation =============
+    IF (flag_emit > 0) THEN
+       CALL strataer_ponde_init
+       WRITE(lunout,*) 'IN STRATAER INIT : ponde_lonlat_vol',ponde_lonlat_vol
+    ENDIF
+    
+    !============= Print params =============
+    IF (is_master) THEN
+       IF (flag_emit == 1 .OR. flag_emit == 4) THEN
+          WRITE(lunout,*) 'IN STRATAER nErupt: ',nErupt
+          WRITE(lunout,*) 'IN STRATAER injdur: ',injdur
+          WRITE(lunout,*) 'IN STRATAER nAerErupt: ',nAerErupt
+          
+          WRITE(lunout,*) 'IN STRATAER : year_emit_vol',year_emit_vol
+          WRITE(lunout,*) 'IN STRATAER : mth_emit_vol',mth_emit_vol
+          WRITE(lunout,*) 'IN STRATAER : day_emit_vol',day_emit_vol
+          WRITE(lunout,*) 'IN STRATAER : altemiss_vol',altemiss_vol
+          WRITE(lunout,*) 'IN STRATAER : sigma_alt_vol',sigma_alt_vol
+          WRITE(lunout,*) 'IN STRATAER : xlat_min_vol',xlat_min_vol
+          WRITE(lunout,*) 'IN STRATAER : xlat_max_vol',xlat_max_vol
+          WRITE(lunout,*) 'IN STRATAER : xlon_min_vol',xlon_min_vol
+          WRITE(lunout,*) 'IN STRATAER : xlon_max_vol',xlon_max_vol
+          IF (flag_emit==1) THEN
+             WRITE(lunout,*) 'IN STRATAEREMISS : m_sulf_emiss_vol',m_sulf_emiss_vol
+             WRITE(lunout,*) 'IN STRATAER : m_aer_emiss_vol',m_aer_emiss_vol
+             IF (ok_qemiss) then
+                WRITE(lunout,*) 'IN STRATAEREMISS : m_H2O_emiss_vol',m_H2O_emiss_vol
+             ENDIF
+          ENDIF
+       ELSEIF (flag_emit == 2) THEN
+          WRITE(lunout,*) 'IN STRATAER : m_aer_emiss_sai',m_aer_emiss_sai
+          WRITE(lunout,*) 'IN STRATAER : altemiss_sai',altemiss_sai
+          WRITE(lunout,*) 'IN STRATAER : sigma_alt_sai',sigma_alt_sai
+          WRITE(lunout,*) 'IN STRATAER : xlat_sai',xlat_sai
+          WRITE(lunout,*) 'IN STRATAER : xlon_sai',xlon_sai
+       ELSEIF (flag_emit == 3) THEN
+          WRITE(lunout,*) 'IN STRATAER : m_aer_emiss_sai',m_aer_emiss_sai
+          WRITE(lunout,*) 'IN STRATAER : altemiss_sai',altemiss_sai
+          WRITE(lunout,*) 'IN STRATAER : sigma_alt_sai',sigma_alt_sai
+          WRITE(lunout,*) 'IN STRATAER : year_emit_sai start/end',year_emit_sai_start,year_emit_sai_end
+          WRITE(lunout,*) 'IN STRATAER : mth_emit_sai start/end',mth_emit_sai_start,mth_emit_sai_end
+          WRITE(lunout,*) 'IN STRATAER : day_emit_sai start/end',day_emit_sai_start,day_emit_sai_end
+          WRITE(lunout,*) 'IN STRATAER : xlat_min_sai',xlat_min_sai
+          WRITE(lunout,*) 'IN STRATAER : xlat_max_sai',xlat_max_sai
+          WRITE(lunout,*) 'IN STRATAER : xlon_sai',xlon_sai
+       ENDIF
+       IF(flag_emit == 4) THEN
+          WRITE(lunout,*) 'IN STRATAER : nSpeciesErupt: ',nSpeciesErupt
+          WRITE(lunout,*) 'IN STRATAER : id_species = ',id_species
+          WRITE(lunout,*) 'IN STRATAER : id_HCl = ',id_HCl
+          WRITE(lunout,*) 'IN STRATAER : id_HBr = ',id_HBr
+          WRITE(lunout,*) 'IN STRATAER : id_NOx = ',id_NOx
+          WRITE(lunout,*) 'IN STRATAER : id_H2O = ',id_H2O
+          WRITE(lunout,*) 'IN STRATAER : m_Chlore_emiss_vol = ',m_Chlore_emiss_vol
+          WRITE(lunout,*) 'IN STRATAER : m_Brome_emiss_vol = ',m_Brome_emiss_vol
+          WRITE(lunout,*) 'IN STRATAER : m_NOx_emiss_vol = ',m_NOx_emiss_vol
+          WRITE(lunout,*) 'IN STRATAER : m_H2O_emiss_vol = ',m_H2O_emiss_vol
+       ENDIF
+    ENDIF ! if master
+    
+    WRITE(lunout,*) 'IN STRATAER_EMISS END'
+  END SUBROUTINE strataer_emiss_init
+  
+  ! Compute the ponderation to applicate in each grid point for all eruptions and init
+  ! dlat & dlon variables
+  SUBROUTINE strataer_ponde_init()
+    
+    USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
+    USE dimphy, ONLY: klon
+    USE mod_grid_phy_lmdz, ONLY: nbp_lat, nbp_lon
+    USE print_control_mod, ONLY : lunout
+    USE strataer_local_var_mod
+    
+    INCLUDE "YOMCST.h"  !--RPI
+    
+    ! local var
+    REAL                :: lat_reg_deg,lon_reg_deg ! lat and lon of grid points in degree
+    INTEGER             :: ieru, i, j
+    
+    ALLOCATE(ponde_lonlat_vol(nErupt))
+    
+    !Compute lon/lat ponderation for injection
+    dlat=180./2./FLOAT(nbp_lat)   ! d latitude in degree
+    dlon=360./2./FLOAT(nbp_lon)   ! d longitude in degree
+    WRITE(lunout,*) 'IN STRATAER_INIT dlat=',dlat,'dlon=',dlon
+    WRITE(lunout,*) 'IN STRATAER_INIT nErupt=',nErupt
+    WRITE(lunout,*) 'IN STRATAER_INIT xlat_min=',xlat_min_vol,'xlat_max=',xlat_max_vol
+    WRITE(lunout,*) 'IN STRATAER_INIT xlon_min=',xlon_min_vol,'xlon_max=',xlon_max_vol
+    
+    DO ieru=1, nErupt
+       ponde_lonlat_vol(ieru) = 0
+       DO i=1,nbp_lon
+          lon_reg_deg = lon_reg(i)*180./RPI
+          DO j=1,nbp_lat
+             lat_reg_deg = lat_reg(j)*180./RPI
+             IF  ( lat_reg_deg.GE.xlat_min_vol(ieru)-dlat .AND. lat_reg_deg.LT.xlat_max_vol(ieru)+dlat .AND. &
+                  lon_reg_deg.GE.xlon_min_vol(ieru)-dlon .AND. lon_reg_deg.LT.xlon_max_vol(ieru)+dlon ) THEN
+                ponde_lonlat_vol(ieru) = ponde_lonlat_vol(ieru) + 1
+             ENDIF
+          ENDDO
+       ENDDO
+       IF(ponde_lonlat_vol(ieru) == 0) THEN
+          WRITE(lunout,*) 'STRATAER_INIT ERROR: no grid point found for eruption ieru=',ieru
+       ENDIF
+    ENDDO !ieru
+    
+    WRITE(lunout,*) 'IN STRATAER_PONDE_INIT ponde_lonlat: ', ponde_lonlat_vol
+    
+  END SUBROUTINE strataer_ponde_init
+  
+END MODULE strataer_emiss_mod
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/strataer_local_var_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/strataer_local_var_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/strataer_local_var_mod.F90	(revision 4727)
@@ -0,0 +1,245 @@
+! $Id: strataer_local_var_mod.F90 2022-10-17 19:39:09Z nlebas $
+MODULE strataer_local_var_mod
+! This module contains strato microphysic model parameters & variables
+  
+  IMPLICIT NONE
+  
+  !============= GENERAL PARAMS =============
+  !flag for type emission scenario: (0) background aer ; (1) volcanic eruption with Sulfur ;
+  !(2,3) strato aer injections (SAI) ; (4) volcanic eruption chimistry; (5) rocket
+  INTEGER,SAVE :: flag_emit
+  !$OMP THREADPRIVATE(flag_emit)
+  
+  ! flag for emission altitude distribution: (0) gaussian; (1) uniform
+  INTEGER,SAVE :: flag_emit_distrib
+  !$OMP THREADPRIVATE(flag_emit_distrib)
+  
+  ! flag to choose nucleation nucleation method
+  LOGICAL,SAVE :: flag_new_nucl   ! T=new routine from A. Maattanen (LATMOS), F=older routine from H. Vehkamäki (FMI)
+  !$OMP THREADPRIVATE(flag_new_nucl)
+  
+  ! Use relative humidity from 2D model stratospheric H2O because LMDz is too dry in the stratosphere
+  ! (no CH4 oxidation)
+  LOGICAL,SAVE :: flag_H2O2d_nucleation
+  !$OMP THREADPRIVATE(flag_H2O2d_nucleation)
+  
+  ! OH reduction from SO2. OH is reduced when its reaction with SO2 competes sufficiently with its reaction
+  ! with O3 (Bekki, 1995). As a result, SO2 lifetime is extended. 2D model O3 climatologies are needed.
+  LOGICAL,SAVE :: flag_OH_reduced
+  !$OMP THREADPRIVATE(flag_OH_reduced)
+  
+  ! H2SO4 photolysis: H2SO4 is converted into SO2 by complex photolytic processes. Here simplified approach
+  ! by setting H2SO4 cross-sections = 0.3*HCl cross-sections (Rinsland et al., 1995)
+  LOGICAL,SAVE :: flag_H2SO4_photolysis
+  !$OMP THREADPRIVATE(flag_H2SO4_photolysis)
+  
+  ! flag for minimum lifetime (=1.5 pdt phys)
+  LOGICAL,SAVE :: flag_min_rreduce
+  !$OMP THREADPRIVATE(flag_min_rreduce)
+  
+  ! flag to read new climato (O3, H2O & H2SO4_LIFET)
+  LOGICAL,SAVE :: flag_newclim_file
+  !$OMP THREADPRIVATE(flag_newclim_file)
+  
+  ! Verbose mode to get more print info
+  LOGICAL, SAVE :: flag_verbose_strataer
+  !$OMP THREADPRIVATE(flag_verbose_strataer)
+  
+  
+  !============= NUCLEATION VARS =============
+  ! flag to constraint nucleation rate in a lat/pres box
+  LOGICAL,SAVE :: flag_nuc_rate_box      ! Nucleation rate limit or not to a lat/pres
+  !$OMP THREADPRIVATE(flag_nuc_rate_box)
+  REAL,SAVE    :: nuclat_min             ! min lat to activate nuc rate
+  REAL,SAVE    :: nuclat_max             ! max lat to activate nuc rate
+  REAL,SAVE    :: nucpres_min            ! min pres to activate nuc rate
+  REAL,SAVE    :: nucpres_max            ! max pres to activate nuc rate
+  !$OMP THREADPRIVATE(nuclat_min, nuclat_max, nucpres_min, nucpres_max)
+
+  LOGICAL,SAVE :: ok_qemiss
+  !$OMP THREADPRIVATE(ok_qemiss)
+  INTEGER,SAVE :: flh2o  ! ds stratemit : flh2o =0 (tr_seri), flh2o=1 (dq) 
+  !$OMP THREADPRIVATE(flh2o)
+!  REAL,ALLOCATABLE,SAVE    :: d_q_emiss(:,:)
+!  !$OMP THREADPRIVATE(d_q_emiss)
+  
+  REAL,ALLOCATABLE,SAVE    :: budg_emi(:,:)            !DIMENSION(klon,n)
+  !$OMP THREADPRIVATE(budg_emi)
+  
+  
+  !============= EMISSION VARS =============
+  !--flag_emit=1 OR == 4 -- Volcanic eruption(s)
+  INTEGER,SAVE             :: nErupt                    ! number of eruptions specs
+  REAL,SAVE                :: injdur                    ! volcanic injection duration
+  !$OMP THREADPRIVATE(nErupt, injdur)
+  INTEGER,ALLOCATABLE,SAVE :: year_emit_vol(:)          ! year of emission date
+  INTEGER,ALLOCATABLE,SAVE :: mth_emit_vol(:)           ! month of emission date
+  INTEGER,ALLOCATABLE,SAVE :: day_emit_vol(:)           ! day of emission date
+  !$OMP THREADPRIVATE(year_emit_vol, mth_emit_vol, day_emit_vol)
+  REAL,ALLOCATABLE,SAVE    :: altemiss_vol(:)           ! emission altitude in m
+  REAL,ALLOCATABLE,SAVE    :: sigma_alt_vol(:)          ! standard deviation of emission altitude in m
+  !$OMP THREADPRIVATE(altemiss_vol, sigma_alt_vol)
+  INTEGER,ALLOCATABLE,SAVE :: ponde_lonlat_vol(:)       ! lon/lat ponderation factor
+  REAL,ALLOCATABLE,SAVE    :: xlat_min_vol(:)           ! min latitude of volcano in degree
+  REAL,ALLOCATABLE,SAVE    :: xlat_max_vol(:)           ! max latitude of volcano in degree
+  REAL,ALLOCATABLE,SAVE    :: xlon_min_vol(:)           ! min longitude of volcano in degree
+  REAL,ALLOCATABLE,SAVE    :: xlon_max_vol(:)           ! max longitude of volcano in degree
+  !$OMP THREADPRIVATE(ponde_lonlat_vol, xlat_min_vol, xlat_max_vol, xlon_min_vol, xlon_max_vol)
+  
+  !--flag_emit=1
+  INTEGER,SAVE             :: nAerErupt                 ! number Aerosol 
+  !$OMP THREADPRIVATE(nAerErupt)
+  REAL,ALLOCATABLE,SAVE    :: m_sulf_emiss_vol(:)        ! emitted sulfur mass in kgS, e.g. 7Tg(S)=14Tg(SO2)
+  REAL,ALLOCATABLE,SAVE    :: m_aer_emiss_vol(:,:)
+  !$OMP THREADPRIVATE(m_sulf_emiss_vol,m_aer_emiss_vol)
+  
+  !--flag_emit=2 --SAI
+  REAL,SAVE    :: m_aer_emiss_sai        ! emitted sulfur mass in kgS, eg 1e9=1TgS, 1e10=10TgS
+  REAL,SAVE    :: altemiss_sai           ! emission altitude in m
+  REAL,SAVE    :: sigma_alt_sai          ! standard deviation of emission altitude in m
+  !$OMP THREADPRIVATE(m_aer_emiss_sai, altemiss_sai, sigma_alt_sai)
+  INTEGER,SAVE    :: year_emit_sai_start
+  INTEGER,SAVE    :: year_emit_sai_end
+  INTEGER,SAVE    :: mth_emit_sai_start
+  INTEGER,SAVE    :: mth_emit_sai_end
+  INTEGER,SAVE    :: day_emit_sai_start
+  INTEGER,SAVE    :: day_emit_sai_end
+  !$OMP THREADPRIVATE(year_emit_sai_start, year_emit_sai_end)
+  !$OMP THREADPRIVATE(mth_emit_sai_start, mth_emit_sai_end)
+  !$OMP THREADPRIVATE(day_emit_sai_start, day_emit_sai_end)
+  REAL,SAVE    :: xlat_sai               ! latitude of SAI in degree
+  REAL,SAVE    :: xlon_sai               ! longitude of SAI in degree
+  !$OMP THREADPRIVATE(xlat_sai, xlon_sai)
+  
+  !--flag_emit=3 -- SAI
+  REAL,SAVE    :: xlat_max_sai           ! maximum latitude of SAI in degrees
+  REAL,SAVE    :: xlat_min_sai           ! minimum latitude of SAI in degrees
+  !$OMP THREADPRIVATE(xlat_min_sai,xlat_max_sai)
+  
+  !--flag_emit=4 -- volc species
+  INTEGER,SAVE             :: nSpeciesErupt            ! number of species Repr
+  INTEGER,ALLOCATABLE,SAVE :: id_species(:)            ! indice species Repr
+  REAL,ALLOCATABLE,SAVE    :: m_species_emiss_vol(:,:) ! emitted species 
+  !$OMP THREADPRIVATE(nSpeciesErupt,id_species,m_species_emiss_vol)
+  INTEGER,ALLOCATABLE,SAVE :: id_HCl
+  INTEGER,ALLOCATABLE,SAVE :: id_HBr
+  INTEGER,ALLOCATABLE,SAVE :: id_NOx
+  INTEGER,ALLOCATABLE,SAVE :: id_H2O
+  !$OMP THREADPRIVATE(id_HCl,id_HBr,id_NOx,id_H2O)
+  REAL,ALLOCATABLE,SAVE    :: m_Chlore_emiss_vol(:)   ! emitted Chlore mass 
+  REAL,ALLOCATABLE,SAVE    :: m_Brome_emiss_vol(:)    ! emitted Brome mass
+  REAL,ALLOCATABLE,SAVE    :: m_NOx_emiss_vol(:)      ! emitted NOx mass
+  REAL,ALLOCATABLE,SAVE    :: m_H2O_emiss_vol(:)      ! emitted H2O mass
+  REAL,ALLOCATABLE,SAVE    :: m_H2O_emiss_vol_daily(:)
+  !$OMP THREADPRIVATE(m_Chlore_emiss_vol,m_Brome_emiss_vol,m_NOx_emiss_vol,m_H2O_emiss_vol)
+  !$OMP THREADPRIVATE(m_H2O_emiss_vol_daily)
+  
+  !--flag_emit=5 -- Rockets Emitted
+  INTEGER, SAVE            :: ifreqroc        ! frequence (=2 ex: tous les 2 mois)
+  !$OMP THREADPRIVATE(ifreqroc)
+  INTEGER,ALLOCATABLE,SAVE :: day_emit_roc(:) ! day of emission date
+  !$OMP THREADPRIVATE(day_emit_roc)
+  
+  REAL,SAVE    :: dlat, dlon             ! delta latitude and d longitude of grid in degree
+  !$OMP THREADPRIVATE(dlat, dlon)
+  
+CONTAINS
+    
+  SUBROUTINE strataer_init()
+    USE ioipsl_getin_p_mod, ONLY : getin_p
+    USE print_control_mod, ONLY : lunout
+    USE mod_phys_lmdz_para, ONLY : is_master
+    USE infotrac_phy, ONLY: id_OCS_strat,id_SO2_strat,id_H2SO4_strat,nbtr_sulgas
+    
+    WRITE(lunout,*) 'IN STRATAER_LOCAL_VAR INIT WELCOME!'
+    
+    !============= Check Sulfur aerosols ID =============
+    WRITE(lunout,*) 'STRATAER_LOCAL_VAR INIT: id_OCS_strat=',id_OCS_strat,' id_SO2_strat=',id_SO2_strat,' id_H2SO4_strat=',id_H2SO4_strat
+    
+    IF(id_OCS_strat < 0 .OR. id_OCS_strat > nbtr_sulgas) THEN
+       WRITE(lunout,*) 'ERROR : OCS index id_OCS_strat=',id_OCS_strat,' is negative or superior than the total sulfur gases !'
+       CALL abort_physic('strataer_local_var_mod','Wrong OCS index, check your tracer.def file.',1)
+    ELSEIF(id_SO2_strat < 0 .OR. id_SO2_strat > nbtr_sulgas) THEN
+       WRITE(lunout,*) 'ERROR : SO2 index id_SO2_strat=',id_SO2_strat,' is negative or superior than the total sulfur gases !'
+       CALL abort_physic('strataer_local_var_mod','Wrong SO2 index, check your tracer.def file.',1)
+    ELSEIF(id_H2SO4_strat < 0 .OR. id_H2SO4_strat > nbtr_sulgas) THEN
+       WRITE(lunout,*) 'ERROR : H2SO4 index id_H2SO4_strat=',id_H2SO4_strat,' is negative or superior than the total sulfur gases !'
+       CALL abort_physic('strataer_local_var_mod','Wrong H2SO4 index, check your tracer.def file.',1)
+    ENDIF
+    
+    !============= Init params =============
+    flag_emit = 0                   ! Background (default)
+    flag_emit_distrib = 0           ! Gaussian (default)
+    flag_new_nucl = .TRUE.          ! Define nucleation routine (default: A. Maattanen - LATMOS)
+    flag_verbose_strataer = .FALSE. ! verbose mode
+    flag_newclim_file = .TRUE.      ! Define input climato file (default: all climato)
+    flag_H2O2d_nucleation = .FALSE. ! Use H2O 2D climato (default: No)
+    flag_OH_reduced = .FALSE.       ! OH reduce (default: No)
+    flag_H2SO4_photolysis = .FALSE. ! H2SO4 photolysis (default: No)
+    flag_min_rreduce = .TRUE.       ! Minimum lifetime=1.5 pdt phys (default: Yes)
+    ok_qemiss = .FALSE.             ! H2O emission flag
+    
+    ! nuc init
+    flag_nuc_rate_box = .FALSE.
+    nuclat_min=0  ; nuclat_max=0
+    nucpres_min=0 ; nucpres_max=0
+    
+    ! emiss init
+    nErupt = 0 ! eruption number
+    injdur = 0 ! init injection duration
+    nAerErupt = 1 ; nSpeciesErupt = 1 ; id_species = 3
+    year_emit_vol=0 ; mth_emit_vol=0 ; day_emit_vol=0
+    m_species_emiss_vol=0. ; m_aer_emiss_vol=0. ; m_sulf_emiss_vol=0.
+    altemiss_vol=0. ; sigma_alt_vol=0.
+    xlon_min_vol=0. ; xlon_max_vol=0.
+    xlat_min_vol=0. ; xlat_max_vol=0.
+    m_Chlore_emiss_vol=0. ; m_Brome_emiss_vol=0.
+    m_NOx_emiss_vol=0. ; m_H2O_emiss_vol=0.
+    day_emit_roc=0 ; ifreqroc=2 ; flh2o=0
+    
+    !============= Read params =============
+    CALL getin_p('flag_emit',flag_emit)
+    CALL getin_p('flag_emit_distrib',flag_emit_distrib)
+    CALL getin_p('flag_verbose_strataer',flag_verbose_strataer)
+    CALL getin_p('flag_new_nucl',flag_new_nucl)
+    CALL getin_p('flag_newclim_file',flag_newclim_file)
+    CALL getin_p('flag_H2O2d_nucleation',flag_H2O2d_nucleation)
+    CALL getin_p('flag_OH_reduced',flag_OH_reduced)
+    CALL getin_p('flag_H2SO4_photolysis',flag_H2SO4_photolysis)
+    CALL getin_p('flag_min_rreduce',flag_min_rreduce)
+    CALL getin_p('ok_qemiss',ok_qemiss)
+    
+    !============= Test flag coherence =============
+    IF (.NOT. flag_newclim_file) THEN
+       IF (flag_H2SO4_photolysis .OR. flag_OH_reduced .OR. flag_H2O2d_nucleation) THEN
+          WRITE(lunout,*) 'ERROR : flag_newclim_file=',flag_newclim_file, &
+               ' whereas flag_H2SO4_photolysis=',flag_H2SO4_photolysis,', flag_OH_reduced=',flag_OH_reduced, &
+               ' and flag_H2O2d_nucleation=',flag_H2O2d_nucleation
+          CALL abort_physic('strataer_local_var_mod','Incompatible options in physiq_def file !',1)
+       ENDIF
+       IF(flag_min_rreduce) THEN
+          WRITE(lunout,*) 'Warning : flag_min_rreduce will be ignored with old climato file !'
+       ENDIF
+    ENDIF
+    
+    !============= Print params =============
+    IF (is_master) THEN
+       WRITE(lunout,*) 'flag_emit = ',flag_emit
+       WRITE(lunout,*) 'IN STRATAER : flag_new_nucl = ',flag_new_nucl
+       WRITE(lunout,*) 'IN STRATAER : flag_newclim_file = ',flag_newclim_file
+       WRITE(lunout,*) 'IN STRATAER : flag_emit_distrib = ',flag_emit_distrib
+       WRITE(lunout,*) 'IN STRATAER : flag_verbose_strataer = ',flag_verbose_strataer
+       IF (flag_emit == 1 .OR. flag_emit == 4) THEN
+          WRITE(lunout,*) 'IN STRATAER : flag_H2O2d_nucleation = ',flag_H2O2d_nucleation
+          WRITE(lunout,*) 'IN STRATAER : flag_OH_reduced = ',flag_OH_reduced
+          WRITE(lunout,*) 'IN STRATAER : flag_H2SO4_photolysis = ',flag_H2SO4_photolysis
+          WRITE(lunout,*) 'IN STRATAER : flag_min_rreduce = ',flag_min_rreduce
+          WRITE(lunout,*) 'IN STRATAER : ok_qemiss = ',ok_qemiss
+       ENDIF
+    ENDIF ! if master
+    
+    WRITE(lunout,*) 'IN STRATAER INIT END'
+    
+  END SUBROUTINE strataer_init
+  
+END MODULE strataer_local_var_mod
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/strataer_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/strataer_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,240 +1,0 @@
-! $Id$
-MODULE strataer_mod
-! This module contains information about strato microphysic model parameters
-  
-  IMPLICIT NONE
-
-  ! flag to constraint nucleation rate in a lat/pres box
-  LOGICAL,SAVE :: flag_nuc_rate_box      ! Nucleation rate limit or not to a lat/pres
-  !$OMP THREADPRIVATE(flag_nuc_rate_box)
-  REAL,SAVE    :: nuclat_min             ! min lat to activate nuc rate
-  REAL,SAVE    :: nuclat_max             ! max lat to activate nuc rate
-  REAL,SAVE    :: nucpres_min            ! min pres to activate nuc rate
-  REAL,SAVE    :: nucpres_max            ! max pres to activate nuc rate
-  !$OMP THREADPRIVATE(nuclat_min, nuclat_max, nucpres_min, nucpres_max)
-  
-  ! flag for sulfur emission scenario: (0) background aer ; (1) volcanic eruption ; (2) strato aer injections (SAI)
-  INTEGER,SAVE :: flag_sulf_emit
-  !$OMP THREADPRIVATE(flag_sulf_emit)
-
-  ! flag for sulfur emission altitude distribution: (0) gaussian; (1) uniform
-  INTEGER,SAVE :: flag_sulf_emit_distrib
-  !$OMP THREADPRIVATE(flag_sulf_emit_distrib)
-  
-  !--flag_sulf_emit=1 -- Volcanic eruption(s)
-  INTEGER,SAVE             :: nErupt                    ! number of eruptions specs
-  REAL,SAVE                :: injdur                    ! volcanic injection duration
-  !$OMP THREADPRIVATE(nErupt, injdur)
-  INTEGER,ALLOCATABLE,SAVE :: year_emit_vol(:)          ! year of emission date
-  INTEGER,ALLOCATABLE,SAVE :: mth_emit_vol(:)           ! month of emission date
-  INTEGER,ALLOCATABLE,SAVE :: day_emit_vol(:)           ! day of emission date
-  !$OMP THREADPRIVATE(year_emit_vol, mth_emit_vol, day_emit_vol)
-  REAL,ALLOCATABLE,SAVE    :: m_aer_emiss_vol(:)        ! emitted sulfur mass in kgS, e.g. 7Tg(S)=14Tg(SO2)
-  REAL,ALLOCATABLE,SAVE    :: altemiss_vol(:)           ! emission altitude in m
-  REAL,ALLOCATABLE,SAVE    :: sigma_alt_vol(:)          ! standard deviation of emission altitude in m
-  !$OMP THREADPRIVATE(m_aer_emiss_vol, altemiss_vol, sigma_alt_vol)
-  INTEGER,ALLOCATABLE,SAVE :: ponde_lonlat_vol(:)       ! lon/lat ponderation factor
-  REAL,ALLOCATABLE,SAVE    :: xlat_min_vol(:)           ! min latitude of volcano in degree
-  REAL,ALLOCATABLE,SAVE    :: xlat_max_vol(:)           ! max latitude of volcano in degree
-  REAL,ALLOCATABLE,SAVE    :: xlon_min_vol(:)           ! min longitude of volcano in degree
-  REAL,ALLOCATABLE,SAVE    :: xlon_max_vol(:)           ! max longitude of volcano in degree
-  !$OMP THREADPRIVATE(ponde_lonlat_vol, xlat_min_vol, xlat_max_vol, xlon_min_vol, xlon_max_vol)
-  
-  !--flag_sulf_emit=2 --SAI
-  REAL,SAVE    :: m_aer_emiss_sai        ! emitted sulfur mass in kgS, eg 1e9=1TgS, 1e10=10TgS
-  REAL,SAVE    :: altemiss_sai           ! emission altitude in m
-  REAL,SAVE    :: sigma_alt_sai          ! standard deviation of emission altitude in m
-  !$OMP THREADPRIVATE(m_aer_emiss_sai, altemiss_sai, sigma_alt_sai)
-  REAL,SAVE    :: xlat_sai               ! latitude of SAI in degree
-  REAL,SAVE    :: xlon_sai               ! longitude of SAI in degree
-  REAL,SAVE    :: dlat, dlon             ! delta latitude and d longitude of grid in degree
-  !$OMP THREADPRIVATE(xlat_sai, xlon_sai, dlat, dlon)
-  
-  !--flag_sulf_emit=3 -- SAI
-  REAL,SAVE    :: xlat_max_sai           ! maximum latitude of SAI in degrees
-  REAL,SAVE    :: xlat_min_sai           ! minimum latitude of SAI in degrees
-  !$OMP THREADPRIVATE(xlat_min_sai,xlat_max_sai)
-  
-CONTAINS
-    
-  SUBROUTINE strataer_init()
-    USE ioipsl_getin_p_mod, ONLY : getin_p
-    USE print_control_mod, ONLY : lunout
-    USE mod_phys_lmdz_para, ONLY : is_master
-
-    ! Local var
-    INTEGER       :: ieru
- 
-    INTEGER :: i
-    
-    WRITE(lunout,*) 'IN STRATAER INIT WELCOME!'
-   
-    !Config Key  = flag_sulf_emit
-    !Config Desc = aerosol emission mode
-    ! - 0 = background aerosol
-    ! - 1 = volcanic eruption
-    ! - 2 = geo-ingeneering design
-    ! - 3 = geo-engineering between two latitudes
-    !Config Def  = 0
-    !Config Help = Used in physiq.F
-    !
-    flag_sulf_emit = 0 ! Background (default)
-    flag_sulf_emit_distrib = 0 ! Gaussian (default)
-    nErupt = 0 ! eruption number
-    injdur = 0 ! init injection duration
-    CALL getin_p('flag_sulf_emit',flag_sulf_emit)
-
-    IF (flag_sulf_emit==1) THEN ! Volcano
-       CALL getin_p('nErupt',nErupt)
-       CALL getin_p('injdur',injdur)
-       CALL getin_p('flag_sulf_emit_distrib',flag_sulf_emit_distrib)
-
-       year_emit_vol=0 ; mth_emit_vol=0 ; day_emit_vol=0
-       m_aer_emiss_vol=0. ; altemiss_vol=0. ; sigma_alt_vol=0.
-       xlon_min_vol=0. ; xlon_max_vol=0.
-       xlat_min_vol=0. ; xlat_max_vol=0.
-
-       IF (nErupt.GT.0) THEN
-          ALLOCATE(year_emit_vol(nErupt),mth_emit_vol(nErupt),day_emit_vol(nErupt))
-          ALLOCATE(m_aer_emiss_vol(nErupt),altemiss_vol(nErupt),sigma_alt_vol(nErupt))
-          ALLOCATE(xlat_min_vol(nErupt),xlon_min_vol(nErupt))
-          ALLOCATE(xlat_max_vol(nErupt),xlon_max_vol(nErupt))
-       ELSE
-          WRITE(lunout,*) 'ERROR : Using flag_sulf_emit=1 (ie Volcanic eruption) but nErupt (',nErupt,') <=0 !'
-          CALL abort_physic('strataer_mod','No eruption define in physiq_def (nErupt=0). Add one or use background condition.',1)
-       ENDIF
-
-       CALL getin_p('year_emit_vol',year_emit_vol)
-       CALL getin_p('mth_emit_vol',mth_emit_vol)
-       CALL getin_p('day_emit_vol',day_emit_vol)
-       CALL getin_p('m_aer_emiss_vol',m_aer_emiss_vol)
-       CALL getin_p('altemiss_vol',altemiss_vol)
-       CALL getin_p('sigma_alt_vol',sigma_alt_vol)
-       CALL getin_p('xlon_min_vol',xlon_min_vol)
-       CALL getin_p('xlon_max_vol',xlon_max_vol)
-       CALL getin_p('xlat_min_vol',xlat_min_vol)
-       CALL getin_p('xlat_max_vol',xlat_max_vol)
-    ELSEIF (flag_sulf_emit == 2) THEN ! SAI
-       CALL getin_p('m_aer_emiss_sai',m_aer_emiss_sai)
-       CALL getin_p('altemiss_sai',altemiss_sai)
-       CALL getin_p('sigma_alt_sai',sigma_alt_sai)
-       CALL getin_p('xlat_sai',xlat_sai)
-       CALL getin_p('xlon_sai',xlon_sai)
-    ELSEIF (flag_sulf_emit == 3) THEN ! SAI between latitudes
-       CALL getin_p('m_aer_emiss_sai',m_aer_emiss_sai)
-       CALL getin_p('altemiss_sai',altemiss_sai)
-       CALL getin_p('sigma_alt_sai',sigma_alt_sai)
-       CALL getin_p('xlon_sai',xlon_sai)
-       CALL getin_p('xlat_max_sai',xlat_max_sai)
-       CALL getin_p('xlat_min_sai',xlat_min_sai)
-    ENDIF
-
-    !Config Key  = flag_nuc_rate_box
-    !Config Desc = define or not a box for nucleation rate
-    ! - F = global nucleation
-    ! - T = 2D-box for nucleation need nuclat_min, nuclat_max, nucpres_min and
-    ! nucpres_max
-    !       to define its bounds.
-    !Config Def  = F
-    !Config Help = Used in physiq.F
-    !
-    flag_nuc_rate_box = .FALSE.
-    nuclat_min=0  ; nuclat_max=0
-    nucpres_min=0 ; nucpres_max=0
-
-    CALL getin_p('flag_nuc_rate_box',flag_nuc_rate_box)
-    CALL getin_p('nuclat_min',nuclat_min)
-    CALL getin_p('nuclat_max',nuclat_max)
-    CALL getin_p('nucpres_min',nucpres_min)
-    CALL getin_p('nucpres_max',nucpres_max)
-
-    !IF (is_master) THEN
-    WRITE(lunout,*) 'flag_sulf_emit = ',flag_sulf_emit
-    IF (flag_sulf_emit == 1) THEN
-       WRITE(lunout,*) 'IN STRATAER nErupt: ',nErupt
-       WRITE(lunout,*) 'IN STRATAER injdur: ',injdur
-       WRITE(lunout,*) 'IN STRATAER : year_emit_vol',year_emit_vol
-       WRITE(lunout,*) 'IN STRATAER : mth_emit_vol',mth_emit_vol
-       WRITE(lunout,*) 'IN STRATAER : day_emit_vol',day_emit_vol
-       WRITE(lunout,*) 'IN STRATAER : m_aer_emiss_vol',m_aer_emiss_vol
-       WRITE(lunout,*) 'IN STRATAER : altemiss_vol',altemiss_vol
-       WRITE(lunout,*) 'IN STRATAER : sigma_alt_vol',sigma_alt_vol
-       WRITE(lunout,*) 'IN STRATAER : xlat_min_vol',xlat_min_vol
-       WRITE(lunout,*) 'IN STRATAER : xlat_max_vol',xlat_max_vol
-       WRITE(lunout,*) 'IN STRATAER : xlon_min_vol',xlon_min_vol
-       WRITE(lunout,*) 'IN STRATAER : xlon_max_vol',xlon_max_vol
-    ELSEIF (flag_sulf_emit == 2) THEN
-       WRITE(lunout,*) 'IN STRATAER : m_aer_emiss_sai',m_aer_emiss_sai
-       WRITE(lunout,*) 'IN STRATAER : altemiss_sai',altemiss_sai
-       WRITE(lunout,*) 'IN STRATAER : sigma_alt_sai',sigma_alt_sai
-       WRITE(lunout,*) 'IN STRATAER : xlat_sai',xlat_sai
-       WRITE(lunout,*) 'IN STRATAER : xlon_sai',xlon_sai
-    ELSEIF (flag_sulf_emit == 3) THEN
-       WRITE(lunout,*) 'IN STRATAER : m_aer_emiss_sai',m_aer_emiss_sai
-       WRITE(lunout,*) 'IN STRATAER : altemiss_sai',altemiss_sai
-       WRITE(lunout,*) 'IN STRATAER : sigma_alt_sai',sigma_alt_sai
-       WRITE(lunout,*) 'IN STRATAER : xlat_min_sai',xlat_min_sai
-       WRITE(lunout,*) 'IN STRATAER : xlat_max_sai',xlat_max_sai
-       WRITE(lunout,*) 'IN STRATAER : xlon_sai',xlon_sai
-    ENDIF
-    WRITE(lunout,*) 'flag_sulf_emit_distrib = ',flag_sulf_emit_distrib
-    WRITE(lunout,*) 'IN STRATAER : flag_nuc_rate_box = ',flag_nuc_rate_box
-    IF (flag_nuc_rate_box) THEN
-       WRITE(lunout,*) 'IN STRATAER : nuclat_min = ',nuclat_min,', nuclat_max = ',nuclat_max
-       WRITE(lunout,*) 'IN STRATAER : nucpres_min = ',nucpres_min,', nucpres_max = ',nucpres_max
-    ENDIF
-    !ENDIF
-
-    IF (flag_sulf_emit == 1) THEN
-       CALL strataer_ponde_init
-       WRITE(lunout,*) 'IN STRATAER INT2 END'
-    END IF
-    WRITE(lunout,*) 'IN STRATAER END'
-
-  END SUBROUTINE strataer_init
-  
-  ! Compute the ponderation to applicate in each grid point for all eruptions and init
-  ! dlat & dlon variables
-  SUBROUTINE strataer_ponde_init()
-    
-    USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
-    USE dimphy, ONLY: klon
-    USE mod_grid_phy_lmdz, ONLY: nbp_lat, nbp_lon
-    USE print_control_mod, ONLY : lunout
-
-    INCLUDE "YOMCST.h"  !--RPI
-
-    ! local var
-    REAL                :: pi,lat_reg_deg,lon_reg_deg! latitude and d longitude of grid in degree
-    INTEGER             :: ieru, i, j
-    
-    ALLOCATE(ponde_lonlat_vol(nErupt))
-    
-    !Compute lon/lat ponderation for injection
-    dlat=180./2./FLOAT(nbp_lat)   ! d latitude in degree
-    dlon=360./2./FLOAT(nbp_lon)   ! d longitude in degree
-    WRITE(lunout,*) 'IN STRATAER_INIT dlat=',dlat,'dlon=',dlon
-    WRITE(lunout,*) 'IN STRATAER_INIT nErupt=',nErupt
-    WRITE(lunout,*) 'IN STRATAER_INIT xlat_min=',xlat_min_vol,'xlat_max=',xlat_max_vol
-    WRITE(lunout,*) 'IN STRATAER_INIT xlon_min=',xlon_min_vol,'xlon_max=',xlon_max_vol
-    DO ieru=1, nErupt
-       ponde_lonlat_vol(ieru) = 0
-       DO i=1,nbp_lon
-          lon_reg_deg = lon_reg(i)*180./RPI
-          DO j=1,nbp_lat
-             lat_reg_deg = lat_reg(j)*180./RPI
-             IF  ( lat_reg_deg.GE.xlat_min_vol(ieru)-dlat .AND. lat_reg_deg.LT.xlat_max_vol(ieru)+dlat .AND. &
-                  lon_reg_deg.GE.xlon_min_vol(ieru)-dlon .AND. lon_reg_deg.LT.xlon_max_vol(ieru)+dlon ) THEN
-                ponde_lonlat_vol(ieru) = ponde_lonlat_vol(ieru) + 1
-             ENDIF
-          ENDDO
-       ENDDO
-       IF(ponde_lonlat_vol(ieru) == 0) THEN
-          WRITE(lunout,*) 'STRATAER_INIT ERROR: no grid point found for eruption ieru=',ieru
-       ENDIF
-    ENDDO !ieru
-    WRITE(lunout,*) 'IN STRATAER_INIT ponde_lonlat: ',ponde_lonlat_vol
-    
-  END SUBROUTINE strataer_ponde_init
-  
-END MODULE strataer_mod
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/strataer_nuc_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/strataer_nuc_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/strataer_nuc_mod.F90	(revision 4727)
@@ -0,0 +1,73 @@
+! $Id: strataer_nuc_mod.F90 3930 2021-06-11 19:39:09Z oboucher $
+MODULE strataer_nuc_mod
+! This module contains information about strato microphysic model nucleation parameters
+  
+  IMPLICIT NONE
+  
+CONTAINS
+  
+  ! Init all nucleation params
+  SUBROUTINE strataer_nuc_init()
+    
+    USE ioipsl_getin_p_mod, ONLY : getin_p
+    USE print_control_mod, ONLY : lunout
+    USE mod_phys_lmdz_para, ONLY : is_master
+    USE strataer_local_var_mod, ONLY: flag_nuc_rate_box,nuclat_min,nuclat_max,nucpres_min,nucpres_max
+    
+    !Config Key  = flag_nuc_rate_box
+    !Config Desc = define or not a box for nucleation rate
+    ! - F = global nucleation
+    ! - T = 2D-box for nucleation need nuclat_min, nuclat_max, nucpres_min and
+    ! nucpres_max
+    !       to define its bounds.
+    !Config Def  = F
+    !Config Help = Used in physiq.F
+    !
+    CALL getin_p('flag_nuc_rate_box',flag_nuc_rate_box)
+    CALL getin_p('nuclat_min',nuclat_min)
+    CALL getin_p('nuclat_max',nuclat_max)
+    CALL getin_p('nucpres_min',nucpres_min)
+    CALL getin_p('nucpres_max',nucpres_max)
+    
+    !============= Print params =============
+    IF (is_master) THEN
+       WRITE(lunout,*) 'IN STRATAER_NUC : flag_nuc_rate_box = ',flag_nuc_rate_box
+       IF (flag_nuc_rate_box) THEN
+          WRITE(lunout,*) 'IN STRATAER_NUC : nuclat_min = ',nuclat_min,', nuclat_max = ',nuclat_max
+          WRITE(lunout,*) 'IN STRATAER_NUC : nucpres_min = ',nucpres_min,', nucpres_max = ',nucpres_max
+       ENDIF
+    ENDIF ! if master
+    
+  END SUBROUTINE strataer_nuc_init
+  
+  ! Init aerosol tracers and large scale scavinging
+  SUBROUTINE tracstrataer_init(aerosol,lessivage)
+    
+    USE infotrac_phy, ONLY: nbtr, nbtr_sulgas, id_H2SO4_strat
+    USE ioipsl, ONLY : getin
+    USE print_control_mod, ONLY : lunout
+    
+    ! Output variables
+    LOGICAL,DIMENSION(nbtr), INTENT(INOUT) :: aerosol
+    LOGICAL,INTENT(INOUT)                  :: lessivage
+    INTEGER :: it
+    
+    ! Initialization
+    lessivage  =.TRUE.
+    aerosol(:) = .FALSE.
+    
+    DO it= 1, nbtr_sulgas
+       aerosol(it)=.FALSE.
+       IF (it==id_H2SO4_strat) aerosol(it)=.TRUE.
+    ENDDO
+    DO it= nbtr_sulgas+1, nbtr
+       aerosol(it)=.TRUE.
+    ENDDO
+    
+    !!jyg(20130206) : le choix d activation du lessivage est fait dans phytrac avec iflag_lscav
+!    CALL getin('lessivage',lessivage)
+    WRITE(lunout,*) 'IN TRACSTRATAER_INIT lessivage: ',lessivage
+    
+  END SUBROUTINE tracstrataer_init
+  
+END MODULE strataer_nuc_mod
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/stratdistrib.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/stratdistrib.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/stratdistrib.F90	(revision 4727)
@@ -0,0 +1,68 @@
+!
+! $Id: stratemit.F90  2022-07-04 mmarchand $
+!
+SUBROUTINE STRATDISTRIB(altLMDz,altemiss,sigma_alt,f_lay_emiss)
+!
+  USE dimphy, ONLY : klon,klev
+  USE strataer_local_var_mod
+  USE YOMCST, only : RPI
+
+  IMPLICIT NONE
+
+! Input argument
+!---------------
+    REAL,DIMENSION(klev+1)  :: altLMDz    ! altitude of layer interfaces in m
+    REAL                    :: sigma_alt
+    REAL                    :: altemiss
+
+! Local variables
+!----------------
+    REAL                 :: f_lay_sum     ! sum of layer emission fractions
+    REAL                 :: alt
+    INTEGER              :: k,i_int
+    INTEGER,PARAMETER    :: n_int_alt=10  ! subintervals nb for integration over Gaussian emission
+
+! Output argument
+!----------------
+    REAL,DIMENSION(klev) :: f_lay_emiss   ! emiss fraction for every emiss for every vertical layer
+    
+    
+! Inject distrib
+!----------------
+    SELECT CASE(flag_emit_distrib)
+       
+    CASE(0) ! Gaussian distribution
+            ! Compute distribution of emission to vertical model layers
+            ! (based on Gaussian peak in altitude)
+       f_lay_sum=0.0
+       DO k=1, klev
+          f_lay_emiss(k)=0.0
+          DO i_int=1, n_int_alt
+             alt=altLMDz(k)+float(i_int)*(altLMDz(k+1)-altLMDz(k))/float(n_int_alt)
+             f_lay_emiss(k)=f_lay_emiss(k)+1./(sqrt(2.*RPI)*sigma_alt)* &
+                   & exp(-0.5*((alt-altemiss)/sigma_alt)**2.)* &           
+                   & (altLMDz(k+1)-altLMDz(k))/float(n_int_alt)
+          ENDDO
+          f_lay_sum=f_lay_sum+f_lay_emiss(k)
+        ENDDO
+        
+     CASE(1) ! Uniform distribution
+             ! In this case, parameter sigma_alt is considered
+             ! to be half the
+             ! height of the injection, centered around altemiss)
+       f_lay_sum=0.0
+       DO k=1, klev
+          f_lay_emiss(k)=max(min(altemiss+sigma_alt,altLMDz(k+1))- &
+                      & max(altemiss-sigma_alt, &
+                      & altLMDz(k)),0.)/(2.*sigma_alt)
+          f_lay_sum=f_lay_sum+f_lay_emiss(k)
+       ENDDO
+
+       END SELECT        ! End CASE over flag_emit_distrib)
+       
+       WRITE(*,*) "IN stratdistrib f_lay_emiss=",f_lay_emiss
+
+       !correct for step integration error
+       f_lay_emiss(:)=f_lay_emiss(:)/f_lay_sum
+
+END SUBROUTINE STRATDISTRIB
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/stratemit.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/stratemit.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/stratemit.F90	(revision 4727)
@@ -0,0 +1,162 @@
+!
+! $Id: stratemit.F90  2022-07-04 mmarchand $
+!
+SUBROUTINE STRATEMIT(pdtphys,pdt,xlat,xlon,t_seri,pplay,paprs,tr_seri,&
+                    m_emiss_vol_daily,latmin,latmax,lonmin,lonmax,altemiss,sigma_alt,id_spec,&
+                    stretchlong,ispeci,id_species_total) 
+
+  USE dimphy, ONLY : klon,klev
+  USE strataer_local_var_mod
+  USE phys_cal_mod
+  USE phys_local_var_mod, ONLY: d_q_emiss
+  USE YOMCST, only : RD, RPI, RG
+  USE geometry_mod, ONLY : cell_area, boundslat
+  USE aerophys
+  USE infotrac_phy
+  USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+  USE mod_grid_phy_lmdz, ONLY: nbp_lon
+ 
+  IMPLICIT NONE
+
+! Input argument
+!---------------
+    REAL,INTENT(IN)    :: pdtphys, pdt               ! Pas d'integration pour la physique(seconde)
+    REAL,DIMENSION(klon),INTENT(IN)    :: xlat       ! latitudes pour chaque point
+    REAL,DIMENSION(klon),INTENT(IN)    :: xlon       ! longitudes pour chaque point
+    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay
+    ! pression pour le mileu de chaque couche (en Pa)
+    REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs
+    ! pression pour chaque inter-couche (en Pa)
+    REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri ! Temperature
+    REAL,INTENT(IN)    :: latmin,latmax,lonmin,lonmax
+    REAL,INTENT(IN)    :: m_emiss_vol_daily          ! daily injection mass emission
+    REAL,INTENT(IN)    :: stretchlong                ! length to stretch emission (day)
+    REAL,DIMENSION(klon,klev) :: m_air_gridbox       ! mass ofair in every grid box[kg
+    REAL,INTENT(IN)     :: sigma_alt, altemiss
+    INTEGER,INTENT(IN)  :: id_spec, ispeci, id_species_total
+    
+! Output argument
+!----------------
+    REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT)  :: tr_seri ! Concentration Traceur [U/KgA]
+! Local variables
+!----------------
+    INTEGER              :: ieru, i, k, i_int, ilon, ilev
+    REAL                 :: dlat_loc
+    REAL,DIMENSION(klev+1)  :: altLMDz    ! altitude of layer interfaces in m
+    REAL                 :: zrho          ! Density of air [kg/m3]
+    REAL,DIMENSION(klev) :: zdm           ! mass of atm. model layer in kg  
+    REAL                 :: zdz           ! thickness of atm. model layer in m
+    REAL                 :: f_lay_sum     ! sum of layer emission fractions
+    REAL,DIMENSION(klev) :: f_lay_emiss   ! emiss fraction for every emiss for every vertical layer
+    REAL                 :: emission      ! emission
+    REAL                 :: theta_min, theta_max, theta ! for SAI computation between two latitudes
+    
+    IF (is_mpi_root) THEN
+       WRITE(*,*) 'IN STRATEMIT: date from phys_cal_mod=',year_cur,'-',&
+                      &  mth_cur,'-',day_cur,'-',hour,' flh2o=',flh2o
+    ENDIF
+
+!--calculate mass of air in every grid box !NL: DONE ABOVE DIRECTLY IN MAIN LOOP I,K
+!    DO ilon=1, klon
+!       DO ilev=1, klev
+!          m_air_gridbox(ilon,ilev)=(paprs(ilon,ilev)-paprs(ilon,ilev+1))/RG*cell_area(ilon)
+!       ENDDO
+!    ENDDO
+    
+    DO i=1,klon
+       
+       dlat_loc=180./RPI/2.*(boundslat(i,1)-boundslat(i,3))
+       dlon=360./2./FLOAT(nbp_lon) 
+       ! dlat = half difference of boundary latitudes
+       IF(flag_verbose_strataer) WRITE(*,*) 'IN STRATEMIT, dlat=',dlat_loc,xlat(i),xlon(i)
+       
+       theta_min = max(xlat(i)-dlat_loc,latmin)
+       theta_max = min(xlat(i)+dlat_loc,latmax)
+                
+       IF (  xlat(i).GE.latmin-dlat_loc .AND. &
+         &   xlat(i).LT.latmax+dlat_loc .AND. &
+         &   xlon(i).GE.lonmin-dlon .AND. &
+         &   xlon(i).LT.lonmax+dlon ) THEN
+                   !
+          WRITE(*,*) 'coordinates of volcanic injection point=',&
+            &    xlat(i),xlon(i),day_cur,mth_cur,year_cur
+          WRITE(*,*) 'DD m_emiss_vol_daily=', &
+            &    m_emiss_vol_daily
+          
+          !compute altLMDz
+          altLMDz(:)=0.0
+          DO k=1, klev
+             zrho=pplay(i,k)/t_seri(i,k)/RD       !air density in kg/m3
+             zdm(k)=(paprs(i,k)-paprs(i,k+1))/RG  !mass of layer in kg
+             zdz=zdm(k)/zrho                   !thickness of layer in m
+             altLMDz(k+1)=altLMDz(k)+zdz       !altitude of interface
+          ENDDO
+          
+          CALL STRATDISTRIB(altLMDz,altemiss,sigma_alt,f_lay_emiss)
+          
+          IF (flag_emit.EQ.3) then
+             theta=(sin(theta_max/180.*RPI)-sin(theta_min/180.*RPI))/ &
+               & (sin(xlat_max_sai/180.*RPI)-sin(xlat_min_sai/180.*RPI))
+          ELSE
+             theta=1.
+          ENDIF
+
+          !vertically distributed emission
+          DO k=1, klev
+            !--calculate mass of air in every grid box
+            m_air_gridbox(i,k)=(paprs(i,k)-paprs(i,k+1))/RG*cell_area(i)
+            ! stretch emission over stretchlong period
+            emission=m_emiss_vol_daily/m_air_gridbox(i,k)*f_lay_emiss(k)/stretchlong/ &
+                 &     (86400.-pdt)*theta
+            
+             IF(flag_verbose_strataer) WRITE(*,*) 'IN STRATEMIT: emission avant/apres', &
+              &  'alt= ', altLMDz(k), &
+              &  'flh2o= ',flh2o, &
+              &  'id_speac= ',id_spec,id_species_total, &
+              &  'emission= ',emission, &
+              &  'pdtphys= ',pdtphys, &
+              &  'rapport m_emiss/m_air*f_lay= ', m_emiss_vol_daily/m_air_gridbox(i,k)*f_lay_emiss(k), &
+              &   'stretchlong= ', stretchlong, &
+              &   'theta= ', theta
+             
+             IF(emission < 1.E-34) emission = 0.0
+             
+             IF (flh2o.EQ.0) THEN
+                IF(flag_verbose_strataer) WRITE(*,*) 'IN STRATEMIT: tr_ser avant/apres',&
+                  &  'i= ',i,'k= ',k, 'flh2o= ',flh2o, &
+                  &  tr_seri(i,k,id_spec), &
+                  &  tr_seri(i,k,id_spec)+emission*pdtphys
+              
+                tr_seri(i,k,id_spec)=tr_seri(i,k,id_spec)+emission*pdtphys
+                IF (id_species_total.NE.0) THEN
+                   tr_seri(i,k,id_species_total)=tr_seri(i,k,id_species_total)+emission*pdtphys
+                ENDIF
+             ELSE IF(flh2o.EQ.1) THEN
+                d_q_emiss(i,k)=emission*pdtphys
+                IF(d_q_emiss(i,k) > 1.E34) THEN
+                   WRITE(*,*) 'IN STRATEMIT: d_q_emiss(i,k) > 1.E34 = ',d_q_emiss(i,k)
+                ELSE IF(d_q_emiss(i,k) < -1.E34) THEN
+                   WRITE(*,*) 'IN STRATEMIT: d_q_emiss(i,k) < -1.E34 = ',d_q_emiss(i,k)
+                ENDIF
+                
+                IF(flag_verbose_strataer) WRITE(*,*) 'IN STRATEMIT: ',&
+                     &  'i= ',i,'k= ',k, 'flh2o= ',flh2o, &
+                     &  'emission= ',emission, &
+                     &  'd_q_emiss(i,k)= ',d_q_emiss(i,k)
+                
+                IF(d_q_emiss(i,k) > 1.E34) THEN
+                   d_q_emiss(i,k) = 1.E34
+                   WRITE(*,*) 'IN STRATEMIT: d_q_emiss(i,k) > 1.E34 : ',d_q_emiss(i,k)
+                ELSE IF(d_q_emiss(i,k) < -1.E34) THEN
+                   d_q_emiss(i,k) = -1.E34
+                   WRITE(*,*) 'IN STRATEMIT: d_q_emiss(i,k) < -1.E34 : ',d_q_emiss(i,k)
+                ENDIF
+             ENDIF
+             budg_emi(i,ispeci)=budg_emi(i,ispeci)+emission*zdm(k)
+          ENDDO
+          
+       ENDIF ! emission grid cell
+
+    ENDDO ! klon loop
+
+END SUBROUTINE STRATEMIT
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/traccoag_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/traccoag_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/StratAer/traccoag_mod.F90	(revision 4727)
@@ -23,11 +23,11 @@
     USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
     USE mod_phys_lmdz_para, only: gather, scatter
-    USE phys_cal_mod, ONLY : year_len, year_cur,mth_cur, day_cur, hour
+    USE phys_cal_mod, ONLY : year_len, year_cur, mth_cur, day_cur, hour
     USE sulfate_aer_mod
     USE phys_local_var_mod, ONLY: stratomask
     USE YOMCST
     USE print_control_mod, ONLY: lunout
-    USE strataer_mod
-
+    USE strataer_local_var_mod
+    
     IMPLICIT NONE
 
@@ -58,4 +58,5 @@
 !----------------
     REAL                                   :: m_aer_emiss_vol_daily ! daily injection mass emission
+    REAL                                   :: m_aer               ! aerosol mass
     INTEGER                                :: it, k, i, ilon, ilev, itime, i_int, ieru
     LOGICAL,DIMENSION(klon,klev)           :: is_strato           ! true = above tropopause, false = below
@@ -78,8 +79,14 @@
     REAL                                   :: theta_min, theta_max ! for SAI computation between two latitudes
     REAL                                   :: dlat_loc
-
-    IF (is_mpi_root) THEN
+    REAL                                   :: latmin,latmax,lonmin,lonmax ! lat/lon min/max for injection
+    REAL                                   :: sigma_alt, altemiss ! injection altitude + sigma for distrib
+    REAL                                   :: pdt,stretchlong     ! physic timestep, stretch emission over one day
+    
+    INTEGER                                :: injdur_sai          ! injection duration for SAI case [days]
+    INTEGER                                :: yr, is_bissext
+
+    IF (is_mpi_root .AND. flag_verbose_strataer) THEN
        WRITE(lunout,*) 'in traccoag: date from phys_cal_mod =',year_cur,'-',mth_cur,'-',day_cur,'-',hour
-       WRITE(lunout,*) 'IN traccoag flag_sulf_emit: ',flag_sulf_emit
+       WRITE(lunout,*) 'IN traccoag flag_emit: ',flag_emit
     ENDIF
     
@@ -124,20 +131,11 @@
 !--calculate mass of air in every grid box
     DO ilon=1, klon
-    DO ilev=1, klev
-      m_air_gridbox(ilon,ilev)=(paprs(ilon,ilev)-paprs(ilon,ilev+1))/RG*cell_area(ilon)
+       DO ilev=1, klev
+          m_air_gridbox(ilon,ilev)=(paprs(ilon,ilev)-paprs(ilon,ilev+1))/RG*cell_area(ilon)
+       ENDDO
     ENDDO
-    ENDDO
-
-!    IF (debutphy) THEN
-!      CALL gather(tr_seri, tr_seri_glo)
-!      IF (MAXVAL(tr_seri_glo).LT.1.e-30) THEN
-!--initialising tracer concentrations to zero
-!        DO it=1, nbtr
-!        tr_seri(:,:,it)=0.0
-!        ENDDO
-!      ENDIF
-!    ENDIF
-
+    
 !--initialise emission diagnostics
+    budg_emi(:,1)=0.0
     budg_emi_ocs(:)=0.0
     budg_emi_so2(:)=0.0
@@ -145,6 +143,6 @@
     budg_emi_part(:)=0.0
 
-!--sulfur emission, depending on chosen scenario (flag_sulf_emit)
-    SELECT CASE(flag_sulf_emit)
+!--sulfur emission, depending on chosen scenario (flag_emit)
+    SELECT CASE(flag_emit)
 
     CASE(0) ! background aerosol
@@ -157,71 +155,29 @@
           IF (year_cur==year_emit_vol(ieru).AND.mth_cur==mth_emit_vol(ieru).AND.&
                day_cur>=day_emit_vol(ieru).AND.day_cur<(day_emit_vol(ieru)+injdur)) THEN
-             !
-             ! daily injection mass emission - NL
-             m_aer_emiss_vol_daily = m_aer_emiss_vol(ieru)/(REAL(injdur)*REAL(ponde_lonlat_vol(ieru)))
-             WRITE(lunout,*) 'IN traccoag DD m_aer_emiss_vol(ieru)=',m_aer_emiss_vol(ieru), &
+
+             ! daily injection mass emission
+             m_aer=m_aer_emiss_vol(ieru,1)/(REAL(injdur)*REAL(ponde_lonlat_vol(ieru)))
+             !emission as SO2 gas (with m(SO2)=64/32*m_aer_emiss)
+             m_aer=m_aer*(mSO2mol/mSatom)
+             
+             WRITE(lunout,*) 'IN traccoag m_aer_emiss_vol(ieru)=',m_aer_emiss_vol(ieru,1), &
                   'ponde_lonlat_vol(ieru)=',ponde_lonlat_vol(ieru),'(injdur*ponde_lonlat_vol(ieru))', &
-                  (injdur*ponde_lonlat_vol(ieru)),'m_aer_emiss_vol_daily=',m_aer_emiss_vol_daily,'ieru=',ieru
+                  (injdur*ponde_lonlat_vol(ieru)),'m_aer_emiss_vol_daily=',m_aer,'ieru=',ieru
              WRITE(lunout,*) 'IN traccoag, dlon=',dlon
-             DO i=1,klon
-                !Pinatubo eruption at 15.14N, 120.35E
-                dlat_loc=180./RPI/2.*(boundslat(i,1)-boundslat(i,3)) ! dlat = half difference of boundary latitudes
-                WRITE(lunout,*) 'IN traccoag, dlat=',dlat_loc
-                IF ( xlat(i).GE.xlat_min_vol(ieru)-dlat_loc .AND. xlat(i).LT.xlat_max_vol(ieru)+dlat_loc .AND. &
-                     xlon(i).GE.xlon_min_vol(ieru)-dlon .AND. xlon(i).LT.xlon_max_vol(ieru)+dlon ) THEN
-                   !
-                   WRITE(lunout,*) 'coordinates of volcanic injection point=',xlat(i),xlon(i),day_cur,mth_cur,year_cur
-                   WRITE(lunout,*) 'DD m_aer_emiss_vol_daily=',m_aer_emiss_vol_daily
-                   !         compute altLMDz
-                   altLMDz(:)=0.0
-                   DO k=1, klev
-                      zrho=pplay(i,k)/t_seri(i,k)/RD       !air density in kg/m3
-                      zdm(k)=(paprs(i,k)-paprs(i,k+1))/RG  !mass of layer in kg
-                      zdz=zdm(k)/zrho                      !thickness of layer in m
-                      altLMDz(k+1)=altLMDz(k)+zdz          !altitude of interface
-                   ENDDO
-
-                   SELECT CASE(flag_sulf_emit_distrib)
-                   
-                   CASE(0) ! Gaussian distribution
-                   !compute distribution of emission to vertical model layers (based on Gaussian peak in altitude)
-                   f_lay_sum=0.0
-                   DO k=1, klev
-                      f_lay_emiss(k)=0.0
-                      DO i_int=1, n_int_alt
-                         alt=altLMDz(k)+float(i_int)*(altLMDz(k+1)-altLMDz(k))/float(n_int_alt)
-                         f_lay_emiss(k)=f_lay_emiss(k)+1./(sqrt(2.*RPI)*sigma_alt_vol(ieru))* &
-                              &              exp(-0.5*((alt-altemiss_vol(ieru))/sigma_alt_vol(ieru))**2.)*   &
-                              &              (altLMDz(k+1)-altLMDz(k))/float(n_int_alt)
-                      ENDDO
-                      f_lay_sum=f_lay_sum+f_lay_emiss(k)
-                   ENDDO
-                   
-                   CASE(1) ! Uniform distribution
-                   ! In this case, parameter sigma_alt_vol(ieru) is considered to be half the
-                   ! height of the injection, centered around altemiss_vol(ieru)
-                   DO k=1, klev
-                      f_lay_emiss(k)=max(min(altemiss_vol(ieru)+sigma_alt_vol(ieru),altLMDz(k+1))- &
-                      & max(altemiss_vol(ieru)-sigma_alt_vol(ieru),altLMDz(k)),0.)/(2.*sigma_alt_vol(ieru))
-                      f_lay_sum=f_lay_sum+f_lay_emiss(k)
-                   ENDDO
-
-                   END SELECT        ! End CASE over flag_sulf_emit_distrib)
-
-                   WRITE(lunout,*) "IN traccoag m_aer_emiss_vol=",m_aer_emiss_vol(ieru)
-                   WRITE(lunout,*) "IN traccoag f_lay_emiss=",f_lay_emiss
-                   !correct for step integration error
-                   f_lay_emiss(:)=f_lay_emiss(:)/f_lay_sum
-                   !emission as SO2 gas (with m(SO2)=64/32*m_aer_emiss)
-                   !vertically distributed emission
-                   DO k=1, klev
-                      ! stretch emission over one day of Pinatubo eruption
-                      emission=m_aer_emiss_vol_daily*(mSO2mol/mSatom)/m_air_gridbox(i,k)*f_lay_emiss(k)/1./(86400.-pdtphys)
-                      tr_seri(i,k,id_SO2_strat)=tr_seri(i,k,id_SO2_strat)+emission*pdtphys
-                      budg_emi_so2(i)=budg_emi_so2(i)+emission*zdm(k)*mSatom/mSO2mol
-                   ENDDO
-                ENDIF ! emission grid cell
-             ENDDO ! klon loop
-             WRITE(lunout,*) "IN traccoag (ieru=",ieru,") m_aer_emiss_vol_daily=",m_aer_emiss_vol_daily
+             
+             latmin=xlat_min_vol(ieru)
+             latmax=xlat_max_vol(ieru)
+             lonmin=xlon_min_vol(ieru)
+             lonmax=xlon_max_vol(ieru)
+             altemiss = altemiss_vol(ieru)
+             sigma_alt = sigma_alt_vol(ieru)
+             pdt=pdtphys
+             ! stretch emission over one day of eruption
+             stretchlong = 1.
+             
+             CALL STRATEMIT(pdtphys,pdt,xlat,xlon,t_seri,pplay,paprs,tr_seri,&
+                  m_aer,latmin,latmax,lonmin,lonmax,altemiss,sigma_alt,id_SO2_strat, &
+                  stretchlong,1,0)
+             
           ENDIF ! emission period
        ENDDO ! eruption number
@@ -229,145 +185,124 @@
     CASE(2) ! stratospheric aerosol injections (SAI)
 !
-      DO i=1,klon
-!       SAI standard scenario with continuous emission from 1 grid point at the equator
-!       SAI emission on single month
-!       SAI continuous emission o
-        dlat_loc=180./RPI/2.*(boundslat(i,1)-boundslat(i,3)) ! dlat = half difference of boundary latitudes
-        IF  ( xlat(i).GE.xlat_sai-dlat_loc .AND. xlat(i).LT.xlat_sai+dlat_loc .AND. &
-          &   xlon(i).GE.xlon_sai-dlon .AND. xlon(i).LT.xlon_sai+dlon ) THEN
-!
-!         compute altLMDz
-          altLMDz(:)=0.0
-          DO k=1, klev
-            zrho=pplay(i,k)/t_seri(i,k)/RD       !air density in kg/m3
-            zdm(k)=(paprs(i,k)-paprs(i,k+1))/RG  !mass of layer in kg
-            zdz=zdm(k)/zrho                      !thickness of layer in m
-            altLMDz(k+1)=altLMDz(k)+zdz          !altitude of interface
-          ENDDO
-
-          SELECT CASE(flag_sulf_emit_distrib)
-
-          CASE(0) ! Gaussian distribution
-          !compute distribution of emission to vertical model layers (based on Gaussian peak in altitude)
-          f_lay_sum=0.0
-               DO k=1, klev
-                     f_lay_emiss(k)=0.0
-                     DO i_int=1, n_int_alt
-                         alt=altLMDz(k)+float(i_int)*(altLMDz(k+1)-altLMDz(k))/float(n_int_alt)
-                         f_lay_emiss(k)=f_lay_emiss(k)+1./(sqrt(2.*RPI)*sigma_alt_sai)* &
-                         &              exp(-0.5*((alt-altemiss_sai)/sigma_alt_sai)**2.)*   & 
-                         &              (altLMDz(k+1)-altLMDz(k))/float(n_int_alt) 
-                     ENDDO
-                     f_lay_sum=f_lay_sum+f_lay_emiss(k)
-               ENDDO
-
-          CASE(1) ! Uniform distribution
-          f_lay_sum=0.0
-          ! In this case, parameter sigma_alt_vol(ieru) is considered to be half
-          ! the height of the injection, centered around altemiss_sai
-               DO k=1, klev
-                    f_lay_emiss(k)=max(min(altemiss_sai+sigma_alt_sai,altLMDz(k+1))- &
-                    & max(altemiss_sai-sigma_alt_sai,altLMDz(k)),0.)/(2.*sigma_alt_sai)
-                    f_lay_sum=f_lay_sum+f_lay_emiss(k)
-               ENDDO
-
-          END SELECT ! Gaussian or uniform distribution
-
-          !correct for step integration error
-          f_lay_emiss(:)=f_lay_emiss(:)/f_lay_sum
-          !emission as SO2 gas (with m(SO2)=64/32*m_aer_emiss)
-          !vertically distributed emission
-          DO k=1, klev
-            ! stretch emission over whole year (360d)
-            emission=m_aer_emiss_sai*(mSO2mol/mSatom)/m_air_gridbox(i,k)*f_lay_emiss(k)/FLOAT(year_len)/86400.  
-            tr_seri(i,k,id_SO2_strat)=tr_seri(i,k,id_SO2_strat)+emission*pdtphys
-            budg_emi_so2(i)=budg_emi_so2(i)+emission*zdm(k)*mSatom/mSO2mol
-          ENDDO
-
-!          !emission as monodisperse particles with 0.1um dry radius (BIN21)
-!          !vertically distributed emission
-!          DO k=1, klev
-!            ! stretch emission over whole year (360d)
-!            emission=m_aer_emiss*(mH2SO4mol/mSatom)/m_part_dry(21)/m_air_gridbox(i,k)*f_lay_emiss(k)/FLOAT(year_len)/86400.
-!            tr_seri(i,k,id_BIN01_strat+20)=tr_seri(i,k,id_BIN01_strat+20)+emission*pdtphys 
-!            budg_emi_part(i)=budg_emi_part(i)+emission*zdm(k)*mSatom/mH2SO4mol
-!          ENDDO
-        ENDIF ! emission grid cell
-      ENDDO ! klon loop
+     ! Computing duration of SAI in days...
+     ! ... starting from 0...
+     injdur_sai = 0
+     ! ... then adding whole years from first to (n-1)th...
+     DO yr = year_emit_sai_start, year_emit_sai_end-1
+       ! (n % 4 == 0) and (n % 100 != 0 or n % 400 == 0)
+       is_bissext = (MOD(yr,4)==0) .AND. (MOD(yr,100) /= 0 .OR. MOD(yr,400) == 0)
+       injdur_sai = injdur_sai+365+is_bissext
+     ENDDO
+     ! ... then subtracting part of the first year where no injection yet...
+     is_bissext = (MOD(year_emit_sai_start,4)==0) .AND. (MOD(year_emit_sai_start,100) /= 0 .OR. MOD(year_emit_sai_start,400) == 0)
+     SELECT CASE(mth_emit_sai_start)
+     CASE(2)
+        injdur_sai = injdur_sai-31
+     CASE(3)
+        injdur_sai = injdur_sai-31-28-is_bissext
+     CASE(4)
+        injdur_sai = injdur_sai-31-28-is_bissext-31
+     CASE(5)
+        injdur_sai = injdur_sai-31-28-is_bissext-31-30
+     CASE(6)
+        injdur_sai = injdur_sai-31-28-is_bissext-31-30-31
+     CASE(7)
+        injdur_sai = injdur_sai-31-28-is_bissext-31-30-31-30
+     CASE(8)
+        injdur_sai = injdur_sai-31-28-is_bissext-31-30-31-30-31
+     CASE(9)
+        injdur_sai = injdur_sai-31-28-is_bissext-31-30-31-30-31-31
+     CASE(10)
+        injdur_sai = injdur_sai-31-28-is_bissext-31-30-31-30-31-31-30
+     CASE(11)
+        injdur_sai = injdur_sai-31-28-is_bissext-31-30-31-30-31-31-30-31
+     CASE(12)
+        injdur_sai = injdur_sai-31-28-is_bissext-31-30-31-30-31-31-30-31-30
+     END SELECT
+     injdur_sai = injdur_sai-day_emit_sai_start+1
+     ! ... then adding part of the n-th year 
+     is_bissext = (MOD(year_emit_sai_end,4)==0) .AND. (MOD(year_emit_sai_end,100) /= 0 .OR. MOD(year_emit_sai_end,400) == 0)
+     SELECT CASE(mth_emit_sai_end)
+     CASE(2)
+        injdur_sai = injdur_sai+31
+     CASE(3)
+        injdur_sai = injdur_sai+31+28+is_bissext
+     CASE(4)
+        injdur_sai = injdur_sai+31+28+is_bissext+31
+     CASE(5)
+        injdur_sai = injdur_sai+31+28+is_bissext+31+30
+     CASE(6)
+        injdur_sai = injdur_sai+31+28+is_bissext+31+30+31
+     CASE(7)
+        injdur_sai = injdur_sai+31+28+is_bissext+31+30+31+30
+     CASE(8)
+        injdur_sai = injdur_sai+31+28+is_bissext+31+30+31+30+31
+     CASE(9)
+        injdur_sai = injdur_sai+31+28+is_bissext+31+30+31+30+31+31
+     CASE(10)
+        injdur_sai = injdur_sai+31+28+is_bissext+31+30+31+30+31+31+30
+     CASE(11)
+        injdur_sai = injdur_sai+31+28+is_bissext+31+30+31+30+31+31+30+31
+     CASE(12)
+        injdur_sai = injdur_sai+31+28+is_bissext+31+30+31+30+31+31+30+31+30
+     END SELECT
+     injdur_sai = injdur_sai+day_emit_sai_end
+     ! A security: are SAI dates of injection consistent?
+     IF (injdur_sai <= 0) THEN
+        CALL abort_physic('traccoag_mod', 'Pb in SAI dates of injection.',1)
+     ENDIF
+     ! Injection in itself
+     IF (( year_emit_sai_start <= year_cur ) &
+        .AND. ( year_cur <= year_emit_sai_end ) &
+        .AND. ( mth_emit_sai_start <= mth_cur .OR. year_emit_sai_start < year_cur ) &
+        .AND. ( mth_cur <= mth_emit_sai_end .OR. year_cur < year_emit_sai_end ) &
+        .AND. ( day_emit_sai_start <= day_cur .OR. mth_emit_sai_start < mth_cur .OR. year_emit_sai_start < year_cur ) &
+        .AND. ( day_cur <= day_emit_sai_end .OR. mth_cur < mth_emit_sai_end .OR. year_cur < year_emit_sai_end )) THEN
+        
+       m_aer=m_aer_emiss_sai
+       !emission as SO2 gas (with m(SO2)=64/32*m_aer_emiss)
+       m_aer=m_aer*(mSO2mol/mSatom)
+       
+       latmin=xlat_sai
+       latmax=xlat_sai
+       lonmin=xlon_sai
+       lonmax=xlon_sai
+       altemiss = altemiss_sai
+       sigma_alt = sigma_alt_sai
+       pdt=0.
+       ! stretch emission over whole year (360d)
+       stretchlong=FLOAT(year_len)
+       
+       CALL STRATEMIT(pdtphys,pdt,xlat,xlon,t_seri,pplay,paprs,m_air_gridbox,tr_seri,&
+            m_aer,latmin,latmax,lonmin,lonmax,altemiss,sigma_alt,id_SO2_strat, &
+            stretchlong,1,0)
+       
+       budg_emi_so2(:) = budg_emi(:,1)*mSatom/mSO2mol
+     ENDIF ! Condition over injection dates
 
     CASE(3) ! --- SAI injection over a single band of longitude and between
             !     lat_min and lat_max
 
-    DO i=1,klon
-!       SAI scenario with continuous emission
-        dlat_loc=180./RPI/2.*(boundslat(i,1)-boundslat(i,3)) ! dlat = half difference of boundary latitudes
-        theta_min = max(xlat(i)-dlat_loc,xlat_min_sai)
-        theta_max = min(xlat(i)+dlat_loc,xlat_max_sai)
-        IF  ( xlat(i).GE.xlat_min_sai-dlat_loc .AND. xlat(i).LT.xlat_max_sai+dlat_loc .AND. &
-          &   xlon(i).GE.xlon_sai-dlon .AND. xlon(i).LT.xlon_sai+dlon ) THEN
-!
-!         compute altLMDz
-          altLMDz(:)=0.0
-          DO k=1, klev
-            zrho=pplay(i,k)/t_seri(i,k)/RD       !air density in kg/m3
-            zdm(k)=(paprs(i,k)-paprs(i,k+1))/RG  !mass of layer in kg
-            zdz=zdm(k)/zrho                      !thickness of layer in m
-            altLMDz(k+1)=altLMDz(k)+zdz          !altitude of interface
-          ENDDO
-
-          SELECT CASE(flag_sulf_emit_distrib)
-
-          CASE(0) ! Gaussian distribution
-          !compute distribution of emission to vertical model layers (based on
-          !Gaussian peak in altitude)
-          f_lay_sum=0.0
-               DO k=1, klev
-                     f_lay_emiss(k)=0.0
-                     DO i_int=1, n_int_alt
-                         alt=altLMDz(k)+float(i_int)*(altLMDz(k+1)-altLMDz(k))/float(n_int_alt)
-                         f_lay_emiss(k)=f_lay_emiss(k)+1./(sqrt(2.*RPI)*sigma_alt_sai)* &
-                         & exp(-0.5*((alt-altemiss_sai)/sigma_alt_sai)**2.)*   &
-                         & (altLMDz(k+1)-altLMDz(k))/float(n_int_alt)
-                     ENDDO
-                     f_lay_sum=f_lay_sum+f_lay_emiss(k)
-               ENDDO
-
-          CASE(1) ! Uniform distribution
-          f_lay_sum=0.0
-          ! In this case, parameter sigma_alt_vol(ieru) is considered to be half
-          ! the height of the injection, centered around altemiss_sai
-               DO k=1, klev
-                    f_lay_emiss(k)=max(min(altemiss_sai+sigma_alt_sai,altLMDz(k+1))- &
-                    & max(altemiss_sai-sigma_alt_sai,altLMDz(k)),0.)/(2.*sigma_alt_sai)
-                    f_lay_sum=f_lay_sum+f_lay_emiss(k)
-               ENDDO
-
-          END SELECT ! Gaussian or uniform distribution
-
-          !correct for step integration error
-          f_lay_emiss(:)=f_lay_emiss(:)/f_lay_sum
-          !emission as SO2 gas (with m(SO2)=64/32*m_aer_emiss)
-          !vertically distributed emission
-          DO k=1, klev
-            ! stretch emission over whole year (360d)
-            emission=m_aer_emiss_sai*(mSO2mol/mSatom)/m_air_gridbox(i,k)*f_lay_emiss(k)/ &
-                      & FLOAT(year_len)/86400.*(sin(theta_max/180.*RPI)-sin(theta_min/180.*RPI))/ & 
-                      & (sin(xlat_max_sai/180.*RPI)-sin(xlat_min_sai/180.*RPI))
-            tr_seri(i,k,id_SO2_strat)=tr_seri(i,k,id_SO2_strat)+emission*pdtphys
-            budg_emi_so2(i)=budg_emi_so2(i)+emission*zdm(k)*mSatom/mSO2mol
-          ENDDO
-
-!          !emission as monodisperse particles with 0.1um dry radius (BIN21)
-!          !vertically distributed emission
-!          DO k=1, klev
-!            ! stretch emission over whole year (360d)
-!            emission=m_aer_emiss*(mH2SO4mol/mSatom)/m_part_dry(21)/m_air_gridbox(i,k)*f_lay_emiss(k)/year_len/86400 
-!            tr_seri(i,k,id_BIN01_strat+20)=tr_seri(i,k,id_BIN01_strat+20)+emission*pdtphys 
-!            budg_emi_part(i)=budg_emi_part(i)+emission*zdm(k)*mSatom/mH2SO4mol
-!          ENDDO
-        ENDIF ! emission grid cell
-      ENDDO ! klon loop
-
-    END SELECT ! emission scenario (flag_sulf_emit)
+       m_aer=m_aer_emiss_sai
+       !emission as SO2 gas (with m(SO2)=64/32*m_aer_emiss)
+       m_aer=m_aer*(mSO2mol/mSatom)
+
+       latmin=xlat_min_sai
+       latmax=xlat_max_sai
+       lonmin=xlon_sai
+       lonmax=xlon_sai
+       altemiss = altemiss_sai
+       sigma_alt = sigma_alt_sai
+       pdt=0.
+       ! stretch emission over whole year (360d)
+       stretchlong=FLOAT(year_len)
+
+       CALL STRATEMIT(pdtphys,pdt,xlat,xlon,t_seri,pplay,paprs,m_air_gridbox,tr_seri,&
+            m_aer,latmin,latmax,lonmin,lonmax,altemiss,sigma_alt,id_SO2_strat, &
+            stretchlong,1,0)
+
+       budg_emi_so2(:) = budg_emi(:,1)*mSatom/mSO2mol
+       
+    END SELECT ! emission scenario (flag_emit)
 
 !--read background concentrations of OCS and SO2 and lifetimes from input file
@@ -387,5 +322,5 @@
     CALL coagulate(pdtphys,mdw,tr_seri,t_seri,pplay,dens_aer,is_strato)
 
-!--call sedimentation routine 
+!--call sedimentation routine
     CALL aer_sedimnt(pdtphys, t_seri, pplay, paprs, tr_seri, dens_aer)
 
@@ -404,10 +339,5 @@
       ENDDO
     ENDDO
-
-!    CALL minmaxsimple(tr_seri(:,:,id_SO2_strat),0.0,0.0,'fin SO2')
-!    DO it=1, nbtr_bin
-!      CALL minmaxsimple(tr_seri(:,:,nbtr_sulgas+it),0.0,0.0,'fin bin ')
-!    ENDDO
-
+    
   END SUBROUTINE traccoag
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/add_phys_tend_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/add_phys_tend_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/add_phys_tend_mod.F90	(revision 4727)
@@ -16,5 +16,5 @@
 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,5 +49,5 @@
   ! ------------
   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,7 +76,7 @@
     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,5 +87,5 @@
 ! $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,11 +102,11 @@
 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,5 +116,5 @@
 !------------
 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,5 +136,5 @@
 ! 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,7 +163,9 @@
 ! 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,7 +174,8 @@
 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,4 +216,5 @@
     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,7 +240,7 @@
 
     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,4 +254,5 @@
      ql_seri(:,:)=ql_seri(:,:)+zdql(:,:)
      qs_seri(:,:)=qs_seri(:,:)+zdqi(:,:)
+     qbs_seri(:,:)=qbs_seri(:,:)+zdqbs(:,:)
 
 !======================================================================
@@ -432,4 +437,5 @@
         ql_seri(:,:)=ql_seri(:,:)-zdql(:,:)
         qs_seri(:,:)=qs_seri(:,:)-zdqi(:,:)
+        qbs_seri(:,:)=qbs_seri(:,:)-zdqbs(:,:)
       ENDIF
 
@@ -446,7 +452,7 @@
 
     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,5 +463,6 @@
     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,4 +472,5 @@
     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,4 +484,5 @@
     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,6 +493,6 @@
 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,6 +510,6 @@
 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,7 +520,7 @@
 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,5 +529,5 @@
 !--------
 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,5 +552,6 @@
 ! 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,7 +560,8 @@
 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,7 +596,7 @@
 
     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,4 +611,5 @@
      ql_n(:,:)=ql(:,:)+zdql(:,:)
      qs_n(:,:)=qs(:,:)+zdqs(:,:)
+     qbs_n(:,:)=qbs(:,:)+zdqbs(:,:)
      temp_n(:,:)=temp(:,:)+zdt(:,:)
 
@@ -616,7 +628,7 @@
 
     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,5 +639,6 @@
     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,4 +652,5 @@
     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,7 +663,7 @@
 
 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,14 +672,14 @@
 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,4 +691,5 @@
     zql_col(:) = 0.
     zqs_col(:) = 0.
+    zqbs_col(:) = 0.
     zek_col(:) = 0.
     zh_dair_col(:) = 0.
@@ -682,4 +697,5 @@
     zh_ql_col(:) = 0.
     zh_qs_col(:) = 0.
+    zh_qbs_col(:) = 0.
 
 !JLD    write (*,*) "rcpd, zcpvap, zcwat, zcice ",rcpd, zcpvap, zcwat, zcice
@@ -694,4 +710,5 @@
         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,8 +719,9 @@
         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,12 +738,12 @@
 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,4 +782,7 @@
       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,6 +821,6 @@
   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
 
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/atke_exchange_coeff_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/atke_exchange_coeff_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,199 +1,0 @@
-module atke_exchange_coeff_mod
-
-implicit none
-
-contains 
-
-subroutine atke_compute_km_kh(ngrid,nlay, &
-                        wind_u,wind_v,temp,play,pinterf, &
-                        tke,Km_out,Kh_out)
-
-!========================================================================
-! Routine that computes turbulent Km / Kh coefficients with a
-! 1.5 order closure scheme (TKE) with or without stationarity assumption
-!
-! This parameterization has been constructed in the framework of a
-! collective and collaborative workshop, 
-! the so-called 'Atelier TKE (ATKE)' with
-! K. Arjdal, L. Raillard, C. Dehondt, P. Tiengou, A. Spiga, F. Cheruy, T Dubos, 
-! M. Coulon-Decorzens, S. Fromang, G. Riviere, A. Sima, F. Hourdin, E. Vignon
-!
-! Main assumptions of the model :
-! (1) dry atmosphere
-! (2) horizontal homogeneity (Dx=Dy=0.)
-!=======================================================================
-
-
-
-USE atke_turbulence_ini_mod, ONLY : iflag_atke, kappa, l0, ric, cinf, rpi, rcpd
-USE atke_turbulence_ini_mod, ONLY : cepsilon, pr_slope, pr_asym, pr_neut, rg, rd
-USE atke_turbulence_ini_mod, ONLY : viscom, viscoh
-
-implicit none
-
-
-! Declarations:
-!=============
-
-INTEGER, INTENT(IN) :: ngrid ! number of horizontal index (flat grid)
-INTEGER, INTENT(IN) :: nlay ! number of vertical index  
-
-REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: wind_u   ! zonal velocity (m/s)
-REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: wind_v   ! meridional velocity (m/s)
-REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: temp   ! temperature (K)
-REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: play   ! pressure (Pa)
-REAL, DIMENSION(ngrid,nlay+1), INTENT(IN)     :: pinterf   ! pressure at interfaces(Pa)
-
-
-REAL, DIMENSION(ngrid,nlay+1), INTENT(INOUT)  :: tke  ! turbulent kinetic energy at interface between layers
-
-REAL, DIMENSION(ngrid,nlay), INTENT(OUT)      :: Km_out   ! output: Exchange coefficient for momentum at interface between layers
-REAL, DIMENSION(ngrid,nlay), INTENT(OUT)      :: Kh_out   ! output: Exchange coefficient for heat flux at interface between layers
-
-! Local variables
-REAL, DIMENSION(ngrid,nlay+1) :: Km          ! Exchange coefficient for momentum at interface between layers
-REAL, DIMENSION(ngrid,nlay+1) :: Kh          ! Exchange coefficient for heat flux at interface between layers
-REAL, DIMENSION(ngrid,nlay)   :: theta       ! Potential temperature
-REAL, DIMENSION(ngrid,nlay+1) :: l_exchange  ! Length of exchange (at interface)
-REAL, DIMENSION(ngrid,nlay+1) :: z_interf    ! Altitude at the interface
-REAL, DIMENSION(ngrid,nlay)   :: z_lay       ! Altitude of layers
-REAL, DIMENSION(ngrid,nlay)   :: dz_interf   ! distance between two consecutive interfaces
-REAL, DIMENSION(ngrid,nlay)   :: dz_lay      ! distance between two layer middles (NB: first and last are half layers)
-REAL, DIMENSION(ngrid,nlay+1) :: Ri          ! Richardson's number (at interface)
-REAL, DIMENSION(ngrid,nlay+1) :: Prandtl     ! Turbulent Prandtl's number (at interface)
-REAL, DIMENSION(ngrid,nlay+1) :: Sm          ! Stability function for momentum (at interface)
-REAL, DIMENSION(ngrid,nlay+1) :: Sh          ! Stability function for heat (at interface)
-
-INTEGER :: igrid,ilay ! horizontal,vertical index (flat grid)
-REAL    :: cn,Ri0,Ri1    ! parameter for Sm stability function and Prandlt
-REAL    :: preff      ! reference pressure for potential temperature calculations
-REAL    :: thetam     ! mean potential temperature at interface
-
-
-! Initializations:
-!================
-
-DO igrid=1,ngrid
-    dz_interf(igrid,1) = 0.0
-    z_interf(igrid,1) = 0.0
-END DO
-
-! Calculation of potential temperature: (if vapor -> todo virtual potential temperature)
-!=====================================
-
-preff=100000.
-! The result should not depend on the choice of preff
-DO ilay=1,nlay
-     DO igrid = 1, ngrid
-        theta(igrid,ilay)=temp(igrid,ilay)*(preff/play(igrid,ilay))**(rd/rcpd)
-     END DO
-END DO
-
-
-
-! Calculation of altitude of layers' middle and bottom interfaces:
-!=================================================================
-
-DO ilay=2,nlay+1
-    DO igrid=1,ngrid
-        dz_interf(igrid,ilay-1) = rd*temp(igrid,ilay-1)/rg/play(igrid,ilay-1)*(pinterf(igrid,ilay-1)-pinterf(igrid,ilay))
-        z_interf(igrid,ilay) = z_interf(igrid,ilay-1) + dz_interf(igrid,ilay-1)
-    ENDDO
-ENDDO
-
-DO ilay=1,nlay
-   DO igrid=1,ngrid 
-      z_lay(igrid,ilay)=0.5*(z_interf(igrid, ilay+1) + z_interf(igrid, ilay))
-   ENDDO
-ENDDO
-
-
-! Computing the mixing length:
-! so far, we have neglected the effect of local stratification
-!==============================================================
-
-
-DO ilay=2,nlay+1
-    DO igrid=1,ngrid
-        l_exchange(igrid,ilay) = kappa*l0*z_interf(igrid,ilay) / (kappa*z_interf(igrid,ilay) + l0)
-    ENDDO
-ENDDO
-
-! Computes the gradient Richardson's number and stability functions:
-!===================================================================
-
-! calculation of cn = Sm value at Ri=0
-! direct dependance on cepsilon to guarantee Fm=1 (first-order like stability function) at Ri=0
-cn=(1./sqrt(cepsilon))**(2/3)
-! calculation of Ri0 such that continuity in slope of Sm at Ri=0
-Ri0=2./rpi*(cinf - cn)*ric/cn
-! calculation of Ri1 to guarantee continuity in slope of Prandlt number at Ri=0
-Ri1 = -2./rpi * (pr_asym - pr_neut) / pr_slope
-
-
-DO ilay=2,nlay
-    DO igrid=1,ngrid
-        dz_lay(igrid,ilay)=z_lay(igrid,ilay)-z_lay(igrid,ilay-1)
-        thetam=0.5*(theta(igrid,ilay) + theta(igrid,ilay-1))
-        Ri(igrid,ilay) = rg * (theta(igrid,ilay) - theta(igrid,ilay-1))/thetam / dz_lay(igrid,ilay) / & 
-        MAX(((wind_u(igrid,ilay) - wind_u(igrid,ilay-1)) / dz_lay(igrid,ilay))**2 + & 
-        ((wind_v(igrid,ilay) - wind_v(igrid,ilay-1)) / dz_lay(igrid,ilay))**2,1E-10) 
-        
-        IF (Ri(igrid,ilay) < 0.) THEN ! unstable cases
-            Sm(igrid,ilay) = 2./rpi * (cinf-cn) * atan(-Ri(igrid,ilay)/Ri0) + cn
-            Prandtl(igrid,ilay) = -2./rpi * (pr_asym - pr_neut) * atan(Ri(igrid,ilay)/Ri1) + pr_neut 
-        ELSE ! stable cases
-            Sm(igrid,ilay) = max(0.,cn*(1.-Ri(igrid,ilay)/Ric))
-            Prandtl(igrid,ilay) = pr_neut + Ri(igrid,ilay) * pr_slope
-            IF (Ri(igrid,ilay) .GE. Prandtl(igrid,ilay)) THEN
-               call abort_physic("atke_compute_km_kh", &
-               'Ri>=Pr in stable conditions -> violates energy conservation principles, change pr_neut or slope', 1)
-            ENDIF
-        END IF
-        
-        Sh(igrid,ilay) = Sm(igrid,ilay) / Prandtl(igrid,ilay)
-
-    ENDDO
-ENDDO
-
-! Computing the TKE:
-!===================
-IF (iflag_atke == 0) THEN
-
-! stationary solution neglecting the vertical transport of TKE by turbulence
-    DO ilay=2,nlay
-        DO igrid=1,ngrid
-            tke(igrid,ilay) = cepsilon * l_exchange(igrid,ilay)**2 * Sm(igrid,ilay) * &
-            (((wind_u(igrid,ilay) - wind_u(igrid,ilay-1)) / dz_lay(igrid,ilay))**2 + & 
-            ((wind_v(igrid,ilay) - wind_v(igrid,ilay-1)) / dz_lay(igrid,ilay))**2 ) * &
-            (1. - Ri(igrid,ilay) / Prandtl(igrid,ilay))
-        ENDDO
-    ENDDO
-
-ELSE ! TO DO
-    
-   call abort_physic("atke_compute_km_kh", &
-        'traitement non-stationnaire de la tke pas encore prevu', 1)
-
-END IF
-
-
-! Computing eddy diffusivity coefficients:
-!========================================
-DO ilay=2,nlay ! TODO: also calculate for nlay+1 ?
-    DO igrid=1,ngrid
-        ! we add the molecular viscosity to Km,h 
-        Km(igrid,ilay) = viscom + l_exchange(igrid,ilay) * Sm(igrid,ilay) * tke(igrid,ilay)**0.5
-        Kh(igrid,ilay) = viscoh + l_exchange(igrid,ilay) * Sh(igrid,ilay) * tke(igrid,ilay)**0.5
-    END DO
-END DO
-
-! for output:
-!===========
-Km_out(1:ngrid,2:nlay)=Km(1:ngrid,2:nlay)
-Kh_out(1:ngrid,2:nlay)=Kh(1:ngrid,2:nlay)
-
-end subroutine atke_compute_km_kh
-
-
-end module atke_exchange_coeff_mod
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/atke_turbulence_ini_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/atke_turbulence_ini_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,80 +1,0 @@
-MODULE atke_turbulence_ini_mod
-
-implicit none
-
-save
-
-  integer :: iflag_atke
-  !$OMP THREADPRIVATE(iflag_atke)
-  real :: kappa = 0.4 ! Von Karman constant
-  !$OMP THREADPRIVATE(kappa)
-  real :: l0, ric, ri0, cinf, cepsilon, pr_slope, pr_asym, pr_neut
-  !$OMP THREADPRIVATE(l0, ric, cinf, cepsilon, pr_slope, pr_asym, pr_neut)
-  integer :: lunout,prt_level
-  !$OMP THREADPRIVATE(lunout,prt_level)
-  real :: rg, rd, rpi, rcpd
-  !$OMP THREADPRIVATE(rg, rd, rpi, rcpd)
-
-  real :: viscom, viscoh
-  !$OMP THREADPRIVATE(viscom,viscoh)
-
-
-
-CONTAINS
-
-SUBROUTINE atke_ini(prt_level_in, lunout_in, rg_in, rd_in, rpi_in, rcpd_in)
-
-   USE ioipsl_getin_p_mod, ONLY : getin_p
-
-  integer, intent(in) :: lunout_in,prt_level_in
-  real, intent(in) :: rg_in, rd_in, rpi_in, rcpd_in
-
-
-  lunout=lunout_in
-  prt_level=prt_level_in
-  rd=rd_in
-  rg=rg_in
-  rpi=rpi_in
-  rcpd=rcpd_in
-
-  viscom=1.46E-5
-  viscoh=2.06E-5
-
-  ! flag that controls options in atke_compute_km_kh
-  iflag_atke=0
-  CALL getin_p('iflag_atke',iflag_atke)
-
-  ! asymptotic mixing length [m]
-  l0=150.0 
-  CALL getin_p('atke_l0',l0)
-
-  ! critical Richardson number 
-  ric=0.25
-  CALL getin_p('atke_ric',ric)
-
-  ! asymptotic value of Sm for Ri=-Inf
-  cinf=1.5
-  CALL getin_p('atke_cinf',cinf)
-
-  ! constant for tke dissipation calculation
-  cepsilon=16.6 ! default value as in yamada4
-  CALL getin_p('atke_cepsilon',cepsilon)
-
-  ! slope of Pr=f(Ri) for stable conditions
-  pr_slope=5.0 ! default value from Zilitinkevich et al. 2005
-  CALL getin_p('atke_pr_slope',pr_slope)
-
-  ! asymptotic turbulent prandt number value for Ri=-Inf
-  pr_asym=0.4
-  CALL getin_p('atke_pr_asym',pr_asym)
-
-  ! value of turbulent prandtl number in neutral conditions (Ri=0)
-  pr_neut=0.8
-  CALL getin_p('atke_pr_neut',pr_neut)
-
-   
- RETURN
-
-END SUBROUTINE atke_ini
-
-END MODULE  atke_turbulence_ini_mod
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/calbeta.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/calbeta.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/calbeta.F90	(revision 4727)
@@ -10,5 +10,5 @@
   IMPLICIT none
 
-#include "flux_arp.h"
+  INCLUDE "flux_arp.h"
 
 !======================================================================
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/calcratqs.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/calcratqs.F90	(revision 4726)
+++ 	(revision )
@@ -1,247 +1,0 @@
-SUBROUTINE calcratqs(klon,klev,prt_level,lunout,       &
-           iflag_ratqs,iflag_con,iflag_cld_th,pdtphys, &
-           ratqsbas,ratqshaut,ratqsp0,ratqsdp, &
-           tau_ratqs,fact_cldcon,wake_s, wake_deltaq,   &
-           ptconv,ptconvth,clwcon0th, rnebcon0th,       &
-           paprs,pplay,t_seri,q_seri,                   &
-           qtc_cv, sigt_cv, zqsat,             &
-           tke,tke_dissip,lmix,wprime, &
-           t2m,q2m,fm_therm, &
-           ratqs,ratqsc,ratqs_inter)
-
-
-USE indice_sol_mod
-USE phys_state_var_mod, ONLY: pctsrf
-USE calcratqs_multi_mod, ONLY: calcratqs_inter, calcratqs_oro, calcratqs_hetero, calcratqs_tke
-
-implicit none
-
-!========================================================================
-! Computation of ratqs, the width of the subrid scale water distribution
-! (normalized by the mean value)
-! Various options controled by flags iflag_con and iflag_ratqs
-! F Hourdin 2012/12/06
-!========================================================================
-
-! Declarations
-
-! Input
-integer,intent(in) :: klon,klev,prt_level,lunout
-integer,intent(in) :: iflag_con,iflag_cld_th,iflag_ratqs
-real,intent(in) :: pdtphys,ratqsbas,ratqshaut,fact_cldcon,tau_ratqs
-real,intent(in) :: ratqsp0, ratqsdp
-real, dimension(klon,klev+1),intent(in) :: paprs,tke,tke_dissip,lmix,wprime
-real, dimension(klon,klev),intent(in) :: pplay,t_seri,q_seri,zqsat,fm_therm, qtc_cv, sigt_cv
-logical, dimension(klon,klev),intent(in) :: ptconv
-real, dimension(klon,klev),intent(in) :: rnebcon0th,clwcon0th
-real, dimension(klon,klev),intent(in) :: wake_deltaq,wake_s
-real, dimension(klon,nbsrf),intent(in) :: t2m,q2m
-! Output
-real, dimension(klon,klev),intent(inout) :: ratqs,ratqsc,ratqs_inter
-
-logical, dimension(klon,klev),intent(inout) :: ptconvth
-
-! local
-integer i,k
-real, dimension(klon,klev) :: ratqss
-real facteur,zfratqs1,zfratqs2
-real, dimension(klon,klev) :: ratqs_hetero,ratqs_oro,ratqs_tke
-
-
-!-------------------------------------------------------------------------
-!  Caclul des ratqs
-!-------------------------------------------------------------------------
-
-!      print*,'calcul des ratqs'
-!   ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q
-!   ----------------
-!   on ecrase le tableau ratqsc calcule par clouds_gno
-      if (iflag_cld_th.eq.1) then
-         do k=1,klev
-         do i=1,klon
-            if(ptconv(i,k)) then
-              ratqsc(i,k)=ratqsbas &
-              +fact_cldcon*(q_seri(i,1)-q_seri(i,k))/q_seri(i,k)
-            else
-               ratqsc(i,k)=0.
-            endif
-         enddo
-         enddo
-
-!-----------------------------------------------------------------------
-!  par nversion de la fonction log normale
-!-----------------------------------------------------------------------
-      else if (iflag_cld_th.eq.4) then
-         ptconvth(:,:)=.false.
-         ratqsc(:,:)=0.
-         if(prt_level.ge.9) print*,'avant clouds_gno thermique'
-         call clouds_gno &
-         (klon,klev,q_seri,zqsat,clwcon0th,ptconvth,ratqsc,rnebcon0th)
-         if(prt_level.ge.9) print*,' CLOUDS_GNO OK'
-       
-       endif
-
-!   ratqs stables
-!   -------------
-
-      if (iflag_ratqs.eq.0) then
-
-! Le cas iflag_ratqs=0 correspond a la version IPCC 2005 du modele.
-         do k=1,klev
-            do i=1, klon
-               ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)* &
-               min((paprs(i,1)-pplay(i,k))/(paprs(i,1)-30000.),1.) 
-            enddo 
-         enddo
-
-! Pour iflag_ratqs=1 ou 2, le ratqs est constant au dessus de 
-! 300 hPa (ratqshaut), varie lineariement en fonction de la pression
-! entre 600 et 300 hPa et est soit constant (ratqsbas) pour iflag_ratqs=1
-! soit lineaire (entre 0 a la surface et ratqsbas) pour iflag_ratqs=2
-! Il s'agit de differents tests dans la phase de reglage du modele
-! avec thermiques.
-
-      else if (iflag_ratqs.eq.1) then
-
-         do k=1,klev
-            do i=1, klon
-               if (pplay(i,k).ge.60000.) then
-                  ratqss(i,k)=ratqsbas
-               else if ((pplay(i,k).ge.30000.).and.(pplay(i,k).lt.60000.)) then
-                  ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*(60000.-pplay(i,k))/(60000.-30000.)
-               else
-                  ratqss(i,k)=ratqshaut
-               endif
-            enddo
-         enddo
-
-      else if (iflag_ratqs.eq.2) then
-
-         do k=1,klev
-            do i=1, klon
-               if (pplay(i,k).ge.60000.) then
-                  ratqss(i,k)=ratqsbas*(paprs(i,1)-pplay(i,k))/(paprs(i,1)-60000.)
-               else if ((pplay(i,k).ge.30000.).and.(pplay(i,k).lt.60000.)) then
-                    ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*(60000.-pplay(i,k))/(60000.-30000.)
-               else
-                    ratqss(i,k)=ratqshaut
-               endif
-            enddo
-         enddo
-
-      else if (iflag_ratqs==3) then
-         do k=1,klev
-           ratqss(:,k)=ratqsbas+(ratqshaut-ratqsbas) &
-           *min( ((paprs(:,1)-pplay(:,k))/70000.)**2 , 1. )
-         enddo
-
-      else if (iflag_ratqs==4) then 
-         do k=1,klev
-           ratqss(:,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) &
-!          *( tanh( (50000.-pplay(:,k))/20000.) + 1.)
-           *( tanh( (ratqsp0-pplay(:,k))/ratqsdp) + 1.)
-         enddo
-
-       else if (iflag_ratqs .GT. 9) then
- 
-       ! interactive ratqs calculations that depend on cold pools, orography, surface heterogeneity and small-scale turbulence
-       ! This should help getting a more realistic ratqs in the low and mid troposphere
-       ! We however need a "background" ratqs to account for subgrid distribution of qt (or qt/qs)
-       ! in the high troposphere
-       
-       ! background ratqs and initialisations
-          do k=1,klev
-             do i=1,klon
-              ratqss(i,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) &
-              *( tanh( (ratqsp0-pplay(i,k))/ratqsdp) + 1.)
-              ratqss(i,k)=max(ratqss(i,k),0.0)
-
-              ratqs_hetero(i,k)=0.
-              ratqs_oro(i,k)=0.
-              ratqs_tke(i,k)=0.
-              ratqs_inter(i,k)=0
-             enddo
-          enddo
-      
-          if (iflag_ratqs .EQ. 10) then 
-             ! interactive ratqs in presence of cold pools     
-             call calcratqs_inter(klon,klev,iflag_ratqs,pdtphys,ratqsbas,wake_deltaq,wake_s,q_seri,qtc_cv, sigt_cv,ratqs_inter)
-             do k=1,klev
-                do i=1,klon
-                    ratqs_inter(i,k)=ratqs_inter(i,k)-0.5*ratqs_inter(i,k)*(tanh((ratqsp0-pplay(i,k))/ratqsdp)+1.)
-                enddo
-             enddo
-             ratqss=ratqss+ratqs_inter
-          else if (iflag_ratqs .EQ. 11) then
-            ! interactive ratqs with several sources
-            call calcratqs_inter(klon,klev,iflag_ratqs,pdtphys,ratqsbas,wake_deltaq,wake_s,q_seri,qtc_cv, sigt_cv,ratqs_inter)
-             ratqss=ratqss+ratqs_inter
-          else if (iflag_ratqs .EQ. 12) then
-             ! contribution of surface heterogeneities to ratqs
-             call calcratqs_hetero(klon,klev,t2m,q2m,t_seri,q_seri,pplay,paprs,ratqs_hetero)
-             ratqss=ratqss+ratqs_hetero
-          else if (iflag_ratqs .EQ. 13) then
-             ! contribution of ubgrid orography to ratqs
-             call calcratqs_oro(klon,klev,zqsat,t_seri,pplay,paprs,ratqs_oro)
-             ratqss=ratqss+ratqs_oro
-          else if (iflag_ratqs .EQ. 14) then
-             ! effect of subgrid-scale TKE on ratqs (in development)
-             call calcratqs_tke(klon,klev,pdtphys,t_seri,q_seri,zqsat,pplay,paprs,tke,tke_dissip,lmix,wprime,ratqs_tke)     
-             ratqss=ratqss+ratqs_tke
-          endif
-          
-      
-      endif
-
-
-!  ratqs final
-!  -----------
-
-      if (iflag_cld_th.eq.1 .or.iflag_cld_th.eq.2.or.iflag_cld_th.eq.4) then
-
-! On ajoute une constante au ratqsc*2 pour tenir compte de 
-! fluctuations turbulentes de petite echelle
-
-         do k=1,klev
-            do i=1,klon
-               if ((fm_therm(i,k).gt.1.e-10)) then
-                  ratqsc(i,k)=sqrt(ratqsc(i,k)**2+0.05**2)
-               endif
-            enddo
-         enddo
-
-!   les ratqs sont une combinaison de ratqss et ratqsc
-       if(prt_level.ge.9) write(lunout,*)'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs
-
-         if (tau_ratqs>1.e-10) then
-            facteur=exp(-pdtphys/tau_ratqs)
-         else
-            facteur=0.
-         endif
-         ratqs(:,:)=ratqsc(:,:)*(1.-facteur)+ratqs(:,:)*facteur
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! FH 22/09/2009
-! La ligne ci-dessous faisait osciller le modele et donnait une solution
-! assymptotique bidon et dépendant fortement du pas de temps.
-!        ratqs(:,:)=sqrt(ratqs(:,:)**2+ratqss(:,:)**2)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-         ratqs(:,:)=max(ratqs(:,:),ratqss(:,:))
-      else if (iflag_cld_th<=6) then
-!   on ne prend que le ratqs stable pour fisrtilp
-         ratqs(:,:)=ratqss(:,:)
-      else
-          zfratqs1=exp(-pdtphys/10800.)
-          zfratqs2=exp(-pdtphys/10800.)
-          do k=1,klev
-             do i=1,klon
-                if (ratqsc(i,k).gt.1.e-10) then
-                   ratqs(i,k)=ratqs(i,k)*zfratqs2+(iflag_cld_th/100.)*ratqsc(i,k)*(1.-zfratqs2)
-                endif
-                ratqs(i,k)=min(ratqs(i,k)*zfratqs1+ratqss(i,k)*(1.-zfratqs1),0.5)
-             enddo
-          enddo
-      endif
-
-
-return
-end
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/calcratqs_multi_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/calcratqs_multi_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,364 +1,0 @@
-MODULE calcratqs_multi_mod
-
-!=============================================
-! module containing subroutines that take 
-! into account the effect of convection, orography,
-! surface heterogeneities and subgrid-scale
-! turbulence on ratqs, i.e. on the width of the
-! total water subgrid distribution.
-!=============================================
-
-IMPLICIT NONE
-
-! Include
-!=============================================
-    INCLUDE "YOETHF.h"
-    INCLUDE "YOMCST.h"
-
-
-      CONTAINS
-
-
-!========================================================================    
-SUBROUTINE calcratqs_inter(klon,klev,iflag_ratqs,pdtphys, &
-           ratqsbas, wake_deltaq, wake_s, q_seri,qtc_cv, sigt_cv,     &
-           ratqs_inter)
-USE ioipsl_getin_p_mod, ONLY : getin_p
-implicit none
-
-!========================================================================
-! L. d'Alençon, 25/02/2021
-! Cette subroutine calcule une valeur de ratqsbas interactive dépendant de la présence de poches froides dans l'environnement. 
-! Elle est appelée par la subroutine calcratqs lorsque iflag_ratqs = 10. 
-!========================================================================
-
-! Declarations
-
-
-LOGICAL, SAVE :: first = .TRUE.
-!$OMP THREADPRIVATE(first)
-! Input
-integer,intent(in) :: klon,klev,iflag_ratqs
-real,intent(in) :: pdtphys,ratqsbas
-real, dimension(klon,klev),intent(in) :: wake_deltaq, q_seri,qtc_cv, sigt_cv
-real, dimension(klon),intent(in) :: wake_s
-
-! Output
-real, dimension(klon,klev),intent(inout) :: ratqs_inter
-
-! local
-integer i,k
-real, dimension(klon,klev) :: wake_dq
-REAL, SAVE             :: a_ratqs_cv
-!$OMP THREADPRIVATE(a_ratqs_cv)
-REAL, SAVE             :: tau_ratqs_wake
-!$OMP THREADPRIVATE(tau_ratqs_wake) 
-REAL, SAVE             :: a_ratqs_wake
-!$OMP THREADPRIVATE(a_ratqs_wake)
-real, dimension(klon) :: max_wake_dq, max_dqconv,max_sigt
-!-------------------------------------------------------------------------
-!  Caclul de ratqs_inter
-!-------------------------------------------------------------------------
-
-!  
-      if (first) then
-         tau_ratqs_wake = 3600. ! temps de relaxation de la variabilité
-         a_ratqs_wake = 3.    ! paramètre pilotant l'importance du terme dépendant des poches froides
-         a_ratqs_cv = 0.5
-         CALL getin_p('tau_ratqs_wake', tau_ratqs_wake)
-         CALL getin_p('a_ratqs_wake', a_ratqs_wake) 
-         CALL getin_p('a_ratqs_cv', a_ratqs_cv)         
-         first=.false.
-      endif       
-      max_wake_dq(:) = 0.
-      max_dqconv (:) = 0
-      max_sigt(:)    = 0. 
-      if (iflag_ratqs.eq.10) then
-        do k=1,klev
-          do i=1,klon
-           max_wake_dq(i) = max(abs(wake_deltaq(i,k)),max_wake_dq(i))
-           max_sigt(i) = max(abs(sigt_cv(i,k)),max_sigt(i))
-           max_dqconv(i) = max(abs(q_seri(i,k) - qtc_cv(i,k)),max_dqconv(i))
-          enddo
-        enddo
-      
-        do k=1,klev
-          do i=1,klon
-           ratqs_inter(i,k)= ratqs_inter(i,k)*exp(-pdtphys/tau_ratqs_wake) +   &
-           a_ratqs_wake*(max_wake_dq(i)*(wake_s(i)**0.5/(1.-wake_s(i))))*(1.-exp(-pdtphys/tau_ratqs_wake))/q_seri(i,1)   
-           if (ratqs_inter(i,k)<ratqsbas) then
-              ratqs_inter(i,k) = ratqsbas
-           endif       
-          enddo
-        enddo
-      endif
-
-      if (iflag_ratqs.eq.11) then
-        do k=1,klev
-          do i=1,klon
-           max_wake_dq(i) = max(abs(wake_deltaq(i,k)),max_wake_dq(i))
-           max_sigt(i) = max(abs(sigt_cv(i,k)),max_sigt(i))
-           max_dqconv(i) = max(abs(q_seri(i,k) - qtc_cv(i,k)),max_dqconv(i))
-          enddo
-        enddo
-      
-        do k=1,klev
-          do i=1,klon
-           ratqs_inter(i,k)= ratqs_inter(i,k)*exp(-pdtphys/tau_ratqs_wake) +   &
-           a_ratqs_wake*(max_wake_dq(i)*(wake_s(i)**0.5/(1.-wake_s(i))))*(1.-exp(-pdtphys/tau_ratqs_wake))/q_seri(i,1)  +   &
-           a_ratqs_cv*max_dqconv(i)*max_sigt(i)*(1.-exp(-pdtphys/tau_ratqs_wake))/q_seri(i,1)
-!           if (ratqs_inter(i,k)>0) then
-!              ratqs_inter(i,k) = abs(q_seri(i,k) - qtc_cv(i,k))
-!           endif       
-          enddo
-        enddo
-      endif
-return
-end          
-
-
-!------------------------------------------------------------------
-SUBROUTINE calcratqs_oro(klon,klev,qsat,temp,pplay,paprs,ratqs_oro)
-
-! Etienne Vignon, November 2021: effect of subgrid orography on ratqs
-
-USE phys_state_var_mod, ONLY: zstd
-USE phys_state_var_mod, ONLY: pctsrf
-USE indice_sol_mod, only: nbsrf, is_lic, is_ter
-
-IMPLICIT NONE
-
-! Declarations
-!--------------
-
-! INPUTS
-
-INTEGER, INTENT(IN) :: klon                       ! number of horizontal grid points
-INTEGER, INTENT(IN) :: klev                       ! number of vertical layers
-REAL, DIMENSION(klon,klev), INTENT(IN) :: qsat    ! saturation specific humidity [kg/kg]
-REAL, DIMENSION(klon,klev), INTENT(IN) :: temp    ! air temperature [K]
-REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay    ! air pressure, layer's center [Pa]
-REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs    ! air pressure, lower inteface [Pa]
-
-! OUTPUTS
-
-REAL, DIMENSION(klon,klev), INTENT(out) :: ratqs_oro ! ratqs profile due to subgrid orography
-
-
-! LOCAL
-
-INTEGER :: i,k
-REAL, DIMENSION(klon) :: orogradT,xsi0
-REAL, DIMENSION (klon,klev) :: zlay
-REAL :: Lvs, temp0
-
-
-! Calculation of the near-surface temperature gradient along the topography
-!--------------------------------------------------------------------------
-
-! at the moment, we fix it at a constant value (moist adiab. lapse rate)
-
-orogradT(:)=-6.5/1000. ! K/m
-
-! Calculation of near-surface surface ratqs
-!-------------------------------------------
-
-DO i=1,klon
-    temp0=temp(i,1)
-    IF (temp0 .LT. RTT) THEN
-        Lvs=RLSTT
-    ELSE
-        Lvs=RLVTT
-    ENDIF
-    xsi0(i)=zstd(i)*ABS(orogradT(i))*Lvs/temp0/temp0/RV
-    ratqs_oro(i,1)=xsi0(i)
-END DO
-
-! Vertical profile of ratqs assuming an exponential decrease with height
-!------------------------------------------------------------------------
-     
-! calculation of geop. height AGL        
-zlay(:,1)= RD*temp(:,1)/(0.5*(paprs(:,1)+pplay(:,1))) &
-           *(paprs(:,1)-pplay(:,1))/RG
-
-DO k=2,klev
-   DO i = 1, klon
-      zlay(i,k)= zlay(i,k-1)+RD*0.5*(temp(i,k-1)+temp(i,k)) &
-               /paprs(i,k)*(pplay(i,k-1)-pplay(i,k))/RG
-               
-      ratqs_oro(i,k)=MAX(0.0,pctsrf(i,is_ter)*xsi0(i)*exp(-zlay(i,k)/MAX(zstd(i),1.)))   
-    END DO
-END DO
-
-
-
-
-END SUBROUTINE calcratqs_oro
-
-!=============================================
-
-SUBROUTINE calcratqs_hetero(klon,klev,t2m,q2m,temp,q,pplay,paprs,ratqs_hetero)
-
-! Etienne Vignon, November 2021
-! Effect of subgrid surface heterogeneities on ratqs
-
-USE phys_local_var_mod, ONLY: s_pblh
-USE phys_state_var_mod, ONLY: pctsrf
-USE indice_sol_mod
-USE lscp_tools_mod, ONLY: CALC_QSAT_ECMWF
-
-IMPLICIT NONE
-
-include "YOMCST.h"
-
-! INPUTS
-
-
-INTEGER, INTENT(IN) :: klon                       ! number of horizontal grid points
-INTEGER, INTENT(IN) :: klev                       ! number of vertical layers
-REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: t2m    ! 2m temperature for each tile [K]
-REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: q2m    ! 2m specific humidity for each tile [kg/kg]
-REAL, DIMENSION(klon,klev), INTENT(IN) :: temp    ! air temperature [K]
-REAL, DIMENSION(klon,klev), INTENT(IN) :: q       ! specific humidity [kg/kg]
-REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay   ! air pressure, layer's center [Pa]
-REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs ! air pressure, lower inteface [Pa]
-
-! OUTPUTS
-
-REAL, DIMENSION(klon,klev), INTENT(out) :: ratqs_hetero ! ratsq profile due to surface heterogeneities
-
-
-INTEGER :: i,k,nsrf
-REAL, DIMENSION(klon) :: xsi0, ratiom, qsat2m, dqsatdT
-REAL, DIMENSION (klon,klev) :: zlay
-
-
-
-! Calculation of near-surface surface ratqs
-!-------------------------------------------
-
-    
-    ratiom(:)=0.
-    xsi0(:)=0.
-    
-    DO nsrf=1,nbsrf
-    CALL CALC_QSAT_ECMWF(klon,t2m(:,nsrf),q2m(:,nsrf),paprs(:,1),RTT,0,.false.,qsat2m,dqsatdT)
-    ratiom(:)=ratiom(:)+pctsrf(:,nsrf)*(q2m(:,nsrf)/qsat2m(:))
-    xsi0(:)=xsi0(:)+pctsrf(:,nsrf)*((q2m(:,nsrf)/qsat2m(:)-ratiom(:))**2)
-    END DO
-    
-    xsi0(:)=sqrt(xsi0(:))/(ratiom(:)+1E-6)
-
-
-
-! Vertical profile of ratqs assuming an exponential decrease with height
-!------------------------------------------------------------------------
-        
-! calculation of geop. height AGL
-
-zlay(:,1)= RD*temp(:,1)/(0.5*(paprs(:,1)+pplay(:,1))) &
-           *(paprs(:,1)-pplay(:,1))/RG
-ratqs_hetero(:,1)=xsi0(:)
-
-DO k=2,klev
-   DO i = 1, klon
-      zlay(i,k)= zlay(i,k-1)+RD*0.5*(temp(i,k-1)+temp(i,k)) &
-               /paprs(i,k)*(pplay(i,k-1)-pplay(i,k))/RG
-               
-      ratqs_hetero(i,k)=MAX(xsi0(i)*exp(-zlay(i,k)/(s_pblh(i)+1.0)),0.0)   
-    END DO
-END DO
-
-END SUBROUTINE calcratqs_hetero
-
-!=============================================
-
-SUBROUTINE calcratqs_tke(klon,klev,pdtphys,temp,q,qsat,pplay,paprs,tke,tke_dissip,lmix,wprime,ratqs_tke)
-
-! References:
-!
-! Etienne Vignon: effect of subgrid turbulence on ratqs
-!
-! Field, P.R., Hill, A., Furtado, K., Korolev, A., 2014b. Mixed-phase clouds in a turbulent environment. Part
-! 2: analytic treatment. Q. J. R. Meteorol. Soc. 21, 2651–2663. https://doi.org/10.1002/qj.2175.
-! 
-! Furtado, K., Field, P.R., Boutle, I.A., Morcrette, C.R., Wilkinson, J., 2016. A physically-based, subgrid
-! parametrization for the production and maintenance of mixed-phase clouds in a general circulation
-! model. J. Atmos. Sci. 73, 279–291. https://doi.org/10.1175/JAS-D-15-0021.
-
-USE phys_local_var_mod, ONLY: omega
-
-IMPLICIT NONE
-
-! INPUTS
-
-INTEGER, INTENT(IN) :: klon                             ! number of horizontal grid points
-INTEGER, INTENT(IN) :: klev                             ! number of vertical layers
-REAL, INTENT(IN) :: pdtphys                             ! physics time step [s]
-REAL, DIMENSION(klon,klev), INTENT(IN) :: temp          ! air temperature [K]
-REAL, DIMENSION(klon,klev), INTENT(IN) :: q             ! specific humidity [kg/kg]
-REAL, DIMENSION(klon,klev), INTENT(IN) :: qsat          ! saturation specific humidity [kg/kg]
-REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay         ! air pressure, layer's center [Pa]
-REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs       ! air pressure, lower inteface [Pa]
-REAL, DIMENSION(klon,klev+1), INTENT(IN) :: tke         ! Turbulent Kinetic Energy [m2/s2]
-REAL, DIMENSION(klon,klev+1), INTENT(IN) :: tke_dissip  ! Turbulent Kinetic Energy Dissipation rate [m2/s3]
-REAL, DIMENSION(klon,klev+1), INTENT(IN) :: lmix  ! Turbulent mixing length
-REAL, DIMENSION(klon,klev+1), INTENT(IN) :: wprime      ! Turbulent vertical velocity scale [m/s]
-
-! OUTPUTS
-
-REAL, DIMENSION(klon,klev), INTENT(out) :: ratqs_tke  ! ratsq profile due to subgrid TKE
-
-! LOCAL
-INTEGER :: i, k
-REAL :: AA, DD, NW, AAprime, VARLOG,rho,Lvs,taue,lhomo,dissmin,maxvarlog
-REAL, DIMENSION(klon,klev) :: sigmaw,w
-REAL, PARAMETER :: C0=10.0
-REAL, PARAMETER :: lmin=0.001
-REAL, PARAMETER :: ratqsmin=1E-6
-REAL, PARAMETER :: ratqsmax=0.5
-
-
-! Calculation of large scale and turbulent vertical velocities
-!---------------------------------------------------------------
-
-DO k=1,klev
-    DO i=1,klon
-        rho=pplay(i,k)/temp(i,k)/RD
-        w(i,k)=-rho*RG*omega(i,k)
-        sigmaw(i,k)=0.5*(wprime(i,k+1)+wprime(i,k)) ! turbulent vertical velocity at the middle of model layers. 
-    END DO
-END DO
-
-! Calculation of ratqs
-!---------------------------------------------------------------
-ratqs_tke(:,1)=ratqsmin ! set to a very low value to avoid division by 0 in order parts
-                        ! of the code
-DO k=2,klev ! we start from second model level since TKE is not defined at k=1
-    DO i=1,klon
-
-       IF (temp(i,k) .LT. RTT) THEN
-           Lvs=RLSTT
-       ELSE
-           Lvs=RLVTT
-       ENDIF
-       dissmin=0.01*(0.5*(tke(i,k)+tke(i,k+1))/pdtphys)
-       maxvarlog=LOG(1.0+ratqsmax**2)! to prevent ratqs from exceeding an arbitrary threshold value 
-       AA=RG*(Lvs/(RCPD*temp(i,k)*temp(i,k)*RV) - 1./(RD*temp(i,k)))
-       lhomo=MAX(0.5*(lmix(i,k)+lmix(i,k+1)),lmin)
-       taue=(lhomo*lhomo/MAX(0.5*(tke_dissip(i,k)+tke_dissip(i,k+1)),dissmin))**(1./3) ! Fields et al. 2014
-       DD=1.0/taue
-       NW=(sigmaw(i,k)**2)*SQRT(2./(C0*MAX(0.5*(tke_dissip(i,k)+tke_dissip(i,k+1)),dissmin)))
-       AAprime=AA*NW
-       VARLOG=AAprime/2./DD
-       VARLOG=MIN(VARLOG,maxvarlog)
-       ratqs_tke(i,k)=SQRT(MAX(EXP(VARLOG)-1.0,ratqsmin))
-       END DO
-END DO
-END SUBROUTINE calcratqs_tke
-
-
-
-
-
-END MODULE calcratqs_multi_mod
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/calcul_divers.h
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/calcul_divers.h	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/calcul_divers.h	(revision 4727)
@@ -2,52 +2,84 @@
 ! $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
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/call_ini_replay.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/call_ini_replay.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/call_ini_replay.F90	(revision 4727)
@@ -0,0 +1,4 @@
+   subroutine call_ini_replay
+   stop 'In call_ini_replay : You should run replay_equip.sh before runing replay[13]d'
+   return
+   end
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/call_param_replay.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/call_param_replay.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/call_param_replay.F90	(revision 4727)
@@ -0,0 +1,5 @@
+   subroutine call_param_replay(ngrid,nlay)
+   integer,intent(in) :: ngrid,nlay
+   stop 'In call_param_replay : You should run replay_equip.sh before runing replay[13]d'
+   return
+   end
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/calltherm.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/calltherm.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/calltherm.F90	(revision 4727)
@@ -4,5 +4,5 @@
       subroutine calltherm(dtime  &
      &      ,pplay,paprs,pphi,weak_inversion  &
-     &      ,u_seri,v_seri,t_seri,q_seri,zqsat,debut  &
+     &      ,u_seri_,v_seri_,t_seri_,q_seri_,t_env,q_env,zqsat,debut  &
      &      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs  &
      &      ,fm_therm,entr_therm,detr_therm,zqasc,clwcon0,lmax,ratqscth,  &
@@ -29,4 +29,7 @@
       USE indice_sol_mod
       USE print_control_mod, ONLY: prt_level,lunout
+      USE lmdz_thermcell_alp, ONLY: thermcell_alp
+      USE lmdz_thermcell_main, ONLY: thermcell_main
+      USE lmdz_thermcell_old, ONLY: thermcell, thermcell_2002, thermcell_eau, calcul_sec, thermcell_sec
 #ifdef ISO
       use infotrac_phy, ONLY: ntiso
@@ -52,6 +55,9 @@
       INTEGER nbptspb
 
-      REAL u_seri(klon,klev),v_seri(klon,klev)
-      REAL t_seri(klon,klev),q_seri(klon,klev),qmemoire(klon,klev)
+      REAL, DIMENSION(klon,klev), INTENT(IN) :: u_seri_,v_seri_
+      REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri_,q_seri_,t_env,q_env
+      REAL, DIMENSION(klon,klev) :: u_seri,v_seri
+      REAL, DIMENSION(klon,klev) :: t_seri,q_seri
+      REAL, DIMENSION(klon,klev) :: qmemoire
       REAL weak_inversion(klon)
       REAL paprs(klon,klev+1)
@@ -75,5 +81,4 @@
       real fmc_therm(klon,klev+1),zqasc(klon,klev)
       real zqla(klon,klev)
-      real zqta(klon,klev)
       real ztv(klon,klev),ztva(klon,klev)
       real zpspsk(klon,klev)
@@ -163,4 +168,9 @@
         first=.false.
       endif
+
+      u_seri(:,:)=u_seri_(:,:)
+      v_seri(:,:)=v_seri_(:,:)
+      t_seri(:,:)=t_seri_(:,:)
+      q_seri(:,:)=q_seri_(:,:)
 
 ! Incrementer le compteur de la physique
@@ -285,5 +295,5 @@
             CALL thermcell_main(itap,klon,klev,zdt  &
      &      ,pplay,paprs,pphi,debut  &
-     &      ,u_seri,v_seri,t_seri,q_seri  &
+     &      ,u_seri,v_seri,t_seri,q_seri,t_env,q_env  &
      &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
      &      ,zfm_therm,zentr_therm,zdetr_therm,zqasc,zqla,lmax  &
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/calwake.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/calwake.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/calwake.F90	(revision 4727)
@@ -29,4 +29,5 @@
   USE indice_sol_mod, ONLY: is_oce
   USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
+  USE lmdz_wake, ONLY : wake
   IMPLICIT NONE
   ! ======================================================================
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cdrag_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cdrag_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cdrag_mod.F90	(revision 4727)
@@ -1,2 +1,5 @@
+!
+!$Id$
+!
 !
 MODULE cdrag_mod
@@ -15,7 +18,7 @@
  SUBROUTINE cdrag(knon,  nsrf,   &
      speed, t1,    q1,    zgeop1, &
-     psol,  tsurf, qsurf, z0m, z0h,  &
+     psol, pblh,  tsurf, qsurf, z0m, z0h,  &
      ri_in, iri_in, &
-     cdm,  cdh,  zri,   pref)
+     cdm,  cdh,  zri,   pref, prain, tsol , pat1)
 
   USE dimphy
@@ -23,5 +26,5 @@
   USE print_control_mod, ONLY: lunout, prt_level
   USE ioipsl_getin_p_mod, ONLY : getin_p
-  USE atke_turbulence_ini_mod, ONLY : ric, cinf, cepsilon, pr_slope, pr_asym, pr_neut
+  USE lmdz_atke_turbulence_ini, ONLY : ric, cinf, cepsilon, pr_slope, pr_asym, pr_neut
 
   IMPLICIT NONE
@@ -81,14 +84,20 @@
   
   INTEGER, INTENT(IN)                      :: knon, nsrf ! nombre de points de grille sur l'horizontal + type de surface
-  REAL, DIMENSION(klon), INTENT(IN)        :: speed ! module du vent au 1er niveau du modele
-  REAL, DIMENSION(klon), INTENT(IN)        :: zgeop1! geopotentiel au 1er niveau du modele
-  REAL, DIMENSION(klon), INTENT(IN)        :: tsurf ! Surface temperature (K)
-  REAL, DIMENSION(klon), INTENT(IN)        :: qsurf ! Surface humidity (Kg/Kg)
-  REAL, DIMENSION(klon), INTENT(IN)        :: z0m, z0h ! Rugosity at surface (m) 
+  REAL, DIMENSION(klon), INTENT(IN)        :: speed    ! module du vent au 1er niveau du modele
+  REAL, DIMENSION(klon), INTENT(IN)        :: zgeop1   ! geopotentiel au 1er niveau du modele
+  REAL, DIMENSION(klon), INTENT(IN)        :: tsurf    ! Surface temperature (K)
+  REAL, DIMENSION(klon), INTENT(IN)        :: qsurf    ! Surface humidity (Kg/Kg)
+  REAL, DIMENSION(klon), INTENT(INOUT)     :: z0m, z0h ! Rugosity at surface (m) 
   REAL, DIMENSION(klon), INTENT(IN)        :: ri_in ! Input Richardson 1st layer for first guess calculations of screen var. 
   INTEGER, INTENT(IN)                      :: iri_in! iflag to activate cdrag calculation using ri1
-  REAL, DIMENSION(klon), INTENT(IN)        :: t1  ! Temperature au premier niveau (K) 
-  REAL, DIMENSION(klon), INTENT(IN)        :: q1  ! humidite specifique au premier niveau (kg/kg)
-  REAL, DIMENSION(klon), INTENT(IN)        :: psol ! pression au sol
+  REAL, DIMENSION(klon), INTENT(IN)        :: t1       ! Temperature au premier niveau (K) 
+  REAL, DIMENSION(klon), INTENT(IN)        :: q1       ! humidite specifique au premier niveau (kg/kg)
+  REAL, DIMENSION(klon), INTENT(IN)        :: psol     ! pression au sol
+
+!------------------ Rajout pour COARE (OT2018) --------------------
+  REAL, DIMENSION(klon), INTENT(INOUT)     :: pblh  !hauteur de CL
+  REAL, DIMENSION(klon), INTENT(IN)        :: prain !rapport au precipitation
+  REAL, DIMENSION(klon), INTENT(IN)        :: tsol  !SST imposé sur la surface oceanique
+  REAL, DIMENSION(klon), INTENT(IN)        :: pat1  !pression premier lev
 
 
@@ -99,5 +108,5 @@
   REAL, DIMENSION(klon), INTENT(OUT)       :: cdh   ! Drag coefficient for heat flux
   REAL, DIMENSION(klon), INTENT(OUT)       :: zri   ! Richardson number
-  REAL, DIMENSION(klon), INTENT(OUT)       :: pref  ! Pression au niveau zgeop/RG
+  REAL, DIMENSION(klon), INTENT(INOUT)       :: pref  ! Pression au niveau zgeop/RG
 
 ! Variables Locales
@@ -116,12 +125,10 @@
   REAL                   MU, CM, CH, B, CMstar, CHstar
   REAL                   PM, PH, BPRIME
-  REAL                   C
   INTEGER                ng_q1                      ! Number of grids that q1 < 0.0
   INTEGER                ng_qsurf                   ! Number of grids that qsurf < 0.0
-  INTEGER                i
+  INTEGER                i, k
   REAL                   zdu2, ztsolv
   REAL                   ztvd, zscf
   REAL                   zucf, zcr
-  REAL                   friv, frih
   REAL, DIMENSION(klon) :: FM, FH                   ! stability functions
   REAL, DIMENSION(klon) :: cdmn, cdhn               ! Drag coefficient in neutral conditions
@@ -129,4 +136,38 @@
   REAL, DIMENSION(klon) :: sm, prandtl              ! Stability function from atke turbulence scheme
   REAL                  ri0, ri1, cn                ! to have dimensionless term in sm and prandtl
+
+!------------------ Rajout (OT2018) --------------------
+!------------------ Rajout pour les appelles BULK (OT) --------------------
+  REAL, DIMENSION(klon,2) :: rugos_itm 
+  REAL, DIMENSION(klon,2) :: rugos_ith 
+  REAL, PARAMETER         :: tol_it_rugos=1.e-4
+  REAL, DIMENSION(3)      :: coeffs
+  LOGICAL                 :: mixte
+  REAL                    :: z_0m
+  REAL                    :: z_0h
+  REAL, DIMENSION(klon)   :: cdmm
+  REAL, DIMENSION(klon)   :: cdhh
+
+!------------------RAJOUT POUR ECUME -------------------
+
+  REAL, DIMENSION(klon) :: PQSAT 
+  REAL, DIMENSION(klon) :: PSFTH
+  REAL, DIMENSION(klon) :: PFSTQ 
+  REAL, DIMENSION(klon) :: PUSTAR
+  REAL, DIMENSION(klon) :: PCD      ! Drag coefficient for momentum
+  REAL, DIMENSION(klon) :: PCDN     ! Drag coefficient for momentum
+  REAL, DIMENSION(klon) :: PCH      ! Drag coefficient for momentum
+  REAL, DIMENSION(klon) :: PCE      ! Drag coefficient for momentum
+  REAL, DIMENSION(klon) :: PRI 
+  REAL, DIMENSION(klon) :: PRESA
+  REAL, DIMENSION(klon) :: PSSS
+
+  LOGICAL               :: OPRECIP
+  LOGICAL               :: OPWEBB
+  LOGICAL               :: OPERTFLUX
+  LOGICAL               :: LPRECIP
+  LOGICAL               :: LPWG
+
+
 
   LOGICAL, SAVE :: firstcall = .TRUE.
@@ -136,4 +177,6 @@
   INTEGER, SAVE :: iflag_corr_insta
   !$OMP THREADPRIVATE(iflag_corr_insta)
+  LOGICAL, SAVE :: ok_cdrag_iter
+  !$OMP THREADPRIVATE(ok_cdrag_iter)
 
 !===================================================================c
@@ -170,7 +213,7 @@
 
 ! Consistent with atke scheme
-cn=(1./sqrt(cepsilon))**(2/3)
-ri0=2./rpi*(cinf - cn)*ric/cn
-ri1=-2./rpi * (pr_asym - pr_neut)/pr_slope
+  cn=(1./sqrt(cepsilon))**(2./3.)
+  ri0=2./rpi*(cinf - cn)*ric/cn
+  ri1=-2./rpi * (pr_asym - pr_neut)/pr_slope
 
 
@@ -209,13 +252,24 @@
 ! On choisit les fonctions de stabilite utilisees au premier appel
 !**************************************************************************
-  IF (firstcall) THEN
+ IF (firstcall) THEN
    iflag_corr_sta=2
    iflag_corr_insta=2
+   ok_cdrag_iter = .FALSE.
  
    CALL getin_p('iflag_corr_sta',iflag_corr_sta)
    CALL getin_p('iflag_corr_insta',iflag_corr_insta)
+   CALL getin_p('ok_cdrag_iter',ok_cdrag_iter)
 
    firstcall = .FALSE.
  ENDIF
+
+!------------------ Rajout (OT2018) --------------------
+!---------    Rajout pour itération sur rugosité     ----------------
+  rugos_itm(:,2) = z0m
+  rugos_itm(:,1) = 3.*tol_it_rugos*z0m
+
+  rugos_ith(:,2) = z0h !cp nouveau rugos_it
+  rugos_ith(:,1) = 3.*tol_it_rugos*z0h
+!--------------------------------------------------------------------
 
 !xxxxxxxxxxxxxxxxxxxxxxx
@@ -227,212 +281,350 @@
 !***********************
      
-
      zdu2 = MAX(CEPDU2, speed(i)**2)
      pref(i) = EXP(LOG(psol(i)) - zgeop1(i)/(RD*t1(i)* &
-                 (1.+ RETV * max(q1(i),0.0))))           ! negative q1 set to zero 
+          (1.+ RETV * max(q1(i),0.0))))           ! negative q1 set to zero
      ztsolv = tsurf(i) * (1.0+RETV*max(qsurf(i),0.0))    ! negative qsurf set to zero
-     ztvd = (t1(i)+zgeop1(i)/RCPD/(1.+RVTMP2*max(q1(i),0.0))) &
+     ztvd = (t1(i)+zgeop1(i)/RCPD/(1.+RVTMP2*q1(i))) &
           *(1.+RETV*max(q1(i),0.0))                      ! negative q1 set to zero
-     zri(i) = zgeop1(i)*(ztvd-ztsolv)/(zdu2*ztvd)
+     
+!------------------ Rajout (OT2018) --------------------
+!--------------   ON DUPLIQUE POUR METTRE ITERATION SUR OCEAN    ------------------------     
      IF (iri_in.EQ.1) THEN
        zri(i) = ri_in(i)
      ENDIF
 
+     IF (nsrf == is_oce) THEN
+        
+!------------------  Pour Core 2 choix Core Pur ou Core Mixte  --------------------
+       IF ((choix_bulk > 1 .AND. choix_bulk < 4) .AND. (nsrf .eq. is_oce)) THEN
+         IF(choix_bulk .eq. 2) THEN
+           mixte = .false.
+         ELSE
+            mixte = .true.
+         ENDIF
+         call clc_core_cp ( sqrt(zdu2),t1(i)-tsurf(i),q1(i)-qsurf(i),t1(i),q1(i),&
+             zgeop1(i)/RG, zgeop1(i)/RG,  zgeop1(i)/RG,&
+             psol(i),nit_bulk,mixte,&
+             coeffs,z_0m,z_0h)
+         cdmm(i) = coeffs(1)
+         cdhh(i) = coeffs(2)
+         cdm(i)=cdmm(i)
+         cdh(i)=cdhh(i)
+         write(*,*) "clc_core cd ch",cdmm(i),cdhh(i)
+
+!------------------                 Pour ECUME                 --------------------
+       ELSE IF ((choix_bulk .eq. 4) .and. (nsrf .eq. is_oce)) THEN
+         OPRECIP = .false.
+         OPWEBB  = .false.
+         OPERTFLUX = .false.
+         IF (nsrf .eq. is_oce) THEN
+           PSSS = 0.0
+         ENDIF
+         call ini_csts
+         call ecumev6_flux( z_0m,t1(i),tsurf(i),&
+             q1(i),qsurf(i),sqrt(zdu2),zgeop1(i)/RG,PSSS,zgeop1(i)/RG,&
+             psol(i),pat1(i), OPRECIP, OPWEBB,&
+             PSFTH,PFSTQ,PUSTAR,PCD,PCDN,&
+             PCH,PCE,PRI,PRESA,prain,&
+             z_0h,OPERTFLUX,coeffs)
+
+         cdmm(i) = coeffs(1)
+         cdhh(i) = coeffs(2)
+         cdm(i)=cdmm(i)
+         cdh(i)=cdhh(i)
+   
+         write(*,*) "ecume cd ch",cdmm(i),cdhh(i)
+
+!------------------                 Pour COARE CNRM                 --------------------
+       ELSE IF ((choix_bulk .eq. 5) .and. (nsrf .eq. is_oce)) THEN
+         LPRECIP = .false.
+         LPWG    = .false.
+         call ini_csts
+         call coare30_flux_cnrm(z_0m,t1(i),tsurf(i), q1(i),  &
+             sqrt(zdu2),zgeop1(i)/RG,zgeop1(i)/RG,psol(i),qsurf(i),PQSAT, &
+             PSFTH,PFSTQ,PUSTAR,PCD,PCDN,PCH,PCE,PRI, &
+             PRESA,prain,pat1(i),z_0h, LPRECIP, LPWG, coeffs) 
+         cdmm(i) = coeffs(1)
+         cdhh(i) = coeffs(2)
+         cdm(i)=cdmm(i)
+         cdh(i)=cdhh(i)
+         write(*,*) "coare CNRM cd ch",cdmm(i),cdhh(i)
+
+!------------------                 Pour COARE Maison                 --------------------
+       ELSE IF ((choix_bulk .eq. 1) .and. (nsrf .eq. is_oce)) THEN
+         IF ( pblh(i) .eq. 0. ) THEN
+           pblh(i) = 1500.
+         ENDIF
+         write(*,*) "debug size",size(coeffs)
+         call coare_cp(sqrt(zdu2),t1(i)-tsurf(i),q1(i)-qsurf(i),&
+               t1(i),q1(i),&
+               zgeop1(i)/RG,zgeop1(i)/RG,zgeop1(i)/RG,&
+               psol(i), pblh(i),&
+               nit_bulk,&
+               coeffs,z_0m,z_0h)
+         cdmm(i) = coeffs(1)
+         cdhh(i) = coeffs(3)
+         cdm(i)=cdmm(i)
+         cdh(i)=cdhh(i)
+         write(*,*) "coare cd ch",cdmm(i),cdhh(i)
+       ELSE
+!------------------                 Pour La param LMDZ (ocean)              --------------------
+         zri(i) = zgeop1(i)*(ztvd-ztsolv)/(zdu2*ztvd)
+         IF (iri_in.EQ.1) THEN
+           zri(i) = ri_in(i)
+         ENDIF
+       ENDIF
+     
+
+!----------------------- Rajout des itérations --------------
+       DO  k=1,nit_bulk
 
 ! Coefficients CD neutres : k^2/ln(z/z0) et k^2/(ln(z/z0)*ln(z/z0h)):
 !********************************************************************
-
-     zzzcd=CKAP/LOG(1.+zgeop1(i)/(RG*z0m(i)))
-     cdmn(i) = zzzcd*zzzcd
-     cdhn(i) = zzzcd*(CKAP/LOG(1.+zgeop1(i)/(RG*z0h(i))))
+         zzzcd=CKAP/LOG(1.+zgeop1(i)/(RG*rugos_itm(i,2)))
+         cdmn(i) = zzzcd*zzzcd
+         cdhn(i) = zzzcd*(CKAP/LOG(1.+zgeop1(i)/(RG*rugos_ith(i,2))))
+
+! Calcul des fonctions de stabilite FMs, FHs, FMi, FHi :
+!*******************************************************
+         IF (zri(i) .LT. 0.) THEN    
+           SELECT CASE (iflag_corr_insta)
+             CASE (1) ! Louis 1979 + Mascart 1995
+                  MU=LOG(MAX(z0m(i)/z0h(i),0.01))
+                  CMstar=6.8741+2.6933*MU-0.3601*(MU**2)+0.0154*(MU**3)
+                  PM=0.5233-0.0815*MU+0.0135*(MU**2)-0.001*(MU**3)
+                  CHstar=3.2165+4.3431*MU+0.536*(MU**2)-0.0781*(MU**3)
+                  PH=0.5802-0.1571*MU+0.0327*(MU**2)-0.0026*(MU**3)
+                  CH=CHstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) &
+                     & * CKAPT/LOG(z0h(i)+zgeop1(i)/(RG*z0h(i)))       &
+                     & * ((zgeop1(i)/(RG*z0h(i)))**PH)
+                  CM=CMstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) &
+                     & *CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i)))         &
+                     & * ((zgeop1(i)/(RG*z0m(i)))**PM)
+                  FM(i)=1.-B*zri(i)/(1.+CM*SQRT(ABS(zri(i))))
+                  FH(i)=1.-B*zri(i)/(1.+CH*SQRT(ABS(zri(i))))
+             CASE (2) ! Louis 1982
+                  zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) &
+                        *(1.0+zgeop1(i)/(RG*z0m(i)))))
+                  FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
+                  FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
+             CASE (3) ! Laurent Li
+                  FM(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min)
+                  FH(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min)
+             CASE (6) ! Consistent with turbulence scheme (in stationary case) derived in atke (2023)
+                  sm(i) = 2./rpi * (cinf - cn) * atan(-zri(i)/ri0) + cn
+                  prandtl(i) = -2./rpi * (pr_asym - pr_neut) * atan(zri(i)/ri1) + pr_neut
+                  FM(i) = MAX((sm(i)**(3./2.) * sqrt(cepsilon) * (1 - zri(i) / prandtl(i))**(1./2.)),f_ri_cd_min)
+                  FH(i) = MAX((FM(i) / prandtl(i)), f_ri_cd_min)
+             CASE default ! Louis 1982
+                  zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) &
+                         *(1.0+zgeop1(i)/(RG*z0m(i)))))
+                  FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
+                  FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
+           END SELECT
+! Calcul des drags
+           cdmm(i)=cdmn(i)*FM(i)
+           cdhh(i)=f_cdrag_ter*cdhn(i)*FH(i)
+! Traitement particulier des cas oceaniques
+! on applique Miller et al 1992 en l'absence de gustiness 
+           IF (nsrf == is_oce) THEN
+!            cdh(i)=f_cdrag_oce*cdhn(i)*FH(i)
+             IF (iflag_gusts==0) THEN
+               zcr = (0.0016/(cdmn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
+               cdhh(i) =f_cdrag_oce* cdhn(i)*(1.0+zcr**1.25)**(1./1.25)
+             ENDIF
+             cdmm(i)=MIN(cdmm(i),cdmmax)
+             cdhh(i)=MIN(cdhh(i),cdhmax)
+!             write(*,*) "LMDZ cd ch",cdmm(i),cdhh(i)
+           END IF
+         ELSE                          
+
+!'''''''''''''''
+! Cas stables :
+!'''''''''''''''
+           zri(i) = MIN(20.,zri(i))
+           SELECT CASE (iflag_corr_sta)
+             CASE (1) ! Louis 1979 + Mascart 1995
+                  FM(i)=MAX(1./((1+BPRIME*zri(i))**2),f_ri_cd_min)
+                  FH(i)=FM(i)
+             CASE (2) ! Louis 1982
+                  zscf = SQRT(1.+CD*ABS(zri(i)))
+                  FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min)
+                  FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min )
+             CASE (3) ! Laurent Li
+                  FM(i)=MAX(1.0 / (1.0+10.0*zri(i)*(1+8.0*zri(i))),f_ri_cd_min)
+                  FH(i)=FM(i)
+             CASE (4)  ! King 2001
+                  IF (zri(i) .LT. C2/2.) THEN
+                    FM(i)=MAX((1.-zri(i)/C2)**2,f_ri_cd_min)
+                    FH(i)=  FM(i)
+                  ELSE
+                    FM(i)=MAX(C3*((C2/zri(i))**2),f_ri_cd_min)
+                    FH(i)= FM(i)
+                  ENDIF
+             CASE (5) ! MO
+                  if (zri(i) .LT. 1./alpha) then
+                    FM(i)=MAX((1.-alpha*zri(i))**2,f_ri_cd_min)
+                    FH(i)=FM(i)
+                  else 
+                    FM(i)=MAX(1E-7,f_ri_cd_min)
+                    FH(i)=FM(i)
+                  endif
+             CASE (6) ! Consistent with turbulence scheme (in stationary case) derived in atke (2023)
+                  sm(i) = MAX(0.,cn*(1.-zri(i)/ric))
+                  prandtl(i) = pr_neut + zri(i) * pr_slope
+                  FM(i) = MAX((sm(i)**(3./2.) * sqrt(cepsilon) * (1 - zri(i) / prandtl(i))**(1./2.)),f_ri_cd_min)
+                  FH(i) = MAX((FM(i) / prandtl(i)), f_ri_cd_min)
+             CASE default ! Louis 1982
+                  zscf = SQRT(1.+CD*ABS(zri(i)))
+                  FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min)
+                  FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min )
+           END SELECT
+
+! Calcul des drags
+           
+           cdmm(i)=cdmn(i)*FM(i)
+           cdhh(i)=f_cdrag_ter*cdhn(i)*FH(i)
+           
+           IF (choix_bulk == 0) THEN
+             cdm(i)=cdmn(i)*FM(i)
+             cdh(i)=f_cdrag_ter*cdhn(i)*FH(i)
+           ENDIF
+
+           IF (nsrf.EQ.is_oce) THEN
+             cdhh(i)=f_cdrag_oce*cdhn(i)*FH(i)
+             cdmm(i)=MIN(cdmm(i),cdmmax)
+             cdhh(i)=MIN(cdhh(i),cdhmax)
+           ENDIF
+           IF (ok_cdrag_iter) THEN
+             rugos_itm(i,1) = rugos_itm(i,2)
+             rugos_ith(i,1) = rugos_ith(i,2)
+             rugos_itm(i,2) =  0.018*cdmm(i) * (speed(i))/RG  &
+                              +  0.11*14e-6 / SQRT(cdmm(i) * zdu2)
+
+!---------- Version SEPARATION DES Z0 ----------------------
+             IF (iflag_z0_oce==0) THEN
+               rugos_ith(i,2) = rugos_itm(i,2)
+             ELSE IF (iflag_z0_oce==1) THEN
+               rugos_ith(i,2) = 0.40*14e-6 / SQRT(cdmm(i) * zdu2)
+             ENDIF
+           ENDIF
+         ENDIF
+         IF (ok_cdrag_iter) THEN
+           rugos_itm(i,2) = MAX(1.5e-05,rugos_itm(i,2))
+           rugos_ith(i,2) = MAX(1.5e-05,rugos_ith(i,2))
+         ENDIF
+       ENDDO
+       IF (nsrf.EQ.is_oce) THEN
+         cdm(i)=MIN(cdmm(i),cdmmax)
+         cdh(i)=MIN(cdhh(i),cdhmax)
+       ENDIF
+       z0m = rugos_itm(:,2)
+       z0h = rugos_ith(:,2)
+     ELSE ! (nsrf == is_oce)
+       zri(i) = zgeop1(i)*(ztvd-ztsolv)/(zdu2*ztvd)
+       IF (iri_in.EQ.1) THEN
+         zri(i) = ri_in(i)
+       ENDIF
+
+! Coefficients CD neutres : k^2/ln(z/z0) et k^2/(ln(z/z0)*ln(z/z0h)):
+!********************************************************************
+       zzzcd=CKAP/LOG(1.+zgeop1(i)/(RG*z0m(i)))
+       cdmn(i) = zzzcd*zzzcd
+       cdhn(i) = zzzcd*(CKAP/LOG(1.+zgeop1(i)/(RG*z0h(i))))
 
 
 ! Calcul des fonctions de stabilit?? FMs, FHs, FMi, FHi :
 !*******************************************************
-
-
-
 !''''''''''''''
 ! Cas instables
 !''''''''''''''
-
- IF (zri(i) .LT. 0.) THEN    
-
-
-        SELECT CASE (iflag_corr_insta)
-    
-        CASE (1) ! Louis 1979 + Mascart 1995
-
-           MU=LOG(MAX(z0m(i)/z0h(i),0.01))
-           CMstar=6.8741+2.6933*MU-0.3601*(MU**2)+0.0154*(MU**3)
-           PM=0.5233-0.0815*MU+0.0135*(MU**2)-0.001*(MU**3)
-           CHstar=3.2165+4.3431*MU+0.536*(MU**2)-0.0781*(MU**3)
-           PH=0.5802-0.1571*MU+0.0327*(MU**2)-0.0026*(MU**3)
-           CH=CHstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) &
-            & * CKAPT/LOG(z0h(i)+zgeop1(i)/(RG*z0h(i)))       &
-            & * ((zgeop1(i)/(RG*z0h(i)))**PH)
-           CM=CMstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) &
-            & *CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i)))         &
-            & * ((zgeop1(i)/(RG*z0m(i)))**PM)
-         
-
-
-
-           FM(i)=1.-B*zri(i)/(1.+CM*SQRT(ABS(zri(i))))
-           FH(i)=1.-B*zri(i)/(1.+CH*SQRT(ABS(zri(i))))
-
-        CASE (2) ! Louis 1982
-
-           zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) &
-                *(1.0+zgeop1(i)/(RG*z0m(i)))))
-           FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
-           FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
-
-
-        CASE (3) ! Laurent Li
-
-           
-           FM(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min)
-           FH(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min)
-
-         CASE (6) ! Consistent with turbulence scheme (in stationary case) derived in atke (2023)
-         
-           sm(i) = 2./rpi * (cinf - cn) * atan(-zri(i)/ri0) + cn
-           prandtl(i) = -2./rpi * (pr_asym - pr_neut) * atan(zri(i)/ri1) + pr_neut
-           FM(i) = MAX((sm(i)**(3/2) * sqrt(cepsilon) * (1 - zri(i) / prandtl(i))**(1/2)),f_ri_cd_min)
-           FH(i) = MAX((FM(i) / prandtl(i)), f_ri_cd_min)
-
-         CASE default ! Louis 1982
-
-           zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) &
-                *(1.0+zgeop1(i)/(RG*z0m(i)))))
-           FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
-           FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
-
-
+       IF (zri(i) .LT. 0.) THEN    
+         SELECT CASE (iflag_corr_insta)
+           CASE (1) ! Louis 1979 + Mascart 1995
+                MU=LOG(MAX(z0m(i)/z0h(i),0.01))
+                CMstar=6.8741+2.6933*MU-0.3601*(MU**2)+0.0154*(MU**3)
+                PM=0.5233-0.0815*MU+0.0135*(MU**2)-0.001*(MU**3)
+                CHstar=3.2165+4.3431*MU+0.536*(MU**2)-0.0781*(MU**3)
+                PH=0.5802-0.1571*MU+0.0327*(MU**2)-0.0026*(MU**3)
+                CH=CHstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) &
+                   & * CKAPT/LOG(z0h(i)+zgeop1(i)/(RG*z0h(i)))       &
+                   & * ((zgeop1(i)/(RG*z0h(i)))**PH)
+                CM=CMstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) &
+                   & *CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i)))         &
+                   & * ((zgeop1(i)/(RG*z0m(i)))**PM)
+                FM(i)=1.-B*zri(i)/(1.+CM*SQRT(ABS(zri(i))))
+                FH(i)=1.-B*zri(i)/(1.+CH*SQRT(ABS(zri(i))))
+           CASE (2) ! Louis 1982
+                zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) &
+                       *(1.0+zgeop1(i)/(RG*z0m(i)))))
+                FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
+                FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
+           CASE (3) ! Laurent Li
+                FM(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min)
+                FH(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min)
+           CASE (6) ! Consistent with turbulence scheme (in stationary case) derived in atke (2023)
+                 sm(i) = 2./rpi * (cinf - cn) * atan(-zri(i)/ri0) + cn
+                 prandtl(i) = -2./rpi * (pr_asym - pr_neut) * atan(zri(i)/ri1) + pr_neut
+                 FM(i) = MAX((sm(i)**(3./2.) * sqrt(cepsilon) * (1 - zri(i) / prandtl(i))**(1./2.)),f_ri_cd_min)
+                 FH(i) = MAX((FM(i) / prandtl(i)), f_ri_cd_min)
+           CASE default ! Louis 1982
+                zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) &
+                      *(1.0+zgeop1(i)/(RG*z0m(i)))))
+                FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
+                FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
          END SELECT
-
-
-
 ! Calcul des drags
-
-
-       cdm(i)=cdmn(i)*FM(i)
-       cdh(i)=f_cdrag_ter*cdhn(i)*FH(i)
-
-
-! Traitement particulier des cas oceaniques
-! on applique Miller et al 1992 en l'absence de gustiness 
-
-  IF (nsrf == is_oce) THEN
-!        cdh(i)=f_cdrag_oce*cdhn(i)*FH(i)
-
-        IF(iflag_gusts==0) THEN
-           zcr = (0.0016/(cdmn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
-           cdh(i) =f_cdrag_oce* cdhn(i)*(1.0+zcr**1.25)**(1./1.25)
-        ENDIF
-
-
-        cdm(i)=MIN(cdm(i),cdmmax)
-        cdh(i)=MIN(cdh(i),cdhmax)
-
-  END IF
-
-
-
- ELSE                          
-
+         cdm(i)=cdmn(i)*FM(i)
+         cdh(i)=f_cdrag_ter*cdhn(i)*FH(i)
+       ELSE                          
 !'''''''''''''''
 ! Cas stables :
 !'''''''''''''''
-        zri(i) = MIN(20.,zri(i))
-
-       SELECT CASE (iflag_corr_sta)
-    
-        CASE (1) ! Louis 1979 + Mascart 1995
-   
-           FM(i)=MAX(1./((1+BPRIME*zri(i))**2),f_ri_cd_min)
-           FH(i)=FM(i)
-
-
-        CASE (2) ! Louis 1982
-           
-           zscf = SQRT(1.+CD*ABS(zri(i)))
-           FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min)
-           FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min )
-
-
-        CASE (3) ! Laurent Li
-   
-           FM(i)=MAX(1.0 / (1.0+10.0*zri(i)*(1+8.0*zri(i))),f_ri_cd_min)
-           FH(i)=FM(i)
-
-
-        CASE (4)  ! King 2001
-          
-           if (zri(i) .LT. C2/2.) then
-           FM(i)=MAX((1.-zri(i)/C2)**2,f_ri_cd_min)
-           FH(i)=  FM(i)
-
-
-           else
-           FM(i)=MAX(C3*((C2/zri(i))**2),f_ri_cd_min)
-           FH(i)= FM(i)
-           endif
-
-
-        CASE (5) ! MO
-   
-          if (zri(i) .LT. 1./alpha) then
-
-           FM(i)=MAX((1.-alpha*zri(i))**2,f_ri_cd_min)
-           FH(i)=FM(i)
-
-           else 
-
-
-           FM(i)=MAX(1E-7,f_ri_cd_min)
-           FH(i)=FM(i)
-
-          endif
-
-        CASE (6) ! Consistent with turbulence scheme (in stationary case) derived in atke (2023)
-          sm(i) = MAX(0.,cn*(1.-zri(i)/ric))
-          prandtl(i) = pr_neut + zri(i) * pr_slope
-          FM(i) = MAX((sm(i)**(3/2) * sqrt(cepsilon) * (1 - zri(i) / prandtl(i))**(1/2)),f_ri_cd_min)
-          FH(i) = MAX((FM(i) / prandtl(i)), f_ri_cd_min)
-
-        CASE default ! Louis 1982
-
-           zscf = SQRT(1.+CD*ABS(zri(i)))
-           FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min)
-           FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min )
-
-
-
-   END SELECT
-
+         zri(i) = MIN(20.,zri(i))
+         SELECT CASE (iflag_corr_sta)
+           CASE (1) ! Louis 1979 + Mascart 1995
+                FM(i)=MAX(1./((1+BPRIME*zri(i))**2),f_ri_cd_min)
+                FH(i)=FM(i)
+           CASE (2) ! Louis 1982
+                zscf = SQRT(1.+CD*ABS(zri(i)))
+                FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min)
+                FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min )
+           CASE (3) ! Laurent Li
+                FM(i)=MAX(1.0 / (1.0+10.0*zri(i)*(1+8.0*zri(i))),f_ri_cd_min)
+                FH(i)=FM(i)
+           CASE (4)  ! King 2001
+                if (zri(i) .LT. C2/2.) then
+                  FM(i)=MAX((1.-zri(i)/C2)**2,f_ri_cd_min)
+                  FH(i)=  FM(i)
+                else
+                  FM(i)=MAX(C3*((C2/zri(i))**2),f_ri_cd_min)
+                  FH(i)= FM(i)
+                endif
+           CASE (5) ! MO
+                if (zri(i) .LT. 1./alpha) then
+                  FM(i)=MAX((1.-alpha*zri(i))**2,f_ri_cd_min)
+                  FH(i)=FM(i)
+                else 
+                  FM(i)=MAX(1E-7,f_ri_cd_min)
+                  FH(i)=FM(i)
+                endif
+           CASE (6) ! Consistent with turbulence scheme (in stationary case) derived in atke (2023)
+                sm(i) = MAX(0.,cn*(1.-zri(i)/ric))
+                prandtl(i) = pr_neut + zri(i) * pr_slope
+                FM(i) = MAX((sm(i)**(3./2.) * sqrt(cepsilon) * (1 - zri(i) / prandtl(i))**(1./2.)),f_ri_cd_min)
+                FH(i) = MAX((FM(i) / prandtl(i)), f_ri_cd_min)
+           CASE default ! Louis 1982
+                zscf = SQRT(1.+CD*ABS(zri(i)))
+                FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min)
+                FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min )
+         END SELECT
 ! Calcul des drags
-
-
-       cdm(i)=cdmn(i)*FM(i)
-       cdh(i)=f_cdrag_ter*cdhn(i)*FH(i)
-
-       IF(nsrf.EQ.is_oce) THEN
-
-        cdh(i)=f_cdrag_oce*cdhn(i)*FH(i)
-        cdm(i)=MIN(cdm(i),cdmmax)
-        cdh(i)=MIN(cdh(i),cdhmax)
-
-      ENDIF
-
-
- ENDIF
-
-!xxxxxxxxxxx
+         cdm(i)=cdmn(i)*FM(i)
+         cdh(i)=f_cdrag_ter*cdhn(i)*FH(i)
+       ENDIF
+     ENDIF ! fin du if (nsrf == is_oce)
   END DO   !  Fin de la boucle sur l'horizontal
-!xxxxxxxxxxx
-! ================================================================= c
-     
+
 END SUBROUTINE cdrag
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/chemistry_cycle_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/chemistry_cycle_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/chemistry_cycle_mod.F90	(revision 4727)
@@ -0,0 +1,22 @@
+MODULE chemistry_cycle_mod
+
+!=======================================================================
+!   Authors: Anne Cozic and Thibaut Lurton
+!
+!  Purpose and description:
+!  -----------------------
+! Control module for the chemistry  tracers :
+!   - Definition of fluxes to be exchanged with Pisces and Inca 
+!
+!=======================================================================
+
+
+  IMPLICIT NONE
+
+! Variables read from parmeter file physiq.def
+  LOGICAL, SAVE, PUBLIC :: dms_cycle_cpl       ! Coupling of CO2 fluxes between LMDZ/ORCHIDEE and LMDZ/OCEAN(PISCES) 
+!$OMP THREADPRIVATE(dms_cycle_cpl)   
+
+
+  
+END MODULE chemistry_cycle_mod
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/clc_core_cp.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/clc_core_cp.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/clc_core_cp.F90	(revision 4727)
@@ -0,0 +1,232 @@
+!
+! $Id$
+!
+      SUBROUTINE clc_core_cp(du, dt, dq, t1, q1, &
+     				zu, zt, zq, &
+     					P,&
+     				n_it, mixte, &
+    			 coeffs, rugosm, rugosh)
+
+      IMPLICIT NONE
+
+
+  !  INTEGER     :: i,j,k
+  REAL, INTENT(IN) :: du,dt,dq,t1,q1
+  REAL, INTENT(IN) :: zu,zt,zq, P
+  INTEGER, INTENT(IN):: n_it
+  LOGICAL, INTENT(IN) :: mixte
+  REAL, DIMENSION(3), INTENT(OUT) :: coeffs
+  real, intent(out) :: rugosm
+  real, intent(out) :: rugosh
+
+
+!  REAL :: du,dt,t1,dq,q1
+  REAL :: dt_u, dq_u
+
+
+
+  REAL :: cd, ch, cd_rt, cd_n10, ce_n10, ce,&
+       u_N, X,&
+       rho,cpa,le
+
+  REAL :: usr,tsr,qsr
+  REAL, DIMENSION(3) :: zeta                           ! dans l'ordre: it courant, it precedente, var
+  REAL, DIMENSION(2,3) :: psi
+  REAL, PARAMETER :: g = 9.81, k=.41, sqrt_k = .640312 !avec g= gravité, k = cste von karman, sqrt_k = racine(k)
+  REAL :: logzu_10,logzt_10,logzq_10,logzt_zu,logzq_zu,&
+       u,cd_n10_rt,ch_n10_rt,ch_n10,chi,z_0m,z_0h,tv
+  INTEGER :: i,j,m1,m2,m3,m4,m5
+
+
+  REAL :: phih,phid,phie
+
+  
+  REAL, parameter :: alpha=2.7e-3,&           !alpha = a1 ds formulation smith 
+       beta = 1.42e-4,&                       !beta = a2 ds la formulation smith
+       gamma = 7.64e-5,&        !Large and yaeger 2006              !gamma = a3 ds formulation smith
+!       gamma = 13.09e-3,&         !Large and yaeger 2004
+       q0 = 1.64474                           ! q0 dzfinis mais pas reutilisée ds la suite ??
+
+  REAL, dimension(3) :: z
+  integer, dimension(2) :: tmp_shape
+  z = [zu, zt, zq]
+ 
+
+
+  logzu_10 = LOG(zu/10.)
+  logzt_10 = LOG(zt/10.)
+  logzq_10 = LOG(zq/10.)
+  logzt_zu = logzt_10 - logzu_10
+  logzq_zu = logzq_10 - logzu_10
+
+  cpa = 1004.67                               !!! pas reutilise ds nvelle formulation...
+
+  tv = t1 * (1+.608*q1)                       !!!!! tv pas reutiliser ds nvelle formulation...
+  rho = p / (287.1 * t1 * (1.+.61*q1))        !!!! rho pas reutiliser ds nvelle formulation....
+
+
+  le = (2.501-.00237*(t1-273.15-dt))*1.e6     !!!!!! le pas reutiliser ds nvelle formulation....
+  
+  u = max(du,.5)                              !!!! u = vitesse du vent 1 er niveau
+  u_N = u                                     !!!!!!! u_N utilisée pour le calcul des premier calcul...
+  
+
+  !!!!! initialisation des parametres et premier calcul de z_0 cd et ch
+
+
+  if (mixte) then 
+     z_0m = 1.e-4                             !!!!! pour l'initialisation on fixe z_0 a 10-4
+     cd_n10 = k**2 / (log(10/z_0m))**2        !!!!! on calcul ensuite cd a 10 m d'après smith 
+     cd_n10_rt = sqrt(cd_n10)   
+  else
+! Large and yaeger 2006
+     cd_n10 = alpha / u_n + beta + gamma * u_n !!!!! calcul de cd pour core pur
+! Large and yaeger 2004
+!     cd_n10 = 1E-3 * (2.7/U_n + 0.142 + U_n/13.09) 
+     cd_n10_rt = sqrt(cd_n10)                  !!!!!!
+     z_0m = 10. * exp(-k/cd_n10_rt)            !!!!!!! on calcul le premier z_0
+  endif
+
+
+  if ( dt .gt. 0. ) then
+     ch_n10 = 0.018 * cd_n10_rt                !!!!!!! si regime stable calcul du ch
+!     z_0h = 10. * exp(-k/ch_n10)
+  else
+     ch_n10 = 0.0327 * cd_n10_rt               !!!!!!! si regime instable calcul du ch
+!     z_0h = 10. * exp(-k/ch_n10)
+  endif
+
+  ce_n10 = 3.46e-2 *cd_n10_rt                  !!!!!! calcul ensuite de ce
+
+
+  dt_u = dt                                    !!! def
+  dq_u = dq                                    !!! def
+
+  cd = cd_n10                                  !!! def
+  ch = ch_n10                                  !!! def
+  ce = ce_n10                                  !!! def
+
+  cd_rt = sqrt(cd)                             !!! def
+
+  !  open(7,file="err_rel.dat",position="append")
+
+
+!!!!!!!!! début des itérations....
+
+  do i = 1,n_it
+
+     usr = cd_rt * u 
+     tsr = ch / cd_rt *  dt_u
+     qsr = ce / cd_rt * dq_u
+
+
+     zeta = k*g / (usr**2) * tsr / t1&
+          * z
+
+     zeta = sign( min(abs(zeta),10.0), zeta )
+
+
+!!!! calcul du zeta pour connaitre le signe et donc en deduire le regime...
+
+
+
+
+     IF ( zeta(1) .GT. 0 ) THEN !!! si regime stable alors valeurs pr chi et psi 
+
+        chi = 0.018 
+
+
+        psi(1,1) = -5.*zeta(1)
+        psi(2,1) = psi(1,1)
+
+     ELSE !!!!! si regime instable alors valeurs pr psi et chi !!!
+
+        chi = 0.0327
+
+        X = sqrt( sqrt( 1-16.*zeta(1) ))
+        psi(1,1) =  3.1415695 / 2 + 2 * LOG( ( 1 + X ) / 2 ) + LOG( (1 + X**2) / 2 ) - 2*ATAN(X)
+        psi(2,1) =  2.*LOG( (1 + X**2) / 2 )
+
+     END IF
+
+     do j =2,3
+        IF ( zeta(j) .GT. 0 ) THEN
+           psi(1,j) = -5.*zeta(j)
+           psi(2,j) = psi(1,1)
+
+        ELSE
+           X = sqrt( sqrt( 1-16.*zeta(j) ))
+           psi(1,j) =  3.1415695 / 2 + 2 * LOG( ( 1 + X ) / 2 ) + LOG( (1 + X**2) / 2 ) - 2*ATAN(X)
+           psi(2,j) =  2.*LOG( (1 + X**2) / 2 )
+
+        END IF
+     enddo
+
+
+     dt_u = dt - tsr / k * &
+          ( logzt_zu + psi(2,1) - psi(2,2) )
+
+     dq_u = dq - qsr / k * &
+          ( logzq_zu + psi(2,1) - psi(2,3) )
+
+
+
+     u_N = u / ( 1 + cd_n10_rt / k * ( logzu_10 - psi(1,1)) )
+
+     if (mixte) then
+        z_0m=0.018*usr**2/9.81 + 0.11*14e-6 / (usr)
+!        z_0h=(0.11*14e-6 / (usr)) + 1.4e-5 
+        cd_n10 = k**2 / (log(10/z_0m))**2
+        cd_n10_rt = sqrt(cd_n10)
+!        ch_n10 = k**2 / ((log(10/z_0m))*(log(10/z_0h)))
+!        ch_n10_rt = sqrt(ch_n10)
+        ch_n10 = 1.e-3
+     else
+! Large and yaeger 2006
+        cd_n10 = alpha / u_n + beta + gamma * u_n !!!!! calcul de cd pour core pur
+! Large and yaeger 2004
+!        cd_n10 = 1E-3 * (2.7/U_n + 0.142 + U_n/13.09) 
+        !        cd_n10_dun = -alpha / u_n**2 + gamma
+        cd_n10_rt = sqrt(cd_n10)
+        z_0m = 10. * exp(-k/cd_n10_rt) !!!!! c'est sur cette ligne la qu'il y a un bug... ou sur la ligne du u_N
+!        ch_n10 = chi * cd_n10_rt
+!        z_0h = 10. * exp(-k/ch_n10)
+!        ch_n10_rt = sqrt(ch_n10)
+        ch_n10 = chi * cd_n10_rt
+     endif
+
+
+     ce_n10 = 3.46e-2*cd_n10_rt
+
+
+
+     phid = 1+cd_n10_rt/k * (logzu_10 - psi(1,1))
+     phih = 1+chi/k * (logzu_10 - psi(2,1))
+     phie = 1+3.46e-2/k * (logzu_10 - psi(2,1))
+
+
+     cd_rt = cd_n10_rt / abs( phid )
+     ch = ch_n10 / ( phih * phid )
+     ce = ce_n10 / ( phie * phid )
+
+     cd=cd_rt**2
+
+  END DO
+
+  usr = cd_rt * u
+  tsr = ch / cd_rt *  dt_u
+  qsr = ce / cd_rt * dq_u
+
+
+  ! coeffs(:,m) = [ &
+  !      rho * usr**2,&
+  !      rho * cpa * usr *tsr,&
+  !      rho * le * usr *qsr]
+
+  coeffs = [ cd_rt**2, ch , ce ]
+
+  rugosm =  z_0m
+  rugosh =  z_0h
+
+      RETURN
+      END subroutine clc_core_cp
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/clesphys.h
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/clesphys.h	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/clesphys.h	(revision 4727)
@@ -18,4 +18,5 @@
        REAL co2_ppm, co2_ppm0, solaire
        INTEGER iflag_thermals,nsplit_thermals
+       INTEGER iflag_physiq
        REAL tau_thermals
 
@@ -42,4 +43,6 @@
 !IM seuils cdrm, cdrh
        REAL cdmmax, cdhmax
+!IM pour les params différentes Olivier Torres
+       INTEGER choix_bulk, nit_bulk, kz0
 !IM param. stabilite s/ terres et en dehors
        REAL ksta, ksta_ter, f_ri_cd_min
@@ -100,8 +103,9 @@
        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
 
-!AI flags pour ECRAD
+!AI flags pour ECRAD       
        LOGICAL :: ok_3Deffect
        CHARACTER(len=512) :: namelist_ecrad_file
@@ -109,4 +113,5 @@
        COMMON/clesphys/                                                 &
 ! REAL FIRST
+! rajout choix_bulk et nit_bulk kz0 par Olivier Torres
      &       co2_ppm, solaire                                           &
      &     , RCO2, RCH4, RN2O, RCFC11, RCFC12                           &
@@ -136,4 +141,5 @@
      &     , ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad                &
      &     , iflag_con, nbapp_cv, nbapp_wk                              &
+     &     , choix_bulk, nit_bulk, kz0                                  &
      &     , iflag_ener_conserv                                         &
      &     , ok_suntime_rrtm                                            & 
@@ -154,7 +160,7 @@
      &     , 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               &
-     &     , ok_3Deffect, namelist_ecrad_file    
+     &     , iflag_phytrac, ok_new_lscp, ok_bs, ok_rad_bs               &
+     &     ,  iflag_thermals,nsplit_thermals, tau_thermals              &
+     &     , iflag_physiq, ok_3Deffect, namelist_ecrad_file
        save /clesphys/
 !$OMP THREADPRIVATE(/clesphys/)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/climb_qbs_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/climb_qbs_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/climb_qbs_mod.F90	(revision 4727)
@@ -0,0 +1,389 @@
+MODULE climb_qbs_mod
+!
+! Module to solve the verctical diffusion of blowing snow; 
+!
+  USE dimphy
+
+  IMPLICIT NONE
+  SAVE 
+  PRIVATE
+  PUBLIC :: climb_qbs_down, climb_qbs_up
+
+  REAL, DIMENSION(:,:), ALLOCATABLE :: gamaqbs
+  !$OMP THREADPRIVATE(gamaqbs)
+  REAL, DIMENSION(:,:), ALLOCATABLE :: Ccoef_QBS, Dcoef_QBS
+  !$OMP THREADPRIVATE(Ccoef_QBS, Dcoef_QBS)
+  REAL, DIMENSION(:), ALLOCATABLE   :: Acoef_QBS, Bcoef_QBS
+  !$OMP THREADPRIVATE(Acoef_QBS, Bcoef_QBS)
+  REAL, DIMENSION(:,:), ALLOCATABLE :: Kcoefqbs
+  !$OMP THREADPRIVATE(Kcoefqbs)
+
+CONTAINS
+!
+!****************************************************************************************
+!
+  SUBROUTINE climb_qbs_down(knon, coefqbs, paprs, pplay, &
+       delp, temp, qbs, dtime, &
+       Ccoef_QBS_out, Dcoef_QBS_out, &
+       Kcoef_qbs_out, gama_qbs_out, &
+       Acoef_QBS_out, Bcoef_QBS_out)
+
+! This routine calculates recursivly the coefficients C and D
+! for the quantity X=[QBS] in equation X(k) = C(k) + D(k)*X(k-1), where k is
+! the index of the vertical layer.
+!
+! Input arguments
+!****************************************************************************************
+    INTEGER, INTENT(IN)                      :: knon
+    REAL, DIMENSION(klon,klev), INTENT(IN)   :: coefqbs
+    REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay 
+    REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs 
+    REAL, DIMENSION(klon,klev), INTENT(IN)   :: delp  
+    REAL, DIMENSION(klon,klev), INTENT(IN)   :: temp
+    REAL, DIMENSION(klon,klev), INTENT(IN)   :: qbs
+    REAL, INTENT(IN)                         :: dtime
+
+! Output arguments
+!****************************************************************************************
+    REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef_QBS_out
+    REAL, DIMENSION(klon), INTENT(OUT)       :: Bcoef_QBS_out
+
+    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef_QBS_out
+    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Dcoef_QBS_out
+    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Kcoef_qbs_out
+    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: gama_qbs_out
+
+! Local variables
+!****************************************************************************************
+    LOGICAL, SAVE                            :: first=.TRUE.
+    !$OMP THREADPRIVATE(first)
+    REAL, DIMENSION(klon)                    :: psref 
+    REAL                                     :: delz, pkh
+    INTEGER                                  :: k, i, ierr
+! Include
+!****************************************************************************************
+    INCLUDE "YOMCST.h"
+    INCLUDE "compbl.h"    
+
+
+!****************************************************************************************
+! 1)
+! Allocation at first time step only
+!   
+!****************************************************************************************
+
+    IF (first) THEN
+       first=.FALSE.
+       ALLOCATE(Ccoef_QBS(klon,klev), STAT=ierr)
+       IF ( ierr /= 0 )  PRINT*,' pb in allloc Ccoef_QBS, ierr=', ierr
+       
+       ALLOCATE(Dcoef_QBS(klon,klev), STAT=ierr)
+       IF ( ierr /= 0 )  PRINT*,' pb in allloc Dcoef_QBS, ierr=', ierr
+       
+       ALLOCATE(Acoef_QBS(klon), Bcoef_QBS(klon), STAT=ierr)
+       IF ( ierr /= 0 )  PRINT*,' pb in allloc Acoef_BS and Bcoef_BS, ierr=', ierr
+       
+       ALLOCATE(Kcoefqbs(klon,klev), STAT=ierr)
+       IF ( ierr /= 0 )  PRINT*,' pb in allloc Kcoefqbs, ierr=', ierr
+       
+       ALLOCATE(gamaqbs(1:klon,2:klev), STAT=ierr)
+       IF ( ierr /= 0 ) PRINT*,' pb in allloc gamaqbs, ierr=', ierr
+       
+    END IF
+
+!****************************************************************************************
+! 2)
+! Definition of the coeficient K 
+!
+!****************************************************************************************
+    Kcoefqbs(:,:) = 0.0
+    DO k = 2, klev
+       DO i = 1, knon
+          Kcoefqbs(i,k) = &
+               coefqbs(i,k)*RG*RG*dtime /(pplay(i,k-1)-pplay(i,k)) &
+               *(paprs(i,k)*2/(temp(i,k)+temp(i,k-1))/RD)**2
+       ENDDO
+    ENDDO
+
+!****************************************************************************************
+! 3)
+! Calculation of gama for "Q" and "H"
+!
+!****************************************************************************************
+!   surface pressure is used as reference
+    psref(:) = paprs(:,1) 
+
+!   definition of gama
+    IF (iflag_pbl == 1) THEN
+       gamaqbs(:,:) = 0.0
+ 
+! conversion de gama
+       DO k = 2, klev
+          DO i = 1, knon
+             delz = RD * (temp(i,k-1)+temp(i,k)) / & 
+                    2.0 / RG / paprs(i,k) * (pplay(i,k-1)-pplay(i,k))
+             pkh  = (psref(i)/paprs(i,k))**RKAPPA
+          
+! convertie gradient verticale de contenu en neige soufflee en difference de neige soufflee entre centre de couches
+             gamaqbs(i,k) = gamaqbs(i,k) * delz    
+          ENDDO
+       ENDDO
+
+    ELSE
+       gamaqbs(:,:) = 0.0
+    ENDIF
+    
+
+!****************************************************************************************    
+! 4)
+! Calculte the coefficients C and D for specific content of blowing snow, qbs
+!
+!****************************************************************************************
+    
+    CALL calc_coef_qbs(knon, Kcoefqbs(:,:), gamaqbs(:,:), delp(:,:), qbs(:,:), &
+         Ccoef_QBS(:,:), Dcoef_QBS(:,:), Acoef_QBS, Bcoef_QBS)
+
+ 
+!****************************************************************************************
+! 5)
+! Return the first layer in output variables
+!
+!****************************************************************************************
+    Acoef_QBS_out = Acoef_QBS
+    Bcoef_QBS_out = Bcoef_QBS
+
+!****************************************************************************************
+! 6)
+! If Pbl is split, return also the other layers in output variables
+!
+!****************************************************************************************
+    IF (mod(iflag_pbl_split,10) .ge.1) THEN
+    DO k= 1, klev
+      DO i= 1, klon
+        Ccoef_QBS_out(i,k) = Ccoef_QBS(i,k)
+        Dcoef_QBS_out(i,k) = Dcoef_QBS(i,k)
+        Kcoef_qbs_out(i,k) = Kcoefqbs(i,k)
+          IF (k.eq.1) THEN
+            gama_qbs_out(i,k)  = 0.
+          ELSE
+            gama_qbs_out(i,k)  = gamaqbs(i,k)
+          ENDIF
+      ENDDO
+    ENDDO
+!!!      
+       ENDIF  ! (mod(iflag_pbl_split,2) .ge.1)
+!!!
+
+  END SUBROUTINE climb_qbs_down
+!
+!****************************************************************************************
+!
+  SUBROUTINE calc_coef_qbs(knon, Kcoef, gama, delp, X, Ccoef, Dcoef, Acoef, Bcoef)
+!
+! Calculate the coefficients C and D in : X(k) = C(k) + D(k)*X(k-1)
+! where X is QQBS, and k the vertical level k=1,klev
+!
+    INCLUDE "YOMCST.h"
+! Input arguments
+!****************************************************************************************
+    INTEGER, INTENT(IN)                      :: knon
+    REAL, DIMENSION(klon,klev), INTENT(IN)   :: Kcoef, delp
+    REAL, DIMENSION(klon,klev), INTENT(IN)   :: X
+    REAL, DIMENSION(klon,2:klev), INTENT(IN) :: gama
+
+! Output arguments
+!****************************************************************************************
+    REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef, Bcoef
+    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef, Dcoef
+
+! Local variables
+!****************************************************************************************
+    INTEGER                                  :: k, i
+    REAL                                     :: buf
+
+!****************************************************************************************
+! Niveau au sommet, k=klev
+!
+!****************************************************************************************
+    Ccoef(:,:) = 0.0
+    Dcoef(:,:) = 0.0
+
+    DO i = 1, knon
+       buf = delp(i,klev) + Kcoef(i,klev)
+       
+       Ccoef(i,klev) = (X(i,klev)*delp(i,klev) - Kcoef(i,klev)*gama(i,klev))/buf
+       Dcoef(i,klev) = Kcoef(i,klev)/buf
+    END DO
+
+
+!****************************************************************************************
+! Niveau  (klev-1) <= k <= 2
+!
+!****************************************************************************************
+
+    DO k=(klev-1),2,-1
+       DO i = 1, knon
+          buf = delp(i,k) + Kcoef(i,k) + Kcoef(i,k+1)*(1.-Dcoef(i,k+1))
+          Ccoef(i,k) = (X(i,k)*delp(i,k) + Kcoef(i,k+1)*Ccoef(i,k+1) + &
+               Kcoef(i,k+1)*gama(i,k+1) - Kcoef(i,k)*gama(i,k))/buf
+          Dcoef(i,k) = Kcoef(i,k)/buf
+       END DO
+    END DO
+
+!****************************************************************************************
+! Niveau k=1
+!
+!****************************************************************************************
+
+    DO i = 1, knon
+       buf = delp(i,1) + Kcoef(i,2)*(1.-Dcoef(i,2))
+       Acoef(i) = (X(i,1)*delp(i,1) + Kcoef(i,2)*(gama(i,2)+Ccoef(i,2)))/buf
+       Bcoef(i) = -1. * RG / buf
+    END DO
+
+  END SUBROUTINE calc_coef_qbs
+!
+!****************************************************************************************
+!
+  SUBROUTINE climb_qbs_up(knon, dtime, qbs_old, &
+       flx_qbs1, paprs, pplay, &
+       Acoef_QBS_in, Bcoef_QBS_in, &
+       Ccoef_QBS_in, Dcoef_QBS_in, &
+       Kcoef_qbs_in, gama_qbs_in, &
+       flux_qbs, d_qbs)
+! 
+! This routine calculates the flux and tendency of the specific content of blowing snow qbs 
+! The quantity qbs is calculated according to 
+! X(k) = C(k) + D(k)*X(k-1) for X=[qbs], where the coefficients 
+! C and D are known from before and k is index of the vertical layer.
+!   
+
+! Input arguments
+!****************************************************************************************
+    INTEGER, INTENT(IN)                      :: knon
+    REAL, INTENT(IN)                         :: dtime
+    REAL, DIMENSION(klon,klev), INTENT(IN)   :: qbs_old
+    REAL, DIMENSION(klon), INTENT(IN)        :: flx_qbs1
+    REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
+    REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
+
+!!! nrlmd le 02/05/2011
+    REAL, DIMENSION(klon), INTENT(IN)        :: Acoef_QBS_in, Bcoef_QBS_in
+    REAL, DIMENSION(klon,klev), INTENT(IN)   :: Ccoef_QBS_in, Dcoef_QBS_in
+    REAL, DIMENSION(klon,klev), INTENT(IN)   :: Kcoef_qbs_in, gama_qbs_in
+!!!
+
+! Output arguments
+!****************************************************************************************
+    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: flux_qbs, d_qbs
+
+! Local variables
+!****************************************************************************************
+    LOGICAL, SAVE                            :: last=.FALSE.
+    REAL, DIMENSION(klon,klev)               :: qbs_new
+    REAL, DIMENSION(klon)                    :: psref         
+    INTEGER                                  :: k, i, ierr
+ 
+! Include
+!****************************************************************************************
+    INCLUDE "YOMCST.h"
+    INCLUDE "compbl.h"    
+
+!****************************************************************************************
+! 1) 
+! Definition of some variables
+    REAL, DIMENSION(klon,klev)               :: zairm
+!
+!****************************************************************************************
+    flux_qbs(:,:) = 0.0
+    d_qbs(:,:)    = 0.0
+
+    psref(1:knon) = paprs(1:knon,1)  
+
+       IF (mod(iflag_pbl_split,10) .ge.1) THEN
+    DO i = 1, knon
+      Acoef_QBS(i)=Acoef_QBS_in(i)
+      Bcoef_QBS(i)=Bcoef_QBS_in(i)
+    ENDDO
+    DO k = 1, klev
+      DO i = 1, knon
+        Ccoef_QBS(i,k)=Ccoef_QBS_in(i,k)
+        Dcoef_QBS(i,k)=Dcoef_QBS_in(i,k)
+        Kcoefqbs(i,k)=Kcoef_qbs_in(i,k)
+          IF (k.gt.1) THEN
+            gamaqbs(i,k)=gama_qbs_in(i,k)
+          ENDIF
+      ENDDO
+    ENDDO
+!!!      
+       ENDIF  ! (mod(iflag_pbl_split,2) .ge.1)
+!!!
+
+!****************************************************************************************
+! 2)
+! Calculation of QBS
+!
+!****************************************************************************************
+
+!- First layer
+    qbs_new(1:knon,1) = Acoef_QBS(1:knon) + Bcoef_QBS(1:knon)*flx_qbs1(1:knon)*dtime
+!- All the other layers 
+    DO k = 2, klev
+       DO i = 1, knon
+          qbs_new(i,k) = Ccoef_QBS(i,k) + Dcoef_QBS(i,k)*qbs_new(i,k-1)
+       END DO
+    END DO
+!****************************************************************************************
+! 3)
+! Calculation of the flux for QBS
+!
+!****************************************************************************************
+
+!- The flux at first layer, k=1
+    flux_qbs(1:knon,1)=flx_qbs1(1:knon)
+
+!- The flux at all layers above surface
+    DO k = 2, klev
+       DO i = 1, knon
+          flux_qbs(i,k) = (Kcoefqbs(i,k)/RG/dtime) * &
+               (qbs_new(i,k)-qbs_new(i,k-1)+gamaqbs(i,k))
+       END DO
+    END DO
+
+!****************************************************************************************
+! 4)
+! Calculation of tendency for QBS
+!
+!****************************************************************************************
+    DO k = 1, klev
+       DO i = 1, knon
+          d_qbs(i,k) = qbs_new(i,k) - qbs_old(i,k)
+          zairm(i, k) = (paprs(i,k)-paprs(i,k+1))/rg
+        END DO
+    END DO
+
+!****************************************************************************************
+! Some deallocations
+!
+!****************************************************************************************
+    IF (last) THEN
+       DEALLOCATE(Ccoef_QBS, Dcoef_QBS,stat=ierr)    
+       IF ( ierr /= 0 )  PRINT*,' pb in dealllocate Ccoef_QBS, Dcoef_QBS, ierr=', ierr
+       DEALLOCATE(Acoef_QBS, Bcoef_QBS,stat=ierr)    
+       IF ( ierr /= 0 )  PRINT*,' pb in dealllocate Acoef_QBS, Bcoef_QBS, ierr=', ierr
+       DEALLOCATE(gamaqbs,stat=ierr)
+       IF ( ierr /= 0 )  PRINT*,' pb in dealllocate gamaqbs, ierr=', ierr
+       DEALLOCATE(Kcoefqbs,stat=ierr)
+       IF ( ierr /= 0 )  PRINT*,' pb in dealllocate Kcoefqbs, ierr=', ierr
+    END IF
+  END SUBROUTINE climb_qbs_up
+!
+!****************************************************************************************
+!
+END MODULE climb_qbs_mod
+
+ 
+
+
+
+
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/cloudth_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cloudth_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,2446 +1,0 @@
-MODULE cloudth_mod
-
-  IMPLICIT NONE
-
-CONTAINS
-
-       SUBROUTINE cloudth(ngrid,klev,ind2,  &
-     &           ztv,po,zqta,fraca, & 
-     &           qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
-     &           ratqs,zqs,t)
-
-
-      IMPLICIT NONE
-
-
-!===========================================================================
-! Auteur : Arnaud Octavio Jam (LMD/CNRS)
-! Date : 25 Mai 2010
-! Objet : calcule les valeurs de qc et rneb dans les thermiques
-!===========================================================================
-
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "nuage.h"
-
-      INTEGER itap,ind1,ind2
-      INTEGER ngrid,klev,klon,l,ig 
-      
-      REAL ztv(ngrid,klev)
-      REAL po(ngrid)
-      REAL zqenv(ngrid)   
-      REAL zqta(ngrid,klev)
-          
-      REAL fraca(ngrid,klev+1)
-      REAL zpspsk(ngrid,klev)
-      REAL paprs(ngrid,klev+1)
-      REAL pplay(ngrid,klev)
-      REAL ztla(ngrid,klev)
-      REAL zthl(ngrid,klev)
-
-      REAL zqsatth(ngrid,klev)
-      REAL zqsatenv(ngrid,klev)
-      
-      
-      REAL sigma1(ngrid,klev)
-      REAL sigma2(ngrid,klev)
-      REAL qlth(ngrid,klev)
-      REAL qlenv(ngrid,klev)
-      REAL qltot(ngrid,klev) 
-      REAL cth(ngrid,klev)  
-      REAL cenv(ngrid,klev)   
-      REAL ctot(ngrid,klev)
-      REAL rneb(ngrid,klev)
-      REAL t(ngrid,klev)
-      REAL qsatmmussig1,qsatmmussig2,sqrt2pi,pi
-      REAL rdd,cppd,Lv
-      REAL alth,alenv,ath,aenv
-      REAL sth,senv,sigma1s,sigma2s,xth,xenv
-      REAL Tbef,zdelta,qsatbef,zcor
-      REAL qlbef  
-      REAL ratqs(ngrid,klev) ! determine la largeur de distribution de vapeur
-      
-      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
-      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 
-      REAL zqs(ngrid), qcloud(ngrid)
-      REAL erf
-
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Gestion de deux versions de cloudth
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      IF (iflag_cloudth_vert.GE.1) THEN
-      CALL cloudth_vert(ngrid,klev,ind2,  &
-     &           ztv,po,zqta,fraca, & 
-     &           qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
-     &           ratqs,zqs,t)
-      RETURN
-      ENDIF
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-!-------------------------------------------------------------------------------
-! Initialisation des variables r?elles
-!-------------------------------------------------------------------------------
-      sigma1(:,:)=0.
-      sigma2(:,:)=0.
-      qlth(:,:)=0.
-      qlenv(:,:)=0.  
-      qltot(:,:)=0.
-      rneb(:,:)=0.
-      qcloud(:)=0.
-      cth(:,:)=0.
-      cenv(:,:)=0.
-      ctot(:,:)=0.
-      qsatmmussig1=0.
-      qsatmmussig2=0.
-      rdd=287.04
-      cppd=1005.7
-      pi=3.14159 
-      Lv=2.5e6
-      sqrt2pi=sqrt(2.*pi)
-
-
-
-!-------------------------------------------------------------------------------
-! Calcul de la fraction du thermique et des ?cart-types des distributions
-!-------------------------------------------------------------------------------                 
-      do ind1=1,ngrid
-
-      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then 
-
-      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
-
-
-!      zqenv(ind1)=po(ind1)
-      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-
-
-
-
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
-      aenv=1./(1.+(alenv*Lv/cppd))
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2)) 
-
-
-
-
-      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatth(ind1,ind2)=qsatbef
-            
-      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)   
-      ath=1./(1.+(alth*Lv/cppd))
-      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2)) 
-      
-      
-
-!------------------------------------------------------------------------------
-! Calcul des ?cart-types pour s
-!------------------------------------------------------------------------------
-
-!      sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
-!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.002*zqta(ind1,ind2) 
-!       if (paprs(ind1,ind2).gt.90000) then
-!       ratqs(ind1,ind2)=0.002
-!       else 
-!       ratqs(ind1,ind2)=0.002+0.0*(90000-paprs(ind1,ind2))/20000
-!       endif
-       sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
-       sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2) 
-!       sigma1s=ratqs(ind1,ind2)*po(ind1)
-!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.00003  
- 
-!------------------------------------------------------------------------------
-! Calcul de l'eau condens?e et de la couverture nuageuse
-!------------------------------------------------------------------------------
-      sqrt2pi=sqrt(2.*pi)
-      xth=sth/(sqrt(2.)*sigma2s)
-      xenv=senv/(sqrt(2.)*sigma1s)
-      cth(ind1,ind2)=0.5*(1.+1.*erf(xth))
-      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv)) 
-      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
-
-      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt(2.)*cth(ind1,ind2))
-      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))   
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      if (ctot(ind1,ind2).lt.1.e-10) then
-      ctot(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2) 
-
-      else   
-                
-      ctot(ind1,ind2)=ctot(ind1,ind2) 
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
-
-      endif                           
-      
-          
-!     print*,sth,sigma2s,qlth(ind1,ind2),ctot(ind1,ind2),qltot(ind1,ind2),'verif'
-
-
-      else  ! gaussienne environnement seule
-      
-      zqenv(ind1)=po(ind1)
-      Tbef=t(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-      
-
-!      qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
-      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
-      aenv=1./(1.+(alenv*Lv/cppd))
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2)) 
-      
-
-      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
-
-      sqrt2pi=sqrt(2.*pi)
-      xenv=senv/(sqrt(2.)*sigma1s)
-      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
-      
-      if (ctot(ind1,ind2).lt.1.e-3) then
-      ctot(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2) 
-
-      else   
-                
-      ctot(ind1,ind2)=ctot(ind1,ind2) 
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
-
-      endif    
- 
- 
- 
- 
- 
- 
-      endif   
-      enddo
-     
-      return
-!     end
-END SUBROUTINE cloudth
-
-
-
-!===========================================================================
-     SUBROUTINE cloudth_vert(ngrid,klev,ind2,  &
-     &           ztv,po,zqta,fraca, & 
-     &           qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
-     &           ratqs,zqs,t)
-
-!===========================================================================
-! Auteur : Arnaud Octavio Jam (LMD/CNRS)
-! Date : 25 Mai 2010
-! Objet : calcule les valeurs de qc et rneb dans les thermiques
-!===========================================================================
-
-
-      USE ioipsl_getin_p_mod, ONLY : getin_p
-
-      IMPLICIT NONE
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "nuage.h"
-      
-      INTEGER itap,ind1,ind2
-      INTEGER ngrid,klev,klon,l,ig 
-      
-      REAL ztv(ngrid,klev)
-      REAL po(ngrid)
-      REAL zqenv(ngrid)   
-      REAL zqta(ngrid,klev)
-          
-      REAL fraca(ngrid,klev+1)
-      REAL zpspsk(ngrid,klev)
-      REAL paprs(ngrid,klev+1)
-      REAL pplay(ngrid,klev)
-      REAL ztla(ngrid,klev)
-      REAL zthl(ngrid,klev)
-
-      REAL zqsatth(ngrid,klev)
-      REAL zqsatenv(ngrid,klev)
-      
-      
-      REAL sigma1(ngrid,klev)                                                         
-      REAL sigma2(ngrid,klev)
-      REAL qlth(ngrid,klev)
-      REAL qlenv(ngrid,klev)
-      REAL qltot(ngrid,klev) 
-      REAL cth(ngrid,klev)  
-      REAL cenv(ngrid,klev)   
-      REAL ctot(ngrid,klev)
-      REAL rneb(ngrid,klev)
-      REAL t(ngrid,klev)                                                                  
-      REAL qsatmmussig1,qsatmmussig2,sqrt2pi,pi
-      REAL rdd,cppd,Lv,sqrt2,sqrtpi
-      REAL alth,alenv,ath,aenv
-      REAL sth,senv,sigma1s,sigma2s,xth,xenv
-      REAL xth1,xth2,xenv1,xenv2,deltasth, deltasenv
-      REAL IntJ,IntI1,IntI2,IntI3,coeffqlenv,coeffqlth
-      REAL Tbef,zdelta,qsatbef,zcor
-      REAL qlbef  
-      REAL ratqs(ngrid,klev) ! determine la largeur de distribution de vapeur
-      ! Change the width of the PDF used for vertical subgrid scale heterogeneity
-      ! (J Jouhaud, JL Dufresne, JB Madeleine)
-      REAL,SAVE :: vert_alpha
-      !$OMP THREADPRIVATE(vert_alpha)
-      LOGICAL, SAVE :: firstcall = .TRUE.
-      !$OMP THREADPRIVATE(firstcall)
-      
-      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
-      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 
-      REAL zqs(ngrid), qcloud(ngrid)
-      REAL erf
-
-!------------------------------------------------------------------------------
-! Initialisation des variables r?elles
-!------------------------------------------------------------------------------
-      sigma1(:,:)=0.
-      sigma2(:,:)=0.
-      qlth(:,:)=0.
-      qlenv(:,:)=0.  
-      qltot(:,:)=0.
-      rneb(:,:)=0.
-      qcloud(:)=0.
-      cth(:,:)=0.
-      cenv(:,:)=0.
-      ctot(:,:)=0.
-      qsatmmussig1=0.
-      qsatmmussig2=0.
-      rdd=287.04
-      cppd=1005.7
-      pi=3.14159 
-      Lv=2.5e6
-      sqrt2pi=sqrt(2.*pi)
-      sqrt2=sqrt(2.)
-      sqrtpi=sqrt(pi)
-
-      IF (firstcall) THEN
-        vert_alpha=0.5
-        CALL getin_p('cloudth_vert_alpha',vert_alpha)
-        WRITE(*,*) 'cloudth_vert_alpha = ', vert_alpha
-        firstcall=.FALSE.
-      ENDIF
-
-!-------------------------------------------------------------------------------
-! Calcul de la fraction du thermique et des ?cart-types des distributions
-!-------------------------------------------------------------------------------                 
-      do ind1=1,ngrid
-
-      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then 
-
-      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
-
-
-!      zqenv(ind1)=po(ind1)
-      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-
-
-
-
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
-      aenv=1./(1.+(alenv*Lv/cppd))
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2)) 
-
-
-
-
-      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatth(ind1,ind2)=qsatbef
-            
-      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)   
-      ath=1./(1.+(alth*Lv/cppd))
-      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2)) 
-      
-      
-
-!------------------------------------------------------------------------------
-! Calcul des ?cart-types pour s
-!------------------------------------------------------------------------------
-
-      sigma1s=(0.92**0.5)*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
-      sigma2s=0.09*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.5+0.002*zqta(ind1,ind2) 
-!       if (paprs(ind1,ind2).gt.90000) then
-!       ratqs(ind1,ind2)=0.002
-!       else 
-!       ratqs(ind1,ind2)=0.002+0.0*(90000-paprs(ind1,ind2))/20000
-!       endif
-!       sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
-!       sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2) 
-!       sigma1s=ratqs(ind1,ind2)*po(ind1)
-!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.00003  
- 
-!------------------------------------------------------------------------------
-! Calcul de l'eau condens?e et de la couverture nuageuse
-!------------------------------------------------------------------------------
-      sqrt2pi=sqrt(2.*pi)
-      xth=sth/(sqrt(2.)*sigma2s)
-      xenv=senv/(sqrt(2.)*sigma1s)
-      cth(ind1,ind2)=0.5*(1.+1.*erf(xth))
-      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv)) 
-      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
-
-      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt(2.)*cth(ind1,ind2))
-      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))   
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-     
-       IF (iflag_cloudth_vert == 1) THEN
-!-------------------------------------------------------------------------------
-!  Version 2: Modification selon J.-Louis. On condense ?? partir de qsat-ratqs
-!-------------------------------------------------------------------------------
-!      deltasenv=aenv*ratqs(ind1,ind2)*po(ind1)
-!      deltasth=ath*ratqs(ind1,ind2)*zqta(ind1,ind2)
-      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
-      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
-!      deltasenv=aenv*0.01*po(ind1)
-!     deltasth=ath*0.01*zqta(ind1,ind2)    
-      xenv1=(senv-deltasenv)/(sqrt(2.)*sigma1s)
-      xenv2=(senv+deltasenv)/(sqrt(2.)*sigma1s)
-      xth1=(sth-deltasth)/(sqrt(2.)*sigma2s)
-      xth2=(sth+deltasth)/(sqrt(2.)*sigma2s)
-      coeffqlenv=(sigma1s)**2/(2*sqrtpi*deltasenv)
-      coeffqlth=(sigma2s)**2/(2*sqrtpi*deltasth)
-      
-      cth(ind1,ind2)=0.5*(1.+1.*erf(xth2))
-      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv2)) 
-      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
-
-      IntJ=sigma1s*(exp(-1.*xenv1**2)/sqrt2pi)+0.5*senv*(1+erf(xenv1))
-      IntI1=coeffqlenv*0.5*(0.5*sqrtpi*(erf(xenv2)-erf(xenv1))+xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
-      IntI2=coeffqlenv*xenv2*(exp(-1.*xenv2**2)-exp(-1.*xenv1**2))
-      IntI3=coeffqlenv*0.5*sqrtpi*xenv2**2*(erf(xenv2)-erf(xenv1))
-
-      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-!      qlenv(ind1,ind2)=IntJ 
-!      print*, qlenv(ind1,ind2),'VERIF EAU'
-
-
-      IntJ=sigma2s*(exp(-1.*xth1**2)/sqrt2pi)+0.5*sth*(1+erf(xth1))
-!      IntI1=coeffqlth*((0.5*xth1-xth2)*exp(-1.*xth1**2)+0.5*xth2*exp(-1.*xth2**2))
-!      IntI2=coeffqlth*0.5*sqrtpi*(0.5+xth2**2)*(erf(xth2)-erf(xth1))
-      IntI1=coeffqlth*0.5*(0.5*sqrtpi*(erf(xth2)-erf(xth1))+xth1*exp(-1.*xth1**2)-xth2*exp(-1.*xth2**2))
-      IntI2=coeffqlth*xth2*(exp(-1.*xth2**2)-exp(-1.*xth1**2))
-      IntI3=coeffqlth*0.5*sqrtpi*xth2**2*(erf(xth2)-erf(xth1))
-      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-!      qlth(ind1,ind2)=IntJ
-!      print*, IntJ,IntI1,IntI2,IntI3,qlth(ind1,ind2),'VERIF EAU2'
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-
-      ELSE IF (iflag_cloudth_vert == 2) THEN
-
-!-------------------------------------------------------------------------------
-!  Version 3: Modification Jean Jouhaud. On condense a partir de -delta s
-!-------------------------------------------------------------------------------
-!      deltasenv=aenv*ratqs(ind1,ind2)*po(ind1)
-!      deltasth=ath*ratqs(ind1,ind2)*zqta(ind1,ind2)
-!      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
-!      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
-      deltasenv=aenv*vert_alpha*sigma1s
-      deltasth=ath*vert_alpha*sigma2s
-      
-      xenv1=-(senv+deltasenv)/(sqrt(2.)*sigma1s)
-      xenv2=-(senv-deltasenv)/(sqrt(2.)*sigma1s)
-      xth1=-(sth+deltasth)/(sqrt(2.)*sigma2s)
-      xth2=-(sth-deltasth)/(sqrt(2.)*sigma2s)
-!     coeffqlenv=(sigma1s)**2/(2*sqrtpi*deltasenv)
-!     coeffqlth=(sigma2s)**2/(2*sqrtpi*deltasth)
-      
-      cth(ind1,ind2)=0.5*(1.-1.*erf(xth1))
-      cenv(ind1,ind2)=0.5*(1.-1.*erf(xenv1))
-      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
-
-      IntJ=0.5*senv*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp(-1.*xenv2**2)
-      IntI1=(((senv+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
-      IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
-      IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp(-1.*xenv1**2)-exp(-1.*xenv2**2))
-
-!      IntI1=0.5*(0.5*sqrtpi*(erf(xenv2)-erf(xenv1))+xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
-!      IntI2=xenv2*(exp(-1.*xenv2**2)-exp(-1.*xenv1**2))
-!      IntI3=0.5*sqrtpi*xenv2**2*(erf(xenv2)-erf(xenv1))
-
-      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-!      qlenv(ind1,ind2)=IntJ 
-!      print*, qlenv(ind1,ind2),'VERIF EAU'
-
-      IntJ=0.5*sth*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp(-1.*xth2**2)
-      IntI1=(((sth+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
-      IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp(-1.*xth1**2)-xth2*exp(-1.*xth2**2))
-      IntI3=((sqrt2*sigma2s*(sth+deltasth))/(4*sqrtpi*deltasth))*(exp(-1.*xth1**2)-exp(-1.*xth2**2))
-      
-      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-!      qlth(ind1,ind2)=IntJ
-!      print*, IntJ,IntI1,IntI2,IntI3,qlth(ind1,ind2),'VERIF EAU2'
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-      
-
-
-
-      ENDIF ! of if (iflag_cloudth_vert==1 or 2)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      if (cenv(ind1,ind2).lt.1.e-10.or.cth(ind1,ind2).lt.1.e-10) then
-      ctot(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2) 
-
-      else 
-                
-      ctot(ind1,ind2)=ctot(ind1,ind2) 
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
-!      qcloud(ind1)=fraca(ind1,ind2)*qlth(ind1,ind2)/cth(ind1,ind2) &
-!    &             +(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)/cenv(ind1,ind2)+zqs(ind1) 
-
-      endif  
-                       
-      
-          
-!     print*,sth,sigma2s,qlth(ind1,ind2),ctot(ind1,ind2),qltot(ind1,ind2),'verif'
-
-
-      else  ! gaussienne environnement seule
-      
-      zqenv(ind1)=po(ind1)
-      Tbef=t(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-      
-
-!      qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
-      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
-      aenv=1./(1.+(alenv*Lv/cppd))
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2)) 
-      
-
-      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
-
-      sqrt2pi=sqrt(2.*pi)
-      xenv=senv/(sqrt(2.)*sigma1s)
-      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
-      
-      if (ctot(ind1,ind2).lt.1.e-3) then
-      ctot(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2) 
-
-      else   
-                
-      ctot(ind1,ind2)=ctot(ind1,ind2) 
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
-
-      endif    
- 
- 
- 
- 
- 
- 
-      endif   
-      enddo
-     
-      return
-!     end
-END SUBROUTINE cloudth_vert
-
-
-
-
-       SUBROUTINE cloudth_v3(ngrid,klev,ind2,  &
-     &           ztv,po,zqta,fraca, & 
-     &           qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
-     &           ratqs,zqs,t)
-
-
-      IMPLICIT NONE
-
-
-!===========================================================================
-! Author : Arnaud Octavio Jam (LMD/CNRS)
-! Date : 25 Mai 2010
-! Objet : calcule les valeurs de qc et rneb dans les thermiques
-!===========================================================================
-
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "nuage.h"
-
-      INTEGER itap,ind1,ind2
-      INTEGER ngrid,klev,klon,l,ig 
-      
-      REAL ztv(ngrid,klev)
-      REAL po(ngrid)
-      REAL zqenv(ngrid)   
-      REAL zqta(ngrid,klev)
-          
-      REAL fraca(ngrid,klev+1)
-      REAL zpspsk(ngrid,klev)
-      REAL paprs(ngrid,klev+1)
-      REAL pplay(ngrid,klev)
-      REAL ztla(ngrid,klev)
-      REAL zthl(ngrid,klev)
-
-      REAL zqsatth(ngrid,klev)
-      REAL zqsatenv(ngrid,klev)
-      
-      REAL sigma1(ngrid,klev)                                                         
-      REAL sigma2(ngrid,klev)
-      REAL qlth(ngrid,klev)
-      REAL qlenv(ngrid,klev)
-      REAL qltot(ngrid,klev) 
-      REAL cth(ngrid,klev)
-      REAL cenv(ngrid,klev)   
-      REAL ctot(ngrid,klev)
-      REAL cth_vol(ngrid,klev)
-      REAL cenv_vol(ngrid,klev)
-      REAL ctot_vol(ngrid,klev)
-      REAL rneb(ngrid,klev)      
-      REAL t(ngrid,klev)
-      REAL qsatmmussig1,qsatmmussig2,sqrt2pi,sqrt2,sqrtpi,pi
-      REAL rdd,cppd,Lv
-      REAL alth,alenv,ath,aenv
-      REAL sth,senv,sigma1s,sigma2s,xth,xenv, exp_xenv1, exp_xenv2,exp_xth1,exp_xth2
-      REAL inverse_rho,beta,a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks
-      REAL Tbef,zdelta,qsatbef,zcor
-      REAL qlbef  
-      REAL ratqs(ngrid,klev) ! Determine the width of the vapour distribution
-      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
-      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 
-      REAL zqs(ngrid), qcloud(ngrid)
-      REAL erf
-
-
-      IF (iflag_cloudth_vert.GE.1) THEN
-      CALL cloudth_vert_v3(ngrid,klev,ind2,  &
-     &           ztv,po,zqta,fraca, & 
-     &           qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
-     &           ratqs,zqs,t)
-      RETURN
-      ENDIF
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-!-------------------------------------------------------------------------------
-! Initialisation des variables r?elles
-!-------------------------------------------------------------------------------
-      sigma1(:,:)=0.
-      sigma2(:,:)=0.
-      qlth(:,:)=0.
-      qlenv(:,:)=0.  
-      qltot(:,:)=0.
-      rneb(:,:)=0.
-      qcloud(:)=0.
-      cth(:,:)=0.
-      cenv(:,:)=0.
-      ctot(:,:)=0.
-      cth_vol(:,:)=0.
-      cenv_vol(:,:)=0.
-      ctot_vol(:,:)=0.
-      qsatmmussig1=0.
-      qsatmmussig2=0.
-      rdd=287.04
-      cppd=1005.7
-      pi=3.14159 
-      Lv=2.5e6
-      sqrt2pi=sqrt(2.*pi)
-      sqrt2=sqrt(2.)
-      sqrtpi=sqrt(pi)
-
-
-!-------------------------------------------------------------------------------
-! Cloud fraction in the thermals and standard deviation of the PDFs
-!-------------------------------------------------------------------------------                 
-      do ind1=1,ngrid
-
-      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then 
-
-      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
-
-      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES*FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-
-
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84
-      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84
-
-!po = qt de l'environnement ET des thermique
-!zqenv = qt environnement
-!zqsatenv = qsat environnement
-!zthl = Tl environnement
-
-
-      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatth(ind1,ind2)=qsatbef
-            
-      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)       !qsl, p84
-      ath=1./(1.+(alth*Lv/cppd))                                        !al, p84
-      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))                      !s, p84
-      
-!zqta = qt thermals
-!zqsatth = qsat thermals
-!ztla = Tl thermals
-
-!------------------------------------------------------------------------------
-! s standard deviations
-!------------------------------------------------------------------------------
-
-!     tests
-!     sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
-!     sigma1s=(0.92*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5))+ratqs(ind1,ind2)*po(ind1)
-!     sigma2s=(0.09*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**0.5))+0.002*zqta(ind1,ind2)
-!     final option
-      sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
-      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2)
- 
-!------------------------------------------------------------------------------
-! Condensed water and cloud cover
-!------------------------------------------------------------------------------
-      xth=sth/(sqrt2*sigma2s)
-      xenv=senv/(sqrt2*sigma1s)
-      cth(ind1,ind2)=0.5*(1.+1.*erf(xth))       !4.18 p 111, l.7 p115 & 4.20 p 119 thesis Arnaud Jam
-      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv))     !4.18 p 111, l.7 p115 & 4.20 p 119 thesis Arnaud Jam
-      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
-      ctot_vol(ind1,ind2)=ctot(ind1,ind2)
-
-      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt2*cth(ind1,ind2))
-      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*cenv(ind1,ind2))
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-
-      if (ctot(ind1,ind2).lt.1.e-10) then
-      ctot(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2) 
-      else
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
-      endif
-
-      else  ! Environnement only, follow the if l.110
-      
-      zqenv(ind1)=po(ind1)
-      Tbef=t(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-
-!     qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
-      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
-      aenv=1./(1.+(alenv*Lv/cppd))
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))
-      
-      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
-
-      xenv=senv/(sqrt2*sigma1s)
-      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-      ctot_vol(ind1,ind2)=ctot(ind1,ind2)
-      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*cenv(ind1,ind2))
-
-      if (ctot(ind1,ind2).lt.1.e-3) then
-      ctot(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2)
-      else   
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
-      endif
-
-
-      endif       ! From the separation (thermal/envrionnement) et (environnement) only, l.110 et l.183
-      enddo       ! from the loop on ngrid l.108
-      return
-!     end
-END SUBROUTINE cloudth_v3
-
-
-
-!===========================================================================
-     SUBROUTINE cloudth_vert_v3(ngrid,klev,ind2,  &
-     &           ztv,po,zqta,fraca, & 
-     &           qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
-     &           ratqs,zqs,t)
-
-!===========================================================================
-! Auteur : Arnaud Octavio Jam (LMD/CNRS)
-! Date : 25 Mai 2010
-! Objet : calcule les valeurs de qc et rneb dans les thermiques
-!===========================================================================
-
-
-      USE ioipsl_getin_p_mod, ONLY : getin_p
-      USE phys_output_var_mod, ONLY : cloudth_sth,cloudth_senv, &
-     &                                cloudth_sigmath,cloudth_sigmaenv
-
-      IMPLICIT NONE
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "nuage.h"
-      
-      INTEGER itap,ind1,ind2
-      INTEGER ngrid,klev,klon,l,ig 
-      
-      REAL ztv(ngrid,klev)
-      REAL po(ngrid)
-      REAL zqenv(ngrid)   
-      REAL zqta(ngrid,klev)
-          
-      REAL fraca(ngrid,klev+1)
-      REAL zpspsk(ngrid,klev)
-      REAL paprs(ngrid,klev+1)
-      REAL pplay(ngrid,klev)
-      REAL ztla(ngrid,klev)
-      REAL zthl(ngrid,klev)
-
-      REAL zqsatth(ngrid,klev)
-      REAL zqsatenv(ngrid,klev)
-      
-      REAL sigma1(ngrid,klev)                                                         
-      REAL sigma2(ngrid,klev)
-      REAL qlth(ngrid,klev)
-      REAL qlenv(ngrid,klev)
-      REAL qltot(ngrid,klev) 
-      REAL cth(ngrid,klev)
-      REAL cenv(ngrid,klev)   
-      REAL ctot(ngrid,klev)
-      REAL cth_vol(ngrid,klev)
-      REAL cenv_vol(ngrid,klev)
-      REAL ctot_vol(ngrid,klev)
-      REAL rneb(ngrid,klev)
-      REAL t(ngrid,klev)                                                                  
-      REAL qsatmmussig1,qsatmmussig2,sqrtpi,sqrt2,sqrt2pi,pi
-      REAL rdd,cppd,Lv
-      REAL alth,alenv,ath,aenv
-      REAL sth,senv,sigma1s,sigma2s,sigma1s_fraca,sigma1s_ratqs
-      REAL inverse_rho,beta,a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks
-      REAL xth,xenv,exp_xenv1,exp_xenv2,exp_xth1,exp_xth2
-      REAL xth1,xth2,xenv1,xenv2,deltasth, deltasenv
-      REAL IntJ,IntI1,IntI2,IntI3,IntJ_CF,IntI1_CF,IntI3_CF,coeffqlenv,coeffqlth
-      REAL Tbef,zdelta,qsatbef,zcor
-      REAL qlbef  
-      REAL ratqs(ngrid,klev) ! determine la largeur de distribution de vapeur
-      ! Change the width of the PDF used for vertical subgrid scale heterogeneity
-      ! (J Jouhaud, JL Dufresne, JB Madeleine)
-      REAL,SAVE :: vert_alpha, vert_alpha_th
-      !$OMP THREADPRIVATE(vert_alpha, vert_alpha_th)
-      REAL,SAVE :: sigma1s_factor=1.1
-      REAL,SAVE :: sigma1s_power=0.6
-      REAL,SAVE :: sigma2s_factor=0.09
-      REAL,SAVE :: sigma2s_power=0.5
-      REAL,SAVE :: cloudth_ratqsmin=-1.
-      !$OMP THREADPRIVATE(sigma1s_factor,sigma1s_power,sigma2s_factor,sigma2s_power,cloudth_ratqsmin)
-      INTEGER, SAVE :: iflag_cloudth_vert_noratqs=0
-      !$OMP THREADPRIVATE(iflag_cloudth_vert_noratqs)
-
-      LOGICAL, SAVE :: firstcall = .TRUE.
-      !$OMP THREADPRIVATE(firstcall)
-
-      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
-      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 
-      REAL zqs(ngrid), qcloud(ngrid)
-      REAL erf
-
-      REAL rhodz(ngrid,klev)
-      REAL zrho(ngrid,klev)
-      REAL dz(ngrid,klev)
-
-      DO ind1 = 1, ngrid
-        !Layer calculation
-        rhodz(ind1,ind2) = (paprs(ind1,ind2)-paprs(ind1,ind2+1))/rg !kg/m2
-        zrho(ind1,ind2) = pplay(ind1,ind2)/t(ind1,ind2)/rd !kg/m3
-        dz(ind1,ind2) = rhodz(ind1,ind2)/zrho(ind1,ind2) !m : epaisseur de la couche en metre
-      END DO
-
-!------------------------------------------------------------------------------
-! Initialize
-!------------------------------------------------------------------------------
-
-      sigma1(:,:)=0.
-      sigma2(:,:)=0.
-      qlth(:,:)=0.
-      qlenv(:,:)=0.  
-      qltot(:,:)=0.
-      rneb(:,:)=0.
-      qcloud(:)=0.
-      cth(:,:)=0.
-      cenv(:,:)=0.
-      ctot(:,:)=0.
-      cth_vol(:,:)=0.
-      cenv_vol(:,:)=0.
-      ctot_vol(:,:)=0.
-      qsatmmussig1=0.
-      qsatmmussig2=0.
-      rdd=287.04
-      cppd=1005.7
-      pi=3.14159 
-      Lv=2.5e6
-      sqrt2pi=sqrt(2.*pi)
-      sqrt2=sqrt(2.)
-      sqrtpi=sqrt(pi)
-
-      IF (firstcall) THEN
-        vert_alpha=0.5
-        CALL getin_p('cloudth_vert_alpha',vert_alpha)
-        WRITE(*,*) 'cloudth_vert_alpha = ', vert_alpha
-        ! The factor used for the thermal is equal to that of the environment
-        !   if nothing is explicitly specified in the def file
-        vert_alpha_th=vert_alpha
-        CALL getin_p('cloudth_vert_alpha_th',vert_alpha_th)
-        WRITE(*,*) 'cloudth_vert_alpha_th = ', vert_alpha_th
-        ! Factor used in the calculation of sigma1s
-        CALL getin_p('cloudth_sigma1s_factor',sigma1s_factor)
-        WRITE(*,*) 'cloudth_sigma1s_factor = ', sigma1s_factor
-        ! Power used in the calculation of sigma1s
-        CALL getin_p('cloudth_sigma1s_power',sigma1s_power)
-        WRITE(*,*) 'cloudth_sigma1s_power = ', sigma1s_power
-        ! Factor used in the calculation of sigma2s
-        CALL getin_p('cloudth_sigma2s_factor',sigma2s_factor)
-        WRITE(*,*) 'cloudth_sigma2s_factor = ', sigma2s_factor
-        ! Power used in the calculation of sigma2s
-        CALL getin_p('cloudth_sigma2s_power',sigma2s_power)
-        WRITE(*,*) 'cloudth_sigma2s_power = ', sigma2s_power
-        ! Minimum value for the environmental air subgrid water distrib
-        CALL getin_p('cloudth_ratqsmin',cloudth_ratqsmin)
-        WRITE(*,*) 'cloudth_ratqsmin = ', cloudth_ratqsmin
-        ! Remove the dependency to ratqs from the variance of the vertical PDF
-        CALL getin_p('iflag_cloudth_vert_noratqs',iflag_cloudth_vert_noratqs)
-        WRITE(*,*) 'iflag_cloudth_vert_noratqs = ', iflag_cloudth_vert_noratqs
-
-        firstcall=.FALSE.
-      ENDIF
-
-!-------------------------------------------------------------------------------
-! Calcul de la fraction du thermique et des ecart-types des distributions
-!-------------------------------------------------------------------------------                 
-      do ind1=1,ngrid
-
-      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then !Thermal and environnement
-
-      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2)) !qt = a*qtth + (1-a)*qtenv
-
-
-      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES*FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-
-
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84
-      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84
-
-!zqenv = qt environnement
-!zqsatenv = qsat environnement
-!zthl = Tl environnement
-
-
-      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatth(ind1,ind2)=qsatbef
-            
-      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)       !qsl, p84
-      ath=1./(1.+(alth*Lv/cppd))                                        !al, p84
-      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))                      !s, p84
-      
-      
-!zqta = qt thermals
-!zqsatth = qsat thermals
-!ztla = Tl thermals
-!------------------------------------------------------------------------------
-! s standard deviation
-!------------------------------------------------------------------------------
-
-      sigma1s_fraca = (sigma1s_factor**0.5)*(fraca(ind1,ind2)**sigma1s_power) / &
-     &                (1-fraca(ind1,ind2))*((sth-senv)**2)**0.5
-!     sigma1s_fraca = (1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5
-      IF (cloudth_ratqsmin>0.) THEN
-         sigma1s_ratqs = cloudth_ratqsmin*po(ind1)
-      ELSE
-         sigma1s_ratqs = ratqs(ind1,ind2)*po(ind1)
-      ENDIF
-      sigma1s = sigma1s_fraca + sigma1s_ratqs
-      sigma2s=(sigma2s_factor*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**sigma2s_power))+0.002*zqta(ind1,ind2)
-!      tests
-!      sigma1s=(0.92**0.5)*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
-!      sigma1s=(0.92*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5))+0.002*zqenv(ind1)
-!      sigma2s=0.09*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.5+0.002*zqta(ind1,ind2) 
-!      sigma2s=(0.09*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**0.5))+ratqs(ind1,ind2)*zqta(ind1,ind2)
-!       if (paprs(ind1,ind2).gt.90000) then
-!       ratqs(ind1,ind2)=0.002
-!       else 
-!       ratqs(ind1,ind2)=0.002+0.0*(90000-paprs(ind1,ind2))/20000
-!       endif
-!       sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
-!       sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2) 
-!       sigma1s=ratqs(ind1,ind2)*po(ind1)
-!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.00003  
- 
-       IF (iflag_cloudth_vert == 1) THEN
-!-------------------------------------------------------------------------------
-!  Version 2: Modification from Arnaud Jam according to JL Dufrense. Condensate from qsat-ratqs
-!-------------------------------------------------------------------------------
-
-      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
-      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
-
-      xenv1=(senv-deltasenv)/(sqrt(2.)*sigma1s)
-      xenv2=(senv+deltasenv)/(sqrt(2.)*sigma1s)
-      xth1=(sth-deltasth)/(sqrt(2.)*sigma2s)
-      xth2=(sth+deltasth)/(sqrt(2.)*sigma2s)
-      coeffqlenv=(sigma1s)**2/(2*sqrtpi*deltasenv)
-      coeffqlth=(sigma2s)**2/(2*sqrtpi*deltasth)
-      
-      cth(ind1,ind2)=0.5*(1.+1.*erf(xth2))
-      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv2)) 
-      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
-
-      ! Environment
-      IntJ=sigma1s*(exp(-1.*xenv1**2)/sqrt2pi)+0.5*senv*(1+erf(xenv1))
-      IntI1=coeffqlenv*0.5*(0.5*sqrtpi*(erf(xenv2)-erf(xenv1))+xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
-      IntI2=coeffqlenv*xenv2*(exp(-1.*xenv2**2)-exp(-1.*xenv1**2))
-      IntI3=coeffqlenv*0.5*sqrtpi*xenv2**2*(erf(xenv2)-erf(xenv1))
-
-      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-
-      ! Thermal
-      IntJ=sigma2s*(exp(-1.*xth1**2)/sqrt2pi)+0.5*sth*(1+erf(xth1))
-      IntI1=coeffqlth*0.5*(0.5*sqrtpi*(erf(xth2)-erf(xth1))+xth1*exp(-1.*xth1**2)-xth2*exp(-1.*xth2**2))
-      IntI2=coeffqlth*xth2*(exp(-1.*xth2**2)-exp(-1.*xth1**2))
-      IntI3=coeffqlth*0.5*sqrtpi*xth2**2*(erf(xth2)-erf(xth1))
-      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-
-      ELSE IF (iflag_cloudth_vert >= 3) THEN
-      IF (iflag_cloudth_vert < 5) THEN
-!-------------------------------------------------------------------------------
-!  Version 3: Changes by J. Jouhaud; condensation for q > -delta s
-!-------------------------------------------------------------------------------
-!      deltasenv=aenv*ratqs(ind1,ind2)*po(ind1)
-!      deltasth=ath*ratqs(ind1,ind2)*zqta(ind1,ind2)
-!      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
-!      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
-      IF (iflag_cloudth_vert == 3) THEN
-        deltasenv=aenv*vert_alpha*sigma1s
-        deltasth=ath*vert_alpha_th*sigma2s
-      ELSE IF (iflag_cloudth_vert == 4) THEN
-        IF (iflag_cloudth_vert_noratqs == 1) THEN
-          deltasenv=vert_alpha*max(sigma1s_fraca,1e-10)
-          deltasth=vert_alpha_th*sigma2s
-        ELSE
-          deltasenv=vert_alpha*sigma1s
-          deltasth=vert_alpha_th*sigma2s
-        ENDIF
-      ENDIF
-      
-      xenv1=-(senv+deltasenv)/(sqrt(2.)*sigma1s)
-      xenv2=-(senv-deltasenv)/(sqrt(2.)*sigma1s)
-      exp_xenv1 = exp(-1.*xenv1**2)
-      exp_xenv2 = exp(-1.*xenv2**2)
-      xth1=-(sth+deltasth)/(sqrt(2.)*sigma2s)
-      xth2=-(sth-deltasth)/(sqrt(2.)*sigma2s)
-      exp_xth1 = exp(-1.*xth1**2)
-      exp_xth2 = exp(-1.*xth2**2)
-      
-      !CF_surfacique
-      cth(ind1,ind2)=0.5*(1.-1.*erf(xth1))
-      cenv(ind1,ind2)=0.5*(1.-1.*erf(xenv1))
-      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2) 
-
-
-      !CF_volumique & eau condense
-      !environnement
-      IntJ=0.5*senv*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp_xenv2
-      IntJ_CF=0.5*(1.-1.*erf(xenv2))
-      if (deltasenv .lt. 1.e-10) then 
-      qlenv(ind1,ind2)=IntJ
-      cenv_vol(ind1,ind2)=IntJ_CF
-      else
-      IntI1=(((senv+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
-      IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp_xenv1-xenv2*exp_xenv2)
-      IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp_xenv1-exp_xenv2)
-      IntI1_CF=((senv+deltasenv)*(erf(xenv2)-erf(xenv1)))/(4*deltasenv)
-      IntI3_CF=(sqrt2*sigma1s*(exp_xenv1-exp_xenv2))/(4*sqrtpi*deltasenv)
-      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-      cenv_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
-      endif
-
-      !thermique
-      IntJ=0.5*sth*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
-      IntJ_CF=0.5*(1.-1.*erf(xth2))
-      if (deltasth .lt. 1.e-10) then
-      qlth(ind1,ind2)=IntJ
-      cth_vol(ind1,ind2)=IntJ_CF
-      else
-      IntI1=(((sth+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
-      IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
-      IntI3=((sqrt2*sigma2s*(sth+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
-      IntI1_CF=((sth+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
-      IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
-      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-      cth_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
-      endif
-
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-      ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
-
-      ELSE IF (iflag_cloudth_vert == 5) THEN
-         sigma1s=(0.71794+0.000498239*dz(ind1,ind2))*(fraca(ind1,ind2)**0.5) &
-              /(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5) &
-              +ratqs(ind1,ind2)*po(ind1) !Environment
-      sigma2s=(0.03218+0.000092655*dz(ind1,ind2))/((fraca(ind1,ind2)+0.02)**0.5)*(((sth-senv)**2)**0.5)+0.002*zqta(ind1,ind2)                   !Thermals
-      !sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
-      !sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2) 
-      xth=sth/(sqrt(2.)*sigma2s)
-      xenv=senv/(sqrt(2.)*sigma1s)
-
-      !Volumique
-      cth_vol(ind1,ind2)=0.5*(1.+1.*erf(xth))
-      cenv_vol(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-      ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
-      !print *,'jeanjean_CV=',ctot_vol(ind1,ind2)
-
-      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt(2.)*cth_vol(ind1,ind2))
-      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv_vol(ind1,ind2))  
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-
-      !Surfacique
-      !Neggers
-      !beta=0.0044
-      !inverse_rho=1.+beta*dz(ind1,ind2)
-      !print *,'jeanjean : beta=',beta
-      !cth(ind1,ind2)=cth_vol(ind1,ind2)*inverse_rho
-      !cenv(ind1,ind2)=cenv_vol(ind1,ind2)*inverse_rho
-      !ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
-
-      !Brooks
-      a_Brooks=0.6694
-      b_Brooks=0.1882
-      A_Maj_Brooks=0.1635 !-- sans shear
-      !A_Maj_Brooks=0.17   !-- ARM LES
-      !A_Maj_Brooks=0.18   !-- RICO LES
-      !A_Maj_Brooks=0.19   !-- BOMEX LES
-      Dx_Brooks=200000.
-      f_Brooks=A_Maj_Brooks*(dz(ind1,ind2)**(a_Brooks))*(Dx_Brooks**(-b_Brooks))
-      !print *,'jeanjean_f=',f_Brooks
-
-      cth(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(cth_vol(ind1,ind2),1.)))- 1.))
-      cenv(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(cenv_vol(ind1,ind2),1.)))- 1.))
-      ctot(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(ctot_vol(ind1,ind2),1.)))- 1.))
-      !print *,'JJ_ctot_1',ctot(ind1,ind2)
-
-
-
-
-
-      ENDIF ! of if (iflag_cloudth_vert<5)
-      ENDIF ! of if (iflag_cloudth_vert==1 or 3 or 4)
-
-!      if (ctot(ind1,ind2).lt.1.e-10) then
-      if (cenv(ind1,ind2).lt.1.e-10.or.cth(ind1,ind2).lt.1.e-10) then
-      ctot(ind1,ind2)=0.
-      ctot_vol(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2)
-
-      else
-                
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
-!      qcloud(ind1)=fraca(ind1,ind2)*qlth(ind1,ind2)/cth(ind1,ind2) &
-!    &             +(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)/cenv(ind1,ind2)+zqs(ind1) 
-
-      endif  
-
-      else  ! gaussienne environnement seule
-      
-
-      zqenv(ind1)=po(ind1)
-      Tbef=t(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-      
-
-!      qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
-      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)
-      aenv=1./(1.+(alenv*Lv/cppd))
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))
-      sth=0.
-      
-
-      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
-      sigma2s=0.
-
-      sqrt2pi=sqrt(2.*pi)
-      xenv=senv/(sqrt(2.)*sigma1s)
-      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-      ctot_vol(ind1,ind2)=ctot(ind1,ind2)
-      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
-      
-      if (ctot(ind1,ind2).lt.1.e-3) then
-      ctot(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2)
-
-      else   
-                
-!      ctot(ind1,ind2)=ctot(ind1,ind2) 
-      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
-
-      endif  
- 
-
-
-
-      endif       ! From the separation (thermal/envrionnement) et (environnement) only, l.335 et l.492
-      ! Outputs used to check the PDFs
-      cloudth_senv(ind1,ind2) = senv
-      cloudth_sth(ind1,ind2) = sth
-      cloudth_sigmaenv(ind1,ind2) = sigma1s
-      cloudth_sigmath(ind1,ind2) = sigma2s
-
-      enddo       ! from the loop on ngrid l.333
-      return
-!     end
-END SUBROUTINE cloudth_vert_v3
-!
-
-
-
-
-
-
-
-
-
-
-
-       SUBROUTINE cloudth_v6(ngrid,klev,ind2,  &
-     &           ztv,po,zqta,fraca, & 
-     &           qcloud,ctot_surf,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
-     &           ratqs,zqs,T)
-
-
-      USE ioipsl_getin_p_mod, ONLY : getin_p
-      USE phys_output_var_mod, ONLY : cloudth_sth,cloudth_senv, &
-     &                                cloudth_sigmath,cloudth_sigmaenv
-
-      IMPLICIT NONE
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "nuage.h"
-
-
-        !Domain variables
-      INTEGER ngrid !indice Max lat-lon
-      INTEGER klev  !indice Max alt
-      INTEGER ind1  !indice in [1:ngrid]
-      INTEGER ind2  !indice in [1:klev]
-        !thermal plume fraction
-      REAL fraca(ngrid,klev+1)   !thermal plumes fraction in the gridbox
-        !temperatures
-      REAL T(ngrid,klev)       !temperature
-      REAL zpspsk(ngrid,klev)  !factor (p/p0)**kappa (used for potential variables)
-      REAL ztv(ngrid,klev)     !potential temperature (voir thermcell_env.F90)
-      REAL ztla(ngrid,klev)    !liquid temperature in the thermals (Tl_th)
-      REAL zthl(ngrid,klev)    !liquid temperature in the environment (Tl_env)
-        !pressure
-      REAL paprs(ngrid,klev+1)   !pressure at the interface of levels
-      REAL pplay(ngrid,klev)     !pressure at the middle of the level
-        !humidity
-      REAL ratqs(ngrid,klev)   !width of the total water subgrid-scale distribution
-      REAL po(ngrid)           !total water (qt)
-      REAL zqenv(ngrid)        !total water in the environment (qt_env)
-      REAL zqta(ngrid,klev)    !total water in the thermals (qt_th)
-      REAL zqsatth(ngrid,klev)   !water saturation level in the thermals (q_sat_th)
-      REAL zqsatenv(ngrid,klev)  !water saturation level in the environment (q_sat_env)
-      REAL qlth(ngrid,klev)    !condensed water in the thermals
-      REAL qlenv(ngrid,klev)   !condensed water in the environment
-      REAL qltot(ngrid,klev)   !condensed water in the gridbox
-        !cloud fractions
-      REAL cth_vol(ngrid,klev)   !cloud fraction by volume in the thermals
-      REAL cenv_vol(ngrid,klev)  !cloud fraction by volume in the environment
-      REAL ctot_vol(ngrid,klev)  !cloud fraction by volume in the gridbox
-      REAL cth_surf(ngrid,klev)  !cloud fraction by surface in the thermals
-      REAL cenv_surf(ngrid,klev) !cloud fraction by surface in the environment  
-      REAL ctot_surf(ngrid,klev) !cloud fraction by surface in the gridbox
-        !PDF of saturation deficit variables
-      REAL rdd,cppd,Lv
-      REAL Tbef,zdelta,qsatbef,zcor
-      REAL alth,alenv,ath,aenv
-      REAL sth,senv              !saturation deficits in the thermals and environment
-      REAL sigma_env,sigma_th    !standard deviations of the biGaussian PDF
-        !cloud fraction variables
-      REAL xth,xenv
-      REAL inverse_rho,beta                                  !Neggers et al. (2011) method
-      REAL a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks !Brooks et al. (2005) method
-        !Incloud total water variables
-      REAL zqs(ngrid)    !q_sat
-      REAL qcloud(ngrid) !eau totale dans le nuage
-        !Some arithmetic variables
-      REAL erf,pi,sqrt2,sqrt2pi
-        !Depth of the layer
-      REAL dz(ngrid,klev)    !epaisseur de la couche en metre
-      REAL rhodz(ngrid,klev)
-      REAL zrho(ngrid,klev)
-      DO ind1 = 1, ngrid
-        rhodz(ind1,ind2) = (paprs(ind1,ind2)-paprs(ind1,ind2+1))/rg ![kg/m2]
-        zrho(ind1,ind2) = pplay(ind1,ind2)/T(ind1,ind2)/rd          ![kg/m3]
-        dz(ind1,ind2) = rhodz(ind1,ind2)/zrho(ind1,ind2)            ![m]
-      END DO
-
-!------------------------------------------------------------------------------
-! Initialization
-!------------------------------------------------------------------------------
-      qlth(:,:)=0.
-      qlenv(:,:)=0.  
-      qltot(:,:)=0.
-      cth_vol(:,:)=0.
-      cenv_vol(:,:)=0.
-      ctot_vol(:,:)=0.
-      cth_surf(:,:)=0.
-      cenv_surf(:,:)=0.
-      ctot_surf(:,:)=0.
-      qcloud(:)=0.
-      rdd=287.04
-      cppd=1005.7
-      pi=3.14159 
-      Lv=2.5e6
-      sqrt2=sqrt(2.)
-      sqrt2pi=sqrt(2.*pi)
-
-
-      DO ind1=1,ngrid
-!-------------------------------------------------------------------------------
-!Both thermal and environment in the gridbox
-!-------------------------------------------------------------------------------
-      IF ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) THEN
-        !--------------------------------------------
-        !calcul de qsat_env
-        !--------------------------------------------
-      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES*FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-        !--------------------------------------------
-        !calcul de s_env
-        !--------------------------------------------
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84 these Arnaud Jam
-      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84 these Arnaud Jam
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84 these Arnaud Jam
-        !--------------------------------------------
-        !calcul de qsat_th
-        !--------------------------------------------
-      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatth(ind1,ind2)=qsatbef
-        !--------------------------------------------
-        !calcul de s_th  
-        !--------------------------------------------
-      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)       !qsl, p84 these Arnaud Jam
-      ath=1./(1.+(alth*Lv/cppd))                                        !al, p84 these Arnaud Jam
-      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))                      !s, p84 these Arnaud Jam
-        !--------------------------------------------
-        !calcul standard deviations bi-Gaussian PDF
-        !--------------------------------------------
-      sigma_th=(0.03218+0.000092655*dz(ind1,ind2))/((fraca(ind1,ind2)+0.01)**0.5)*(((sth-senv)**2)**0.5)+0.002*zqta(ind1,ind2)
-      sigma_env=(0.71794+0.000498239*dz(ind1,ind2))*(fraca(ind1,ind2)**0.5) &
-           /(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5) &
-           +ratqs(ind1,ind2)*po(ind1)
-      xth=sth/(sqrt2*sigma_th)
-      xenv=senv/(sqrt2*sigma_env)
-        !--------------------------------------------
-        !Cloud fraction by volume CF_vol
-        !--------------------------------------------
-      cth_vol(ind1,ind2)=0.5*(1.+1.*erf(xth))
-      cenv_vol(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-      ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
-        !-------------------------------------------- 
-        !Condensed water qc
-        !--------------------------------------------
-      qlth(ind1,ind2)=sigma_th*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt2*cth_vol(ind1,ind2))
-      qlenv(ind1,ind2)=sigma_env*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*cenv_vol(ind1,ind2))  
-      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
-        !--------------------------------------------
-        !Cloud fraction by surface CF_surf
-        !--------------------------------------------
-        !Method Neggers et al. (2011) : ok for cumulus clouds only
-      !beta=0.0044 (Jouhaud et al.2018)
-      !inverse_rho=1.+beta*dz(ind1,ind2)
-      !ctot_surf(ind1,ind2)=ctot_vol(ind1,ind2)*inverse_rho
-        !Method Brooks et al. (2005) : ok for all types of clouds
-      a_Brooks=0.6694
-      b_Brooks=0.1882
-      A_Maj_Brooks=0.1635 !-- sans dependence au cisaillement de vent
-      Dx_Brooks=200000.   !-- si l'on considere des mailles de 200km de cote
-      f_Brooks=A_Maj_Brooks*(dz(ind1,ind2)**(a_Brooks))*(Dx_Brooks**(-b_Brooks))
-      ctot_surf(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(ctot_vol(ind1,ind2),1.)))- 1.))
-        !--------------------------------------------
-        !Incloud Condensed water qcloud
-        !--------------------------------------------
-      if (ctot_surf(ind1,ind2) .lt. 1.e-10) then
-      ctot_vol(ind1,ind2)=0.
-      ctot_surf(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2)
-      else
-      qcloud(ind1)=qltot(ind1,ind2)/ctot_vol(ind1,ind2)+zqs(ind1)
-      endif
-
-
-
-!-------------------------------------------------------------------------------
-!Environment only in the gridbox
-!-------------------------------------------------------------------------------
-      ELSE
-        !--------------------------------------------
-        !calcul de qsat_env
-        !--------------------------------------------
-      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
-      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
-      qsatbef=MIN(0.5,qsatbef)
-      zcor=1./(1.-retv*qsatbef)
-      qsatbef=qsatbef*zcor
-      zqsatenv(ind1,ind2)=qsatbef
-        !--------------------------------------------
-        !calcul de s_env
-        !--------------------------------------------
-      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84 these Arnaud Jam
-      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84 these Arnaud Jam
-      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84 these Arnaud Jam 
-        !--------------------------------------------
-        !calcul standard deviations Gaussian PDF
-        !--------------------------------------------
-      zqenv(ind1)=po(ind1)
-      sigma_env=ratqs(ind1,ind2)*zqenv(ind1)
-      xenv=senv/(sqrt2*sigma_env)
-        !--------------------------------------------
-        !Cloud fraction by volume CF_vol
-        !--------------------------------------------
-      ctot_vol(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-        !--------------------------------------------
-        !Condensed water qc
-        !--------------------------------------------
-      qltot(ind1,ind2)=sigma_env*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*ctot_vol(ind1,ind2))
-        !--------------------------------------------
-        !Cloud fraction by surface CF_surf
-        !--------------------------------------------
-        !Method Neggers et al. (2011) : ok for cumulus clouds only
-      !beta=0.0044 (Jouhaud et al.2018)
-      !inverse_rho=1.+beta*dz(ind1,ind2)
-      !ctot_surf(ind1,ind2)=ctot_vol(ind1,ind2)*inverse_rho
-        !Method Brooks et al. (2005) : ok for all types of clouds
-      a_Brooks=0.6694
-      b_Brooks=0.1882
-      A_Maj_Brooks=0.1635 !-- sans dependence au shear
-      Dx_Brooks=200000.
-      f_Brooks=A_Maj_Brooks*(dz(ind1,ind2)**(a_Brooks))*(Dx_Brooks**(-b_Brooks))
-      ctot_surf(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(ctot_vol(ind1,ind2),1.)))- 1.))
-        !--------------------------------------------
-        !Incloud Condensed water qcloud
-        !--------------------------------------------
-      if (ctot_surf(ind1,ind2) .lt. 1.e-8) then
-      ctot_vol(ind1,ind2)=0.
-      ctot_surf(ind1,ind2)=0.
-      qcloud(ind1)=zqsatenv(ind1,ind2)
-      else
-      qcloud(ind1)=qltot(ind1,ind2)/ctot_vol(ind1,ind2)+zqsatenv(ind1,ind2)
-      endif
-
-
-      END IF  ! From the separation (thermal/envrionnement) et (environnement only)
-
-      ! Outputs used to check the PDFs
-      cloudth_senv(ind1,ind2) = senv
-      cloudth_sth(ind1,ind2) = sth
-      cloudth_sigmaenv(ind1,ind2) = sigma_env
-      cloudth_sigmath(ind1,ind2) = sigma_th
-
-      END DO  ! From the loop on ngrid
-      return
-
-END SUBROUTINE cloudth_v6
-
-
-
-
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-SUBROUTINE cloudth_mpc(klon,klev,ind2,iflag_mpc_bl,mpc_bl_points,           &
-&           temp,ztv,po,zqta,fraca,zpspsk,paprs,pplay,ztla,zthl,            &
-&           ratqs,zqs,snowflux,qcloud,qincloud,icefrac,ctot,ctot_vol)
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-! Author : Arnaud Octavio Jam (LMD/CNRS), Etienne Vignon (LMDZ/CNRS)
-! Date: Adapted from cloudth_vert_v3 in 2021
-! Aim : computes qc and rneb in thermals with cold microphysical considerations
-!       + for mixed phase boundary layer clouds, calculate ql and qi from 
-!       a stationary MPC model
-! IMPORTANT NOTE: we assume iflag_clouth_vert=3
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-
-      USE ioipsl_getin_p_mod, ONLY : getin_p
-      USE phys_output_var_mod, ONLY : cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
-      USE lscp_tools_mod, ONLY: CALC_QSAT_ECMWF, FALLICE_VELOCITY
-      USE phys_local_var_mod, ONLY : qlth, qith, qsith, wiceth
-
-      IMPLICIT NONE
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "nuage.h"
-      
-
-!------------------------------------------------------------------------------
-! Declaration
-!------------------------------------------------------------------------------
-
-! INPUT/OUTPUT
-
-      INTEGER, INTENT(IN)                         :: klon,klev,ind2
-      
-
-      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  temp          ! Temperature [K]
-      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  ztv           ! Virtual potential temp [K]
-      REAL, DIMENSION(klon),      INTENT(IN)      ::  po            ! specific humidity [kg/kg]
-      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  zqta          ! specific humidity within thermals [kg/kg]
-      REAL, DIMENSION(klon,klev+1), INTENT(IN)    ::  fraca         ! Fraction of the mesh covered by thermals [0-1] 
-      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  zpspsk
-      REAL, DIMENSION(klon,klev+1), INTENT(IN)    ::  paprs         ! Pressure at layer interfaces [Pa]
-      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  pplay         ! Pressure at the center of layers [Pa]
-      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  ztla          ! Liquid temp [K]
-      REAL, DIMENSION(klon,klev), INTENT(INOUT)      ::  zthl       ! Liquid potential temp [K]
-      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  ratqs         ! Parameter that determines the width of the total water distrib.
-      REAL, DIMENSION(klon),      INTENT(IN)      ::  zqs           ! Saturation specific humidity in the mesh [kg/kg]
-      REAL, DIMENSION(klon,klev+1), INTENT(IN)    ::  snowflux      ! snow flux at the interface of the layer [kg/m2/s]
-      INTEGER,                      INTENT(IN)    ::  iflag_mpc_bl  ! option flag for mpc boundary layer clouds param.
-
-
-      INTEGER, DIMENSION(klon,klev), INTENT(INOUT) :: mpc_bl_points  ! grid points with convective (thermals) mixed phase clouds
-      
-      REAL, DIMENSION(klon,klev), INTENT(OUT)      ::  ctot         ! Cloud fraction [0-1]
-      REAL, DIMENSION(klon,klev), INTENT(OUT)      ::  ctot_vol     ! Volume cloud fraction [0-1]
-      REAL, DIMENSION(klon),      INTENT(OUT)      ::  qcloud       ! In cloud total water content [kg/kg] 
-      REAL, DIMENSION(klon),      INTENT(OUT)      ::  qincloud       ! In cloud condensed water content [kg/kg] 
-      REAL, DIMENSION(klon,klev), INTENT(OUT)      ::  icefrac      ! Fraction of ice in clouds [0-1]
-
-
-! LOCAL VARIABLES
-
-      INTEGER itap,ind1,l,ig,iter,k 
-      INTEGER iflag_topthermals, niter
-      LOGICAL falseklon(klon)
-
-      REAL zqsatth(klon), zqsatenv(klon), zqsatenvonly(klon)
-      REAL sigma1(klon,klev)                                                         
-      REAL sigma2(klon,klev)
-      REAL qcth(klon,klev)
-      REAL qcenv(klon,klev)
-      REAL qctot(klon,klev) 
-      REAL cth(klon,klev)
-      REAL cenv(klon,klev)   
-      REAL cth_vol(klon,klev)
-      REAL cenv_vol(klon,klev)
-      REAL rneb(klon,klev)
-      REAL zqenv(klon), zqth(klon), zqenvonly(klon) 
-      REAL qsatmmussig1,qsatmmussig2,sqrtpi,sqrt2,sqrt2pi,pi
-      REAL rdd,cppd,Lv
-      REAL alth,alenv,ath,aenv
-      REAL sth,senv,sigma1s,sigma2s,sigma1s_fraca,sigma1s_ratqs
-      REAL inverse_rho,beta,a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks
-      REAL xth,xenv,exp_xenv1,exp_xenv2,exp_xth1,exp_xth2
-      REAL xth1,xth2,xenv1,xenv2,deltasth, deltasenv
-      REAL IntJ,IntI1,IntI2,IntI3,IntJ_CF,IntI1_CF,IntI3_CF,coeffqlenv,coeffqlth
-      REAL zdelta,qsatbef,zcor
-      REAL Tbefth(klon), Tbefenv(klon), Tbefenvonly(klon), rhoth(klon)
-      REAL qlbef
-      REAL dqsatenv(klon), dqsatth(klon), dqsatenvonly(klon)
-      REAL erf
-      REAL zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
-      REAL zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon) 
-      REAL rhodz(klon,klev)
-      REAL zrho(klon,klev)
-      REAL dz(klon,klev)
-      REAL qslenv(klon), qslth(klon) 
-      REAL alenvl, aenvl
-      REAL sthi, sthl, sthil, althl, athl, althi, athi, sthlc, deltasthc, sigma2sc
-      REAL senvi, senvl, qbase, sbase, qliqth, qiceth
-      REAL qmax, ttarget, stmp, cout, coutref, fraci
-      REAL maxi, mini, pas, temp_lim
-      REAL deltazlev_mpc(klev), temp_mpc(klev), pres_mpc(klev), fraca_mpc(klev+1), snowf_mpc(klev+1)
-
-      ! Modifty the saturation deficit PDF in thermals 
-      ! in the presence of ice crystals
-      REAL,SAVE :: C_mpc
-      !$OMP THREADPRIVATE(C_mpc)
-      REAL, SAVE    :: Ni,C_cap,Ei,d_top
-      !$OMP THREADPRIVATE(Ni,C_cap,Ei,d_top)
-      ! Change the width of the PDF used for vertical subgrid scale heterogeneity
-      ! (J Jouhaud, JL Dufresne, JB Madeleine)
-      REAL,SAVE :: vert_alpha, vert_alpha_th
-      !$OMP THREADPRIVATE(vert_alpha, vert_alpha_th)
-      REAL,SAVE :: sigma1s_factor=1.1
-      REAL,SAVE :: sigma1s_power=0.6
-      REAL,SAVE :: sigma2s_factor=0.09
-      REAL,SAVE :: sigma2s_power=0.5
-      REAL,SAVE :: cloudth_ratqsmin=-1.
-      !$OMP THREADPRIVATE(sigma1s_factor,sigma1s_power,sigma2s_factor,sigma2s_power,cloudth_ratqsmin)
-      INTEGER, SAVE :: iflag_cloudth_vert_noratqs=0
-      !$OMP THREADPRIVATE(iflag_cloudth_vert_noratqs)
-      LOGICAL, SAVE :: firstcall = .TRUE.
-      !$OMP THREADPRIVATE(firstcall)
-
-      CHARACTER (len = 80) :: abort_message
-      CHARACTER (len = 20) :: routname = 'cloudth_mpc'
-
-
-!------------------------------------------------------------------------------
-! Initialisation
-!------------------------------------------------------------------------------
-
-
-! Few initial checksS
-
-      IF (iflag_cloudth_vert.NE.3) THEN
-         abort_message = 'clouth_mpc cannot be used if iflag_cloudth_vert .NE. 3'
-         CALL abort_physic(routname,abort_message,1)
-      ENDIF
-
-      DO k = 1,klev
-      DO ind1 = 1, klon
-        rhodz(ind1,k) = (paprs(ind1,k)-paprs(ind1,k+1))/rg !kg/m2
-        zrho(ind1,k) = pplay(ind1,k)/temp(ind1,k)/rd !kg/m3
-        dz(ind1,k) = rhodz(ind1,k)/zrho(ind1,k) !m : epaisseur de la couche en metre
-      END DO
-      END DO
-
-
-      sigma1(:,:)=0.
-      sigma2(:,:)=0.
-      qcth(:,:)=0.
-      qcenv(:,:)=0.  
-      qctot(:,:)=0.
-      qlth(:,ind2)=0.
-      qith(:,ind2)=0.
-      wiceth(:,ind2)=0.
-      rneb(:,:)=0.
-      qcloud(:)=0.
-      cth(:,:)=0.
-      cenv(:,:)=0.
-      ctot(:,:)=0.
-      cth_vol(:,:)=0.
-      cenv_vol(:,:)=0.
-      ctot_vol(:,:)=0.
-      falseklon(:)=.false.
-      qsatmmussig1=0.
-      qsatmmussig2=0.
-      rdd=287.04
-      cppd=1005.7
-      pi=3.14159 
-      sqrt2pi=sqrt(2.*pi)
-      sqrt2=sqrt(2.)
-      sqrtpi=sqrt(pi)
-      icefrac(:,ind2)=0.
-      althl=0.
-      althi=0.
-      athl=0.
-      athi=0.
-      senvl=0.
-      senvi=0.
-      sthi=0.
-      sthl=0.
-      sthil=0.
-
-
-
-      IF (firstcall) THEN
-
-        vert_alpha=0.5
-        CALL getin_p('cloudth_vert_alpha',vert_alpha)
-        WRITE(*,*) 'cloudth_vert_alpha = ', vert_alpha
-        ! The factor used for the thermal is equal to that of the environment
-        !   if nothing is explicitly specified in the def file
-        vert_alpha_th=vert_alpha
-        CALL getin_p('cloudth_vert_alpha_th',vert_alpha_th)
-        WRITE(*,*) 'cloudth_vert_alpha_th = ', vert_alpha_th
-        ! Factor used in the calculation of sigma1s
-        CALL getin_p('cloudth_sigma1s_factor',sigma1s_factor)
-        WRITE(*,*) 'cloudth_sigma1s_factor = ', sigma1s_factor
-        ! Power used in the calculation of sigma1s
-        CALL getin_p('cloudth_sigma1s_power',sigma1s_power)
-        WRITE(*,*) 'cloudth_sigma1s_power = ', sigma1s_power
-        ! Factor used in the calculation of sigma2s
-        CALL getin_p('cloudth_sigma2s_factor',sigma2s_factor)
-        WRITE(*,*) 'cloudth_sigma2s_factor = ', sigma2s_factor
-        ! Power used in the calculation of sigma2s
-        CALL getin_p('cloudth_sigma2s_power',sigma2s_power)
-        WRITE(*,*) 'cloudth_sigma2s_power = ', sigma2s_power
-        ! Minimum value for the environmental air subgrid water distrib
-        CALL getin_p('cloudth_ratqsmin',cloudth_ratqsmin)
-        WRITE(*,*) 'cloudth_ratqsmin = ', cloudth_ratqsmin
-        ! Remove the dependency to ratqs from the variance of the vertical PDF
-        CALL getin_p('iflag_cloudth_vert_noratqs',iflag_cloudth_vert_noratqs)
-        WRITE(*,*) 'iflag_cloudth_vert_noratqs = ', iflag_cloudth_vert_noratqs
-        ! Modifies the PDF in thermals when ice crystals are present
-        C_mpc=1.e4
-        CALL getin_p('C_mpc',C_mpc)
-        WRITE(*,*) 'C_mpc = ', C_mpc
-        Ni=2.0e3
-        CALL getin_p('Ni', Ni)
-        WRITE(*,*) 'Ni = ', Ni
-        Ei=0.5
-        CALL getin_p('Ei', Ei)
-        WRITE(*,*) 'Ei = ', Ei
-        C_cap=0.5
-        CALL getin_p('C_cap', C_cap)
-        WRITE(*,*) 'C_cap = ', C_cap
-        d_top=1.2
-        CALL getin_p('d_top', d_top)
-        WRITE(*,*) 'd_top = ', d_top
-
-        firstcall=.FALSE.
-
-      ENDIF
-
-
-
-!-------------------------------------------------------------------------------
-! Identify grid points with potential mixed-phase conditions
-!-------------------------------------------------------------------------------
-
-      temp_lim=RTT-40.0
-
-      DO ind1=1,klon
-            IF ((temp(ind1,ind2) .LT. RTT) .AND. (temp(ind1,ind2) .GT. temp_lim) &
-            .AND. (iflag_mpc_bl .GE. 1) .AND. (ind2<=klev-2)  &
-            .AND. (ztv(ind1,1).GT.ztv(ind1,2)) .AND.(fraca(ind1,ind2).GT.1.e-10)) THEN
-                mpc_bl_points(ind1,ind2)=1
-            ELSE
-                mpc_bl_points(ind1,ind2)=0
-            ENDIF
-      ENDDO
-
-
-!-------------------------------------------------------------------------------
-! Thermal fraction calculation and standard deviation of the distribution
-!-------------------------------------------------------------------------------  
-
-! calculation of temperature, humidity and saturation specific humidity
-
-Tbefenv(:)=zthl(:,ind2)*zpspsk(:,ind2)
-Tbefth(:)=ztla(:,ind2)*zpspsk(:,ind2)
-Tbefenvonly(:)=temp(:,ind2)
-rhoth(:)=paprs(:,ind2)/Tbefth(:)/RD
-
-zqenv(:)=(po(:)-fraca(:,ind2)*zqta(:,ind2))/(1.-fraca(:,ind2)) !qt = a*qtth + (1-a)*qtenv 
-zqth(:)=zqta(:,ind2)
-zqenvonly(:)=po(:)
-
-
-CALL CALC_QSAT_ECMWF(klon,Tbefenvonly,zqenvonly,paprs(:,ind2),RTT,0,.false.,zqsatenvonly,dqsatenv)
-
-CALL CALC_QSAT_ECMWF(klon,Tbefenv,zqenv,paprs(:,ind2),RTT,0,.false.,zqsatenv,dqsatenv)
-CALL CALC_QSAT_ECMWF(klon,Tbefenv,zqenv,paprs(:,ind2),RTT,1,.false.,qslenv,dqsatenv)
-
-CALL CALC_QSAT_ECMWF(klon,Tbefth,zqth,paprs(:,ind2),RTT,1,.false.,qslth,dqsatth)
-CALL CALC_QSAT_ECMWF(klon,Tbefth,zqth,paprs(:,ind2),RTT,2,.false.,qsith(:,ind2),dqsatth)
-CALL CALC_QSAT_ECMWF(klon,Tbefth,zqth,paprs(:,ind2),RTT,0,.false.,zqsatth,dqsatth)
-
-
-  DO ind1=1,klon
-
-
-    IF ((ztv(ind1,1).GT.ztv(ind1,2)).AND.(fraca(ind1,ind2).GT.1.e-10)) THEN !Thermal and environnement
-
-
-! Environment:
-
-
-        IF (Tbefenv(ind1) .GE. RTT) THEN
-               Lv=RLVTT
-        ELSE
-               Lv=RLSTT
-        ENDIF
-        
-
-        alenv=(0.622*Lv*zqsatenv(ind1))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84
-        aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84
-        senv=aenv*(po(ind1)-zqsatenv(ind1))                          !s, p84
-     
-        ! For MPCs:
-        IF (mpc_bl_points(ind1,ind2) .EQ. 1) THEN
-        alenvl=(0.622*RLVTT*qslenv(ind1))/(rdd*zthl(ind1,ind2)**2)     
-        aenvl=1./(1.+(alenv*Lv/cppd))         
-        senvl=aenvl*(po(ind1)-qslenv(ind1))    
-        senvi=senv
-        ENDIF
-
-
-! Thermals:
-
-
-        IF (Tbefth(ind1) .GE. RTT) THEN
-            Lv=RLVTT
-        ELSE
-            Lv=RLSTT
-        ENDIF
-
-        
-        alth=(0.622*Lv*zqsatth(ind1))/(rdd*ztla(ind1,ind2)**2)       
-        ath=1./(1.+(alth*Lv/cppd))                                                         
-        sth=ath*(zqta(ind1,ind2)-zqsatth(ind1))                      
-
-       ! For MPCs:
-        IF (mpc_bl_points(ind1,ind2) .GT. 0) THEN
-         althi=alth
-         althl=(0.622*RLVTT*qslth(ind1))/(rdd*ztla(ind1,ind2)**2)                    
-         athl=1./(1.+(alth*RLVTT/cppd)) 
-         athi=alth     
-         sthl=athl*(zqta(ind1,ind2)-qslth(ind1))   
-         sthi=athi*(zqta(ind1,ind2)-qsith(ind1,ind2))  
-         sthil=athi*(zqta(ind1,ind2)-qslth(ind1))
-        ENDIF     
-
-
-
-!-------------------------------------------------------------------------------
-!  Version 3: Changes by J. Jouhaud; condensation for q > -delta s
-!  Rq: in this subroutine, we assume iflag_clouth_vert .EQ. 3 
-!-------------------------------------------------------------------------------
-
-        IF (mpc_bl_points(ind1,ind2) .EQ. 0) THEN ! No BL MPC
-
-       ! Standard deviation of the distributions
-
-           sigma1s_fraca = (sigma1s_factor**0.5)*(fraca(ind1,ind2)**sigma1s_power) / &
-           &                (1-fraca(ind1,ind2))*((sth-senv)**2)**0.5
-
-           IF (cloudth_ratqsmin>0.) THEN
-             sigma1s_ratqs = cloudth_ratqsmin*po(ind1)
-           ELSE
-             sigma1s_ratqs = ratqs(ind1,ind2)*po(ind1)
-           ENDIF
- 
-           sigma1s = sigma1s_fraca + sigma1s_ratqs
-           sigma2s=(sigma2s_factor*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**sigma2s_power))+0.002*zqta(ind1,ind2)
-
-
-           deltasenv=aenv*vert_alpha*sigma1s
-           deltasth=ath*vert_alpha_th*sigma2s
-
-           xenv1=-(senv+deltasenv)/(sqrt(2.)*sigma1s)
-           xenv2=-(senv-deltasenv)/(sqrt(2.)*sigma1s)
-           exp_xenv1 = exp(-1.*xenv1**2)
-           exp_xenv2 = exp(-1.*xenv2**2)
-           xth1=-(sth+deltasth)/(sqrt(2.)*sigma2s)
-           xth2=-(sth-deltasth)/(sqrt(2.)*sigma2s)
-           exp_xth1 = exp(-1.*xth1**2)
-           exp_xth2 = exp(-1.*xth2**2)
-      
-      !surface CF
-
-           cth(ind1,ind2)=0.5*(1.-1.*erf(xth1))
-           cenv(ind1,ind2)=0.5*(1.-1.*erf(xenv1))
-           ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2) 
-
-
-      !volume CF and condensed water
-
-            !environnement
-
-            IntJ=0.5*senv*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp_xenv2
-            IntJ_CF=0.5*(1.-1.*erf(xenv2))
-
-            IF (deltasenv .LT. 1.e-10) THEN 
-              qcenv(ind1,ind2)=IntJ
-              cenv_vol(ind1,ind2)=IntJ_CF
-            ELSE
-              IntI1=(((senv+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
-              IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp_xenv1-xenv2*exp_xenv2)
-              IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp_xenv1-exp_xenv2)
-              IntI1_CF=((senv+deltasenv)*(erf(xenv2)-erf(xenv1)))/(4*deltasenv)
-              IntI3_CF=(sqrt2*sigma1s*(exp_xenv1-exp_xenv2))/(4*sqrtpi*deltasenv)
-              qcenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-              cenv_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
-            ENDIF
-             
-
-
-            !thermals
-
-            IntJ=0.5*sth*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
-            IntJ_CF=0.5*(1.-1.*erf(xth2))
-     
-            IF (deltasth .LT. 1.e-10) THEN
-              qcth(ind1,ind2)=IntJ
-              cth_vol(ind1,ind2)=IntJ_CF
-            ELSE
-              IntI1=(((sth+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
-              IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
-              IntI3=((sqrt2*sigma2s*(sth+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
-              IntI1_CF=((sth+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
-              IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
-              qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
-              cth_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
-            ENDIF
-
-              qctot(ind1,ind2)=fraca(ind1,ind2)*qcth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qcenv(ind1,ind2)
-              ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
-              
-
-            IF (cenv(ind1,ind2).LT.1.e-10.or.cth(ind1,ind2).LT.1.e-10) THEN
-                ctot(ind1,ind2)=0.
-                ctot_vol(ind1,ind2)=0.
-                qcloud(ind1)=zqsatenv(ind1)
-                qincloud(ind1)=0.
-            ELSE               
-                qcloud(ind1)=qctot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
-                qincloud(ind1)=qctot(ind1,ind2)/ctot(ind1,ind2)
-            ENDIF 
-
-
-        ELSE ! mpc_bl_points>0
-
-            ! Treat boundary layer mixed phase clouds
-            
-            ! thermals
-            !=========
-
-            ! ice phase
-            !...........
-
-            qiceth=0.
-            deltazlev_mpc=dz(ind1,:)
-            temp_mpc=ztla(ind1,:)*zpspsk(ind1,:)
-            pres_mpc=pplay(ind1,:)
-            fraca_mpc=fraca(ind1,:)
-            snowf_mpc=snowflux(ind1,:)
-            iflag_topthermals=0
-            IF ((mpc_bl_points(ind1,ind2) .EQ. 1) .AND. (mpc_bl_points(ind1,ind2+1) .EQ. 0))  THEN
-                iflag_topthermals = 1
-            ELSE IF ((mpc_bl_points(ind1,ind2) .EQ. 1) .AND. (mpc_bl_points(ind1,ind2+1) .EQ. 1) & 
-                    .AND. (mpc_bl_points(ind1,ind2+2) .EQ. 0) ) THEN
-                iflag_topthermals = 2
-            ELSE 
-                iflag_topthermals = 0
-            ENDIF
-
-            CALL ICE_MPC_BL_CLOUDS(ind1,ind2,klev,Ni,Ei,C_cap,d_top,iflag_topthermals,temp_mpc,pres_mpc,zqta(ind1,:), &
-                                   qsith(ind1,:),qlth(ind1,:),deltazlev_mpc,wiceth(ind1,:),fraca_mpc,qith(ind1,:))
-
-            ! qmax calculation
-            sigma2s=(sigma2s_factor*((MAX((sthl-senvl),0.)**2)**0.5)/((fraca(ind1,ind2)+0.02)**sigma2s_power))+0.002*zqta(ind1,ind2)
-            deltasth=athl*vert_alpha_th*sigma2s
-            xth1=-(sthl+deltasth)/(sqrt(2.)*sigma2s)
-            xth2=-(sthl-deltasth)/(sqrt(2.)*sigma2s)
-            exp_xth1 = exp(-1.*xth1**2)
-            exp_xth2 = exp(-1.*xth2**2)
-            IntJ=0.5*sthl*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
-            IntJ_CF=0.5*(1.-1.*erf(xth2))
-            IntI1=(((sthl+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
-            IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
-            IntI3=((sqrt2*sigma2s*(sthl+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
-            IntI1_CF=((sthl+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
-            IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
-            qmax=MAX(IntJ+IntI1+IntI2+IntI3,0.)
-
-
-            ! Liquid phase
-            !................
-            ! We account for the effect of ice crystals in thermals on sthl
-            ! and on the width of the distribution
-
-            sthlc=sthl*1./(1.+C_mpc*qith(ind1,ind2))  &
-                + (1.-1./(1.+C_mpc*qith(ind1,ind2))) * athl*(qsith(ind1,ind2)-qslth(ind1))  
-
-            sigma2sc=(sigma2s_factor*((MAX((sthlc-senvl),0.)**2)**0.5) &
-                 /((fraca(ind1,ind2)+0.02)**sigma2s_power)) &
-                 +0.002*zqta(ind1,ind2)
-            deltasthc=athl*vert_alpha_th*sigma2sc
-     
-            
-            xth1=-(sthlc+deltasthc)/(sqrt(2.)*sigma2sc)
-            xth2=-(sthlc-deltasthc)/(sqrt(2.)*sigma2sc)           
-            exp_xth1 = exp(-1.*xth1**2)
-            exp_xth2 = exp(-1.*xth2**2)
-            IntJ=0.5*sthlc*(1-erf(xth2))+(sigma2sc/sqrt2pi)*exp_xth2
-            IntJ_CF=0.5*(1.-1.*erf(xth2))
-            IntI1=(((sthlc+deltasthc)**2+(sigma2sc)**2)/(8*deltasthc))*(erf(xth2)-erf(xth1))
-            IntI2=(sigma2sc**2/(4*deltasthc*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
-            IntI3=((sqrt2*sigma2sc*(sthlc+deltasthc))/(4*sqrtpi*deltasthc))*(exp_xth1-exp_xth2)
-            IntI1_CF=((sthlc+deltasthc)*(erf(xth2)-erf(xth1)))/(4*deltasthc)
-            IntI3_CF=(sqrt2*sigma2sc*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasthc)
-            qliqth=IntJ+IntI1+IntI2+IntI3
-            
-            qlth(ind1,ind2)=MAX(0.,qliqth)
-
-            ! Condensed water
-            
-            qcth(ind1,ind2)=qlth(ind1,ind2)+qith(ind1,ind2)
-
-
-            ! consistency with subgrid distribution
-           
-             IF ((qcth(ind1,ind2) .GT. qmax) .AND. (qcth(ind1,ind2) .GT. 0)) THEN
-                 fraci=qith(ind1,ind2)/qcth(ind1,ind2)
-                 qcth(ind1,ind2)=qmax
-                 qith(ind1,ind2)=fraci*qmax
-                 qlth(ind1,ind2)=(1.-fraci)*qmax
-             ENDIF
-
-            ! Cloud Fraction
-            !...............
-            ! calculation of qbase which is the value of the water vapor within mixed phase clouds
-            ! such that the total water in cloud = qbase+qliqth+qiceth
-            ! sbase is the value of s such that int_sbase^\intfy s ds = cloud fraction
-            ! sbase and qbase calculation (note that sbase is wrt liq so negative)
-            ! look for an approximate solution with iteration
-            
-            ttarget=qcth(ind1,ind2)
-            mini= athl*(qsith(ind1,ind2)-qslth(ind1))
-            maxi= 0. !athl*(3.*sqrt(sigma2s))
-            niter=20
-            pas=(maxi-mini)/niter
-            stmp=mini
-            sbase=stmp
-            coutref=1.E6
-            DO iter=1,niter
-                cout=ABS(sigma2s/SQRT(2.*RPI)*EXP(-((sthl-stmp)/sigma2s)**2)+(sthl-stmp)/SQRT(2.)*(1.-erf(-(sthl-stmp)/sigma2s)) &
-                     + stmp/2.*(1.-erf(-(sthl-stmp)/sigma2s)) -ttarget)
-               IF (cout .LT. coutref) THEN
-                     sbase=stmp
-                     coutref=cout
-                ELSE
-                     stmp=stmp+pas
-                ENDIF
-            ENDDO
-            qbase=MAX(0., sbase/athl+qslth(ind1))
-
-            ! surface cloud fraction in thermals
-            cth(ind1,ind2)=0.5*(1.-erf((sbase-sthl)/sqrt(2.)/sigma2s))
-            cth(ind1,ind2)=MIN(MAX(cth(ind1,ind2),0.),1.)
-
-
-            !volume cloud fraction in thermals
-            !to be checked
-            xth1=-(sthl+deltasth-sbase)/(sqrt(2.)*sigma2s)
-            xth2=-(sthl-deltasth-sbase)/(sqrt(2.)*sigma2s)           
-            exp_xth1 = exp(-1.*xth1**2)
-            exp_xth2 = exp(-1.*xth2**2)
-
-            IntJ=0.5*sthl*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
-            IntJ_CF=0.5*(1.-1.*erf(xth2))
-     
-            IF (deltasth .LT. 1.e-10) THEN
-              cth_vol(ind1,ind2)=IntJ_CF
-            ELSE
-              IntI1=(((sthl+deltasth-sbase)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
-              IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
-              IntI3=((sqrt2*sigma2s*(sthl+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
-              IntI1_CF=((sthl-sbase+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
-              IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
-              cth_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
-            ENDIF
-              cth_vol(ind1,ind2)=MIN(MAX(0.,cth_vol(ind1,ind2)),1.)
-
-
-
-            ! Environment
-            !=============
-            ! In the environment/downdrafts, only liquid clouds
-            ! See Shupe et al. 2008, JAS
-
-            ! standard deviation of the distribution in the environment
-            sth=sthl
-            senv=senvl
-            sigma1s_fraca = (sigma1s_factor**0.5)*(fraca(ind1,ind2)**sigma1s_power) / &
-                          &                (1-fraca(ind1,ind2))*(MAX((sth-senv),0.)**2)**0.5
-            ! for mixed phase clouds, there is no contribution from large scale ratqs to the distribution
-            ! in the environement
-
-            sigma1s_ratqs=1E-10
-            IF (cloudth_ratqsmin>0.) THEN
-                sigma1s_ratqs = cloudth_ratqsmin*po(ind1)
-            ENDIF
-
-            sigma1s = sigma1s_fraca + sigma1s_ratqs
-            deltasenv=aenvl*vert_alpha*sigma1s
-            xenv1=-(senvl+deltasenv)/(sqrt(2.)*sigma1s)
-            xenv2=-(senvl-deltasenv)/(sqrt(2.)*sigma1s)
-            exp_xenv1 = exp(-1.*xenv1**2)
-            exp_xenv2 = exp(-1.*xenv2**2)
-
-            !surface CF
-            cenv(ind1,ind2)=0.5*(1.-1.*erf(xenv1))
-
-            !volume CF and condensed water
-            IntJ=0.5*senvl*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp_xenv2
-            IntJ_CF=0.5*(1.-1.*erf(xenv2))
-
-            IF (deltasenv .LT. 1.e-10) THEN
-              qcenv(ind1,ind2)=IntJ
-              cenv_vol(ind1,ind2)=IntJ_CF
-            ELSE
-              IntI1=(((senvl+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
-              IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp_xenv1-xenv2*exp_xenv2)
-              IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp_xenv1-exp_xenv2)
-              IntI1_CF=((senvl+deltasenv)*(erf(xenv2)-erf(xenv1)))/(4*deltasenv)
-              IntI3_CF=(sqrt2*sigma1s*(exp_xenv1-exp_xenv2))/(4*sqrtpi*deltasenv)
-              qcenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3 ! only liquid water in environment
-              cenv_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
-            ENDIF
-
-            qcenv(ind1,ind2)=MAX(qcenv(ind1,ind2),0.)
-            cenv_vol(ind1,ind2)=MIN(MAX(cenv_vol(ind1,ind2),0.),1.)
-
-
-            
-            ! Thermals + environment
-            ! ======================= 
-            ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2) 
-            qctot(ind1,ind2)=fraca(ind1,ind2)*qcth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qcenv(ind1,ind2)
-            ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
-            IF (qcth(ind1,ind2) .GT. 0) THEN
-               icefrac(ind1,ind2)=fraca(ind1,ind2)*qith(ind1,ind2) &
-                    /(fraca(ind1,ind2)*qcth(ind1,ind2) &
-                    +(1.-1.*fraca(ind1,ind2))*qcenv(ind1,ind2))
-                icefrac(ind1,ind2)=MAX(MIN(1.,icefrac(ind1,ind2)),0.)
-            ELSE
-                icefrac(ind1,ind2)=0.
-            ENDIF
-
-            IF (cenv(ind1,ind2).LT.1.e-10.or.cth(ind1,ind2).LT.1.e-10) THEN
-                ctot(ind1,ind2)=0.
-                ctot_vol(ind1,ind2)=0.
-                qincloud(ind1)=0.
-                qcloud(ind1)=zqsatenv(ind1)
-            ELSE               
-                qcloud(ind1)=fraca(ind1,ind2)*(qcth(ind1,ind2)/cth(ind1,ind2)+qbase) &
-                            +(1.-1.*fraca(ind1,ind2))*(qcenv(ind1,ind2)/cenv(ind1,ind2)+qslenv(ind1))
-                qincloud(ind1)=MAX(fraca(ind1,ind2)*(qcth(ind1,ind2)/cth(ind1,ind2)) &
-                            +(1.-1.*fraca(ind1,ind2))*(qcenv(ind1,ind2)/cenv(ind1,ind2)),0.)
-            ENDIF 
-
-        ENDIF ! mpc_bl_points
-
-
-    ELSE  ! gaussian for environment only
-
-      
-
-
-        IF (Tbefenvonly(ind1) .GE. RTT) THEN
-                Lv=RLVTT
-        ELSE
-                Lv=RLSTT
-        ENDIF
-        
-
-        zthl(ind1,ind2)=temp(ind1,ind2)*(101325./paprs(ind1,ind2))**(rdd/cppd)
-        alenv=(0.622*Lv*zqsatenvonly(ind1))/(rdd*zthl(ind1,ind2)**2)
-        aenv=1./(1.+(alenv*Lv/cppd))
-        senv=aenv*(po(ind1)-zqsatenvonly(ind1))
-        sth=0.
-      
-        sigma1s=ratqs(ind1,ind2)*zqenvonly(ind1)
-        sigma2s=0.
-
-        sqrt2pi=sqrt(2.*pi)
-        xenv=senv/(sqrt(2.)*sigma1s)
-        ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
-        ctot_vol(ind1,ind2)=ctot(ind1,ind2)
-        qctot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
-      
-        IF (ctot(ind1,ind2).LT.1.e-3) THEN
-          ctot(ind1,ind2)=0.
-          qcloud(ind1)=zqsatenvonly(ind1)
-          qincloud(ind1)=0.
-        ELSE 
-          qcloud(ind1)=qctot(ind1,ind2)/ctot(ind1,ind2)+zqsatenvonly(ind1)
-          qincloud(ind1)=MAX(qctot(ind1,ind2)/ctot(ind1,ind2),0.)
-        ENDIF
- 
-
-    ENDIF       ! From the separation (thermal/envrionnement) and (environnement only,) l.335 et l.492
-
-    ! Outputs used to check the PDFs
-    cloudth_senv(ind1,ind2) = senv
-    cloudth_sth(ind1,ind2) = sth
-    cloudth_sigmaenv(ind1,ind2) = sigma1s
-    cloudth_sigmath(ind1,ind2) = sigma2s
-
-
-    ENDDO       !loop on klon
-
-    ! Calcule ice fall velocity in thermals
-
-    CALL FALLICE_VELOCITY(klon,qith(:,ind2),Tbefth(:),rhoth(:),paprs(:,ind2),falseklon(:),wiceth(:,ind2))
-
-RETURN
-
-
-END SUBROUTINE cloudth_mpc
-
-!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-SUBROUTINE ICE_MPC_BL_CLOUDS(ind1,ind2,klev,Ni,Ei,C_cap,d_top,iflag_topthermals,temp,pres,qth,qsith,qlth,deltazlev,vith,fraca,qith)
-
-! parameterization of ice for boundary
-! layer mixed-phase clouds assuming a stationary system
-!
-! Note that vapor deposition on ice crystals and riming of liquid droplets
-! depend on the ice number concentration Ni
-! One could assume that Ni depends on qi, e.g.,  Ni=beta*(qi*rho)**xi
-! and use values from Hong et al. 2004, MWR for instance
-! One may also estimate Ni as a function of T, as in Meyers 1922 or Fletcher 1962 
-! One could also think of a more complex expression of Ni;
-! function of qi, T, the concentration in aerosols or INP ..
-! Here we prefer fixing Ni to a tuning parameter
-! By default we take 2.0L-1=2.0e3m-3, median value from measured vertical profiles near Svalbard
-! in Mioche et al. 2017
-!
-!
-! References:
-!------------
-! This parameterization is thoroughly described in Vignon et al. 
-!
-! More specifically
-! for the Water vapor deposition process:
-!
-! Rotstayn, L. D., 1997: A physically based scheme for the treat-
-! ment of stratiform cloudfs and precipitation in large-scale
-! models. I: Description and evaluation of the microphysical
-! processes. Quart. J. Roy. Meteor. Soc., 123, 1227–1282.
-!
-!  Morrison, H., and A. Gettelman, 2008: A new two-moment bulk
-!  stratiform cloud microphysics scheme in the NCAR Com-
-!  munity Atmosphere Model (CAM3). Part I: Description and
-!  numerical tests. J. Climate, 21, 3642–3659
-!
-! for the Riming process:
-!
-! Rutledge, S. A., and P. V. Hobbs, 1983: The mesoscale and micro-
-! scale structure and organization of clouds and precipitation in
-! midlatitude cyclones. VII: A model for the ‘‘seeder-feeder’’
-! process in warm-frontal rainbands. J. Atmos. Sci., 40, 1185–1206
-!
-! Thompson, G., R. M. Rasmussen, and K. Manning, 004: Explicit
-! forecasts of winter precipitation using an improved bulk
-! microphysics scheme. Part I: Description and sensitivityThompson, G., R. M. Rasmussen, and K. Manning, 2004: Explicit
-! forecasts of winter precipitation using an improved bulk
-! microphysics scheme. Part I: Description and sensitivity analysis. Mon. Wea. Rev., 132, 519–542
-!
-! For the formation of clouds by thermals:
-!
-! Rio, C., & Hourdin, F. (2008). A thermal plume model for the convective boundary layer : Representation of cumulus clouds. Journal of
-! the Atmospheric Sciences, 65, 407–425.
-!
-! Jam, A., Hourdin, F., Rio, C., & Couvreux, F. (2013). Resolved versus parametrized boundary-layer plumes. Part III: Derivation of a
-! statistical scheme for cumulus clouds. Boundary-layer Meteorology, 147, 421–441. https://doi.org/10.1007/s10546-012-9789-3
-!
-!
-!
-! Contact: Etienne Vignon, etienne.vignon@lmd.ipsl.fr
-!=============================================================================
-
-    USE ioipsl_getin_p_mod, ONLY : getin_p
-    USE phys_state_var_mod, ONLY : fm_therm, detr_therm, entr_therm
-
-    IMPLICIT none
-
-    INCLUDE "YOMCST.h"
-    INCLUDE "nuage.h"
-
-    INTEGER, INTENT(IN) :: ind1,ind2, klev           ! horizontal and vertical indices and dimensions
-    INTEGER, INTENT(IN) :: iflag_topthermals         ! uppermost layer of thermals ?
-    REAL, INTENT(IN)    :: Ni                        ! ice number concentration [m-3]
-    REAL, INTENT(IN)    :: Ei                        ! ice-droplet collision efficiency
-    REAL, INTENT(IN)    :: C_cap                     ! ice crystal capacitance
-    REAL, INTENT(IN)    :: d_top                     ! cloud-top ice crystal mixing parameter
-    REAL,  DIMENSION(klev), INTENT(IN) :: temp       ! temperature [K] within thermals
-    REAL,  DIMENSION(klev), INTENT(IN) :: pres       ! pressure [Pa]
-    REAL,  DIMENSION(klev), INTENT(IN) :: qth        ! mean specific water content in thermals [kg/kg]
-    REAL,  DIMENSION(klev), INTENT(IN) :: qsith        ! saturation specific humidity wrt ice in thermals [kg/kg]
-    REAL,  DIMENSION(klev), INTENT(IN) :: qlth       ! condensed liquid water in thermals, approximated value [kg/kg]
-    REAL,  DIMENSION(klev), INTENT(IN) :: deltazlev  ! layer thickness [m]
-    REAL,  DIMENSION(klev), INTENT(IN) :: vith       ! ice crystal fall velocity [m/s]
-    REAL,  DIMENSION(klev+1), INTENT(IN) :: fraca      ! fraction of the mesh covered by thermals
-    REAL,  DIMENSION(klev), INTENT(INOUT) :: qith       ! condensed ice water , thermals [kg/kg]
-
-
-    INTEGER ind2p1,ind2p2
-    REAL rho(klev)
-    REAL unsurtaudet, unsurtaustardep, unsurtaurim
-    REAL qi, AA, BB, Ka, Dv, rhoi
-    REAL p0, t0, fp1, fp2
-    REAL alpha, flux_term
-    REAL det_term, precip_term, rim_term, dep_term
-
-
-    ind2p1=ind2+1
-    ind2p2=ind2+2
-
-    rho=pres/temp/RD  ! air density kg/m3
-
-    Ka=2.4e-2      ! thermal conductivity of the air, SI
-    p0=101325.0    ! ref pressure
-    T0=273.15      ! ref temp
-    rhoi=500.0     ! cloud ice density following Reisner et al. 1998
-    alpha=700.     ! fallvelocity param
-
-
-    IF (iflag_topthermals .GT. 0) THEN ! uppermost thermals levels
-
-    Dv=0.0001*0.211*(p0/pres(ind2))*((temp(ind2)/T0)**1.94) ! water vapor diffusivity in air, SI
-
-    ! Detrainment term:
-
-    unsurtaudet=detr_therm(ind1,ind2)/rho(ind2)/deltazlev(ind2)
- 
-
-    ! Deposition term
-    AA=RLSTT/Ka/temp(ind2)*(RLSTT/RV/temp(ind2)-1.)
-    BB=1./(rho(ind2)*Dv*qsith(ind2))
-    unsurtaustardep=C_cap*(Ni**0.66)*(qth(ind2)-qsith(ind2))/qsith(ind2) &
-                    *4.*RPI/(AA+BB)*(6.*rho(ind2)/rhoi/RPI/Gamma(4.))**(0.33)
-
-    ! Riming term  neglected at this level
-    !unsurtaurim=rho(ind2)*alpha*3./rhoi/2.*Ei*qlth(ind2)*((p0/pres(ind2))**0.4)
-
-    qi=fraca(ind2)*unsurtaustardep/MAX((d_top*unsurtaudet),1E-12)
-    qi=MAX(qi,0.)**(3./2.)
-
-    ELSE ! other levels, estimate qi(k) from variables at k+1 and k+2
-
-    Dv=0.0001*0.211*(p0/pres(ind2p1))*((temp(ind2p1)/T0)**1.94) ! water vapor diffusivity in air, SI
-
-    ! Detrainment term:
-
-    unsurtaudet=detr_therm(ind1,ind2p1)/rho(ind2p1)/deltazlev(ind2p1)
-    det_term=-unsurtaudet*qith(ind2p1)*rho(ind2p1)
-    
-    
-    ! Deposition term
-
-    AA=RLSTT/Ka/temp(ind2p1)*(RLSTT/RV/temp(ind2p1)-1.)
-    BB=1./(rho(ind2p1)*Dv*qsith(ind2p1))
-    unsurtaustardep=C_cap*(Ni**0.66)*(qth(ind2p1)-qsith(ind2p1)) &
-         /qsith(ind2p1)*4.*RPI/(AA+BB) &
-         *(6.*rho(ind2p1)/rhoi/RPI/Gamma(4.))**(0.33)
-    dep_term=rho(ind2p1)*fraca(ind2p1)*(qith(ind2p1)**0.33)*unsurtaustardep
- 
-    ! Riming term
-
-    unsurtaurim=rho(ind2p1)*alpha*3./rhoi/2.*Ei*qlth(ind2p1)*((p0/pres(ind2p1))**0.4)
-    rim_term=rho(ind2p1)*fraca(ind2p1)*qith(ind2p1)*unsurtaurim
-
-    ! Precip term
-
-    ! We assume that there is no solid precipitation outside thermals 
-    ! so the precipitation flux within thermals is equal to the precipitation flux
-    ! at mesh-scale divided by  thermals fraction
-    
-    fp2=0.
-    fp1=0.
-    IF (fraca(ind2p1) .GT. 0.) THEN
-    fp2=-qith(ind2p2)*rho(ind2p2)*vith(ind2p2)*fraca(ind2p2)! flux defined positive upward
-    fp1=-qith(ind2p1)*rho(ind2p1)*vith(ind2p1)*fraca(ind2p1)
-    ENDIF
-
-    precip_term=-1./deltazlev(ind2p1)*(fp2-fp1)
-
-    ! Calculation in a top-to-bottom loop
-
-    IF (fm_therm(ind1,ind2p1) .GT. 0.) THEN
-          qi= 1./fm_therm(ind1,ind2p1)* &
-              (deltazlev(ind2p1)*(-rim_term-dep_term-det_term-precip_term) + &
-              fm_therm(ind1,ind2p2)*(qith(ind2p1)))
-    END IF
-
-    ENDIF ! top thermals
-
-    qith(ind2)=MAX(0.,qi)
-
-    RETURN
-
-END SUBROUTINE ICE_MPC_BL_CLOUDS
-
-
-
-
-END MODULE cloudth_mod
-
-
-
-
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/coare30_flux_cnrm.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/coare30_flux_cnrm.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/coare30_flux_cnrm.F90	(revision 4727)
@@ -0,0 +1,631 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
+!SFX_LIC for details. version 1.
+!     #########
+
+!------------------------ Modif Olivier Torres pour rajout fonction et pas appel ----------------
+
+
+
+real function PSIFCTT(zet)
+
+  real, intent(in) :: zet
+
+  if(zet<0) then
+     x=(1.-(15*zet))**.5 
+     psik=2*log((1+x)/2) 
+     x=(1.-(34.15*zet))**.3333 
+     psic=1.5*log((1.+x+x*x)/3.)-sqrt(3.)*atan((1.+2.*x)/sqrt(3.))+4.*atan(1.)/sqrt(3.) 
+     f=zet*zet/(1+zet*zet) 
+     PSIFCTT=(1-f)*psik+f*psic   
+
+  else
+     c=min(50.,.35*zet) 
+     PSIFCTT=-((1.+2./3.*zet)**1.5+.6667*(zet-14.28)/exp(c)+8.525)
+  endif
+end FUNCTION PSIFCTT
+
+real function PSIFCTU(zet)
+
+  real, intent(in) :: zet
+
+  if (zet<0) then 
+
+     x=(1.-15.*zet)**.25 
+     psik=2.*log((1.+x)/2.)+log((1.+x*x)/2.)-2.*atan(x)+2.*atan(1.) 
+     x=(1.-10.15*zet)**.3333 
+     psic=1.5*log((1.+x+x*x)/3.)-sqrt(3.)*atan((1.+2.*x)/sqrt(3.))+4.*atan(1.)/sqrt(3.) 
+     f=zet*zet/(1+zet*zet) 
+     PSIFCTU=(1-f)*psik+f*psic                                                
+  else
+     c=min(50.,.35*zet) 
+     PSIFCTU=-((1+1.0*zet)**1.0+.667*(zet-14.28)/exp(c)+8.525)
+  endif
+END FUNCTION PSIFCTU
+
+!----------------------------------- Fin Modif ---------------------------------------------------
+
+
+SUBROUTINE COARE30_FLUX_CNRM(PZ0SEA,PTA,PSST,PQA,  &
+            PVMOD,PZREF,PUREF,PPS,PQSATA,PQSAT,PSFTH,PSFTQ,PUSTAR,PCD,PCDN,PCH,PCE,PRI,&
+            PRESA,PRAIN,PPA,PZ0HSEA,LPRECIP, LPWG,coeffs )  
+!     #######################################################################
+!
+!
+!!****  *COARE25_FLUX*  
+!!
+!!    PURPOSE
+!!    -------
+!      Calculate the surface fluxes of heat, moisture, and momentum over
+!      sea surface with bulk algorithm COARE3.0. 
+!     
+!!**  METHOD
+!!    ------
+!      transfer coefficients were obtained using a dataset which combined COARE
+!      data with those from three other ETL field experiments, and reanalysis of
+!      the HEXMAX data (DeCosmos et al. 1996). 
+!      ITERMAX=3 
+!      Take account of the surface gravity waves on the velocity roughness and 
+!      hence the momentum transfer coefficient
+!        NGRVWAVES=0 no gravity waves action (Charnock) !default value
+!        NGRVWAVES=1 wave age parameterization of Oost et al. 2002
+!        NGRVWAVES=2 model of Taylor and Yelland 2001
+!
+!!    EXTERNAL
+!!    --------
+!!
+!!    IMPLICIT ARGUMENTS
+!!    ------------------ 
+!!      
+!!    REFERENCE
+!!    ---------
+!!      Fairall et al (2003), J. of Climate, vol. 16, 571-591
+!!      Fairall et al (1996), JGR, 3747-3764
+!!      Gosnell et al (1995), JGR, 437-442
+!!      Fairall et al (1996), JGR, 1295-1308
+!!      
+!!    AUTHOR
+!!    ------
+!!     C. Lebeaupin  *Météo-France* (adapted from C. Fairall's code)
+!!
+!!    MODIFICATIONS
+!!    -------------
+!!      Original     1/06/2006
+!!      B. Decharme    06/2009 limitation of Ri
+!!      B. Decharme    09/2012 Bug in Ri calculation and limitation of Ri in surface_ri.F90
+!!      B. Decharme    06/2013 bug in z0 (output) computation 
+!!      J.Escobar      06/2013  for REAL4/8 add EPSILON management
+!!      C. Lebeaupin   03/2014 bug if PTA=PSST and PEXNA=PEXNS: set a minimum value
+!!                             add abort if no convergence
+!-------------------------------------------------------------------------------
+!
+!*       0.     DECLARATIONS
+!               ------------
+!
+!
+!USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
+!
+
+!----------Rajout Olive ---------
+USE dimphy
+USE indice_sol_mod
+
+!--------------------------------
+
+USE MODD_CSTS,       ONLY : XKARMAN, XG, XSTEFAN, XRD, XRV, XPI, &
+                            XLVTT, XCL, XCPD, XCPV, XRHOLW, XTT, &
+                            XP00
+
+!USE MODD_SURF_ATM,   ONLY : XVZ0CM
+!
+!USE MODD_SURF_PAR,   ONLY : XUNDEF, XSURF_EPSILON
+!USE MODD_WATER_PAR
+!
+!USE MODI_SURFACE_RI
+!USE MODI_WIND_THRESHOLD
+!USE MODE_COARE30_PSI
+!
+!USE MODE_THERMOS
+!
+!
+!USE MODI_ABOR1_SFX
+!
+!
+!USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+!USE PARKIND1  ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!*      0.1    declarations of arguments
+!
+!
+!
+!TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+!
+REAL, DIMENSION(klon), INTENT(IN)       :: PTA   ! air temperature at atm. level (K)
+REAL, DIMENSION(klon), INTENT(IN)       :: PQA   ! air humidity at atm. level (kg/kg)
+!REAL, DIMENSION(:), INTENT(IN)       :: PEXNA ! Exner function at atm. level
+!REAL, DIMENSION(:), INTENT(IN)       :: PRHOA ! air density at atm. level
+REAL, DIMENSION(klon), INTENT(IN)       :: PVMOD ! module of wind at atm. wind level (m/s)
+REAL, DIMENSION(klon), INTENT(IN)       :: PZREF ! atm. level for temp. and humidity (m)
+REAL, DIMENSION(klon), INTENT(IN)       :: PUREF ! atm. level for wind (m)
+REAL, DIMENSION(klon), INTENT(IN)       :: PSST  ! Sea Surface Temperature (K)
+!REAL, DIMENSION(:), INTENT(IN)       :: PEXNS ! Exner function at sea surface
+REAL, DIMENSION(klon), INTENT(IN)       :: PPS   ! air pressure at sea surface (Pa)
+REAL, DIMENSION(klon), INTENT(IN)       :: PRAIN !precipitation rate (kg/s/m2)
+REAL, DIMENSION(klon), INTENT(IN)       :: PPA        ! air pressure at atm level (Pa)
+REAL, DIMENSION(klon), INTENT(IN)       :: PQSATA        ! air pressure at atm level (Pa)
+!
+REAL, DIMENSION(klon), INTENT(INOUT)    :: PZ0SEA! roughness length over the ocean
+!                                                                                 
+!  surface fluxes : latent heat, sensible heat, friction fluxes
+REAL, DIMENSION(klon), INTENT(OUT)      :: PSFTH ! heat flux (W/m2)
+REAL, DIMENSION(klon), INTENT(OUT)      :: PSFTQ ! water flux (kg/m2/s)
+REAL, DIMENSION(klon), INTENT(OUT)      :: PUSTAR! friction velocity (m/s)
+!
+! diagnostics
+REAL, DIMENSION(klon), INTENT(OUT)      :: PQSAT ! humidity at saturation
+REAL, DIMENSION(klon), INTENT(OUT)      :: PCD   ! heat drag coefficient
+REAL, DIMENSION(klon), INTENT(OUT)      :: PCDN  ! momentum drag coefficient
+REAL, DIMENSION(klon), INTENT(OUT)      :: PCH   ! neutral momentum drag coefficient
+REAL, DIMENSION(klon), INTENT(OUT)      :: PCE  !transfer coef. for latent heat flux
+REAL, DIMENSION(klon), INTENT(OUT)      :: PRI   ! Richardson number
+REAL, DIMENSION(klon), INTENT(OUT)      :: PRESA ! aerodynamical resistance
+REAL, DIMENSION(klon), INTENT(OUT)      :: PZ0HSEA ! heat roughness length
+
+LOGICAL,            INTENT(IN)    :: LPRECIP   !
+LOGICAL,            INTENT(IN)    :: LPWG    ! 
+real, dimension(3), intent(inout)      :: coeffs
+!
+!
+
+!INCLUDE "YOMCST.h"
+!INCLUDE "clesphys.h"
+
+!*      0.2    declarations of local variables
+!
+REAL, DIMENSION(SIZE(PTA))      :: ZVMOD    ! wind intensity
+REAL, DIMENSION(SIZE(PTA))      :: ZPA      ! Pressure at atm. level
+REAL, DIMENSION(SIZE(PTA))      :: ZTA      ! Temperature at atm. level
+REAL, DIMENSION(SIZE(PTA))      :: ZQASAT   ! specific humidity at saturation  at atm. level (kg/kg)
+!
+!rajout
+REAL, DIMENSION(SIZE(PTA))       :: PEXNA      ! Exner function at atm level
+REAL, DIMENSION(SIZE(PTA))       :: PEXNS      ! Exner function at atm level
+!
+REAL, DIMENSION(SIZE(PTA))      :: ZO       ! rougness length ref 
+REAL, DIMENSION(SIZE(PTA))      :: ZWG      ! gustiness factor (m/s)
+!
+REAL, DIMENSION(SIZE(PTA))      :: ZDU,ZDT,ZDQ,ZDUWG !differences
+!
+REAL, DIMENSION(SIZE(PTA))      :: ZUSR        !velocity scaling parameter "ustar" (m/s) = friction velocity
+REAL, DIMENSION(SIZE(PTA))      :: ZTSR        !temperature sacling parameter "tstar" (degC)
+REAL, DIMENSION(SIZE(PTA))      :: ZQSR        !humidity scaling parameter "qstar" (kg/kg)
+!
+REAL, DIMENSION(SIZE(PTA))      :: ZU10,ZT10   !vertical profils (10-m height) 
+REAL, DIMENSION(SIZE(PTA))      :: ZVISA       !kinematic viscosity of dry air
+REAL, DIMENSION(SIZE(PTA))      :: ZO10,ZOT10  !roughness length at 10m
+REAL, DIMENSION(SIZE(PTA))      :: ZCD,ZCT,ZCC
+REAL, DIMENSION(SIZE(PTA))      :: ZCD10,ZCT10 !transfer coef. at 10m
+REAL, DIMENSION(SIZE(PTA))      :: ZRIBU,ZRIBCU
+REAL, DIMENSION(SIZE(PTA))      :: ZETU,ZL10
+!
+REAL, DIMENSION(SIZE(PTA))      :: ZCHARN                      !Charnock number depends on wind module
+REAL, DIMENSION(SIZE(PTA))      :: ZTWAVE,ZHWAVE,ZCWAVE,ZLWAVE !to compute gravity waves' impact
+!
+REAL, DIMENSION(SIZE(PTA))      :: ZZL,ZZTL!,ZZQL    !Obukhovs stability 
+                                                     !param. z/l for u,T,q
+REAL, DIMENSION(SIZE(PTA))      :: ZRR
+REAL, DIMENSION(SIZE(PTA))      :: ZOT,ZOQ           !rougness length ref
+REAL, DIMENSION(SIZE(PTA))      :: ZPUZ,ZPTZ,ZPQZ    !PHI funct. for u,T,q 
+!
+REAL, DIMENSION(SIZE(PTA))      :: ZBF               !constants to compute gustiness factor
+!
+REAL, DIMENSION(SIZE(PTA))      :: ZTAU       !momentum flux (W/m2)
+REAL, DIMENSION(SIZE(PTA))      :: ZHF        !sensible heat flux (W/m2)
+REAL, DIMENSION(SIZE(PTA))      :: ZEF        !latent heat flux (W/m2)
+REAL, DIMENSION(SIZE(PTA))      :: ZWBAR      !diag for webb correction but not used here after
+REAL, DIMENSION(SIZE(PTA))      :: ZTAUR      !momentum flux due to rain (W/m2)
+REAL, DIMENSION(SIZE(PTA))      :: ZRF        !sensible heat flux due to rain (W/m2)
+REAL, DIMENSION(SIZE(PTA))      :: ZCHN,ZCEN  !neutral coef. for heat and vapor
+!
+REAL, DIMENSION(SIZE(PTA))      :: ZLV      !latent heat constant
+!
+REAL, DIMENSION(SIZE(PTA))      :: ZTAC,ZDQSDT,ZDTMP,ZDWAT,ZALFAC ! for precipitation impact
+REAL, DIMENSION(SIZE(PTA))      :: ZXLR                           ! vaporisation  heat  at a given temperature
+REAL, DIMENSION(SIZE(PTA))      :: ZCPLW                          ! specific heat for water at a given temperature 
+!
+REAL, DIMENSION(SIZE(PTA))      :: ZUSTAR2  ! square of friction velocity
+!
+REAL, DIMENSION(SIZE(PTA))      :: ZDIRCOSZW! orography slope cosine (=1 on water!)
+REAL, DIMENSION(SIZE(PTA))      :: ZAC      ! Aerodynamical conductance
+!
+!
+INTEGER, DIMENSION(SIZE(PTA))   :: ITERMAX             ! maximum number of iterations
+!
+REAL    :: ZRVSRDM1,ZRDSRV,ZR2 ! thermodynamic constants
+REAL    :: ZBETAGUST           !gustiness factor
+REAL    :: ZZBL                !atm. boundary layer depth (m)
+REAL    :: ZVISW               !m2/s kinematic viscosity of water
+REAL    :: ZS                  !height of rougness length ref
+REAL    :: ZCH10               !transfer coef. at 10m
+
+REAL    :: QSAT_SEAWATER
+REAL    :: QSATSEAW_1D
+REAL, EXTERNAL :: PSIFCTU, PSIFCTT
+!
+INTEGER :: J, JLOOP    !loop indice
+!REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+!--------- Modif Olive -----------------
+REAL, DIMENSION(SIZE(PTA))        :: PRHOA
+REAL, PARAMETER                   :: XUNDEF = 1.E+20
+
+REAL       :: XVCHRNK = 0.021
+REAL       :: XVZ0CM = 1.0E-5 
+!REAL       :: XRIMAX
+
+
+INTEGER :: PREF             ! reference pressure for exner function
+INTEGER :: NGRVWAVES        ! Pour le choix du z0
+
+INCLUDE "YOMCST.h"
+INCLUDE "clesphys.h"
+
+!--------------------------------------
+
+
+PRHOA(:) = PPS(:) / (287.1 * PTA(:) * (1.+.61*PQA(:)))
+
+PREF = 100000.                     ! = 1000 hPa
+NGRVWAVES = 1
+
+PEXNA = (PPA/PREF)**(RD/RCPD)
+PEXNS = (PPS/PREF)**(RD/RCPD)
+
+!
+!-------------------------------------------------------------------------------
+!
+!       1.     Initializations
+!              ---------------
+!
+!       1.1   Constants and parameters
+!
+!IF (LHOOK) CALL DR_HOOK('COARE30_FLUX',0,ZHOOK_HANDLE)
+!
+ZRVSRDM1  = XRV/XRD-1. ! 0.607766
+ZRDSRV    = XRD/XRV    ! 0.62198
+ZR2       = 1.-ZRDSRV  ! pas utilisé dans cette routine
+ZBETAGUST = 1.2        ! value based on TOGA-COARE experiment
+ZZBL      = 600.       ! Set a default value for boundary layer depth
+ZS        = 10.        ! Standard heigth =10m
+ZCH10     = 0.00115
+!
+ZVISW     = 1.E-6
+!
+!       1.2   Array initialization by undefined values
+!
+PSFTH (:)=XUNDEF
+PSFTQ (:)=XUNDEF
+PUSTAR(:)=XUNDEF
+!
+PCD(:) = XUNDEF
+PCDN(:) = XUNDEF
+PCH(:) = XUNDEF
+PCE(:) =XUNDEF
+PRI(:) = XUNDEF
+!
+PRESA(:)=XUNDEF
+!
+!-------------------------------------------------------------------------------
+!       2. INITIAL GUESS FOR THE ITERATIVE METHOD 
+!          -------------------------------------
+!
+!       2.0     Temperature 
+!
+! Set a non-zero value for the temperature gradient
+!
+WHERE((PTA(:)*PEXNS(:)/PEXNA(:)-PSST(:))==0.) 
+      ZTA(:)=PTA(:)-1E-3
+ELSEWHERE
+      ZTA(:)=PTA(:)      
+ENDWHERE
+
+!       2.1     Wind and humidity 
+!
+! Sea surface specific humidity 
+!
+!PQSAT(:)=QSAT_SEAWATER(PSST(:),PPS(:))  
+PQSAT(:)=QSATSEAW_1D(PSST(:),PPS(:)) 
+
+
+       
+!              
+! Set a minimum value to wind 
+!
+!ZVMOD(:) = WIND_THRESHOLD(PVMOD(:),PUREF(:))
+
+
+ZVMOD = MAX(PVMOD , 0.1 * MIN(10.,PUREF) )    !set a minimum value to wind
+!ZVMOD = PVMOD    !set a minimum value to wind
+
+!
+! Specific humidity at saturation at the atm. level 
+!
+ZPA(:) = XP00* (PEXNA(:)**(XCPD/XRD))
+!ZQASAT(:) = QSAT_SEAWATER(ZTA(:),ZPA(:)) 
+ZQASAT = QSATSEAW_1D(ZTA(:),ZPA(:)) 
+
+
+!
+!
+ZO(:)  = 0.0001
+ZWG(:) = 0.
+IF (LPWG) ZWG(:) = 0.5
+!
+ZCHARN(:) = 0.011  
+!
+DO J=1,SIZE(PTA)
+  !
+  !      2.2       initial guess
+  !    
+  ZDU(J) = ZVMOD(J)   !wind speed difference with surface current(=0) (m/s)
+                      !initial guess for gustiness factor
+  ZDT(J) = -(ZTA(J)/PEXNA(J)) + (PSST(J)/PEXNS(J)) !potential temperature difference
+  ZDQ(J) = PQSAT(J)-PQA(J)                         !specific humidity difference
+  !
+  ZDUWG(J) = SQRT(ZDU(J)**2+ZWG(J)**2)     !wind speed difference including gustiness ZWG
+  !
+  !      2.3   initialization of neutral coefficients
+  !
+  ZU10(J)  = ZDUWG(J)*LOG(ZS/ZO(J))/LOG(PUREF(J)/ZO(J))
+  ZUSR(J)  = 0.035*ZU10(J)
+  ZVISA(J) = 1.326E-5*(1.+6.542E-3*(ZTA(J)-XTT)+&
+             8.301E-6*(ZTA(J)-XTT)**2-4.84E-9*(ZTA(J)-XTT)**3) !Andrea (1989) CRREL Rep. 89-11
+  ! 
+  ZO10(J) = ZCHARN(J)*ZUSR(J)*ZUSR(J)/XG+0.11*ZVISA(J)/ZUSR(J)
+  ZCD(J)  = (XKARMAN/LOG(PUREF(J)/ZO10(J)))**2  !drag coefficient
+  ZCD10(J)= (XKARMAN/LOG(ZS/ZO10(J)))**2
+  ZCT10(J)= ZCH10/SQRT(ZCD10(J))
+  ZOT10(J)= ZS/EXP(XKARMAN/ZCT10(J))
+  !
+  !-------------------------------------------------------------------------------
+  !             Grachev and Fairall (JAM, 1997)
+  ZCT(J) = XKARMAN/LOG(PZREF(J)/ZOT10(J))      !temperature transfer coefficient
+  ZCC(J) = XKARMAN*ZCT(J)/ZCD(J)               !z/L vs Rib linear coef.
+  !
+  ZRIBCU(J) = -PUREF(J)/(ZZBL*0.004*ZBETAGUST**3) !saturation or plateau Rib
+  !ZRIBU(J) =-XG*PUREF(J)*(ZDT(J)+ZRVSRDM1*(ZTA(J)-XTT)*ZDQ)/&
+  !     &((ZTA(J)-XTT)*ZDUWG(J)**2)
+  ZRIBU(J)  = -XG*PUREF(J)*(ZDT(J)+ZRVSRDM1*ZTA(J)*ZDQ(J))/&
+               (ZTA(J)*ZDUWG(J)**2)  
+  !
+  IF (ZRIBU(J)<0.) THEN
+    ZETU(J) = ZCC(J)*ZRIBU(J)/(1.+ZRIBU(J)/ZRIBCU(J))    !Unstable G and F
+  ELSE
+    ZETU(J) = ZCC(J)*ZRIBU(J)/(1.+27./9.*ZRIBU(J)/ZCC(J))!Stable 
+  ENDIF
+  !
+  ZL10(J) = PUREF(J)/ZETU(J) !MO length
+  !
+ENDDO
+!
+!  First guess M-O stability dependent scaling params. (u*,T*,q*) to estimate ZO and z/L (ZZL)
+ZUSR(:) = ZDUWG(:)*XKARMAN/(LOG(PUREF(:)/ZO10(:))-PSIFCTU(PUREF/ZL10))
+ZTSR(:) = -ZDT(:)*XKARMAN/(LOG(PZREF(:)/ZOT10(:))-PSIFCTT(PZREF/ZL10))
+ZQSR(:) = -ZDQ(:)*XKARMAN/(LOG(PZREF(:)/ZOT10(:))-PSIFCTT(PZREF/ZL10))
+!
+ZZL(:) = 0.0
+!
+DO J=1,SIZE(PTA)
+  !
+  IF (ZETU(J)>50.) THEN
+    ITERMAX(J) = 1
+  ELSE
+    ITERMAX(J) = 3 !number of iterations
+  ENDIF
+  !
+  !then modify Charnork for high wind speeds Chris Fairall's data
+  IF (ZDUWG(J)>10.) ZCHARN(J) = 0.011 + (0.018-0.011)*(ZDUWG(J)-10.)/(18.-10.)
+  IF (ZDUWG(J)>18.) ZCHARN(J) = 0.018
+  !
+  !                3.  ITERATIVE LOOP TO COMPUTE USR, TSR, QSR 
+  !                -------------------------------------------
+  !
+  ZHWAVE(J) = 0.018*ZVMOD(J)*ZVMOD(J)*(1.+0.015*ZVMOD(J))
+  ZTWAVE(J) = 0.729*ZVMOD(J)
+  ZCWAVE(J) = XG*ZTWAVE(J)/(2.*XPI)
+  ZLWAVE(J) = ZTWAVE(J)*ZCWAVE(J)
+  !
+ENDDO
+!
+   
+!
+DO JLOOP=1,MAXVAL(ITERMAX) ! begin of iterative loop
+  !
+  DO J=1,SIZE(PTA)
+    !
+    IF (JLOOP.GT.ITERMAX(J)) CYCLE
+    !
+    IF (NGRVWAVES==0) THEN
+      ZO(J) = ZCHARN(J)*ZUSR(J)*ZUSR(J)/XG + 0.11*ZVISA(J)/ZUSR(J) !Smith 1988
+    ELSE IF (NGRVWAVES==1) THEN
+      ZO(J) = (50./(2.*XPI))*ZLWAVE(J)*(ZUSR(J)/ZCWAVE(J))**4.5 &
+              + 0.11*ZVISA(J)/ZUSR(J)                       !Oost et al. 2002  
+    ELSE IF (NGRVWAVES==2) THEN
+      ZO(J) = 1200.*ZHWAVE(J)*(ZHWAVE(J)/ZLWAVE(J))**4.5 &
+              + 0.11*ZVISA(J)/ZUSR(J)                       !Taulor and Yelland 2001  
+    ENDIF
+    !
+    ZRR(J) = ZO(J)*ZUSR(J)/ZVISA(J)
+    ZOQ(J) = MIN(1.15E-4 , 5.5E-5/ZRR(J)**0.6)
+    ZOT(J) = ZOQ(J)
+    !
+    ZZL(J) = XKARMAN * XG * PUREF(J) * &
+              ( ZTSR(J)*(1.+ZRVSRDM1*PQA(J)) + ZRVSRDM1*ZTA(J)*ZQSR(J) ) / &
+              ( ZTA(J)*ZUSR(J)*ZUSR(J)*(1.+ZRVSRDM1*PQA(J)) )  
+    ZZTL(J)= ZZL(J)*PZREF(J)/PUREF(J)  ! for T 
+!    ZZQL(J)=ZZL(J)*PZREF(J)/PUREF(J)  ! for Q
+  ENDDO
+  !
+  ZPUZ(:) = PSIFCTU(ZZL(:))     
+  ZPTZ(:) = PSIFCTT(ZZTL(:))
+  !
+  DO J=1,SIZE(PTA)
+    !
+    ! ZPQZ(J)=PSIFCTT(ZZQL(J))    
+    ZPQZ(J) = ZPTZ(J)
+    !
+    !             3.1 scale parameters
+    !
+    ZUSR(J) = ZDUWG(J)*XKARMAN/(LOG(PUREF(J)/ZO(J)) -ZPUZ(J))
+    ZTSR(J) = -ZDT(J)  *XKARMAN/(LOG(PZREF(J)/ZOT(J))-ZPTZ(J))
+    ZQSR(J) = -ZDQ(J)  *XKARMAN/(LOG(PZREF(J)/ZOQ(J))-ZPQZ(J))
+    !
+    !             3.2 Gustiness factor (ZWG)
+    !
+    IF(LPWG) THEN
+      ZBF(J) = -XG/ZTA(J)*ZUSR(J)*(ZTSR(J)+ZRVSRDM1*ZTA(J)*ZQSR(J))
+      IF (ZBF(J)>0.) THEN
+        ZWG(J) = ZBETAGUST*(ZBF(J)*ZZBL)**(1./3.)
+      ELSE
+        ZWG(J) = 0.2
+      ENDIF
+    ENDIF  
+    ZDUWG(J) = SQRT(ZVMOD(J)**2 + ZWG(J)**2)
+    !
+  ENDDO
+  !
+ENDDO
+!-------------------------------------------------------------------------------
+!
+!            4.  COMPUTE transfer coefficients PCD, PCH, ZCE and SURFACE FLUXES
+!                --------------------------------------------------------------
+!
+ZTAU(:) = XUNDEF
+ZHF(:)  = XUNDEF
+ZEF(:)  = XUNDEF
+!
+ZWBAR(:) = 0.
+ZTAUR(:) = 0.
+ZRF(:)   = 0.
+!
+DO J=1,SIZE(PTA)
+  !
+  !
+  !            4. transfert coefficients PCD, PCH and PCE 
+  !                 and neutral PCDN, ZCHN, ZCEN 
+  !
+  PCD(J) = (ZUSR(J)/ZDUWG(J))**2.
+  PCH(J) = ZUSR(J)*ZTSR(J)/(ZDUWG(J)*(ZTA(J)*PEXNS(J)/PEXNA(J)-PSST(J)))
+  PCE(J) = ZUSR(J)*ZQSR(J)/(ZDUWG(J)*(PQA(J)-PQSAT(J)))
+  !
+  PCDN(J) = (XKARMAN/LOG(ZS/ZO(J)))**2.
+  ZCHN(J) = (XKARMAN/LOG(ZS/ZO(J)))*(XKARMAN/LOG(ZS/ZOT(J)))
+  ZCEN(J) = (XKARMAN/LOG(ZS/ZO(J)))*(XKARMAN/LOG(ZS/ZOQ(J)))
+  !
+  ZLV(J) = XLVTT + (XCPV-XCL)*(PSST(J)-XTT)
+  !
+  !            4. 2 surface fluxes 
+  !
+  IF (ABS(PCDN(J))>1.E-2) THEN   !!!! secure COARE3.0 CODE 
+    write(*,*) 'pb PCDN in COARE30: ',PCDN(J)
+    write(*,*) 'point: ',J,"/",SIZE(PTA)
+    write(*,*) 'roughness: ', ZO(J)
+    write(*,*) 'ustar: ',ZUSR(J)
+    write(*,*) 'wind: ',ZDUWG(J)
+    CALL abort_physic('COARE30',': PCDN too large -> no convergence',1)
+  ELSE
+    ZTSR(J) = -ZTSR(J)
+    ZQSR(J) = -ZQSR(J)
+    ZTAU(J) = -PRHOA(J)*ZUSR(J)*ZUSR(J)*ZVMOD(J)/ZDUWG(J)
+    ZHF(J)  =  PRHOA(J)*XCPD*ZUSR(J)*ZTSR(J)
+    ZEF(J)  =  PRHOA(J)*ZLV(J)*ZUSR(J)*ZQSR(J)
+    !    
+    !           4.3 Contributions to surface  fluxes due to rainfall
+    !
+    ! SB: a priori, le facteur ZRDSRV=XRD/XRV est introduit pour
+    !     adapter la formule de Clausius-Clapeyron (pour l'air
+    !     sec) au cas humide.
+    IF (LPRECIP) THEN
+      ! 
+      ! heat surface  fluxes
+      !
+      ZTAC(J)  = ZTA(J)-XTT
+      !
+      ZXLR(J)  = XLVTT + (XCPV-XCL)* ZTAC(J)                            ! latent heat of rain vaporization
+      ZDQSDT(J)= ZQASAT(J) * ZXLR(J) / (XRD*ZTA(J)**2)                  ! Clausius-Clapeyron relation
+      ZDTMP(J) = (1.0 + 3.309e-3*ZTAC(J) -1.44e-6*ZTAC(J)*ZTAC(J)) * &  !heat diffusivity
+                  0.02411 / (PRHOA(J)*XCPD)
+      !
+      ZDWAT(J) = 2.11e-5 * (XP00/ZPA(J)) * (ZTA(J)/XTT)**1.94           ! water vapour diffusivity from eq (13.3)
+      !                                                                 ! of Pruppacher and Klett (1978)      
+      ZALFAC(J)= 1.0 / (1.0 + &                                         ! Eq.11 in GoF95
+                   ZRDSRV*ZDQSDT(J)*ZXLR(J)*ZDWAT(J)/(ZDTMP(J)*XCPD))   ! ZALFAC=wet-bulb factor (sans dim)     
+      ZCPLW(J) = 4224.8482 + ZTAC(J) * &
+                              ( -4.707 + ZTAC(J) * &
+                                (0.08499 + ZTAC(J) * &
+                                  (1.2826e-3 + ZTAC(J) * &
+                                    (4.7884e-5 - 2.0027e-6* ZTAC(J))))) ! specific heat  
+      !       
+      ZRF(J)   = PRAIN(J) * ZCPLW(J) * ZALFAC(J) * &                    !Eq.12 in GoF95 !SIGNE?
+                   (PSST(J) - ZTA(J) + (PQSAT(J)-PQA(J))*ZXLR(J)/XCPD )
+      !
+      ! Momentum flux due to rainfall  
+      !
+      ZTAUR(J)=-0.85*(PRAIN(J) *ZVMOD(J)) !pp3752 in FBR96
+      !
+    ENDIF
+    !
+    !             4.4   Webb correction to latent heat flux
+    ! 
+    ZWBAR(J)=- (1./ZRDSRV)*ZUSR(J)*ZQSR(J) / (1.0+(1./ZRDSRV)*PQA(J)) &
+               - ZUSR(J)*ZTSR(J)/ZTA(J)                        ! Eq.21*rhoa in FBR96    
+    !
+    !             4.5   friction velocity which contains correction du to rain            
+    !
+    ZUSTAR2(J)= - (ZTAU(J) + ZTAUR(J)) / PRHOA(J)
+    PUSTAR(J) =  SQRT(ZUSTAR2(J))
+    !
+    !             4.6   Total surface fluxes
+    !           
+    PSFTH (J) =  ZHF(J) + ZRF(J)
+    PSFTQ (J) =  ZEF(J) / ZLV(J)
+    ! 
+  ENDIF
+ENDDO 
+
+
+coeffs = [PCD,&
+       PCE,&
+       PCH]
+                     
+!-------------------------------------------------------------------------------
+!
+!       5.  FINAL STEP : TOTAL SURFACE FLUXES AND DERIVED DIAGNOSTICS 
+!           -----------
+!       5.1    Richardson number
+!             
+!
+!------------STOP LA --------------------
+!ZDIRCOSZW(:) = 1.
+! CALL SURFACE_RI(PSST,PQSAT,PEXNS,PEXNA,ZTA,ZQASAT,&
+!                PZREF,PUREF,ZDIRCOSZW,PVMOD,PRI   )  
+!!
+!!       5.2     Aerodynamical conductance and resistance
+!!             
+!ZAC(:) = PCH(:)*ZVMOD(:)
+!PRESA(:) = 1. / MAX(ZAC(:),XSURF_EPSILON)
+!
+!!       5.3 Z0 and Z0H over sea
+!!
+!PZ0SEA(:) =  ZCHARN(:) * ZUSTAR2(:) / XG + XVZ0CM * PCD(:) / PCDN(:)
+!!
+!!PZ0HSEA(:) = PZ0SEA(:)
+!!
+!IF (LHOOK) CALL DR_HOOK('COARE30_FLUX',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE COARE30_FLUX_CNRM
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/coare_cp.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/coare_cp.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/coare_cp.F90	(revision 4727)
@@ -0,0 +1,252 @@
+real function psit_30(zet)
+
+  real, intent(in) :: zet
+
+  if(zet<0) then
+     x=(1.-(15*zet))**.5 
+     psik=2*log((1+x)/2) 
+     x=(1.-(34.15*zet))**.3333 
+     psic=1.5*log((1.+x+x*x)/3.)-sqrt(3.)*atan((1.+2.*x)/sqrt(3.))+4.*atan(1.)/sqrt(3.) 
+     f=zet*zet/(1+zet*zet) 
+     psit_30=(1-f)*psik+f*psic   
+
+  else
+     c=min(50.,.35*zet) 
+     psit_30=-((1.+2./3.*zet)**1.5+.6667*(zet-14.28)/exp(c)+8.525)
+  endif
+end FUNCTION psit_30
+
+real function psiuo(zet)
+
+  real, intent(in) :: zet
+
+  if (zet<0) then 
+
+     x=(1.-15.*zet)**.25 
+     psik=2.*log((1.+x)/2.)+log((1.+x*x)/2.)-2.*atan(x)+2.*atan(1.) 
+     x=(1.-10.15*zet)**.3333 
+     psic=1.5*log((1.+x+x*x)/3.)-sqrt(3.)*atan((1.+2.*x)/sqrt(3.))+4.*atan(1.)/sqrt(3.) 
+     f=zet*zet/(1+zet*zet) 
+     psiuo=(1-f)*psik+f*psic                                                
+  else
+     c=min(50.,.35*zet) 
+     psiuo=-((1+1.0*zet)**1.0+.667*(zet-14.28)/exp(c)+8.525)
+  endif
+END FUNCTION psiuo
+
+
+real function gen_q1(ts,p,dq)
+
+  real, intent(in) :: ts,p,dq
+  real es,qs
+
+  es = 6.112*exp(17.502*(ts-273.15)/(ts-32.18))*.98*(1.0007+3.46e-8*p)
+  qs = es*62.197/(p-37.8*es)
+
+  q1 = dq + qs  
+
+end function gen_q1
+
+
+
+
+subroutine coare_cp(du,dt,dq,&
+     t,q,&
+     zu,zt,zq,&
+     p,zi,&
+     nits,&
+     coeffs,rugosm,rugosh)
+  !     zo,tau,hsb,hlb,&
+  !     var)
+  !version with shortened iteration  modified Rt and Rq
+  !uses wave information wave period in s and wave ht in m
+  !no wave, standard coare 2.6 charnock:  jwave=0 
+  !Oost et al.  zo=50/2/pi L (u*/c)**4.5 if jwave=1
+  !taylor and yelland  zo=1200 h*(L/h)**4.5 jwave=2
+  !
+  USE MODD_CSTS,       ONLY : XKARMAN, XG, XSTEFAN, XRD, XRV, XPI, &
+                            XLVTT, XCL, XCPD, XCPV, XRHOLW, XTT, &
+                            XP00
+
+  IMPLICIT NONE
+
+  real, intent(in) :: du,dt,dq,t,q
+  real, intent(in) :: zu,zt,zq,p,zi
+  integer, intent(in) :: nits
+  ! real, dimension (nits), intent(out) :: zo,tau,hsb,hlb
+  ! real, dimension(nits,3), intent(out) :: var
+  real, dimension(3), intent(out) :: coeffs
+  real, intent(out) :: rugosm
+  real, intent(out) :: rugosh
+
+  real, parameter ::  beta=1.2, von=.4, fdg = 1. ,&
+       tdk = 273.16, pi = 3.141593, grav = 9.82,&
+       rgas = 287.1
+
+  integer, dimension(3) :: shape_input
+
+  real bf, cc, rhoa, visa,&
+       u10, ut, uts, ut0, ug,&
+       cd10, ch10, ct, ct10,&
+       charn, ribu,&
+       l, l10, &
+       ribcu,rr,&
+       zet,zetu, zom10, zoh10, zot, zoq, zot10,&
+       cd, ch, le, cpa, cpv,&
+       usr,qsr,tsr,&
+       zom, t_c
+
+!, ZTWAVE, ZHWAVE, ZCWAVE, ZLWAVE
+
+
+
+
+  real old_usr, old_tsr, old_qsr,tmp
+
+  real, external :: psit_30, psiuo, grv
+  integer i,j,k
+!---------------- Rajout pour prendre en compte différent Z0 --------------------------------!
+!  INTEGER :: NGRVWAVES        ! Pour le choix du z0
+!  NGRVWAVES = 2
+!---------------------------------------------------------------------------------------------
+!-------------------- Attention Modif réalisée pas SURRR -------------------------------------
+!---------------------------------------------------------------------------------------------
+
+  Ribcu=-zu/zi/.004/Beta**3 
+  cpa=1004.67 
+
+  t_c = t - 273.15
+
+
+  Le=(2.501-.00237*(t_c-dt))*1e6 
+
+
+  visa=1.326e-5*(1+6.542e-3*(t_c)+8.301e-6*t_c**2-4.84e-9*t_c**3) 
+
+
+  cpv=cpa*(1+0.84*Q) 
+  rhoa=P/(Rgas*t*(1+0.61*Q)) 
+
+
+
+
+
+
+  ug=.2 
+
+  ut=sqrt(du*du+ug*ug) 
+  ut=MAX(ut , 0.1 * MIN(10.,zu) )
+
+  u10=ut*log(10/1e-4)/log(zu/1e-4) 
+  usr=.035*u10                              ! turbulent friction velocity (m/s), including gustiness
+  zom10=0.011*usr*usr/grav+0.11*visa/usr     ! roughness length for u (smith 88)
+  Cd10=(von/log(10/zom10))**2 
+!  zoh10=0.40*visa/usr+1.4e-5
+!  Ch10=((von**2)/((log(10/zom10))*(log(10/zoh10)))) !ammener à devenir ca 
+  Ch10=0.00115 
+  Ct10=Ch10/sqrt(Cd10) 
+  zot10=10/exp(von/Ct10)                    ! roughness length for t
+  Cd=(von/log(zu/zom10))**2 
+  Ct=von/log(zt/zot10) 
+  CC=von*Ct/Cd 
+
+  ut0 = ut
+
+
+  ut = ut0
+  Ribu=grav*zu/t*(dt+.61*t*dq)/ut**2 
+
+  if (Ribu .LT. 0) then 
+     zetu=CC*Ribu/(1+Ribu/Ribcu) 
+  else 
+     zetu=CC*Ribu*(1+27/9*Ribu/CC) 
+  endif
+
+  L10=zu/zetu 
+
+  ! if (zetu .GT. 50) then 
+  !    nits=1 
+  ! endif
+
+  usr=ut*von/(log(zu/zom10)-psiuo(zetu))
+  tsr=dt*von*fdg/(log(zt/zot10)-psit_30(zt/L10)) 
+  qsr=dq*von*fdg/(log(zq/zot10)-psit_30(zq/L10)) 
+  !  tkt=.001
+
+  ! charnock constant - lin par morceau - constant
+  if ( ut <= 10. ) then
+     charn=0.011 
+  else
+     if (ut .GT. 18) then
+        charn=0.018
+     else
+        charn=0.011+(ut-10)/(18-10)*(0.018-0.011) 
+     endif
+  endif
+
+!  ZHWAVE = 0.018*ut*ut*(1.+0.015*ut)
+!  ZTWAVE = 0.729*ut
+!  ZCWAVE = XG*ZTWAVE/(2.*pi)
+!  ZLWAVE = ZTWAVE*ZCWAVE
+
+
+  !***************  bulk loop ************
+  do i=1, nits 
+
+     zet=von*grav*zu/t*(tsr*(1+0.61*Q)+.61*t*qsr)/(usr*usr)/(1+0.61*Q)
+
+!     IF (NGRVWAVES==0) THEN
+!       zom = charn*usr*usr/XG + 0.11*visa/usr !Smith 1988
+!     ELSE IF (NGRVWAVES==1) THEN
+!       zom = (50./(2.*pi))*ZLWAVE*(usr/ZCWAVE)**4.5 &
+!               + 0.11*visa/usr                       !Oost et al. 2002  
+!     ELSE IF (NGRVWAVES==2) THEN
+!       zom = 1200.*ZHWAVE*(ZHWAVE/ZLWAVE)**4.5 &
+!               + 0.11*visa/usr                       !Taulor and Yelland 2001  
+!     ENDIF 
+
+     zom=charn*usr*usr/grav+0.11*visa/usr 
+
+     rr=zom*usr/visa 
+     L=zu/zet 
+     zoq=min(1.15e-4,5.5e-5/rr**.6)  ! a modifier
+     zot=zoq                         ! a modifier
+!     zot=0.40*visa/usr+1.4e-5 
+
+     old_usr = usr
+     old_tsr = tsr
+     old_qsr = qsr
+
+     usr=ut*von/(log(zu/zom)-psiuo(zu/L)) 
+     tsr=dt*von*fdg/(log(zt/zot)-psit_30(zt/L)) 
+     qsr=dq*von*fdg/(log(zq/zoq)-psit_30(zq/L)) 
+
+     Bf=-grav/t*usr*(tsr+.61*t*qsr) 
+
+     if (Bf .GT. 0) then 
+        ug=Beta*(Bf*zi)**.333 
+     else 
+        ug=.2 
+     endif
+
+     ut=sqrt(du*du+ug*ug) 
+     ut=MAX(ut , 0.1 * MIN(10.,zu) )
+
+
+  enddo !bulk iter loop
+
+  ! coeffs(m1,m2,m3,m4,m5,1)=rhoa*usr*usr*du/ut !stress
+  ! coeffs(m1,m2,m3,m4,m5,2)=rhoa*cpa*usr*tsr 
+  ! coeffs(m1,m2,m3,m4,m5,3)=rhoa*Le*usr*qsr 
+
+  tmp = (von/(log(zu/zom)-psiuo(zu/L)) ) * ut / du
+
+  coeffs = [tmp**2,&
+       von*fdg/(log(zt/zot)-psit_30(zt/L)) * tmp,&
+       von*fdg/(log(zq/zoq)-psit_30(zq/L)) * tmp]
+
+  rugosm = zom
+  rugosh = zot
+
+
+end subroutine coare_cp
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/coef_diff_turb_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/coef_diff_turb_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/coef_diff_turb_mod.F90	(revision 4727)
@@ -159,5 +159,11 @@
 !!$!          ycdragm(1:knon) = ycoefh(1:knon,1)
 !!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-       CALL ustarhb(knon,yu,yv,ycdragm, yustar)
+
+       ! Normalement, on peut passer dans les codes avec knon=0
+       ! Mais ca fait planter le replay.
+       ! En attendant une réécriture, on a joute des if (Fredho)
+       if ( klon>1 .or. (klon==1 .and. knon==1) ) then
+          CALL ustarhb(knon,klev,knon,yu,yv,ycdragm, yustar)
+       endif
      
        IF (prt_level > 9) THEN
@@ -167,8 +173,10 @@
 !   iflag_pbl peut etre utilise comme longuer de melange
        IF (iflag_pbl.GE.31) THEN
-          CALL vdif_kcay(knon,dtime,RG,RD,ypaprs,yt, &
+          if ( klon>1 .or. (klon==1 .and. knon==1) ) then
+          CALL vdif_kcay(knon,klev,knon,dtime,RG,RD,ypaprs,yt, &
                yzlev,yzlay,yu,yv,yteta, &
                ycdragm,yq2,q2diag,ykmm,ykmn,yustar, &
                iflag_pbl)
+          endif
        ELSE IF (iflag_pbl<20) THEN
           CALL yamada4(ni,nsrf,knon,dtime,RG,RD,ypaprs,yt, &
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/concvl.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/concvl.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/concvl.F90	(revision 4727)
@@ -3,5 +3,5 @@
                   t, q, t_wake, q_wake, s_wake, u, v, tra, ntra, &
                   Ale, Alp, sig1, w01, &
-                  d_t, d_q, d_u, d_v, d_tra, &
+                  d_t, d_q, d_qcomp, d_u, d_v, d_tra, &
                   rain, snow, kbas, ktop, sigd, &
                   cbmf, plcl, plfc, wbeff, convoccur, &
@@ -16,5 +16,5 @@
                   dd_t, dd_q, lalim_conv, wght_th, &                 ! RomP
                   evap, ep, epmlmMm, eplaMm, &                       ! RomP
-                  wdtrainA, wdtrainS, wdtrainM, wght, qtc, sigt, &
+                  wdtrainA, wdtrainS, wdtrainM, wght, qtc, sigt, detrain, &
                   tau_cld_cv, coefw_cld_cv, &                           ! RomP+RL, AJ
 !RomP <<<
@@ -105,5 +105,5 @@
   REAL, DIMENSION(klon,klev),   INTENT(INOUT)   :: sig1, w01
 
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: d_t, d_q, d_u, d_v
+  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: d_t, d_q, d_qcomp, d_u, d_v
   REAL, DIMENSION(klon,klev, nbtr),INTENT(OUT)  :: d_tra
   REAL, DIMENSION(klon),        INTENT(OUT)     :: rain, snow
@@ -145,5 +145,5 @@
   REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: wght                       !RL
   REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: qtc
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: sigt
+  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: sigt, detrain
   REAL,                         INTENT(OUT)     :: tau_cld_cv, coefw_cld_cv
   REAL, DIMENSION(klon),        INTENT(OUT)     :: epmax_diag                ! epmax_cape
@@ -429,5 +429,5 @@
                     Ale, Alp, omega, &
                     em_sig1feed, em_sig2feed, em_wght, &
-                    iflag, d_t, d_q, d_u, d_v, d_tra, rain, kbas, ktop, &
+                    iflag, d_t, d_q, d_qcomp, d_u, d_v, d_tra, rain, kbas, ktop, &
                     cbmf, plcl, plfc, wbeff, sig1, w01, ptop2, sigd, &
                     Ma, mip, Vprecip, Vprecipi, upwd, dnwd, dnwdbis, qcondc, wd, &
@@ -440,5 +440,5 @@
                     da, phi, mp, phii, d1a, dam, sij, wght, &           ! RomP+RL
                     qta, clw, elij, evap, ep, epmlmMm, eplaMm, &        ! RomP+RL
-                    wdtrainA, wdtrainS, wdtrainM, qtc, sigt, &
+                    wdtrainA, wdtrainS, wdtrainM, qtc, sigt, detrain, &
                     tau_cld_cv, coefw_cld_cv, &                         ! RomP,AJ
 !AC!+!RomP+jyg
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/conf_phys_m.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/conf_phys_m.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/conf_phys_m.F90	(revision 4727)
@@ -16,5 +16,5 @@
        fact_cldcon, facttemps,ok_newmicro,iflag_radia,&
        iflag_cld_th, &
-       iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
+       ratqsbas,ratqshaut,tau_ratqs, &
        ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan, flag_volc_surfstrat, aerosol_couple, & 
        chemistry_couple, flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
@@ -29,11 +29,12 @@
     USE carbon_cycle_mod,  ONLY: read_fco2_ocean_cor,var_fco2_ocean_cor
     USE carbon_cycle_mod,  ONLY: read_fco2_land_cor,var_fco2_land_cor
+    USE chemistry_cycle_mod, ONLY: dms_cycle_cpl
     USE mod_grid_phy_lmdz, ONLY: klon_glo
     USE print_control_mod, ONLY: lunout
     use config_ocean_skin_m, only: config_ocean_skin
     USE phys_state_var_mod, ONLY: phys_tstep
+    USE infotrac_phy, ONLY: type_trac
 
     INCLUDE "conema3.h"
-    INCLUDE "fisrtilp.h"
     INCLUDE "nuage.h"
     INCLUDE "YOMCST.h"
@@ -86,5 +87,5 @@
     REAL                 :: fact_cldcon, facttemps,ratqsbas,ratqshaut,tau_ratqs
     INTEGER              :: iflag_cld_th
-    INTEGER              :: iflag_ratqs
+     
 
     CHARACTER (len = 6), SAVE  :: type_ocean_omp, version_ocean_omp, ocean_omp
@@ -171,20 +172,8 @@
     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
     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
     REAL,SAVE :: inertie_sol_omp,inertie_sno_omp,inertie_sic_omp
@@ -200,5 +189,5 @@
     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,6 +223,4 @@
     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
@@ -246,4 +233,5 @@
     LOGICAL, SAVE :: carbon_cycle_cpl_omp
     LOGICAL, SAVE :: carbon_cycle_rad_omp
+    LOGICAL, SAVE :: dms_cycle_cpl_omp
     INTEGER, SAVE :: level_coupling_esm_omp
     LOGICAL, SAVE :: read_fco2_ocean_cor_omp
@@ -255,4 +243,9 @@
     LOGICAL, SAVE :: ok_new_lscp_omp
     LOGICAL, SAVE :: ok_icefra_lscp_omp
+    !rajout de choix_bulk et nit_bulk par Olivier Torres
+    INTEGER,SAVE  :: choix_bulk_omp
+    INTEGER,SAVE  :: nit_bulk_omp
+    INTEGER,SAVE  :: kz0_omp
+    LOGICAL, SAVE :: ok_bs_omp, ok_rad_bs_omp
 
 
@@ -948,4 +941,31 @@
     CALL getin('nbapp_rad',nbapp_rad_omp)
 
+    !rajout Olivier Torres
+    !Config  Key  = choix_bulk
+    !Config  Desc = choix de la formulation bulk a prendre dans clcdrag au-dessus de l'ocean
+    !Config  Def  = 0
+    !Config         0 -> originale (lmdz/Louis 79)
+    !Config         1 -> COARE
+    !Config         2 -> CORE-"pure" (cf. Large)
+    !Config         3 -> CORE-"mixte" (avec z_0 et C_T^N donnees par Smith 88)
+    choix_bulk_omp = 0
+    CALL getin('choix_bulk',choix_bulk_omp)
+
+    !Config  Key  = nit_bulk
+    !Config  Desc = choix du nombre d'it de pt fixe dans la bulk
+    !Config  Def  = 5
+    nit_bulk_omp = 1
+    CALL getin('nit_bulk',nit_bulk_omp)
+
+    !Config  Key  = kz0
+    !Config  Desc = choix de la formulation z0 pour la bulk ECUME
+    !Config  Def  = 1
+    !Config         0 -> ARPEGE formulation
+    !Config         1 -> Smith Formulation
+    !Config         2 -> Direct computation using the stability functions
+    kz0_omp = 0
+    CALL getin('kz0',kz0_omp)
+
+
     !Config  Key  = iflag_con
     !Config  Desc = Flag de convection
@@ -992,21 +1012,4 @@
     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)
-
     !
     !
@@ -1067,76 +1070,5 @@
     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
@@ -1254,12 +1186,4 @@
 
     !
-    !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 =  
@@ -1412,85 +1336,4 @@
     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
-    !Config Desc =  
-    !Config Def  = 0
-    !Config Help = 
-    !
-    iflag_rei_omp = 0
-    CALL getin('iflag_rei',iflag_rei_omp)
-
 
     !
@@ -1527,22 +1370,4 @@
     ok_plane_contrail_omp = .FALSE.
     CALL getin('ok_plane_contrail',ok_plane_contrail_omp)
-
-    !
-    !Config Key  = rei_min
-    !Config Desc =  
-    !Config Def  = 3.5
-    !Config Help = 
-    !
-    rei_min_omp = 3.5
-    CALL getin('rei_min',rei_min_omp)
-
-    !
-    !Config Key  = rei_max
-    !Config Desc =  
-    !Config Def  = 61.29
-    !Config Help = 
-    !
-    rei_max_omp = 61.29
-    CALL getin('rei_max',rei_max_omp)
 
     !
@@ -1664,4 +1489,7 @@
     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
@@ -1713,10 +1541,9 @@
     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)
@@ -2359,4 +2186,22 @@
     !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.
@@ -2400,4 +2245,14 @@
     CALL getin('level_coupling_esm',level_coupling_esm_omp)
 
+
+    dms_cycle_cpl_omp=.FALSE.
+    CALL getin('transm_dms_oa',dms_cycle_cpl_omp)
+    !
+    !Config Key  = dms_cycle_cpl
+    !Config Desc = receive dms from pisces via oasis
+    !Config Def  = .FALSE.
+    !Config Help = can be activated only if lmdz use inca for the atmospheric chemistry 
+
+    
     !$OMP END MASTER
     !$OMP BARRIER
@@ -2446,21 +2301,8 @@
     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
@@ -2473,22 +2315,13 @@
     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
     ok_ice_sursat = ok_ice_sursat_omp
     ok_plane_h2o = ok_plane_h2o_omp
     ok_plane_contrail = ok_plane_contrail_omp
-    rei_min = rei_min_omp
-    rei_max = rei_max_omp
     top_height = top_height_omp
     overlap = overlap_omp
@@ -2502,4 +2335,5 @@
     pmagic = pmagic_omp
     iflag_pbl = iflag_pbl_omp
+    iflag_physiq = iflag_physiq_omp
     iflag_pbl_split = iflag_pbl_split_omp
 !FC
@@ -2692,4 +2526,9 @@
     read_fco2_land_cor = read_fco2_land_cor_omp
     var_fco2_land_cor = var_fco2_land_cor_omp
+    dms_cycle_cpl = dms_cycle_cpl_omp
+    !rajout Olivier Torres
+    kz0=kz0_omp
+    choix_bulk = choix_bulk_omp
+    nit_bulk = nit_bulk_omp
 
     ! Test of coherence between type_ocean and version_ocean
@@ -2811,4 +2650,10 @@
     ENDIF
 
+
+    ! Test on chemistry cycle 
+    IF ((type_trac .ne. "inca" .AND. type_trac .ne. "inco") .AND. dms_cycle_cpl ) THEN 
+       CALL abort_physic('conf_phys', 'dms_cycle_cpl has to be TRUE only with INCA coupling model',1)
+    ENDIF
+    
     ! ORCHIDEE must be activated for ifl_pbltree=1
     IF (.NOT. ok_veget .AND. ifl_pbltree==1) THEN
@@ -2872,20 +2717,8 @@
     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
@@ -2909,19 +2742,8 @@
     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
     WRITE(lunout,*) ' ok_ice_sursat = ',ok_ice_sursat
     WRITE(lunout,*) ' ok_plane_h2o = ',ok_plane_h2o
     WRITE(lunout,*) ' ok_plane_contrail = ',ok_plane_contrail
-    WRITE(lunout,*) ' rei_min = ',rei_min
-    WRITE(lunout,*) ' rei_max = ',rei_max
     WRITE(lunout,*) ' overlap = ',overlap 
     WRITE(lunout,*) ' cdmmax = ',cdmmax 
@@ -2957,4 +2779,5 @@
     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
@@ -2982,4 +2805,6 @@
     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
@@ -3039,4 +2864,5 @@
     WRITE(lunout,*) ' read_fco2_land_cor = ', read_fco2_land_cor
     WRITE(lunout,*) ' var_fco2_land_cor = ', var_fco2_land_cor
+    WRITE(lunout,*) ' dms_cycle_cpl = ', dms_cycle_cpl
     WRITE(lunout,*) ' iflag_tsurf_inlandsis = ', iflag_tsurf_inlandsis
     WRITE(lunout,*) ' iflag_temp_inlandsis = ', iflag_temp_inlandsis
@@ -3056,4 +2882,8 @@
     WRITE(lunout,*) ' buf_sph_pol = ', buf_sph_pol
     WRITE(lunout,*) ' buf_siz_pol= ', buf_siz_pol
+    !rajout Olivier Torres
+    write(lunout,*) 'choix_bulk = ', choix_bulk
+    write(lunout,*) 'nit_bulk = ', nit_bulk
+    write(lunout,*) 'kz0 = ', kz0
 
     !$OMP END MASTER
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/cosp_output_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/cosp_output_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/cosp_output_mod.F90	(revision 4727)
@@ -235,9 +235,6 @@
   USE time_phylmdz_mod, ONLY: day_ref, annee_ref, day_ini, start_time, itau_phy
   USE print_control_mod, ONLY: lunout
-
-#ifdef CPP_XIOS
-    ! ug Pour les sorties XIOS
-    USE wxios
-#endif
+  ! ug Pour les sorties XIOS
+  USE wxios
 
   IMPLICIT NONE
@@ -263,11 +260,9 @@
 !!! Variables d'entree
 
-#ifdef CPP_XIOS
-    ! ug Variables utilisées pour récupérer le calendrier pour xios
-    INTEGER :: x_an, x_mois, x_jour
-    REAL :: x_heure
-    INTEGER :: ini_an, ini_mois, ini_jour
-    REAL :: ini_heure
-#endif
+  ! ug Variables utilisées pour récupérer le calendrier pour xios
+  INTEGER :: x_an, x_mois, x_jour
+  REAL :: x_heure
+  INTEGER :: ini_an, ini_mois, ini_jour
+  REAL :: ini_heure
 
     WRITE(lunout,*) 'Debut cosp_output_mod.F90'
@@ -316,39 +311,39 @@
     CALL ymds2ju(annee_ref, 1, day_ini, start_time, zjulian_start)
 
-#ifdef CPP_XIOS
+    IF (using_xios) THEN
     
-! recuperer la valeur indefine Xios
-!    CALL xios_get_field_attr("clcalipso",default_value=Cosp_fill_value)
-!         Cosp_fill_value=missing_val
-          Cosp_fill_value=0.
-         print*,'Cosp_fill_value=',Cosp_fill_value
-!    if (use_vgrid) then
-!      print*,'vgrid%Nlvgrid, vgrid%z = ',vgrid%Nlvgrid, vgrid%z
-        CALL wxios_add_vaxis("height", vgrid%Nlvgrid, vgrid%z)
-     print*,'wxios_add_vaxis '
-!    else
-!         WRITE(lunout,*) 'wxios_add_vaxis "presnivs", vgrid%Nlvgrid ',vgrid%Nlvgrid
-!        CALL wxios_add_vaxis("presnivs", vgrid%Nlvgrid, presnivs)
-!    endif
-    WRITE(lunout,*) 'wxios_add_vaxis height_mlev, Nlevlmdz ',Nlevlmdz
-    CALL wxios_add_vaxis("height_mlev", Nlevlmdz, vgrid%mz)
-    WRITE(lunout,*) 'wxios_add_vaxis sza, PARASOL_NREFL ',PARASOL_NREFL
-    CALL wxios_add_vaxis("sza", PARASOL_NREFL, PARASOL_SZA)
-    WRITE(lunout,*) 'wxios_add_vaxis pressure2 ',7
-    CALL wxios_add_vaxis("pressure2", 7, ISCCP_PC)
-    WRITE(lunout,*) 'wxios_add_vaxis column ',Ncolumns
-    CALL wxios_add_vaxis("column", Ncolumns, column_ax)
-
-! AI nov 2015
-   CALL wxios_add_vaxis("temp", LIDAR_NTEMP, LIDAR_PHASE_TEMP)
-   CALL wxios_add_vaxis("cth", MISR_N_CTH, MISR_CTH)
-   CALL wxios_add_vaxis("dbze", DBZE_BINS, dbze_ax) 
-   CALL wxios_add_vaxis("scatratio", SR_BINS, sratio_ax)
-   CALL wxios_add_vaxis("ReffIce", numMODISReffIceBins, reffICE_binCenters)
-   CALL wxios_add_vaxis("ReffLiq", numMODISReffLiqBins, reffLIQ_binCenters)
-   print*,'reffICE_binCenters=',reffICE_binCenters
-   CALL wxios_add_vaxis("tau", 7, ISCCP_TAU)
-
-#endif
+  ! recuperer la valeur indefine Xios
+  !    CALL xios_get_field_attr("clcalipso",default_value=Cosp_fill_value)
+  !         Cosp_fill_value=missing_val
+            Cosp_fill_value=0.
+           print*,'Cosp_fill_value=',Cosp_fill_value
+  !    if (use_vgrid) then
+  !      print*,'vgrid%Nlvgrid, vgrid%z = ',vgrid%Nlvgrid, vgrid%z
+          CALL wxios_add_vaxis("height", vgrid%Nlvgrid, vgrid%z)
+       print*,'wxios_add_vaxis '
+  !    else
+  !         WRITE(lunout,*) 'wxios_add_vaxis "presnivs", vgrid%Nlvgrid ',vgrid%Nlvgrid
+  !        CALL wxios_add_vaxis("presnivs", vgrid%Nlvgrid, presnivs)
+  !    endif
+      WRITE(lunout,*) 'wxios_add_vaxis height_mlev, Nlevlmdz ',Nlevlmdz
+      CALL wxios_add_vaxis("height_mlev", Nlevlmdz, vgrid%mz)
+      WRITE(lunout,*) 'wxios_add_vaxis sza, PARASOL_NREFL ',PARASOL_NREFL
+      CALL wxios_add_vaxis("sza", PARASOL_NREFL, PARASOL_SZA)
+      WRITE(lunout,*) 'wxios_add_vaxis pressure2 ',7
+      CALL wxios_add_vaxis("pressure2", 7, ISCCP_PC)
+      WRITE(lunout,*) 'wxios_add_vaxis column ',Ncolumns
+      CALL wxios_add_vaxis("column", Ncolumns, column_ax)
+
+  ! AI nov 2015
+     CALL wxios_add_vaxis("temp", LIDAR_NTEMP, LIDAR_PHASE_TEMP)
+     CALL wxios_add_vaxis("cth", MISR_N_CTH, MISR_CTH)
+     CALL wxios_add_vaxis("dbze", DBZE_BINS, dbze_ax) 
+     CALL wxios_add_vaxis("scatratio", SR_BINS, sratio_ax)
+     CALL wxios_add_vaxis("ReffIce", numMODISReffIceBins, reffICE_binCenters)
+     CALL wxios_add_vaxis("ReffLiq", numMODISReffLiqBins, reffLIQ_binCenters)
+     print*,'reffICE_binCenters=',reffICE_binCenters
+     CALL wxios_add_vaxis("tau", 7, ISCCP_TAU)
+
+  ENDIF
    
     zdtimemoy_cosp = freq_COSP         ! Frequence ou l on moyenne
@@ -363,10 +358,10 @@
 !                    nhoricosp(iff),cosp_nidfiles(iff)
 
-#ifdef CPP_XIOS
-        IF (.not. ok_all_xml) then
-         WRITE(lunout,*) 'wxios_add_file ',cosp_outfilenames(iff)
-         CALL wxios_add_file(cosp_outfilenames(iff),chfreq(iff),10)
-        ENDIF
-#endif
+         IF (using_xios) THEN
+           IF (.not. ok_all_xml) then
+             WRITE(lunout,*) 'wxios_add_file ',cosp_outfilenames(iff)
+             CALL wxios_add_file(cosp_outfilenames(iff),chfreq(iff),10)
+           ENDIF
+         ENDIF
 
 #ifndef CPP_IOIPSL_NO_OUTPUT 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/cosp_output_write_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/cosp_output_write_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/cosp_output_write_mod.F90	(revision 4727)
@@ -26,9 +26,6 @@
     USE time_phylmdz_mod, ONLY: itau_phy, start_time, day_step_phy
     USE print_control_mod, ONLY: lunout,prt_level
-
-#ifdef CPP_XIOS
     USE wxios, only: wxios_closedef
-    USE xios, only: xios_update_calendar, xios_field_is_active
-#endif
+    USE lmdz_xios, only: xios_update_calendar, xios_field_is_active, using_xios
   IMPLICIT NONE  
 !!! Variables d'entree
@@ -58,9 +55,9 @@
   real, dimension(Npoints,MISR_N_CTH,7) :: tmp_fi4da_misr
 
-#ifdef CPP_XIOS
-  missing_val=missing_cosp
-#else
-  missing_val=0.
-#endif
+  IF (using_xios) THEN
+    missing_val=missing_cosp
+  ELSE
+    missing_val=0.
+  ENDIF
 
   Nlevout = vgrid%Nlvgrid
@@ -90,5 +87,5 @@
 !   endif
 
-!!#ifdef CPP_XIOS
+!!IF (using_xios) THEN
 ! !$OMP MASTER
 !IF (cosp_varsdefined) THEN
@@ -101,5 +98,5 @@
 !  !$OMP END MASTER
 !  !$OMP BARRIER
-!!#endif
+!!ENDIF
 
 !!!! Sorties Calipso
@@ -163,23 +160,24 @@
    if (cfg%Lproftemp) CALL histwrite3d_cosp(o_proftemp,stlidar%proftemp,nvert)                    !TIBO
 
-#ifdef CPP_XIOS
-   do icl=1,SR_BINS
-      tmp_fi4da_cfadL(:,:,icl)=stlidar%cfad_sr(:,icl,:)
-   enddo
-!   if (cfg%LcfadLidarsr532) CALL histwrite4d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr)
-   if (cfg%LcfadLidarsr532) CALL histwrite4d_cosp(o_cfad_lidarsr532,tmp_fi4da_cfadL)
-   if (cfg%LprofSR) CALL histwrite4d_cosp(o_profSR,stlidar%profSR)                              !TIBO
-#else
-   if (cfg%LcfadLidarsr532) then
+   IF (using_xios) THEN
      do icl=1,SR_BINS
-        CALL histwrite3d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr(:,icl,:),nvert,icl)
+        tmp_fi4da_cfadL(:,:,icl)=stlidar%cfad_sr(:,icl,:)
      enddo
-   endif
-   if (cfg%LprofSR) then
-     do icl=1,Ncolumns                                                              !TIBO
-        CALL histwrite3d_cosp(o_profSR,stlidar%profSR(:,icl,:),nvert,icl)           !TIBO
-     enddo                                                                          !TIBO
-   endif
-#endif
+  !   if (cfg%LcfadLidarsr532) CALL histwrite4d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr)
+     if (cfg%LcfadLidarsr532) CALL histwrite4d_cosp(o_cfad_lidarsr532,tmp_fi4da_cfadL)
+     if (cfg%LprofSR) CALL histwrite4d_cosp(o_profSR,stlidar%profSR)                              !TIBO
+   ELSE
+     if (cfg%LcfadLidarsr532) then
+       do icl=1,SR_BINS
+          CALL histwrite3d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr(:,icl,:),nvert,icl)
+       enddo
+     endif
+     if (cfg%LprofSR) then
+       do icl=1,Ncolumns                                                              !TIBO
+          CALL histwrite3d_cosp(o_profSR,stlidar%profSR(:,icl,:),nvert,icl)           !TIBO
+       enddo                                                                          !TIBO
+      endif
+   ENDIF
+
    if (cfg%LparasolRefl) CALL histwrite3d_cosp(o_parasol_refl,stlidar%parasolrefl,nvertp)
 
@@ -201,13 +199,13 @@
   endif
 
-#ifdef CPP_XIOS
-   if (cfg%Latb532) CALL histwrite4d_cosp(o_atb532,sglidar%beta_tot)
-#else
-   if (cfg%Latb532) then  
-     do icl=1,Ncolumns 
-        CALL histwrite3d_cosp(o_atb532,sglidar%beta_tot(:,icl,:),nvertmcosp,icl)
-     enddo
-   endif 
-#endif
+   IF (using_xios) THEN
+     if (cfg%Latb532) CALL histwrite4d_cosp(o_atb532,sglidar%beta_tot)
+   ELSE
+     if (cfg%Latb532) then  
+       do icl=1,Ncolumns 
+          CALL histwrite3d_cosp(o_atb532,sglidar%beta_tot(:,icl,:),nvertmcosp,icl)
+       enddo
+     endif 
+   ENDIF
 
    if (cfg%LlidarBetaMol532) CALL histwrite3d_cosp(o_beta_mol532,sglidar%beta_mol,nvertmcosp) 
@@ -219,23 +217,23 @@
 
    where(stradar%cfad_ze == R_UNDEF) stradar%cfad_ze = missing_val
-#ifdef CPP_XIOS
-   do icl=1,DBZE_BINS
-     tmp_fi4da_cfadR(:,:,icl)=stradar%cfad_ze(:,icl,:)
-   enddo
-   if (cfg%Ldbze94) CALL histwrite4d_cosp(o_dbze94,sgradar%Ze_tot)
-!   if (cfg%LcfadDbze94) CALL histwrite4d_cosp(o_cfadDbze94,stradar%cfad_ze)
-   if (cfg%LcfadDbze94) CALL histwrite4d_cosp(o_cfadDbze94,tmp_fi4da_cfadR)
-#else
-   if (cfg%Ldbze94) then
-    do icl=1,Ncolumns
-       CALL histwrite3d_cosp(o_dbze94,sgradar%Ze_tot(:,icl,:),nvert,icl)
-    enddo
-   endif
-   if (cfg%LcfadDbze94) then
-    do icl=1,DBZE_BINS
-    CALL histwrite3d_cosp(o_cfadDbze94,stradar%cfad_ze(:,icl,:),nvert,icl)
-    enddo
-   endif
-#endif
+   IF (using_xios) THEN
+     do icl=1,DBZE_BINS
+       tmp_fi4da_cfadR(:,:,icl)=stradar%cfad_ze(:,icl,:)
+     enddo
+     if (cfg%Ldbze94) CALL histwrite4d_cosp(o_dbze94,sgradar%Ze_tot)
+  !  if (cfg%LcfadDbze94) CALL histwrite4d_cosp(o_cfadDbze94,stradar%cfad_ze)
+     if (cfg%LcfadDbze94) CALL histwrite4d_cosp(o_cfadDbze94,tmp_fi4da_cfadR)
+   ELSE
+     if (cfg%Ldbze94) then
+       do icl=1,Ncolumns
+         CALL histwrite3d_cosp(o_dbze94,sgradar%Ze_tot(:,icl,:),nvert,icl)
+       enddo
+     endif
+     if (cfg%LcfadDbze94) then
+       do icl=1,DBZE_BINS
+         CALL histwrite3d_cosp(o_cfadDbze94,stradar%cfad_ze(:,icl,:),nvert,icl)
+       enddo
+     endif
+   ENDIF
  endif
 ! endif pour radar
@@ -264,13 +262,13 @@
 
    CALL histwrite2d_cosp(o_sunlit,gbx%sunlit)
-#ifdef CPP_XIOS
-  if (cfg%Lclisccp) CALL histwrite4d_cosp(o_clisccp2,isccp%fq_isccp)
-#else
-   if (cfg%Lclisccp) then
-     do icl=1,7
-       CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl) 
-     enddo
-   endif
-#endif
+   IF (using_xios) THEN
+     if (cfg%Lclisccp) CALL histwrite4d_cosp(o_clisccp2,isccp%fq_isccp)
+   ELSE
+     if (cfg%Lclisccp) then
+       do icl=1,7
+         CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl) 
+       enddo
+     endif
+   ENDIF
 
    if (cfg%Lboxtauisccp) CALL histwrite3d_cosp(o_boxtauisccp,isccp%boxtau,nvertcol)
@@ -288,17 +286,17 @@
    where(misr%fq_MISR == R_UNDEF) misr%fq_MISR = missing_val
 
-#ifdef CPP_XIOS
-   do icl=1,MISR_N_CTH
-      tmp_fi4da_misr(:,icl,:)=misr%fq_MISR(:,:,icl)
-   enddo
-!   if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,misr%fq_MISR)
-   if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,tmp_fi4da_misr)
-#else
-   if (cfg%LclMISR) then
-    do icl=1,7 
-      CALL histwrite3d_cosp(o_clMISR,misr%fq_MISR(:,icl,:),nvertmisr,icl)
-    enddo
-   endif
-#endif
+   IF (using_xios) THEN
+     do icl=1,MISR_N_CTH
+        tmp_fi4da_misr(:,icl,:)=misr%fq_MISR(:,:,icl)
+     enddo
+  !   if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,misr%fq_MISR)
+     if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,tmp_fi4da_misr)
+   ELSE
+     if (cfg%LclMISR) then
+      do icl=1,7 
+        CALL histwrite3d_cosp(o_clMISR,misr%fq_MISR(:,icl,:),nvertmisr,icl)
+      enddo
+     endif
+   ENDIF
  endif
 ! endif pour Misr
@@ -365,14 +363,14 @@
           modis%Optical_Thickness_vs_Cloud_Top_Pressure = missing_val
 
-#ifdef CPP_XIOS
-   if (cfg%Lclmodis) CALL histwrite4d_cosp(o_clmodis,modis%Optical_Thickness_vs_Cloud_Top_Pressure)
-#else
-  if (cfg%Lclmodis) then
-   do icl=1,7
-   CALL histwrite3d_cosp(o_clmodis, &
-     modis%Optical_Thickness_vs_Cloud_Top_Pressure(:,icl,:),nvertisccp,icl)           
-   enddo
-  endif 
-#endif
+   IF (using_xios) THEN
+     if (cfg%Lclmodis) CALL histwrite4d_cosp(o_clmodis,modis%Optical_Thickness_vs_Cloud_Top_Pressure)
+   ELSE
+     if (cfg%Lclmodis) then
+       do icl=1,7
+         CALL histwrite3d_cosp(o_clmodis, &
+         modis%Optical_Thickness_vs_Cloud_Top_Pressure(:,icl,:),nvertisccp,icl)           
+       enddo
+      endif 
+   ENDIF
 
     where(modis%Optical_Thickness_vs_ReffIce == R_UNDEF) &
@@ -382,21 +380,21 @@
           modis%Optical_Thickness_vs_ReffLiq = missing_val
 
-#ifdef CPP_XIOS
-  if (cfg%Lcrimodis) CALL histwrite4d_cosp(o_crimodis,modis%Optical_Thickness_vs_ReffIce)
-  if (cfg%Lcrlmodis) CALL histwrite4d_cosp(o_crlmodis,modis%Optical_Thickness_vs_ReffLiq)
-#else
-  if (cfg%Lcrimodis) then
-    do icl=1,7
-     CALL histwrite3d_cosp(o_crimodis, &
-          modis%Optical_Thickness_vs_ReffIce(:,icl,:),nvertReffIce,icl)
-    enddo
-  endif
-  if (cfg%Lcrlmodis) then
-    do icl=1,7 
-     CALL histwrite3d_cosp(o_crlmodis, &
-          modis%Optical_Thickness_vs_ReffLiq(:,icl,:),nvertReffLiq,icl)
-    enddo
-  endif 
-#endif
+   IF (using_xios) THEN
+     if (cfg%Lcrimodis) CALL histwrite4d_cosp(o_crimodis,modis%Optical_Thickness_vs_ReffIce)
+     if (cfg%Lcrlmodis) CALL histwrite4d_cosp(o_crlmodis,modis%Optical_Thickness_vs_ReffLiq)
+   ELSE
+     if (cfg%Lcrimodis) then
+       do icl=1,7
+         CALL histwrite3d_cosp(o_crimodis, &
+            modis%Optical_Thickness_vs_ReffIce(:,icl,:),nvertReffIce,icl)
+       enddo
+     endif
+     if (cfg%Lcrlmodis) then
+       do icl=1,7 
+         CALL histwrite3d_cosp(o_crlmodis, &
+            modis%Optical_Thickness_vs_ReffLiq(:,icl,:),nvertReffLiq,icl)
+       enddo
+     endif 
+   ENDIF
  endif !modis
 
@@ -410,9 +408,4 @@
             ENDDO !  iff
 #endif
-! Fermeture dans phys_output_write
-!#ifdef CPP_XIOS
-            !On finalise l'initialisation:
-            !CALL wxios_closedef()
-!#endif
 
 !$OMP END MASTER
@@ -451,7 +444,5 @@
     USE mod_grid_phy_lmdz, ONLY: nbp_lon
     USE print_control_mod, ONLY: lunout,prt_level
-#ifdef CPP_XIOS
-  USE wxios
-#endif
+    USE wxios
 
     IMPLICIT NONE
@@ -485,15 +476,15 @@
     ENDIF
 
-#ifdef CPP_XIOS
-     IF (.not. ok_all_xml) then
-       IF ( var%cles(iff) ) THEN
-         if (prt_level >= 10) then
-              WRITE(lunout,*)'Appel wxios_add_field_to_file var%name =',var%name 
-         endif
-        CALL wxios_add_field_to_file(var%name, 2, cosp_nidfiles(iff), cosp_outfilenames(iff), &
+    IF (using_xios) THEN
+      IF (.not. ok_all_xml) then
+        IF ( var%cles(iff) ) THEN
+          if (prt_level >= 10) then
+            WRITE(lunout,*)'Appel wxios_add_field_to_file var%name =',var%name 
+          endif
+          CALL wxios_add_field_to_file(var%name, 2, cosp_nidfiles(iff), cosp_outfilenames(iff), &
                                      var%description, var%unit, 1, typeecrit)
-       ENDIF
-     ENDIF
-#endif
+        ENDIF
+      ENDIF
+    ENDIF
 
 #ifndef CPP_IOIPSL_NO_OUTPUT 
@@ -514,9 +505,5 @@
     USE mod_grid_phy_lmdz, ONLY: nbp_lon
     USE print_control_mod, ONLY: lunout,prt_level
-
-#ifdef CPP_XIOS
-  USE wxios
-#endif
-
+    USE wxios
 
     IMPLICIT NONE
@@ -591,5 +578,5 @@
     ENDIF
 
-#ifdef CPP_XIOS
+    IF (using_xios) THEN
       IF (.not. ok_all_xml) then
         IF ( var%cles(iff) ) THEN
@@ -601,5 +588,5 @@
         ENDIF
       ENDIF
-#endif
+    ENDIF
 
 #ifndef CPP_IOIPSL_NO_OUTPUT
@@ -621,8 +608,5 @@
   USE mod_grid_phy_lmdz, ONLY: nbp_lon
   USE print_control_mod, ONLY: lunout,prt_level
-
-#ifdef CPP_XIOS
-  USE xios, only: xios_send_field
-#endif
+  USE lmdz_xios, only: xios_send_field, using_xios
 
   IMPLICIT NONE
@@ -672,6 +656,6 @@
         CALL histwrite(cosp_nidfiles(iff),var%name,itau_iocosp,Field2d,nbp_lon*jj_nb,index2d) 
 #endif
-                deallocate(index2d)
-#ifdef CPP_XIOS
+            deallocate(index2d)
+            IF (using_xios) THEN
               IF (.not. ok_all_xml) then
                  if (firstx) then
@@ -683,9 +667,9 @@
                  endif
               ENDIF
-#endif
-           ENDIF
+            ENDIF
+          ENDIF
       ENDDO 
 
-#ifdef CPP_XIOS
+    IF (using_xios) THEN
       IF (ok_all_xml) THEN
         if (prt_level >= 1) then
@@ -694,5 +678,5 @@
        CALL xios_send_field(var%name, Field2d)
       ENDIF
-#endif
+    ENDIF
 
 !$OMP END MASTER   
@@ -710,9 +694,5 @@
   USE mod_grid_phy_lmdz, ONLY: nbp_lon
   USE print_control_mod, ONLY: lunout,prt_level
-
-#ifdef CPP_XIOS
-  USE xios, only: xios_send_field
-#endif
-
+  USE lmdz_xios, only: xios_send_field, using_xios
 
   IMPLICIT NONE
@@ -776,5 +756,5 @@
 #endif
 
-#ifdef CPP_XIOS
+        IF (using_xios) THEN
           IF (.not. ok_all_xml) then
            IF (firstx) THEN
@@ -784,14 +764,15 @@
            ENDIF
           ENDIF
-#endif
+        ENDIF
          deallocate(index3d)
         ENDIF
       ENDDO
-#ifdef CPP_XIOS
+
+  IF (using_xios) THEN
     IF (ok_all_xml) THEN
      CALL xios_send_field(nom, Field3d(:,:,1:nlev))
      IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name
     ENDIF
-#endif
+  ENDIF
 
 !$OMP END MASTER   
@@ -809,9 +790,5 @@
   USE mod_grid_phy_lmdz, ONLY: nbp_lon
   USE print_control_mod, ONLY: lunout,prt_level
-
-#ifdef CPP_XIOS
-  USE xios, only: xios_send_field
-#endif
-
+  USE lmdz_xios, only: xios_send_field, using_xios
 
   IMPLICIT NONE
@@ -842,10 +819,10 @@
     CALL grid1Dto2D_mpi(buffer_omp,field4d)
 
-#ifdef CPP_XIOS
+   IF (using_xios) THEN
 !    IF (ok_all_xml) THEN
      CALL xios_send_field(var%name, Field4d(:,:,1:nlev,1:nlev2))
      IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name
 !    ENDIF
-#endif
+   ENDIF
 
 !$OMP END MASTER   
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/cosp_read_otputkeys.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/cosp_read_otputkeys.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/cosp_read_otputkeys.F90	(revision 4727)
@@ -226,8 +226,5 @@
 
  SUBROUTINE READ_COSP_OUTPUT_NL(itap,cosp_nl,cfg)
-
-#ifdef CPP_XIOS
-    USE xios, ONLY: xios_field_is_active
-#endif
+    USE lmdz_xios, ONLY: xios_field_is_active, using_xios
   implicit none
   character(len=*),intent(in) :: cosp_nl
@@ -746,12 +743,8 @@
     USE MOD_COSP_CONSTANTS
     USE MOD_COSP_TYPES
-#ifdef CPP_XIOS
-    USE xios, ONLY: xios_field_is_active
-#endif
+    USE lmdz_xios, ONLY: xios_field_is_active,using_xios
   implicit none
   type(cosp_config),intent(out) :: cfg
   integer :: i
-
-#ifdef CPP_XIOS
 
  logical :: Lradar_sim,Llidar_sim,Lisccp_sim,Lmodis_sim,Lmisr_sim,Lrttov_sim, Lstats, &
@@ -776,7 +769,9 @@
   character(len=32) :: out_list(N_OUT_LIST)
 
-  do i=1,N_OUT_LIST
-    cfg%out_list(i)=''
-  enddo
+  IF (using_xios) THEN
+    
+    do i=1,N_OUT_LIST
+      cfg%out_list(i)=''
+    enddo
 
     LcfadDbze94   = .false.
@@ -1232,5 +1227,5 @@
   cfg%Lrttov_sim = Lrttov_sim
 
-#endif
+ ENDIF ! using_xios
 
   END SUBROUTINE read_xiosfieldactive
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/mod_cosp_constants.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/mod_cosp_constants.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/mod_cosp_constants.F90	(revision 4727)
@@ -33,5 +33,5 @@
 ! 
 
-#include "cosp_defs.h"
+#INCLUDE "cosp_defs.h"
 MODULE MOD_COSP_CONSTANTS
     IMPLICIT NONE
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/phys_cosp.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/phys_cosp.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp/phys_cosp.F90	(revision 4727)
@@ -84,7 +84,5 @@
   use cosp_output_write_mod
 !  use MOD_COSP_Modis_Simulator, only : cosp_modis 
-#ifdef CPP_XIOS
-    USE xios, ONLY: xios_field_is_active
-#endif
+  USE lmdz_xios, ONLY: xios_field_is_active, using_xios
   use cosp_read_otputkeys
 
@@ -183,9 +181,10 @@
 
 ! Clefs Outputs initialisation
-#ifdef CPP_XIOS
-  call cosp_outputkeys_init(cfg)
-#else
-  call read_cosp_output_nl(itap,cosp_output_nl,cfg)
-#endif
+  IF (using_xios) THEN
+    call cosp_outputkeys_init(cfg)
+  ELSE
+    call read_cosp_output_nl(itap,cosp_output_nl,cfg)
+  ENDIF
+
 !!!   call cosp_outputkeys_test(cfg)
   print*,' Cles des differents simulateurs cosp a itap :',itap
@@ -203,7 +202,7 @@
 !!! Ici on modifie les cles logiques pour les outputs selon les champs actives dans les .xml
   if ((itap.gt.1).and.(first_write))then
-#ifdef CPP_XIOS
-    call read_xiosfieldactive(cfg)
-#endif
+   
+    IF (using_xios) call read_xiosfieldactive(cfg)
+  
     first_write=.false.
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp2/cosp_output_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp2/cosp_output_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp2/cosp_output_mod.F90	(revision 4727)
@@ -246,9 +246,6 @@
   USE time_phylmdz_mod, ONLY: day_ref, annee_ref, day_ini, start_time, itau_phy
   USE print_control_mod, ONLY: lunout
-
-#ifdef CPP_XIOS
     ! ug Pour les sorties XIOS
-    USE wxios
-#endif
+  USE wxios
 
   IMPLICIT NONE
@@ -275,11 +272,9 @@
 !!! Variables d'entree
 
-#ifdef CPP_XIOS
-    ! ug Variables utilisées pour récupérer le calendrier pour xios
-    INTEGER :: x_an, x_mois, x_jour
-    REAL :: x_heure
-    INTEGER :: ini_an, ini_mois, ini_jour
-    REAL :: ini_heure
-#endif
+! ug Variables utilisées pour récupérer le calendrier pour xios
+  INTEGER :: x_an, x_mois, x_jour
+  REAL :: x_heure
+  INTEGER :: ini_an, ini_mois, ini_jour
+  REAL :: ini_heure
 
     WRITE(lunout,*) 'Debut cosp_output_mod.F90'
@@ -328,59 +323,59 @@
     CALL ymds2ju(annee_ref, 1, day_ini, start_time, zjulian_start)
 
-#ifdef CPP_XIOS
-    
-! recuperer la valeur indefine Xios
-!    CALL xios_get_field_attr("clcalipso",default_value=Cosp_fill_value)
-!         Cosp_fill_value=missing_val
-          Cosp_fill_value=0.
-         print*,'Cosp_fill_value=',Cosp_fill_value
-
-    CALL wxios_add_vaxis("height", vgrid%Nlvgrid, vgrid%z)
-    print*,'wxios_add_vaxis vgrid%Nlvgrid, vgrid%z',vgrid%Nlvgrid,vgrid%z
-
-    WRITE(lunout,*) 'wxios_add_vaxis height_mlev, Nlevlmdz vgrid%mz ', &
+    IF (using_xios) THEN
+
+  ! recuperer la valeur indefine Xios
+  !    CALL xios_get_field_attr("clcalipso",default_value=Cosp_fill_value)
+  !         Cosp_fill_value=missing_val
+      Cosp_fill_value=0.
+      print*,'Cosp_fill_value=',Cosp_fill_value
+
+      CALL wxios_add_vaxis("height", vgrid%Nlvgrid, vgrid%z)
+      print*,'wxios_add_vaxis vgrid%Nlvgrid, vgrid%z',vgrid%Nlvgrid,vgrid%z
+
+      WRITE(lunout,*) 'wxios_add_vaxis height_mlev, Nlevlmdz vgrid%mz ', &
                      Nlevlmdz,vgrid%mz
-    CALL wxios_add_vaxis("height_mlev", Nlevlmdz, vgrid%mz)
-
-    WRITE(lunout,*) 'wxios_add_vaxis sza, PARASOL_NREFL ', &
-                     PARASOL_NREFL, PARASOL_SZA
-    CALL wxios_add_vaxis("sza", PARASOL_NREFL, PARASOL_SZA)
-
-    WRITE(lunout,*) 'wxios_add_vaxis pressure2 ',7,pres_binCenters
-    CALL wxios_add_vaxis("pressure2", 7, pres_binCenters)
-
-    WRITE(lunout,*) 'wxios_add_vaxis column ',Ncolumns,column_ax
-    CALL wxios_add_vaxis("column", Ncolumns, column_ax)
-
-   WRITE(lunout,*) 'wxios_add_vaxis temp LIDAR_NTEMP, LIDAR_PHASE_TEMP ', &
+      CALL wxios_add_vaxis("height_mlev", Nlevlmdz, vgrid%mz)
+
+      WRITE(lunout,*) 'wxios_add_vaxis sza, PARASOL_NREFL ', &
+                       PARASOL_NREFL, PARASOL_SZA
+      CALL wxios_add_vaxis("sza", PARASOL_NREFL, PARASOL_SZA)
+
+      WRITE(lunout,*) 'wxios_add_vaxis pressure2 ',7,pres_binCenters
+      CALL wxios_add_vaxis("pressure2", 7, pres_binCenters)
+
+      WRITE(lunout,*) 'wxios_add_vaxis column ',Ncolumns,column_ax
+      CALL wxios_add_vaxis("column", Ncolumns, column_ax)
+
+      WRITE(lunout,*) 'wxios_add_vaxis temp LIDAR_NTEMP, LIDAR_PHASE_TEMP ', &
                     LIDAR_NTEMP, LIDAR_PHASE_TEMP
-   CALL wxios_add_vaxis("temp", LIDAR_NTEMP, LIDAR_PHASE_TEMP)
-
-   WRITE(lunout,*) 'wxios_add_vaxis cth16 numMISRHgtBins, misr_histHgtCenters ', & 
-                    numMISRHgtBins, misr_histHgtCenters 
-   CALL wxios_add_vaxis("cth16", numMISRHgtBins, misr_histHgtCenters)
-
-   WRITE(lunout,*) 'wxios_add_vaxis dbze DBZE_BINS, dbze_ax ', &
-                    DBZE_BINS, dbze_ax
-   CALL wxios_add_vaxis("dbze", DBZE_BINS, dbze_ax) 
-
-   WRITE(lunout,*) 'wxios_add_vaxis scatratio SR_BINS, sratio_ax', &
-                   SR_BINS, sratio_ax
-   CALL wxios_add_vaxis("scatratio", SR_BINS, sratio_ax)
-
-   WRITE(lunout,*) 'wxios_add_vaxis ReffIce numMODISReffIceBins, &
-                   reffICE_binCenters',numMODISReffIceBins, reffICE_binCenters
-   CALL wxios_add_vaxis("ReffIce", numMODISReffIceBins, reffICE_binCenters)
-
-   WRITE(lunout,*) 'wxios_add_vaxis ReffLiq numMODISReffLiqBins, &
+      CALL wxios_add_vaxis("temp", LIDAR_NTEMP, LIDAR_PHASE_TEMP)
+
+      WRITE(lunout,*) 'wxios_add_vaxis cth16 numMISRHgtBins, misr_histHgtCenters ', & 
+                      numMISRHgtBins, misr_histHgtCenters 
+      CALL wxios_add_vaxis("cth16", numMISRHgtBins, misr_histHgtCenters)
+
+      WRITE(lunout,*) 'wxios_add_vaxis dbze DBZE_BINS, dbze_ax ', &
+                       DBZE_BINS, dbze_ax
+      CALL wxios_add_vaxis("dbze", DBZE_BINS, dbze_ax) 
+
+      WRITE(lunout,*) 'wxios_add_vaxis scatratio SR_BINS, sratio_ax', &
+                     SR_BINS, sratio_ax
+      CALL wxios_add_vaxis("scatratio", SR_BINS, sratio_ax)
+
+      WRITE(lunout,*) 'wxios_add_vaxis ReffIce numMODISReffIceBins, &
+                     reffICE_binCenters',numMODISReffIceBins, reffICE_binCenters
+     CALL wxios_add_vaxis("ReffIce", numMODISReffIceBins, reffICE_binCenters)
+
+     WRITE(lunout,*) 'wxios_add_vaxis ReffLiq numMODISReffLiqBins, &
                     reffLIQ_binCenters', numMODISReffLiqBins, reffLIQ_binCenters
-   CALL wxios_add_vaxis("ReffLiq", numMODISReffLiqBins, reffLIQ_binCenters)
-
-   WRITE(lunout,*) 'wxios_add_vaxis 7, tau_binCenters', &
-                    7, tau_binCenters
-   CALL wxios_add_vaxis("tau", 7, tau_binCenters)
-
-#endif
-   
+     CALL wxios_add_vaxis("ReffLiq", numMODISReffLiqBins, reffLIQ_binCenters)
+
+     WRITE(lunout,*) 'wxios_add_vaxis 7, tau_binCenters', &
+                      7, tau_binCenters
+     CALL wxios_add_vaxis("tau", 7, tau_binCenters)
+
+  ENDIF
+
     zdtimemoy_cosp = freq_COSP         ! Frequence ou l on moyenne
 
@@ -394,10 +389,10 @@
 !                    nhoricosp(iff),cosp_nidfiles(iff)
 
-#ifdef CPP_XIOS
-        IF (.not. ok_all_xml) then
-         WRITE(lunout,*) 'wxios_add_file ',cosp_outfilenames(iff)
-         CALL wxios_add_file(cosp_outfilenames(iff),chfreq(iff),10)
+        IF(using_xios) THEN
+          IF (.not. ok_all_xml) then
+           WRITE(lunout,*) 'wxios_add_file ',cosp_outfilenames(iff)
+           CALL wxios_add_file(cosp_outfilenames(iff),chfreq(iff),10)
+          ENDIF
         ENDIF
-#endif
 
 #ifndef CPP_IOIPSL_NO_OUTPUT 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp2/cosp_output_write_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp2/cosp_output_write_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp2/cosp_output_write_mod.F90	(revision 4727)
@@ -36,9 +36,6 @@
     USE time_phylmdz_mod, ONLY: itau_phy, start_time, day_step_phy
     USE print_control_mod, ONLY: lunout,prt_level
-
-#ifdef CPP_XIOS
     USE wxios, only: wxios_closedef
-    USE xios, only: xios_update_calendar, xios_field_is_active
-#endif
+    USE lmdz_xios, only: xios_update_calendar, xios_field_is_active, using_xios
   IMPLICIT NONE  
 !!! Variables d'entree
@@ -68,9 +65,9 @@
   real, dimension(Npoints,numMISRHgtBins,7) :: tmp_fi4da_misr
 
-#ifdef CPP_XIOS
-  missing_val=missing_cosp
-#else
-  missing_val=0.
-#endif
+  IF (using_xios) THEN
+    missing_val=missing_cosp
+  ELSE
+    missing_val=0.
+  ENDIF
 
   Nlevout = vgrid%Nlvgrid
@@ -100,5 +97,5 @@
 !   endif
 
-!!#ifdef CPP_XIOS
+!! IF (using_xios) THEN
 ! !$OMP MASTER
 !IF (cosp_varsdefined) THEN
@@ -111,5 +108,5 @@
 !  !$OMP END MASTER
 !  !$OMP BARRIER
-!!#endif
+!! ENDIF
 
 !!!! Sorties Calipso
@@ -173,17 +170,18 @@
 !   if (cfg%Lproftemp) CALL histwrite3d_cosp(o_proftemp,stlidar%proftemp,nvert)                    !TIBO
 
-#ifdef CPP_XIOS
-   do icl=1,SR_BINS
+  IF (using_xios) THEN
+
+    do icl=1,SR_BINS
       tmp_fi4da_cfadL(:,:,icl)=stlidar%cfad_sr(:,icl,:)
-   enddo
+    enddo
 !   if (cfg%LcfadLidarsr532) CALL histwrite4d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr)
-   if (cfg%LcfadLidarsr532) CALL histwrite4d_cosp(o_cfad_lidarsr532,tmp_fi4da_cfadL)
+    if (cfg%LcfadLidarsr532) CALL histwrite4d_cosp(o_cfad_lidarsr532,tmp_fi4da_cfadL)
 !   if (cfg%LprofSR) CALL histwrite4d_cosp(o_profSR,stlidar%profSR)                              !TIBO
-#else
-   if (cfg%LcfadLidarsr532) then
-     do icl=1,SR_BINS
+  ELSE
+    if (cfg%LcfadLidarsr532) then
+      do icl=1,SR_BINS
         CALL histwrite3d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr(:,icl,:),nvert,icl)
-     enddo
-   endif
+      enddo
+    endif
 !   if (cfg%LprofSR) then
 !     do icl=1,Ncolumns                                                              !TIBO
@@ -191,5 +189,6 @@
 !     enddo                                                                          !TIBO
 !   endif
-#endif
+  ENDIF
+
    if (cfg%LparasolRefl) CALL histwrite3d_cosp(o_parasol_refl,stlidar%parasolrefl,nvertp)
 
@@ -211,13 +210,14 @@
   endif
 
-#ifdef CPP_XIOS
-   if (cfg%Latb532) CALL histwrite4d_cosp(o_atb532,sglidar%beta_tot)
-#else
-   if (cfg%Latb532) then  
-     do icl=1,Ncolumns 
+  IF (using_xios) THEN
+
+    if (cfg%Latb532) CALL histwrite4d_cosp(o_atb532,sglidar%beta_tot)
+  ELSE
+    if (cfg%Latb532) then  
+      do icl=1,Ncolumns 
         CALL histwrite3d_cosp(o_atb532,sglidar%beta_tot(:,icl,:),nvertmcosp,icl)
-     enddo
-   endif 
-#endif
+      enddo
+    endif 
+  ENDIF
 
    if (cfg%LlidarBetaMol532) CALL histwrite3d_cosp(o_beta_mol532,sglidar%beta_mol,nvertmcosp) 
@@ -229,23 +229,23 @@
 
    where(stradar%cfad_ze == R_UNDEF) stradar%cfad_ze = missing_val
-#ifdef CPP_XIOS
-   do icl=1,DBZE_BINS
-     tmp_fi4da_cfadR(:,:,icl)=stradar%cfad_ze(:,icl,:)
-   enddo
-   if (cfg%Ldbze94) CALL histwrite4d_cosp(o_dbze94,sgradar%Ze_tot)
-!   if (cfg%LcfadDbze94) CALL histwrite4d_cosp(o_cfadDbze94,stradar%cfad_ze)
-   if (cfg%LcfadDbze94) CALL histwrite4d_cosp(o_cfadDbze94,tmp_fi4da_cfadR)
-#else
-   if (cfg%Ldbze94) then
-    do icl=1,Ncolumns
-       CALL histwrite3d_cosp(o_dbze94,sgradar%Ze_tot(:,icl,:),nvert,icl)
+  IF (using_xios) THEN
+    do icl=1,DBZE_BINS
+      tmp_fi4da_cfadR(:,:,icl)=stradar%cfad_ze(:,icl,:)
     enddo
-   endif
-   if (cfg%LcfadDbze94) then
-    do icl=1,DBZE_BINS
-    CALL histwrite3d_cosp(o_cfadDbze94,stradar%cfad_ze(:,icl,:),nvert,icl)
-    enddo
-   endif
-#endif
+    if (cfg%Ldbze94) CALL histwrite4d_cosp(o_dbze94,sgradar%Ze_tot)
+ !   if (cfg%LcfadDbze94) CALL histwrite4d_cosp(o_cfadDbze94,stradar%cfad_ze)
+    if (cfg%LcfadDbze94) CALL histwrite4d_cosp(o_cfadDbze94,tmp_fi4da_cfadR)
+  ELSE
+    if (cfg%Ldbze94) then
+      do icl=1,Ncolumns
+        CALL histwrite3d_cosp(o_dbze94,sgradar%Ze_tot(:,icl,:),nvert,icl)
+      enddo
+     endif
+     if (cfg%LcfadDbze94) then
+       do icl=1,DBZE_BINS
+         CALL histwrite3d_cosp(o_cfadDbze94,stradar%cfad_ze(:,icl,:),nvert,icl)
+       enddo
+     endif
+  ENDIF
  endif
 ! endif pour radar
@@ -273,14 +273,14 @@
   where(isccp%boxptop == R_UNDEF) isccp%boxptop = missing_val 
 
-   CALL histwrite2d_cosp(o_sunlit,gbx%sunlit)
-#ifdef CPP_XIOS
-  if (cfg%Lclisccp) CALL histwrite4d_cosp(o_clisccp2,isccp%fq_isccp)
-#else
-   if (cfg%Lclisccp) then
-     do icl=1,7
-       CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl) 
-     enddo
-   endif
-#endif
+  CALL histwrite2d_cosp(o_sunlit,gbx%sunlit)
+  IF (using_xios) THEN
+    if (cfg%Lclisccp) CALL histwrite4d_cosp(o_clisccp2,isccp%fq_isccp)
+  ELSE
+    if (cfg%Lclisccp) then
+      do icl=1,7
+        CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl) 
+      enddo
+    endif
+  ENDIF
 
    if (cfg%Lboxtauisccp) CALL histwrite3d_cosp(o_boxtauisccp,isccp%boxtau,nvertcol)
@@ -298,17 +298,17 @@
    where(misr%fq_MISR == R_UNDEF) misr%fq_MISR = missing_val
 
-#ifdef CPP_XIOS
-   do icl=1,numMISRHgtBins
+  IF (using_xios) THEN
+    do icl=1,numMISRHgtBins
       tmp_fi4da_misr(:,icl,:)=misr%fq_MISR(:,:,icl)
-   enddo
+    enddo
 !   if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,misr%fq_MISR)
-   if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,tmp_fi4da_misr)
-#else
-   if (cfg%LclMISR) then
-    do icl=1,7 
-      CALL histwrite3d_cosp(o_clMISR,misr%fq_MISR(:,icl,:),nvertmisr,icl)
-    enddo
-   endif
-#endif
+    if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,tmp_fi4da_misr)
+  ELSE
+    if (cfg%LclMISR) then
+      do icl=1,7 
+        CALL histwrite3d_cosp(o_clMISR,misr%fq_MISR(:,icl,:),nvertmisr,icl)
+      enddo
+     endif
+  ENDIF
  endif
 ! endif pour Misr
@@ -375,14 +375,14 @@
           modis%Optical_Thickness_vs_Cloud_Top_Pressure = missing_val
 
-#ifdef CPP_XIOS
-   if (cfg%Lclmodis) CALL histwrite4d_cosp(o_clmodis,modis%Optical_Thickness_vs_Cloud_Top_Pressure)
-#else
-  if (cfg%Lclmodis) then
-   do icl=1,7
-   CALL histwrite3d_cosp(o_clmodis, &
-     modis%Optical_Thickness_vs_Cloud_Top_Pressure(:,icl,:),nvertisccp,icl)           
-   enddo
-  endif 
-#endif
+  IF (using_xios) THEN
+    if (cfg%Lclmodis) CALL histwrite4d_cosp(o_clmodis,modis%Optical_Thickness_vs_Cloud_Top_Pressure)
+  ELSE
+    if (cfg%Lclmodis) then
+     do icl=1,7
+       CALL histwrite3d_cosp(o_clmodis, &
+         modis%Optical_Thickness_vs_Cloud_Top_Pressure(:,icl,:),nvertisccp,icl)           
+     enddo
+    endif 
+  ENDIF
 
     where(modis%Optical_Thickness_vs_ReffIce == R_UNDEF) &
@@ -392,21 +392,21 @@
           modis%Optical_Thickness_vs_ReffLiq = missing_val
 
-#ifdef CPP_XIOS
-  if (cfg%Lclmodis) CALL histwrite4d_cosp(o_crimodis,modis%Optical_Thickness_vs_ReffIce)
-  if (cfg%Lclmodis) CALL histwrite4d_cosp(o_crlmodis,modis%Optical_Thickness_vs_ReffLiq)
-#else
-  if (cfg%Lclmodis) then
-    do icl=1,7
-     CALL histwrite3d_cosp(o_crimodis, &
-          modis%Optical_Thickness_vs_ReffIce(:,icl,:),nvertReffIce,icl)
-    enddo
-  endif
-  if (cfg%Lclmodis) then
-    do icl=1,7 
-     CALL histwrite3d_cosp(o_crlmodis, &
-          modis%Optical_Thickness_vs_ReffLiq(:,icl,:),nvertReffLiq,icl)
-    enddo
-  endif 
-#endif
+    IF (using_xios) THEN
+      if (cfg%Lclmodis) CALL histwrite4d_cosp(o_crimodis,modis%Optical_Thickness_vs_ReffIce)
+      if (cfg%Lclmodis) CALL histwrite4d_cosp(o_crlmodis,modis%Optical_Thickness_vs_ReffLiq)
+    ELSE
+      if (cfg%Lclmodis) then
+        do icl=1,7
+          CALL histwrite3d_cosp(o_crimodis, &
+             modis%Optical_Thickness_vs_ReffIce(:,icl,:),nvertReffIce,icl)
+        enddo
+      endif
+      if (cfg%Lclmodis) then
+        do icl=1,7 
+           CALL histwrite3d_cosp(o_crlmodis, &
+              modis%Optical_Thickness_vs_ReffLiq(:,icl,:),nvertReffLiq,icl)
+        enddo
+      endif 
+  ENDIF !using_xios
  endif !modis
 
@@ -421,8 +421,8 @@
 #endif
 ! Fermeture dans phys_output_write
-!#ifdef CPP_XIOS
+! IF (using_xios) THEN
             !On finalise l'initialisation:
             !CALL wxios_closedef()
-!#endif
+! ELSE
 
 !$OMP END MASTER
@@ -461,7 +461,5 @@
     USE mod_grid_phy_lmdz, ONLY: nbp_lon
     USE print_control_mod, ONLY: lunout,prt_level
-#ifdef CPP_XIOS
-  USE wxios
-#endif
+    USE wxios
 
     IMPLICIT NONE
@@ -495,5 +493,5 @@
     ENDIF
 
-#ifdef CPP_XIOS
+    IF (using_xios) THEN
      IF (.not. ok_all_xml) then
        IF ( var%cles(iff) ) THEN
@@ -505,5 +503,5 @@
        ENDIF
      ENDIF
-#endif
+    ENDIF
 
 #ifndef CPP_IOIPSL_NO_OUTPUT 
@@ -524,9 +522,5 @@
     USE mod_grid_phy_lmdz, ONLY: nbp_lon
     USE print_control_mod, ONLY: lunout,prt_level
-
-#ifdef CPP_XIOS
-  USE wxios
-#endif
-
+    USE wxios
 
     IMPLICIT NONE
@@ -601,5 +595,5 @@
     ENDIF
 
-#ifdef CPP_XIOS
+    IF (using_xios) THEN
       IF (.not. ok_all_xml) then
         IF ( var%cles(iff) ) THEN
@@ -611,5 +605,5 @@
         ENDIF
       ENDIF
-#endif
+    ENDIF
 
 #ifndef CPP_IOIPSL_NO_OUTPUT
@@ -631,8 +625,5 @@
   USE mod_grid_phy_lmdz, ONLY: nbp_lon
   USE print_control_mod, ONLY: lunout,prt_level
-
-#ifdef CPP_XIOS
-  USE xios, only: xios_send_field
-#endif
+  USE lmdz_xios, only: xios_send_field, using_xios
 
   IMPLICIT NONE
@@ -677,5 +668,5 @@
       firstx=.true.
       DO iff=1, 3
-           IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN
+          IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN
                 ALLOCATE(index2d(nbp_lon*jj_nb))
 #ifndef CPP_IOIPSL_NO_OUTPUT
@@ -683,5 +674,5 @@
 #endif
                 deallocate(index2d)
-#ifdef CPP_XIOS
+            IF (using_xios) THEN
               IF (.not. ok_all_xml) then
                  if (firstx) then
@@ -693,9 +684,9 @@
                  endif
               ENDIF
-#endif
-           ENDIF
+            ENDIF
+          ENDIF
       ENDDO 
 
-#ifdef CPP_XIOS
+    IF (using_xios) THEN
       IF (ok_all_xml) THEN
         if (prt_level >= 1) then
@@ -704,5 +695,5 @@
        CALL xios_send_field(var%name, Field2d)
       ENDIF
-#endif
+    ENDIF
 
 !$OMP END MASTER   
@@ -720,9 +711,5 @@
   USE mod_grid_phy_lmdz, ONLY: nbp_lon
   USE print_control_mod, ONLY: lunout,prt_level
-
-#ifdef CPP_XIOS
-  USE xios, only: xios_send_field
-#endif
-
+  USE lmdz_xios, only: xios_send_field, using_xios
 
   IMPLICIT NONE
@@ -786,5 +773,5 @@
 #endif
 
-#ifdef CPP_XIOS
+       IF (using_xios) THEN
           IF (.not. ok_all_xml) then
            IF (firstx) THEN
@@ -794,14 +781,15 @@
            ENDIF
           ENDIF
-#endif
+        ENDIF
          deallocate(index3d)
         ENDIF
       ENDDO
-#ifdef CPP_XIOS
-    IF (ok_all_xml) THEN
-     CALL xios_send_field(nom, Field3d(:,:,1:nlev))
-     IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name
+
+    IF (using_xios) THEN
+      IF (ok_all_xml) THEN
+        CALL xios_send_field(nom, Field3d(:,:,1:nlev))
+        IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name
+      ENDIF
     ENDIF
-#endif
 
 !$OMP END MASTER   
@@ -819,9 +807,5 @@
   USE mod_grid_phy_lmdz, ONLY: nbp_lon
   USE print_control_mod, ONLY: lunout,prt_level
-
-#ifdef CPP_XIOS
-  USE xios, only: xios_send_field
-#endif
-
+  USE lmdz_xios, only: xios_send_field, using_xios
 
   IMPLICIT NONE
@@ -852,10 +836,10 @@
     CALL grid1Dto2D_mpi(buffer_omp,field4d)
 
-#ifdef CPP_XIOS
+  IF (using_xios) THEN
 !    IF (ok_all_xml) THEN
      CALL xios_send_field(var%name, Field4d(:,:,1:nlev,1:nlev2))
      IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name
 !    ENDIF
-#endif
+  ENDIF
 
 !$OMP END MASTER   
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp2/cosp_read_otputkeys.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp2/cosp_read_otputkeys.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp2/cosp_read_otputkeys.F90	(revision 4727)
@@ -228,8 +228,5 @@
 
  SUBROUTINE READ_COSP_OUTPUT_NL(itap,cosp_nl,cfg)
-
-#ifdef CPP_XIOS
-    USE xios, ONLY: xios_field_is_active
-#endif
+  USE lmdz_xios, ONLY: xios_field_is_active, using_xios
   implicit none
   character(len=*),intent(in) :: cosp_nl
@@ -755,12 +752,8 @@
 !    USE MOD_COSP_CONSTANTS
 !    USE MOD_COSP_TYPES
-#ifdef CPP_XIOS
-    USE xios, ONLY: xios_field_is_active
-#endif
+     USE lmdz_xios, ONLY: xios_field_is_active, using_xios
   implicit none
   type(cosp_config),intent(out) :: cfg
   integer :: i
-
-#ifdef CPP_XIOS
 
  logical :: Lradar_sim,Llidar_sim,Lparasol_sim,Lisccp_sim,Lmodis_sim,Lmisr_sim,Lrttov_sim, Lstats, &
@@ -784,4 +777,6 @@
         
   character(len=32) :: out_list(78)
+
+ IF (using_xios) THEN
 
   do i=1,78
@@ -1249,5 +1244,5 @@
  endif 
 
-#endif
+ ENDIF !using_xios
 
   END SUBROUTINE read_xiosfieldactive
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp2/phys_cosp2.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp2/phys_cosp2.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cosp2/phys_cosp2.F90	(revision 4727)
@@ -73,5 +73,5 @@
 
 !! AI rajouter
-!#include "cosp_defs.h" 
+!INCLUDE "cosp_defs.h" 
 !  USE MOD_COSP_CONSTANTS
 !  USE MOD_COSP_TYPES
@@ -83,4 +83,5 @@
   use cosp_output_mod
   use cosp_output_write_mod
+  USE lmdz_xios, ONLY : using_xios
 !  use MOD_COSP_Modis_Simulator, only : cosp_modis 
 !  use mod_cosp_config, only : vgrid_zl,vgrid_zu,vgrid_z
@@ -245,9 +246,9 @@
 
 ! Clefs Outputs initialisation
-#ifdef CPP_XIOS
+ IF (using_xios) THEN
   call cosp_outputkeys_init(cfg)
-#else
+ ELSE
    call read_cosp_output_nl(itap,cosp_output_nl,cfg)
-#endif
+ ENDIF
 
   print*,' Cles des differents simulateurs cosp a itap :',itap
@@ -265,7 +266,6 @@
 !!! Ici on modifie les cles logiques pour les outputs selon les champs actives dans les .xml
   if ((itap.gt.1).and.(first_write))then
-#ifdef CPP_XIOS
-    call read_xiosfieldactive(cfg)
-#endif
+    
+    IF (using_xios)   call read_xiosfieldactive(cfg)
     first_write=.false.
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cospv2/lmdz_cosp_interface.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cospv2/lmdz_cosp_interface.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cospv2/lmdz_cosp_interface.F90	(revision 4727)
@@ -67,4 +67,5 @@
   use ioipsl
   use iophy
+  use lmdz_xios, ONLY : using_xios
   use lmdz_cosp_output_mod
   use lmdz_cosp_output_write_mod
@@ -262,9 +263,9 @@
 
 ! Clefs Outputs initialisation
-#ifdef CPP_XIOS
-  call cosp_outputkeys_init(cfg)
-#else
+ IF (using_xios) THEN
+   call cosp_outputkeys_init(cfg)
+ ELSE
    call read_cosp_output_nl(itap,cosp_output_nl,cfg)
-#endif
+ ENDIF
 
   print*,' Cles des differents simulateurs cosp a itap :',itap
@@ -278,29 +279,29 @@
     endif
 
-#ifdef CPP_XIOS
-   print*,'On passe par ifdef CPP_XIOS'
-#else
-if (cosp_init_flag .eq. 0) then
-
-    ! Initialize the distributional parameters for hydrometeors in radar simulator.
-    ! In COSPv1.4, this was declared in cosp_defs.f.
-    if (cloudsat_micro_scheme == 'MMF_v3.5_two_moment')  then
-       ldouble = .true. 
-       lsingle = .false.
+ IF (using_xios) THEN
+   print*,'On passe par using_xios'
+ ELSE
+   if (cosp_init_flag .eq. 0) then
+
+      ! Initialize the distributional parameters for hydrometeors in radar simulator.
+      ! In COSPv1.4, this was declared in cosp_defs.f.
+      if (cloudsat_micro_scheme == 'MMF_v3.5_two_moment')  then
+         ldouble = .true. 
+         lsingle = .false.
+      endif
+      call hydro_class_init(lsingle,ldouble,sd)
+      call quickbeam_optics_init()
+
+      print*,' just before call COSP_INIT, cosp_init_flag =', cosp_init_flag
+      call COSP_INIT(cfg%Lisccp, cfg%Lmodis, cfg%Lmisr, cfg%Lcloudsat, cfg%Lcalipso, &
+         cfg%LgrLidar532, cfg%Latlid, cfg%Lparasol, cfg%Lrttov,          &
+         cloudsat_radar_freq, cloudsat_k2, cloudsat_use_gas_abs,         &
+         cloudsat_do_ray, isccp_topheight, isccp_topheight_direction,    &
+         surface_radar, rcfg_cloudsat, use_vgrid_in, csat_vgrid_in,      &
+         niv_sorties, Nlevels, cloudsat_micro_scheme)
+      cosp_init_flag = 1
+      print*,' just after call COSP_INIT, cosp_init_flag =', cosp_init_flag
     endif
-    call hydro_class_init(lsingle,ldouble,sd)
-    call quickbeam_optics_init()
-
-  print*,' just before call COSP_INIT, cosp_init_flag =', cosp_init_flag
-  call COSP_INIT(cfg%Lisccp, cfg%Lmodis, cfg%Lmisr, cfg%Lcloudsat, cfg%Lcalipso, &
-        cfg%LgrLidar532, cfg%Latlid, cfg%Lparasol, cfg%Lrttov,          &
-        cloudsat_radar_freq, cloudsat_k2, cloudsat_use_gas_abs,         &
-        cloudsat_do_ray, isccp_topheight, isccp_topheight_direction,    &
-        surface_radar, rcfg_cloudsat, use_vgrid_in, csat_vgrid_in,      &
-        niv_sorties, Nlevels, cloudsat_micro_scheme)
-  cosp_init_flag = 1
- print*,' just after call COSP_INIT, cosp_init_flag =', cosp_init_flag
-endif
-#endif
+  ENDIF
 
   print*,'Fin lecture Namelists, debut_cosp =',debut_cosp
@@ -311,7 +312,5 @@
 !!! Ici on modifie les cles logiques pour les outputs selon les champs actives dans les .xml
   if ((itap.ge.1).and.(first_write))then
-#ifdef CPP_XIOS
-    call read_xiosfieldactive(cfg)
-#endif
+    IF (using_xios) call read_xiosfieldactive(cfg)
     first_write=.false.
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cospv2/lmdz_cosp_output_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cospv2/lmdz_cosp_output_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cospv2/lmdz_cosp_output_mod.F90	(revision 4727)
@@ -326,9 +326,6 @@
   USE time_phylmdz_mod, ONLY: day_ref, annee_ref, day_ini, start_time, itau_phy
   USE print_control_mod, ONLY: lunout
-
-#ifdef CPP_XIOS
-    ! ug Pour les sorties XIOS
-    USE wxios
-#endif
+  ! ug Pour les sorties XIOS
+  USE wxios
 
   IMPLICIT NONE
@@ -350,11 +347,9 @@
 !!! Variables d'entree
 
-#ifdef CPP_XIOS
-    ! ug Variables utilisées pour récupérer le calendrier pour xios
-    INTEGER :: x_an, x_mois, x_jour
-    REAL :: x_heure
-    INTEGER :: ini_an, ini_mois, ini_jour
-    REAL :: ini_heure
-#endif
+  ! ug Variables utilisées pour récupérer le calendrier pour xios
+  INTEGER :: x_an, x_mois, x_jour
+  REAL :: x_heure
+  INTEGER :: ini_an, ini_mois, ini_jour
+  REAL :: ini_heure
 
     WRITE(lunout,*) 'Debut lmdz_cosp_output_mod.F90'
@@ -401,9 +396,10 @@
     CALL ymds2ju(annee_ref, 1, day_ini, start_time, zjulian_start)
 
-#ifdef CPP_XIOS
+  IF (using_xios) THEN
+
     
-! recuperer la valeur indefine Xios
-!    CALL xios_get_field_attr("clcalipso",default_value=Cosp_fill_value)
-!         Cosp_fill_value=missing_val
+  ! recuperer la valeur indefine Xios
+  !    CALL xios_get_field_attr("clcalipso",default_value=Cosp_fill_value)
+  !         Cosp_fill_value=missing_val
           Cosp_fill_value=0.
          print*,'Cosp_fill_value=',Cosp_fill_value
@@ -426,33 +422,33 @@
     CALL wxios_add_vaxis("column", Ncolumns, column_ax)
 
-   WRITE(lunout,*) 'wxios_add_vaxis temp LIDAR_NTEMP, LIDAR_PHASE_TEMP ', &
-                    LIDAR_NTEMP, LIDAR_PHASE_TEMP
-   CALL wxios_add_vaxis("temp", LIDAR_NTEMP, LIDAR_PHASE_TEMP)
-
-   WRITE(lunout,*) 'wxios_add_vaxis cth16 numMISRHgtBins, misr_histHgtCenters ', & 
+    WRITE(lunout,*) 'wxios_add_vaxis temp LIDAR_NTEMP, LIDAR_PHASE_TEMP ', &
+                     LIDAR_NTEMP, LIDAR_PHASE_TEMP
+    CALL wxios_add_vaxis("temp", LIDAR_NTEMP, LIDAR_PHASE_TEMP)
+
+    WRITE(lunout,*) 'wxios_add_vaxis cth16 numMISRHgtBins, misr_histHgtCenters ', & 
                     numMISRHgtBins, misr_histHgtCenters 
-   CALL wxios_add_vaxis("cth", numMISRHgtBins, misr_histHgtCenters)
-
-   WRITE(lunout,*) 'wxios_add_vaxis dbze CLOUDSAT_DBZE_BINS, cloudsat_binCenters ', &
+    CALL wxios_add_vaxis("cth", numMISRHgtBins, misr_histHgtCenters)
+
+    WRITE(lunout,*) 'wxios_add_vaxis dbze CLOUDSAT_DBZE_BINS, cloudsat_binCenters ', &
                     CLOUDSAT_DBZE_BINS, cloudsat_binCenters
-   CALL wxios_add_vaxis("dbze", CLOUDSAT_DBZE_BINS, cloudsat_binCenters) 
-
-   WRITE(lunout,*) 'wxios_add_vaxis scatratio SR_BINS, calipso_binCenters', &
+    CALL wxios_add_vaxis("dbze", CLOUDSAT_DBZE_BINS, cloudsat_binCenters) 
+
+    WRITE(lunout,*) 'wxios_add_vaxis scatratio SR_BINS, calipso_binCenters', &
                    SR_BINS, calipso_binCenters
-   CALL wxios_add_vaxis("scatratio", SR_BINS, calipso_binCenters)
-
-   WRITE(lunout,*) 'wxios_add_vaxis ReffIce numMODISReffIceBins, &
+    CALL wxios_add_vaxis("scatratio", SR_BINS, calipso_binCenters)
+
+    WRITE(lunout,*) 'wxios_add_vaxis ReffIce numMODISReffIceBins, &
                    reffICE_binCenters',numMODISReffIceBins, reffICE_binCenters
-   CALL wxios_add_vaxis("ReffIce", numMODISReffIceBins, reffICE_binCenters)
-
-   WRITE(lunout,*) 'wxios_add_vaxis ReffLiq numMODISReffLiqBins, &
+    CALL wxios_add_vaxis("ReffIce", numMODISReffIceBins, reffICE_binCenters)
+
+    WRITE(lunout,*) 'wxios_add_vaxis ReffLiq numMODISReffLiqBins, &
                     reffLIQ_binCenters', numMODISReffLiqBins, reffLIQ_binCenters
-   CALL wxios_add_vaxis("ReffLiq", numMODISReffLiqBins, reffLIQ_binCenters)
-
-   WRITE(lunout,*) 'wxios_add_vaxis 7, tau_binCenters', &
+    CALL wxios_add_vaxis("ReffLiq", numMODISReffLiqBins, reffLIQ_binCenters)
+
+    WRITE(lunout,*) 'wxios_add_vaxis 7, tau_binCenters', &
                     7, tau_binCenters
-   CALL wxios_add_vaxis("tau", 7, tau_binCenters)
-
-#endif
+    CALL wxios_add_vaxis("tau", 7, tau_binCenters)
+
+  ENDIF
    
     zdtimemoy_cosp = freq_COSP         ! Frequence ou l on moyenne
@@ -467,10 +463,10 @@
 !                    nhoricosp(iff),cosp_nidfiles(iff)
 
-#ifdef CPP_XIOS
+ IF (using_xios) THEN
         IF (.not. ok_all_xml) then
          WRITE(lunout,*) 'wxios_add_file ',cosp_outfilenames(iff)
          CALL wxios_add_file(cosp_outfilenames(iff),chfreq(iff),10)
         ENDIF
-#endif
+ ENDIF
 
 #ifndef CPP_IOIPSL_NO_OUTPUT 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90	(revision 4727)
@@ -42,5 +42,5 @@
 
     USE wxios, only: wxios_closedef
-    USE xios, only: xios_update_calendar, xios_field_is_active
+    USE lmdz_xios, only: xios_update_calendar, xios_field_is_active
   IMPLICIT NONE  
 !!! Variables d'entree
@@ -807,5 +807,5 @@
   USE print_control_mod, ONLY: lunout,prt_level
 
-  USE xios, only: xios_send_field
+  USE lmdz_xios, only: xios_send_field
 
   IMPLICIT NONE
@@ -889,5 +889,5 @@
   USE print_control_mod, ONLY: lunout,prt_level
 
-  USE xios, only: xios_send_field
+  USE lmdz_xios, only: xios_send_field
 
 
@@ -980,5 +980,5 @@
   USE print_control_mod, ONLY: lunout,prt_level
 
-  USE xios, only: xios_send_field
+  USE lmdz_xios, only: xios_send_field
 
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cospv2/lmdz_cosp_read_outputkeys.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cospv2/lmdz_cosp_read_outputkeys.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cospv2/lmdz_cosp_read_outputkeys.F90	(revision 4727)
@@ -422,8 +422,5 @@
 
  SUBROUTINE READ_COSP_OUTPUT_NL(itap,cosp_nl,cfg)
-
-#ifdef CPP_XIOS
-    USE xios, ONLY: xios_field_is_active
-#endif
+  USE lmdz_xios, ONLY: xios_field_is_active, using_xios
   implicit none
   character(len=*),intent(in) :: cosp_nl
@@ -1020,13 +1017,8 @@
 
  SUBROUTINE read_xiosfieldactive(cfg)
-
-#ifdef CPP_XIOS
-    USE xios, ONLY: xios_field_is_active
-#endif
+  USE lmdz_xios, ONLY: xios_field_is_active, using_xios
   implicit none
   type(cosp_config),intent(inout) :: cfg
   integer :: i
-
-#ifdef CPP_XIOS
 
 !COSPv2 local variables
@@ -1067,4 +1059,6 @@
         
   character(len=32) :: out_list(107)
+
+ IF (using_xios) THEN
 
   do i=1,107
@@ -1717,5 +1711,5 @@
  endif 
 
-#endif
+ ENDIF !using_xios
 
   END SUBROUTINE read_xiosfieldactive
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cpl_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cpl_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cpl_mod.F90	(revision 4727)
@@ -377,5 +377,5 @@
             0,zjulian,dtime,nhoridcs,nidcs) 
 ! no vertical axis
-       DO jf=1,maxrecv
+       DO jf=1,maxrecv_phys
          IF (inforecv(i)%action) THEN
              CALL histdef(nidcs,inforecv(i)%name ,inforecv(i)%name , &
@@ -433,5 +433,5 @@
     CHARACTER(len = 80)                     :: abort_message
     REAL, DIMENSION(klon)                   :: read_sic1D
-    REAL, DIMENSION(nbp_lon,jj_nb,maxrecv)      :: tab_read_flds
+    REAL, DIMENSION(nbp_lon,jj_nb,maxrecv_phys)      :: tab_read_flds
     REAL, DIMENSION(klon,nbsrf)             :: pctsrf_old
     REAL, DIMENSION(klon_mpi)               :: rlon_mpi, rlat_mpi
@@ -462,5 +462,5 @@
           ndexcs(:) = 0
           itau_w = itau_phy + itime + start_time * day_step_phy
-          DO i = 1, maxrecv
+          DO i = 1, maxrecv_phys
             IF (inforecv(i)%action) THEN
                 CALL histwrite(nidcs,inforecv(i)%name,itau_w,tab_read_flds(:,:,i),nbp_lon*(nbp_lat),ndexcs)
@@ -1249,5 +1249,7 @@
     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     USE time_phylmdz_mod, ONLY: start_time, itau_phy
-    use config_ocean_skin_m, only: activate_ocean_skin
+    USE config_ocean_skin_m, only: activate_ocean_skin
+    USE lmdz_mpi
+
 ! Some includes
 !    
@@ -1283,8 +1285,5 @@
     REAL  :: calving_glo(nb_zone_calving)
     
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
     INTEGER, DIMENSION(MPI_STATUS_SIZE)                  :: status
-#endif
 
 ! End definitions
@@ -1357,15 +1356,11 @@
         IF (is_parallel) THEN
            IF (.NOT. is_north_pole_dyn) THEN
-#ifdef CPP_MPI
               CALL MPI_RECV(Up,1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,status,error)
               CALL MPI_SEND(tmp_calv(1,1),1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,error)
-#endif
            ENDIF
        
            IF (.NOT. is_south_pole_dyn) THEN
-#ifdef CPP_MPI
               CALL MPI_SEND(tmp_calv(1,jj_nb),1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,error)
               CALL MPI_RECV(down,1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,status,error)
-#endif
            ENDIF
          
@@ -1392,7 +1387,5 @@
          ENDDO
          
-#ifdef CPP_MPI
          CALL MPI_ALLREDUCE(calving, calving_glo, nb_zone_calving, MPI_REAL_LMDZ, MPI_SUM, COMM_LMDZ_PHY, error)
-#endif
          
          tab_flds(:,:,ids_calvin) = 0
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/create_etat0_limit_unstruct.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/create_etat0_limit_unstruct.F90	(revision 4726)
+++ 	(revision )
@@ -1,119 +1,0 @@
-MODULE etat0_limit_unstruct_mod
-
-  LOGICAL, SAVE  :: create_etat0_limit
-!$OMP THREADPRIVATE(create_etat0_limit) 
-
-
-
-
-CONTAINS
-  
-  SUBROUTINE init_etat0_limit_unstruct
-#ifdef CPP_XIOS
-  USE xios, ONLY: xios_set_axis_attr, xios_set_fieldgroup_attr, &
-                  xios_set_filegroup_attr, xios_set_file_attr
-  USE mod_phys_lmdz_para, ONLY: is_omp_master
-  USE mod_grid_phy_lmdz, ONLY: grid_type, unstructured
-  USE ioipsl, ONLY : ioget_year_len
-  USE ioipsl_getin_p_mod, ONLY: getin_p
-  USE time_phylmdz_mod, ONLY : annee_ref
-  USE create_etat0_unstruct_mod, ONLY: init_create_etat0_unstruct
-  IMPLICIT NONE
-  
-    INTEGER :: iflag_phys,i
-    INTEGER :: ndays
-    REAL,ALLOCATABLE :: value(:)
-    
-      IF (grid_type==unstructured) THEN
-        CALL getin_p("iflag_phys",iflag_phys)
-        
-        CALL getin_p('create_etat0_limit',create_etat0_limit)
-        
-        ndays=ioget_year_len(annee_ref)
-        ALLOCATE(value(ndays))
-        DO i=1,ndays
-          value(i)=i-1
-        ENDDO
-        
-        IF (is_omp_master) CALL xios_set_axis_attr("time_year",n_glo=ndays,value=value) 
-        
-        IF (create_etat0_limit) THEN
-          IF (iflag_phys<100) THEN
-            IF (is_omp_master) CALL xios_set_fieldgroup_attr("etat0_limit_read",read_access=.TRUE.,enabled=.TRUE.)
-            IF (is_omp_master) CALL xios_set_filegroup_attr("etat0_limit_read",enabled=.TRUE.)
-          ENDIF
-          IF (is_omp_master) CALL xios_set_file_attr("limit_write",enabled=.TRUE.)
-          CALL init_create_etat0_unstruct
-        ENDIF
-      
-      ENDIF  
-
-#endif
-  END SUBROUTINE init_etat0_limit_unstruct
-  
-  SUBROUTINE create_etat0_limit_unstruct
-#ifdef CPP_XIOS
-  USE mod_grid_phy_lmdz, ONLY: grid_type, unstructured
-  USE create_etat0_unstruct_mod, ONLY: create_etat0_unstruct
-  USE create_limit_unstruct_mod, ONLY: create_limit_unstruct
-  USE phyaqua_mod, ONLY: iniaqua
-  USE phys_cal_mod, only: year_len
-  USE mod_phys_lmdz_para, ONLY: is_omp_master
-  USE ioipsl_getin_p_mod, ONLY: getin_p
-  USE dimphy, ONLY: klon
-  USE xios, ONLY: xios_context_finalize, xios_set_current_context, &
-                  xios_finalize
-  USE print_control_mod, ONLY: lunout
-  IMPLICIT NONE
-      INTEGER :: iflag_phys
-      INTEGER :: ierr
-      CHARACTER (LEN=20) :: modname='create_etat0_limit_unstruct'
-      CHARACTER (LEN=80) :: abort_message
-     
-      IF (grid_type==unstructured) THEN
-  
-        CALL getin_p("iflag_phys",iflag_phys)
-
-        IF (iflag_phys<100) THEN
-          IF ( create_etat0_limit) THEN
-              CALL create_etat0_unstruct
-              CALL create_limit_unstruct
-              IF (is_omp_master)  THEN
-                CALL xios_context_finalize()
-                CALL xios_set_current_context("icosagcm")   ! very bad, need to find an other solution
-                CALL xios_context_finalize()
-                CALL xios_finalize()
-#ifdef CPP_MPI    
-                CALL MPI_Finalize(ierr)
-#endif
-                abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine' 
-                CALL abort_physic(modname,abort_message,0)
-              ENDIF
-!$OMP BARRIER
-              abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine'
-              CALL abort_physic(modname,abort_message,0)
-          ENDIF 
-        ELSE
-          IF (create_etat0_limit) THEN 
-            CALL iniaqua(klon,year_len,iflag_phys)
-              IF (is_omp_master)  THEN
-                CALL xios_context_finalize()
-                CALL xios_set_current_context("icosagcm")   ! very bad, need to find an other solution
-                CALL xios_context_finalize()
-                CALL xios_finalize()
-#ifdef CPP_MPI
-                CALL MPI_Finalize(ierr)
-#endif
-              ENDIF
-!$OMP BARRIER
-              abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine' 
-              CALL abort_physic(modname,abort_message,0)
-          ENDIF
-        ENDIF
-      ENDIF
-        
-#endif
-  END SUBROUTINE create_etat0_limit_unstruct
-  
-END MODULE etat0_limit_unstruct_mod
-
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/create_etat0_limit_unstruct_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/create_etat0_limit_unstruct_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/create_etat0_limit_unstruct_mod.F90	(revision 4727)
@@ -0,0 +1,111 @@
+MODULE etat0_limit_unstruct_mod
+
+  LOGICAL, SAVE  :: create_etat0_limit
+!$OMP THREADPRIVATE(create_etat0_limit) 
+
+
+
+
+CONTAINS
+  
+  SUBROUTINE init_etat0_limit_unstruct
+  USE lmdz_xios, ONLY: xios_set_axis_attr, xios_set_fieldgroup_attr, &
+                  xios_set_filegroup_attr, xios_set_file_attr
+  USE mod_phys_lmdz_para, ONLY: is_omp_master
+  USE mod_grid_phy_lmdz, ONLY: grid_type, unstructured
+  USE ioipsl, ONLY : ioget_year_len
+  USE ioipsl_getin_p_mod, ONLY: getin_p
+  USE time_phylmdz_mod, ONLY : annee_ref
+  USE create_etat0_unstruct_mod, ONLY: init_create_etat0_unstruct
+  IMPLICIT NONE
+  
+    INTEGER :: iflag_phys,i
+    INTEGER :: ndays
+    REAL,ALLOCATABLE :: value(:)
+    
+      IF (grid_type==unstructured) THEN
+        CALL getin_p("iflag_phys",iflag_phys)
+        
+        CALL getin_p('create_etat0_limit',create_etat0_limit)
+        
+        ndays=ioget_year_len(annee_ref)
+        ALLOCATE(value(ndays))
+        DO i=1,ndays
+          value(i)=i-1
+        ENDDO
+        
+        IF (is_omp_master) CALL xios_set_axis_attr("time_year",n_glo=ndays,value=value) 
+        
+        IF (create_etat0_limit) THEN
+          IF (iflag_phys<100) THEN
+            IF (is_omp_master) CALL xios_set_fieldgroup_attr("etat0_limit_read",read_access=.TRUE.,enabled=.TRUE.)
+            IF (is_omp_master) CALL xios_set_filegroup_attr("etat0_limit_read",enabled=.TRUE.)
+          ENDIF
+          IF (is_omp_master) CALL xios_set_file_attr("limit_write",enabled=.TRUE.)
+          CALL init_create_etat0_unstruct
+        ENDIF
+      
+      ENDIF  
+
+  END SUBROUTINE init_etat0_limit_unstruct
+  
+  SUBROUTINE create_etat0_limit_unstruct
+  USE mod_grid_phy_lmdz, ONLY: grid_type, unstructured
+  USE create_etat0_unstruct_mod, ONLY: create_etat0_unstruct
+  USE create_limit_unstruct_mod, ONLY: create_limit_unstruct
+  USE phyaqua_mod, ONLY: iniaqua
+  USE phys_cal_mod, only: year_len
+  USE mod_phys_lmdz_para, ONLY: is_omp_master
+  USE ioipsl_getin_p_mod, ONLY: getin_p
+  USE dimphy, ONLY: klon
+  USE lmdz_xios, ONLY: xios_context_finalize, xios_set_current_context, &
+                  xios_finalize
+  USE print_control_mod, ONLY: lunout
+  IMPLICIT NONE
+      INTEGER :: iflag_phys
+      INTEGER :: ierr
+      CHARACTER (LEN=20) :: modname='create_etat0_limit_unstruct'
+      CHARACTER (LEN=80) :: abort_message
+     
+      IF (grid_type==unstructured) THEN
+  
+        CALL getin_p("iflag_phys",iflag_phys)
+
+        IF (iflag_phys<100) THEN
+          IF ( create_etat0_limit) THEN
+              CALL create_etat0_unstruct
+              CALL create_limit_unstruct
+              IF (is_omp_master)  THEN
+                CALL xios_context_finalize()
+                CALL xios_set_current_context("icosagcm")   ! very bad, need to find an other solution
+                CALL xios_context_finalize()
+                CALL xios_finalize()
+                CALL MPI_Finalize(ierr)
+                abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine' 
+                CALL abort_physic(modname,abort_message,0)
+              ENDIF
+!$OMP BARRIER
+              abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine'
+              CALL abort_physic(modname,abort_message,0)
+          ENDIF 
+        ELSE
+          IF (create_etat0_limit) THEN 
+            CALL iniaqua(klon,year_len,iflag_phys)
+              IF (is_omp_master)  THEN
+                CALL xios_context_finalize()
+                CALL xios_set_current_context("icosagcm")   ! very bad, need to find an other solution
+                CALL xios_context_finalize()
+                CALL xios_finalize()
+                CALL MPI_Finalize(ierr)
+              ENDIF
+!$OMP BARRIER
+              abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine' 
+              CALL abort_physic(modname,abort_message,0)
+          ENDIF
+        ENDIF
+      ENDIF
+        
+  END SUBROUTINE create_etat0_limit_unstruct
+  
+END MODULE etat0_limit_unstruct_mod
+
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/create_etat0_unstruct.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/create_etat0_unstruct.F90	(revision 4726)
+++ 	(revision )
@@ -1,272 +1,0 @@
-MODULE create_etat0_unstruct_mod
-
-
-
-
-
-
-CONTAINS
-  
-  SUBROUTINE init_create_etat0_unstruct
-#ifdef CPP_XIOS
-  USE xios
-  USE netcdf
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-  INTEGER :: file_id, iret
-  
-   ! for coupling activate ocean fraction reading from file "ocean_fraction.nc"
-    IF (is_omp_master) THEN
-
-      IF (NF90_OPEN("ocean_fraction.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
-        CALL xios_set_file_attr("frac_ocean",enabled=.TRUE.)
-        CALL xios_set_field_attr("mask",field_ref="frac_ocean_read")
-        iret=NF90_CLOSE(file_id)
-      ELSE IF (NF90_OPEN("land_water_0.05.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
-        CALL xios_set_file_attr("land_water",name="land_water_0.05",enabled=.TRUE.)
-        CALL xios_set_field_attr("mask",field_ref="land_water")
-        iret=NF90_CLOSE(file_id)
-      ELSE IF (NF90_OPEN("land_water_0.25.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
-        CALL xios_set_file_attr("land_water",name="land_water_0.25",enabled=.TRUE.)
-        CALL xios_set_field_attr("mask",field_ref="land_water")
-        iret=NF90_CLOSE(file_id)
-      ELSE IF (NF90_OPEN("land_water_0.50.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
-        CALL xios_set_file_attr("land_water",name="land_water_0.50",enabled=.TRUE.)
-        CALL xios_set_field_attr("mask",field_ref="land_water")
-        iret=NF90_CLOSE(file_id)
-      ENDIF
-
-    ENDIF
-
-#endif
-  
-  END SUBROUTINE init_create_etat0_unstruct
-  
- 
-  SUBROUTINE create_etat0_unstruct
-  USE dimphy
-#ifdef CPP_XIOS
-  USE xios
-  USE infotrac_phy
-  USE fonte_neige_mod
-  USE pbl_surface_mod
-  USE phys_state_var_mod
-  USE indice_sol_mod
-  USE surface_data,      ONLY: landice_opt
-  USE mod_phys_lmdz_para
-  USE print_control_mod, ONLY: lunout
-  USE geometry_mod
-  USE ioipsl_getin_p_mod, ONLY: getin_p
-
-  IMPLICIT NONE
-  INCLUDE 'dimsoil.h'
-
-    LOGICAL :: no_ter_antartique   ! If true, no land points are allowed at Antartic
-    REAL,    DIMENSION(klon)                 :: tsol
-    REAL,    DIMENSION(klon)                 :: sn
-    REAL,    DIMENSION(klon)                 :: rugmer
-    REAL,    DIMENSION(klon)                 :: run_off_lic_0
-    REAL,    DIMENSION(klon)                 :: lic
-    REAL,    DIMENSION(klon)                 :: fder
-
-    REAL,    DIMENSION(klon,nbsrf)           :: qsolsrf, snsrf
-    REAL,    DIMENSION(klon,nsoilmx,nbsrf)   :: tsoil
-    
-    REAL,    DIMENSION(klon_mpi)             :: tsol_mpi, qsol_mpi, zmasq_mpi, lic_mpi
-    REAL,    DIMENSION(klon_mpi)             :: zmea_mpi, zstd_mpi, zsig_mpi, zgam_mpi, zthe_mpi
-    REAL,    DIMENSION(klon_mpi)             :: cell_area_mpi
-    REAL,    DIMENSION(klon_mpi,nbsrf)       :: pctsrf_mpi
-
-    INTEGER :: ji,j,i
- 
-    IF (is_omp_master) THEN
-      CALL xios_recv_field("ts",tsol_mpi)
-      CALL xios_recv_field("qs",qsol_mpi)
-      CALL xios_recv_field("mask",zmasq_mpi)
-      IF (landice_opt .LT. 2) CALL xios_recv_field("landice",lic_mpi)
-      CALL xios_recv_field("zmea",zmea_mpi)
-      CALL xios_recv_field("zstd",zstd_mpi)
-      CALL xios_recv_field("zsig",zsig_mpi)
-      CALL xios_recv_field("zgam",zgam_mpi)
-      CALL xios_recv_field("zthe",zthe_mpi)
-    ENDIF
-    CALL scatter_omp(tsol_mpi,tsol)
-    CALL scatter_omp(qsol_mpi,qsol)
-    CALL scatter_omp(zmasq_mpi,zmasq)
-    IF (landice_opt .LT. 2) CALL scatter_omp(lic_mpi,lic)
-    CALL scatter_omp(zmea_mpi,zmea)
-    CALL scatter_omp(zstd_mpi,zstd)
-    CALL scatter_omp(zsig_mpi,zsig)
-    CALL scatter_omp(zgam_mpi,zgam)
-    CALL scatter_omp(zthe_mpi,zthe)
-
-    radsol(:)   = 0.0
-    rugmer(:) = 0.001
-    sn(:)     = 0
-
-    WHERE(qsol(:)<0) qsol(:)=0 
-        
-    WHERE(   zmasq(:)<EPSFRA) zmasq(:)=0.
-    WHERE(1.-zmasq(:)<EPSFRA) zmasq(:)=1.
-
-    pctsrf(:,:) = 0
-    IF (landice_opt .LT. 2) THEN
-       pctsrf(:,is_lic)=lic
-       WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0.
-       WHERE(zmasq(:)<EPSFRA)         pctsrf(:,is_lic)=0.
-
-       pctsrf(:,is_ter)=zmasq(:)
-       
-       !--- Adequation with soil/sea mask
-       DO ji=1,klon
-          IF(zmasq(ji)>EPSFRA) THEN 
-             IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN
-                pctsrf(ji,is_lic)=zmasq(ji)
-                pctsrf(ji,is_ter)=0.
-             ELSE
-                pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic)
-                IF(pctsrf(ji,is_ter)<EPSFRA) THEN
-                   pctsrf(ji,is_ter)=0.
-                   pctsrf(ji,is_lic)=zmasq(ji)
-                END IF
-             END IF
-          END IF
-       END DO
-   
-    ELSE
-       ! landice_opt=>2 : no land ice
-       pctsrf(:,is_lic)=0.0
-       pctsrf(:,is_ter)=zmasq(:)
-    END IF
-
-
-
-
-
-  !--- Option no_ter_antartique removes all land fractions souther than 60S.
-  !--- Land ice is set instead of the land fractions on these latitudes.
-  !--- The ocean and sea-ice fractions are not changed.
-  no_ter_antartique=.FALSE.
-  CALL getin_p('no_ter_antartique',no_ter_antartique)
-  WRITE(lunout,*)"no_ter_antartique=",no_ter_antartique
-  IF (no_ter_antartique) THEN
-     ! Remove all land fractions souther than 60S and set land-ice instead
-     WRITE(lunout,*) "Remove land fractions souther than 60deg south by increasing"
-     WRITE(lunout,*) "the continental ice fractions. No land can now be found at Antartic."
-     DO ji=1, klon
-        IF (latitude_deg(ji)<-60.0) THEN
-           pctsrf(ji,is_lic) = pctsrf(ji,is_lic) + pctsrf(ji,is_ter)
-           pctsrf(ji,is_ter) = 0
-        END IF
-     END DO
-  END IF
-    
-! sub-surface ocean and sea ice (sea ice set to zero for start)
-!*******************************************************************************
-    pctsrf(:,is_oce)=(1.-zmasq(:))
-    WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0.
-    
-    zval(:)=max(0.,zmea-2*zstd(:))
-    zpic(:)=zmea+2*zstd(:)
-    
-!! WARNING    DON'T FORGET FOR LATER
-!!ym  IF(couple) pctsrf(:,is_oce)=ocemask_fi(:)
-!! 
-    
-! Init: tsol, qsol, sn, evap, tsoil, rain_fall, snow_fall, solsw, sollw, frugs
-!*******************************************************************************
-    DO i=1,nbsrf
-     ftsol(:,i) = tsol
-    END DO
-  
-    DO i=1,nbsrf
-     snsrf(:,i) = sn
-    END DO
-!albedo SB >>>
-!ym error : the sub surface dimension is the third not second
-!    falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
-!    falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
-    falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6
-    falb_dir(:,:,is_oce)=0.5;  falb_dir(:,:,is_sic)=0.6
-
-!ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ?
-!ym probably the uninitialized value was 0 for standard (regular grid) case
-    falb_dif(:,:,:)=0
-
-!albedo SB <<<
-    fevap(:,:) = 0.
-    DO i=1,nbsrf
-     qsolsrf(:,i)=150.
-    END DO
- 
-    DO i=1,nbsrf 
-      DO j=1,nsoilmx
-        tsoil(:,j,i) = tsol
-      END DO
-    END DO
- 
-    rain_fall = 0.; snow_fall = 0.
-    solsw = 165.;   sollw = -53.
-!ym warning missing init for sollwdown => set to 0
-  sollwdown  = 0.
-    
-    
-    t_ancien = 273.15
-    u_ancien=0
-    v_ancien=0
-    q_ancien = 0.
-    agesno = 0.
-
-    z0m(:,is_oce) = rugmer(:)
-
-   z0m(:,is_ter) = 0.01 ! MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
-   z0m(:,is_lic) = 0.001 !MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
-
-   z0m(:,is_sic) = 0.001
-   z0h(:,:)=z0m(:,:)
-
-    fder = 0.0
-    clwcon = 0.0
-    rnebcon = 0.0
-    ratqs = 0.0
-    run_off_lic_0 = 0.0 
-    rugoro = 0.0
-
-! Before phyredem calling, surface modules and values to be saved in startphy.nc
-! are initialized
-!*******************************************************************************
-    pbl_tke(:,:,:) = 1.e-8 
-    zmax0(:) = 40.
-    f0(:) = 1.e-5
-    sig1(:,:) = 0.
-    w01(:,:) = 0.
-    wake_deltat(:,:) = 0.
-    wake_deltaq(:,:) = 0.
-    wake_s(:) = 0.
-    wake_cstar(:) = 0.
-    wake_fip(:) = 0.
-    wake_pe = 0.
-    fm_therm = 0.
-    entr_therm = 0.
-    detr_therm = 0.
-    ale_bl = 0.
-    ale_bl_trig =0. 
-    alp_bl =0.
-    CALL fonte_neige_init(run_off_lic_0)
-    CALL pbl_surface_init( fder, snsrf, qsolsrf, tsoil )
-
-    CALL gather_omp(cell_area,cell_area_mpi)
-    CALL gather_omp(pctsrf,pctsrf_mpi)
-    IF (is_omp_master) THEN
-      CALL xios_send_field("area_ce0l",cell_area_mpi)
-      CALL xios_send_field("fract_oce_ce0l",pctsrf_mpi(:,is_oce))
-      CALL xios_send_field("fract_sic_ce0l",pctsrf_mpi(:,is_sic))
-    ENDIF
-    
-    CALL phyredem( "startphy.nc" )
-
-#endif
-  END SUBROUTINE create_etat0_unstruct
-
-
-END MODULE create_etat0_unstruct_mod
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/create_etat0_unstruct_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/create_etat0_unstruct_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/create_etat0_unstruct_mod.F90	(revision 4727)
@@ -0,0 +1,270 @@
+MODULE create_etat0_unstruct_mod
+
+
+
+
+
+
+CONTAINS
+  
+  SUBROUTINE init_create_etat0_unstruct
+  USE lmdz_xios
+  USE netcdf
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+  INTEGER :: file_id, iret
+  
+   ! for coupling activate ocean fraction reading from file "ocean_fraction.nc"
+    IF (is_omp_master) THEN
+
+      IF (NF90_OPEN("ocean_fraction.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
+        CALL xios_set_file_attr("frac_ocean",enabled=.TRUE.)
+        CALL xios_set_field_attr("mask",field_ref="frac_ocean_read")
+        iret=NF90_CLOSE(file_id)
+      ELSE IF (NF90_OPEN("land_water_0.05.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
+        CALL xios_set_file_attr("land_water",name="land_water_0.05",enabled=.TRUE.)
+        CALL xios_set_field_attr("mask",field_ref="land_water")
+        iret=NF90_CLOSE(file_id)
+      ELSE IF (NF90_OPEN("land_water_0.25.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
+        CALL xios_set_file_attr("land_water",name="land_water_0.25",enabled=.TRUE.)
+        CALL xios_set_field_attr("mask",field_ref="land_water")
+        iret=NF90_CLOSE(file_id)
+      ELSE IF (NF90_OPEN("land_water_0.50.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
+        CALL xios_set_file_attr("land_water",name="land_water_0.50",enabled=.TRUE.)
+        CALL xios_set_field_attr("mask",field_ref="land_water")
+        iret=NF90_CLOSE(file_id)
+      ENDIF
+
+    ENDIF
+
+  END SUBROUTINE init_create_etat0_unstruct
+  
+ 
+  SUBROUTINE create_etat0_unstruct
+  USE dimphy
+  USE lmdz_xios
+  USE infotrac_phy
+  USE fonte_neige_mod
+  USE pbl_surface_mod
+  USE phys_state_var_mod
+  USE indice_sol_mod
+  USE surface_data,      ONLY: landice_opt
+  USE mod_phys_lmdz_para
+  USE print_control_mod, ONLY: lunout
+  USE geometry_mod
+  USE ioipsl_getin_p_mod, ONLY: getin_p
+
+  IMPLICIT NONE
+  INCLUDE 'dimsoil.h'
+
+    LOGICAL :: no_ter_antartique   ! If true, no land points are allowed at Antartic
+    REAL,    DIMENSION(klon)                 :: tsol
+    REAL,    DIMENSION(klon)                 :: sn
+    REAL,    DIMENSION(klon)                 :: rugmer
+    REAL,    DIMENSION(klon)                 :: run_off_lic_0
+    REAL,    DIMENSION(klon)                 :: lic
+    REAL,    DIMENSION(klon)                 :: fder
+
+    REAL,    DIMENSION(klon,nbsrf)           :: qsolsrf, snsrf
+    REAL,    DIMENSION(klon,nsoilmx,nbsrf)   :: tsoil
+    
+    REAL,    DIMENSION(klon_mpi)             :: tsol_mpi, qsol_mpi, zmasq_mpi, lic_mpi
+    REAL,    DIMENSION(klon_mpi)             :: zmea_mpi, zstd_mpi, zsig_mpi, zgam_mpi, zthe_mpi
+    REAL,    DIMENSION(klon_mpi)             :: cell_area_mpi
+    REAL,    DIMENSION(klon_mpi,nbsrf)       :: pctsrf_mpi
+
+    INTEGER :: ji,j,i
+ 
+    IF (is_omp_master) THEN
+      CALL xios_recv_field("ts",tsol_mpi)
+      CALL xios_recv_field("qs",qsol_mpi)
+      CALL xios_recv_field("mask",zmasq_mpi)
+      IF (landice_opt .LT. 2) CALL xios_recv_field("landice",lic_mpi)
+      CALL xios_recv_field("zmea",zmea_mpi)
+      CALL xios_recv_field("zstd",zstd_mpi)
+      CALL xios_recv_field("zsig",zsig_mpi)
+      CALL xios_recv_field("zgam",zgam_mpi)
+      CALL xios_recv_field("zthe",zthe_mpi)
+    ENDIF
+    CALL scatter_omp(tsol_mpi,tsol)
+    CALL scatter_omp(qsol_mpi,qsol)
+    CALL scatter_omp(zmasq_mpi,zmasq)
+    IF (landice_opt .LT. 2) CALL scatter_omp(lic_mpi,lic)
+    CALL scatter_omp(zmea_mpi,zmea)
+    CALL scatter_omp(zstd_mpi,zstd)
+    CALL scatter_omp(zsig_mpi,zsig)
+    CALL scatter_omp(zgam_mpi,zgam)
+    CALL scatter_omp(zthe_mpi,zthe)
+
+    radsol(:)   = 0.0
+    rugmer(:) = 0.001
+    sn(:)     = 0
+
+    WHERE(qsol(:)<0) qsol(:)=0 
+        
+    WHERE(   zmasq(:)<EPSFRA) zmasq(:)=0.
+    WHERE(1.-zmasq(:)<EPSFRA) zmasq(:)=1.
+
+    pctsrf(:,:) = 0
+    IF (landice_opt .LT. 2) THEN
+       pctsrf(:,is_lic)=lic
+       WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0.
+       WHERE(zmasq(:)<EPSFRA)         pctsrf(:,is_lic)=0.
+
+       pctsrf(:,is_ter)=zmasq(:)
+       
+       !--- Adequation with soil/sea mask
+       DO ji=1,klon
+          IF(zmasq(ji)>EPSFRA) THEN 
+             IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN
+                pctsrf(ji,is_lic)=zmasq(ji)
+                pctsrf(ji,is_ter)=0.
+             ELSE
+                pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic)
+                IF(pctsrf(ji,is_ter)<EPSFRA) THEN
+                   pctsrf(ji,is_ter)=0.
+                   pctsrf(ji,is_lic)=zmasq(ji)
+                END IF
+             END IF
+          END IF
+       END DO
+   
+    ELSE
+       ! landice_opt=>2 : no land ice
+       pctsrf(:,is_lic)=0.0
+       pctsrf(:,is_ter)=zmasq(:)
+    END IF
+
+
+
+
+
+  !--- Option no_ter_antartique removes all land fractions souther than 60S.
+  !--- Land ice is set instead of the land fractions on these latitudes.
+  !--- The ocean and sea-ice fractions are not changed.
+  !--- This option is only available if landice_opt<2.   
+  IF (landice_opt .LT. 2) THEN
+     no_ter_antartique=.FALSE.
+     CALL getin_p('no_ter_antartique',no_ter_antartique)
+     WRITE(lunout,*)"no_ter_antartique=",no_ter_antartique
+     IF (no_ter_antartique) THEN
+        ! Remove all land fractions souther than 60S and set land-ice instead
+        WRITE(lunout,*) "Remove land fractions souther than 60deg south by increasing"
+        WRITE(lunout,*) "the continental ice fractions. No land can now be found at Antartic."
+        DO ji=1, klon
+           IF (latitude_deg(ji)<-60.0) THEN
+              pctsrf(ji,is_lic) = pctsrf(ji,is_lic) + pctsrf(ji,is_ter)
+              pctsrf(ji,is_ter) = 0
+           END IF
+        END DO
+     END IF
+  END IF
+    
+! sub-surface ocean and sea ice (sea ice set to zero for start)
+!*******************************************************************************
+    pctsrf(:,is_oce)=(1.-zmasq(:))
+    WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0.
+    
+    zval(:)=max(0.,zmea-2*zstd(:))
+    zpic(:)=zmea+2*zstd(:)
+    
+!! WARNING    DON'T FORGET FOR LATER
+!!ym  IF(couple) pctsrf(:,is_oce)=ocemask_fi(:)
+!! 
+    
+! Init: tsol, qsol, sn, evap, tsoil, rain_fall, snow_fall, solsw, sollw, frugs
+!*******************************************************************************
+    DO i=1,nbsrf
+     ftsol(:,i) = tsol
+    END DO
+  
+    DO i=1,nbsrf
+     snsrf(:,i) = sn
+    END DO
+!albedo SB >>>
+!ym error : the sub surface dimension is the third not second
+!    falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
+!    falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
+    falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6
+    falb_dir(:,:,is_oce)=0.5;  falb_dir(:,:,is_sic)=0.6
+
+!ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ?
+!ym probably the uninitialized value was 0 for standard (regular grid) case
+    falb_dif(:,:,:)=0
+
+!albedo SB <<<
+    fevap(:,:) = 0.
+    DO i=1,nbsrf
+     qsolsrf(:,i)=150.
+    END DO
+ 
+    DO i=1,nbsrf 
+      DO j=1,nsoilmx
+        tsoil(:,j,i) = tsol
+      END DO
+    END DO
+ 
+    rain_fall = 0.; snow_fall = 0.
+    solsw = 165.;   sollw = -53.
+!ym warning missing init for sollwdown => set to 0
+  sollwdown  = 0.
+    
+    
+    t_ancien = 273.15
+    u_ancien=0
+    v_ancien=0
+    q_ancien = 0.
+    agesno = 0.
+
+    z0m(:,is_oce) = rugmer(:)
+
+   z0m(:,is_ter) = 0.01 ! MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
+   z0m(:,is_lic) = 0.001 !MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
+
+   z0m(:,is_sic) = 0.001
+   z0h(:,:)=z0m(:,:)
+
+    fder = 0.0
+    clwcon = 0.0
+    rnebcon = 0.0
+    ratqs = 0.0
+    run_off_lic_0 = 0.0 
+    rugoro = 0.0
+
+! Before phyredem calling, surface modules and values to be saved in startphy.nc
+! are initialized
+!*******************************************************************************
+    pbl_tke(:,:,:) = 1.e-8 
+    zmax0(:) = 40.
+    f0(:) = 1.e-5
+    sig1(:,:) = 0.
+    w01(:,:) = 0.
+    wake_deltat(:,:) = 0.
+    wake_deltaq(:,:) = 0.
+    wake_s(:) = 0.
+    wake_cstar(:) = 0.
+    wake_fip(:) = 0.
+    wake_pe = 0.
+    fm_therm = 0.
+    entr_therm = 0.
+    detr_therm = 0.
+    ale_bl = 0.
+    ale_bl_trig =0. 
+    alp_bl =0.
+    CALL fonte_neige_init(run_off_lic_0)
+    CALL pbl_surface_init( fder, snsrf, qsolsrf, tsoil )
+
+    CALL gather_omp(cell_area,cell_area_mpi)
+    CALL gather_omp(pctsrf,pctsrf_mpi)
+    IF (is_omp_master) THEN
+      CALL xios_send_field("area_ce0l",cell_area_mpi)
+      CALL xios_send_field("fract_oce_ce0l",pctsrf_mpi(:,is_oce))
+      CALL xios_send_field("fract_sic_ce0l",pctsrf_mpi(:,is_sic))
+    ENDIF
+    
+    CALL phyredem( "startphy.nc" )
+
+  END SUBROUTINE create_etat0_unstruct
+
+
+END MODULE create_etat0_unstruct_mod
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/create_limit_unstruct.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/create_limit_unstruct.F90	(revision 4726)
+++ 	(revision )
@@ -1,319 +1,0 @@
-MODULE create_limit_unstruct_mod
-    PRIVATE
-    INTEGER, PARAMETER                             :: lmdep=12
-
-    PUBLIC create_limit_unstruct
-
-CONTAINS
-
-
-  SUBROUTINE create_limit_unstruct
-  USE dimphy
-#ifdef CPP_XIOS
-  USE xios
-  USE ioipsl,             ONLY : ioget_year_len
-  USE time_phylmdz_mod, ONLY : annee_ref
-  USE indice_sol_mod
-  USE phys_state_var_mod
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-    INCLUDE "iniprint.h"
-    REAL,    DIMENSION(:,:),ALLOCATABLE            :: sic
-    REAL,    DIMENSION(:,:),ALLOCATABLE            :: sst
-    REAL,    DIMENSION(klon,lmdep)                 :: rugos
-    REAL,    DIMENSION(klon,lmdep)                 :: albedo
-    REAL,    DIMENSION(:,:),ALLOCATABLE            :: sic_mpi
-    REAL,    DIMENSION(:,:),ALLOCATABLE            :: sst_mpi
-    REAL,    DIMENSION(klon_mpi,lmdep)             :: rugos_mpi
-    REAL,    DIMENSION(klon_mpi,lmdep)             :: albedo_mpi
-    INTEGER                                        :: ndays
-    REAL                                           :: fi_ice(klon)
-    REAL, ALLOCATABLE                              :: sic_year(:,:)
-    REAL, ALLOCATABLE                              :: sst_year(:,:)
-    REAL, ALLOCATABLE                              :: rugos_year(:,:)
-    REAL, ALLOCATABLE                              :: albedo_year(:,:)
-    REAL, ALLOCATABLE                              :: pctsrf_t(:,:,:)
-    REAL, ALLOCATABLE                              :: phy_bil(:,:)
-    REAL, ALLOCATABLE                              :: sst_year_mpi(:,:)
-    REAL, ALLOCATABLE                              :: rugos_year_mpi(:,:)
-    REAL, ALLOCATABLE                              :: albedo_year_mpi(:,:)
-    REAL, ALLOCATABLE                              :: pctsrf_t_mpi(:,:,:)
-    REAL, ALLOCATABLE                              :: phy_bil_mpi(:,:)
-    INTEGER :: l,k
-    INTEGER :: nbad
-    INTEGER :: sic_time_axis_size 
-    INTEGER :: sst_time_axis_size
-    CHARACTER(LEN=99)                  :: mess            ! error message
-    
-     
-    ndays=ioget_year_len(annee_ref)
-    
-    IF (is_omp_master) CALL xios_get_axis_attr("time_sic",n_glo=sic_time_axis_size)
-    CALL bcast_omp(sic_time_axis_size)
-    ALLOCATE(sic_mpi(klon_mpi,sic_time_axis_size))
-    ALLOCATE(sic(klon,sic_time_axis_size))
-    
-    
-    IF (is_omp_master) CALL xios_get_axis_attr("time_sst",n_glo=sst_time_axis_size)
-    CALL bcast_omp(sst_time_axis_size)
-    ALLOCATE(sst_mpi(klon_mpi,sst_time_axis_size))
-    ALLOCATE(sst(klon,sst_time_axis_size))
-    
-    IF (is_omp_master) THEN
-      CALL xios_recv_field("sic_limit",sic_mpi)
-      CALL xios_recv_field("sst_limit",sst_mpi)
-      CALL xios_recv_field("rugos_limit",rugos_mpi)
-      CALL xios_recv_field("albedo_limit",albedo_mpi)
-    ENDIF
-    CALL scatter_omp(sic_mpi,sic)
-    CALL scatter_omp(sst_mpi,sst)
-    CALL scatter_omp(rugos_mpi,rugos)
-    CALL scatter_omp(albedo_mpi,albedo)
-    
-    ALLOCATE(sic_year(klon,ndays))
-    ALLOCATE(sst_year(klon,ndays))
-    ALLOCATE(rugos_year(klon,ndays))
-    ALLOCATE(albedo_year(klon,ndays))
-    ALLOCATE(pctsrf_t(klon,nbsrf,ndays))
-    ALLOCATE(phy_bil(klon,ndays)); phy_bil=0.0
-
-
-! sic
-    IF (sic_time_axis_size==lmdep) THEN
-      CALL time_interpolation(ndays,sic,'gregorian',sic_year)
-    ELSE IF (sic_time_axis_size==ndays) THEN
-      sic_year=sic
-    ELSE
-      WRITE(mess,*) 'sic time axis is nor montly, nor daily. sic time interpolation ',&
-                    'is requiered but is not currently managed'
-      CALL abort_physic('create_limit_unstruct',TRIM(mess),1)
-    ENDIF
-    
-    sic_year(:,:)=sic_year(:,:)/100.  ! convert percent to fraction
-    WHERE(sic_year(:,:)>1.0) sic_year(:,:)=1.0    ! Some fractions have some time large negative values
-    WHERE(sic_year(:,:)<0.0) sic_year(:,:)=0.0    ! probably better to apply alse this filter before horizontal interpolation
-    
-! sst
-    IF (sst_time_axis_size==lmdep) THEN
-      CALL time_interpolation(ndays,sst,'gregorian',sst_year)
-    ELSE IF (sst_time_axis_size==ndays) THEN
-      sst_year=sst
-    ELSE
-      WRITE(mess,*)'sic time axis is nor montly, nor daily. sic time interpolation ',&
-                   'is requiered but is not currently managed'
-      CALL abort_physic('create_limit_unstruct',TRIM(mess),1)
-    ENDIF
-    WHERE(sst_year(:,:)<271.38) sst_year(:,:)=271.38
-
-
-! rugos    
-    DO l=1, lmdep
-      WHERE(NINT(zmasq(:))/=1) rugos(:,l)=0.001
-    ENDDO
-    CALL time_interpolation(ndays,rugos,'360_day',rugos_year)
-
-! albedo    
-    CALL time_interpolation(ndays,albedo,'360_day',albedo_year)
-
-
-    DO k=1,ndays
-      fi_ice=sic_year(:,k)
-      WHERE(fi_ice>=1.0  ) fi_ice=1.0
-      WHERE(fi_ice<EPSFRA) fi_ice=0.0
-      pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter)       ! land soil
-      pctsrf_t(:,is_lic,k)=pctsrf(:,is_lic)       ! land ice
-
-!!     IF (icefile==trim(fcpldsic)) THEN           ! SIC=pICE*(1-LIC-TER)
-!!        pctsrf_t(:,is_sic,k)=fi_ice(:)*(1.-pctsrf(:,is_lic)-pctsrf(:,is_ter))
-!!     ELSE IF (icefile==trim(fhistsic)) THEN      ! SIC=pICE
-!!        pctsrf_t(:,is_sic,k)=fi_ice(:)
-!!     ELSE ! icefile==famipsic                    ! SIC=pICE-LIC
-        pctsrf_t(:,is_sic,k)=fi_ice-pctsrf_t(:,is_lic,k)
-!     END IF
-      WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0.
-      WHERE(1.0-zmasq<EPSFRA)
-        pctsrf_t(:,is_sic,k)=0.0
-        pctsrf_t(:,is_oce,k)=0.0
-      ELSEWHERE
-        WHERE(pctsrf_t(:,is_sic,k)>=1.0-zmasq)
-          pctsrf_t(:,is_sic,k)=1.0-zmasq
-          pctsrf_t(:,is_oce,k)=0.0
-        ELSEWHERE
-          pctsrf_t(:,is_oce,k)=1.0-zmasq-pctsrf_t(:,is_sic,k)
-          WHERE(pctsrf_t(:,is_oce,k)<EPSFRA)
-             pctsrf_t(:,is_oce,k)=0.0
-             pctsrf_t(:,is_sic,k)=1.0-zmasq
-          END WHERE
-        END WHERE
-      END WHERE
-      nbad=COUNT(pctsrf_t(:,is_oce,k)<0.0)
-      IF(nbad>0) WRITE(lunout,*) 'pb sous maille pour nb point = ',nbad
-      nbad=COUNT(abs(sum(pctsrf_t(:,:,k),dim=2)-1.0)>EPSFRA)
-      IF(nbad>0) WRITE(lunout,*) 'pb sous surface pour nb points = ',nbad
-    END DO
-    
-    ALLOCATE(sst_year_mpi(klon_mpi,ndays))
-    ALLOCATE(rugos_year_mpi(klon_mpi,ndays))
-    ALLOCATE(albedo_year_mpi(klon_mpi,ndays))
-    ALLOCATE(pctsrf_t_mpi(klon_mpi,nbsrf,ndays))
-    ALLOCATE(phy_bil_mpi(klon_mpi,ndays))
-    
-    CALL gather_omp(pctsrf_t   , pctsrf_t_mpi)
-    CALL gather_omp(sst_year   , sst_year_mpi)
-    CALL gather_omp(phy_bil    , phy_bil_mpi)
-    CALL gather_omp(albedo_year, albedo_year_mpi)
-    CALL gather_omp(rugos_year , rugos_year_mpi)
-
-    IF (is_omp_master) THEN
-      CALL xios_send_field("foce_limout",pctsrf_t_mpi(:,is_oce,:))
-      CALL xios_send_field("fsic_limout",pctsrf_t_mpi(:,is_sic,:))
-      CALL xios_send_field("fter_limout",pctsrf_t_mpi(:,is_ter,:))
-      CALL xios_send_field("flic_limout",pctsrf_t_mpi(:,is_lic,:))
-      CALL xios_send_field("sst_limout", sst_year_mpi)
-      CALL xios_send_field("bils_limout",phy_bil_mpi)
-      CALL xios_send_field("alb_limout", albedo_year_mpi) 
-      CALL xios_send_field("rug_limout", rugos_year_mpi) 
-    ENDIF
-#endif
-  END SUBROUTINE create_limit_unstruct
-  
-  
-  SUBROUTINE time_interpolation(ndays,field_in,calendar,field_out)
-  USE pchsp_95_m, only: pchsp_95
-  USE pchfe_95_m, only: pchfe_95
-  USE arth_m, only: arth
-  USE dimphy, ONLY : klon
-  USE ioipsl,             ONLY : ioget_year_len
-  USE time_phylmdz_mod, ONLY : annee_ref
-  USE mod_phys_lmdz_para
-  IMPLICIT NONE
-   INCLUDE "iniprint.h"
-
-   INTEGER,         INTENT(IN)  :: ndays
-   REAL,            INTENT(IN)  :: field_in(klon,lmdep)
-   CHARACTER(LEN=*),INTENT(IN)  :: calendar
-   REAL,            INTENT(OUT) :: field_out(klon,ndays)
- 
-   INTEGER :: ndays_in
-   REAL    :: timeyear(lmdep)   
-   REAL    :: yder(lmdep)   
-   INTEGER :: ij,ierr, n_extrap
-   LOGICAL :: skip
-
-   CHARACTER (len = 50)         :: modname = 'create_limit_unstruct.time_interpolation'
-   CHARACTER (len = 80)         :: abort_message
-
-  
-   IF (is_omp_master) ndays_in=year_len(annee_ref, calendar)
-   CALL bcast_omp(ndays_in)
-   IF (is_omp_master) timeyear=mid_months(annee_ref, calendar, lmdep)
-   CALL bcast_omp(timeyear)
-    
-   n_extrap = 0
-   skip=.FALSE.
-   DO ij=1,klon
-     yder = pchsp_95(timeyear, field_in(ij, :), ibeg=2, iend=2, vc_beg=0., vc_end=0.)
-     CALL pchfe_95(timeyear, field_in(ij, :), yder, skip, arth(0., real(ndays_in) / ndays, ndays), field_out(ij, :), ierr)
-     if (ierr < 0) then
-        abort_message='error in pchfe_95'
-        CALL abort_physic(modname,abort_message,1)
-     endif
-     n_extrap = n_extrap + ierr
-   END DO
-   
-   IF (n_extrap /= 0) then
-     WRITE(lunout,*) "get_2Dfield pchfe_95: n_extrap = ", n_extrap
-   ENDIF 
-  
-  
-  END SUBROUTINE time_interpolation
-  !-------------------------------------------------------------------------------
-  !
-  FUNCTION year_len(y,cal_in)
-  !
-  !-------------------------------------------------------------------------------
-    USE ioipsl, ONLY : ioget_calendar,ioconf_calendar,lock_calendar,ioget_year_len
-    IMPLICIT NONE
-  !-------------------------------------------------------------------------------
-  ! Arguments:
-    INTEGER                       :: year_len
-    INTEGER,           INTENT(IN) :: y
-    CHARACTER(LEN=*),  INTENT(IN) :: cal_in
-  !-------------------------------------------------------------------------------
-  ! Local variables:
-    CHARACTER(LEN=20)             :: cal_out              ! calendar (for outputs)
-  !-------------------------------------------------------------------------------
-  !--- Getting the input calendar to reset at the end of the function
-    CALL ioget_calendar(cal_out)
-  
-  !--- Unlocking calendar and setting it to wanted one
-    CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in))
-  
-  !--- Getting the number of days in this year
-    year_len=ioget_year_len(y)
-  
-  !--- Back to original calendar
-    CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out))
-  
-  END FUNCTION year_len
-  !
-  !-------------------------------------------------------------------------------
-  
-  
-  !-------------------------------------------------------------------------------
-  !
-  FUNCTION mid_months(y,cal_in,nm)
-  !
-  !-------------------------------------------------------------------------------
-    USE ioipsl, ONLY : ioget_calendar,ioconf_calendar,lock_calendar,ioget_mon_len
-    IMPLICIT NONE
-  !-------------------------------------------------------------------------------
-  ! Arguments:
-    INTEGER,                INTENT(IN) :: y               ! year
-    CHARACTER(LEN=*),       INTENT(IN) :: cal_in          ! calendar
-    INTEGER,                INTENT(IN) :: nm              ! months/year number
-    REAL,    DIMENSION(nm)             :: mid_months      ! mid-month times
-  !-------------------------------------------------------------------------------
-  ! Local variables:
-    CHARACTER(LEN=99)                  :: mess            ! error message
-    CHARACTER(LEN=20)                  :: cal_out         ! calendar (for outputs)
-    INTEGER, DIMENSION(nm)             :: mnth            ! months lengths (days)
-    INTEGER                            :: m               ! months counter
-    INTEGER                            :: nd              ! number of days
-    INTEGER                            :: k
-  !-------------------------------------------------------------------------------
-    nd=year_len(y,cal_in)
-  
-    IF(nm==12) THEN
-  
-    !--- Getting the input calendar to reset at the end of the function
-      CALL ioget_calendar(cal_out)
-  
-    !--- Unlocking calendar and setting it to wanted one
-      CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in))
-  
-    !--- Getting the length of each month
-      DO m=1,nm; mnth(m)=ioget_mon_len(y,m); END DO
-  
-    !--- Back to original calendar
-      CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out))
-  
-    ELSE IF(MODULO(nd,nm)/=0) THEN
-      WRITE(mess,'(a,i3,a,i3,a)')'Unconsistent calendar: ',nd,' days/year, but ',&
-        nm,' months/year. Months number should divide days number.'
-      CALL abort_physic('mid_months',TRIM(mess),1)
-  
-    ELSE
-      mnth=(/(m,m=1,nm,nd/nm)/)
-    END IF
-  
-  !--- Mid-months times
-    mid_months(1)=0.5*REAL(mnth(1))
-    DO k=2,nm
-      mid_months(k)=mid_months(k-1)+0.5*REAL(mnth(k-1)+mnth(k))
-    END DO
-  
-  END FUNCTION mid_months
-  
-
-END MODULE create_limit_unstruct_mod
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/create_limit_unstruct_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/create_limit_unstruct_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/create_limit_unstruct_mod.F90	(revision 4727)
@@ -0,0 +1,317 @@
+MODULE create_limit_unstruct_mod
+    PRIVATE
+    INTEGER, PARAMETER                             :: lmdep=12
+
+    PUBLIC create_limit_unstruct
+
+CONTAINS
+
+
+  SUBROUTINE create_limit_unstruct
+  USE dimphy
+  USE lmdz_xios
+  USE ioipsl,             ONLY : ioget_year_len
+  USE time_phylmdz_mod, ONLY : annee_ref
+  USE indice_sol_mod
+  USE phys_state_var_mod
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+    INCLUDE "iniprint.h"
+    REAL,    DIMENSION(:,:),ALLOCATABLE            :: sic
+    REAL,    DIMENSION(:,:),ALLOCATABLE            :: sst
+    REAL,    DIMENSION(klon,lmdep)                 :: rugos
+    REAL,    DIMENSION(klon,lmdep)                 :: albedo
+    REAL,    DIMENSION(:,:),ALLOCATABLE            :: sic_mpi
+    REAL,    DIMENSION(:,:),ALLOCATABLE            :: sst_mpi
+    REAL,    DIMENSION(klon_mpi,lmdep)             :: rugos_mpi
+    REAL,    DIMENSION(klon_mpi,lmdep)             :: albedo_mpi
+    INTEGER                                        :: ndays
+    REAL                                           :: fi_ice(klon)
+    REAL, ALLOCATABLE                              :: sic_year(:,:)
+    REAL, ALLOCATABLE                              :: sst_year(:,:)
+    REAL, ALLOCATABLE                              :: rugos_year(:,:)
+    REAL, ALLOCATABLE                              :: albedo_year(:,:)
+    REAL, ALLOCATABLE                              :: pctsrf_t(:,:,:)
+    REAL, ALLOCATABLE                              :: phy_bil(:,:)
+    REAL, ALLOCATABLE                              :: sst_year_mpi(:,:)
+    REAL, ALLOCATABLE                              :: rugos_year_mpi(:,:)
+    REAL, ALLOCATABLE                              :: albedo_year_mpi(:,:)
+    REAL, ALLOCATABLE                              :: pctsrf_t_mpi(:,:,:)
+    REAL, ALLOCATABLE                              :: phy_bil_mpi(:,:)
+    INTEGER :: l,k
+    INTEGER :: nbad
+    INTEGER :: sic_time_axis_size 
+    INTEGER :: sst_time_axis_size
+    CHARACTER(LEN=99)                  :: mess            ! error message
+    
+     
+    ndays=ioget_year_len(annee_ref)
+    
+    IF (is_omp_master) CALL xios_get_axis_attr("time_sic",n_glo=sic_time_axis_size)
+    CALL bcast_omp(sic_time_axis_size)
+    ALLOCATE(sic_mpi(klon_mpi,sic_time_axis_size))
+    ALLOCATE(sic(klon,sic_time_axis_size))
+    
+    
+    IF (is_omp_master) CALL xios_get_axis_attr("time_sst",n_glo=sst_time_axis_size)
+    CALL bcast_omp(sst_time_axis_size)
+    ALLOCATE(sst_mpi(klon_mpi,sst_time_axis_size))
+    ALLOCATE(sst(klon,sst_time_axis_size))
+    
+    IF (is_omp_master) THEN
+      CALL xios_recv_field("sic_limit",sic_mpi)
+      CALL xios_recv_field("sst_limit",sst_mpi)
+      CALL xios_recv_field("rugos_limit",rugos_mpi)
+      CALL xios_recv_field("albedo_limit",albedo_mpi)
+    ENDIF
+    CALL scatter_omp(sic_mpi,sic)
+    CALL scatter_omp(sst_mpi,sst)
+    CALL scatter_omp(rugos_mpi,rugos)
+    CALL scatter_omp(albedo_mpi,albedo)
+    
+    ALLOCATE(sic_year(klon,ndays))
+    ALLOCATE(sst_year(klon,ndays))
+    ALLOCATE(rugos_year(klon,ndays))
+    ALLOCATE(albedo_year(klon,ndays))
+    ALLOCATE(pctsrf_t(klon,nbsrf,ndays))
+    ALLOCATE(phy_bil(klon,ndays)); phy_bil=0.0
+
+
+! sic
+    IF (sic_time_axis_size==lmdep) THEN
+      CALL time_interpolation(ndays,sic,'gregorian',sic_year)
+    ELSE IF (sic_time_axis_size==ndays) THEN
+      sic_year=sic
+    ELSE
+      WRITE(mess,*) 'sic time axis is nor montly, nor daily. sic time interpolation ',&
+                    'is requiered but is not currently managed'
+      CALL abort_physic('create_limit_unstruct',TRIM(mess),1)
+    ENDIF
+    
+    sic_year(:,:)=sic_year(:,:)/100.  ! convert percent to fraction
+    WHERE(sic_year(:,:)>1.0) sic_year(:,:)=1.0    ! Some fractions have some time large negative values
+    WHERE(sic_year(:,:)<0.0) sic_year(:,:)=0.0    ! probably better to apply alse this filter before horizontal interpolation
+    
+! sst
+    IF (sst_time_axis_size==lmdep) THEN
+      CALL time_interpolation(ndays,sst,'gregorian',sst_year)
+    ELSE IF (sst_time_axis_size==ndays) THEN
+      sst_year=sst
+    ELSE
+      WRITE(mess,*)'sic time axis is nor montly, nor daily. sic time interpolation ',&
+                   'is requiered but is not currently managed'
+      CALL abort_physic('create_limit_unstruct',TRIM(mess),1)
+    ENDIF
+    WHERE(sst_year(:,:)<271.38) sst_year(:,:)=271.38
+
+
+! rugos    
+    DO l=1, lmdep
+      WHERE(NINT(zmasq(:))/=1) rugos(:,l)=0.001
+    ENDDO
+    CALL time_interpolation(ndays,rugos,'360_day',rugos_year)
+
+! albedo    
+    CALL time_interpolation(ndays,albedo,'360_day',albedo_year)
+
+
+    DO k=1,ndays
+      fi_ice=sic_year(:,k)
+      WHERE(fi_ice>=1.0  ) fi_ice=1.0
+      WHERE(fi_ice<EPSFRA) fi_ice=0.0
+      pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter)       ! land soil
+      pctsrf_t(:,is_lic,k)=pctsrf(:,is_lic)       ! land ice
+
+!!     IF (icefile==trim(fcpldsic)) THEN           ! SIC=pICE*(1-LIC-TER)
+!!        pctsrf_t(:,is_sic,k)=fi_ice(:)*(1.-pctsrf(:,is_lic)-pctsrf(:,is_ter))
+!!     ELSE IF (icefile==trim(fhistsic)) THEN      ! SIC=pICE
+!!        pctsrf_t(:,is_sic,k)=fi_ice(:)
+!!     ELSE ! icefile==famipsic                    ! SIC=pICE-LIC
+        pctsrf_t(:,is_sic,k)=fi_ice-pctsrf_t(:,is_lic,k)
+!     END IF
+      WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0.
+      WHERE(1.0-zmasq<EPSFRA)
+        pctsrf_t(:,is_sic,k)=0.0
+        pctsrf_t(:,is_oce,k)=0.0
+      ELSEWHERE
+        WHERE(pctsrf_t(:,is_sic,k)>=1.0-zmasq)
+          pctsrf_t(:,is_sic,k)=1.0-zmasq
+          pctsrf_t(:,is_oce,k)=0.0
+        ELSEWHERE
+          pctsrf_t(:,is_oce,k)=1.0-zmasq-pctsrf_t(:,is_sic,k)
+          WHERE(pctsrf_t(:,is_oce,k)<EPSFRA)
+             pctsrf_t(:,is_oce,k)=0.0
+             pctsrf_t(:,is_sic,k)=1.0-zmasq
+          END WHERE
+        END WHERE
+      END WHERE
+      nbad=COUNT(pctsrf_t(:,is_oce,k)<0.0)
+      IF(nbad>0) WRITE(lunout,*) 'pb sous maille pour nb point = ',nbad
+      nbad=COUNT(abs(sum(pctsrf_t(:,:,k),dim=2)-1.0)>EPSFRA)
+      IF(nbad>0) WRITE(lunout,*) 'pb sous surface pour nb points = ',nbad
+    END DO
+    
+    ALLOCATE(sst_year_mpi(klon_mpi,ndays))
+    ALLOCATE(rugos_year_mpi(klon_mpi,ndays))
+    ALLOCATE(albedo_year_mpi(klon_mpi,ndays))
+    ALLOCATE(pctsrf_t_mpi(klon_mpi,nbsrf,ndays))
+    ALLOCATE(phy_bil_mpi(klon_mpi,ndays))
+    
+    CALL gather_omp(pctsrf_t   , pctsrf_t_mpi)
+    CALL gather_omp(sst_year   , sst_year_mpi)
+    CALL gather_omp(phy_bil    , phy_bil_mpi)
+    CALL gather_omp(albedo_year, albedo_year_mpi)
+    CALL gather_omp(rugos_year , rugos_year_mpi)
+
+    IF (is_omp_master) THEN
+      CALL xios_send_field("foce_limout",pctsrf_t_mpi(:,is_oce,:))
+      CALL xios_send_field("fsic_limout",pctsrf_t_mpi(:,is_sic,:))
+      CALL xios_send_field("fter_limout",pctsrf_t_mpi(:,is_ter,:))
+      CALL xios_send_field("flic_limout",pctsrf_t_mpi(:,is_lic,:))
+      CALL xios_send_field("sst_limout", sst_year_mpi)
+      CALL xios_send_field("bils_limout",phy_bil_mpi)
+      CALL xios_send_field("alb_limout", albedo_year_mpi) 
+      CALL xios_send_field("rug_limout", rugos_year_mpi) 
+    ENDIF
+  END SUBROUTINE create_limit_unstruct
+  
+  
+  SUBROUTINE time_interpolation(ndays,field_in,calendar,field_out)
+  USE pchsp_95_m, only: pchsp_95
+  USE pchfe_95_m, only: pchfe_95
+  USE arth_m, only: arth
+  USE dimphy, ONLY : klon
+  USE ioipsl,             ONLY : ioget_year_len
+  USE time_phylmdz_mod, ONLY : annee_ref
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+   INCLUDE "iniprint.h"
+
+   INTEGER,         INTENT(IN)  :: ndays
+   REAL,            INTENT(IN)  :: field_in(klon,lmdep)
+   CHARACTER(LEN=*),INTENT(IN)  :: calendar
+   REAL,            INTENT(OUT) :: field_out(klon,ndays)
+ 
+   INTEGER :: ndays_in
+   REAL    :: timeyear(lmdep)   
+   REAL    :: yder(lmdep)   
+   INTEGER :: ij,ierr, n_extrap
+   LOGICAL :: skip
+
+   CHARACTER (len = 50)         :: modname = 'create_limit_unstruct.time_interpolation'
+   CHARACTER (len = 80)         :: abort_message
+
+  
+   IF (is_omp_master) ndays_in=year_len(annee_ref, calendar)
+   CALL bcast_omp(ndays_in)
+   IF (is_omp_master) timeyear=mid_months(annee_ref, calendar, lmdep)
+   CALL bcast_omp(timeyear)
+    
+   n_extrap = 0
+   skip=.FALSE.
+   DO ij=1,klon
+     yder = pchsp_95(timeyear, field_in(ij, :), ibeg=2, iend=2, vc_beg=0., vc_end=0.)
+     CALL pchfe_95(timeyear, field_in(ij, :), yder, skip, arth(0., real(ndays_in) / ndays, ndays), field_out(ij, :), ierr)
+     if (ierr < 0) then
+        abort_message='error in pchfe_95'
+        CALL abort_physic(modname,abort_message,1)
+     endif
+     n_extrap = n_extrap + ierr
+   END DO
+   
+   IF (n_extrap /= 0) then
+     WRITE(lunout,*) "get_2Dfield pchfe_95: n_extrap = ", n_extrap
+   ENDIF 
+  
+  
+  END SUBROUTINE time_interpolation
+  !-------------------------------------------------------------------------------
+  !
+  FUNCTION year_len(y,cal_in)
+  !
+  !-------------------------------------------------------------------------------
+    USE ioipsl, ONLY : ioget_calendar,ioconf_calendar,lock_calendar,ioget_year_len
+    IMPLICIT NONE
+  !-------------------------------------------------------------------------------
+  ! Arguments:
+    INTEGER                       :: year_len
+    INTEGER,           INTENT(IN) :: y
+    CHARACTER(LEN=*),  INTENT(IN) :: cal_in
+  !-------------------------------------------------------------------------------
+  ! Local variables:
+    CHARACTER(LEN=20)             :: cal_out              ! calendar (for outputs)
+  !-------------------------------------------------------------------------------
+  !--- Getting the input calendar to reset at the end of the function
+    CALL ioget_calendar(cal_out)
+  
+  !--- Unlocking calendar and setting it to wanted one
+    CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in))
+  
+  !--- Getting the number of days in this year
+    year_len=ioget_year_len(y)
+  
+  !--- Back to original calendar
+    CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out))
+  
+  END FUNCTION year_len
+  !
+  !-------------------------------------------------------------------------------
+  
+  
+  !-------------------------------------------------------------------------------
+  !
+  FUNCTION mid_months(y,cal_in,nm)
+  !
+  !-------------------------------------------------------------------------------
+    USE ioipsl, ONLY : ioget_calendar,ioconf_calendar,lock_calendar,ioget_mon_len
+    IMPLICIT NONE
+  !-------------------------------------------------------------------------------
+  ! Arguments:
+    INTEGER,                INTENT(IN) :: y               ! year
+    CHARACTER(LEN=*),       INTENT(IN) :: cal_in          ! calendar
+    INTEGER,                INTENT(IN) :: nm              ! months/year number
+    REAL,    DIMENSION(nm)             :: mid_months      ! mid-month times
+  !-------------------------------------------------------------------------------
+  ! Local variables:
+    CHARACTER(LEN=99)                  :: mess            ! error message
+    CHARACTER(LEN=20)                  :: cal_out         ! calendar (for outputs)
+    INTEGER, DIMENSION(nm)             :: mnth            ! months lengths (days)
+    INTEGER                            :: m               ! months counter
+    INTEGER                            :: nd              ! number of days
+    INTEGER                            :: k
+  !-------------------------------------------------------------------------------
+    nd=year_len(y,cal_in)
+  
+    IF(nm==12) THEN
+  
+    !--- Getting the input calendar to reset at the end of the function
+      CALL ioget_calendar(cal_out)
+  
+    !--- Unlocking calendar and setting it to wanted one
+      CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in))
+  
+    !--- Getting the length of each month
+      DO m=1,nm; mnth(m)=ioget_mon_len(y,m); END DO
+  
+    !--- Back to original calendar
+      CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out))
+  
+    ELSE IF(MODULO(nd,nm)/=0) THEN
+      WRITE(mess,'(a,i3,a,i3,a)')'Unconsistent calendar: ',nd,' days/year, but ',&
+        nm,' months/year. Months number should divide days number.'
+      CALL abort_physic('mid_months',TRIM(mess),1)
+  
+    ELSE
+      mnth=(/(m,m=1,nm,nd/nm)/)
+    END IF
+  
+  !--- Mid-months times
+    mid_months(1)=0.5*REAL(mnth(1))
+    DO k=2,nm
+      mid_months(k)=mid_months(k-1)+0.5*REAL(mnth(k-1)+mnth(k))
+    END DO
+  
+  END FUNCTION mid_months
+  
+
+END MODULE create_limit_unstruct_mod
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cv30_routines.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cv30_routines.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cv30_routines.F90	(revision 4727)
@@ -3281,7 +3281,7 @@
         ! Toutes les autres variables fn de ep sont calculées plus bas.
 
-#include "cvthermo.h"
-#include "cv30param.h"
-#include "conema3.h"
+        INCLUDE "cvthermo.h"
+        INCLUDE "cv30param.h"
+        INCLUDE "conema3.h"
 
 ! inputs:
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cv3_routines.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cv3_routines.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cv3_routines.F90	(revision 4727)
@@ -3448,9 +3448,9 @@
                      tv, tvp, wghti, &
                      iflag, precip, Vprecip, Vprecipi, &     ! jyg: Vprecipi
-                     ft, fr, fu, fv, ftra, &                 ! jyg
+                     ft, fr, fr_comp, fu, fv, ftra, &                 ! jyg
                      cbmf, upwd, dnwd, dnwd0, ma, mip, &
 !!                     tls, tps,                             ! useless . jyg
                      qcondc, wd, &
-                     ftd, fqd, qta, qtc, sigt, tau_cld_cv, coefw_cld_cv)
+                     ftd, fqd, qta, qtc, sigt, detrain, tau_cld_cv, coefw_cld_cv)
 
     USE print_control_mod, ONLY: lunout, prt_level
@@ -3505,5 +3505,5 @@
 !outputs:
       REAL, DIMENSION (nloc), INTENT (OUT)               :: precip
-      REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: ft, fr, fu, fv
+      REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: ft, fr, fu, fv , fr_comp
       REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: ftd, fqd
       REAL, DIMENSION (nloc, nd, ntra), INTENT (OUT)     :: ftra
@@ -3515,4 +3515,5 @@
       REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: qcondc                      ! cld
       REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: qtc, sigt                   ! cld
+      REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: detrain                     ! Louis : pour le calcul de Klein du terme de variance qui dÃ©traine dans lenvironnement
       REAL, DIMENSION (nloc), INTENT (OUT)               :: wd                          ! gust
       REAL, DIMENSION (nloc), INTENT (OUT)               :: cbmf
@@ -3541,4 +3542,5 @@
       REAL, DIMENSION (nloc)                             :: sument
       REAL, DIMENSION (nloc, nd)                         :: sigment, qtment             ! cld
+      REAL, DIMENSION (nloc, nd, nd)                     :: qdet
       REAL sumdq !jyg
 ! 
@@ -3570,4 +3572,5 @@
       ft(il, i) = 0.0
       fr(il, i) = 0.0
+      fr_comp(il,i) = 0.0
       fu(il, i) = 0.0
       fv(il, i) = 0.0
@@ -3580,4 +3583,6 @@
       sigment(il, i) = 0.0 ! cld
       sigt(il, i) = 0.0 ! cld
+      qdet(il,i,:) = 0.0 ! cld
+      detrain(il, i) = 0.0 ! cld
       nqcond(il, i) = 0.0 ! cld
     END DO
@@ -3811,4 +3816,5 @@
       IF (j<=inb(il) .AND. iflag(il)<=1) THEN
         fr(il, 1) = fr(il, 1) + 0.01*grav*work(il)*ment(il, j, 1)*(qent(il,j,1)-rr(il,1))
+        fr_comp(il,1) = fr_comp(il,1) + 0.01*grav*work(il)*ment(il, j, 1)*(qent(il,j,1)-rr(il,1))
         fu(il, 1) = fu(il, 1) + 0.01*grav*work(il)*ment(il, j, 1)*(uent(il,j,1)-u(il,1))
         fv(il, 1) = fv(il, 1) + 0.01*grav*work(il)*ment(il, j, 1)*(vent(il,j,1)-v(il,1))
@@ -4213,4 +4219,5 @@
           fr(il, i) = fr(il, i) + 0.01*grav*dpinv*ment(il, k, i) * &
                                                        (qent(il,k,i)-awat(il)-rr(il,i))
+          fr_comp(il,i) = fr_comp(il,i) + 0.01*grav*dpinv*ment(il, k, i)*(qent(il,k,i)-awat(il)-rr(il,i))
           fu(il, i) = fu(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(uent(il,k,i)-u(il,i))
           fv(il, i) = fv(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(vent(il,k,i)-v(il,i))
@@ -4218,4 +4225,5 @@
 ! (saturated updrafts resulting from mixing)                                   ! cld
           qcond(il, i) = qcond(il, i) + (elij(il,k,i)-awat(il))                ! cld
+          qdet(il,k,i) = (qent(il,k,i)-awat(il))                               ! cld Louis : specific humidity in detraining water
           qtment(il, i) = qtment(il, i) + qent(il,k,i)                         ! cld
           nqcond(il, i) = nqcond(il, i) + 1.                                   ! cld
@@ -4298,4 +4306,5 @@
 ! (saturated downdrafts resulting from mixing)                                 ! cld
           qcond(il, i) = qcond(il, i) + elij(il, k, i)                         ! cld
+          qdet(il,k,i) = qent(il,k,i)                                          ! cld Louis : specific humidity in detraining water
           qtment(il, i) = qent(il,k,i) + qtment(il,i)                          ! cld
           nqcond(il, i) = nqcond(il, i) + 1.                                   ! cld
@@ -4316,4 +4325,5 @@
 !      PROBLEM: Should not qent(il,i,i) be taken into account even if nent(il,i)/=0?
 !!        qtment(il, i) = qent(il,k,i) + qtment(il,i)                            ! cld
+        qdet(il,i,i) = qent(il,i,i)                                            ! cld Louis : specific humidity in detraining water
         qtment(il, i) = qent(il,i,i) + qtment(il,i)                            ! cld
 !>jyg
@@ -4887,4 +4897,5 @@
         IF  (k<=inb(il) .AND. i<=inb(il) .AND. iflag(il)<=1) THEN   ! cld
           sument(il) =sument(il) + abs(ment(il,k,i))
+          detrain(il,i) = detrain(il,i) + abs(ment(il,k,i))*(qdet(il,k,i) - rr(il,i))*(qdet(il,k,i) - rr(il,i)) ! Louis terme de dÃ©trainement dans le bilan de variance
         ENDIF
       ENDDO     ! il
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cv3a_uncompress.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cv3a_uncompress.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cv3a_uncompress.F90	(revision 4727)
@@ -2,5 +2,5 @@
                            iflag, kbas, ktop, &
                            precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
-                           ft, fq, fu, fv, ftra,  &
+                           ft, fq, fqcomp, fu, fv, ftra,  &
                            sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
                            qcondc, wd, cape, cin, &
@@ -12,9 +12,9 @@
                            qta, clw, elij, evap, ep, epmlmMm, eplaMm, &         ! RomP+jyg
                            wdtrainA, wdtrainS, wdtrainM, &                      ! RomP
-                           qtc, sigt,          &
+                           qtc, sigt, detrain,         &
                            epmax_diag, & ! epmax_cape
                            iflag1, kbas1, ktop1, &
                            precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
-                           ft1, fq1, fu1, fv1, ftra1, &
+                           ft1, fq1, fqcomp1, fu1, fv1, ftra1, &
                            sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
                            qcondc1, wd1, cape1, cin1, &
@@ -26,5 +26,5 @@
                            qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &  ! RomP+jyg
                            wdtrainA1, wdtrainS1, wdtrainM1, &                   ! RomP
-                           qtc1, sigt1, &
+                           qtc1, sigt1, detrain1, &
                            epmax_diag1) ! epmax_cape
 
@@ -54,5 +54,5 @@
   REAL, DIMENSION (nloc), INTENT (IN)                :: ptop2
   REAL, DIMENSION (nloc), INTENT (IN)                :: epmax_diag
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: ft, fq, fu, fv
+  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: ft, fq, fqcomp, fu, fv
   REAL, DIMENSION (nloc, nd, ntra), INTENT (IN)      :: ftra
   REAL, DIMENSION (nloc), INTENT (IN)                :: sigd
@@ -81,5 +81,5 @@
   REAL, DIMENSION (nloc, nd, nd), INTENT (IN)        :: epmlmMm                !RomP+jyg
   REAL, DIMENSION (nloc, nd), INTENT (IN)            :: eplamM                 !RomP+jyg
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: qtc, sigt              !RomP
+  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: qtc, sigt, detrain              !RomP
   REAL, DIMENSION (nloc, nd), INTENT (IN)            :: wdtrainA, wdtrainS, wdtrainM     !RomP
 
@@ -91,5 +91,5 @@
   REAL, DIMENSION (len), INTENT (OUT)                :: epmax_diag1 ! epmax_cape
   REAL, DIMENSION (len), INTENT (OUT)                :: ptop21
-  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ft1, fq1, fu1, fv1
+  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ft1, fq1, fqcomp1, fu1, fv1
   REAL, DIMENSION (len, nd, ntra), INTENT (OUT)      :: ftra1
   REAL, DIMENSION (len), INTENT (OUT)                :: sigd1
@@ -118,5 +118,5 @@
   REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: epmlmMm1               !RomP+jyg
   REAL, DIMENSION (len, nd), INTENT (OUT)            :: eplamM1                !RomP+jyg
-  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qtc1, sigt1            !RomP
+  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qtc1, sigt1, detrain1            !RomP
   REAL, DIMENSION (len, nd), INTENT (OUT)            :: wdtrainA1, wdtrainS1, wdtrainM1   !RomP
 
@@ -158,4 +158,5 @@
         ft1(idcum(i), k) = ft(i, k)
         fq1(idcum(i), k) = fq(i, k)
+        fqcomp1(idcum(i), k) = fqcomp(i, k)
         fu1(idcum(i), k) = fu(i, k)
         fv1(idcum(i), k) = fv(i, k)
@@ -187,4 +188,5 @@
         qtc1(idcum(i), k) = qtc(i, k)
         sigt1(idcum(i), k) = sigt(i, k)
+        detrain1(idcum(i), k) = detrain(i, k)
    
       END DO
@@ -285,4 +287,5 @@
       ft1(:, 1:nl) = ft(:, 1:nl)
       fq1(:, 1:nl) = fq(:, 1:nl)
+      fqcomp1(:, 1:nl) = fqcomp(:, 1:nl)
       fu1(:, 1:nl) = fu(:, 1:nl)
       fv1(:, 1:nl) = fv(:, 1:nl)
@@ -314,4 +317,5 @@
       qtc1(:, 1:nl) = qtc(:, 1:nl)
       sigt1(:, 1:nl) = sigt(:, 1:nl)
+      detrain1(:, 1:nl) = detrain(:, 1:nl)
 !
       ma1(:, nlp) = 0.
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cva_driver.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cva_driver.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cva_driver.F90	(revision 4727)
@@ -11,5 +11,5 @@
                       Ale1, Alp1, omega1, &
                       sig1feed1, sig2feed1, wght1, &
-                      iflag1, ft1, fq1, fu1, fv1, ftra1, &
+                      iflag1, ft1, fq1, fqcomp1, fu1, fv1, ftra1, &
                       precip1, kbas1, ktop1, &
                       cbmf1, plcl1, plfc1, wbeff1, &
@@ -26,5 +26,5 @@
                       da1, phi1, mp1, phi21, d1a1, dam1, sigij1, wghti1, & ! RomP, RL
                       qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &  ! RomP, RL
-                      wdtrainA1, wdtrainS1, wdtrainM1, qtc1, sigt1, tau_cld_cv, &     !!jygprl
+                      wdtrainA1, wdtrainS1, wdtrainM1, qtc1, sigt1, detrain1, tau_cld_cv, &     !!jygprl
                       coefw_cld_cv, &                                      ! RomP, AJ
                       epmax_diag1)  ! epmax_cape
@@ -88,4 +88,5 @@
 ! ft1           Real           Output       temp tend
 ! fq1           Real           Output       spec hum tend
+! fqcomp1       Real           Output       spec hum tend (only mixed draughts)
 ! fu1           Real           Output       u-wind tend
 ! fv1           Real           Output       v-wind tend
@@ -135,4 +136,5 @@
 ! qtc1          Real           Output     specific humidity in convection
 ! sigt1         Real           Output     surface fraction in adiabatic updrafts                                         
+! detrain1      Real           Output     detrainment terme klein
 ! phi21         Real           Output     used in tracer transport (cvltr)
                                          
@@ -209,4 +211,5 @@
   REAL, DIMENSION (len, nd), INTENT (OUT)            :: ft1
   REAL, DIMENSION (len, nd), INTENT (OUT)            :: fq1
+  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fqcomp1
   REAL, DIMENSION (len, nd), INTENT (OUT)            :: fu1
   REAL, DIMENSION (len, nd), INTENT (OUT)            :: fv1
@@ -248,4 +251,5 @@
   REAL, DIMENSION (len, nd), INTENT (OUT)            :: qtc1    ! in cloud water content (intensive)   ! cld
   REAL, DIMENSION (len, nd), INTENT (OUT)            :: sigt1   ! fract. cloud area (intensive)        ! cld
+  REAL, DIMENSION (len, nd), INTENT (OUT)            :: detrain1   ! detrainement term of mixed draughts in environment
 
 ! RomP >>>
@@ -502,5 +506,5 @@
   REAL, DIMENSION(len,nd)     :: ice, fondue, b
   REAL, DIMENSION(len,nd)     :: frac_a, frac_s, faci               !!jygprl
-  REAL ft(nloc, nd), fq(nloc, nd)
+  REAL ft(nloc, nd), fq(nloc, nd), fqcomp(nloc, nd)
   REAL ftd(nloc, nd), fqd(nloc, nd)
   REAL fu(nloc, nd), fv(nloc, nd)
@@ -528,4 +532,5 @@
   REAL qtc(nloc, nd)         ! cld
   REAL sigt(nloc, nd)        ! cld
+  REAL detrain(nloc, nd)     ! cld
  
 ! RomP >>>
@@ -593,4 +598,5 @@
   ft1(:, :) = 0.0
   fq1(:, :) = 0.0
+  fqcomp1(:, :) = 0.0
   fu1(:, :) = 0.0
   fv1(:, :) = 0.0
@@ -646,4 +652,5 @@
 ! RomP >>>
   sigt1(:, :) = 0.
+  detrain1(:, :) = 0.
   qtc1(:, :) = 0.
   wdtrainA1(:, :) = 0.
@@ -1139,10 +1146,10 @@
                      nent, elij, traent, sig, &
                      tv, tvp, wghti, &
-                     iflag, precip, Vprecip, Vprecipi, ft, fq, fu, fv, ftra, &      ! jyg
+                     iflag, precip, Vprecip, Vprecipi, ft, fq, fqcomp, fu, fv, ftra, &      ! jyg
                      cbmf, upwd, dnwd, dnwd0, ma, mip, &
 !!                     tls, tps, &                            ! useless . jyg
                      qcondc, wd, &
 !!                     ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
-                     ftd, fqd, qta, qtc, sigt, tau_cld_cv, coefw_cld_cv)         !!jygprl
+                     ftd, fqd, qta, qtc, sigt, detrain, tau_cld_cv, coefw_cld_cv)         !!jygprl
 !
 !         Test conseravtion de l'eau
@@ -1204,5 +1211,5 @@
                            iflag, icb, inb, &
                            precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
-                           ft, fq, fu, fv, ftra, &
+                           ft, fq, fqcomp, fu, fv, ftra, &
                            sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
                            qcondc, wd, cape, cin, &
@@ -1214,8 +1221,8 @@
                            qta, clw, elij, evap, ep, epmlmMm, eplaMm, &  ! RomP
                            wdtrainA, wdtrainS, wdtrainM, &                         ! RomP
-                           qtc, sigt, epmax_diag, & ! epmax_cape
+                           qtc, sigt, detrain, epmax_diag, & ! epmax_cape
                            iflag1, kbas1, ktop1, &
                            precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
-                           ft1, fq1, fu1, fv1, ftra1, &
+                           ft1, fq1, fqcomp1, fu1, fv1, ftra1, &
                            sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
                            qcondc1, wd1, cape1, cin1, &
@@ -1227,5 +1234,5 @@
                            qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
                            wdtrainA1, wdtrainS1, wdtrainM1,                  & ! RomP
-                           qtc1, sigt1, epmax_diag1) ! epmax_cape
+                           qtc1, sigt1, detrain1, epmax_diag1) ! epmax_cape
 !   
       IF (prt_level >= 10) THEN
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/1DUTILS.h
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/1DUTILS.h	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/1DUTILS.h	(revision 4727)
@@ -266,5 +266,5 @@
 !Config  Def  = 0.
 !Config  Help = 
-       tsurf = 0.
+       time_ini = 0.
        CALL getin('time_ini',time_ini)
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/1D_decl_cases.h
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/1D_decl_cases.h	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/1D_decl_cases.h	(revision 4727)
@@ -1,3 +1,3 @@
-#include "netcdf.inc"
+        INCLUDE "netcdf.inc"
 
 ! Declarations specifiques au cas Toga
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/1D_read_forc_cases.h
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/1D_read_forc_cases.h	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/1D_read_forc_cases.h	(revision 4727)
@@ -73,9 +73,17 @@
 
 ! initial and boundary conditions :
+      ! initial pressure
       psurf = ps_prof_cas
-      if (tskin_prof_cas .NE. 0.) THEN
+
+      !initial surface temperature
+      if (tskin_prof_cas .NE. 0.) then
+      ! we take the first value of the prescribed ts
           tsurf=tskin_prof_cas
+      else if (ts_prof_cas .NE. 0) then
+      ! if an initial ts value is present, we take it
+          tsurf=ts_prof_cas
       endif
 
+      ! ts forcing during the run (if any)
       tg = ts_prof_cas
       if ((tg .eq. 0.) .and. (tskin_prof_cas .NE. 0.)) THEN
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/1Dconv.h
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/1Dconv.h	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/1Dconv.h	(revision 4727)
@@ -13,5 +13,5 @@
 !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 
-#include "YOMCST.h"
+      INCLUDE "YOMCST.h"
 
       INTEGER klev
@@ -461,6 +461,6 @@
       implicit none
 
-#include "dimensions.h"
-!cccc#include "dimphy.h"
+      INCLUDE "dimensions.h"
+!cccc      INCLUDE "dimphy.h"
 
       integer k
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/mod_1D_amma_read.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/mod_1D_amma_read.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/mod_1D_amma_read.F90	(revision 4727)
@@ -59,5 +59,5 @@
       implicit none
 
-#include "netcdf.inc"
+      INCLUDE "netcdf.inc"
 
       INTEGER nid,rid,ierr
@@ -180,5 +180,5 @@
 !program reading forcings of the AMMA case study
       implicit none
-#include "netcdf.inc"
+      INCLUDE "netcdf.inc"
 
       integer ntime,nlevel
@@ -407,5 +407,5 @@
 !---------------------------------------------------------------------------------------
 
-#include "compar1d.h"
+        INCLUDE "compar1d.h"
 
 ! inputs:
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/mod_1D_cases_read.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/mod_1D_cases_read.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/mod_1D_cases_read.F90	(revision 4727)
@@ -90,5 +90,5 @@
       implicit none
 
-#include "netcdf.inc"
+      INCLUDE "netcdf.inc"
 
       INTEGER nid,rid,ierr
@@ -267,5 +267,5 @@
 !program reading forcing of the case study
       implicit none
-#include "netcdf.inc"
+      INCLUDE "netcdf.inc"
 
       integer ntime,nlevel
@@ -994,6 +994,6 @@
 !---------------------------------------------------------------------------------------
 
-#include "compar1d.h"
-#include "date_cas.h"
+        INCLUDE "compar1d.h"
+        INCLUDE "date_cas.h"
 
 ! inputs:
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/mod_1D_cases_read2.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/mod_1D_cases_read2.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/mod_1D_cases_read2.F90	(revision 4727)
@@ -81,5 +81,5 @@
     implicit none
 
-#include "netcdf.inc"
+    INCLUDE "netcdf.inc"
 
     INTEGER nid,rid,ierr
@@ -192,5 +192,5 @@
     implicit none
 
-#include "netcdf.inc"
+    INCLUDE "netcdf.inc"
 
     INTEGER nid,rid,ierr
@@ -240,5 +240,5 @@
     allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))        
     allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
-    allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1))
+    allocate(ap_cas(nlev_cas+1),bp_cas(nlev_cas+1))
     allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas), &
          qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
@@ -320,6 +320,6 @@
     implicit none
 
-#include "netcdf.inc"
-#include "date_cas.h"
+    INCLUDE "netcdf.inc"
+    INCLUDE "date_cas.h"
 
     INTEGER nid,rid,ierr
@@ -393,5 +393,5 @@
     allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))        
     allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
-    allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1))
+    allocate(ap_cas(nlev_cas+1),bp_cas(nlev_cas+1))
     allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas), &
          qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
@@ -543,5 +543,5 @@
   use netcdf, only: nf90_get_var
   implicit none
-#include "netcdf.inc"
+  INCLUDE "netcdf.inc"
 
   integer ntime,nlevel
@@ -660,5 +660,5 @@
   use netcdf, only: nf90_get_var
   implicit none
-#include "netcdf.inc"
+  INCLUDE "netcdf.inc"
 
   integer ntime,nlevel
@@ -831,5 +831,5 @@
   use netcdf, only: nf90_get_var
   implicit none
-#include "netcdf.inc"
+  INCLUDE "netcdf.inc"
 
   integer ntime,nlevel,k,t
@@ -1061,6 +1061,6 @@
   !---------------------------------------------------------------------------------------
 
-#include "compar1d.h"
-#include "date_cas.h"
+  INCLUDE "compar1d.h"
+  INCLUDE "date_cas.h"
 
   ! inputs:
@@ -1135,9 +1135,9 @@
   !       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,5 +1155,5 @@
   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
@@ -1270,6 +1270,6 @@
   !---------------------------------------------------------------------------------------
 
-#include "compar1d.h"
-#include "date_cas.h"
+  INCLUDE "compar1d.h"
+  INCLUDE "date_cas.h"
 
   ! inputs:
@@ -1350,9 +1350,9 @@
   !       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,6 +1370,6 @@
   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,5 +1403,5 @@
      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))
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90	(revision 4727)
@@ -90,6 +90,6 @@
     implicit none
 
-#include "netcdf.inc"
-#include "date_cas.h"
+    INCLUDE "netcdf.inc"
+    INCLUDE "date_cas.h"
 
     INTEGER nid,rid,ierr
@@ -163,5 +163,5 @@
     allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))        
     allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
-    allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1))
+    allocate(ap_cas(nlev_cas+1),bp_cas(nlev_cas+1))
     allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas), &
          qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
@@ -331,6 +331,6 @@
     use netcdf, only: nf90_get_var
     implicit none
-#include "netcdf.inc"
-#include "compar1d.h"
+    INCLUDE "netcdf.inc"
+    INCLUDE "compar1d.h"
 
     integer ntime,nlevel,k,t
@@ -671,6 +671,6 @@
     !---------------------------------------------------------------------------------------
 
-#include "compar1d.h"
-#include "date_cas.h"
+    INCLUDE "compar1d.h"
+    INCLUDE "date_cas.h"
 
     ! inputs:
@@ -934,6 +934,6 @@
     implicit none
 
-#include "YOMCST.h"
-#include "dimensions.h"
+    INCLUDE "YOMCST.h"
+    INCLUDE "dimensions.h"
 
     !-------------------------------------------------------------------------
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h	(revision 4727)
@@ -150,5 +150,5 @@
       implicit none
 
-#include "netcdf.inc"
+      INCLUDE "netcdf.inc"
 
       integer ntime,nlevel
@@ -495,5 +495,5 @@
 
          implicit none
-#include "netcdf.inc"
+         INCLUDE "netcdf.inc"
          integer nid,ttm,llm
          real*8 time(ttm)
@@ -545,5 +545,5 @@
        implicit none
 
-#include "dimensions.h"
+      INCLUDE "dimensions.h"
 
 !-------------------------------------------------------------------------
@@ -659,5 +659,5 @@
        implicit none
 
-#include "dimensions.h"
+      INCLUDE "dimensions.h"
 
 !-------------------------------------------------------------------------
@@ -781,5 +781,5 @@
 ! Read RICO forcing data 
 !-------------------------------------------------------------------------
-#include "dimensions.h"
+      INCLUDE "dimensions.h"
 
 
@@ -1057,5 +1057,5 @@
        implicit none
  
-#include "dimensions.h"
+      INCLUDE "dimensions.h"
 
 !-------------------------------------------------------------------------
@@ -1179,5 +1179,5 @@
        implicit none
  
-#include "dimensions.h"
+       INCLUDE "dimensions.h"
 
 !-------------------------------------------------------------------------
@@ -1338,5 +1338,5 @@
        implicit none
  
-#include "dimensions.h"
+       INCLUDE "dimensions.h"
 
 !-------------------------------------------------------------------------
@@ -1561,5 +1561,5 @@
 !---------------------------------------------------------------------------------------
 
-#include "compar1d.h"
+        INCLUDE "compar1d.h"
 
 ! inputs:
@@ -1703,5 +1703,5 @@
 !---------------------------------------------------------------------------------------
 
-#include "compar1d.h"
+        INCLUDE "compar1d.h"
 
 ! inputs:
@@ -1816,5 +1816,5 @@
 !---------------------------------------------------------------------------------------
 
-#include "compar1d.h"
+        INCLUDE "compar1d.h"
 
 ! inputs:
@@ -2173,5 +2173,5 @@
       implicit none
 
-#include "netcdf.inc"
+      INCLUDE "netcdf.inc"
 
       integer ntime,nlevel
@@ -2385,6 +2385,6 @@
       implicit none
 
-#include "netcdf.inc"
-#include "YOMCST.h"
+      INCLUDE "netcdf.inc"
+      INCLUDE "YOMCST.h"
 
       integer ntime,nlevel
@@ -2719,5 +2719,5 @@
       implicit none
 
-#include "netcdf.inc"
+      INCLUDE "netcdf.inc"
 
       integer ntime,nlevel,nsol
@@ -2960,5 +2960,5 @@
       
       parameter (ncm_1=49180)
-#include "YOMCST.h"
+      INCLUDE "YOMCST.h"
 
       real albsfc(ncm_1), albsfc_w(ncm_1)
@@ -3064,5 +3064,5 @@
       SUBROUTINE read_rtmip(nlev_rtmip,play,plev,t,h2o,o3)
       
-#include "YOMCST.h"
+      INCLUDE "YOMCST.h"
 
       real t(nlev_rtmip), pt(nlev_rtmip),pb(nlev_rtmip),h2o(nlev_rtmip), o3(nlev_rtmip)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/old_1D_decl_cases.h
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/old_1D_decl_cases.h	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/old_1D_decl_cases.h	(revision 4727)
@@ -1,3 +1,3 @@
-#include "netcdf.inc"
+         INCLUDE "netcdf.inc"
 
 ! Declarations specifiques au cas Toga
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/old_lmdz1d.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/old_lmdz1d.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/old_lmdz1d.F90	(revision 4727)
@@ -13,5 +13,5 @@
        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, &
@@ -47,18 +47,18 @@
 
       implicit none
-#include "dimensions.h"
-#include "YOMCST.h"
-!!#include "control.h"
-#include "clesphys.h"
-#include "dimsoil.h"
-!#include "indicesol.h"
-
-#include "compar1d.h"
-#include "flux_arp.h"
-#include "date_cas.h"
-#include "tsoilnudge.h"
-#include "fcg_gcssold.h"
-!!!#include "fbforcing.h"
-#include "compbl.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "YOMCST.h"
+!!      INCLUDE "control.h"
+      INCLUDE "clesphys.h"
+      INCLUDE "dimsoil.h"
+!      INCLUDE "indicesol.h"
+
+      INCLUDE "compar1d.h"
+      INCLUDE "flux_arp.h"
+      INCLUDE "date_cas.h"
+      INCLUDE "tsoilnudge.h"
+      INCLUDE "fcg_gcssold.h"
+!!!      INCLUDE "fbforcing.h"
+      INCLUDE "compbl.h"
 
 !=====================================================================
@@ -163,5 +163,5 @@
 !=====================================================================
 !
-#include "old_1D_decl_cases.h"
+      INCLUDE "old_1D_decl_cases.h"
 !
 !---------------------------------------------------------------------
@@ -721,5 +721,5 @@
 !=====================================================================
 
-#include "old_1D_read_forc_cases.h"
+      INCLUDE "old_1D_read_forc_cases.h"
 
       if (forcing_GCM2SCM) then
@@ -920,4 +920,5 @@
         u_ancien(1,:)=u(:)
         v_ancien(1,:)=v(:)
+        rneb_ancien(1,:)=0.
 
         u10m=0.
@@ -945,4 +946,7 @@
 !------------------------------------------------------------------------
 !Al1 =============== restart option ==========================
+        iflag_physiq=0
+        call getin('iflag_physiq',iflag_physiq)
+
         if (.not.restart) then
           iflag_pbl = 5
@@ -1065,5 +1069,5 @@
 !---------------------------------------------------------------------
 
-#include "old_1D_interp_cases.h"
+      INCLUDE "old_1D_interp_cases.h"
 
       if (forcing_GCM2SCM) then
@@ -1248,12 +1252,10 @@
 !! 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
 ! au dessus de 700hpa, on relaxe vers les profils initiaux
       if (forcing_sandu .OR. forcing_astex) then
-#include "1D_nudge_sandu_astex.h"
+      INCLUDE "1D_nudge_sandu_astex.h"
       else
         u(1:mxcalc)=u(1:mxcalc) + timestep*(                                &
@@ -1360,3 +1362,3 @@
         END SUBROUTINE old_lmdz1d
 
-#include "old_1DUTILS_read_interp.h"
+        INCLUDE "old_1DUTILS_read_interp.h"
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/replay1d.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/replay1d.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/replay1d.F90	(revision 4727)
@@ -11,5 +11,5 @@
 
       implicit none
-#include "dimensions.h"
+      INCLUDE "dimensions.h"
 
 real :: airefi
@@ -75,5 +75,5 @@
 ! Initialisation de la parametrisation
 !---------------------------------------------------------------------
-call get_ini_module
+call call_ini_replay
 
 !---------------------------------------------------------------------
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/scm.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/scm.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/scm.F90	(revision 4727)
@@ -9,5 +9,5 @@
        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, &
@@ -43,17 +43,17 @@
 
       implicit none
-#include "dimensions.h"
-#include "YOMCST.h"
-!!#include "control.h"
-#include "clesphys.h"
-#include "dimsoil.h"
-!#include "indicesol.h"
-
-#include "compar1d.h"
-#include "flux_arp.h"
-#include "date_cas.h"
-#include "tsoilnudge.h"
-#include "fcg_gcssold.h"
-#include "compbl.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "YOMCST.h"
+!!      INCLUDE "control.h"
+      INCLUDE "clesphys.h"
+      INCLUDE "dimsoil.h"
+!      INCLUDE "indicesol.h"
+
+      INCLUDE "compar1d.h"
+      INCLUDE "flux_arp.h"
+      INCLUDE "date_cas.h"
+      INCLUDE "tsoilnudge.h"
+      INCLUDE "fcg_gcssold.h"
+      INCLUDE "compbl.h"
 
 !=====================================================================
@@ -129,5 +129,5 @@
 !=====================================================================
 !
-#include "1D_decl_cases.h"
+      INCLUDE "1D_decl_cases.h"
 !
 !---------------------------------------------------------------------
@@ -489,5 +489,5 @@
 !=====================================================================
 
-#include "1D_read_forc_cases.h"
+      INCLUDE "1D_read_forc_cases.h"
    print*,'A d_t_adv ',d_t_adv(1:20)*86400
 
@@ -678,4 +678,5 @@
         u_ancien(1,:)=u(:)
         v_ancien(1,:)=v(:)
+        rneb_ancien(1,:)=0.
  
         u10m=0.
@@ -703,4 +704,7 @@
 !------------------------------------------------------------------------
 !Al1 =============== restart option ======================================
+        iflag_physiq=0
+        call getin('iflag_physiq',iflag_physiq)
+
         if (.not.restart) then
           iflag_pbl = 5
@@ -803,5 +807,5 @@
 !---------------------------------------------------------------------
 
-#include "1D_interp_cases.h"
+      INCLUDE "1D_interp_cases.h"
 
 !---------------------------------------------------------------------
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation_scheme.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation_scheme.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation_scheme.F90	(revision 4727)
@@ -83,7 +83,12 @@
 USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
 USE RADIATION_SETUP
-! Commentes : jour, date de la simulation 
 USE YOMCST   , ONLY : RSIGMA ! Stefan-Boltzmann constant
-USE radiation_config, ONLY : config_type,ISolverSpartacus
+USE RADIATION_SETUP, ONLY : SETUP_RADIATION_SCHEME, &
+                         &  config_type, driver_config_type, &
+                         &  NWEIGHT_UV,  IBAND_UV,  WEIGHT_UV, &
+                         &  NWEIGHT_PAR, IBAND_PAR, WEIGHT_PAR, &
+                         &  ITYPE_TROP_BG_AER,  TROP_BG_AER_MASS_EXT, &
+                         &  ITYPE_STRAT_BG_AER, STRAT_BG_AER_MASS_EXT, &
+                         &  ISolverSpartacus
 
 ! Modules from radiation library
@@ -297,5 +302,5 @@
 !AI juillet 2023 : verif des param de config :
 if (lprint_config) then
- IF (is_master) THEN       
+! IF (is_master) THEN       
    print*,'Parametres de configuration de ecrad, etape ',itap_ecrad     
    print*,'Entree dans radiation_scheme'
@@ -377,5 +382,5 @@
 
            itap_ecrad=itap_ecrad+1
-   ENDIF          
+!   ENDIF          
 endif           
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation_setup.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation_setup.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/radiation_setup.F90	(revision 4727)
@@ -15,4 +15,7 @@
 
   USE PARKIND1,         ONLY : JPRB
+
+  USE radiation_interface,      ONLY : setup_radiation
+  USE setup_config_from_lmdz,   ONLY : driver_config_type
 
   IMPLICIT NONE
@@ -48,9 +51,9 @@
   SUBROUTINE SETUP_RADIATION_SCHEME(LOUTPUT,file_name,rad_config,driver_config)
 
-    USE radiation_config, ONLY : config_type, &
-        &                       ISolverMcICA, ISolverSpartacus, &
-        &                       ILiquidModelSlingo, ILiquidModelSOCRATES, &
-        &                       IIceModelFu, IIceModelBaran, &
-        &                       IOverlapExponentialRandom
+!    USE radiation_config, ONLY : config_type, &
+!        &                       ISolverMcICA, ISolverSpartacus, &
+!        &                       ILiquidModelSlingo, ILiquidModelSOCRATES, &
+!        &                       IIceModelFu, IIceModelBaran, &
+!        &                       IOverlapExponentialRandom
     USE mod_phys_lmdz_para
       
@@ -59,6 +62,6 @@
     USE YOESRTWN, ONLY : NMPSRTM
 
-    USE radiation_interface,      ONLY : setup_radiation
-    USE setup_config_from_lmdz,   ONLY : driver_config_type
+ !   USE radiation_interface,      ONLY : setup_radiation
+ !   USE setup_config_from_lmdz,   ONLY : driver_config_type
 
     ! Whether or not to provide information on the radiation scheme
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecumev6_flux.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecumev6_flux.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecumev6_flux.F90	(revision 4727)
@@ -0,0 +1,777 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
+!SFX_LIC for details. version 1.
+!     #########
+    SUBROUTINE ECUMEV6_FLUX(PZ0SEA,PTA,PSST,PQA,PQSAT,PVMOD, &
+                            PZREF,PSSS,PUREF,PPS,PPA,OPRECIP,OPWEBB,        &
+                            PSFTH,PSFTQ,PUSTAR,PCD,PCDN,PCH,PCE,        &
+                            PRI,PRESA,PRAIN,PZ0HSEA,OPERTFLUX,coeffs   )
+!###############################################################################
+!!
+!!****  *ECUMEV6_FLUX*
+!!
+!!    PURPOSE
+!!    -------
+!       Calculate the surface turbulent fluxes of heat, moisture, and momentum 
+!       over sea surface + corrections due to rainfall & Webb effect.
+!!
+!!**  METHOD
+!!    ------
+!       The estimation of the transfer coefficients relies on the iterative 
+!       computation of the scaling parameters U*/Teta*/q*. The convergence is
+!       supposed to be reached in NITERFL iterations maximum.
+!       Neutral transfer coefficients for momentum/temperature/humidity
+!       are computed as a function of the 10m-height neutral wind speed using
+!       the ECUME_V6 formulation based on the multi-campaign (POMME,FETCH,CATCH,
+!       SEMAPHORE,EQUALANT) ALBATROS dataset.
+!!
+!!    EXTERNAL
+!!    --------
+!!
+!!    IMPLICIT ARGUMENTS
+!!    ------------------
+!!
+!!    REFERENCE
+!!    ---------
+!!      Fairall et al (1996), JGR, 3747-3764
+!!      Gosnell et al (1995), JGR, 437-442
+!!      Fairall et al (1996), JGR, 1295-1308
+!!
+!!    AUTHOR
+!!    ------
+!!      C. Lebeaupin  *Météo-France* (adapted from S. Belamari's code)
+!!
+!!    MODIFICATIONS
+!!    -------------
+!!      Original     15/03/2005
+!!      Modified        01/2006  C. Lebeaupin (adapted from  A. Pirani's code)
+!!      Modified        08/2009  B. Decharme: limitation of Ri
+!!      Modified        09/2012  B. Decharme: CD correction
+!!      Modified        09/2012  B. Decharme: limitation of Ri in surface_ri.F90
+!!      Modified        10/2012  P. Le Moigne: extra inputs for FLake use
+!!      Modified        06/2013  B. Decharme: bug in z0 (output) computation 
+!!      Modified        12/2013  S. Belamari: ZRF computation updated:
+!!                                1. ZP00/PPA in ZDWAT, ZLVA in ZDQSDT/ZBULB/ZRF
+!!                                2. ZDWAT/ZDTMP in ZBULB/ZRF (Gosnell et al 95)
+!!                                3. cool skin correction included
+!!      Modified        01/2014  S. Belamari: salinity impact on latent heat of
+!!                                vaporization of seawater included
+!!      Modified        01/2014  S. Belamari: new formulation for pure water
+!!                                specific heat (ZCPWA)
+!!      Modified        01/2014  S. Belamari: 4 choices for PZ0SEA computation
+!!      Modified        12/2015  S. Belamari: ECUME now provides parameterisations
+!!                                for:  U10n*sqrt(CDN)          instead of CDN
+!!                                      U10n*CHN/sqrt(CDN)         "       CHN
+!!                                      U10n*CEN/sqrt(CDN)         "       CEN
+!!      Modified        01/2016  S. Belamari: New ECUME formulation
+!!
+!!      To be done:
+!!      include gustiness computation following Mondon & Redelsperger (1998)
+!!!
+!-------------------------------------------------------------------------------
+!!
+!!    MODIFICATIONS RELATED TO SST CORRECTION COMPUTATION
+!!    ---------------------------------------------------
+!!      Modified        09/2013  S. Belamari: use 0.98 for the ocean emissivity
+!!                                following up to date satellite measurements in
+!!                                the 8-14 μm range (obtained values range from
+!!                                0.98 to 0.99).
+!!!
+!-------------------------------------------------------------------------------
+!
+!       0.   DECLARATIONS
+!            ------------
+!
+USE dimphy
+USE indice_sol_mod
+USE MODD_CSTS,             ONLY : XPI, XDAY, XKARMAN, XG, XP00, XSTEFAN, XRD, XRV,   &
+                                  XCPD, XCPV, XCL, XTT, XLVTT
+
+
+!USE MODD_SURF_PAR,         ONLY : XUNDEF
+!USE MODD_SURF_ATM,         ONLY : XVCHRNK, XVZ0CM
+!USE MODD_REPROD_OPER,      ONLY : CCHARNOCK
+!
+!USE MODE_THERMOS
+!USE MODI_WIND_THRESHOLD
+!USE MODI_SURFACE_RI
+!
+!USE YOMHOOK,   ONLY : LHOOK,   DR_HOOK
+!USE PARKIND1,  ONLY : JPRB
+!
+!USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+!       0.1. Declarations of arguments
+!
+REAL, DIMENSION(klon), INTENT(IN)    :: PVMOD      ! module of wind at atm level (m/s)
+REAL, DIMENSION(klon), INTENT(IN)    :: PTA        ! air temperature at atm level (K)
+REAL, DIMENSION(klon), INTENT(IN)    :: PQA        ! air spec. hum. at atm level (kg/kg)
+REAL, DIMENSION(klon), INTENT(IN)    :: PQSAT      ! sea surface spec. hum. (kg/kg)
+REAL, DIMENSION(klon), INTENT(IN)    :: PPA        ! air pressure at atm level (Pa)
+!REAL, DIMENSION(:), INTENT(IN)    :: PRHOA      ! air density at atm level (kg/m3)
+!REAL, DIMENSION(:), INTENT(IN)    :: PEXNA      ! Exner function at atm level
+REAL, DIMENSION(klon), INTENT(IN)    :: PUREF      ! atm level for wind (m)
+REAL, DIMENSION(klon), INTENT(IN)    :: PZREF      ! atm level for temp./hum. (m)
+REAL, DIMENSION(klon), INTENT(IN)    :: PSSS       ! Sea Surface Salinity (g/kg)
+REAL, DIMENSION(klon), INTENT(IN)    :: PPS        ! air pressure at sea surface (Pa)
+!REAL, DIMENSION(:), INTENT(IN)    :: PEXNS      ! Exner function at sea surface
+!REAL, DIMENSION(:), INTENT(IN)    :: PPERTFLUX  ! stochastic flux perturbation pattern
+! for correction
+!REAL,               INTENT(IN)    :: PICHCE    !
+LOGICAL,            INTENT(IN)    :: OPRECIP   !
+LOGICAL,            INTENT(IN)    :: OPWEBB    !
+LOGICAL,            INTENT(IN)    :: OPERTFLUX
+REAL, DIMENSION(klon), INTENT(IN)    :: PRAIN     ! precipitation rate (kg/s/m2)
+!
+!INTEGER,            INTENT(IN)    :: KZ0
+!
+REAL, DIMENSION(klon), INTENT(INOUT) :: PSST       ! Sea Surface Temperature (K)
+REAL, DIMENSION(klon), INTENT(INOUT) :: PZ0SEA     ! roughness length over sea
+REAL, DIMENSION(klon), INTENT(OUT)   :: PZ0HSEA    ! heat roughness length over sea
+
+! surface fluxes : latent heat, sensible heat, friction fluxes
+REAL, DIMENSION(klon), INTENT(OUT)   :: PUSTAR     ! friction velocity (m/s)
+REAL, DIMENSION(klon), INTENT(OUT)   :: PSFTH      ! heat flux (W/m2)
+REAL, DIMENSION(klon), INTENT(OUT)   :: PSFTQ      ! water flux (kg/m2/s)
+
+! diagnostics
+REAL, DIMENSION(klon), INTENT(OUT)   :: PCD        ! transfer coef. for momentum
+REAL, DIMENSION(klon), INTENT(OUT)   :: PCH        ! transfer coef. for temperature
+REAL, DIMENSION(klon), INTENT(OUT)   :: PCE        ! transfer coef. for humidity
+REAL, DIMENSION(klon), INTENT(OUT)   :: PCDN       ! neutral coef. for momentum
+REAL, DIMENSION(klon), INTENT(OUT)   :: PRI        ! Richardson number
+REAL, DIMENSION(klon), INTENT(OUT)   :: PRESA      ! aerodynamical resistance
+real, dimension(3), intent(out)   :: coeffs
+
+!       0.2. Declarations of local variables
+!
+! specif SB
+INTEGER, DIMENSION(SIZE(PTA))     :: JCV        ! convergence index
+INTEGER, DIMENSION(SIZE(PTA))     :: JITER      ! nb of iterations to converge
+!rajout
+REAL, DIMENSION(SIZE(PTA))        :: PEXNA      ! Exner function at atm level
+REAL, DIMENSION(SIZE(PTA))       :: PEXNS      ! Exner function at atm level
+!
+REAL, DIMENSION(SIZE(PTA))        :: ZTAU       ! momentum flux (N/m2)
+REAL, DIMENSION(SIZE(PTA))        :: ZHF        ! sensible heat flux (W/m2)
+REAL, DIMENSION(SIZE(PTA))        :: ZEF        ! latent heat flux (W/m2)
+REAL, DIMENSION(SIZE(PTA))        :: ZTAUR      ! momentum flx due to rain (N/m2)
+REAL, DIMENSION(SIZE(PTA))        :: ZRF        ! sensible flx due to rain (W/m2)
+REAL, DIMENSION(SIZE(PTA))        :: ZEFWEBB    ! Webb corr. on latent flx (W/m2)
+
+REAL, DIMENSION(SIZE(PTA))        :: ZVMOD      ! wind intensity at atm level (m/s)
+REAL, DIMENSION(SIZE(PTA))        :: ZQSATA     ! sat.spec.hum. at atm level (kg/kg)
+REAL, DIMENSION(SIZE(PTA))        :: ZLVA       ! vap.heat of pure water at atm level (J/kg)
+REAL, DIMENSION(SIZE(PTA))        :: ZLVS       ! vap.heat of seawater at sea surface (J/kg)
+REAL, DIMENSION(SIZE(PTA))        :: ZCPA       ! specif.heat moist air (J/kg/K)
+REAL, DIMENSION(SIZE(PTA))        :: ZVISA      ! kinemat.visc. of dry air (m2/s)
+REAL, DIMENSION(SIZE(PTA))        :: ZDU        ! U   vert.grad. (real atm)
+REAL, DIMENSION(SIZE(PTA))        :: ZDT,ZDQ    ! T,Q vert.grad. (real atm)
+REAL, DIMENSION(SIZE(PTA))        :: ZDDU       ! U   vert.grad. (real atm + gust)
+REAL, DIMENSION(SIZE(PTA))        :: ZDDT,ZDDQ  ! T,Q vert.grad. (real atm + WL/CS)
+REAL, DIMENSION(SIZE(PTA))        :: ZUSR       ! velocity scaling param. (m/s)
+                                                ! =friction velocity
+REAL, DIMENSION(SIZE(PTA))        :: ZTSR       ! temperature scaling param. (K)
+REAL, DIMENSION(SIZE(PTA))        :: ZQSR       ! humidity scaling param. (kg/kg)
+REAL, DIMENSION(SIZE(PTA))        :: ZDELTAU10N,ZDELTAT10N,ZDELTAQ10N
+                                                ! U,T,Q vert.grad. (10m, neutral atm)
+REAL, DIMENSION(SIZE(PTA))        :: ZUSR0,ZTSR0,ZQSR0    ! ITERATIVE PROCESS
+REAL, DIMENSION(SIZE(PTA))        :: ZDUSTO,ZDTSTO,ZDQSTO ! ITERATIVE PROCESS
+REAL, DIMENSION(SIZE(PTA))        :: ZPSIU,ZPSIT! PSI funct for U, T/Q (Z0 comp)
+REAL, DIMENSION(SIZE(PTA))        :: ZCHARN     ! Charnock parameter   (Z0 comp)
+
+REAL, DIMENSION(SIZE(PTA))        :: ZUSTAR2    ! square of friction velocity
+REAL, DIMENSION(SIZE(PTA))        :: ZAC        ! aerodynamical conductance
+REAL, DIMENSION(SIZE(PTA))        :: ZDIRCOSZW  ! orography slope cosine
+                                                ! (=1 on water!)
+REAL, DIMENSION(SIZE(PTA))        :: ZPARUN,ZPARTN,ZPARQN ! neutral parameter for U,T,Q
+
+!-- rajout pour la pression saturante
+REAL, DIMENSION(SIZE(PPA))        :: ZFOES                                 ! [OPWEBB]
+REAL, DIMENSION(SIZE(PPA))        :: ZWORK1
+REAL, DIMENSION(SIZE(PPA))        :: ZWORK2  
+REAL, DIMENSION(SIZE(PPS))        :: ZWORK1A
+REAL, DIMENSION(SIZE(PPS))        :: ZWORK2A
+!#####################
+
+REAL, DIMENSION(0:5)              :: ZCOEFU,ZCOEFT,ZCOEFQ
+
+!--------- Modif Olive -----------------
+REAL, DIMENSION(SIZE(PTA))        :: PRHOA
+REAL, PARAMETER                   :: XUNDEF = 1.E+20
+
+
+REAL       :: XVCHRNK = 0.021
+REAL       :: XVZ0CM = 1.0E-5 
+!REAL       :: XRIMAX
+
+CHARACTER  :: CCHARNOCK = 'NEW'
+
+
+!--------------------------------------
+
+
+! local constants
+LOGICAL :: OPCVFLX              ! to force convergence
+INTEGER :: NITERMAX             ! nb of iterations to get free convergence
+INTEGER :: NITERSUP             ! nb of additional iterations if OPCVFLX=.TRUE.
+INTEGER :: NITERFL              ! maximum number of iterations
+REAL    :: ZETV,ZRDSRV          ! thermodynamic constants
+REAL    :: ZSQR3
+REAL    :: ZLMOMIN,ZLMOMAX      ! min/max value of Obukhovs stability param. z/l
+REAL    :: ZBTA,ZGMA            ! parameters of the stability functions
+REAL    :: ZDUSR0,ZDTSR0,ZDQSR0 ! maximum gap for USR/TSR/QSR between 2 steps
+REAL    :: ZP00                 ! [OPRECIP] - water vap. diffusiv.ref.press.(Pa)
+REAL    :: ZUTU,ZUTT,ZUTQ       ! U10n threshold in ECUME parameterisation
+REAL    :: ZCDIRU,ZCDIRT,ZCDIRQ ! coef directeur pour fonction affine U,T,Q
+REAL    :: ZORDOU,ZORDOT,ZORDOQ ! ordonnee a l'origine pour fonction affine U,T,Q
+
+INTEGER :: JJ                                   ! for ITERATIVE PROCESS
+INTEGER :: JLON,JK
+REAL    :: ZLMOU,ZLMOT                          ! Obukhovs param. z/l for U, T/Q
+REAL    :: ZPSI_U,ZPSI_T                        ! PSI funct. for U, T/Q
+REAL    :: Z0TSEA,Z0QSEA                        ! roughness length for T, Q
+REAL    :: ZCHIC,ZCHIK,ZPSIC,ZPSIK,ZLOGUS10,ZLOGTS10
+REAL    :: ZTAC,ZCPWA,ZDQSDT,ZDWAT,ZDTMP,ZBULB  ! [OPRECIP]
+REAL    :: ZWW                                  ! [OPWEBB]
+
+
+INTEGER :: PREF             ! reference pressure for exner function
+REAL, DIMENSION(klon)    :: PQSATA      ! sea surface spec. hum. (kg/kg)
+
+REAL    :: qsat_seawater2,qsat_seawater
+
+INCLUDE "YOMCST.h"
+INCLUDE "clesphys.h"
+
+!REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!----------------------- Modif Olive calcul de PRHOA ---------------------------
+
+!write(*,*) "PZ0SEA ",PZ0SEA
+!write(*,*) "PTA ",PTA
+!write(*,*) "PSST ",PSST
+!write(*,*) "PQA ",PQA
+!write(*,*) "PVMOD ",PVMOD
+!write(*,*) "PZREF ",PZREF
+!write(*,*) "PUREF ",PUREF
+!write(*,*) "PPS ",PPS
+!write(*,*) "PPA ",PPA
+!write(*,*) "OPRECIP ",OPRECIP
+!write(*,*) "PZ0HSEA ",PZ0HSEA
+!write(*,*) "PRAIN ",PRAIN
+
+
+PRHOA(:) = PPS(:) / (287.1 * PTA(:) * (1.+.61*PQA(:)))
+!write(*,*) "klon klon ",klon,PTA
+!write(*,*) "PRHOA ",SIZE(PRHOA),PRHOA
+
+PREF = 100900.                    ! = 1000 hPa
+
+!PEXNA = (PPA/PPS)**RKAPPA
+!PEXNS = (PPS/PPS)**RKAPPA
+
+PEXNA = (PPA/PREF)**(RD/RCPD)
+PEXNS = (PPS/PREF)**(RD/RCPD)
+
+!IF (LHOOK) CALL DR_HOOK('ECUMEV6_FLUX',0,ZHOOK_HANDLE)
+!
+ZDUSR0   = 1.E-06
+ZDTSR0   = 1.E-06
+ZDQSR0   = 1.E-09
+!
+NITERMAX = 5
+NITERSUP = 5
+OPCVFLX  = .TRUE.
+!
+NITERFL = NITERMAX
+IF (OPCVFLX) NITERFL = NITERMAX+NITERSUP
+!
+ZCOEFU = (/ 1.00E-03, 3.66E-02, -1.92E-03, 2.32E-04, -7.02E-06,  6.40E-08 /)
+ZCOEFT = (/ 5.36E-03, 2.90E-02, -1.24E-03, 4.50E-04, -2.06E-05,       0.0 /)
+ZCOEFQ = (/ 1.00E-03, 3.59E-02, -2.87E-04,      0.0,       0.0,       0.0 /)
+!
+ZUTU = 40.0
+ZUTT = 14.4
+ZUTQ = 10.0
+!
+ZCDIRU = ZCOEFU(1) + 2.0*ZCOEFU(2)*ZUTU + 3.0*ZCOEFU(3)*ZUTU**2   &
+                   + 4.0*ZCOEFU(4)*ZUTU**3 + 5.0*ZCOEFU(5)*ZUTU**4
+ZCDIRT = ZCOEFT(1) + 2.0*ZCOEFT(2)*ZUTT + 3.0*ZCOEFT(3)*ZUTT**2   &
+                   + 4.0*ZCOEFT(4)*ZUTT**3
+ZCDIRQ = ZCOEFQ(1) + 2.0*ZCOEFQ(2)*ZUTQ
+!
+ZORDOU = ZCOEFU(0) + ZCOEFU(1)*ZUTU + ZCOEFU(2)*ZUTU**2 + ZCOEFU(3)*ZUTU**3   &
+                   + ZCOEFU(4)*ZUTU**4 + ZCOEFU(5)*ZUTU**5
+ZORDOT = ZCOEFT(0) + ZCOEFT(1)*ZUTT + ZCOEFT(2)*ZUTT**2 + ZCOEFT(3)*ZUTT**3   &
+                   + ZCOEFT(4)*ZUTT**4
+ZORDOQ = ZCOEFQ(0) + ZCOEFQ(1)*ZUTQ + ZCOEFQ(2)*ZUTQ**2
+!
+!-------------------------------------------------------------------------------
+!
+!       1.   AUXILIARY CONSTANTS & ARRAY INITIALISATION BY UNDEFINED VALUES.
+!       --------------------------------------------------------------------
+!
+ZDIRCOSZW(:) = 1.0
+!
+ZETV    = XRV/XRD-1.0   !~0.61 (cf Liu et al. 1979)
+ZRDSRV  = XRD/XRV       !~0.622
+ZSQR3   = SQRT(3.0)
+ZLMOMIN = -200.0
+ZLMOMAX = 0.25
+ZBTA    = 16.0
+ZGMA    = 7.0           !initially =4.7, modified to 7.0 following G. Caniaux
+!
+ZP00    = 1013.25E+02
+!
+PCD  = XUNDEF
+PCH  = XUNDEF
+PCE  = XUNDEF
+PCDN = XUNDEF
+ZUSR = XUNDEF
+ZTSR = XUNDEF
+ZQSR = XUNDEF
+ZTAU = XUNDEF
+ZHF  = XUNDEF
+ZEF  = XUNDEF
+!
+PSFTH  = XUNDEF
+PSFTQ  = XUNDEF
+PUSTAR = XUNDEF
+PRESA  = XUNDEF
+PRI    = XUNDEF
+!
+ZTAUR   = 0.0
+ZRF     = 0.0
+ZEFWEBB = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+!       2.   INITIALISATIONS BEFORE ITERATIVE LOOP.
+!       -------------------------------------------
+!
+!ZVMOD(:) = WIND_THRESHOLD(PVMOD(:),PUREF(:))    !set a minimum value to wind
+ZVMOD = MAX(PVMOD , 0.1 * MIN(10.,PUREF) )    !set a minimum value to wind
+
+write(*,*) "ZVMOD ",SIZE(ZVMOD)
+
+!
+!       2.0. Radiative fluxes - For warm layer & cool skin
+!
+!       2.0b. Warm Layer correction
+!
+!       2.1. Specific humidity at saturation
+!
+WHERE(PSSS(:)>0.0.AND.PSSS(:)/=XUNDEF)
+  PQSATA = QSAT_SEAWATER2 (PSST(:),PPS(:),PSSS(:))    !at sea surface
+ELSEWHERE
+  PQSATA (:) = QSAT_SEAWATER (PSST(:),PPS(:))            !at sea surface
+ENDWHERE
+
+!ZQSATA(:) = QSAT(PTA(:),PPA(:))                         !at atm level
+
+!### OLIVIER POUR PRESSION SATURANTE #####
+!-------------------------------------------------------------------------------
+!
+ZFOES  = 1 !PSAT(PT(:))
+ZFOES  = 0.98*ZFOES
+!
+ZWORK1    = ZFOES/PPS
+ZWORK2    = XRD/XRV
+
+ZWORK1A    = ZFOES/PPA
+ZWORK2A    = XRD/XRV
+
+!write(*,*) "ZFOES ",ZFOES
+!write(*,*) "PPS ",PPS
+!write(*,*) "ZWORK1 ",ZWORK1
+!write(*,*) "XRD ",XRD
+!write(*,*) "XRV ",XRV
+!write(*,*) "PPA ",PPA
+!write(*,*) "ZWORK1A ",ZWORK1A
+
+write(*,*) "PQSAT : ",PQSAT
+write(*,*) "PQSATA : ",PQSATA
+
+
+!
+!*       2.    COMPUTE SATURATION HUMIDITY
+!              ---------------------------
+!
+!PQSAT  = ZWORK2*ZWORK1 / (1.+(ZWORK2-1.)*ZWORK1)
+!ZQSATA = ZWORK2A*ZWORK1A / (1.+(ZWORK2A-1.)*ZWORK1A)
+ZQSATA = QSAT_SEAWATER (PTA(:),PPA(:))            !at sea surface
+
+
+!
+!       2.2. Gradients at the air-sea interface
+!
+ZDU(:) = ZVMOD(:)               !one assumes u is measured / sea surface current
+ZDT(:) = PTA(:)/PEXNA(:)-PSST(:)/PEXNS(:)
+ZDQ(:) = PQA(:)-PQSATA(:)
+
+write(*,*) "PQA ",PQA(:)
+write(*,*) "PQSAT",PQSAT(:)
+write(*,*) "ZDQ",ZDQ(:)
+!
+!       2.3. Latent heat of vaporisation
+!
+ZLVA(:) = XLVTT+(XCPV-XCL)*(PTA (:)-XTT)                !of pure water at atm level
+ZLVS(:) = XLVTT+(XCPV-XCL)*(PSST(:)-XTT)                !of pure water at sea surface
+
+
+
+write(*,*) "ZLVA ",ZLVA
+write(*,*) "ZLVS ",ZLVS
+
+
+WHERE(PSSS(:)>0.0.AND.PSSS(:)/=XUNDEF)
+  ZLVS(:) = ZLVS(:)*(1.0-1.00472E-3*PSSS(:))            !of seawater at sea surface
+ENDWHERE
+!
+!       2.4. Specific heat of moist air (Businger 1982)
+!
+!ZCPA(:) = XCPD*(1.0+(XCPV/XCPD-1.0)*PQA(:))
+ZCPA(:) = XCPD
+!
+!       2.4b Kinematic viscosity of dry air (Andreas 1989, CRREL Rep. 89-11)
+!
+ZVISA(:) = 1.326E-05*(1.0+6.542E-03*(PTA(:)-XTT)+8.301E-06*(PTA(:)-XTT)**2   &
+           -4.84E-09*(PTA(:)-XTT)**3)
+!
+!       2.4c Coefficients for warm layer and/or cool skin correction
+!
+!       2.5. Initial guess
+!
+ZDDU(:) = ZDU(:)
+ZDDT(:) = ZDT(:)
+ZDDQ(:) = ZDQ(:)
+ZDDU(:) = SIGN(MAX(ABS(ZDDU(:)),10.0*ZDUSR0),ZDDU(:))
+ZDDT(:) = SIGN(MAX(ABS(ZDDT(:)),10.0*ZDTSR0),ZDDT(:))
+ZDDQ(:) = SIGN(MAX(ABS(ZDDQ(:)),10.0*ZDQSR0),ZDDQ(:))
+
+write(*,*) "ZDDU ",ZDDU
+write(*,*) "ZDDQ ",ZDDQ
+write(*,*) "ZDDT ",ZDDT
+
+!
+JCV (:) = -1
+ZUSR(:) = 0.04*ZDDU(:)
+ZTSR(:) = 0.04*ZDDT(:)
+ZQSR(:) = 0.04*ZDDQ(:)
+ZDELTAU10N(:) = ZDDU(:)
+ZDELTAT10N(:) = ZDDT(:)
+ZDELTAQ10N(:) = ZDDQ(:)
+JITER(:) = 99
+!
+! In the following, we suppose that Richardson number PRI < XRIMAX
+! If not true, Monin-Obukhov theory can't (and therefore shouldn't) be applied !
+!-------------------------------------------------------------------------------
+!
+!       3.   ITERATIVE LOOP TO COMPUTE U*, T*, Q*.
+!       ------------------------------------------
+!
+DO JJ=1,NITERFL
+  DO JLON=1,SIZE(PTA)
+!
+  IF (JCV(JLON) == -1) THEN
+    ZUSR0(JLON)=ZUSR(JLON)
+    ZTSR0(JLON)=ZTSR(JLON)
+    ZQSR0(JLON)=ZQSR(JLON)
+    IF (JJ == NITERMAX+1 .OR. JJ == NITERMAX+NITERSUP) THEN
+      ZDELTAU10N(JLON) = 0.5*(ZDUSTO(JLON)+ZDELTAU10N(JLON))    !forced convergence
+      ZDELTAT10N(JLON) = 0.5*(ZDTSTO(JLON)+ZDELTAT10N(JLON))
+      ZDELTAQ10N(JLON) = 0.5*(ZDQSTO(JLON)+ZDELTAQ10N(JLON))
+      IF (JJ == NITERMAX+NITERSUP) JCV(JLON)=3
+    ENDIF
+    ZDUSTO(JLON) = ZDELTAU10N(JLON)
+    ZDTSTO(JLON) = ZDELTAT10N(JLON)
+    ZDQSTO(JLON) = ZDELTAQ10N(JLON)
+!
+!       3.1. Neutral parameter for wind speed (ECUME_V6 formulation)
+!
+    IF (ZDELTAU10N(JLON) <= ZUTU) THEN
+      ZPARUN(JLON) = ZCOEFU(0) + ZCOEFU(1)*ZDELTAU10N(JLON)      &
+                               + ZCOEFU(2)*ZDELTAU10N(JLON)**2   &
+                               + ZCOEFU(3)*ZDELTAU10N(JLON)**3   &
+                               + ZCOEFU(4)*ZDELTAU10N(JLON)**4   &
+                               + ZCOEFU(5)*ZDELTAU10N(JLON)**5
+    ELSE
+      ZPARUN(JLON) = ZCDIRU*(ZDELTAU10N(JLON)-ZUTU) + ZORDOU
+    ENDIF
+    PCDN(JLON) = (ZPARUN(JLON)/ZDELTAU10N(JLON))**2
+!
+!       3.2. Neutral parameter for temperature (ECUME_V6 formulation)
+!
+    IF (ZDELTAU10N(JLON) <= ZUTT) THEN
+      ZPARTN(JLON) = ZCOEFT(0) + ZCOEFT(1)*ZDELTAU10N(JLON)      &
+                               + ZCOEFT(2)*ZDELTAU10N(JLON)**2   &
+                               + ZCOEFT(3)*ZDELTAU10N(JLON)**3   &
+                               + ZCOEFT(4)*ZDELTAU10N(JLON)**4
+    ELSE
+      ZPARTN(JLON) = ZCDIRT*(ZDELTAU10N(JLON)-ZUTT) + ZORDOT
+    ENDIF
+!
+!       3.3. Neutral parameter for humidity (ECUME_V6 formulation)
+!
+    IF (ZDELTAU10N(JLON) <= ZUTQ) THEN
+      ZPARQN(JLON) = ZCOEFQ(0) + ZCOEFQ(1)*ZDELTAU10N(JLON)      &
+                               + ZCOEFQ(2)*ZDELTAU10N(JLON)**2
+    ELSE
+      ZPARQN(JLON) = ZCDIRQ*(ZDELTAU10N(JLON)-ZUTQ) + ZORDOQ
+    ENDIF
+!
+!       3.4. Scaling parameters U*, T*, Q*
+!
+    ZUSR(JLON) = ZPARUN(JLON)
+    ZTSR(JLON) = ZPARTN(JLON)*ZDELTAT10N(JLON)/ZDELTAU10N(JLON)
+    ZQSR(JLON) = ZPARQN(JLON)*ZDELTAQ10N(JLON)/ZDELTAU10N(JLON)
+!
+!       3.4b Gustiness factor (Deardorff 1970)
+!
+!       3.4c Cool skin correction
+!
+!       3.5. Obukhovs stability param. z/l following Liu et al. (JAS, 1979)
+!
+! For U
+    ZLMOU = PUREF(JLON)*XG*XKARMAN*(ZTSR(JLON)/PTA(JLON)   &
+            +ZETV*ZQSR(JLON)/(1.0+ZETV*PQA(JLON)))/ZUSR(JLON)**2
+! For T/Q
+    ZLMOT = ZLMOU*(PZREF(JLON)/PUREF(JLON))
+    ZLMOU = MAX(MIN(ZLMOU,ZLMOMAX),ZLMOMIN)
+    ZLMOT = MAX(MIN(ZLMOT,ZLMOMAX),ZLMOMIN)
+!
+!       3.6. Stability function psi (see Liu et al, 1979 ; Dyer and Hicks, 1970)
+!            Modified to include convective form following Fairall (unpublished)
+!
+! For U
+    IF (ZLMOU == 0.0) THEN
+      ZPSI_U = 0.0
+    ELSEIF (ZLMOU > 0.0) THEN
+      ZPSI_U = -ZGMA*ZLMOU
+    ELSE
+      ZCHIK  = (1.0-ZBTA*ZLMOU)**0.25
+      ZPSIK  = 2.0*LOG((1.0+ZCHIK)/2.0)  &
+                +LOG((1.0+ZCHIK**2)/2.0) &
+                -2.0*ATAN(ZCHIK)+0.5*XPI
+      ZCHIC  = (1.0-12.87*ZLMOU)**(1.0/3.0)       !for very unstable conditions
+      ZPSIC  = 1.5*LOG((ZCHIC**2+ZCHIC+1.0)/3.0)   &
+                -ZSQR3*ATAN((2.0*ZCHIC+1.0)/ZSQR3) &
+                +XPI/ZSQR3
+      ZPSI_U = ZPSIC+(ZPSIK-ZPSIC)/(1.0+ZLMOU**2) !match Kansas & free-conv. forms
+    ENDIF
+    ZPSIU(JLON) = ZPSI_U
+! For T/Q
+    IF (ZLMOT == 0.0) THEN
+      ZPSI_T = 0.0
+    ELSEIF (ZLMOT > 0.0) THEN
+      ZPSI_T = -ZGMA*ZLMOT
+    ELSE
+      ZCHIK  = (1.0-ZBTA*ZLMOT)**0.25
+      ZPSIK  = 2.0*LOG((1.0+ZCHIK**2)/2.0)
+      ZCHIC  = (1.0-12.87*ZLMOT)**(1.0/3.0)       !for very unstable conditions
+      ZPSIC  = 1.5*LOG((ZCHIC**2+ZCHIC+1.0)/3.0)   &
+                -ZSQR3*ATAN((2.0*ZCHIC+1.0)/ZSQR3) &
+                +XPI/ZSQR3
+      ZPSI_T = ZPSIC+(ZPSIK-ZPSIC)/(1.0+ZLMOT**2) !match Kansas & free-conv. forms
+    ENDIF
+    ZPSIT(JLON) = ZPSI_T
+!
+!       3.7. Update air-sea gradients
+!
+    ZDDU(JLON) = ZDU(JLON)
+    ZDDT(JLON) = ZDT(JLON)
+    ZDDQ(JLON) = ZDQ(JLON)
+    ZDDU(JLON) = SIGN(MAX(ABS(ZDDU(JLON)),10.0*ZDUSR0),ZDDU(JLON))
+    ZDDT(JLON) = SIGN(MAX(ABS(ZDDT(JLON)),10.0*ZDTSR0),ZDDT(JLON))
+    ZDDQ(JLON) = SIGN(MAX(ABS(ZDDQ(JLON)),10.0*ZDQSR0),ZDDQ(JLON))
+    ZLOGUS10   = LOG(PUREF(JLON)/10.0)
+    ZLOGTS10   = LOG(PZREF(JLON)/10.0)
+    ZDELTAU10N(JLON) = ZDDU(JLON)-ZUSR(JLON)*(ZLOGUS10-ZPSI_U)/XKARMAN
+    ZDELTAT10N(JLON) = ZDDT(JLON)-ZTSR(JLON)*(ZLOGTS10-ZPSI_T)/XKARMAN
+    ZDELTAQ10N(JLON) = ZDDQ(JLON)-ZQSR(JLON)*(ZLOGTS10-ZPSI_T)/XKARMAN
+    ZDELTAU10N(JLON) = SIGN(MAX(ABS(ZDELTAU10N(JLON)),10.0*ZDUSR0),   &
+                            ZDELTAU10N(JLON))
+    ZDELTAT10N(JLON) = SIGN(MAX(ABS(ZDELTAT10N(JLON)),10.0*ZDTSR0),   &
+                            ZDELTAT10N(JLON))
+    ZDELTAQ10N(JLON) = SIGN(MAX(ABS(ZDELTAQ10N(JLON)),10.0*ZDQSR0),   &
+                            ZDELTAQ10N(JLON))
+!
+!       3.8. Test convergence for U*, T*, Q*
+!
+    IF (ABS(ZUSR(JLON)-ZUSR0(JLON)) < ZDUSR0 .AND.   &
+        ABS(ZTSR(JLON)-ZTSR0(JLON)) < ZDTSR0 .AND.   &
+        ABS(ZQSR(JLON)-ZQSR0(JLON)) < ZDQSR0) THEN
+      JCV(JLON) = 1                                     !free convergence
+      IF (JJ >= NITERMAX+1) JCV(JLON) = 2               !leaded convergence
+    ENDIF
+    JITER(JLON) = JJ
+  ENDIF
+!
+  ENDDO
+ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+!       4.   COMPUTATION OF TURBULENT FLUXES AND EXCHANGE COEFFICIENTS.
+!       ---------------------------------------------------------------
+!
+DO JLON=1,SIZE(PTA)
+!
+!       4.1. Surface turbulent fluxes
+!            (ATM CONV.: ZTAU<<0 ; ZHF,ZEF<0 if atm looses heat)
+!
+  ZTAU(JLON) = -PRHOA(JLON)*ZUSR(JLON)**2
+  ZHF(JLON)  = -PRHOA(JLON)*ZCPA(JLON)*ZUSR(JLON)*ZTSR(JLON)
+  ZEF(JLON)  = -PRHOA(JLON)*ZLVS(JLON)*ZUSR(JLON)*ZQSR(JLON)
+
+  write(*,*) "ZTAU = ",ZTAU(JLON)
+  write(*,*) "SENS = ",ZHF(JLON)
+  write(*,*) "LAT = ",ZEF(JLON)
+
+!
+!       4.2. Exchange coefficients PCD, PCH, PCE
+!
+  PCD(JLON) = (ZUSR(JLON)/ZDDU(JLON))**2
+  PCH(JLON) = (ZUSR(JLON)*ZTSR(JLON))/(ZDDU(JLON)*ZDDT(JLON))
+  PCE(JLON) = (ZUSR(JLON)*ZQSR(JLON))/(ZDDU(JLON)*ZDDQ(JLON))
+
+  write(*,*) "ZUSR = ",ZUSR(JLON)
+  write(*,*) "ZTSR = ",ZTSR(JLON)
+  write(*,*) "ZQSR = ",ZQSR(JLON)
+
+!
+!       4.3. Stochastic perturbation of turbulent fluxes
+!
+!  IF( OPERTFLUX )THEN
+!    ZTAU(JLON) = ZTAU(JLON)* ( 1. + PPERTFLUX(JLON) / 2. )
+!    ZHF (JLON) = ZHF(JLON)*  ( 1. + PPERTFLUX(JLON) / 2. )
+!    ZEF (JLON) = ZEF(JLON)*  ( 1. + PPERTFLUX(JLON) / 2. )
+!  ENDIF
+!
+ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+!       5.   COMPUTATION OF FLUX CORRECTIONS DUE TO RAINFALL.
+!            (ATM conv: ZRF<0 if atm. looses heat, ZTAUR<<0)
+!       -----------------------------------------------------
+!
+IF (OPRECIP) THEN
+  DO JLON=1,SIZE(PTA)
+!
+!       5.1. Momentum flux due to rainfall (ZTAUR, N/m2)
+!
+! See pp3752 in FBR96.
+    ZTAUR(JLON) = -0.85*PRAIN(JLON)*PVMOD(JLON)
+!
+!       5.2. Sensible heat flux due to rainfall (ZRF, W/m2)
+!
+! See Eq.12 in GoF95 with ZCPWA as specific heat of water at atm level (J/kg/K),
+! ZDQSDT from Clausius-Clapeyron relation, ZDWAT as water vapor diffusivity 
+! (Eq.13-3 of Pruppacher and Klett, 1978), ZDTMP as heat diffusivity, and ZBULB
+! as wet-bulb factor (Eq.11 in GoF95).
+!
+    ZTAC   = PTA(JLON)-XTT
+    ZCPWA  = 4217.51 -3.65566*ZTAC +0.1381*ZTAC**2       &
+              -2.8309E-03*ZTAC**3 +3.42061E-05*ZTAC**4   &
+              -2.18107E-07*ZTAC**5 +5.74535E-10*ZTAC**6
+    ZDQSDT = (ZLVA(JLON)*ZQSATA(JLON))/(XRV*PTA(JLON)**2)
+    ZDWAT  = 2.11E-05*(ZP00/PPA(JLON))*(PTA(JLON)/XTT)**1.94
+    ZDTMP  = (1.0+3.309E-03*ZTAC-1.44E-06*ZTAC**2)   &
+              *0.02411/(PRHOA(JLON)*ZCPA(JLON))
+    ZBULB  = 1.0/(1.0+ZDQSDT*(ZLVA(JLON)*ZDWAT)/(ZCPA(JLON)*ZDTMP))
+    ZRF(JLON) = PRAIN(JLON)*ZCPWA*ZBULB*((PSST(JLON)-PTA(JLON))   &
+                +(PQSATA(JLON)-PQA(JLON))*(ZLVA(JLON)*ZDWAT)/(ZCPA(JLON)*ZDTMP))
+!
+  ENDDO
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!       6.   COMPUTATION OF WEBB CORRECTION TO LATENT HEAT FLUX (ZEFWEBB, W/m2).
+!       ------------------------------------------------------------------------
+!
+! See Eq.21 and Eq.22 in FBR96.
+IF (OPWEBB) THEN
+  DO JLON=1,SIZE(PTA)
+    ZWW = (1.0+ZETV)*(ZUSR(JLON)*ZQSR(JLON))   &
+           +(1.0+(1.0+ZETV)*PQA(JLON))*(ZUSR(JLON)*ZTSR(JLON))/PTA(JLON)
+    ZEFWEBB(JLON) = -PRHOA(JLON)*ZLVS(JLON)*ZWW*PQA(JLON)
+  ENDDO
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!       7.   FINAL STEP : TOTAL SURFACE FLUXES AND DERIVED DIAGNOSTICS. 
+!       ---------------------------------------------------------------
+!
+!       7.1. Richardson number
+!
+! CALL SURFACE_RI(PSST,PQSAT,PEXNS,PEXNA,PTA,PQA,   &
+!                PZREF,PUREF,ZDIRCOSZW,PVMOD,PRI)
+!
+!       7.2. Friction velocity which contains correction due to rain
+!
+ZUSTAR2(:) = -(ZTAU(:)+ZTAUR(:))/PRHOA(:)       !>>0 as ZTAU<<0 & ZTAUR<=0
+!
+IF (OPRECIP) THEN
+  PCD(:) = ZUSTAR2(:)/ZDDU(:)**2
+ENDIF
+!
+PUSTAR(:) = SQRT(ZUSTAR2(:))                    !>>0
+!
+!       7.3. Aerodynamical conductance and resistance
+!
+ZAC  (:) = PCH(:)*ZDDU(:)
+PRESA(:) = 1.0/ZAC(:)
+!
+!       7.4. Total surface fluxes
+!
+PSFTH(:) =  ZHF(:)+ZRF(:)
+PSFTQ(:) = (ZEF(:)+ZEFWEBB(:))/ZLVS(:)
+!
+!       7.5. Charnock number
+!
+IF (CCHARNOCK == 'OLD') THEN
+  ZCHARN(:) = XVCHRNK
+ELSE            !modified for moderate wind speed as in COARE3.0
+  ZCHARN(:) = MIN(0.018,MAX(0.011,0.011+(0.007/8.0)*(ZDDU(:)-10.0)))
+ENDIF
+!
+!       7.6. Roughness lengths Z0 and Z0H over sea
+!
+!IF (KZ0 == 0) THEN      ! ARPEGE formulation
+!  PZ0SEA (:) = (ZCHARN(:)/XG)*ZUSTAR2(:) + XVZ0CM*PCD(:)/PCDN(:)
+!  PZ0HSEA(:) = PZ0SEA (:)
+!ELSEIF (KZ0 == 1) THEN  ! Smith (1988) formulation
+!  PZ0SEA (:) = (ZCHARN(:)/XG)*ZUSTAR2(:) + 0.11*ZVISA(:)/PUSTAR(:)
+!  PZ0HSEA(:) = PZ0SEA (:)
+!ELSEIF (KZ0 == 2) THEN  ! Direct computation using the stability functions
+!  DO JLON=1,SIZE(PTA)
+!    PZ0SEA (JLON) = PUREF(JLON)/EXP(XKARMAN*ZDDU(JLON)/PUSTAR(JLON)+ZPSIU(JLON))
+!    Z0TSEA        = PZREF(JLON)/EXP(XKARMAN*ZDDT(JLON)/ZTSR  (JLON)+ZPSIT(JLON))
+!    Z0QSEA        = PZREF(JLON)/EXP(XKARMAN*ZDDQ(JLON)/ZQSR  (JLON)+ZPSIT(JLON))
+!    PZ0HSEA(JLON) = 0.5*(Z0TSEA+Z0QSEA)
+!  ENDDO
+!ENDIF
+
+write(*,*) "JLON ",JLON
+write(*,*) "PTA ",klon,PTA
+write(*,*) "PCD ",SIZE(PCD),PCD
+write(*,*) "PCQ ",SIZE(PCE),PCE
+write(*,*) "PCH ",SIZE(PCH),PCH
+
+coeffs = [PCD,&
+       PCE,&
+       PCH]
+!
+!
+!IF (LHOOK) CALL DR_HOOK('ECUMEV6_FLUX',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+   END SUBROUTINE ECUMEV6_FLUX
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ener_conserv.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ener_conserv.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ener_conserv.F90	(revision 4727)
@@ -32,8 +32,8 @@
 
 IMPLICIT none
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "clesphys.h"
-#include "compbl.h"
+INCLUDE "YOMCST.h"
+INCLUDE "YOETHF.h"
+INCLUDE "clesphys.h"
+INCLUDE "compbl.h"
 
 ! Arguments
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/evappot.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/evappot.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/evappot.F90	(revision 4727)
@@ -4,7 +4,7 @@
 IMPLICIT NONE
 
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
+INCLUDE "YOMCST.h"
+INCLUDE "YOETHF.h"
+INCLUDE "FCTTRE.h"
 
 
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/fisrtilp.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/fisrtilp.F90	(revision 4726)
+++ 	(revision )
@@ -1,1734 +1,0 @@
-! $Id$
-!
-!
-SUBROUTINE fisrtilp(dtime,paprs,pplay,t,q,ptconv,ratqs, &
-     d_t, d_q, d_ql, d_qi, rneb, radliq, rain, snow,          &
-     pfrac_impa, pfrac_nucl, pfrac_1nucl,               &
-     frac_impa, frac_nucl, beta,                        &
-     prfl, psfl, rhcl, zqta, fraca,                     &
-     ztv, zpspsk, ztla, zthl, iflag_cld_th,             &
-     iflag_ice_thermo)
-
-  !
-  USE dimphy
-  USE icefrac_lsc_mod ! compute ice fraction (JBM 3/14)
-  USE print_control_mod, ONLY: prt_level, lunout
-  USE cloudth_mod 
-  USE ioipsl_getin_p_mod, ONLY : getin_p
-  USE phys_local_var_mod, ONLY: ql_seri,qs_seri
-  USE phys_local_var_mod, ONLY: rneblsvol
-  ! flag to include modifications to ensure energy conservation (if flag >0)
-  USE add_phys_tend_mod, only : fl_cor_ebil 
-  IMPLICIT none
-  !======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS)
-  ! Date: le 20 mars 1995
-  ! Objet: condensation et precipitation stratiforme.
-  !        schema de nuage
-  ! Fusion de fisrt (physique sursaturation, P. LeVan K. Laval)
-  !             et ilp (il pleut, L. Li)
-  ! Principales parties:
-  ! P0> Thermalisation des precipitations venant de la couche du dessus
-  ! P1> Evaporation de la precipitation (qui vient du niveau k+1)
-  ! P2> Formation du nuage (en k) 
-  ! P2.A.0> Calcul des grandeurs nuageuses une pdf en creneau
-  ! P2.A.1> Avec les nouvelles PDFs, calcul des grandeurs nuageuses pour 
-  ! les valeurs de T et Q initiales
-  ! P2.A.2> Prise en compte du couplage entre eau condensee et T.
-  ! P2.A.3> Calcul des valeures finales associees a la formation des nuages
-  ! P2.B> Nuage "tout ou rien"
-  ! P2.C> Prise en compte de la Chaleur latente apres formation nuage
-  ! P3> Formation de la precipitation (en k)
-  !======================================================================
-  ! JLD: 
-  ! * Routine probablement fausse (au moins incoherente) si thermcep = .false.
-  ! * fl_cor_ebil doit etre > 0 ; 
-  !   fl_cor_ebil= 0 pour reproduire anciens bugs
-  !======================================================================
-  include "YOMCST.h"
-  include "fisrtilp.h"
-  include "nuage.h" ! JBM (3/14)
-
-  !
-  ! Principaux inputs:
-  !
-  REAL, INTENT(IN)                              :: dtime  ! intervalle du temps (s)
-  REAL, DIMENSION(klon,klev+1),    INTENT(IN)   :: paprs  ! pression a inter-couche
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: pplay  ! pression au milieu de couche
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: t      ! temperature (K)
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: q      ! humidite specifique (kg/kg)
-  LOGICAL, DIMENSION(klon,klev),   INTENT(IN)   :: ptconv ! points ou le schema de conv. prof. est actif
-  INTEGER,                         INTENT(IN)   :: iflag_cld_th
-  INTEGER,                         INTENT(IN)   :: iflag_ice_thermo
-  !
-  ! Inputs lies aux thermiques
-  ! 
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: ztv
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: zqta, fraca 
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: zpspsk, ztla
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: zthl
-  !
-  !  Input/output
-  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: ratqs  ! determine la largeur de distribution de vapeur
-  !
-  ! Principaux outputs:
-  !
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_t  ! incrementation de la temperature (K)
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_q  ! incrementation de la vapeur d'eau
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_ql ! incrementation de l'eau liquide
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_qi ! incrementation de l'eau glace
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rneb ! fraction nuageuse
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: radliq ! eau liquide utilisee dans rayonnements
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rhcl ! humidite relative en ciel clair
-  REAL, DIMENSION(klon),           INTENT(OUT)  :: rain
-  REAL, DIMENSION(klon),           INTENT(OUT)  :: snow
-  REAL, DIMENSION(klon,klev+1),    INTENT(OUT)  :: prfl
-  REAL, DIMENSION(klon,klev+1),    INTENT(OUT)  :: psfl 
-
-  !AA
-  ! Coeffients de fraction lessivee : pour OFF-LINE
-  !
-  REAL, DIMENSION(klon,klev),      INTENT(INOUT)  :: pfrac_nucl
-  REAL, DIMENSION(klon,klev),      INTENT(INOUT)  :: pfrac_1nucl
-  REAL, DIMENSION(klon,klev),      INTENT(INOUT)  :: pfrac_impa
-  !
-  ! Fraction d'aerosols lessivee par impaction et par nucleation
-  ! POur ON-LINE
-  !
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_impa
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_nucl
-  !AA
-  ! --------------------------------------------------------------------------------
-  !
-  ! Options du programme:
-  !
-  REAL, SAVE :: seuil_neb=0.001 ! un nuage existe vraiment au-dela
-  !$OMP THREADPRIVATE(seuil_neb)
-
-  !<LTP
-  REAL smallestreal
-  REAL, SAVE :: rain_int_min=0.001 !intensité locale minimum pour la pluie avant diminution de la fraction précipitante associée = 0.001 mm/s
-  !>LTP  
-  !$OMP THREADPRIVATE(rain_int_min)
-
-
-  INTEGER ninter ! sous-intervals pour la precipitation
-  PARAMETER (ninter=5)
-  INTEGER,SAVE :: iflag_evap_prec=1 ! evaporation de la pluie
-  !$OMP THREADPRIVATE(iflag_evap_prec)
-  !
-  LOGICAL cpartiel ! condensation partielle
-  PARAMETER (cpartiel=.TRUE.)
-  REAL t_coup
-  PARAMETER (t_coup=234.0)
-  REAL DDT0
-  PARAMETER (DDT0=.01)
-  REAL ztfondue
-  PARAMETER (ztfondue=278.15)
-  ! --------------------------------------------------------------------------------
-  !
-  ! Variables locales:
-  !
-  INTEGER i, k, n, kk
-  INTEGER,save::itap=0
-  !$OMP THREADPRIVATE(itap)
-
-  REAL qsl, qsi
-  real zct      ,zcl
-  INTEGER ncoreczq  
-  REAL ctot(klon,klev)
-  REAL ctot_vol(klon,klev)
-  REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5  
-  REAL zdqsdT_raw(klon)
-  REAL Tbef(klon),qlbef(klon),DT(klon),num,denom
-
-  logical lognormale(klon)
-  logical ice_thermo
-  LOGICAL convergence(klon)
-  INTEGER n_i(klon), iter
-  REAL cste
-
-  real zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
-  real Zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon)
-  real erf   
-  REAL qcloud(klon)
- 
-  REAL zrfl(klon), zrfln(klon), zqev, zqevt
-!<LTP
-  REAL zrflclr(klon), zrflcld(klon)
-  REAL d_zrfl_clr_cld(klon), d_zifl_clr_cld(klon)
-  REAL d_zrfl_cld_clr(klon), d_zifl_cld_clr(klon) 
-!>LTP
-
-  REAL zifl(klon), zifln(klon), zqev0,zqevi, zqevti
-!<LTP
-  REAL ziflclr(klon), ziflcld(klon) 
-!>LTP
-  REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq 
-  REAL zoliqp(klon), zoliqi(klon)
-  REAL zt(klon)
-! JBM (3/14) nexpo is replaced by exposant_glace
-! REAL nexpo ! exponentiel pour glace/eau
-! INTEGER, PARAMETER :: nexpo=6
-  INTEGER exposant_glace_old
-  REAL t_glace_min_old
-  REAL zdz(klon),zrho(klon),ztot      , zrhol(klon)
-  REAL zchau      ,zfroi      ,zfice(klon),zneb(klon),znebprecip(klon)
-!<LTP
-  REAL znebprecipclr(klon), znebprecipcld(klon)
-  REAL tot_zneb(klon), tot_znebn(klon), d_tot_zneb(klon)
-  REAL d_znebprecip_clr_cld(klon), d_znebprecip_cld_clr(klon)
-!>LTP
-
-  REAL zmelt, zpluie, zice
-  REAL dzfice(klon)
-  REAL zsolid
-!!!!
-!  Variables pour Bergeron
-  REAL zcp, coef1, DeltaT, Deltaq, Deltaqprecl
-  REAL zqpreci(klon), zqprecl(klon)
-! Variable pour conservation enegie des precipitations
-  REAL zmqc(klon)
-  !
-  LOGICAL appel1er
-  SAVE appel1er
-  !$OMP THREADPRIVATE(appel1er)
-  !
-! iflag_oldbug_fisrtilp=0 enleve le BUG par JYG : tglace_min -> tglace_max
-! iflag_oldbug_fisrtilp=1 ajoute le BUG
-  INTEGER,SAVE :: iflag_oldbug_fisrtilp=0 !=0 sans bug
-  !$OMP THREADPRIVATE(iflag_oldbug_fisrtilp)
-  !---------------------------------------------------------------
-  !
-  !AA Variables traceurs:
-  !AA  Provisoire !!! Parametres alpha du lessivage
-  !AA  A priori on a 4 scavenging # possibles
-  !
-  REAL a_tr_sca(4)
-  save a_tr_sca
-  !$OMP THREADPRIVATE(a_tr_sca)
-  !
-  ! Variables intermediaires
-  !
-  REAL zalpha_tr
-  REAL zfrac_lessi
-  REAL zprec_cond(klon)
-  !AA
-! RomP >>> 15 nov 2012
-  REAL   beta(klon,klev) ! taux de conversion de l'eau cond
-! RomP <<<
-  REAL zmair(klon), zcpair, zcpeau
-  !     Pour la conversion eau-neige
-  REAL zlh_solid(klon), zm_solid
-  !---------------------------------------------------------------
-  !
-  ! Fonctions en ligne:
-  !
-  REAL fallvs,fallvc ! Vitesse de chute pour cristaux de glace
-                     ! (Heymsfield & Donner, 1990)
-  REAL zzz
-
-  include "YOETHF.h"
-  include "FCTTRE.h"
-  fallvc (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_con
-  fallvs (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_lsc
-  !
-  DATA appel1er /.TRUE./
-  !ym
-!CR: pour iflag_ice_thermo=2, on active que la convection
-!  ice_thermo = iflag_ice_thermo .GE. 1
-
-  
-  itap=itap+1
-  znebprecip(:)=0.
-
-!<LTP
-  smallestreal=1.e-9
-  znebprecipclr(:)=0.
-  znebprecipcld(:)=0.
-!>LTP
-
-  ice_thermo = (iflag_ice_thermo .EQ. 1).OR.(iflag_ice_thermo .GE. 3)
-  zdelq=0.0
-  ctot_vol(1:klon,1:klev)=0.0
-  rneblsvol(1:klon,1:klev)=0.0
-
-  if (prt_level>9)write(lunout,*)'NUAGES4 A. JAM'
-  IF (appel1er) THEN
-     CALL getin_p('iflag_oldbug_fisrtilp',iflag_oldbug_fisrtilp)
-     CALL getin_p('iflag_evap_prec',iflag_evap_prec)
-     CALL getin_p('seuil_neb',seuil_neb)
-!<LTP   
-     CALL getin_p('rain_int_min',rain_int_min)
-!>LTP
-     write(lunout,*)' iflag_oldbug_fisrtilp =',iflag_oldbug_fisrtilp 
-     !
-     WRITE(lunout,*) 'fisrtilp, ninter:', ninter
-     WRITE(lunout,*) 'fisrtilp, iflag_evap_prec:', iflag_evap_prec
-!<LTP   
-     WRITE(lunout,*) 'fisrtilp, rain_int_min:', rain_int_min
-!>LTP   
-     WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel
-     WRITE(lunout,*) 'FISRTILP VERSION LUDO'
-     
-     IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
-        WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
-        WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes'
-        !         CALL abort
-     ENDIF
-     appel1er = .FALSE.
-     !
-     !AA initialiation provisoire
-     a_tr_sca(1) = -0.5
-     a_tr_sca(2) = -0.5
-     a_tr_sca(3) = -0.5
-     a_tr_sca(4) = -0.5
-     !
-     !AA Initialisation a 1 des coefs des fractions lessivees 
-     !
-     !cdir collapse
-     DO k = 1, klev
-        DO i = 1, klon
-           pfrac_nucl(i,k)=1.
-           pfrac_1nucl(i,k)=1.
-           pfrac_impa(i,k)=1.
-           beta(i,k)=0.  !RomP initialisation
-        ENDDO
-     ENDDO
-
-  ENDIF          !  test sur appel1er
-  !
-  !MAf Initialisation a 0 de zoliq
-  !      DO i = 1, klon
-  !         zoliq(i)=0.
-  !      ENDDO 
-  ! Determiner les nuages froids par leur temperature
-  !  nexpo regle la raideur de la transition eau liquide / eau glace.
-  !
-!CR: on est oblige de definir des valeurs fisrt car les valeurs de newmicro ne sont pas les memes par defaut
-  IF (iflag_t_glace.EQ.0) THEN
-!   ztglace = RTT - 15.0
-    t_glace_min_old = RTT - 15.0
-    !AJ<
-    IF (ice_thermo) THEN
-!     nexpo = 2
-      exposant_glace_old = 2
-    ELSE
-!     nexpo = 6
-      exposant_glace_old = 6
-    ENDIF
-    
-  ENDIF
-  
-!!  RLVTT = 2.501e6 ! pas de redefinition des constantes physiques (jyg)
-!!  RLSTT = 2.834e6 ! pas de redefinition des constantes physiques (jyg)
-!>AJ
-  !cc      nexpo = 1
-  !
-  ! Initialiser les sorties:
-  !
-  !cdir collapse
-  DO k = 1, klev+1
-     DO i = 1, klon
-        prfl(i,k) = 0.0
-        psfl(i,k) = 0.0
-     ENDDO
-  ENDDO
-
-  !cdir collapse
-
-  DO k = 1, klev
-     DO i = 1, klon
-        d_t(i,k) = 0.0
-        d_q(i,k) = 0.0
-        d_ql(i,k) = 0.0
-        d_qi(i,k) = 0.0
-        rneb(i,k) = 0.0
-        radliq(i,k) = 0.0
-        frac_nucl(i,k) = 1. 
-        frac_impa(i,k) = 1. 
-     ENDDO
-  ENDDO
-  DO i = 1, klon
-     rain(i) = 0.0
-     snow(i) = 0.0
-     zoliq(i)=0.
-     !     ENDDO
-     !
-     ! Initialiser le flux de precipitation a zero
-     !
-     !     DO i = 1, klon
-     zrfl(i) = 0.0
-     zifl(i) = 0.0
-!<LTP
-     zrflclr(i) = 0.0
-     ziflclr(i) = 0.0
-     zrflcld(i) = 0.0
-     ziflcld(i) = 0.0
-     tot_zneb(i) = 0.0
-     tot_znebn(i) = 0.0
-     d_tot_zneb(i) = 0.0
-!>LTP
-
-     zneb(i) = seuil_neb
-  ENDDO
-  !
-  !
-  !AA Pour plus de securite 
-
-  zalpha_tr   = 0.
-  zfrac_lessi = 0.
-
-  !AA==================================================================
-  !
-  ncoreczq=0
-  ! BOUCLE VERTICALE (DU HAUT VERS LE BAS)
-  !
-  DO k = klev, 1, -1
-     !
-     !AA===============================================================
-     !
-     ! Initialisation temperature et vapeur
-     DO i = 1, klon
-        zt(i)=t(i,k)
-        zq(i)=q(i,k)
-     ENDDO
-     !
-     ! ----------------------------------------------------------------
-     ! P0> Thermalisation des precipitations venant de la couche du dessus
-     ! ----------------------------------------------------------------
-     ! Calculer la varition de temp. de l'air du a la chaleur sensible
-     ! transporter par la pluie. On thermalise la pluie avec l'air de la couche.
-     ! Cette quantite de pluie qui est thermalisee, et devra continue a l'etre lors
-     ! des differentes transformations thermodynamiques. Cette masse d'eau doit
-     ! donc etre ajoute a l'humidite de la couche lorsque l'on calcule la variation
-     ! de l'enthalpie  de la couche avec la temperature
-     ! Variables calculees ou modifiees:
-     !   -  zt: temperature de la cocuhe
-     !   - zmqc: masse de precip qui doit etre thermalisee
-     !
-     IF(k.LE.klevm1) THEN         
-        DO i = 1, klon
-           !IM
-           zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
-           ! il n'y a pas encore d'eau liquide ni glace dans la maiille, donc zq suffit
-           zcpair=RCPD*(1.0+RVTMP2*zq(i))
-           zcpeau=RCPD*RVTMP2
-         if (fl_cor_ebil .GT. 0) then
-           ! zmqc: masse de precip qui doit etre thermalisee avec l'air de la couche atm 
-           ! pour s'assurer que la precip arrivant au sol aura bien la temperature de la 
-           ! derniere couche
-           zmqc(i) = (zrfl(i)+zifl(i))*dtime/zmair(i)
-           ! t(i,k+1)+d_t(i,k+1): nouvelle temp de la couche au dessus
-           zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zmqc(i)*zcpeau + zcpair*zt(i) ) &
-                 / (zcpair + zmqc(i)*zcpeau)
-         else ! si on maintient les anciennes erreurs
-           zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zrfl(i)*dtime*zcpeau &
-                + zmair(i)*zcpair*zt(i) ) &
-                / (zmair(i)*zcpair + zrfl(i)*dtime*zcpeau)
-         end if
-        ENDDO
-     ELSE  ! IF(k.LE.klevm1) 
-        DO i = 1, klon 
-           zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG 
-           zmqc(i) = 0.
-        ENDDO
-     ENDIF ! end IF(k.LE.klevm1)
-     !
-     ! ----------------------------------------------------------------
-     ! P1> Calcul de l'evaporation de la precipitation
-     ! ----------------------------------------------------------------
-     ! On evapore une partie des precipitations venant de la maille du dessus.
-     ! On calcule l'evaporation et la sublimation des precipitations, jusqu'a
-     ! ce que la fraction de cette couche qui est sous le nuage soit saturee.
-     ! Variables calculees ou modifiees:
-     !   - zrfl et zifl: flux de precip liquide et glace
-     !   - zq, zt: humidite et temperature de la cocuhe
-     !   - zmqc: masse de precip qui doit etre thermalisee
-     !
-     IF (iflag_evap_prec>=1) THEN
-        DO i = 1, klon
-!          S'il y a des precipitations
-           IF (zrfl(i)+zifl(i).GT.0.) THEN
-              ! Calcul du qsat
-              IF (thermcep) THEN
-                 zdelta=MAX(0.,SIGN(1.,RTT-zt(i)))
-                 zqs(i)= R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
-                 zqs(i)=MIN(0.5,zqs(i))
-                 zcor=1./(1.-RETV*zqs(i))
-                 zqs(i)=zqs(i)*zcor
-              ELSE
-                 IF (zt(i) .LT. t_coup) THEN
-                    zqs(i) = qsats(zt(i)) / pplay(i,k)
-                 ELSE
-                    zqs(i) = qsatl(zt(i)) / pplay(i,k)
-                 ENDIF
-              ENDIF
-           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
-        ENDDO
-!AJ<
-
-       IF (.NOT. ice_thermo) THEN
-        DO i = 1, klon
-!          S'il y a des precipitations
-           IF (zrfl(i)+zifl(i).GT.0.) THEN
-                ! Evap max pour ne pas saturer la fraction sous le nuage
-                ! Evap max jusqu'à atteindre la saturation dans la partie
-                ! de la maille qui est sous le nuage de la couche du dessus
-                !!! On ne tient compte de cette fraction que sous une seule
-                !!! couche sous le nuage
-                zqev = MAX (0.0, (zqs(i)-zq(i))*zneb(i) )
-             ! Ajout de la prise en compte des precip a thermiser
-             ! avec petite reecriture 
-             if  (fl_cor_ebil .GT. 0) then ! nouveau
-                ! Calcul de l'evaporation du flux de precip herite
-                !   d'au-dessus
-                zqevt = coef_eva * (1.0-zq(i)/zqs(i)) * SQRT(zrfl(i)) &
-                     * zmair(i)/pplay(i,k)*zt(i)*RD
-                zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) * dtime/zmair(i)
-
-                ! Seuil pour ne pas saturer la fraction sous le nuage
-                zqev = MIN (zqev, zqevt)
-                ! Nouveau flux de precip
-                zrfln(i) = zrfl(i) - zqev*zmair(i)/dtime
-                ! Aucun flux liquide pour T < t_coup, on reevapore tout.
-                IF (zt(i) .LT. t_coup.and.reevap_ice) THEN
-                  zrfln(i)=0.
-                  zqev = (zrfl(i)-zrfln(i))/zmair(i)*dtime
-                END IF
-                ! Nouvelle vapeur 
-                zq(i) = zq(i) + zqev
-                zmqc(i) = zmqc(i)-zqev
-                ! Nouvelle temperature (chaleur latente)
-                zt(i) = zt(i) - zqev &
-                     * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
-!!JLD debut de partie a supprimer a terme
-            else ! if  (fl_cor_ebil .GT. 0)
-                ! Calcul de l'evaporation du flux de precip herite
-                !   d'au-dessus
-                zqevt = coef_eva * (1.0-zq(i)/zqs(i)) * SQRT(zrfl(i)) &
-                     * (paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-                zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) &
-                     * RG*dtime/(paprs(i,k)-paprs(i,k+1))
-                ! Seuil pour ne pas saturer la fraction sous le nuage
-                zqev = MIN (zqev, zqevt)
-                ! Nouveau flux de precip
-                zrfln(i) = zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1)) &
-                     /RG/dtime
-                ! Aucun flux liquide pour T < t_coup
-                IF (zt(i) .LT. t_coup.and.reevap_ice) zrfln(i)=0.
-                ! Nouvelle vapeur 
-                zq(i) = zq(i) - (zrfln(i)-zrfl(i)) &
-                     * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-                ! Nouvelle temperature (chaleur latente)
-                zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
-                     * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
-                     * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
-              end if ! if  (fl_cor_ebil .GT. 0)
-!!JLD fin de partie a supprimer a terme
-                zrfl(i) = zrfln(i)
-                zifl(i) = 0.
-           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
-        ENDDO
-!
-       ELSE ! (.NOT. ice_thermo) 
-!      ================================
-!      Avec thermodynamique de la glace
-!      ================================
-        DO i = 1, klon
-
-
-!AJ<
-!        S'il y a des precipitations
-         IF (zrfl(i)+zifl(i).GT.0.) THEN
-
-        !LTP<
-        !On ne tient compte que du flux de précipitation en ciel clair dans le calcul de l'évaporation.
-                IF (iflag_evap_prec==4) THEN
-                        zrfl(i) = zrflclr(i)
-                        zifl(i) = ziflclr(i)
-                ENDIF
-        
-        !>LTP
-
-         IF (iflag_evap_prec==1) THEN
-            znebprecip(i)=zneb(i)
-         ELSE
-            znebprecip(i)=MAX(zneb(i),znebprecip(i))
-         ENDIF
-         
-         IF (iflag_evap_prec==4) THEN
-        ! Evap max pour ne pas saturer toute la maille
-         zqev0 = MAX (0.0, zqs(i)-zq(i))
-         ELSE 
-        ! Evap max pour ne pas saturer la fraction sous le nuage
-         zqev0 = MAX (0.0, (zqs(i)-zq(i))*znebprecip(i) )
-         ENDIF
-
-         !JAM
-         ! On differencie qsat pour l'eau et la glace
-         ! Si zdelta=1. --> glace
-         ! Si zdelta=0. --> eau liquide
-        
-         ! Calcul du qsat par rapport a l'eau liquide
-         qsl= R2ES*FOEEW(zt(i),0.)/pplay(i,k)
-         qsl= MIN(0.5,qsl)
-         zcor= 1./(1.-RETV*qsl)
-         qsl= qsl*zcor
-         
-         ! Calcul de l'evaporation du flux de precip venant du dessus
-         ! Formulation en racine du flux de precip
-         ! (Klemp & Wilhelmson, 1978; Sundqvist, 1988)
-         IF (iflag_evap_prec==3) THEN
-         zqevt = znebprecip(i)*coef_eva*(1.0-zq(i)/qsl) &
-              *SQRT(zrfl(i)/max(1.e-4,znebprecip(i))) &
-              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-!<LTP
-         ELSE IF (iflag_evap_prec==4) THEN
-         zqevt = znebprecipclr(i)*coef_eva*(1.0-zq(i)/qsl) &
-              *SQRT(zrfl(i)/max(1.e-8,znebprecipclr(i))) &
-              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-!>LTP
-        ELSE 
-         zqevt = 1.*coef_eva*(1.0-zq(i)/qsl)*SQRT(zrfl(i)) &
-              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-         ENDIF
-
-
-         zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) &
-              *RG*dtime/(paprs(i,k)-paprs(i,k+1)) 
-         
-         ! Calcul du qsat par rapport a la glace
-         qsi= R2ES*FOEEW(zt(i),1.)/pplay(i,k)
-         qsi= MIN(0.5,qsi)
-         zcor= 1./(1.-RETV*qsi)
-         qsi= qsi*zcor
-
-         ! Calcul de la sublimation du flux de precip solide herite
-         !   d'au-dessus
-         IF (iflag_evap_prec==3) THEN
-         zqevti = znebprecip(i)*coef_eva*(1.0-zq(i)/qsi) &
-              *SQRT(zifl(i)/max(1.e-4,znebprecip(i))) &
-              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-!<LTP
-         ELSE IF (iflag_evap_prec==4) THEN
-         zqevti = znebprecipclr(i)*coef_eva*(1.0-zq(i)/qsi) &
-              *SQRT(zifl(i)/max(1.e-8,znebprecipclr(i))) &
-              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-!>LTP
-         ELSE
-         zqevti = 1.*coef_eva*(1.0-zq(i)/qsi)*SQRT(zifl(i)) &
-              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-         ENDIF
-         zqevti = MAX(0.0,MIN(zqevti,zifl(i))) &
-              *RG*dtime/(paprs(i,k)-paprs(i,k+1))   
-
-       
-        !JAM
-        ! Limitation de l'evaporation. On s'assure qu'on ne sature pas 
-        ! la fraction de la couche sous le nuage sinon on repartit zqev0 
-        ! en conservant la proportion liquide / glace
-     
-         IF (zqevt+zqevti.GT.zqev0) THEN
-            zqev=zqev0*zqevt/(zqevt+zqevti)
-            zqevi=zqev0*zqevti/(zqevt+zqevti)
-         ELSE
-!JLD je ne comprends pas les lignes ci-dessous. On repartit les precips
-!       liquides et solides meme si on ne sature pas la couche. 
-!       A mon avis, le test est inutile, et il faudrait tout remplacer par:
-!            zqev=zqevt
-!            zqevi=zqevti
-             IF (zqevt+zqevti.GT.0.) THEN
-                zqev=MIN(zqev0*zqevt/(zqevt+zqevti),zqevt)
-                zqevi=MIN(zqev0*zqevti/(zqevt+zqevti),zqevti)
-             ELSE
-             zqev=0.
-             zqevi=0.
-             ENDIF
-         ENDIF
-
-         ! Nouveaux flux de precip liquide et solide 
-         zrfln(i) = Max(0.,zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1)) &
-                                 /RG/dtime)
-         zifln(i) = Max(0.,zifl(i) - zqevi*(paprs(i,k)-paprs(i,k+1)) &
-                                 /RG/dtime)
-
-         ! Mise a jour de la vapeur, temperature et flux de precip
-         zq(i) = zq(i) - (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
-                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-       if (fl_cor_ebil .GT. 0) then ! avec correction thermalisation des precips
-         zmqc(i) = zmqc(i) + (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
-                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-         zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
-                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
-                  * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i))) &
-                  + (zifln(i)-zifl(i)) &
-                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
-                  * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
-       else ! sans correction thermalisation des precips
-         zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
-                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
-                  * RLVTT/RCPD/(1.0+RVTMP2*zq(i)) &
-                  + (zifln(i)-zifl(i)) &
-                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
-                  * RLSTT/RCPD/(1.0+RVTMP2*zq(i))
-       end if
-        ! Nouvelles vaeleurs des precips liquides et solides 
-         zrfl(i) = zrfln(i)
-         zifl(i) = zifln(i)
-
-!<LTP
-        IF (iflag_evap_prec==4) THEN
-                zrflclr(i) = zrfl(i)
-                ziflclr(i) = zifl(i)    
-                IF(zrflclr(i) + ziflclr(i) .LE. 0) THEN
-                        znebprecipclr(i) = 0.
-                ENDIF   
-                zrfl(i) = zrflclr(i) + zrflcld(i)
-                zifl(i) = ziflclr(i) + ziflcld(i) 
-        ENDIF
-!>LTP        
-
-
-!        print*,'REEVAP ',itap,k,znebprecip(1),zqev0,zqev,zqevi,zrfl(1)
-
-!CR ATTENTION: deplacement de la fonte de la glace
-!jyg : Bug !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! jyg
-!!!        zmelt = ((zt(i)-273.15)/(ztfondue-273.15))**2  !!!!!!!!! jyg
-!jyg : Bug !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! jyg
-           zmelt = ((zt(i)-273.15)/(ztfondue-273.15))             ! jyg
-           ! fraction de la precip solide qui est fondue
-           zmelt = MIN(MAX(zmelt,0.),1.)
-           ! Fusion de la glace
-!<LTP
-           IF (iflag_evap_prec==4) THEN
-                   zrflclr(i)=zrflclr(i)+zmelt*ziflclr(i)
-                   zrflcld(i)=zrflcld(i)+zmelt*ziflcld(i)
-                   zrfl(i)=zrflclr(i)+zrflcld(i)
-!>LTP        
-           ELSE
-                   zrfl(i)=zrfl(i)+zmelt*zifl(i)
-           ENDIF
-           if (fl_cor_ebil .LE. 0) then
-             ! the following line should not be here. Indeed, if zifl is modified
-             ! now, zifl(i)*zmelt is no more the amount of ice that has melt
-             ! and therefore the change in temperature computed below is wrong
-             zifl(i)=zifl(i)*(1.-zmelt)
-           end if
-           ! Chaleur latente de fusion
-        if (fl_cor_ebil .GT. 0) then ! avec correction thermalisation des precips
-           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
-                      *RLMLT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
-        else ! sans correction thermalisation des precips
-           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
-                      *RLMLT/RCPD/(1.0+RVTMP2*zq(i))
-        end if
-           if (fl_cor_ebil .GT. 0) then ! correction bug, deplacement ligne precedente
-!<LTP
-             IF (iflag_evap_prec==4) THEN
-                   ziflclr(i)=ziflclr(i)*(1.-zmelt)
-                   ziflcld(i)=ziflcld(i)*(1.-zmelt)
-                   zifl(i)=ziflclr(i)+ziflcld(i)
-!>LTP        
-             ELSE
-                   zifl(i)=zifl(i)*(1.-zmelt)
-             ENDIF
-           end if
-
-           ELSE
-              ! Si on n'a plus de pluies, on reinitialise a 0 la farcion
-              ! sous nuageuse utilisee pour la pluie.
-              znebprecip(i)=0.
-           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
-        ENDDO
-
-      ENDIF ! (.NOT. ice_thermo) 
-     
-     ! ----------------------------------------------------------------
-     ! Fin evaporation de la precipitation
-     ! ----------------------------------------------------------------
-     ENDIF ! (iflag_evap_prec>=1)
-     !
-     ! Calculer Qs et L/Cp*dQs/dT:
-     !
-     IF (thermcep) THEN
-        DO i = 1, klon
-           zdelta = MAX(0.,SIGN(1.,RTT-zt(i)))
-           zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-       if  (fl_cor_ebil .GT. 0) then ! nouveau
-           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
-       else    
-           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i))
-       endif
-           zqs(i) = R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
-           zqs(i) = MIN(0.5,zqs(i))
-           zcor = 1./(1.-RETV*zqs(i))
-           zqs(i) = zqs(i)*zcor
-           zdqs(i) = FOEDE(zt(i),zdelta,zcvm5,zqs(i),zcor)
-           zdqsdT_raw(i) = zdqs(i)*  &
-         &         RCPD*(1.0+RVTMP2*zq(i)) / (RLVTT*(1.-zdelta) + RLSTT*zdelta)
-        ENDDO
-     ELSE
-        DO i = 1, klon
-           IF (zt(i).LT.t_coup) THEN
-              zqs(i) = qsats(zt(i))/pplay(i,k)
-              zdqs(i) = dqsats(zt(i),zqs(i))
-           ELSE
-              zqs(i) = qsatl(zt(i))/pplay(i,k)
-              zdqs(i) = dqsatl(zt(i),zqs(i))
-           ENDIF
-        ENDDO
-     ENDIF
-     !
-     ! Determiner la condensation partielle et calculer la quantite
-     ! de l'eau condensee:
-     !
-!verification de la valeur de iflag_fisrtilp_qsat pour iflag_ice_thermo=1
-!       if ((iflag_ice_thermo.eq.1).and.(iflag_fisrtilp_qsat.ne.0)) then
-!         write(*,*) " iflag_ice_thermo==1 requires iflag_fisrtilp_qsat==0", &
-!        " but iflag_fisrtilp_qsat=",iflag_fisrtilp_qsat, ". Might as well stop here."
-!         stop
-!       endif
-
-     ! ----------------------------------------------------------------
-     ! P2> Formation du nuage
-     ! ----------------------------------------------------------------
-     ! Variables calculees:
-     !   rneb  : fraction nuageuse
-     !   zcond : eau condensee moyenne dans la maille.
-     !   rhcl: humidite relative ciel-clair
-     !   zt : temperature de la maille
-     ! ----------------------------------------------------------------
-     !
-     IF (cpartiel) THEN
-        ! -------------------------
-        ! P2.A> Nuage fractionnaire
-        ! -------------------------
-        !
-        !   Calcul de l'eau condensee et de la fraction nuageuse et de l'eau
-        !   nuageuse a partir des PDF de Sandrine Bony.
-        !   rneb  : fraction nuageuse
-        !   zqn   : eau totale dans le nuage
-        !   zcond : eau condensee moyenne dans la maille.
-        !  on prend en compte le réchauffement qui diminue la partie
-        ! condensee
-        !
-        !   Version avec les raqts
-
-        ! ----------------------------------------------------------------
-        ! P2.A.0> Calcul des grandeurs nuageuses une pdf en creneau
-        ! ----------------------------------------------------------------
-        if (iflag_pdf.eq.0) then
-
-           ! version creneau de (Li, 1998)
-           do i=1,klon
-              zdelq = min(ratqs(i,k),0.99) * zq(i)
-              rneb(i,k) = (zq(i)+zdelq-zqs(i)) / (2.0*zdelq)
-              zqn(i) = (zq(i)+zdelq+zqs(i))/2.0
-           enddo
-
-        else !  if (iflag_pdf.eq.0)
-           ! ----------------------------------------------------------------
-           ! P2.A.1> Avec les nouvelles PDFs, calcul des grandeurs nuageuses pour 
-           ! les valeurs de T et Q initiales
-           ! ----------------------------------------------------------------
-           do i=1,klon
-              if(zq(i).lt.1.e-15) then
-                 ncoreczq=ncoreczq+1
-                 zq(i)=1.e-15
-              endif
-           enddo
-
-           if (iflag_cld_th>=5) then
-
-              if (iflag_cloudth_vert<=2) then
-               call cloudth(klon,klev,k,ztv, &
-                   zq,zqta,fraca, &
-                   qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
-                   ratqs,zqs,t)
-              elseif (iflag_cloudth_vert>=3 .and. iflag_cloudth_vert<=5) then
-               call cloudth_v3(klon,klev,k,ztv, &
-                   zq,zqta,fraca, &
-                   qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
-                   ratqs,zqs,t)
-              !----------------------------------
-              !Version these Jean Jouhaud, Decembre 2018 
-              !----------------------------------              
-              elseif (iflag_cloudth_vert==6) then
-               call cloudth_v6(klon,klev,k,ztv, &
-                   zq,zqta,fraca, &
-                   qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
-                   ratqs,zqs,t)
-
-              endif
-              do i=1,klon
-                 rneb(i,k)=ctot(i,k)
-                 rneblsvol(i,k)=ctot_vol(i,k)
-                 zqn(i)=qcloud(i)
-              enddo
-
-           endif
-
-           if (iflag_cld_th <= 4) then
-              lognormale = .true.
-           elseif (iflag_cld_th >= 6) then
-              ! lognormale en l'absence des thermiques
-              lognormale = fraca(:,k) < 1e-10
-           else
-              ! Dans le cas iflag_cld_th=5, on prend systématiquement la
-              ! bi-gaussienne
-              lognormale = .false.
-           end if
-
-!CR: variation de qsat avec T en presence de glace ou non
-!initialisations
-           do i=1,klon
-              DT(i) = 0.
-              n_i(i)=0
-              Tbef(i)=zt(i)
-              qlbef(i)=0.
-           enddo
-
-        ! ----------------------------------------------------------------
-        ! P2.A.2> Prise en compte du couplage entre eau condensee et T.
-        ! Calcul des grandeurs nuageuses en tenant compte de l'effet de
-        ! la condensation sur T, et donc sur qsat et sur les grandeurs nuageuses
-        ! qui en dependent. Ce changement de temperature est provisoire, et
-        ! la valeur definitive sera calcule plus tard.
-        ! Variables calculees: 
-        !   rneb : nebulosite
-        !   zcond: eau condensee en moyenne dans la maille
-        ! note JLD: si on n'a pas de pdf lognormale, ce qui se passe ne me semble
-        ! pas clair, il n'y a probablement pas de prise en compte de l'effet de
-        ! T sur qsat
-        ! ----------------------------------------------------------------
-
-!Boucle iterative: ATTENTION, l'option -1 n'est plus activable ici
-           if (iflag_fisrtilp_qsat.ge.0) then
-             ! Iteration pour condensation avec variation de qsat(T) 
-             ! -----------------------------------------------------
-             do iter=1,iflag_fisrtilp_qsat+1
-                
-               do i=1,klon
-!                 do while ((abs(DT(i)).gt.DDT0).or.(n_i(i).eq.0))
-                 ! !! convergence = .true. tant que l'on n'a pas converge !!
-                 ! ------------------------------
-                 convergence(i)=abs(DT(i)).gt.DDT0
-                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
-                 ! si on n'a pas converge
-                 !
-                 ! P2.A.2.1> Calcul de la fraction nuageuse et de la quantite d'eau condensee
-                 ! ---------------------------------------------------------------
-                 ! Variables calculees: 
-                 ! rneb : nebulosite
-                 ! zqn : eau condensee, dans le nuage (in cloud water content)
-                 ! zcond: eau condensee en moyenne dans la maille
-                 ! rhcl: humidite relative ciel-clair
-                 !
-                 Tbef(i)=Tbef(i)+DT(i) ! nouvelle temperature
-                 if (.not.ice_thermo) then   
-                    zdelta = MAX(0.,SIGN(1.,RTT-Tbef(i)))
-                 else
-                    if (iflag_t_glace.eq.0) then
-                    zdelta = MAX(0.,SIGN(1.,t_glace_min_old-Tbef(i)))
-                    else if (iflag_t_glace.ge.1) then
-                       if (iflag_oldbug_fisrtilp.EQ.0) then
-                          zdelta = MAX(0.,SIGN(1.,t_glace_max-Tbef(i)))
-                       else
-                          !avec bug : zdelta = MAX(0.,SIGN(1.,t_glace_min-Tbef(i)))
-                          zdelta = MAX(0.,SIGN(1.,t_glace_min-Tbef(i)))
-                       endif
-                    endif
-                 endif
-                 ! Calcul de rneb, qzn et zcond pour les PDF lognormales
-                 zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-               if (fl_cor_ebil .GT. 0) then
-                 zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
-               else
-                 zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i))
-               end if
-                 zqs(i) = R2ES*FOEEW(Tbef(i),zdelta)/pplay(i,k)
-                 zqs(i) = MIN(0.5,zqs(i))
-                 zcor = 1./(1.-RETV*zqs(i))
-                 zqs(i) = zqs(i)*zcor
-                 zdqs(i) = FOEDE(Tbef(i),zdelta,zcvm5,zqs(i),zcor)
-                 zpdf_sig(i)=ratqs(i,k)*zq(i)
-                 zpdf_k(i)=-sqrt(log(1.+(zpdf_sig(i)/zq(i))**2))
-                 zpdf_delta(i)=log(zq(i)/zqs(i))
-                 zpdf_a(i)=zpdf_delta(i)/(zpdf_k(i)*sqrt(2.))
-                 zpdf_b(i)=zpdf_k(i)/(2.*sqrt(2.))
-                 zpdf_e1(i)=zpdf_a(i)-zpdf_b(i)
-                 zpdf_e1(i)=sign(min(abs(zpdf_e1(i)),5.),zpdf_e1(i))
-                 zpdf_e1(i)=1.-erf(zpdf_e1(i))
-                 zpdf_e2(i)=zpdf_a(i)+zpdf_b(i)
-                 zpdf_e2(i)=sign(min(abs(zpdf_e2(i)),5.),zpdf_e2(i))
-                 zpdf_e2(i)=1.-erf(zpdf_e2(i))
-             
-                 if (zpdf_e1(i).lt.1.e-10) then
-                    rneb(i,k)=0.
-                    zqn(i)=zqs(i)
-                 else
-                    rneb(i,k)=0.5*zpdf_e1(i)
-                    zqn(i)=zq(i)*zpdf_e2(i)/zpdf_e1(i)
-                 endif
-
-                 ! If vertical heterogeneity, change fraction by volume as well
-                 if (iflag_cloudth_vert>=3) then
-                   ctot_vol(i,k)=rneb(i,k)
-                   rneblsvol(i,k)=ctot_vol(i,k)
-                 endif
-
-                 endif !convergence
-
-               enddo ! boucle en i
-
-                 ! P2.A.2.2> Calcul APPROCHE de la variation de temperature DT 
-                 !         due a la condensation.
-                 ! ---------------------------------------------------------------
-                 ! Variables calculees: 
-                 ! DT : variation de temperature due a la condensation 
-
-                 if (.not. ice_thermo) then
-                 ! --------------------------
-                 do i=1,klon
-                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
-
-                 qlbef(i)=max(0.,zqn(i)-zqs(i))
-               if (fl_cor_ebil .GT. 0) then
-                 num=-Tbef(i)+zt(i)+rneb(i,k)*RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
-               else
-                 num=-Tbef(i)+zt(i)+rneb(i,k)*RLVTT/RCPD/(1.0+RVTMP2*zq(i))*qlbef(i)
-               end if
-                 denom=1.+rneb(i,k)*zdqs(i)
-                 DT(i)=num/denom
-                 n_i(i)=n_i(i)+1
-                 endif
-                 enddo
-
-                 else ! if (.not. ice_thermo)
-                 ! --------------------------
-                 if (iflag_t_glace.ge.1) then
-                 CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
-                 endif
-
-                 do i=1,klon
-                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
-                 
-                 if (iflag_t_glace.eq.0) then
-                    zfice(i) = 1.0 - (Tbef(i)-t_glace_min_old) / (RTT-t_glace_min_old)
-                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
-                    zfice(i) = zfice(i)**exposant_glace_old
-                    dzfice(i)= exposant_glace_old * zfice(i)**(exposant_glace_old-1) &
-          &                     / (t_glace_min_old - RTT)
-                 endif
-                 
-                 if (iflag_t_glace.ge.1.and.zfice(i)>0.) then
-                 dzfice(i)= exposant_glace * zfice(i)**(exposant_glace-1) &
-          &                    / (t_glace_min - t_glace_max)
-                 endif
-               
-                 if ((zfice(i).eq.0).or.(zfice(i).eq.1)) then
-                    dzfice(i)=0.
-                 endif
-
-                 if (zfice(i).lt.1) then
-                    cste=RLVTT
-                 else
-                    cste=RLSTT
-                 endif
-
-                 qlbef(i)=max(0.,zqn(i)-zqs(i))
-               if (fl_cor_ebil .GT. 0) then
-                 num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT &
-           &          +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
-                 denom = 1.+rneb(i,k)*((1-zfice(i))*RLVTT+zfice(i)*RLSTT)/cste*zdqs(i) &
-                         -(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*rneb(i,k)    &
-           &               *qlbef(i)*dzfice(i)
-               else
-                 num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT &
-           &         +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*zq(i))*qlbef(i)
-                 denom = 1.+rneb(i,k)*((1-zfice(i))*RLVTT+zfice(i)*RLSTT)/cste*zdqs(i) &
-                         -(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*zq(i))*rneb(i,k)*qlbef(i)*dzfice(i)
-               end if
-                 DT(i)=num/denom
-                 n_i(i)=n_i(i)+1
-
-                 endif ! fin convergence
-                 enddo ! fin boucle i
-
-                 endif !ice_thermo
-
-             enddo ! iter=1,iflag_fisrtilp_qsat+1
-             ! Fin d'iteration pour condensation avec variation de qsat(T) 
-             ! -----------------------------------------------------------
-           endif !  if (iflag_fisrtilp_qsat.ge.0)
-     ! ----------------------------------------------------------------
-     ! Fin de P2.A.2> la prise en compte du couplage entre eau condensee et T
-     ! ----------------------------------------------------------------
-
-        endif ! iflag_pdf
-
-!        if (iflag_fisrtilp_qsat.eq.-1) then 
-!------------------------------------------
-!CR: ATTENTION option fausse mais a existe:
-! pour la re-activer, prendre iflag_fisrtilp_qsat=0 et
-! activer les lignes suivantes: 
-       IF (1.eq.0) THEN 
-       DO i=1,klon
-           IF (rneb(i,k) .LE. 0.0) THEN
-              zqn(i) = 0.0
-              rneb(i,k) = 0.0
-              zcond(i) = 0.0
-              rhcl(i,k)=zq(i)/zqs(i)
-           ELSE IF (rneb(i,k) .GE. 1.0) THEN
-              zqn(i) = zq(i)
-              rneb(i,k) = 1.0                 
-              zcond(i) = MAX(0.0,zqn(i)-zqs(i))/(1+zdqs(i))
-              rhcl(i,k)=1.0
-           ELSE
-              zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)/(1+zdqs(i))
-              rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
-           ENDIF
-       ENDDO
-       ENDIF
-!------------------------------------------
-
-!        ELSE
-        ! ----------------------------------------------------------------
-        ! P2.A.3> Calcul des valeures finales associees a la formation des nuages
-        ! Variables calculees: 
-        !   rneb : nebulosite
-        !   zcond: eau condensee en moyenne dans la maille
-        !   zq : eau vapeur dans la maille
-        !   zt : temperature de la maille
-        !   rhcl: humidite relative ciel-clair
-        ! ----------------------------------------------------------------
-        !
-        ! Bornage de l'eau in-cloud (zqn) et de la fraction nuageuse (rneb) 
-        ! Calcule de l'eau condensee moyenne dans la maille (zcond),
-        ! et de l'humidite relative ciel-clair (rhcl)
-        DO i=1,klon
-           IF (rneb(i,k) .LE. 0.0) THEN
-              zqn(i) = 0.0
-              rneb(i,k) = 0.0
-              zcond(i) = 0.0
-              rhcl(i,k)=zq(i)/zqs(i)
-           ELSE IF (rneb(i,k) .GE. 1.0) THEN
-              zqn(i) = zq(i)
-              rneb(i,k) = 1.0
-              zcond(i) = MAX(0.0,zqn(i)-zqs(i))
-              rhcl(i,k)=1.0
-           ELSE
-              zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)
-              rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
-           ENDIF
-        ENDDO
-
-       
-        ! If vertical heterogeneity, change fraction by volume as well
-        if (iflag_cloudth_vert>=3) then
-          ctot_vol(1:klon,k)=min(max(ctot_vol(1:klon,k),0.),1.)
-          rneblsvol(1:klon,k)=ctot_vol(1:klon,k)
-        endif
-
-!        ENDIF
-
-     ELSE ! de IF (cpartiel) 
-        ! -------------------------
-        ! P2.B> Nuage "tout ou rien"
-        ! -------------------------
-        ! note JLD: attention, rhcl non calcule. Ca peut avoir des consequences?
-        DO i = 1, klon
-           IF (zq(i).GT.zqs(i)) THEN
-              rneb(i,k) = 1.0
-           ELSE
-              rneb(i,k) = 0.0
-           ENDIF
-           zcond(i) = MAX(0.0,zq(i)-zqs(i))/(1.+zdqs(i))
-        ENDDO
-     ENDIF ! de IF (cpartiel) 
-     !
-     ! Mise a jour vapeur d'eau
-     ! -------------------------
-     DO i = 1, klon
-        zq(i) = zq(i) - zcond(i)
-        !         zt(i) = zt(i) + zcond(i) * RLVTT/RCPD
-     ENDDO
-!AJ<
-     ! ------------------------------------
-     ! P2.C> Prise en compte de la Chaleur latente apres formation nuage
-     ! -------------------------------------
-     ! Variable calcule:
-     !   zt : temperature de la maille
-     !
-     IF (.NOT. ice_thermo) THEN
-        if (iflag_fisrtilp_qsat.lt.1) then
-           DO i = 1, klon
-             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
-           ENDDO
-        else if (iflag_fisrtilp_qsat.gt.0) then
-           DO i= 1, klon
-    if (fl_cor_ebil .GT. 0) then
-             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
-    else
-             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i)))
-    end if
-           ENDDO
-        endif
-     ELSE
-         if (iflag_t_glace.ge.1) then
-            CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
-         endif
-         if (iflag_fisrtilp_qsat.lt.1) then
-           DO i = 1, klon
-! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
-!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
-!                                     t_glace_max, exposant_glace)
-              if (iflag_t_glace.eq.0) then
-                    zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
-                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
-                    zfice(i) = zfice(i)**exposant_glace_old
-              endif
-              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i)) &
-                       +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*zq(i))
-           ENDDO
-         else
-           DO i=1, klon
-! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
-!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
-!                                     t_glace_max, exposant_glace)
-              if (iflag_t_glace.eq.0) then
-                    zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
-                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
-                    zfice(i) = zfice(i)**exposant_glace_old
-              endif
-        if (fl_cor_ebil .GT. 0) then
-              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) & 
-           &             * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i))) &
-                      +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
-        else 
-              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i))) &
-                      +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i)))
-        end if
-           ENDDO
-         endif
-!         print*,zt(i),zrfl(i),zifl(i),'temp1'
-       ENDIF
-!>AJ
-
-     ! ----------------------------------------------------------------
-     ! P3> Formation des precipitations
-     ! ----------------------------------------------------------------
-     !
-     ! Partager l'eau condensee en precipitation et eau liquide nuageuse
-     !
-
-!<LTP
-
-IF (iflag_evap_prec==4) THEN
-        !Partitionnement des precipitations venant du dessus en précipitations nuageuses
-        !et précipitations ciel clair
-
-        !0) Calculate tot_zneb, la fraction nuageuse totale au-dessus du nuage
-        !en supposant un recouvrement maximum aléatoire (voir Jakob and Klein, 2000)
-        
-        DO i=1, klon
-                tot_znebn(i) = 1 - (1-tot_zneb(i))*(1 - max(rneb(i,k),zneb(i))) &
-                        /(1-min(zneb(i),1-smallestreal))
-                d_tot_zneb(i) = tot_znebn(i) - tot_zneb(i)
-                tot_zneb(i) = tot_znebn(i)
-
-
-                !1) Cloudy to clear air
-                d_znebprecip_cld_clr(i) = znebprecipcld(i) - min(rneb(i,k),znebprecipcld(i)) 
-                IF (znebprecipcld(i) .GT. 0) THEN
-                        d_zrfl_cld_clr(i) = d_znebprecip_cld_clr(i)/znebprecipcld(i)*zrflcld(i) 
-                        d_zifl_cld_clr(i) = d_znebprecip_cld_clr(i)/znebprecipcld(i)*ziflcld(i) 
-                ELSE 
-                        d_zrfl_cld_clr(i) = 0. 
-                        d_zifl_cld_clr(i) = 0. 
-                ENDIF
-
-                !2) Clear to cloudy air
-                d_znebprecip_clr_cld(i) = max(0., min(znebprecipclr(i), rneb(i,k) &
-                        - d_tot_zneb(i) - zneb(i)))
-                IF (znebprecipclr(i) .GT. 0) THEN
-                        d_zrfl_clr_cld(i) = d_znebprecip_clr_cld(i)/znebprecipclr(i)*zrflclr(i) 
-                        d_zifl_clr_cld(i) = d_znebprecip_clr_cld(i)/znebprecipclr(i)*ziflclr(i)
-                ELSE
-                        d_zrfl_clr_cld(i) = 0. 
-                        d_zifl_clr_cld(i) = 0. 
-                ENDIF 
-
-                !Update variables
-                znebprecipcld(i) = znebprecipcld(i) + d_znebprecip_clr_cld(i) - d_znebprecip_cld_clr(i)  
-                znebprecipclr(i) = znebprecipclr(i) + d_znebprecip_cld_clr(i) - d_znebprecip_clr_cld(i) 
-                zrflcld(i) = zrflcld(i) + d_zrfl_clr_cld(i) - d_zrfl_cld_clr(i) 
-                ziflcld(i) = ziflcld(i) + d_zifl_clr_cld(i) - d_zifl_cld_clr(i)
-                zrflclr(i) = zrflclr(i) + d_zrfl_cld_clr(i) - d_zrfl_clr_cld(i)
-                ziflclr(i) = ziflclr(i) + d_zifl_cld_clr(i) - d_zifl_clr_cld(i)
-
-        ENDDO
-ENDIF
-
-!>LTP
-
-
-
-     ! Initialisation de zoliq (eau condensee moyenne dans la maille)
-     DO i = 1, klon
-        IF (rneb(i,k).GT.0.0) THEN
-           zoliq(i) = zcond(i)
-           zrho(i) = pplay(i,k) / zt(i) / RD
-           zdz(i) = (paprs(i,k)-paprs(i,k+1)) / (zrho(i)*RG)
-        ENDIF
-     ENDDO
-!AJ<
-     IF (.NOT. ice_thermo) THEN
-       IF (iflag_t_glace.EQ.0) THEN
-         DO i = 1, klon
-            IF (rneb(i,k).GT.0.0) THEN
-               zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (273.13-t_glace_min_old)
-               zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
-               zfice(i) = zfice(i)**exposant_glace_old
-!              zfice(i) = zfice(i)**nexpo
-         !!      zfice(i)=0.
-            ENDIF
-         ENDDO
-       ELSE ! of IF (iflag_t_glace.EQ.0)
-         CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
-!         DO i = 1, klon
-!            IF (rneb(i,k).GT.0.0) THEN
-! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
-!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
-!                                     t_glace_max, exposant_glace)
-!            ENDIF
-!         ENDDO
-       ENDIF
-     ENDIF
-
-     ! Calcul de radliq (eau condensee pour le rayonnement)
-     ! Iteration pour realiser une moyenne de l'eau nuageuse lors de la precip
-     ! Remarque: ce n'est donc pas l'eau restante en fin de precip mais une
-     ! eau moyenne restante dans le nuage sur la duree du pas de temps qui est
-     ! transmise au rayonnement;
-     ! ----------------------------------------------------------------
-     DO i = 1, klon
-        IF (rneb(i,k).GT.0.0) THEN
-           zneb(i) = MAX(rneb(i,k), seuil_neb)
-     !      zt(i) = zt(i)+zcond(i)*zfice(i)*RLMLT/RCPD/(1.0+RVTMP2*zq(i))  
-!           print*,zt(i),'fractionglace'
-!>AJ
-           radliq(i,k) = zoliq(i)/REAL(ninter+1)
-        ENDIF
-     ENDDO
-     !
-     DO n = 1, ninter
-        DO i = 1, klon
-           IF (rneb(i,k).GT.0.0) THEN
-              zrhol(i) = zrho(i) * zoliq(i) / zneb(i)
-              ! Initialization of zpluie and zice:
-              zpluie=0
-              zice=0
-              IF (zneb(i).EQ.seuil_neb) THEN
-                 ztot = 0.0
-              ELSE
-                 !  quantite d'eau a eliminer: zchau (Sundqvist, 1978)
-                 !  meme chose pour la glace: zfroi (Zender & Kiehl, 1997)
-                 if (ptconv(i,k)) then
-                    zcl   =cld_lc_con
-                    zct   =1./cld_tau_con
-                    zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i) &
-                         *fallvc(zrhol(i)) * zfice(i)
-                 else
-                    zcl   =cld_lc_lsc
-                    zct   =1./cld_tau_lsc
-                    zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i) &
-                         *fallvs(zrhol(i)) * zfice(i)
-                 endif
-
-                 ! si l'heterogeneite verticale est active, on utilise 
-                 ! la fraction volumique "vraie" plutot que la fraction
-                 ! surfacique modifiee, qui est plus grande et reduit
-                 ! sinon l'eau in-cloud de facon artificielle
-                 if ((iflag_cloudth_vert>=3).AND.(iflag_rain_incloud_vol==1)) then
-                    zchau    = zct   *dtime/REAL(ninter) * zoliq(i) &
-                         *(1.0-EXP(-(zoliq(i)/ctot_vol(i,k)/zcl   )**2)) *(1.-zfice(i))
-                 else
-                    zchau    = zct   *dtime/REAL(ninter) * zoliq(i) &
-                         *(1.0-EXP(-(zoliq(i)/zneb(i)/zcl   )**2)) *(1.-zfice(i))
-                 endif
-!AJ<
-                 IF (.NOT. ice_thermo) THEN
-                   ztot    = zchau + zfroi
-                 ELSE
-                   zpluie = MIN(MAX(zchau,0.0),zoliq(i)*(1.-zfice(i)))
-                   zice = MIN(MAX(zfroi,0.0),zoliq(i)*zfice(i)) 
-                   ztot    = zpluie    + zice
-                 ENDIF
-!>AJ
-                 ztot    = MAX(ztot   ,0.0)
-              ENDIF
-              ztot    = MIN(ztot,zoliq(i))
-!AJ<
-     !         zoliqp = MAX(zoliq(i)*(1.-zfice(i))-1.*zpluie   , 0.0)
-     !         zoliqi = MAX(zoliq(i)*zfice(i)-1.*zice   , 0.0)
-!JLD : les 2 variables zoliqp et zoliqi crorresponent a des pseudo precip
-!      temporaires et ne doivent pas etre calcule (alors qu'elles le sont
-!      si iflag_bergeron <> 2
-!      A SUPPRIMER A TERME
-              zoliqp(i) = MAX(zoliq(i)*(1.-zfice(i))-1.*zpluie  , 0.0)
-              zoliqi(i) = MAX(zoliq(i)*zfice(i)-1.*zice  , 0.0)
-              zoliq(i) = MAX(zoliq(i)-ztot   , 0.0)
-!>AJ
-              radliq(i,k) = radliq(i,k) + zoliq(i)/REAL(ninter+1)
-           ENDIF
-        ENDDO  ! i = 1,klon
-     ENDDO     ! n = 1,ninter
-
-     ! ----------------------------------------------------------------
-     !
-     IF (.NOT. ice_thermo) THEN
-       DO i = 1, klon
-         IF (rneb(i,k).GT.0.0) THEN
-           d_ql(i,k) = zoliq(i)
-           zrfl(i) = zrfl(i)+ MAX(zcond(i)-zoliq(i),0.0) &
-                * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
-         ENDIF
-       ENDDO
-     ELSE
-!
-!CR&JYG<
-! On prend en compte l'effet Bergeron dans les flux de precipitation :
-! Si T < 0 C, alors les precipitations liquides sont converties en glace, ce qui
-! provoque un accroissement de temperature DeltaT. L'effet de DeltaT sur le condensat
-! et les precipitations est grossierement pris en compte en linearisant les equations 
-! et en approximant le processus de precipitation liquide par un processus a seuil.
-! On fait l'hypothese que le condensat nuageux n'est pas modifié dans cette opération.
-! Le condensat precipitant liquide est supprime (dans la limite DeltaT<273-T).
-! Le condensat precipitant solide est augmente.
-! La vapeur d'eau est augmentee.
-!
-       IF ((iflag_bergeron .EQ. 2)) THEN
-         DO i = 1, klon
-           IF (rneb(i,k) .GT. 0.0) THEN
-             zqpreci(i)=(zcond(i)-zoliq(i))*zfice(i)
-             zqprecl(i)=(zcond(i)-zoliq(i))*(1.-zfice(i))
-           if (fl_cor_ebil .GT. 0) then
-             zcp=RCPD*(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
-             coef1 = rneb(i,k)*RLSTT/zcp*zdqsdT_raw(i)
-!            Calcul de DT si toute les precips liquides congelent
-             DeltaT = RLMLT*zqprecl(i) / (zcp*(1.+coef1))
-!            On ne veut pas que T devienne superieur a la temp. de congelation.
-!            donc que Delta > RTT-zt(i
-             DeltaT = max( min( RTT-zt(i), DeltaT) , 0. )
-             zt(i)      = zt(i)      + DeltaT
-!            Eau vaporisee du fait de l'augmentation de T
-             Deltaq = rneb(i,k)*zdqsdT_raw(i)*DeltaT
-!            on reajoute cette eau vaporise a la vapeur et on l'enleve des precips
-             zq(i) = zq(i) +  Deltaq
-!            Les 3 max si dessous prtotegent uniquement des erreurs d'arrondies
-             zcond(i)   = max( zcond(i)- Deltaq, 0. )
-!            precip liquide qui congele ou qui s'evapore
-             Deltaqprecl = -zcp/RLMLT*(1.+coef1)*DeltaT
-             zqprecl(i) = max( zqprecl(i) + Deltaqprecl, 0. )
-!            bilan eau glacee
-             zqpreci(i) = max (zqpreci(i) - Deltaqprecl - Deltaq, 0.)
-           else ! if (fl_cor_ebil .GT. 0)
-!            ancien calcul
-             zcp=RCPD*(1.0+RVTMP2*(zq(i)+zcond(i)))
-             coef1 = RLMLT*zdqs(i)/RLVTT
-             DeltaT = max( min( RTT-zt(i), RLMLT*zqprecl(i)/zcp/(1.+coef1) ) , 0.)
-             zqpreci(i) = zqpreci(i) + zcp/RLMLT*DeltaT
-             zqprecl(i) = max( zqprecl(i) - zcp/RLMLT*(1.+coef1)*DeltaT, 0. )
-             zcond(i)   = max( zcond(i)   - zcp/RLVTT*zdqs(i)*DeltaT, 0. )
-             zq(i)      = zq(i)      + zcp/RLVTT*zdqs(i)*DeltaT
-             zt(i)      = zt(i)      + DeltaT
-           end if ! if (fl_cor_ebil .GT. 0)
-           ENDIF  ! rneb(i,k) .GT. 0.0
-         ENDDO
-         DO i = 1, klon
-           IF (rneb(i,k).GT.0.0) THEN
-             d_ql(i,k) = (1-zfice(i))*zoliq(i)
-             d_qi(i,k) = zfice(i)*zoliq(i)
-!<LTP
-             IF (iflag_evap_prec == 4) THEN
-                zrflcld(i) = zrflcld(i)+zqprecl(i) &
-                 *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
-                ziflcld(i) = ziflcld(i)+ zqpreci(i) &
-                      *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
-                znebprecipcld(i) = rneb(i,k)
-                zrfl(i) = zrflcld(i) + zrflclr(i)
-                zifl(i) = ziflcld(i) + ziflclr(i)        
-!>LTP
-             ELSE
-                zrfl(i) = zrfl(i)+ zqprecl(i) &
-                 *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
-                zifl(i) = zifl(i)+ zqpreci(i) &
-                      *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)  
-             
-             ENDIF !iflag_evap_prec==4
-
-           ENDIF                      
-         ENDDO
-!!
-       ELSE  ! iflag_bergeron
-!>CR&JYG
-!!
-       DO i = 1, klon
-         IF (rneb(i,k).GT.0.0) THEN
-!CR on prend en compte la phase glace
-!JLD inutile car on ne passe jamais ici si .not.ice_thermo
-!           if (.not.ice_thermo) then
-!           d_ql(i,k) = zoliq(i)
-!           d_qi(i,k) = 0.
-!           else
-           d_ql(i,k) = (1-zfice(i))*zoliq(i)
-           d_qi(i,k) = zfice(i)*zoliq(i)
-!           endif
-!<LTP
-             IF (iflag_evap_prec == 4) THEN
-                zrflcld(i) = zrflcld(i)+ MAX(zcond(i)*(1.-zfice(i))-zoliqp(i),0.0) &
-                       *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
-                ziflcld(i) = ziflcld(i)+ MAX(zcond(i)*zfice(i)-zoliqi(i),0.0) &
-                        *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)  
-                znebprecipcld(i) = rneb(i,k)
-                zrfl(i) = zrflcld(i) + zrflclr(i)
-                zifl(i) = ziflcld(i) + ziflclr(i)        
-!>LTP
-             ELSE
-!AJ<
-                   zrfl(i) = zrfl(i)+ MAX(zcond(i)*(1.-zfice(i))-zoliqp(i),0.0) &
-                       *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
-                        zifl(i) = zifl(i)+ MAX(zcond(i)*zfice(i)-zoliqi(i),0.0) &
-                        *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)  
-     !      zrfl(i) = zrfl(i)+  zpluie                         &
-     !          *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
-     !      zifl(i) = zifl(i)+  zice                    &
-     !               *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)                                    
-             ENDIF !iflag_evap_prec == 4             
-
-!CR : on prend en compte l'effet Bergeron dans les flux de precipitation
-           IF ((iflag_bergeron .EQ. 1) .AND. (zt(i) .LT. 273.15)) THEN
-!<LTP
-                IF (iflag_evap_prec == 4) THEN
-                     zsolid = zrfl(i)
-                     ziflclr(i) = ziflclr(i) +zrflclr(i)
-                     ziflcld(i) = ziflcld(i) +zrflcld(i)
-                     zifl(i) = ziflclr(i)+ziflcld(i)
-                     zrflcld(i)=0.
-                     zrflclr(i)=0.   
-                     zrfl(i) = zrflclr(i)+zrflcld(i)
-!>LTP
-                ELSE
-                     zsolid = zrfl(i)
-                     zifl(i) = zifl(i)+zrfl(i)
-                     zrfl(i) = 0.
-                 ENDIF!iflag_evap_prec==4
-
-           if (fl_cor_ebil .GT. 0) then
-              zt(i)=zt(i)+zsolid*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
-                      *(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
-           else
-              zt(i)=zt(i)+zsolid*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
-                      *(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*zq(i))
-           end if
-           ENDIF  ! (iflag_bergeron .EQ. 1) .AND. (zt(i) .LT. 273.15)
-!RC   
-
-         ENDIF ! rneb(i,k).GT.0.0
-       ENDDO
-
-       ENDIF  ! iflag_bergeron .EQ. 2
-     ENDIF  ! .NOT. ice_thermo
-
-!CR: la fonte est faite au debut
-!      IF (ice_thermo) THEN
-!       DO i = 1, klon
-!           zmelt = ((zt(i)-273.15)/(ztfondue-273.15))**2
-!           zmelt = MIN(MAX(zmelt,0.),1.)
-!           zrfl(i)=zrfl(i)+zmelt*zifl(i)
-!           zifl(i)=zifl(i)*(1.-zmelt)
-!           print*,zt(i),'octavio1'
-!           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
-!                      *RLMLT/RCPD/(1.0+RVTMP2*zq(i))
-!           print*,zt(i),zrfl(i),zifl(i),zmelt,'octavio2'
-!       ENDDO
-!     ENDIF
-
-
-!<LTP
-
-!Limitation de la fraction surfacique couverte par les précipitations lorsque l'intensité locale du flux de précipitation descend en
-!dessous de rain_int_min
-    IF (iflag_evap_prec==4) THEN
-        DO i=1, klon
-            IF (zrflclr(i) + ziflclr(i) .GT. 0 ) THEN
-               znebprecipclr(i) = min(znebprecipclr(i), max(zrflclr(i) &
-                    /(znebprecipclr(i)*rain_int_min), &
-                    ziflclr(i)/(znebprecipclr(i)*rain_int_min)))
-            ELSE
-                znebprecipclr(i)=0.
-            ENDIF
-
-            IF (zrflcld(i) + ziflcld(i) .GT. 0 ) THEN
-               znebprecipcld(i) = min(znebprecipcld(i), &
-                    max(zrflcld(i)/(znebprecipcld(i)*rain_int_min), &
-                    ziflcld(i)/(znebprecipcld(i)*rain_int_min)))
-            ELSE
-                znebprecipcld(i)=0.
-            ENDIF
-       ENDDO
-    ENDIf
-
-!>LTP
-
-
-
-
-       
-     IF (.NOT. ice_thermo) THEN
-       DO i = 1, klon
-         IF (zt(i).LT.RTT) THEN
-           psfl(i,k)=zrfl(i)
-         ELSE
-           prfl(i,k)=zrfl(i)
-         ENDIF
-       ENDDO
-     ELSE
-     ! JAM*************************************************
-     ! Revoir partie ci-dessous: a quoi servent psfl et prfl?
-     ! *****************************************************
-
-       DO i = 1, klon
-     !   IF (zt(i).LT.RTT) THEN
-           psfl(i,k)=zifl(i) 
-     !   ELSE
-           prfl(i,k)=zrfl(i)
-     !   ENDIF
-!>AJ
-       ENDDO
-     ENDIF
-     ! ----------------------------------------------------------------
-     ! Fin de formation des precipitations
-     ! ----------------------------------------------------------------
-     !
-     ! Calculer les tendances de q et de t:
-     !
-     DO i = 1, klon
-        d_q(i,k) = zq(i) - q(i,k)
-        d_t(i,k) = zt(i) - t(i,k)
-     ENDDO
-     !
-     !AA--------------- Calcul du lessivage stratiforme  -------------
-
-     DO i = 1,klon
-        !
-        if(zcond(i).gt.zoliq(i)+1.e-10) then
-         beta(i,k) = (zcond(i)-zoliq(i))/zcond(i)/dtime
-        else
-         beta(i,k) = 0.
-        endif
-        zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0) &
-             * (paprs(i,k)-paprs(i,k+1))/RG
-        IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
-           !AA lessivage nucleation LMD5 dans la couche elle-meme
-          IF (iflag_t_glace.EQ.0) THEN
-           if (t(i,k) .GE. t_glace_min_old) THEN
-              zalpha_tr = a_tr_sca(3)
-           else
-              zalpha_tr = a_tr_sca(4)
-           endif
-          ELSE ! of IF (iflag_t_glace.EQ.0)
-           if (t(i,k) .GE. t_glace_min) THEN
-              zalpha_tr = a_tr_sca(3)
-           else
-              zalpha_tr = a_tr_sca(4)
-           endif
-          ENDIF
-           zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
-           pfrac_nucl(i,k)=pfrac_nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
-           frac_nucl(i,k)= 1.-zneb(i)*zfrac_lessi 
-           !
-           ! nucleation avec un facteur -1 au lieu de -0.5
-           zfrac_lessi = 1. - EXP(-zprec_cond(i)/zneb(i))
-           pfrac_1nucl(i,k)=pfrac_1nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
-        ENDIF
-        !
-     ENDDO      ! boucle sur i
-     !
-     !AA Lessivage par impaction dans les couches en-dessous
-     DO kk = k-1, 1, -1
-        DO i = 1, klon
-           IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
-             IF (iflag_t_glace.EQ.0) THEN
-              if (t(i,kk) .GE. t_glace_min_old) THEN
-                 zalpha_tr = a_tr_sca(1)
-              else
-                 zalpha_tr = a_tr_sca(2)
-              endif
-             ELSE ! of IF (iflag_t_glace.EQ.0)
-              if (t(i,kk) .GE. t_glace_min) THEN
-                 zalpha_tr = a_tr_sca(1)
-              else
-                 zalpha_tr = a_tr_sca(2)
-              endif
-             ENDIF
-              zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
-              pfrac_impa(i,kk)=pfrac_impa(i,kk)*(1.-zneb(i)*zfrac_lessi)
-              frac_impa(i,kk)= 1.-zneb(i)*zfrac_lessi
-           ENDIF
-        ENDDO
-     ENDDO
-     !
-     !AA===============================================================
-     !                     FIN DE LA BOUCLE VERTICALE  
-  end DO
-  !
-  !AA==================================================================
-  !
-  ! Pluie ou neige au sol selon la temperature de la 1ere couche
-  !
-!CR: si la thermo de la glace est active, on calcule zifl directement
-  IF (.NOT.ice_thermo) THEN
-  DO i = 1, klon
-     IF ((t(i,1)+d_t(i,1)) .LT. RTT) THEN
-!AJ<
-!        snow(i) = zrfl(i)
-        snow(i) = zrfl(i)+zifl(i)
-!>AJ
-        zlh_solid(i) = RLSTT-RLVTT
-     ELSE
-        rain(i) = zrfl(i)
-        zlh_solid(i) = 0.
-     ENDIF
-  ENDDO
-
-  ELSE
-     DO i = 1, klon
-        snow(i) = zifl(i)
-        rain(i) = zrfl(i)
-     ENDDO
-   
-   ENDIF
-  !
-  ! For energy conservation : when snow is present, the solification
-  ! latent heat is considered.
-!CR: si thermo de la glace, neige deja prise en compte
-  IF (.not.ice_thermo) THEN
-  DO k = 1, klev
-     DO i = 1, klon
-        zcpair=RCPD*(1.0+RVTMP2*(q(i,k)+d_q(i,k)))
-        zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
-        zm_solid = (prfl(i,k)-prfl(i,k+1)+psfl(i,k)-psfl(i,k+1))*dtime
-        d_t(i,k) = d_t(i,k) + zlh_solid(i) *zm_solid / (zcpair*zmair(i))
-     END DO
-  END DO
-  ENDIF
-  !
-
-  if (ncoreczq>0) then
-     WRITE(lunout,*)'WARNING : ZQ dans fisrtilp ',ncoreczq,' val < 1.e-15.'
-  endif
-
-END SUBROUTINE fisrtilp
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/fisrtilp.h
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/fisrtilp.h	(revision 4726)
+++ 	(revision )
@@ -1,33 +1,0 @@
-!
-! $Header$
-!
-!
-!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
-!                 veillez  n'utiliser que des ! pour les commentaires
-!                 et  bien positionner les & des lignes de continuation
-!                 (les placer en colonne 6 et en colonne 73)
-!
-      REAL cld_lc_lsc,cld_lc_con
-      REAL cld_tau_lsc,cld_tau_con
-      REAL ffallv_lsc,ffallv_con
-      REAL coef_eva,coef_eva_i
-      LOGICAL reevap_ice
-      INTEGER iflag_pdf
-      INTEGER iflag_fisrtilp_qsat
-      INTEGER iflag_bergeron
-
-      common/comfisrtilp/                                               &
-     &     cld_lc_lsc                                                   &
-     &     ,cld_lc_con                                                  &
-     &     ,cld_tau_lsc                                                 &
-     &     ,cld_tau_con                                                 &
-     &     ,ffallv_lsc                                                  &
-     &     ,ffallv_con                                                  &
-     &     ,coef_eva                                                    &
-     &     ,coef_eva_i                                                  &
-     &     ,reevap_ice                                                  &
-     &     ,iflag_fisrtilp_qsat                                         &
-     &     ,iflag_bergeron                                              &
-     &     ,iflag_pdf        
-
-!$OMP THREADPRIVATE(/comfisrtilp/)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/fonte_neige_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/fonte_neige_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/fonte_neige_mod.F90	(revision 4727)
@@ -164,6 +164,6 @@
     REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain
     REAL, DIMENSION(klon), INTENT(IN)    :: precip_snow
-    
-! Input/Output variables
+
+    ! Input/Output variables
 !****************************************************************************************
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ice_sursat_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ice_sursat_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ice_sursat_mod.F90	(revision 4727)
@@ -308,5 +308,4 @@
   INCLUDE "YOETHF.h"
   INCLUDE "FCTTRE.h"
-  INCLUDE "fisrtilp.h"
   INCLUDE "clesphys.h"
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/icefrac_lsc_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/icefrac_lsc_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/icefrac_lsc_mod.F90	(revision 4727)
@@ -17,7 +17,6 @@
   
   USE print_control_mod, ONLY: lunout, prt_level
-  INCLUDE "nuage.h"
-
-  ! nuage.h contains:
+  USE lmdz_lscp_ini, 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
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/infotrac_phy.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/infotrac_phy.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/infotrac_phy.F90	(revision 4727)
@@ -19,4 +19,9 @@
    PUBLIC :: nbtr_bin, nbtr_sulgas                         !--- Number of aerosols bins and sulfur gases for StratAer model
    PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
+#endif
+#ifdef REPROBUS
+   PUBLIC :: nbtr_bin, nbtr_sulgas
+   PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, &
+             id_TEST_strat
 #endif
 
@@ -68,5 +73,5 @@
 !  | 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,5 +98,5 @@
 !  | 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         |
@@ -118,4 +123,12 @@
   INTEGER, SAVE ::  id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
 !$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat)
+#endif
+#ifdef REPROBUS
+  INTEGER, SAVE ::  nbtr_bin, nbtr_sulgas
+!$OMP THREADPRIVATE(nbtr_bin, nbtr_sulgas)
+  INTEGER, SAVE ::  id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat,&
+                    id_TEST_strat
+!$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat)
+!$OMP THREADPRIVATE(id_TEST_strat)
 #endif
 
@@ -175,5 +188,6 @@
    TYPE(trac_type), POINTER             :: t1, t(:)
    INTEGER :: ierr
-
+   CHARACTER(LEN=maxlen),   ALLOCATABLE :: types_trac(:)  !--- Keyword for tracers type(s), parsed version
+   
    CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac_phy"
 !------------------------------------------------------------------------------------------------------------------------------
@@ -187,4 +201,12 @@
 
    CALL getin_p('type_trac',type_trac)
+
+   lerr=strParse(type_trac, '|', types_trac, n=nt)
+   IF (nt .GT. 1) THEN
+      IF (nt .GT. 2) CALL abort_physic(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
+      IF (nt .EQ. 2) type_trac=types_trac(2)
+   ENDIF
+
+   
    CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
    lInit = .NOT.ALLOCATED(tracers)
@@ -202,5 +224,5 @@
       CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname)
       CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only',          modname)
-      CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(type_trac)//' not possible yet.',1)
+      CASE DEFAULT; CALL abort_physic(modname,'type_trac='//TRIM(type_trac)//' not possible yet.',1)
    END SELECT
 
@@ -209,13 +231,13 @@
       CASE('inca', 'inco')
 #ifndef INCA
-         CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1)
+         CALL abort_physic(modname, 'You must add cpp key INCA and compile with INCA code', 1)
 #endif
       CASE('repr')
 #ifndef REPROBUS
-         CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
+         CALL abort_physic(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
 #endif
       CASE('coag')
 #ifndef CPP_StratAer
-         CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
+         CALL abort_physic(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
 #endif
    END SELECT
@@ -234,10 +256,11 @@
 
    !=== DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE
-   IF(testTracersFiles(modname, texp, fType, lInit)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
+   IF(testTracersFiles(modname, texp, fType, lInit)) CALL abort_physic(modname, 'problem with tracers file(s)',1)
+
    ttp = type_trac; IF(fType /= 1) ttp = texp
 
 !##############################################################################################################################
    IF(lInit) THEN
-      IF(readTracersFiles(ttp, type_trac == 'repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
+      IF(readTracersFiles(ttp, type_trac == 'repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1)
    ELSE
       CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname)
@@ -246,5 +269,5 @@
 
    !---------------------------------------------------------------------------------------------------------------------------
-   IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
+   IF(fType == 0) CALL abort_physic(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
    !---------------------------------------------------------------------------------------------------------------------------
    IF(fType == 1 .AND. ANY(['inca','inco']==type_trac) .AND. lInit) THEN  !=== FOUND OLD STYLE INCA "traceur.def"
@@ -255,5 +278,5 @@
       nbtr = nqINCA + nqCO2                                          !--- Number of tracers passed to phytrac
       nqtrue = nbtr + nqo                                            !--- Total number of "true" tracers
-      IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
+      IF(ALL([2,3] /= nqo)) CALL abort_physic(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
       ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
       ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA),  pbl_flg_inca(nqINCA))
@@ -279,5 +302,5 @@
          CALL addKey('phase',     t1%phase,     t1%keys)
       END DO
-      IF(setGeneration(tracers)) CALL abort_gcm(modname,'See above',1) !- SET FIELDS %iGeneration, %gen0Name
+      IF(setGeneration(tracers)) CALL abort_physic(modname,'See below',1) !- SET FIELDS %iGeneration, %gen0Name
       DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
 #endif
@@ -314,5 +337,5 @@
       IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
       WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available'
-      CALL abort_gcm(modname, TRIM(msg1), 1)
+      CALL abort_physic(modname, TRIM(msg1), 1)
    END DO
    nqtot =    COUNT( hadv< 20 .AND. vadv< 20 ) &                     !--- No additional tracer
@@ -340,5 +363,5 @@
       IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
       WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq)
-      IF(iad == -1) CALL abort_gcm(modname, msg1, 1)
+      IF(iad == -1) CALL abort_physic(modname, msg1, 1)
 
       !--- SET FIELDS %longName, %isAdvected, %isInPhysics
@@ -381,5 +404,5 @@
    !=== READ PHYSICAL PARAMETERS FOR ISOTOPES
    niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
-   IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1)
+   IF(readIsotopesFile()) CALL abort_physic(modname, 'Problem when reading isotopes parameters', 1)
 
 !##############################################################################################################################
@@ -387,11 +410,11 @@
 !##############################################################################################################################
    !--- Convection / boundary layer activation for all tracers
-   ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
-   ALLOCATE( pbl_flg(nbtr));  pbl_flg(1:nbtr) = 1
+   IF (.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
+   IF (.NOT.ALLOCATED(pbl_flg)) ALLOCATE( pbl_flg(nbtr));  pbl_flg(1:nbtr) = 1
 
    !--- Note: nqtottr can differ from nbtr when nmom/=0
    nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
    IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
-      CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1)
+      CALL abort_physic(modname, 'pb dans le calcul de nqtottr', 1)
 
    !=== DISPLAY THE RESULTS
@@ -414,5 +437,5 @@
       cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,          &
                   t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
-      CALL abort_gcm(modname, "problem with the tracers table content", 1)
+      CALL abort_physic(modname, "problem with the tracers table content", 1)
    IF(niso > 0) THEN
       CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ini_COSP.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ini_COSP.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ini_COSP.F90	(revision 4727)
@@ -0,0 +1,36 @@
+!  A.I avril 2023
+
+  subroutine 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)
+
+! Routine pour initialiser les champs input pour Cosp au  1er appel de celui-ci
+!         Ce 1er appel sert uniquement a definir les axes verticaux pour les 
+!         sortie Cosp
+
+      use dimphy
+      include "ini_COSP.h"
+
+      ! Initialisations pour le 1er passage a Cosp
+        ref_liq_cosp0=1.
+        ref_ice_cosp0=1.
+        pctsrf_cosp0=0.5
+        zu10m_cosp0=1.
+        zv10m_cosp0=1.
+        zxtsol_cosp0=288.
+        zx_rh_cosp0=1.
+        cldfra_cosp0=1.
+        rnebcon_cosp0=0.
+        flwc_cosp0=0.
+        fiwc_cosp0=0.
+        prfl_cosp0(:,1:klev)=0.
+        psfl_cosp0(:,1:klev)=0.
+        pmflxr_cosp0(:,1:klev)=0.
+        pmflxs_cosp0(:,1:klev)=0.
+        mr_ozone_cosp0=0.
+        cldtau_cosp0=0.
+        cldemi_cosp0=0.
+        JrNt_cosp0=0.
+
+     end subroutine ini_COSP
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ini_COSP.h
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ini_COSP.h	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ini_COSP.h	(revision 4727)
@@ -0,0 +1,24 @@
+! A.I mars 2023
+
+! Declaration des champs inputs a initialiser pour le simulateur d'observable satellite  COSP
+
+    REAL :: zx_rhcosp0(klon,klev), &
+            ref_liq_cosp0(klon,klev), ref_ice_cosp0(klon,klev), &
+            zx_rh_cosp0(klon,klev), cldfra_cosp0(klon,klev), rnebcon_cosp0(klon,klev), &
+            fiwc_cosp0(klon,klev), flwc_cosp0(klon,klev), prfl_cosp0(klon,klev), &
+            psfl_cosp0(klon,klev), pmflxr_cosp0(klon,klev), pmflxs_cosp0(klon,klev), &
+            mr_ozone_cosp0(klon,klev), cldtau_cosp0(klon,klev), cldemi_cosp0(klon,klev), &
+            pctsrf_cosp0(klon),zu10m_cosp0(klon),zv10m_cosp0(klon), &
+            zxtsol_cosp0(klon),JrNt_cosp0(klon)
+
+!   COMMON/iniCOSP/                                                 &
+!            zx_rhcosp0(klon,klev),ref_liq_cosp0(klon,klev), ref_ice_cosp0(klon,klev), &
+!	    zx_rh_cosp0(klon,klev), cldfra_cosp0(klon,klev), rnebcon_cosp0(klon,klev), &
+!            fiwc_cosp0(klon,klev), flwc_cosp0(klon,klev), prfl_cosp0(klon,klev), &
+!            psfl_cosp0(klon,klev), pmflxr_cosp0(klon,klev), pmflxs_cosp0(klon,klev), &
+!            mr_ozone_cosp0(klon,klev), cldtau_cosp0(klon,klev), cldemi_cosp0(klon,klev), &
+!            pctsrf_cosp0(klon),zu10m_cosp0(klon),zv10m_cosp0(klon), &
+!            zxtsol_cosp0(klon),JrNt_cosp0(klon)
+!	save /iniCOSP/
+!!$OMP THREADPRIVATE(/iniCOSP/)
+	
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ini_csts.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ini_csts.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ini_csts.F90	(revision 4727)
@@ -0,0 +1,187 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
+!SFX_LIC for details. version 1.
+!     #########
+      SUBROUTINE INI_CSTS 
+!     ##################
+!
+!!****  *INI_CSTS * - routine to initialize the module MODD_CST
+!!
+!!    PURPOSE
+!!    -------
+!       The purpose of this routine is to initialize  the physical constants
+!     stored in  module MODD_CST.
+!      
+!
+!!**  METHOD
+!!    ------
+!!      The physical constants are set to their numerical values 
+!!     
+!!
+!!    EXTERNAL
+!!    --------
+!!      FMLOOK : to retrieve logical unit number associated to a file
+!!
+!!    IMPLICIT ARGUMENTS
+!!    ------------------
+!!      Module MODD_CST     : contains physical constants
+!!
+!!    REFERENCE
+!!    ---------
+!!      Book2 of the documentation (module MODD_CST, routine INI_CSTS)
+!!      
+!!
+!!    AUTHOR
+!!    ------
+!!      V. Ducrocq       * Meteo France *
+!!
+!!    MODIFICATIONS
+!!    -------------
+!!      Original    18/05/94 
+!!      J. Stein    02/01/95  add the volumic mass of liquid water
+!!      J.-P. Pinty 13/12/95  add the water vapor pressure over solid ice
+!!      J. Stein    29/06/97  add XTH00
+!!      V. Masson   05/10/98  add XRHOLI
+!!      C. Mari     31/10/00  add NDAYSEC
+!!      V. Masson   01/03/03  add XCONDI
+!!      A. Voldoire 01/12/09  add XTTSI, XICEC, XTTS for ESM
+!!      J. Escobar  28/03/2014 for pb with emissivity/aerosol reset XSURF_TINY=1.0e-80 in real8 case
+!!
+!-------------------------------------------------------------------------------
+!
+!*       0.    DECLARATIONS
+!              ------------
+!
+USE MODD_CSTS
+!
+!
+!USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+!USE PARKIND1  ,ONLY : JPRB
+!
+!USE MODI_INI_CTURBS
+!
+!USE MODI_INI_OCEAN_CSTS
+!
+!USE MODI_INI_SURF_CSTS
+!
+IMPLICIT NONE
+!  
+!-------------------------------------------------------------------------------
+!
+!*       1.     FUNDAMENTAL CONSTANTS
+!               ---------------------
+!
+
+!REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+!IF (LHOOK) CALL DR_HOOK('INI_CSTS',0,ZHOOK_HANDLE)
+
+!#ifdef SFX_MNH
+!#ifdef MNH_MPI_DOUBLE_PRECISION
+XSURF_TINY    = 1.0e-80
+!#else
+!XSURF_TINY    = TINY    (XSURF_TINY    )
+!#endif
+!#else
+XSURF_TINY    = 1.0e-80
+!#endif
+XSURF_TINY_12 = SQRT    (XSURF_TINY    )
+XSURF_EPSILON = EPSILON (XSURF_EPSILON ) * 10.0
+
+XPI         = 2.*ASIN(1.)
+XKARMAN     = 0.4
+XBOLTZ      = 1.380658E-23
+XLIGHTSPEED = 299792458.
+XPLANCK     = 6.6260755E-34
+XAVOGADRO   = 6.0221367E+23
+!
+!-------------------------------------------------------------------------------
+!
+!*       2.     ASTRONOMICAL CONSTANTS
+!               ----------------------
+!
+XDAY   = 86400.
+XSIYEA = 365.25*XDAY*2.*XPI/ 6.283076
+XSIDAY = XDAY/(1.+XDAY/XSIYEA)
+XOMEGA = 2.*XPI/XSIDAY
+NDAYSEC = 24*3600 ! Number of seconds in a day
+!
+!-------------------------------------------------------------------------------!
+!
+!
+!*       3.     TERRESTRIAL GEOIDE CONSTANTS
+!               ----------------------------
+!
+XRADIUS = 6371229.
+XG      = 9.80665
+!
+!-------------------------------------------------------------------------------
+!
+!*       4.     REFERENCE PRESSURE
+!               -------------------
+!
+XP00 = 1.E5
+XTH00 = 300.
+!-------------------------------------------------------------------------------
+!
+!*       5.     RADIATION CONSTANTS
+!               -------------------
+!
+!JUAN OVERFLOW XSTEFAN = 2.* XPI**5 * XBOLTZ**4 / (15.* XLIGHTSPEED**2 * XPLANCK**3)
+XSTEFAN = ( 2.* XPI**5 / 15. ) * ( (XBOLTZ / XPLANCK)* XBOLTZ ) * (XBOLTZ/(XLIGHTSPEED*XPLANCK))**2 
+XI0     = 1370.
+!
+!-------------------------------------------------------------------------------
+!
+!*       6.     THERMODYNAMIC CONSTANTS
+!               -----------------------
+!
+XMD    = 28.9644E-3
+XMV    = 18.0153E-3
+XRD    = XAVOGADRO * XBOLTZ / XMD
+XRV    = XAVOGADRO * XBOLTZ / XMV
+XCPD   = 7.* XRD /2.
+XCPV   = 4.* XRV
+XRHOLW = 1000.
+XRHOLI = 917.
+XCONDI = 2.22
+XCL    = 4.218E+3
+XCI    = 2.106E+3
+XTT    = 273.16
+XTTSI  = XTT - 1.8
+XICEC  = 0.5
+XTTS   = XTT*(1-XICEC) + XTTSI*XICEC
+XLVTT  = 2.5008E+6
+XLSTT  = 2.8345E+6
+XLMTT  = XLSTT - XLVTT
+XESTT  = 611.14
+XGAMW  = (XCL - XCPV) / XRV
+XBETAW = (XLVTT/XRV) + (XGAMW * XTT)
+XALPW  = LOG(XESTT) + (XBETAW /XTT) + (XGAMW *LOG(XTT))
+XGAMI  = (XCI - XCPV) / XRV
+XBETAI = (XLSTT/XRV) + (XGAMI * XTT)
+XALPI  = LOG(XESTT) + (XBETAI /XTT) + (XGAMI *LOG(XTT))
+!
+!-------------------------------------------------------------------------------
+!
+!*       7.     TURBULENCE CONSTANTS
+!               --------------------
+!
+! CALL INI_CTURBS
+!-------------------------------------------------------------------------------
+!
+!*       8.     OCEAN CONSTANTS
+!               ---------------
+!
+! CALL INI_OCEAN_CSTS
+!
+!*       9.     SURFACE CONSTANTS
+!               -----------------
+!
+! CALL INI_SURF_CSTS
+!IF (LHOOK) CALL DR_HOOK('INI_CSTS',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE INI_CSTS 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ini_undefSTD.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ini_undefSTD.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ini_undefSTD.F90	(revision 4727)
@@ -31,5 +31,5 @@
   ! ====================================================================
 
-  ! ym #include "dimphy.h"
+  ! ym INCLUDE "dimphy.h"
   ! variables Input/Output
   ! INTEGER nlevSTD, klevSTD, itap
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iophy.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iophy.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iophy.F90	(revision 4727)
@@ -16,13 +16,7 @@
 !$OMP THREADPRIVATE(itau_iophy)
 
-#ifdef CPP_XIOS
   INTERFACE histwrite_phy
     MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old,histwrite2d_xios,histwrite3d_xios,histwrite0d_xios
   END INTERFACE
-#else
-  INTERFACE histwrite_phy
-    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old
-  END INTERFACE
-#endif
 
   INTERFACE histbeg_phy_all
@@ -52,7 +46,5 @@
     USE ioipsl, ONLY: flio_dom_set
 #endif
-#ifdef CPP_XIOS
-  use wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_context_init
-#endif
+  use wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_context_init, using_xios
     IMPLICIT NONE
     REAL,DIMENSION(klon),INTENT(IN) :: rlon
@@ -72,14 +64,10 @@
     INTEGER :: data_ibegin, data_iend
 
-#ifdef CPP_XIOS
-      CALL wxios_context_init
-#endif
+    if (using_xios)  CALL wxios_context_init
     
 
     IF (grid_type==unstructured) THEN
     
-#ifdef CPP_XIOS
       CALL wxios_domain_param_unstructured("dom_glo")
-#endif
 
     ELSE
@@ -140,5 +128,5 @@
                       'APPLE',phys_domain_id)
 #endif
-#ifdef CPP_XIOS
+    IF (using_xios) THEN  
       ! Set values for the mask:
       IF (mpi_rank == 0) THEN
@@ -163,10 +151,8 @@
 
       ! Initialize the XIOS domain coreesponding to this process:
-#endif
+    ENDIF
 !$OMP END MASTER
 
-#ifdef CPP_XIOS    
-        CALL wxios_domain_param("dom_glo")
-#endif
+      IF (using_xios) CALL wxios_domain_param("dom_glo")
       
     ENDIF
@@ -227,7 +213,5 @@
   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
   USE ioipsl, ONLY: histbeg
-#ifdef CPP_XIOS
-  USE wxios, ONLY: wxios_add_file
-#endif
+  USE wxios, ONLY: wxios_add_file, using_xios
   IMPLICIT NONE
   INCLUDE 'clesphys.h'
@@ -251,13 +235,13 @@
   ENDIF
 
-#ifdef CPP_XIOS
-  ! ug OMP en chantier...
-  IF((.NOT. is_using_mpi) .OR. is_mpi_root) THEN
-      ! ug Création du fichier
-    IF (.not. ok_all_xml) THEN
-      CALL wxios_add_file(name, ffreq, lev)
+  IF (using_xios) THEN  
+    ! ug OMP en chantier...
+    IF((.NOT. is_using_mpi) .OR. is_mpi_root) THEN
+        ! ug Création du fichier
+      IF (.not. ok_all_xml) THEN
+        CALL wxios_add_file(name, ffreq, lev)
+      ENDIF
     ENDIF
   ENDIF
-#endif
 !$OMP END MASTER
   
@@ -608,7 +592,5 @@
     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     USE aero_mod, ONLY : naero_tot, name_aero_tau
-#ifdef CPP_XIOS
-    USE wxios, ONLY: wxios_add_field_to_file
-#endif
+    USE wxios, ONLY: wxios_add_field_to_file, using_xios
     USE print_control_mod, ONLY: prt_level,lunout
     IMPLICIT NONE
@@ -650,16 +632,16 @@
     IF(.NOT.clef_stations(iff)) THEN  
 
-#ifdef CPP_XIOS
-      IF (.not. ok_all_xml) THEN
-        IF ( var%flag(iff)<=lev_files(iff) ) THEN
-          CALL wxios_add_field_to_file(var%name, 2, iff, phys_out_filenames(iff), &
-          var%description, var%unit, var%flag(iff), typeecrit)
-          IF (prt_level >= 10) THEN
-            WRITE(lunout,*) 'histdef2d: call wxios_add_field_to_file var%name iff: ', &
-                            trim(var%name),iff
+      IF (using_xios) THEN  
+        IF (.not. ok_all_xml) THEN
+          IF ( var%flag(iff)<=lev_files(iff) ) THEN
+            CALL wxios_add_field_to_file(var%name, 2, iff, phys_out_filenames(iff), &
+            var%description, var%unit, var%flag(iff), typeecrit)
+            IF (prt_level >= 10) THEN
+              WRITE(lunout,*) 'histdef2d: call wxios_add_field_to_file var%name iff: ', &
+                              trim(var%name),iff
+            ENDIF
           ENDIF
         ENDIF
       ENDIF
-#endif
 #ifndef CPP_IOIPSL_NO_OUTPUT 
 
@@ -725,7 +707,5 @@
     USE print_control_mod, ONLY: prt_level,lunout
     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-#ifdef CPP_XIOS
-    USE wxios, ONLY: wxios_add_field_to_file
-#endif
+    USE wxios, ONLY: wxios_add_field_to_file, using_xios
     USE print_control_mod, ONLY: prt_level,lunout
     IMPLICIT NONE
@@ -766,16 +746,17 @@
     IF(.NOT.clef_stations(iff)) THEN
 
-#ifdef CPP_XIOS
-       IF (.not. ok_all_xml) THEN
-         IF ( var%flag(iff)<=lev_files(iff) ) THEN
-         CALL wxios_add_field_to_file(var%name, 3, iff, phys_out_filenames(iff), &
-         var%description, var%unit, var%flag(iff), typeecrit)
-           IF (prt_level >= 10) THEN
-             WRITE(lunout,*) 'histdef3d: call wxios_add_field_to_file var%name iff: ', &
-                             trim(var%name),iff
-           ENDIF
-         ENDIF
-       ENDIF
-#endif
+      IF (using_xios) THEN  
+
+        IF (.not. ok_all_xml) THEN
+          IF ( var%flag(iff)<=lev_files(iff) ) THEN
+          CALL wxios_add_field_to_file(var%name, 3, iff, phys_out_filenames(iff), &
+          var%description, var%unit, var%flag(iff), typeecrit)
+            IF (prt_level >= 10) THEN
+              WRITE(lunout,*) 'histdef3d: call wxios_add_field_to_file var%name iff: ', &
+                              trim(var%name),iff
+            ENDIF
+          ENDIF
+        ENDIF
+      ENDIF
 #ifndef CPP_IOIPSL_NO_OUTPUT 
 
@@ -974,7 +955,5 @@
   USE print_control_mod, ONLY: prt_level,lunout
   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat
-#ifdef CPP_XIOS
-  USE xios, ONLY: xios_send_field, xios_field_is_active
-#endif
+  USE lmdz_xios, ONLY: xios_send_field, xios_field_is_active, using_xios
   USE print_control_mod, ONLY: lunout, prt_level
 
@@ -1036,14 +1015,14 @@
 
   ELSE
-#ifdef CPP_XIOS
-    IF (ok_all_xml) THEN
-      !$omp barrier
-      !$omp master
-      is_active = xios_field_is_active(var%name, at_current_timestep_arg=.false.)
-      !$omp end master
-      !$omp barrier
-      IF(.not. is_active) RETURN
-    ENDIF
-#endif
+    IF (using_xios) THEN
+      IF (ok_all_xml) THEN
+        !$omp barrier
+        !$omp master
+        is_active = xios_field_is_active(var%name, at_current_timestep_arg=.false.)
+        !$omp end master
+        !$omp barrier
+        IF(.not. is_active) RETURN
+      ENDIF
+    ENDIF
 
     !Et sinon on.... écrit
@@ -1068,5 +1047,5 @@
 
       IF (ok_all_xml) THEN
-#ifdef CPP_XIOS
+        IF (using_xios) THEN  
           IF (prt_level >= 10) THEN
              write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name)                       
@@ -1091,35 +1070,35 @@
                              trim(var%name)                       
           ENDIF
-#else
-        CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
-#endif
+        ELSE
+          CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
+        ENDIF
       ELSE  
         DO iff=iff_beg, iff_end
             IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN 
 
-#ifdef CPP_XIOS
-               IF (firstx) THEN
-                  IF (prt_level >= 10) THEN
-                     write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
-                                    iff,trim(var%name)                       
-                     write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
-                  ENDIF
-                  IF (grid_type==regular_lonlat) THEN
-                    IF (SIZE(field) == klon) then
-                       CALL xios_send_field(var%name, Field2d)
-                    ELSE
+              IF (using_xios) THEN
+                IF (firstx) THEN
+                   IF (prt_level >= 10) THEN
+                      write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
+                                     iff,trim(var%name)                       
+                      write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
+                   ENDIF
+                   IF (grid_type==regular_lonlat) THEN
+                     IF (SIZE(field) == klon) then
+                        CALL xios_send_field(var%name, Field2d)
+                     ELSE
+                        CALL xios_send_field(var%name, field)
+                     ENDIF
+                   ELSE IF (grid_type==unstructured) THEN
+                     IF (SIZE(field) == klon) then
+                       CALL xios_send_field(var%name, buffer_omp)
+                     ELSE
                        CALL xios_send_field(var%name, field)
-                    ENDIF
-                  ELSE IF (grid_type==unstructured) THEN
-                    IF (SIZE(field) == klon) then
-                      CALL xios_send_field(var%name, buffer_omp)
-                    ELSE
-                      CALL xios_send_field(var%name, field)
-                    ENDIF
-                  ENDIF
-
-                  firstx=.false.
-               ENDIF
-#endif
+                     ENDIF
+                   ENDIF
+
+                   firstx=.false.
+                ENDIF
+              ENDIF
 
                   IF (.NOT.clef_stations(iff)) THEN
@@ -1129,5 +1108,5 @@
                         CALL histwrite(nid_files(iff),var%name,itau_iophy,Field2d,nbp_lon*jj_nb,index2d)
 #endif
-!#ifdef CPP_XIOS
+!    IF (using_xios) THEN  
 !                        IF (iff == iff_beg) THEN
 !                          IF (prt_level >= 10) THEN
@@ -1136,5 +1115,5 @@
 !                          CALL xios_send_field(var%name, Field2d)
 !                        ENDIF
-!#endif
+!    ENDIF
                   ELSE 
                         ALLOCATE(fieldok(npstn))
@@ -1188,7 +1167,5 @@
                                  nid_files, swaerofree_diag
   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, regular_lonlat, unstructured
-#ifdef CPP_XIOS
-  USE xios, ONLY: xios_send_field, xios_field_is_active
-#endif
+  USE lmdz_xios, ONLY: xios_send_field, xios_field_is_active, using_xios
   USE print_control_mod, ONLY: prt_level,lunout
 
@@ -1236,14 +1213,14 @@
       CALL bcast_omp(swaerofree_diag)
   ELSE
-#ifdef CPP_XIOS
-    IF (ok_all_xml) THEN
-      !$omp barrier
-      !$omp master
-      is_active = xios_field_is_active(var%name, at_current_timestep_arg=.false.)
-      !$omp end master
-      !$omp barrier
-      IF(.not. is_active) RETURN
-    ENDIF
-#endif
+    IF (using_xios) THEN  
+      IF (ok_all_xml) THEN
+        !$omp barrier
+        !$omp master
+        is_active = xios_field_is_active(var%name, at_current_timestep_arg=.false.)
+        !$omp end master
+        !$omp barrier
+        IF(.not. is_active) RETURN
+      ENDIF
+    ENDIF
 
     !Et sinon on.... écrit
@@ -1273,5 +1250,5 @@
 
     IF (ok_all_xml) THEN
-#ifdef CPP_XIOS
+      IF (using_xios) THEN  
           IF (prt_level >= 10) THEN
              write(lunout,*)'Dans iophy histwrite3D,var%name ',&
@@ -1292,12 +1269,12 @@
         ENDIF
 
-#else
+      ELSE
         CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
-#endif
+      ENDIF
     ELSE  
 
       DO iff=iff_beg, iff_end
           IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
-#ifdef CPP_XIOS
+            IF (using_xios) THEN  
               IF (firstx) THEN
                 IF (prt_level >= 10) THEN
@@ -1324,8 +1301,9 @@
                 firstx=.false.
               ENDIF
-#endif
-              IF (.NOT.clef_stations(iff)) THEN
-                        ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
-                        ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
+            ENDIF
+            
+            IF (.NOT.clef_stations(iff)) THEN
+                      ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
+                      ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
 
 #ifndef CPP_IOIPSL_NO_OUTPUT 
@@ -1333,9 +1311,9 @@
 #endif
 
-!#ifdef CPP_XIOS
+!    IF (using_xios) THEN  
 !                        IF (iff == 1) THEN
 !                              CALL xios_send_field(var%name, Field3d(:,:,1:klev))
 !                        ENDIF
-!#endif
+!    ENDIF
 !                        
               ELSE 
@@ -1378,5 +1356,4 @@
 
 ! VERSION DES HISTWRITE DEDIEES AU TOUT-XIOS-XML DEJA UTILISEE DANS PHYDEV
-#ifdef CPP_XIOS
   SUBROUTINE histwrite2d_xios(field_name,field)
 
@@ -1386,5 +1363,5 @@
                                 jj_nb, klon_mpi, is_master
   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured
-  USE xios, ONLY: xios_send_field
+  USE lmdz_xios, ONLY: xios_send_field
   USE print_control_mod, ONLY: prt_level,lunout
 
@@ -1468,5 +1445,5 @@
                                 is_sequential, klon_mpi_begin, klon_mpi_end, &
                                 jj_nb, klon_mpi, is_master
-  USE xios, ONLY: xios_send_field
+  USE lmdz_xios, ONLY: xios_send_field
   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured
   USE print_control_mod, ONLY: prt_level,lunout
@@ -1551,7 +1528,6 @@
   END SUBROUTINE histwrite3d_xios
 
-#ifdef CPP_XIOS
   SUBROUTINE histwrite0d_xios(field_name, field)
-  USE xios, ONLY: xios_send_field
+  USE lmdz_xios, ONLY: xios_send_field
   USE mod_phys_lmdz_para, ONLY: is_master
   USE print_control_mod, ONLY: prt_level,lunout
@@ -1568,6 +1544,4 @@
 
   END SUBROUTINE histwrite0d_xios
-#endif
-
-#endif
+
 END MODULE iophy
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iophys.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iophys.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iophys.F90	(revision 4727)
@@ -220,5 +220,5 @@
 ! px arrive 
 
-#include "iotd.h"
+      INCLUDE "iotd.h"
 
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iotd_ecrit.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iotd_ecrit.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iotd_ecrit.F90	(revision 4727)
@@ -27,6 +27,6 @@
 ! Commons
 
-#include "netcdf.inc"
-#include "iotd.h"
+      INCLUDE "netcdf.inc"
+      INCLUDE "iotd.h"
 
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iotd_fin.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iotd_fin.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iotd_fin.F90	(revision 4727)
@@ -14,6 +14,6 @@
 
 
-#include "netcdf.inc"
-#include "iotd.h"
+      INCLUDE "netcdf.inc"
+      INCLUDE "iotd.h"
       integer ierr
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iotd_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iotd_ini.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/iotd_ini.F90	(revision 4727)
@@ -16,6 +16,6 @@
 !   -------------
 
-#include "netcdf.inc"
-#include "iotd.h"
+      INCLUDE "netcdf.inc"
+      INCLUDE "iotd.h"
 
 !   Arguments:
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/limit_read_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/limit_read_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/limit_read_mod.F90	(revision 4727)
@@ -36,7 +36,6 @@
   USE surface_data
   USE mod_phys_lmdz_para
-#ifdef CPP_XIOS
-  USE XIOS
-#endif
+  USE lmdz_xios
+
   IMPLICIT NONE
     INTEGER, INTENT(IN) :: first_day
@@ -45,7 +44,5 @@
     IF ( type_ocean /= 'couple') THEN
       IF (grid_type==unstructured) THEN
-#ifdef CPP_XIOS
         IF (is_omp_master) CALL xios_set_file_attr("limit_read",enabled=.TRUE.,record_offset=first_day)
-#endif
       ENDIF  
     ENDIF
@@ -172,7 +169,5 @@
     USE phys_cal_mod, ONLY : calend, year_len
     USE print_control_mod, ONLY: lunout, prt_level
-#ifdef CPP_XIOS
-    USE XIOS, ONLY: xios_recv_field
-#endif
+    USE lmdz_xios, ONLY: xios_recv_field, using_xios
     
     IMPLICIT NONE
@@ -297,5 +292,4 @@
       IF (grid_type==unstructured) THEN
 
-#ifdef CPP_XIOS
         IF ( type_ocean /= 'couple') THEN
 
@@ -331,6 +325,4 @@
           CALL Scatter_omp(rug_mpi, rugos)
        END IF
-#endif
-
  
      ELSE      ! grid_type==regular
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_atke_exchange_coeff.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_atke_exchange_coeff.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_atke_exchange_coeff.F90	(revision 4727)
@@ -0,0 +1,463 @@
+module lmdz_atke_exchange_coeff
+
+implicit none
+
+contains 
+
+subroutine atke_compute_km_kh(ngrid,nlay,dtime, &
+                        wind_u,wind_v,temp,qvap,play,pinterf,cdrag_uv, &
+                        tke,Km_out,Kh_out)
+
+!========================================================================
+! Routine that computes turbulent Km / Kh coefficients with a
+! 1.5 order closure scheme (TKE) with or without stationarity assumption
+!
+! This parameterization has been constructed in the framework of a
+! collective and collaborative workshop, 
+! the so-called 'Atelier TKE (ATKE)' with
+! K. Arjdal, L. Raillard, C. Dehondt, P. Tiengou, A. Spiga, F. Cheruy, T Dubos, 
+! M. Coulon-Decorzens, S. Fromang, G. Riviere, A. Sima, F. Hourdin, E. Vignon
+!
+! Main assumptions of the model :
+! (1) horizontal homogeneity (Dx=Dy=0.)
+!=======================================================================
+
+
+
+USE lmdz_atke_turbulence_ini, ONLY : iflag_atke, kappa, l0, ric, cinf, rpi, rcpd, atke_ok_virtual
+USE lmdz_atke_turbulence_ini, ONLY : cepsilon, pr_slope, pr_asym, pr_neut, ctkes,rg, rd, rv, atke_ok_vdiff
+USE lmdz_atke_turbulence_ini, ONLY : viscom, viscoh, clmix, clmixshear, iflag_atke_lmix, lmin, smmin
+
+implicit none
+
+
+! Declarations:
+!=============
+
+INTEGER, INTENT(IN) :: ngrid ! number of horizontal index (flat grid)
+INTEGER, INTENT(IN) :: nlay  ! number of vertical index  
+
+REAL, INTENT(IN)    :: dtime ! physics time step (s)
+REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: wind_u   ! zonal velocity (m/s)
+REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: wind_v   ! meridional velocity (m/s)
+REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: temp   ! temperature (K)
+REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: qvap   ! specific humidity (kg/kg)
+REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: play   ! pressure (Pa)
+REAL, DIMENSION(ngrid,nlay+1), INTENT(IN)     :: pinterf   ! pressure at interfaces(Pa)
+REAL, DIMENSION(ngrid), INTENT(IN)            :: cdrag_uv   ! surface drag coefficient for momentum
+
+REAL, DIMENSION(ngrid,nlay+1), INTENT(INOUT)  :: tke  ! turbulent kinetic energy at interface between layers
+
+REAL, DIMENSION(ngrid,nlay), INTENT(OUT)      :: Km_out   ! output: Exchange coefficient for momentum at interface between layers
+REAL, DIMENSION(ngrid,nlay), INTENT(OUT)      :: Kh_out   ! output: Exchange coefficient for heat flux at interface between layers
+
+! Local variables
+REAL, DIMENSION(ngrid,nlay+1) :: Km          ! Exchange coefficient for momentum at interface between layers
+REAL, DIMENSION(ngrid,nlay+1) :: Kh          ! Exchange coefficient for heat flux at interface between layers
+REAL, DIMENSION(ngrid,nlay)   :: theta       ! Potential temperature
+REAL, DIMENSION(ngrid,nlay+1) :: l_exchange  ! Length of exchange (at interface)
+REAL, DIMENSION(ngrid,nlay+1) :: z_interf    ! Altitude at the interface
+REAL, DIMENSION(ngrid,nlay)   :: z_lay       ! Altitude of layers
+REAL, DIMENSION(ngrid,nlay)   :: dz_interf   ! distance between two consecutive interfaces
+REAL, DIMENSION(ngrid,nlay)   :: dz_lay      ! distance between two layer middles (NB: first and last are half layers)
+REAL, DIMENSION(ngrid,nlay+1) :: N2          ! square of Brunt Vaisala pulsation (at interface)
+REAL, DIMENSION(ngrid,nlay+1) :: shear2      ! square of wind shear (at interface)
+REAL, DIMENSION(ngrid,nlay+1) :: Ri          ! Richardson's number (at interface)
+REAL, DIMENSION(ngrid,nlay+1) :: Prandtl     ! Turbulent Prandtl's number (at interface)
+REAL, DIMENSION(ngrid,nlay+1) :: Sm          ! Stability function for momentum (at interface)
+REAL, DIMENSION(ngrid,nlay+1) :: Sh          ! Stability function for heat (at interface)
+
+INTEGER :: igrid,ilay ! horizontal,vertical index (flat grid)
+REAL    :: cn,Ri0,Ri1    ! parameter for Sm stability function and Prandlt
+REAL    :: preff      ! reference pressure for potential temperature calculations
+REAL    :: thetam     ! mean potential temperature at interface
+REAL    :: delta      ! discriminant of the second order polynomial
+REAL    :: qq         ! tke=qq**2/2
+REAL    :: shear      ! wind shear
+REAL    :: lstrat     ! mixing length depending on local stratification
+REAL    :: taustrat   ! caracteristic timescale for turbulence in very stable conditions
+REAL    :: netloss    ! net loss term of tke
+REAL    :: netsource  ! net source term of tke
+REAL    :: ustar      ! friction velocity estimation
+REAL    :: invtau     
+REAL    :: rvap
+
+! Initializations:
+!================
+
+DO igrid=1,ngrid
+    dz_interf(igrid,1) = 0.0
+    z_interf(igrid,1) = 0.0
+END DO
+
+! Calculation of potential temperature: (if vapor -> virtual potential temperature)
+!=====================================
+
+preff=100000.
+! results should not depend on the choice of preff
+DO ilay=1,nlay
+     DO igrid = 1, ngrid
+        theta(igrid,ilay)=temp(igrid,ilay)*(preff/play(igrid,ilay))**(rd/rcpd)
+     END DO
+END DO
+
+! account for water vapor mass for buoyancy calculation
+IF (atke_ok_virtual) THEN
+  DO ilay=1,nlay
+     DO igrid = 1, ngrid
+        rvap=max(0.,qvap(igrid,ilay)/(1.-qvap(igrid,ilay)))
+        theta(igrid,ilay)=theta(igrid,ilay)*(1.+rvap/(RD/RV))/(1.+rvap)
+     END DO
+  END DO
+ENDIF
+
+
+! Calculation of altitude of layers' middle and bottom interfaces:
+!=================================================================
+
+DO ilay=2,nlay+1
+    DO igrid=1,ngrid
+        dz_interf(igrid,ilay-1) = rd*temp(igrid,ilay-1)/rg/play(igrid,ilay-1)*(pinterf(igrid,ilay-1)-pinterf(igrid,ilay))
+        z_interf(igrid,ilay) = z_interf(igrid,ilay-1) + dz_interf(igrid,ilay-1)
+    ENDDO
+ENDDO
+
+DO ilay=1,nlay
+   DO igrid=1,ngrid 
+      z_lay(igrid,ilay)=0.5*(z_interf(igrid, ilay+1) + z_interf(igrid, ilay))
+   ENDDO
+ENDDO
+
+
+! Computes the gradient Richardson's number and stability functions:
+!===================================================================
+
+! calculation of cn = Sm value at Ri=0
+! direct dependance on cepsilon to guarantee Fm=1 (first-order like stability function) at Ri=0
+cn=(1./sqrt(cepsilon))**(2/3)
+! calculation of Ri0 such that continuity in slope of Sm at Ri=0
+Ri0=2./rpi*(cinf - cn)*ric/cn
+! calculation of Ri1 to guarantee continuity in slope of Prandlt number at Ri=0
+Ri1 = -2./rpi * (pr_asym - pr_neut) 
+
+
+DO ilay=2,nlay
+    DO igrid=1,ngrid
+        dz_lay(igrid,ilay)=z_lay(igrid,ilay)-z_lay(igrid,ilay-1)
+        thetam=0.5*(theta(igrid,ilay) + theta(igrid,ilay-1))
+        N2(igrid,ilay) = rg * (theta(igrid,ilay) - theta(igrid,ilay-1))/thetam / dz_lay(igrid,ilay)
+        shear2(igrid,ilay)= (((wind_u(igrid,ilay) - wind_u(igrid,ilay-1)) / dz_lay(igrid,ilay))**2 + &
+            ((wind_v(igrid,ilay) - wind_v(igrid,ilay-1)) / dz_lay(igrid,ilay))**2 )
+        Ri(igrid,ilay) = N2(igrid,ilay) / MAX(shear2(igrid,ilay),1E-10) 
+        
+        IF (Ri(igrid,ilay) < 0.) THEN ! unstable cases
+            Sm(igrid,ilay) = 2./rpi * (cinf-cn) * atan(-Ri(igrid,ilay)/Ri0) + cn
+            Prandtl(igrid,ilay) = -2./rpi * (pr_asym - pr_neut) * atan(Ri(igrid,ilay)/Ri1) + pr_neut 
+        ELSE ! stable cases
+            Sm(igrid,ilay) = max(smmin,cn*(1.-Ri(igrid,ilay)/Ric))
+            ! prandlt expression from venayagamoorthy and stretch 2010, Li et al 2019
+            Prandtl(igrid,ilay) = pr_neut*exp(-pr_slope/pr_neut*Ri(igrid,ilay)+Ri(igrid,ilay)/pr_neut) &
+                                + Ri(igrid,ilay) * pr_slope
+            IF (Ri(igrid,ilay) .GE. Prandtl(igrid,ilay)) THEN
+               call abort_physic("atke_compute_km_kh", &
+               'Ri>=Pr in stable conditions -> violates energy conservation principles, change pr_neut or slope', 1)
+            ENDIF
+        END IF
+        
+        Sh(igrid,ilay) = Sm(igrid,ilay) / Prandtl(igrid,ilay)
+
+    ENDDO
+ENDDO
+
+
+! Computing the mixing length:
+!==============================================================
+
+
+IF (iflag_atke_lmix .EQ. 1 ) THEN
+
+   DO ilay=2,nlay
+      DO igrid=1,ngrid
+          l_exchange(igrid,ilay) = kappa*l0*z_interf(igrid,ilay) / (kappa*z_interf(igrid,ilay) + l0)
+          IF (N2(igrid,ilay) .GT. 0.) THEN
+             lstrat=clmix*sqrt(tke(igrid,ilay))/sqrt(N2(igrid,ilay))
+             lstrat=max(lstrat,lmin)
+             !Inverse interpolation, Van de Wiel et al. 2010
+             l_exchange(igrid,ilay)=(1./(l_exchange(igrid,ilay))+1./(lstrat))**(-1.0)
+          ENDIF 
+      ENDDO
+   ENDDO
+
+ELSE IF (iflag_atke_lmix .EQ. 2 ) THEN
+! add effect of wind shear on lstrat following grisogono and belusic 2008, qjrms
+DO ilay=2,nlay
+      DO igrid=1,ngrid
+          l_exchange(igrid,ilay) = kappa*l0*z_interf(igrid,ilay) / (kappa*z_interf(igrid,ilay) + l0)
+          IF (N2(igrid,ilay) .GT. 0. .AND. shear2(igrid,ilay) .GT. 0.) THEN
+             lstrat=min(clmix*sqrt(tke(igrid,ilay))/sqrt(N2(igrid,ilay)), &
+                    clmixshear*sqrt(tke(igrid,ilay))/sqrt(shear2(igrid,ilay)))
+             lstrat=max(lstrat,lmin)
+             !Inverse interpolation, Van de Wiel et al. 2010   
+             l_exchange(igrid,ilay)=(1./(l_exchange(igrid,ilay))+1./(lstrat))**(-1.0)
+          ENDIF
+      ENDDO
+   ENDDO
+
+ELSE IF (iflag_atke_lmix .EQ. 3 ) THEN
+! add effect of wind shear on lstrat following grisogono 2010, qjrms
+DO ilay=2,nlay
+      DO igrid=1,ngrid
+          l_exchange(igrid,ilay) = kappa*l0*z_interf(igrid,ilay) / (kappa*z_interf(igrid,ilay) + l0)
+          IF (N2(igrid,ilay) .GT. 0. .AND. shear2(igrid,ilay) .GT. 0.) THEN
+             lstrat=clmix*sqrt(tke(igrid,ilay))/sqrt(shear2(igrid,ilay))*(1.0+Ri(igrid,ilay)/(2.*Prandtl(igrid,ilay)))
+             lstrat=max(lstrat,lmin)
+             !Inverse interpolation, Van de Wiel et al. 2010   
+             l_exchange(igrid,ilay)=(1./(l_exchange(igrid,ilay))+1./(lstrat))**(-1.0)
+          ENDIF
+      ENDDO
+   ENDDO
+
+
+
+ELSE
+! default: neglect effect of local stratification and shear
+
+   DO ilay=2,nlay+1
+      DO igrid=1,ngrid
+          l_exchange(igrid,ilay) = kappa*l0*z_interf(igrid,ilay) / (kappa*z_interf(igrid,ilay) + l0)
+      ENDDO
+
+   ENDDO
+ENDIF
+
+
+! Computing the TKE k>=2:
+!========================
+IF (iflag_atke == 0) THEN
+
+! stationary solution (dtke/dt=0)
+
+   DO ilay=2,nlay
+        DO igrid=1,ngrid
+            tke(igrid,ilay) = cepsilon * l_exchange(igrid,ilay)**2 * Sm(igrid,ilay) * &
+            shear2(igrid,ilay) * (1. - Ri(igrid,ilay) / Prandtl(igrid,ilay))
+        ENDDO
+    ENDDO
+
+ELSE IF (iflag_atke == 1) THEN
+
+! full implicit scheme resolved with a second order polynomial equation
+
+    DO ilay=2,nlay
+        DO igrid=1,ngrid
+           qq=max(sqrt(2.*tke(igrid,ilay)),1.e-10)
+           delta=(2.*sqrt(2.)*cepsilon*l_exchange(igrid,ilay)/dtime)**2. &
+                 +4.*(2.*sqrt(2.)*cepsilon*l_exchange(igrid,ilay)/dtime*qq + &
+                 2.*l_exchange(igrid,ilay)*l_exchange(igrid,ilay)*cepsilon*Sm(igrid,ilay) &
+                 *shear2(igrid,ilay) * (1. - Ri(igrid,ilay) / Prandtl(igrid,ilay)))
+           qq=(-2.*sqrt(2.)*cepsilon*l_exchange(igrid,ilay)/dtime + sqrt(delta))/2.
+           qq=max(0.,qq)
+           tke(igrid,ilay)=0.5*(qq**2) 
+        ENDDO
+    ENDDO
+
+
+ELSE IF (iflag_atke == 2) THEN
+
+! semi implicit scheme when l does not depend on tke
+! positive-guaranteed if pr slope in stable condition >1
+
+   DO ilay=2,nlay
+        DO igrid=1,ngrid
+           qq=max(sqrt(2.*tke(igrid,ilay)),1.e-10)
+           qq=(qq+l_exchange(igrid,ilay)*Sm(igrid,ilay)*dtime/sqrt(2.)      & 
+               *shear2(igrid,ilay)*(1.-Ri(igrid,ilay)/Prandtl(igrid,ilay))) &
+               /(1.+qq*dtime/(cepsilon*l_exchange(igrid,ilay)*2.*sqrt(2.))) 
+           tke(igrid,ilay)=0.5*(qq**2) 
+        ENDDO
+    ENDDO
+
+
+ELSE IF (iflag_atke == 3) THEN
+! numerical resolution adapted from that in MAR (Deleersnijder 1992)
+! positively defined by construction
+
+    DO ilay=2,nlay
+        DO igrid=1,ngrid
+           qq=max(sqrt(2.*tke(igrid,ilay)),1.e-10)
+           IF (Ri(igrid,ilay) .LT. 0.) THEN
+              netloss=qq/(2.*sqrt(2.)*cepsilon*l_exchange(igrid,ilay))
+              netsource=l_exchange(igrid,ilay)*Sm(igrid,ilay)/sqrt(2.)*shear2(igrid,ilay)*(1.-Ri(igrid,ilay)/Prandtl(igrid,ilay))
+           ELSE
+              netloss=qq/(2.*sqrt(2.)*cepsilon*l_exchange(igrid,ilay))+ &
+                      l_exchange(igrid,ilay)*Sm(igrid,ilay)/sqrt(2.)*N2(igrid,ilay)/Prandtl(igrid,ilay)
+              netsource=l_exchange(igrid,ilay)*Sm(igrid,ilay)/sqrt(2.)*shear2(igrid,ilay)
+           ENDIF
+           qq=((qq**2)/dtime+qq*netsource)/(qq/dtime+netloss)
+           tke(igrid,ilay)=0.5*(qq**2)
+        ENDDO
+    ENDDO
+
+ELSE IF (iflag_atke == 4) THEN
+! semi implicit scheme from Arpege (V. Masson methodology with 
+! Taylor expansion of the dissipation term)
+    DO ilay=2,nlay
+        DO igrid=1,ngrid
+           qq=max(sqrt(2.*tke(igrid,ilay)),1.e-10)
+           qq=(l_exchange(igrid,ilay)*Sm(igrid,ilay)/sqrt(2.)*shear2(igrid,ilay)*(1.-Ri(igrid,ilay)/Prandtl(igrid,ilay)) &
+             +qq*(1.+dtime*qq/(cepsilon*l_exchange(igrid,ilay)*2.*sqrt(2.)))) &
+             /(1.+2.*qq*dtime/(cepsilon*l_exchange(igrid,ilay)*2.*sqrt(2.)))
+           qq=max(0.,qq)
+           tke(igrid,ilay)=0.5*(qq**2)
+        ENDDO
+    ENDDO
+
+
+ELSE
+   call abort_physic("atke_compute_km_kh", &
+        'numerical treatment of TKE not possible yet', 1)
+
+END IF
+
+! We impose a 0 tke at nlay+1
+!==============================
+
+DO igrid=1,ngrid
+ tke(igrid,nlay+1)=0.
+END DO
+
+
+! Calculation of surface TKE (k=1)
+!=================================
+! surface TKE calculation inspired from what is done in Arpege (see E. Bazile note)
+DO igrid=1,ngrid
+ ustar=sqrt(cdrag_uv(igrid)*(wind_u(igrid,1)**2+wind_v(igrid,1)**2))
+ tke(igrid,1)=ctkes*(ustar**2)
+END DO
+
+
+! vertical diffusion of TKE 
+!==========================
+IF (atke_ok_vdiff) THEN
+   CALL atke_vdiff_tke(ngrid,nlay,dtime,z_lay,z_interf,temp,play,l_exchange,Sm,tke)
+ENDIF
+
+
+! Computing eddy diffusivity coefficients:
+!========================================
+DO ilay=2,nlay ! TODO: also calculate for nlay+1 ?
+    DO igrid=1,ngrid
+        ! we add the molecular viscosity to Km,h 
+        Km(igrid,ilay) = viscom + l_exchange(igrid,ilay) * Sm(igrid,ilay) * tke(igrid,ilay)**0.5
+        Kh(igrid,ilay) = viscoh + l_exchange(igrid,ilay) * Sh(igrid,ilay) * tke(igrid,ilay)**0.5
+    END DO
+END DO
+
+! for output:
+!===========
+Km_out(1:ngrid,2:nlay)=Km(1:ngrid,2:nlay)
+Kh_out(1:ngrid,2:nlay)=Kh(1:ngrid,2:nlay)
+
+end subroutine atke_compute_km_kh
+
+!===============================================================================================
+subroutine atke_vdiff_tke(ngrid,nlay,dtime,z_lay,z_interf,temp,play,l_exchange,Sm,tke)
+
+! routine that computes the vertical diffusion of TKE by the turbulence
+! using an implicit resolution (See note by Dufresne and Ghattas (2009))
+! E Vignon, July 2023
+
+USE lmdz_atke_turbulence_ini, ONLY : rd, cke, viscom
+
+
+INTEGER, INTENT(IN) :: ngrid ! number of horizontal index (flat grid)
+INTEGER, INTENT(IN) :: nlay  ! number of vertical index  
+
+REAL, INTENT(IN)    :: dtime ! physics time step (s)
+REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: z_lay   ! altitude of mid-layers (m)
+REAL, DIMENSION(ngrid,nlay+1), INTENT(IN)       :: z_interf   ! altitude of bottom interfaces (m)
+REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: temp   ! temperature (K)
+REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: play   ! pressure (Pa)
+REAL, DIMENSION(ngrid,nlay+1), INTENT(IN)     :: l_exchange     ! mixing length at interfaces between layers
+REAL, DIMENSION(ngrid,nlay+1), INTENT(IN)     :: Sm     ! stability function for eddy diffusivity for momentum at interface between layers
+
+REAL, DIMENSION(ngrid,nlay+1), INTENT(INOUT)  :: tke    ! turbulent kinetic energy at interface between layers
+
+
+
+INTEGER                                       :: igrid,ilay
+REAL, DIMENSION(ngrid,nlay+1)                 :: Ke     ! eddy diffusivity for TKE
+REAL, DIMENSION(ngrid,nlay+1)                 :: dtke
+REAL, DIMENSION(ngrid,nlay+1)                 :: ak, bk, ck, CCK, DDK
+REAL                                          :: gammak,Kem,KKb,KKt
+
+
+! Few initialisations
+CCK(:,:)=0.
+DDK(:,:)=0.
+dtke(:,:)=0.
+
+
+! Eddy diffusivity for TKE
+
+DO ilay=2,nlay
+    DO igrid=1,ngrid
+       Ke(igrid,ilay)=(viscom+l_exchange(igrid,ilay)*Sm(igrid,ilay)*sqrt(tke(igrid,ilay)))*cke 
+    ENDDO
+ENDDO
+! at the top of the atmosphere set to 0
+Ke(:,nlay+1)=0.
+! at the surface, set it equal to that at the first model level
+Ke(:,1)=Ke(:,2)
+
+
+! calculate intermediary variables
+
+DO ilay=2,nlay 
+    DO igrid=1,ngrid
+    Kem=0.5*(Ke(igrid,ilay+1)+Ke(igrid,ilay))    
+    KKt=Kem*play(igrid,ilay)/rd/temp(igrid,ilay)/(z_interf(igrid,ilay+1)-z_interf(igrid,ilay))
+    Kem=0.5*(Ke(igrid,ilay)+Ke(igrid,ilay-1))
+    KKb=Kem*play(igrid,ilay-1)/rd/temp(igrid,ilay-1)/(z_interf(igrid,ilay)-z_interf(igrid,ilay-1))
+    gammak=1./(z_lay(igrid,ilay)-z_lay(igrid,ilay-1))
+    ak(igrid,ilay)=-gammak*dtime*KKb
+    ck(igrid,ilay)=-gammak*dtime*KKt
+    bk(igrid,ilay)=1.+gammak*dtime*(KKt+KKb)
+    ENDDO
+ENDDO
+
+! calculate CCK and DDK coefficients
+! downhill phase
+
+DO igrid=1,ngrid
+  CCK(igrid,nlay)=tke(igrid,nlay)/bk(igrid,nlay)
+  DDK(igrid,nlay)=-ak(igrid,nlay)/bk(igrid,nlay)
+ENDDO
+
+
+DO ilay=nlay-1,2,-1
+    DO igrid=1,ngrid
+        CCK(igrid,ilay)=(tke(igrid,ilay)/bk(igrid,ilay)-ck(igrid,ilay)/bk(igrid,ilay)*CCK(igrid,ilay+1)) &
+                       / (1.+ck(igrid,ilay)/bk(igrid,ilay)*DDK(igrid,ilay+1))
+        DDK(igrid,ilay)=-ak(igrid,ilay)/bk(igrid,ilay)/(1+ck(igrid,ilay)/bk(igrid,ilay)*DDK(igrid,ilay+1))
+    ENDDO
+ENDDO
+
+! calculate TKE
+! uphill phase
+
+DO ilay=2,nlay+1
+    DO igrid=1,ngrid
+        dtke(igrid,ilay)=CCK(igrid,ilay)+DDK(igrid,ilay)*tke(igrid,ilay-1)-tke(igrid,ilay)
+    ENDDO
+ENDDO
+
+! update TKE
+tke(:,:)=tke(:,:)+dtke(:,:)
+
+
+end subroutine atke_vdiff_tke
+
+
+
+end module lmdz_atke_exchange_coeff
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_atke_turbulence_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_atke_turbulence_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_atke_turbulence_ini.F90	(revision 4727)
@@ -0,0 +1,141 @@
+MODULE lmdz_atke_turbulence_ini
+
+implicit none
+
+save
+
+integer :: iflag_atke, iflag_num_atke, iflag_atke_lmix
+  !$OMP THREADPRIVATE(iflag_atke, iflag_num_atke, iflag_atke_lmix)
+  real :: kappa = 0.4 ! Von Karman constant
+  !$OMP THREADPRIVATE(kappa)
+  real :: l0,ric,ri0,cinf,cepsilon,pr_slope,pr_asym,pr_neut,clmix,clmixshear,smmin,ctkes,cke
+  !$OMP THREADPRIVATE(l0,ric,cinf,cepsilon,pr_slope,pr_asym,pr_neut,clmix,clmixshear,smmin,ctkes,cke)
+  integer :: lunout,prt_level
+  !$OMP THREADPRIVATE(lunout,prt_level)
+  real :: rg, rd, rpi, rcpd, rv
+  !$OMP THREADPRIVATE(rg, rd, rpi, rcpd, rv)
+
+  real :: viscom, viscoh
+  !$OMP THREADPRIVATE(viscom,viscoh)
+
+  real :: lmin=0.01              ! minimum mixing length
+  !$OMP THREADPRIVATE(lmin)
+
+  logical :: atke_ok_vdiff, atke_ok_virtual
+  !$OMP THREADPRIVATE(atke_ok_vdiff,atke_ok_virtual)
+
+CONTAINS
+
+SUBROUTINE atke_ini(prt_level_in, lunout_in, rg_in, rd_in, rpi_in, rcpd_in, rv_in)
+
+   USE ioipsl_getin_p_mod, ONLY : getin_p
+
+  integer, intent(in) :: lunout_in,prt_level_in
+  real, intent(in) :: rg_in, rd_in, rpi_in, rcpd_in, rv_in
+
+
+  lunout=lunout_in
+  prt_level=prt_level_in
+  rd=rd_in
+  rg=rg_in
+  rpi=rpi_in
+  rcpd=rcpd_in
+  rv=rv_in
+
+  viscom=1.46E-5
+  viscoh=2.06E-5
+
+  ! flag that controls options in atke_compute_km_kh
+  iflag_atke=0
+  CALL getin_p('iflag_atke',iflag_atke)
+
+  ! flag that controls the calculation of mixing length in atke
+  iflag_atke_lmix=0
+  CALL getin_p('iflag_atke_lmix',iflag_atke_lmix)
+
+  if (iflag_atke .eq. 0 .and. iflag_atke_lmix>0) then
+        call abort_physic("atke_turbulence_ini", &
+        'stationary scheme must use mixing length formulation not depending on tke', 1)
+  endif
+
+  ! activate vertical diffusion of TKE or not
+  atke_ok_vdiff=.false.
+  CALL getin_p('atke_ok_vdiff',atke_ok_vdiff)
+
+
+  ! account for vapor for flottability
+  atke_ok_virtual=.true.
+  CALL getin_p('atke_ok_virtual',atke_ok_virtual)
+
+
+  ! 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 in neutral conditions [m]
+  ! Sun et al 2011, JAMC 
+  ! between 10 and 40
+
+  l0=15.0 
+  CALL getin_p('atke_l0',l0)
+
+  ! critical Richardson number 
+  ric=0.25
+  CALL getin_p('atke_ric',ric)
+
+  ! asymptotic value of Sm for Ri=-Inf
+  cinf=1.5
+  CALL getin_p('atke_cinf',cinf)
+
+  ! constant for tke dissipation calculation
+  cepsilon=5.87 ! default value as in yamada4
+  CALL getin_p('atke_cepsilon',cepsilon)
+
+
+ ! coefficient for surface TKE 
+ ! following Lenderink & Holtslag 2004, ctkes=(cepsilon)**(2/3)
+ ! (provided by limit condition in neutral conditions)
+  ctkes=(cepsilon)**(2./3.)
+
+  ! slope of Pr=f(Ri) for stable conditions
+  pr_slope=5.0 ! default value from Zilitinkevich et al. 2005
+  CALL getin_p('atke_pr_slope',pr_slope)
+  if (pr_slope .le. 1) then
+        call abort_physic("atke_turbulence_ini", &
+        'pr_slope has to be greater than 1 for consistency of the tke scheme', 1)
+  endif
+
+  ! asymptotic turbulent prandt number value for Ri=-Inf
+  pr_asym=0.4
+  CALL getin_p('atke_pr_asym',pr_asym)
+
+  ! value of turbulent prandtl number in neutral conditions (Ri=0)
+  pr_neut=0.8
+  CALL getin_p('atke_pr_neut',pr_neut)
+
+  ! coefficient for mixing length depending on local stratification
+  clmix=0.5
+  CALL getin_p('atke_clmix',clmix)
+ 
+  ! coefficient for mixing length depending on local wind shear
+  clmixshear=0.5
+  CALL getin_p('atke_clmixshear',clmixshear)
+
+
+  ! minimum anisotropy coefficient (defined here as minsqrt(Ez/Ek)) at large Ri. 
+  ! From Zilitinkevich et al. 2013, it equals sqrt(0.03)~0.17
+  
+  smmin=0.17
+  CALL getin_p('atke_smmin',smmin)
+
+
+  ! ratio between the eddy diffusivity coeff for tke wrt that for momentum
+  ! default value from Lenderink et al. 2004
+  cke=2.
+  CALL getin_p('atke_cke',cke)
+
+ RETURN
+
+END SUBROUTINE atke_ini
+
+END MODULE  lmdz_atke_turbulence_ini
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_blowing_snow_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_blowing_snow_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_blowing_snow_ini.F90	(revision 4727)
@@ -0,0 +1,82 @@
+module lmdz_blowing_snow_ini
+
+implicit none
+
+save
+   integer :: prt_level=0,lunout
+   real RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT,RD,RG
+   real coef_eva_bs, expo_eva_bs, fallv_bs, zeta_bs
+   real prt_bs, pbst_bs, qbst_bs
+   integer :: iflag_saltation_bs
+
+   !$OMP THREADPRIVATE(prt_level, lunout)
+   !$OMP THREADPRIVATE(RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT,RD,RG)
+   !$OMP THREADPRIVATE(coef_eva_bs, expo_eva_bs, fallv_bs, zeta_bs)
+   !$OMP THREADPRIVATE(pbst_bs, prt_bs, qbst_bs)
+   !$OMP THREADPRIVATE(iflag_saltation_bs)
+
+    real tbsmelt                  ! parameter to calculate melting fraction of BS sedimentation
+    parameter (tbsmelt=278.15)
+
+    real taumeltbs0               ! Melting time scale of blowing snow at 273.15K
+    parameter (taumeltbs0=1800.0)
+
+    real qbsmin                   ! Minimum blowing snow specific content
+    parameter (qbsmin=1.E-10)
+
+
+      contains
+
+      subroutine blowing_snow_ini(prt_level_in,lunout_in, &
+                                  RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in,&
+                                  RVTMP2_in, RTT_in,RD_in,RG_in)
+
+         USE ioipsl_getin_p_mod, ONLY : getin_p
+
+         integer, intent(in) :: prt_level_in,lunout_in
+         real, intent(in) :: RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in
+         real, intent(in) ::  RVTMP2_in, RTT_in, RD_in, RG_in
+
+
+         prt_level=prt_level_in
+         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
+         lunout=lunout_in
+
+
+         qbst_bs= 0.001
+         CALL getin_p('qbst_bs',qbst_bs)
+
+         pbst_bs= 0.0003
+         CALL getin_p('pbst_bs',pbst_bs)
+
+         prt_bs= 0.0003
+         CALL getin_p('prt_bs',prt_bs)
+
+
+         zeta_bs= 3.
+         CALL getin_p('zeta_bs',zeta_bs)
+
+         fallv_bs = 0.1
+         CALL getin_p('fallv_bs',fallv_bs)
+
+         coef_eva_bs =  2.e-5 
+         CALL getin_p('coef_eva_bs',coef_eva_bs)
+
+         expo_eva_bs = 0.5
+         CALL getin_p('expo_eva_bs',expo_eva_bs)
+
+         iflag_saltation_bs=0
+         CALL getin_p('iflag_saltation_bs',iflag_saltation_bs)
+
+
+      end subroutine blowing_snow_ini
+
+end module lmdz_blowing_snow_ini
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_blowing_snow_sublim_sedim.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_blowing_snow_sublim_sedim.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_blowing_snow_sublim_sedim.F90	(revision 4727)
@@ -0,0 +1,252 @@
+module lmdz_blowing_snow_sublim_sedim
+
+contains
+subroutine blowing_snow_sublim_sedim(ngrid,nlay,dtime,temp,qv,qbs,pplay,paprs,dtemp_bs,dq_bs,dqbs_bs,bsfl,precip_bs)
+
+!==============================================================================
+! Routine that calculates the evaporation and sedimentation of blowing snow
+! inspired by what is done in lscp_mod
+! Etienne Vignon, October 2022
+!==============================================================================
+
+
+use lmdz_blowing_snow_ini, only : coef_eva_bs,RTT,RD,RG,expo_eva_bs, fallv_bs, qbsmin
+use lmdz_blowing_snow_ini, only : RCPD, RLSTT, RLMLT, RLVTT, RVTMP2, tbsmelt, taumeltbs0
+USE lmdz_lscp_tools, only : calc_qsat_ecmwf
+
+implicit none
+
+
+!++++++++++++++++++++++++++++++++++++++++++++++++++++
+! Declarations
+!++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+!INPUT
+!=====
+
+integer, intent(in)                     :: ngrid,nlay
+real, intent(in)                        :: dtime
+real, intent(in), dimension(ngrid,nlay) :: temp
+real, intent(in), dimension(ngrid,nlay) :: qv
+real, intent(in), dimension(ngrid,nlay) :: qbs
+real, intent(in), dimension(ngrid,nlay) :: pplay
+real, intent(in), dimension(ngrid,nlay+1) :: paprs
+
+
+
+! OUTPUT
+!========
+
+
+real, intent(out), dimension(ngrid,nlay) :: dtemp_bs
+real, intent(out), dimension(ngrid,nlay) :: dq_bs
+real, intent(out), dimension(ngrid,nlay) :: dqbs_bs
+real, intent(out), dimension(ngrid,nlay+1) :: bsfl
+real, intent(out), dimension(ngrid)      :: precip_bs
+
+
+! LOCAL
+!======
+
+
+integer                                  :: k,i,n
+real                                     :: zqev0, zqevi, zqevti, zcpair, zcpeau, dqbsmelt
+real                                     :: dqsedim,precbs, deltaqchaud, zmelt, taumeltbs
+real                                     :: maxdeltaqchaud
+real, dimension(ngrid)                   :: zt,zq,zqbs,qsi,dqsi,qsl, dqsl,qzero,sedim,sedimn
+real, dimension(ngrid)                   :: zqbsi,zmqc, zmair, zdz
+real, dimension(ngrid,nlay)              :: velo, zrho
+
+!++++++++++++++++++++++++++++++++++++++++++++++++++
+! Initialisation
+!++++++++++++++++++++++++++++++++++++++++++++++++++
+
+qzero(:)=0.
+dtemp_bs(:,:)=0.
+dq_bs(:,:)=0.
+dqbs_bs(:,:)=0.
+velo(:,:)=0.
+zt(:)=0.
+zq(:)=0.
+zqbs(:)=0.
+sedim(:)=0.
+
+! begin of top-down loop
+DO k = nlay, 1, -1
+    
+    DO i=1,ngrid
+        zt(i)=temp(i,k)
+        zq(i)=qv(i,k)
+        zqbs(i)=qbs(i,k)
+    ENDDO
+
+
+    IF (k.LE.nlay-1) THEN
+
+        ! thermalization of blowing snow precip coming from above    
+        DO i = 1, ngrid
+            zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
+            ! RVTMP2=rcpv/rcpd-1
+            zcpair=RCPD*(1.0+RVTMP2*zq(i))
+            zcpeau=RCPD*RVTMP2
+            ! zmqc: precipitation mass that has to be thermalized with 
+            ! layer's air so that precipitation at the ground has the
+            ! same temperature as the lowermost layer
+            zmqc(i) = (sedim(i))*dtime/zmair(i)
+            ! t(i,k+1)+d_t(i,k+1): new temperature of the overlying layer
+            zt(i) = ( (temp(i,k+1)+dtemp_bs(i,k+1))*zmqc(i)*zcpeau + zcpair*zt(i) ) &
+             / (zcpair + zmqc(i)*zcpeau)
+        ENDDO
+    ELSE
+        DO i = 1, ngrid
+            zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
+            zmqc(i) = 0.
+        ENDDO
+
+    ENDIF
+
+
+
+    ! calulation saturation specific humidity
+    CALL CALC_QSAT_ECMWF(ngrid,zt(:),qzero(:),pplay(:,k),RTT,2,.false.,qsi(:),dqsi(:))
+    CALL CALC_QSAT_ECMWF(ngrid,zt(:),qzero(:),pplay(:,k),RTT,1,.false.,qsl(:),dqsl(:))
+    ! sublimation calculation
+    ! SUndqvist formula dP/dz=beta*(1-q/qsat)*sqrt(P)
+    
+    DO i = 1, ngrid
+
+       zrho(i,k)  = pplay(i,k) / zt(i) / RD
+       zdz(i)   = (paprs(i,k)-paprs(i,k+1)) / (zrho(i,k)*RG)
+       ! BS fall velocity
+       velo(i,k) = fallv_bs
+
+
+          IF (zt(i) .GT. RTT) THEN
+             
+             ! if positive celcius temperature, we assume
+             ! that part of the the blowing snow flux melts and evaporates
+             
+             ! vapor, bs, temperature, precip fluxes update
+             zmelt = ((zt(i)-RTT)/(tbsmelt-RTT))
+             zmelt = MIN(MAX(zmelt,0.),1.)
+             sedimn(i)=sedim(i)*zmelt
+             deltaqchaud=-(sedimn(i)-sedim(i))*(RG/(paprs(i,k)-paprs(i,k+1)))*dtime
+             ! max evap such as celcius temperature cannot become negative
+             maxdeltaqchaud= max(RCPD*(1.0+RVTMP2*(zq(i)+zqbs(i)))*(zt(i)-RTT)/(RLMLT+RLVTT),0.)
+
+             deltaqchaud=min(max(deltaqchaud,0.),maxdeltaqchaud)
+             zq(i) = zq(i) + deltaqchaud  
+              
+             ! melting + evaporation
+             zt(i) = zt(i) - deltaqchaud * (RLMLT+RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zqbs(i)))
+
+             sedim(i)=sedimn(i)
+
+             ! if temperature still positive, we assume that part of the blowing snow 
+             ! already present in the mesh melts and evaporates with a typical time 
+             ! constant between taumeltbs0 and 0
+ 
+             IF ( zt(i) .GT. RTT ) THEN
+                taumeltbs=taumeltbs0*exp(-max(0.,(zt(i)-RTT)/(tbsmelt-RTT)))
+                deltaqchaud=min(zqbs(i),zqbs(i)/taumeltbs*dtime)
+                maxdeltaqchaud= max(RCPD*(1.0+RVTMP2*(zq(i)+zqbs(i)))*(zt(i)-RTT)/(RLMLT+RLVTT),0.)
+                deltaqchaud=min(max(deltaqchaud,0.),maxdeltaqchaud)
+                zq(i) = zq(i) + deltaqchaud
+
+                ! melting + evaporation
+                zt(i) = zt(i) - deltaqchaud * (RLMLT+RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zqbs(i)))
+                ! qbs update
+                zqbs(i)=max(zqbs(i)-deltaqchaud,0.)
+             ENDIF
+
+             ! now sedimentation scheme with an exact numerical resolution 
+             ! (correct if fall velocity is constant)
+             zqbsi(i)=zqbs(i)
+             zqbs(i) = zqbsi(i)*exp(-velo(i,k)/zdz(i)*dtime)+sedim(i)/zrho(i,k)/velo(i,k)
+             zqbs(i) = max(zqbs(i),0.)
+
+             ! flux update
+             sedim(i) = sedim(i) + zrho(i,k)*zdz(i)/dtime*(zqbsi(i)-zqbs(i))
+             sedim(i) = max(0.,sedim(i))
+      
+          ELSE 
+              ! negative celcius temperature     
+              ! Sublimation scheme   
+
+              zqevti = coef_eva_bs*(1.0-zq(i)/qsi(i))*(sedim(i)**expo_eva_bs) &
+                    *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+              zqevti = MAX(0.0,MIN(zqevti,sedim(i)))*RG*dtime/(paprs(i,k)-paprs(i,k+1))
+
+              ! Sublimation limit: we ensure that the whole mesh does not exceed saturation wrt ice
+              zqev0 = MAX(0.0, qsi(i)-zq(i))
+              zqevi = MIN(zqev0,zqevti)
+
+              ! New solid precipitation fluxes
+              sedimn(i) = Max(0.,sedim(i) - zqevi*(paprs(i,k)-paprs(i,k+1))/RG/dtime)
+
+
+              ! vapor, temperature, precip fluxes update following sublimation
+              zq(i) = zq(i) - (sedimn(i)-sedim(i))*(RG/(paprs(i,k)-paprs(i,k+1)))*dtime                
+              zq(i) = max(0., zq(i))
+              zt(i) = zt(i)                             &
+                + (sedimn(i)-sedim(i))                      &
+                * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime    &
+                * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zqbs(i)))
+
+               sedim(i)=sedimn(i)
+               zqbsi(i)=zqbs(i)
+
+               ! now sedimentation scheme with an exact numerical resolution 
+               ! (correct if fall velocity is constant)
+
+               zqbs(i) = zqbsi(i)*exp(-velo(i,k)/zdz(i)*dtime)+sedim(i)/zrho(i,k)/velo(i,k)
+               zqbs(i) = max(zqbs(i),0.)
+
+               ! flux update
+               sedim(i) = sedim(i) + zrho(i,k)*zdz(i)/dtime*(zqbsi(i)-zqbs(i))
+               sedim(i) = max(0.,sedim(i))
+
+
+           ENDIF
+
+
+           ! if qbs<qbsmin, sublimate or melt and evaporate qbs
+           ! see Gerber et al. 2023, JGR Atmos for the choice of qbsmin
+           IF (zqbs(i) .LT. qbsmin) THEN                       
+              zq(i) = zq(i)+zqbs(i)
+              IF (zt(i) .LT. RTT) THEN
+                 zt(i) = zt(i) - zqbs(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zqbs(i)))
+              ELSE
+               zt(i) = zt(i) - zqbs(i) * (RLVTT+RLMLT)/RCPD/(1.0+RVTMP2*(zq(i)+zqbs(i)))
+              ENDIF
+              zqbs(i)=0.
+           ENDIF
+
+
+    ENDDO ! loop on ngrid
+
+
+
+
+    ! Outputs:
+    DO i = 1, ngrid
+        bsfl(i,k)=sedim(i)
+        dqbs_bs(i,k) = zqbs(i)-qbs(i,k)
+        dq_bs(i,k) = zq(i) - qv(i,k)
+        dtemp_bs(i,k) = zt(i) - temp(i,k)
+    ENDDO
+
+
+ENDDO ! vertical loop
+
+
+!surface bs flux
+DO i = 1, ngrid
+  precip_bs(i) = sedim(i)
+ENDDO
+
+
+return
+
+end subroutine blowing_snow_sublim_sedim
+end module lmdz_blowing_snow_sublim_sedim
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_call_atke.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_call_atke.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_call_atke.F90	(revision 4727)
@@ -0,0 +1,169 @@
+module lmdz_call_atke
+
+USE lmdz_atke_exchange_coeff, ONLY :  atke_compute_km_kh
+
+implicit none
+
+
+contains
+
+subroutine call_atke(dtime,ngrid,nlay,cdrag_uv,cdrag_t,u_surf,v_surf,temp_surf, &
+                        wind_u,wind_v,temp,qvap,play,pinterf, &
+                        tke,Km_out,Kh_out)
+
+
+
+
+USE lmdz_atke_turbulence_ini, ONLY : iflag_num_atke, rg, rd
+
+implicit none
+
+
+! Declarations:
+!=============
+
+REAL, INTENT(IN)    :: dtime ! timestep (s)
+INTEGER, INTENT(IN) :: ngrid ! number of horizontal index (flat grid)
+INTEGER, INTENT(IN) :: nlay ! number of vertical index  
+
+
+REAL, DIMENSION(ngrid), INTENT(IN)       :: cdrag_uv  ! drag coefficient for wind
+REAL, DIMENSION(ngrid), INTENT(IN)       :: cdrag_t   ! drag coefficient for temperature
+
+REAL, DIMENSION(ngrid), INTENT(IN)       :: u_surf    ! x wind velocity at the surface
+REAL, DIMENSION(ngrid), INTENT(IN)       :: v_surf    ! y wind velocity at the surface
+REAL, DIMENSION(ngrid), INTENT(IN)       :: temp_surf ! surface temperature
+
+REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: wind_u   ! zonal velocity (m/s)
+REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: wind_v   ! meridional velocity (m/s)
+REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: temp   ! temperature (K)
+REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: qvap   ! specific humidity (kg/kg)
+REAL, DIMENSION(ngrid,nlay), INTENT(IN)       :: play   ! pressure (Pa)
+REAL, DIMENSION(ngrid,nlay+1), INTENT(IN)     :: pinterf   ! pressure at interfaces(Pa)
+
+
+REAL, DIMENSION(ngrid,nlay+1), INTENT(INOUT)  :: tke  ! turbulent kinetic energy at interface between layers
+
+REAL, DIMENSION(ngrid,nlay), INTENT(OUT)      :: Km_out   ! output: Exchange coefficient for momentum at interface between layers
+REAL, DIMENSION(ngrid,nlay), INTENT(OUT)      :: Kh_out   ! output: Exchange coefficient for heat flux at interface between layers
+
+
+REAL, DIMENSION(ngrid,nlay) :: wind_u_predict, wind_v_predict
+REAL, DIMENSION(ngrid) ::  wind1
+INTEGER i
+
+
+
+call atke_compute_km_kh(ngrid,nlay,dtime,&
+                        wind_u,wind_v,temp,qvap,play,pinterf,cdrag_uv,&
+                        tke,Km_out,Kh_out)
+
+
+                               
+if (iflag_num_atke .EQ. 1) then
+   !! In this case, we make an explicit prediction of the wind shear to calculate the tke in a
+   !! forward backward way
+   !! pay attention that the treatment of the TKE
+   !! has to be adapted when solving the TKE with a prognostic equation
+
+   do i=1,ngrid
+      wind1(i)=sqrt(wind_u(i,1)**2+wind_v(i,1)**2)
+   enddo
+   call atke_explicit_prediction(ngrid,nlay,rg,rd,dtime,pinterf,play,temp,wind1,wind_u,Km_out,u_surf,cdrag_uv,wind_u_predict)  
+   call atke_explicit_prediction(ngrid,nlay,rg,rd,dtime,pinterf,play,temp,wind1,wind_v,Km_out,v_surf,cdrag_uv,wind_v_predict)
+
+
+   call atke_compute_km_kh(ngrid,nlay,dtime,&
+                        wind_u_predict,wind_v_predict,temp,qvap,play,pinterf,cdrag_uv, &
+                        tke,Km_out,Kh_out)
+
+end if
+
+
+
+
+
+
+end subroutine call_atke
+
+!----------------------------------------------------------------------------------------
+
+subroutine atke_explicit_prediction(ngrid,nlay,rg,rd,dtime,pinterf,play,temp,wind1,x_in,K_in,x_surf,cdrag,x_predict)
+
+INTEGER, INTENT(IN) :: ngrid ! number of horizontal index (flat grid)
+INTEGER, INTENT(IN) :: nlay ! number of vertical index  
+REAL, INTENT(IN) :: rg,rd,dtime ! gravity, R dry air and timestep
+REAL, DIMENSION(ngrid,nlay),   INTENT(IN)  :: play      ! pressure middle of layers (Pa)
+REAL, DIMENSION(ngrid,nlay),   INTENT(IN)  :: temp      ! temperature (K)
+REAL, DIMENSION(ngrid),        INTENT(IN)  :: wind1     ! wind speed first level (m/s)
+REAL, DIMENSION(ngrid,nlay+1), INTENT(IN)  :: pinterf ! pressure at interfaces(Pa)
+REAL, DIMENSION(ngrid,nlay),   INTENT(IN)  :: x_in    ! variable at the beginning of timestep
+REAL, DIMENSION(ngrid,nlay+1), INTENT(IN)  :: K_in    ! eddy diffusivity coef at the beginning of time step
+REAL, DIMENSION(ngrid),        INTENT(IN)  :: x_surf  ! surface variable
+REAL, DIMENSION(ngrid),        INTENT(IN)  :: cdrag  ! drag coefficient
+REAL, DIMENSION(ngrid,nlay),   INTENT(OUT) :: x_predict  ! variable at the end of time step after explicit prediction
+
+
+integer i,k
+real ml,F1,rho
+real, dimension(ngrid) :: play1,temp1
+real, dimension(ngrid,nlay+1) :: K_big
+
+! computation of K_big
+
+play1(:)=play(:,1)
+temp1(:)=temp(:,1)
+
+! "big K" calculation
+do  k=2,nlay-1
+   do i=1,ngrid
+      rho=pinterf(i,k)/rd/(0.5*(temp(i,k-1)+temp(i,k)))
+      K_big(i,k)=rg*K_in(i,k)/(play(i,k)-play(i,k+1))*(rho**2)
+   enddo
+enddo
+! speficic treatment for k=nlay
+do i=1,ngrid
+   rho=pinterf(i,nlay)/rd/temp(i,nlay)
+   K_big(i,nlay)=rg*K_in(i,nlay)/(2*(play(i,nlay)-pinterf(i,nlay+1)))*(rho**2)
+enddo
+
+
+
+! x_predict calculation for 2<=k<=nlay-1
+do  k=2,nlay-1
+   do i=1,ngrid
+      ml=(pinterf(i,k)-pinterf(i,k+1))/rg
+      x_predict(i,k)=x_in(i,k)-dtime/ml*(-K_big(i,k+1)*x_in(i,k+1) &
+                  + (K_big(i,k)+K_big(i,k+1))*x_in(i,k) &
+                  - K_big(i,k)*x_in(i,k-1))
+   enddo
+enddo
+
+! Specific treatment for k=1 
+do i=1,ngrid
+   ml=(pinterf(i,1)-pinterf(i,2))/rg
+   F1=-play1(i)/rd/temp1(i)*wind1(i)*cdrag(i)*(x_in(i,1)-x_surf(i)) ! attention convention sens du flux
+   x_predict(i,1)=x_in(i,1)-dtime/ml*(-K_big(i,2)*(x_in(i,2) - x_in(i,1))-F1)
+enddo
+
+! Specific treatment for k=nlay
+! flux at the top of the atmosphere=0
+do i=1,ngrid
+   ml=0.5*(pinterf(i,nlay)-pinterf(i,nlay+1))/rg
+   x_predict(i,nlay)=x_in(i,nlay)+dtime/ml*(K_big(i,nlay)*(x_in(i,nlay)-x_in(i,nlay-1)))
+enddo
+
+!K_big(:,1)=0.
+!do  k=1,nlay
+!   do i=1,ngrid
+!      print*, 'youhou', k, x_in(i,k), x_predict(i,k), K_big(i,k)
+!   end do
+!enddo
+
+
+
+end subroutine atke_explicit_prediction
+
+
+
+end module lmdz_call_atke
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_call_blowing_snow.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_call_blowing_snow.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_call_blowing_snow.F90	(revision 4727)
@@ -0,0 +1,45 @@
+module lmdz_call_blowing_snow
+
+contains
+
+subroutine call_blowing_snow_sublim_sedim(ngrid,nlay,dtime,temp,q,qbs,pplay,paprs, &
+                                  dtemp_bs,dq_bs,dqbs_bs,bsfl,precip_bs)
+
+use lmdz_blowing_snow_sublim_sedim, only : blowing_snow_sublim_sedim
+implicit none
+
+!INPUT
+!=====
+
+integer, intent(in)                     :: ngrid,nlay
+real, intent(in)                        :: dtime
+real, intent(in), dimension(ngrid,nlay) :: temp
+real, intent(in), dimension(ngrid,nlay) :: q
+real, intent(in), dimension(ngrid,nlay) :: qbs
+real, intent(in), dimension(ngrid,nlay) :: pplay
+real, intent(in), dimension(ngrid,nlay+1) :: paprs
+
+
+! OUTPUT
+!========
+
+
+real, intent(out), dimension(ngrid,nlay) :: dtemp_bs
+real, intent(out), dimension(ngrid,nlay) :: dq_bs
+real, intent(out), dimension(ngrid,nlay) :: dqbs_bs
+real, intent(out), dimension(ngrid,nlay+1) :: bsfl
+real, intent(out), dimension(ngrid)      :: precip_bs
+
+      
+
+
+call blowing_snow_sublim_sedim(ngrid,nlay,dtime,temp,q,qbs,pplay,paprs, &
+                                  dtemp_bs,dq_bs,dqbs_bs,bsfl,precip_bs)
+
+
+
+
+
+end subroutine call_blowing_snow_sublim_sedim
+
+end module lmdz_call_blowing_snow
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_call_cloud_optics_prop.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_call_cloud_optics_prop.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_call_cloud_optics_prop.F90	(revision 4727)
@@ -0,0 +1,132 @@
+! $Id$
+MODULE lmdz_call_cloud_optics_prop
+
+CONTAINS
+
+  SUBROUTINE call_cloud_optics_prop(klon, klev, ok_newmicro,&
+       paprs, pplay, temp, radocond, picefra, pclc, &
+    pcltau, pclemi, pch, pcl, pcm, pct, radocondwp, xflwp, xfiwp, xflwc, xfiwc, ok_aie, &
+    mass_solu_aero, mass_solu_aero_pi, pcldtaupi, distcltop, temp_cltop, re, fl, reliq, reice, &
+    reliq_pi, reice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, &
+    reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  & 
+    icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon)
+
+  ! Interface between the LMDZ physics monitor and the cloud properties calculation routines
+  ! 2023/10/02: L. Raillard, M. Coulon--Decorzens, A. Idelkadi, L. Fairhead
+  ! (E. Vignon and J.-B. Madeleine in spirit)
+  ! List of arguments
+  !------------------
+
+  USE lmdz_cloud_optics_prop_ini , ONLY : ok_cdnc
+  USE lmdz_cloud_optics_prop_ini , ONLY : bl95_b0, bl95_b1
+  USE lmdz_cloud_optics_prop_ini , ONLY : iflag_ice_thermo, ok_new_lscp, iflag_t_glace
+  USE lmdz_cloud_optics_prop, ONLY : cloud_optics_prop
+  
+  USE icefrac_lsc_mod ! computes ice fraction (JBM 3/14)  
+  USE lmdz_lscp_tools, only: icefrac_lscp
+
+  IMPLICIT NONE
+  
+  ! input:
+  INTEGER, INTENT(IN) :: klon, klev      ! number of horizontal and vertical grid points
+  REAL, INTENT(IN) :: paprs(klon, klev+1)! pressure at bottom interfaces [Pa]
+  REAL, INTENT(IN) :: pplay(klon, klev)  ! pressure at the middle of layers [Pa]
+  REAL, INTENT(IN) :: temp(klon, klev)   ! temperature [K]
+  REAL, INTENT(IN) :: radocond(klon, klev) ! cloud condensed water seen by radiation [kg/kg]
+  REAL, INTENT(IN) :: picefra(klon,klev) ! ice fraction in clouds from large scale condensation scheme [-]
+  REAL, INTENT(IN) :: rnebcon(klon,klev) ! convection cloud fraction [-]
+  REAL, INTENT(IN) :: ccwcon(klon,klev)  ! condensed water from deep convection [kg/kg]
+  ! jq for the aerosol indirect effect
+  ! jq introduced by Johannes Quaas (quaas@lmd.jussieu.fr), 27/11/2003
+  REAL, INTENT(IN) :: mass_solu_aero(klon, klev)    ! total mass concentration for all soluble aerosols [ug m-3]
+  REAL, INTENT(IN) :: mass_solu_aero_pi(klon, klev) ! - (pre-industrial value)
+  REAL, INTENT(IN)  :: dNovrN(klon)         ! enhancement factor for cdnc
+  REAL, INTENT(OUT) :: distcltop(klon,klev) ! distance from large scale cloud top [m]
+  REAL, INTENT(OUT) :: temp_cltop(klon,klev)!temperature at large scale cloud top [K]
+
+  LOGICAL, INTENT(IN) :: ptconv(klon, klev) ! flag for grid points affected by deep convection
+  LOGICAL, INTENT(IN) :: ok_newmicro, ok_aie
+
+  ! inout:
+  REAL, INTENT(INOUT) :: pclc(klon, klev) ! cloud fraction for radiation [-]
+
+  ! out:
+  REAL, INTENT(OUT) :: pct(klon)      ! 2D total cloud cover [-]
+  REAL, INTENT(OUT) :: pcl(klon)      ! 2D low cloud cover [-]
+  REAL, INTENT(OUT) :: pcm(klon)      ! 2D mid cloud cover [-]
+  REAL, INTENT(OUT) :: pch(klon)      ! 2D high cloud cover [-]
+  REAL, INTENT(OUT) :: radocondwp(klon) ! total condensed water path (seen by radiation) [kg/m2]
+  REAL, INTENT(OUT) :: xflwp(klon)    ! liquid water path (seen by radiation) [kg/m2]
+  REAL, INTENT(OUT) :: xfiwp(klon)    ! ice water path (seen by radiation) [kg/m2]
+  REAL, INTENT(OUT) :: xflwc(klon, klev) ! liquid water content seen by radiation [kg/kg]
+  REAL, INTENT(OUT) :: xfiwc(klon, klev) ! ice water content seen by radiation [kg/kg]
+  REAL, INTENT(OUT) :: re(klon, klev) ! cloud droplet effective radius multiplied by fl
+  REAL, INTENT(OUT) :: fl(klon, klev) ! xliq * rneb, denominator to re; fraction of liquid water clouds
+                                      ! introduced to avoid problems in the averaging of the output
+                                      ! water clouds within a grid cell
+
+  REAL, INTENT(OUT) :: pcltau(klon, klev) ! cloud optical depth [m]
+  REAL, INTENT(OUT) :: pclemi(klon, klev) ! cloud emissivity [-]
+  REAL, INTENT(OUT) :: pcldtaupi(klon, klev) ! pre-industrial value of cloud optical thickness, ie.
+                                             ! values of optical thickness that does not account
+                                             ! for aerosol effects on cloud droplet radius [m]
+
+  REAL, INTENT(OUT) :: reliq(klon, klev)   ! liquid droplet effective radius [m] 
+  REAL, INTENT(OUT) :: reice(klon, klev)   ! ice effective radius [m]
+  REAL, INTENT(OUT) :: reliq_pi(klon, klev)! liquid droplet effective radius [m], pre-industrial
+  REAL, INTENT(OUT) :: reice_pi(klon, klev)! ice effective radius [m], pre-industrial
+  REAL, INTENT(OUT) :: scdnc(klon, klev)   ! cloud droplet number concentration, mean over the whole mesh [m-3]
+  REAL, INTENT(OUT) :: cldncl(klon)        ! cloud droplet number concentration at top of cloud [m-3]
+  REAL, INTENT(OUT) :: reffclwtop(klon)    ! effective radius of cloud droplet at top of cloud [m] 
+  REAL, INTENT(OUT) :: lcc(klon)           ! liquid Cloud Content at top of cloud [kg/kg]
+  REAL, INTENT(OUT) :: reffclws(klon, klev)! stratiform cloud droplet effective radius 
+  REAL, INTENT(OUT) :: reffclwc(klon, klev)! convective cloud droplet effective radius 
+  REAL, INTENT(OUT) :: cldnvi(klon)        ! column Integrated cloud droplet Number [/m2]
+  REAL, INTENT(OUT) :: lcc3d(klon, klev)   ! cloud fraction for liquid part only [-]
+  REAL, INTENT(OUT) :: lcc3dcon(klon, klev)! cloud fraction for liquid part only, convective clouds [-]
+  REAL, INTENT(OUT) :: lcc3dstra(klon, klev)!cloud fraction for liquid part only, stratiform clouds [-]
+  REAL, INTENT(OUT) :: icc3dcon(klon, klev)! cloud fraction for liquid part only, convective clouds [-]
+  REAL, INTENT(OUT) :: icc3dstra(klon, klev)! cloud fraction for ice part only, stratiform clouds [-] 
+  REAL, INTENT(INOUT) :: icefrac_optics(klon, klev)! ice fraction in clouds seen by radiation [-]
+
+  ! Local variables
+  !----------------
+  INTEGER :: k
+  REAL :: dzfice(klon, klev)
+
+  IF (iflag_t_glace .EQ. 0) THEN
+     icefrac_optics(:, :) = 0.
+  ELSE
+     DO k = 1, klev
+        IF (ok_new_lscp) THEN
+          CALL icefrac_lscp(klon,temp(:,k),iflag_ice_thermo,distcltop(:,k),temp_cltop(:,k), &
+   &         icefrac_optics(:,k),dzfice(:,k))
+        ELSE
+          CALL icefrac_lsc(klon,temp(:,k),pplay(1:klon,k)/paprs(1:klon,1),icefrac_optics(:,k))
+        ENDIF
+     ENDDO
+  ENDIF
+  
+
+
+  IF (ok_newmicro) THEN       
+    CALL cloud_optics_prop(klon, klev, paprs, pplay, temp, radocond, picefra, pclc, &
+    pcltau, pclemi, pch, pcl, pcm, pct, radocondwp, xflwp, xfiwp, xflwc, xfiwc, &
+    mass_solu_aero, mass_solu_aero_pi, pcldtaupi, distcltop, temp_cltop, re, fl, reliq, reice, &
+    reliq_pi, reice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, &
+    reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  & 
+    icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon)
+  ELSE
+    CALL nuage (paprs, pplay, &
+               temp, radocond, picefra, pclc, pcltau, pclemi, &
+               pch, pcl,pcm, pct, radocondwp, &
+               ok_aie, &
+               mass_solu_aero, mass_solu_aero_pi, &
+               bl95_b0, bl95_b1, distcltop, temp_cltop, &
+               pcldtaupi, re, fl)
+  ENDIF
+  RETURN
+
+END SUBROUTINE call_cloud_optics_prop
+
+END MODULE lmdz_call_cloud_optics_prop
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_cloud_optics_prop.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_cloud_optics_prop.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_cloud_optics_prop.F90	(revision 4727)
@@ -0,0 +1,736 @@
+! $Id$
+MODULE lmdz_cloud_optics_prop
+
+CONTAINS
+
+SUBROUTINE cloud_optics_prop(klon, klev, paprs, pplay, temp, radocond, picefra, pclc, &
+    pcltau, pclemi, pch, pcl, pcm, pct, radocondwp, xflwp, xfiwp, xflwc, xfiwc, &
+    mass_solu_aero, mass_solu_aero_pi, pcldtaupi, distcltop, temp_cltop, re, fl, reliq, reice, &
+    reliq_pi, reice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, &
+    reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  & 
+    icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon)
+
+  USE lmdz_cloud_optics_prop_ini , ONLY : flag_aerosol, ok_cdnc
+  USE lmdz_cloud_optics_prop_ini , ONLY : lunout
+  USE lmdz_cloud_optics_prop_ini , ONLY : bl95_b0, bl95_b1
+  USE lmdz_cloud_optics_prop_ini , ONLY : latitude_deg
+  USE lmdz_cloud_optics_prop_ini , ONLY : iflag_t_glace
+  USE lmdz_cloud_optics_prop_ini , ONLY : cdnc_max, cdnc_max_m3
+  USE lmdz_cloud_optics_prop_ini , ONLY : cdnc_min, cdnc_min_m3
+  USE lmdz_cloud_optics_prop_ini , ONLY : thres_tau, thres_neb
+  USE lmdz_cloud_optics_prop_ini , ONLY : prmhc, prlmc
+  USE lmdz_cloud_optics_prop_ini , ONLY : coef_froi, coef_chau
+  USE lmdz_cloud_optics_prop_ini , ONLY : seuil_neb
+  USE lmdz_cloud_optics_prop_ini , ONLY : t_glace_min_old, t_glace_max_old
+  USE lmdz_cloud_optics_prop_ini , ONLY : k_ice0, df
+  USE lmdz_cloud_optics_prop_ini , ONLY : rg, rd, rpi
+  USE lmdz_cloud_optics_prop_ini , ONLY : rad_chau1, rad_chau2, rad_froid, iflag_rei
+  USE lmdz_cloud_optics_prop_ini , ONLY : ok_icefra_lscp, rei_max, rei_min
+  USE lmdz_cloud_optics_prop_ini , ONLY : zepsec, novlp, iflag_ice_thermo, ok_new_lscp
+  
+
+
+
+  IMPLICIT NONE
+  ! ======================================================================
+  ! Authors: Z.X. Li (LMD/CNRS) date: 19930910
+  !          O.Boucher (LMD/CNRS) mise a jour en 201212
+  !          I. Musat (LMD/CNRS) : prise en compte de la meme hypothese 
+  !                              de recouvrement pour les nuages que pour 
+  !                              le rayonnement rrtm via le parametre
+  !                               novlp de radopt.h : 20160721
+  !          L.Fairheard, E.Vignon, JB Madeleine, L. Raillard, A. Idelkadi
+  !          M. Coulon-Decorzens: replayisation of the routine + cleaning
+  !                               and commentaries
+  !
+  ! Aim: compute condensate optical properties,
+  !      cloud optical depth and emissivity
+  ! ======================================================================
+  
+  ! List of arguments
+  !------------------
+
+  ! input:
+  INTEGER, INTENT(IN) :: klon, klev      ! number of horizontal and vertical grid points
+  REAL, INTENT(IN) :: paprs(klon, klev+1)! pressure at bottom interfaces [Pa]
+  REAL, INTENT(IN) :: pplay(klon, klev)  ! pressure at the middle of layers [Pa]
+  REAL, INTENT(IN) :: temp(klon, klev)   ! temperature [K]
+  REAL, INTENT(IN) :: radocond(klon, klev) ! cloud condensed water seen by radiation [kg/kg]
+  REAL, INTENT(IN) :: picefra(klon,klev) ! ice fraction in clouds from large scale condensation scheme [-]
+  REAL, INTENT(IN) :: rnebcon(klon,klev) ! convection cloud fraction [-]
+  REAL, INTENT(IN) :: ccwcon(klon,klev)  ! condensed water from deep convection [kg/kg]
+  ! jq for the aerosol indirect effect
+  ! jq introduced by Johannes Quaas (quaas@lmd.jussieu.fr), 27/11/2003
+  REAL, INTENT(IN) :: mass_solu_aero(klon, klev)    ! total mass concentration for all soluble aerosols [ug m-3]
+  REAL, INTENT(IN) :: mass_solu_aero_pi(klon, klev) ! - (pre-industrial value)
+  REAL, INTENT(IN)  :: dNovrN(klon)         ! enhancement factor for cdnc
+  REAL, INTENT(OUT) :: distcltop(klon,klev) ! distance from large scale cloud top [m]
+  REAL, INTENT(OUT) :: temp_cltop(klon,klev)!temperature at large scale cloud top [K]
+
+  LOGICAL, INTENT(IN) :: ptconv(klon, klev) ! flag for grid points affected by deep convection
+
+  ! inout:
+  REAL, INTENT(INOUT) :: pclc(klon, klev) ! cloud fraction for radiation [-]
+
+  ! out:
+  REAL, INTENT(OUT) :: pct(klon)      ! 2D total cloud cover [-]
+  REAL, INTENT(OUT) :: pcl(klon)      ! 2D low cloud cover [-]
+  REAL, INTENT(OUT) :: pcm(klon)      ! 2D mid cloud cover [-]
+  REAL, INTENT(OUT) :: pch(klon)      ! 2D high cloud cover [-]
+  REAL, INTENT(OUT) :: radocondwp(klon) ! total condensed water path (seen by radiation) [kg/m2]
+  REAL, INTENT(OUT) :: xflwp(klon)    ! liquid water path (seen by radiation) [kg/m2]
+  REAL, INTENT(OUT) :: xfiwp(klon)    ! ice water path (seen by radiation) [kg/m2]
+  REAL, INTENT(OUT) :: xflwc(klon, klev) ! liquid water content seen by radiation [kg/kg]
+  REAL, INTENT(OUT) :: xfiwc(klon, klev) ! ice water content seen by radiation [kg/kg]
+  REAL, INTENT(OUT) :: re(klon, klev) ! cloud droplet effective radius multiplied by fl
+  REAL, INTENT(OUT) :: fl(klon, klev) ! xliq * rneb, denominator to re; fraction of liquid water clouds
+                                      ! introduced to avoid problems in the averaging of the output
+                                      ! water clouds within a grid cell
+
+  REAL, INTENT(OUT) :: pcltau(klon, klev) ! cloud optical depth [m]
+  REAL, INTENT(OUT) :: pclemi(klon, klev) ! cloud emissivity [-]
+  REAL, INTENT(OUT) :: pcldtaupi(klon, klev) ! pre-industrial value of cloud optical thickness, ie.
+                                             ! values of optical thickness that does not account
+                                             ! for aerosol effects on cloud droplet radius [m]
+
+  REAL, INTENT(OUT) :: reliq(klon, klev)   ! liquid droplet effective radius [m] 
+  REAL, INTENT(OUT) :: reice(klon, klev)   ! ice effective radius [m]
+  REAL, INTENT(OUT) :: reliq_pi(klon, klev)! liquid droplet effective radius [m], pre-industrial
+  REAL, INTENT(OUT) :: reice_pi(klon, klev)! ice effective radius [m], pre-industrial
+  REAL, INTENT(OUT) :: scdnc(klon, klev)   ! cloud droplet number concentration, mean over the whole mesh [m-3]
+  REAL, INTENT(OUT) :: cldncl(klon)        ! cloud droplet number concentration at top of cloud [m-3]
+  REAL, INTENT(OUT) :: reffclwtop(klon)    ! effective radius of cloud droplet at top of cloud [m] 
+  REAL, INTENT(OUT) :: lcc(klon)           ! liquid Cloud Content at top of cloud [kg/kg]
+  REAL, INTENT(OUT) :: reffclws(klon, klev)! stratiform cloud droplet effective radius 
+  REAL, INTENT(OUT) :: reffclwc(klon, klev)! convective cloud droplet effective radius 
+  REAL, INTENT(OUT) :: cldnvi(klon)        ! column Integrated cloud droplet Number [/m2]
+  REAL, INTENT(OUT) :: lcc3d(klon, klev)   ! cloud fraction for liquid part only [-]
+  REAL, INTENT(OUT) :: lcc3dcon(klon, klev)! cloud fraction for liquid part only, convective clouds [-]
+  REAL, INTENT(OUT) :: lcc3dstra(klon, klev)!cloud fraction for liquid part only, stratiform clouds [-]
+  REAL, INTENT(OUT) :: icc3dcon(klon, klev)! cloud fraction for liquid part only, convective clouds [-]
+  REAL, INTENT(OUT) :: icc3dstra(klon, klev)! cloud fraction for ice part only, stratiform clouds [-] 
+  REAL, INTENT(INOUT) :: icefrac_optics(klon, klev)! ice fraction in clouds seen by radiation [-]
+
+  ! Local variables
+  !----------------
+
+  LOGICAL, SAVE :: first = .TRUE.
+  !$OMP THREADPRIVATE(FIRST)
+  INTEGER flag_max
+
+  ! threshold PARAMETERs
+  REAL phase3d(klon, klev)
+  REAL tcc(klon), ftmp(klon), lcc_integrat(klon), height(klon)
+  LOGICAL lo
+  INTEGER i, k
+  REAL radius
+
+
+  REAL rel, tc, rei, iwc, dei, deimin, deimax
+  REAL k_ice
+
+  ! jq for the aerosol indirect effect
+  ! jq introduced by Johannes Quaas (quaas@lmd.jussieu.fr), 27/11/2003
+  REAL cdnc(klon, klev) ! cloud droplet number concentration [m-3]
+  REAL cdnc_pi(klon, klev) ! cloud droplet number concentration [m-3] (pi value)
+  REAL re_pi(klon, klev) ! cloud droplet effective radius [um] (pi value)
+
+  ! IM cf. CR:parametres supplementaires
+  REAL dzfice(klon,klev)
+  REAL zclear(klon)
+  REAL zcloud(klon)
+  REAL zcloudh(klon)
+  REAL zcloudm(klon)
+  REAL zcloudl(klon)
+  REAL rhodz(klon, klev) !--rho*dz pour la couche
+  REAL zrho(klon, klev) !--rho pour la couche
+  REAL dh(klon, klev) !--dz pour la couche
+  REAL rad_chaud(klon, klev) !--rayon pour les nuages chauds
+  REAL rad_chaud_pi(klon, klev) !--rayon pour les nuages chauds pre-industriels
+  REAL zflwp_var, zfiwp_var
+  REAL d_rei_dt
+
+
+  ! FH : 2011/05/24
+  ! rei = ( rei_max - rei_min ) * T(°C) / 81.4 + rei_max
+  ! to be used for a temperature in celcius T(°C) < 0
+  ! rei=rei_min for T(°C) < -81.4
+  ! Calcul de la pente de la relation entre rayon effective des cristaux
+  ! et la température Pour retrouver les résultats numériques de la version d'origine,
+  ! on impose 0.71 quand on est proche de 0.71
+  d_rei_dt = (rei_max-rei_min)/81.4
+  IF (abs(d_rei_dt-0.71)<1.E-4) d_rei_dt = 0.71
+
+  ! Calculer l'epaisseur optique et l'emmissivite des nuages
+  ! IM inversion des DO
+
+  xflwp = 0.D0
+  xfiwp = 0.D0
+  xflwc = 0.D0
+  xfiwc = 0.D0
+
+  reliq = 0.
+  reice = 0.
+  reliq_pi = 0.
+  reice_pi = 0.
+
+  IF (iflag_t_glace.EQ.0) THEN
+    DO k = 1, klev
+      DO i = 1, klon
+        ! -layer calculation
+        rhodz(i, k) = (paprs(i,k)-paprs(i,k+1))/rg ! kg/m2
+        zrho(i, k) = pplay(i, k)/temp(i, k)/rd ! kg/m3
+        dh(i, k) = rhodz(i, k)/zrho(i, k) ! m
+        ! -Fraction of ice in cloud using a linear transition
+        icefrac_optics(i, k) = 1.0 - (temp(i,k)-t_glace_min_old)/(t_glace_max_old-t_glace_min_old)
+        icefrac_optics(i, k) = min(max(icefrac_optics(i,k),0.0), 1.0)
+        ! -IM Total Liquid/Ice water content
+        xflwc(i, k) = (1.-icefrac_optics(i,k))*radocond(i, k)
+        xfiwc(i, k) = icefrac_optics(i, k)*radocond(i, k)
+      ENDDO
+    ENDDO
+  ELSE ! of IF (iflag_t_glace.EQ.0)
+    DO k = 1, klev
+
+
+!!$      IF (ok_new_lscp) THEN
+!!$          CALL icefrac_lscp(klon,temp(:,k),iflag_ice_thermo,distcltop(:,k),temp_cltop(:,k),icefrac_optics(:,k),dzfice(:,k))
+!!$      ELSE
+!!$          CALL icefrac_lsc(klon,temp(:,k),pplay(:,k)/paprs(:,1),icefrac_optics(:,k))
+!!$      ENDIF
+
+      DO i = 1, klon
+        
+        IF ((.NOT. ptconv(i,k)) .AND. ok_new_lscp .AND. ok_icefra_lscp) THEN
+        ! EV: take the ice fraction directly from the lscp code
+        ! consistent only for non convective grid points
+        ! critical for mixed phase clouds
+            icefrac_optics(i,k)=picefra(i,k)
+        ENDIF
+
+        ! -layer calculation
+        rhodz(i, k) = (paprs(i,k)-paprs(i,k+1))/rg ! kg/m2
+        zrho(i, k) = pplay(i, k)/temp(i, k)/rd ! kg/m3
+        dh(i, k) = rhodz(i, k)/zrho(i, k) ! m
+        ! -IM Total Liquid/Ice water content
+        xflwc(i, k) = (1.-icefrac_optics(i,k))*radocond(i, k)
+        xfiwc(i, k) = icefrac_optics(i, k)*radocond(i, k)
+      ENDDO
+    ENDDO
+  ENDIF
+
+
+
+
+
+
+  IF (ok_cdnc) THEN
+
+    ! --we compute cloud properties as a function of the aerosol load
+
+    DO k = 1, klev
+      DO i = 1, klon
+        ! Formula "D" of Boucher and Lohmann, Tellus, 1995
+        ! Cloud droplet number concentration (CDNC) is restricted
+        ! to be within [20, 1000 cm^3]
+
+        ! --pre-industrial case
+        cdnc_pi(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero_pi(i,k), &
+          1.E-4))/log(10.))*1.E6 !-m-3
+        cdnc_pi(i, k) = min(cdnc_max_m3, max(cdnc_min_m3,cdnc_pi(i,k)))
+
+      ENDDO
+    ENDDO
+
+    !--flag_aerosol=7 => MACv2SP climatology 
+    !--in this case there is an enhancement factor
+    IF (flag_aerosol .EQ. 7) THEN 
+
+      !--present-day
+      DO k = 1, klev
+        DO i = 1, klon
+          cdnc(i, k) = cdnc_pi(i,k)*dNovrN(i)
+        ENDDO
+      ENDDO
+
+    !--standard case
+    ELSE
+
+      DO k = 1, klev
+        DO i = 1, klon
+
+          ! Formula "D" of Boucher and Lohmann, Tellus, 1995
+          ! Cloud droplet number concentration (CDNC) is restricted
+          ! to be within [20, 1000 cm^3]
+
+          ! --present-day case
+          cdnc(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero(i,k), &
+            1.E-4))/log(10.))*1.E6 !-m-3
+          cdnc(i, k) = min(cdnc_max_m3, max(cdnc_min_m3,cdnc(i,k)))
+
+        ENDDO
+      ENDDO
+
+    ENDIF !--flag_aerosol
+
+    !--computing cloud droplet size
+    DO k = 1, klev
+      DO i = 1, klon
+
+        ! --present-day case
+        rad_chaud(i, k) = 1.1*((radocond(i,k)*pplay(i, &
+          k)/(rd*temp(i,k)))/(4./3*rpi*1000.*cdnc(i,k)))**(1./3.)
+        rad_chaud(i, k) = max(rad_chaud(i,k)*1.E6, 5.)
+
+        ! --pre-industrial case
+        rad_chaud_pi(i, k) = 1.1*((radocond(i,k)*pplay(i, &
+          k)/(rd*temp(i,k)))/(4./3.*rpi*1000.*cdnc_pi(i,k)))**(1./3.)
+        rad_chaud_pi(i, k) = max(rad_chaud_pi(i,k)*1.E6, 5.)
+
+        ! --pre-industrial case
+        ! --liquid/ice cloud water paths:
+        IF (pclc(i,k)<=seuil_neb) THEN
+
+          pcldtaupi(i, k) = 0.0
+
+        ELSE
+
+          zflwp_var = 1000.*(1.-icefrac_optics(i,k))*radocond(i, k)/pclc(i, k)* &
+            rhodz(i, k)
+          zfiwp_var = 1000.*icefrac_optics(i, k)*radocond(i, k)/pclc(i, k)*rhodz(i, k)
+          ! Calculation of ice cloud effective radius in micron
+          IF (iflag_rei .EQ. 1) THEN
+            ! when we account for precipitation in the radiation scheme,
+            ! It is recommended to use the rei formula from Sun and Rikkus 1999 with a revision
+            ! from Sun 2001 (as in the IFS model)
+            iwc=icefrac_optics(i, k)*radocond(i, k)/pclc(i,k)*zrho(i,k)*1000. !in cloud ice water content in g/m3
+            dei=(1.2351+0.0105*(temp(i,k)-273.15))*(45.8966*(iwc**0.2214) + &
+               & 0.7957*(iwc**0.2535)*(temp(i,k)-83.15))
+            !deimax=155.0
+            !deimin=20.+40*cos(abs(latitude_deg(i))/180.*RPI)
+            !Etienne: deimax and deimin controled by rei_max and rei_min in physiq.def
+            deimax=rei_max*2.0
+            deimin=2.0*rei_min+40*cos(abs(latitude_deg(i))/180.*RPI) 
+            dei=min(dei,deimax)
+            dei=max(dei,deimin)
+            rei=3.*sqrt(3.)/8.*dei
+           ELSE
+            ! Default
+            ! for ice clouds: as a function of the ambiant temperature
+            ! [formula used by Iacobellis and Somerville (2000), with an
+            ! asymptotical value of 3.5 microns at T<-81.4 C added to be
+            ! consistent with observations of Heymsfield et al. 1986]:
+            ! 2011/05/24 : rei_min = 3.5 becomes a free PARAMETER as well as
+            ! rei_max=61.29
+            tc = temp(i, k) - 273.15
+            rei = d_rei_dt*tc + rei_max
+            IF (tc<=-81.4) rei = rei_min
+           ENDIF
+
+          ! -- cloud optical thickness :
+          ! [for liquid clouds, traditional formula,
+          ! for ice clouds, Ebert & Curry (1992)]
+
+          IF (zfiwp_var==0. .OR. rei<=0.) rei = 1.
+          pcldtaupi(i, k) = 3.0/2.0*zflwp_var/rad_chaud_pi(i, k) + &
+            zfiwp_var*(3.448E-03+2.431/rei)
+
+        ENDIF
+
+      ENDDO
+    ENDDO
+
+  ELSE !--not ok_cdnc
+
+    ! -prescribed cloud droplet radius
+
+    DO k = 1, min(3, klev)
+      DO i = 1, klon
+        rad_chaud(i, k) = rad_chau2
+        rad_chaud_pi(i, k) = rad_chau2
+      ENDDO
+    ENDDO
+    DO k = min(3, klev) + 1, klev
+      DO i = 1, klon
+        rad_chaud(i, k) = rad_chau1
+        rad_chaud_pi(i, k) = rad_chau1
+      ENDDO
+    ENDDO
+
+  ENDIF !--ok_cdnc
+
+  ! --computation of cloud optical depth and emissivity
+  ! --in the general case
+
+  DO k = 1, klev
+    DO i = 1, klon
+
+      IF (pclc(i,k)<=seuil_neb) THEN
+
+        ! effective cloud droplet radius (microns) for liquid water clouds:
+        ! For output diagnostics cloud droplet effective radius [um]
+        ! we multiply here with f * xl (fraction of liquid water
+        ! clouds in the grid cell) to avoid problems in the averaging of the
+        ! output.
+        ! In the output of IOIPSL, derive the REAL cloud droplet
+        ! effective radius as re/fl
+
+        fl(i, k) = seuil_neb*(1.-icefrac_optics(i,k))
+        re(i, k) = rad_chaud(i, k)*fl(i, k)
+        rel = 0.
+        rei = 0.
+        pclc(i, k) = 0.0
+        pcltau(i, k) = 0.0
+        pclemi(i, k) = 0.0
+
+      ELSE
+
+        ! -- liquid/ice cloud water paths:
+
+        zflwp_var = 1000.*(1.-icefrac_optics(i,k))*radocond(i, k)/pclc(i, k)*rhodz(i, k)
+        zfiwp_var = 1000.*icefrac_optics(i, k)*radocond(i, k)/pclc(i, k)*rhodz(i, k)
+
+        ! effective cloud droplet radius (microns) for liquid water clouds:
+        ! For output diagnostics cloud droplet effective radius [um]
+        ! we multiply here with f Effective radius of cloud droplet at top of cloud (m)* xl (fraction of liquid water
+        ! clouds in the grid cell) to avoid problems in the averaging of the
+        ! output.
+        ! In the output of IOIPSL, derive the REAL cloud droplet
+        ! effective radius as re/fl
+
+        fl(i, k) = pclc(i, k)*(1.-icefrac_optics(i,k))
+        re(i, k) = rad_chaud(i, k)*fl(i, k)
+
+        rel = rad_chaud(i, k)
+
+        ! Calculation of ice cloud effective radius in micron
+
+
+        IF (iflag_rei .GT. 0) THEN
+
+            ! when we account for precipitation in the radiation scheme,
+            ! we use the rei formula from Sun and Rikkus 1999 with a revision
+            ! from Sun 2001 (as in the IFS model)
+            iwc=icefrac_optics(i, k)*radocond(i, k)/pclc(i,k)*zrho(i,k)*1000. !in cloud ice water content in g/m3
+            dei=(1.2351+0.0105*(temp(i,k)-273.15))*(45.8966*(iwc**0.2214) + &
+               &0.7957*(iwc**0.2535)*(temp(i,k)-83.15))
+            !deimax=155.0
+            !deimin=20.+40*cos(abs(latitude_deg(i))/180.*RPI)
+            !Etienne: deimax and deimin controled by rei_max and rei_min in physiq.def
+            deimax=rei_max*2.0
+            deimin=2.0*rei_min+40*cos(abs(latitude_deg(i))/180.*RPI) 
+            dei=min(dei,deimax)
+            dei=max(dei,deimin)
+            rei=3.*sqrt(3.)/8.*dei
+       
+        ELSE
+            ! Default
+            ! for ice clouds: as a function of the ambiant temperature
+            ! [formula used by Iacobellis and Somerville (2000), with an
+            ! asymptotical value of 3.5 microns at T<-81.4 C added to be
+            ! consistent with observations of Heymsfield et al. 1986]:
+            ! 2011/05/24 : rei_min = 3.5 becomes a free PARAMETER as well as
+            ! rei_max=61.29
+            tc = temp(i, k) - 273.15
+            rei = d_rei_dt*tc + rei_max
+            IF (tc<=-81.4) rei = rei_min
+        ENDIF
+        ! -- cloud optical thickness :
+        ! [for liquid clouds, traditional formula,
+        ! for ice clouds, Ebert & Curry (1992)]
+
+        IF (zflwp_var==0.) rel = 1.
+        IF (zfiwp_var==0. .OR. rei<=0.) rei = 1.
+        pcltau(i, k) = 3.0/2.0*(zflwp_var/rel) + zfiwp_var*(3.448E-03+2.431/ &
+          rei)
+
+        ! -- cloud infrared emissivity:
+        ! [the broadband infrared absorption coefficient is PARAMETERized
+        ! as a function of the effective cld droplet radius]
+        ! Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):
+
+        k_ice = k_ice0 + 1.0/rei
+
+        pclemi(i, k) = 1.0 - exp(-coef_chau*zflwp_var-df*k_ice*zfiwp_var)
+
+      ENDIF
+
+      reice(i, k) = rei
+
+      xflwp(i) = xflwp(i) + xflwc(i, k)*rhodz(i, k)
+      xfiwp(i) = xfiwp(i) + xfiwc(i, k)*rhodz(i, k)
+
+    ENDDO
+  ENDDO
+
+  ! --if cloud droplet radius is fixed, then pcldtaupi=pcltau
+
+  IF (.NOT. ok_cdnc) THEN
+    DO k = 1, klev
+      DO i = 1, klon
+        pcldtaupi(i, k) = pcltau(i, k)
+        reice_pi(i, k) = reice(i, k)
+      ENDDO
+    ENDDO
+  ENDIF
+
+  DO k = 1, klev
+    DO i = 1, klon
+      reliq(i, k) = rad_chaud(i, k)
+      reliq_pi(i, k) = rad_chaud_pi(i, k)
+      reice_pi(i, k) = reice(i, k)
+    ENDDO
+  ENDDO
+
+  ! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
+  ! IM cf. CR:test: calcul prenant ou non en compte le recouvrement
+  ! initialisations
+
+  DO i = 1, klon
+    zclear(i) = 1.
+    zcloud(i) = 0.
+    zcloudh(i) = 0.
+    zcloudm(i) = 0.
+    zcloudl(i) = 0.
+    pch(i) = 1.0
+    pcm(i) = 1.0
+    pcl(i) = 1.0
+    radocondwp(i) = 0.0
+  ENDDO
+
+  ! --calculation of liquid water path
+
+  DO k = klev, 1, -1
+    DO i = 1, klon
+      radocondwp(i) = radocondwp(i) + radocond(i, k)*rhodz(i, k)
+    ENDDO
+  ENDDO
+
+  ! --calculation of cloud properties with cloud overlap
+  ! choix de l'hypothese de recouvrement nuageuse via radopt.h (IM, 19.07.2016)
+  ! !novlp=1: max-random
+  ! !novlp=2: maximum
+  ! !novlp=3: random
+
+
+  IF (novlp==1) THEN
+    DO k = klev, 1, -1
+      DO i = 1, klon
+        zclear(i) = zclear(i)*(1.-max(pclc(i,k),zcloud(i)))/(1.-min(real( &
+          zcloud(i),kind=8),1.-zepsec))
+        pct(i) = 1. - zclear(i)
+        IF (paprs(i,k)<prmhc) THEN
+          pch(i) = pch(i)*(1.-max(pclc(i,k),zcloudh(i)))/(1.-min(real(zcloudh &
+            (i),kind=8),1.-zepsec))
+          zcloudh(i) = pclc(i, k)
+        ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
+          pcm(i) = pcm(i)*(1.-max(pclc(i,k),zcloudm(i)))/(1.-min(real(zcloudm &
+            (i),kind=8),1.-zepsec))
+          zcloudm(i) = pclc(i, k)
+        ELSE IF (paprs(i,k)>=prlmc) THEN
+          pcl(i) = pcl(i)*(1.-max(pclc(i,k),zcloudl(i)))/(1.-min(real(zcloudl &
+            (i),kind=8),1.-zepsec))
+          zcloudl(i) = pclc(i, k)
+        ENDIF
+        zcloud(i) = pclc(i, k)
+      ENDDO
+    ENDDO
+  ELSE IF (novlp==2) THEN
+    DO k = klev, 1, -1
+      DO i = 1, klon
+        zcloud(i) = max(pclc(i,k), zcloud(i))
+        pct(i) = zcloud(i)
+        IF (paprs(i,k)<prmhc) THEN
+          pch(i) = min(pclc(i,k), pch(i))
+        ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
+          pcm(i) = min(pclc(i,k), pcm(i))
+        ELSE IF (paprs(i,k)>=prlmc) THEN
+          pcl(i) = min(pclc(i,k), pcl(i))
+        ENDIF
+      ENDDO
+    ENDDO
+  ELSE IF (novlp==3) THEN
+    DO k = klev, 1, -1
+      DO i = 1, klon
+        zclear(i) = zclear(i)*(1.-pclc(i,k))
+        pct(i) = 1 - zclear(i)
+        IF (paprs(i,k)<prmhc) THEN
+          pch(i) = pch(i)*(1.0-pclc(i,k))
+        ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
+          pcm(i) = pcm(i)*(1.0-pclc(i,k))
+        ELSE IF (paprs(i,k)>=prlmc) THEN
+          pcl(i) = pcl(i)*(1.0-pclc(i,k))
+        ENDIF
+      ENDDO
+    ENDDO
+  ENDIF
+
+  DO i = 1, klon
+    pch(i) = 1. - pch(i)
+    pcm(i) = 1. - pcm(i)
+    pcl(i) = 1. - pcl(i)
+  ENDDO
+
+  ! ========================================================
+  ! DIAGNOSTICS CALCULATION FOR CMIP5 PROTOCOL
+  ! ========================================================
+  ! change by Nicolas Yan (LSCE)
+  ! Cloud Droplet Number Concentration (CDNC) : 3D variable
+  ! Fractionnal cover by liquid water cloud (LCC3D) : 3D variable
+  ! Cloud Droplet Number Concentration at top of cloud (CLDNCL) : 2D variable
+  ! Droplet effective radius at top of cloud (REFFCLWTOP) : 2D variable
+  ! Fractionnal cover by liquid water at top of clouds (LCC) : 2D variable
+
+  IF (ok_cdnc) THEN
+
+    DO k = 1, klev
+      DO i = 1, klon
+        phase3d(i, k) = 1 - icefrac_optics(i, k)
+        IF (pclc(i,k)<=seuil_neb) THEN
+          lcc3d(i, k) = seuil_neb*phase3d(i, k)
+        ELSE
+          lcc3d(i, k) = pclc(i, k)*phase3d(i, k)
+        ENDIF
+        scdnc(i, k) = lcc3d(i, k)*cdnc(i, k) ! m-3
+      ENDDO
+    ENDDO
+
+    DO i = 1, klon
+      lcc(i) = 0.
+      reffclwtop(i) = 0.
+      cldncl(i) = 0.
+      IF (novlp.EQ.3 .OR. novlp.EQ.1) tcc(i) = 1.
+      IF (novlp.EQ.2) tcc(i) = 0.
+    ENDDO
+
+    DO i = 1, klon
+      DO k = klev - 1, 1, -1 !From TOA down
+
+          ! Test, if the cloud optical depth exceeds the necessary
+          ! threshold:
+
+        IF (pcltau(i,k)>thres_tau .AND. pclc(i,k)>thres_neb) THEN
+
+          IF (novlp.EQ.2) THEN
+            IF (first) THEN
+              WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM'
+              first = .FALSE.
+            ENDIF
+            flag_max = -1.
+            ftmp(i) = max(tcc(i), pclc(i,k))
+          ENDIF
+
+          IF (novlp.EQ.3) THEN
+            IF (first) THEN
+              WRITE (*, *) 'Hypothese de recouvrement: RANDOM'
+              first = .FALSE.
+            ENDIF
+            flag_max = 1.
+            ftmp(i) = tcc(i)*(1-pclc(i,k))
+          ENDIF
+
+          IF (novlp.EQ.1) THEN
+            IF (first) THEN
+              WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM_ &
+                &                                             &
+                &                                          RANDOM'
+              first = .FALSE.
+            ENDIF
+            flag_max = 1.
+            ftmp(i) = tcc(i)*(1.-max(pclc(i,k),pclc(i,k+1)))/(1.-min(pclc(i, &
+              k+1),1.-thres_neb))
+          ENDIF
+          ! Effective radius of cloud droplet at top of cloud (m)
+          reffclwtop(i) = reffclwtop(i) + rad_chaud(i, k)*1.0E-06*phase3d(i, &
+            k)*(tcc(i)-ftmp(i))*flag_max
+          ! CDNC at top of cloud (m-3)
+          cldncl(i) = cldncl(i) + cdnc(i, k)*phase3d(i, k)*(tcc(i)-ftmp(i))* &
+            flag_max
+          ! Liquid Cloud Content at top of cloud
+          lcc(i) = lcc(i) + phase3d(i, k)*(tcc(i)-ftmp(i))*flag_max
+          ! Total Cloud Content at top of cloud
+          tcc(i) = ftmp(i)
+
+        ENDIF ! is there a visible, not-too-small cloud?
+      ENDDO ! loop over k
+
+      IF (novlp.EQ.3 .OR. novlp.EQ.1) tcc(i) = 1. - tcc(i)
+
+    ENDDO ! loop over i
+
+    ! ! Convective and Stratiform Cloud Droplet Effective Radius (REFFCLWC
+    ! REFFCLWS)
+    DO i = 1, klon
+      DO k = 1, klev
+        ! Weight to be used for outputs: eau_liquide*couverture nuageuse
+        lcc3dcon(i, k) = rnebcon(i, k)*phase3d(i, k)*ccwcon(i, k) ! eau liquide convective
+        lcc3dstra(i, k) = pclc(i, k)*radocond(i, k)*phase3d(i, k)
+        lcc3dstra(i, k) = lcc3dstra(i, k) - lcc3dcon(i, k) ! eau liquide stratiforme
+        lcc3dstra(i, k) = max(lcc3dstra(i,k), 0.0)
+        !FC pour la glace (CAUSES)
+        icc3dcon(i, k) = rnebcon(i, k)*(1-phase3d(i, k))*ccwcon(i, k) !  glace convective
+        icc3dstra(i, k)= pclc(i, k)*radocond(i, k)*(1-phase3d(i, k))
+        icc3dstra(i, k) = icc3dstra(i, k) - icc3dcon(i, k) ! glace stratiforme
+        icc3dstra(i, k) = max( icc3dstra(i, k), 0.0)
+        !FC (CAUSES)
+
+        ! Compute cloud droplet radius as above in meter
+        radius = 1.1*((radocond(i,k)*pplay(i,k)/(rd*temp(i,k)))/(4./3*rpi*1000.* &
+          cdnc(i,k)))**(1./3.)
+        radius = max(radius, 5.E-6)
+        ! Convective Cloud Droplet Effective Radius (REFFCLWC) : variable 3D
+        reffclwc(i, k) = radius
+        reffclwc(i, k) = reffclwc(i, k)*lcc3dcon(i, k)
+        ! Stratiform Cloud Droplet Effective Radius (REFFCLWS) : variable 3D
+        reffclws(i, k) = radius
+        reffclws(i, k) = reffclws(i, k)*lcc3dstra(i, k)
+      ENDDO !klev
+    ENDDO !klon
+
+    ! Column Integrated Cloud Droplet Number (CLDNVI) : variable 2D
+
+    DO i = 1, klon
+      cldnvi(i) = 0.
+      lcc_integrat(i) = 0.
+      height(i) = 0.
+      DO k = 1, klev
+        cldnvi(i) = cldnvi(i) + cdnc(i, k)*lcc3d(i, k)*dh(i, k)
+        lcc_integrat(i) = lcc_integrat(i) + lcc3d(i, k)*dh(i, k)
+        height(i) = height(i) + dh(i, k)
+      ENDDO ! klev
+      lcc_integrat(i) = lcc_integrat(i)/height(i)
+      IF (lcc_integrat(i)<=1.0E-03) THEN
+        cldnvi(i) = cldnvi(i)*lcc(i)/seuil_neb
+      ELSE
+        cldnvi(i) = cldnvi(i)*lcc(i)/lcc_integrat(i)
+      ENDIF
+    ENDDO ! klon
+
+    DO i = 1, klon
+      DO k = 1, klev
+        IF (scdnc(i,k)<=0.0) scdnc(i, k) = 0.0
+        IF (reffclws(i,k)<=0.0) reffclws(i, k) = 0.0
+        IF (reffclwc(i,k)<=0.0) reffclwc(i, k) = 0.0
+        IF (lcc3d(i,k)<=0.0) lcc3d(i, k) = 0.0
+        IF (lcc3dcon(i,k)<=0.0) lcc3dcon(i, k) = 0.0
+        IF (lcc3dstra(i,k)<=0.0) lcc3dstra(i, k) = 0.0
+!FC (CAUSES)
+        IF (icc3dcon(i,k)<=0.0) icc3dcon(i, k) = 0.0
+        IF (icc3dstra(i,k)<=0.0) icc3dstra(i, k) = 0.0
+!FC (CAUSES)
+      ENDDO
+      IF (reffclwtop(i)<=0.0) reffclwtop(i) = 0.0
+      IF (cldncl(i)<=0.0) cldncl(i) = 0.0
+      IF (cldnvi(i)<=0.0) cldnvi(i) = 0.0
+      IF (lcc(i)<=0.0) lcc(i) = 0.0
+    ENDDO
+
+  ENDIF !ok_cdnc
+
+  first=.false. !to be sure
+
+  RETURN
+
+END SUBROUTINE cloud_optics_prop
+
+END MODULE lmdz_cloud_optics_prop
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_cloud_optics_prop_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_cloud_optics_prop_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_cloud_optics_prop_ini.F90	(revision 4727)
@@ -0,0 +1,104 @@
+MODULE lmdz_cloud_optics_prop_ini
+  IMPLICIT NONE
+
+  SAVE
+
+  INTEGER, PROTECTED :: prt_level, lunout
+  INTEGER, PROTECTED :: flag_aerosol
+  INTEGER, PROTECTED :: iflag_t_glace=0
+  INTEGER, PROTECTED :: iflag_rei
+  INTEGER, PROTECTED :: novlp, iflag_ice_thermo
+  LOGICAL, PROTECTED :: ok_cdnc
+  LOGICAL, PROTECTED :: ok_icefra_lscp, ok_new_lscp
+  REAL, PROTECTED :: bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula
+  REAL, ALLOCATABLE :: latitude_deg(:)
+  !$OMP THREADPRIVATE(latitude_deg)
+  REAL, PROTECTED :: cdnc_max=-1.
+  REAL, PROTECTED :: cdnc_max_m3=-1.
+  REAL, PROTECTED :: cdnc_min=-1.
+  REAL, PROTECTED :: cdnc_min_m3=-1.
+  REAL, PROTECTED :: rpi, rg, rd
+  REAL, PROTECTED :: rad_chau1, rad_chau2, rad_froid
+  REAL, PROTECTED :: rei_max, rei_min
+  REAL, PROTECTED :: zepsec
+  REAL, PARAMETER :: thres_tau=0.3, thres_neb=0.001
+  REAL, PARAMETER :: prmhc=440.*100. ! Pressure between medium and high level cloud in Pa
+  REAL, PARAMETER :: prlmc=680.*100. ! Pressure between low and medium level cloud in Pa
+  REAL, PARAMETER :: coef_froi=0.09, coef_chau =0.13
+  REAL, PARAMETER :: seuil_neb=0.001
+! if iflag_t_glace=0, old values are used for liquid/ice partitionning:
+  REAL, PARAMETER :: t_glace_min_old = 258.
+  REAL, PARAMETER :: t_glace_max_old = 273.13
+  REAL, PARAMETER :: k_ice0=0.005 ! units=m2/g
+  REAL, PARAMETER :: df=1.66 ! diffusivity factor
+!$OMP THREADPRIVATE(prt_level, lunout, flag_aerosol, iflag_t_glace)
+!$OMP THREADPRIVATE(iflag_rei, novlp, iflag_ice_thermo)  
+!$OMP THREADPRIVATE(ok_cdnc, ok_icefra_lscp)
+!$OMP THREADPRIVATE(bl95_b0, bl95_b1, cdnc_max, cdnc_max_m3)
+!$OMP THREADPRIVATE(cdnc_min, cdnc_min_m3, rpi, rg, rd)
+!$OMP THREADPRIVATE(rad_chau1, rad_chau2, rad_froid, rei_max, rei_min)
+!$OMP THREADPRIVATE(zepsec) 
+
+  
+CONTAINS
+
+  SUBROUTINE cloud_optics_prop_ini(klon, prt_level_in, lunout_in, flag_aerosol_in, &
+       & ok_cdnc_in, bl95_b0_in, &
+       & bl95_b1_in, latitude_deg_in, rpi_in, rg_in, rd_in, zepsec_in, novlp_in, &
+       & iflag_ice_thermo_in, ok_new_lscp_in)
+
+    USE ioipsl_getin_p_mod, ONLY : getin_p
+
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: klon
+    INTEGER, INTENT(IN) :: prt_level_in, lunout_in
+    INTEGER, INTENT(IN) :: flag_aerosol_in
+    INTEGER, INTENT(IN) :: novlp_in, iflag_ice_thermo_in
+    LOGICAL, INTENT(IN) :: ok_cdnc_in, ok_new_lscp_in
+    REAL, INTENT(IN) :: bl95_b0_in, bl95_b1_in
+    REAL, INTENT(IN) :: latitude_deg_in(klon)
+    REAL, INTENT(IN) :: rpi_in, rg_in, rd_in
+    REAL, INTENT(IN) :: zepsec_in
+
+    ALLOCATE(latitude_deg(klon))
+
+    prt_level = prt_level_in
+    lunout = lunout_in
+    flag_aerosol = flag_aerosol_in
+    ok_cdnc = ok_cdnc_in
+    bl95_b0 = bl95_b0_in
+    bl95_b1 = bl95_b1_in
+    latitude_deg(:) = latitude_deg_in(:)
+    rpi = rpi_in
+    rg = rg_in
+    rd = rd_in
+    zepsec = zepsec_in
+    novlp = novlp_in
+    iflag_ice_thermo = iflag_ice_thermo_in
+    ok_new_lscp = ok_new_lscp_in
+    
+    call getin_p('cdnc_min',cdnc_min)
+    cdnc_min_m3=cdnc_min*1.E6
+    IF (cdnc_min_m3<0.) cdnc_min_m3=20.E6 ! astuce pour retrocompatibilite
+    write(lunout,*)'cdnc_min=', cdnc_min_m3/1.E6
+    call getin_p('cdnc_max',cdnc_max)
+    cdnc_max_m3=cdnc_max*1.E6
+    IF (cdnc_max_m3<0.) cdnc_max_m3=1000.E6 ! astuce pour retrocompatibilite
+    write(lunout,*)'cdnc_max=', cdnc_max_m3/1.E6
+    CALL getin_p('iflag_t_glace',iflag_t_glace)      
+    write(lunout,*)'iflag_t_glace= ',iflag_t_glace
+    CALL getin_p('rad_chau1',rad_chau1)
+    CALL getin_p('rad_chau2',rad_chau2)
+    CALL getin_p('rad_froid ',rad_froid)
+    CALL getin_p('ok_icefra_lscp', ok_icefra_lscp)
+    iflag_rei = 0
+    CALL getin_p('iflag_rei',iflag_rei)
+    rei_min = 3.5
+    CALL getin_p('rei_min',rei_min)
+    rei_max = 61.29
+    CALL getin_p('rei_max',rei_max)
+
+   
+  END SUBROUTINE cloud_optics_prop_ini
+
+END MODULE lmdz_cloud_optics_prop_ini
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_cloudth.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_cloudth.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_cloudth.F90	(revision 4727)
@@ -0,0 +1,2334 @@
+MODULE lmdz_cloudth
+
+
+  IMPLICIT NONE
+
+CONTAINS
+
+       SUBROUTINE cloudth(ngrid,klev,ind2,  &
+     &           ztv,po,zqta,fraca, & 
+     &           qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
+     &           ratqs,zqs,t, &
+     &           cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+
+      use lmdz_cloudth_ini, only: iflag_cloudth_vert,iflag_ratqs
+
+      IMPLICIT NONE
+
+
+!===========================================================================
+! Auteur : Arnaud Octavio Jam (LMD/CNRS)
+! Date : 25 Mai 2010
+! Objet : calcule les valeurs de qc et rneb dans les thermiques
+!===========================================================================
+
+
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOETHF.h"
+      INCLUDE "FCTTRE.h"
+
+      INTEGER itap,ind1,ind2
+      INTEGER ngrid,klev,klon,l,ig 
+      real, dimension(ngrid,klev), intent(out) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
+      
+      REAL ztv(ngrid,klev)
+      REAL po(ngrid)
+      REAL zqenv(ngrid)   
+      REAL zqta(ngrid,klev)
+          
+      REAL fraca(ngrid,klev+1)
+      REAL zpspsk(ngrid,klev)
+      REAL paprs(ngrid,klev+1)
+      REAL pplay(ngrid,klev)
+      REAL ztla(ngrid,klev)
+      REAL zthl(ngrid,klev)
+
+      REAL zqsatth(ngrid,klev)
+      REAL zqsatenv(ngrid,klev)
+      
+      
+      REAL sigma1(ngrid,klev)
+      REAL sigma2(ngrid,klev)
+      REAL qlth(ngrid,klev)
+      REAL qlenv(ngrid,klev)
+      REAL qltot(ngrid,klev) 
+      REAL cth(ngrid,klev)  
+      REAL cenv(ngrid,klev)   
+      REAL ctot(ngrid,klev)
+      REAL rneb(ngrid,klev)
+      REAL t(ngrid,klev)
+      REAL qsatmmussig1,qsatmmussig2,sqrt2pi,pi
+      REAL rdd,cppd,Lv
+      REAL alth,alenv,ath,aenv
+      REAL sth,senv,sigma1s,sigma2s,xth,xenv
+      REAL Tbef,zdelta,qsatbef,zcor
+      REAL qlbef  
+      REAL ratqs(ngrid,klev) ! determine la largeur de distribution de vapeur
+      
+      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
+      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 
+      REAL zqs(ngrid), qcloud(ngrid)
+      REAL erf
+
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Gestion de deux versions de cloudth
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      IF (iflag_cloudth_vert.GE.1) THEN
+      CALL cloudth_vert(ngrid,klev,ind2,  &
+     &           ztv,po,zqta,fraca, & 
+     &           qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
+     &           ratqs,zqs,t)
+      RETURN
+      ENDIF
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!-------------------------------------------------------------------------------
+! Initialisation des variables r?elles
+!-------------------------------------------------------------------------------
+      sigma1(:,:)=0.
+      sigma2(:,:)=0.
+      qlth(:,:)=0.
+      qlenv(:,:)=0.  
+      qltot(:,:)=0.
+      rneb(:,:)=0.
+      qcloud(:)=0.
+      cth(:,:)=0.
+      cenv(:,:)=0.
+      ctot(:,:)=0.
+      qsatmmussig1=0.
+      qsatmmussig2=0.
+      rdd=287.04
+      cppd=1005.7
+      pi=3.14159 
+      Lv=2.5e6
+      sqrt2pi=sqrt(2.*pi)
+
+
+
+!-------------------------------------------------------------------------------
+! Calcul de la fraction du thermique et des ?cart-types des distributions
+!-------------------------------------------------------------------------------                 
+      do ind1=1,ngrid
+
+      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then 
+
+      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
+
+
+!      zqenv(ind1)=po(ind1)
+      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatenv(ind1,ind2)=qsatbef
+
+
+
+
+      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
+      aenv=1./(1.+(alenv*Lv/cppd))
+      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2)) 
+
+
+
+
+      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatth(ind1,ind2)=qsatbef
+            
+      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)   
+      ath=1./(1.+(alth*Lv/cppd))
+      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2)) 
+      
+      
+
+!------------------------------------------------------------------------------
+! Calcul des ?cart-types pour s
+!------------------------------------------------------------------------------
+
+!      sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
+!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.002*zqta(ind1,ind2) 
+!       if (paprs(ind1,ind2).gt.90000) then
+!       ratqs(ind1,ind2)=0.002
+!       else 
+!       ratqs(ind1,ind2)=0.002+0.0*(90000-paprs(ind1,ind2))/20000
+!       endif
+       sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
+       sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2) 
+!       sigma1s=ratqs(ind1,ind2)*po(ind1)
+!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.00003  
+ 
+!------------------------------------------------------------------------------
+! Calcul de l'eau condens?e et de la couverture nuageuse
+!------------------------------------------------------------------------------
+      sqrt2pi=sqrt(2.*pi)
+      xth=sth/(sqrt(2.)*sigma2s)
+      xenv=senv/(sqrt(2.)*sigma1s)
+      cth(ind1,ind2)=0.5*(1.+1.*erf(xth))
+      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv)) 
+      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
+
+      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt(2.)*cth(ind1,ind2))
+      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))   
+      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      if (ctot(ind1,ind2).lt.1.e-10) then
+      ctot(ind1,ind2)=0.
+      qcloud(ind1)=zqsatenv(ind1,ind2) 
+
+      else   
+                
+      ctot(ind1,ind2)=ctot(ind1,ind2) 
+      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
+
+      endif                           
+      
+          
+!     print*,sth,sigma2s,qlth(ind1,ind2),ctot(ind1,ind2),qltot(ind1,ind2),'verif'
+
+
+      else  ! gaussienne environnement seule
+      
+      zqenv(ind1)=po(ind1)
+      Tbef=t(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatenv(ind1,ind2)=qsatbef
+      
+
+!      qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
+      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
+      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
+      aenv=1./(1.+(alenv*Lv/cppd))
+      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2)) 
+      
+
+      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
+
+      sqrt2pi=sqrt(2.*pi)
+      xenv=senv/(sqrt(2.)*sigma1s)
+      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
+      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
+      
+      if (ctot(ind1,ind2).lt.1.e-3) then
+      ctot(ind1,ind2)=0.
+      qcloud(ind1)=zqsatenv(ind1,ind2) 
+
+      else   
+                
+      ctot(ind1,ind2)=ctot(ind1,ind2) 
+      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
+
+      endif    
+ 
+ 
+ 
+ 
+ 
+ 
+      endif   
+      enddo
+     
+      return
+!     end
+END SUBROUTINE cloudth
+
+
+
+!===========================================================================
+     SUBROUTINE cloudth_vert(ngrid,klev,ind2,  &
+     &           ztv,po,zqta,fraca, & 
+     &           qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
+     &           ratqs,zqs,t)
+
+!===========================================================================
+! Auteur : Arnaud Octavio Jam (LMD/CNRS)
+! Date : 25 Mai 2010
+! Objet : calcule les valeurs de qc et rneb dans les thermiques
+!===========================================================================
+
+
+      use lmdz_cloudth_ini, only: iflag_cloudth_vert, vert_alpha
+
+      IMPLICIT NONE
+
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOETHF.h"
+      INCLUDE "FCTTRE.h"
+      
+      INTEGER itap,ind1,ind2
+      INTEGER ngrid,klev,klon,l,ig 
+      
+      REAL ztv(ngrid,klev)
+      REAL po(ngrid)
+      REAL zqenv(ngrid)   
+      REAL zqta(ngrid,klev)
+          
+      REAL fraca(ngrid,klev+1)
+      REAL zpspsk(ngrid,klev)
+      REAL paprs(ngrid,klev+1)
+      REAL pplay(ngrid,klev)
+      REAL ztla(ngrid,klev)
+      REAL zthl(ngrid,klev)
+
+      REAL zqsatth(ngrid,klev)
+      REAL zqsatenv(ngrid,klev)
+      
+      
+      REAL sigma1(ngrid,klev)                                                         
+      REAL sigma2(ngrid,klev)
+      REAL qlth(ngrid,klev)
+      REAL qlenv(ngrid,klev)
+      REAL qltot(ngrid,klev) 
+      REAL cth(ngrid,klev)  
+      REAL cenv(ngrid,klev)   
+      REAL ctot(ngrid,klev)
+      REAL rneb(ngrid,klev)
+      REAL t(ngrid,klev)                                                                  
+      REAL qsatmmussig1,qsatmmussig2,sqrt2pi,pi
+      REAL rdd,cppd,Lv,sqrt2,sqrtpi
+      REAL alth,alenv,ath,aenv
+      REAL sth,senv,sigma1s,sigma2s,xth,xenv
+      REAL xth1,xth2,xenv1,xenv2,deltasth, deltasenv
+      REAL IntJ,IntI1,IntI2,IntI3,coeffqlenv,coeffqlth
+      REAL Tbef,zdelta,qsatbef,zcor
+      REAL qlbef  
+      REAL ratqs(ngrid,klev) ! determine la largeur de distribution de vapeur
+      ! Change the width of the PDF used for vertical subgrid scale heterogeneity
+      ! (J Jouhaud, JL Dufresne, JB Madeleine)
+      
+      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
+      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 
+      REAL zqs(ngrid), qcloud(ngrid)
+      REAL erf
+
+!------------------------------------------------------------------------------
+! Initialisation des variables r?elles
+!------------------------------------------------------------------------------
+      sigma1(:,:)=0.
+      sigma2(:,:)=0.
+      qlth(:,:)=0.
+      qlenv(:,:)=0.  
+      qltot(:,:)=0.
+      rneb(:,:)=0.
+      qcloud(:)=0.
+      cth(:,:)=0.
+      cenv(:,:)=0.
+      ctot(:,:)=0.
+      qsatmmussig1=0.
+      qsatmmussig2=0.
+      rdd=287.04
+      cppd=1005.7
+      pi=3.14159 
+      Lv=2.5e6
+      sqrt2pi=sqrt(2.*pi)
+      sqrt2=sqrt(2.)
+      sqrtpi=sqrt(pi)
+
+!-------------------------------------------------------------------------------
+! Calcul de la fraction du thermique et des ?cart-types des distributions
+!-------------------------------------------------------------------------------                 
+      do ind1=1,ngrid
+
+      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then 
+
+      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
+
+
+!      zqenv(ind1)=po(ind1)
+      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatenv(ind1,ind2)=qsatbef
+
+
+
+
+      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
+      aenv=1./(1.+(alenv*Lv/cppd))
+      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2)) 
+
+
+
+
+      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatth(ind1,ind2)=qsatbef
+            
+      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)   
+      ath=1./(1.+(alth*Lv/cppd))
+      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2)) 
+      
+      
+
+!------------------------------------------------------------------------------
+! Calcul des ?cart-types pour s
+!------------------------------------------------------------------------------
+
+      sigma1s=(0.92**0.5)*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
+      sigma2s=0.09*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.5+0.002*zqta(ind1,ind2) 
+!       if (paprs(ind1,ind2).gt.90000) then
+!       ratqs(ind1,ind2)=0.002
+!       else 
+!       ratqs(ind1,ind2)=0.002+0.0*(90000-paprs(ind1,ind2))/20000
+!       endif
+!       sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
+!       sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2) 
+!       sigma1s=ratqs(ind1,ind2)*po(ind1)
+!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.00003  
+ 
+!------------------------------------------------------------------------------
+! Calcul de l'eau condens?e et de la couverture nuageuse
+!------------------------------------------------------------------------------
+      sqrt2pi=sqrt(2.*pi)
+      xth=sth/(sqrt(2.)*sigma2s)
+      xenv=senv/(sqrt(2.)*sigma1s)
+      cth(ind1,ind2)=0.5*(1.+1.*erf(xth))
+      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv)) 
+      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
+
+      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt(2.)*cth(ind1,ind2))
+      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))   
+      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
+     
+       IF (iflag_cloudth_vert == 1) THEN
+!-------------------------------------------------------------------------------
+!  Version 2: Modification selon J.-Louis. On condense ?? partir de qsat-ratqs
+!-------------------------------------------------------------------------------
+!      deltasenv=aenv*ratqs(ind1,ind2)*po(ind1)
+!      deltasth=ath*ratqs(ind1,ind2)*zqta(ind1,ind2)
+      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
+      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
+!      deltasenv=aenv*0.01*po(ind1)
+!     deltasth=ath*0.01*zqta(ind1,ind2)    
+      xenv1=(senv-deltasenv)/(sqrt(2.)*sigma1s)
+      xenv2=(senv+deltasenv)/(sqrt(2.)*sigma1s)
+      xth1=(sth-deltasth)/(sqrt(2.)*sigma2s)
+      xth2=(sth+deltasth)/(sqrt(2.)*sigma2s)
+      coeffqlenv=(sigma1s)**2/(2*sqrtpi*deltasenv)
+      coeffqlth=(sigma2s)**2/(2*sqrtpi*deltasth)
+      
+      cth(ind1,ind2)=0.5*(1.+1.*erf(xth2))
+      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv2)) 
+      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
+
+      IntJ=sigma1s*(exp(-1.*xenv1**2)/sqrt2pi)+0.5*senv*(1+erf(xenv1))
+      IntI1=coeffqlenv*0.5*(0.5*sqrtpi*(erf(xenv2)-erf(xenv1))+xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
+      IntI2=coeffqlenv*xenv2*(exp(-1.*xenv2**2)-exp(-1.*xenv1**2))
+      IntI3=coeffqlenv*0.5*sqrtpi*xenv2**2*(erf(xenv2)-erf(xenv1))
+
+      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
+!      qlenv(ind1,ind2)=IntJ 
+!      print*, qlenv(ind1,ind2),'VERIF EAU'
+
+
+      IntJ=sigma2s*(exp(-1.*xth1**2)/sqrt2pi)+0.5*sth*(1+erf(xth1))
+!      IntI1=coeffqlth*((0.5*xth1-xth2)*exp(-1.*xth1**2)+0.5*xth2*exp(-1.*xth2**2))
+!      IntI2=coeffqlth*0.5*sqrtpi*(0.5+xth2**2)*(erf(xth2)-erf(xth1))
+      IntI1=coeffqlth*0.5*(0.5*sqrtpi*(erf(xth2)-erf(xth1))+xth1*exp(-1.*xth1**2)-xth2*exp(-1.*xth2**2))
+      IntI2=coeffqlth*xth2*(exp(-1.*xth2**2)-exp(-1.*xth1**2))
+      IntI3=coeffqlth*0.5*sqrtpi*xth2**2*(erf(xth2)-erf(xth1))
+      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
+!      qlth(ind1,ind2)=IntJ
+!      print*, IntJ,IntI1,IntI2,IntI3,qlth(ind1,ind2),'VERIF EAU2'
+      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
+
+      ELSE IF (iflag_cloudth_vert == 2) THEN
+
+!-------------------------------------------------------------------------------
+!  Version 3: Modification Jean Jouhaud. On condense a partir de -delta s
+!-------------------------------------------------------------------------------
+!      deltasenv=aenv*ratqs(ind1,ind2)*po(ind1)
+!      deltasth=ath*ratqs(ind1,ind2)*zqta(ind1,ind2)
+!      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
+!      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
+      deltasenv=aenv*vert_alpha*sigma1s
+      deltasth=ath*vert_alpha*sigma2s
+      
+      xenv1=-(senv+deltasenv)/(sqrt(2.)*sigma1s)
+      xenv2=-(senv-deltasenv)/(sqrt(2.)*sigma1s)
+      xth1=-(sth+deltasth)/(sqrt(2.)*sigma2s)
+      xth2=-(sth-deltasth)/(sqrt(2.)*sigma2s)
+!     coeffqlenv=(sigma1s)**2/(2*sqrtpi*deltasenv)
+!     coeffqlth=(sigma2s)**2/(2*sqrtpi*deltasth)
+      
+      cth(ind1,ind2)=0.5*(1.-1.*erf(xth1))
+      cenv(ind1,ind2)=0.5*(1.-1.*erf(xenv1))
+      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
+
+      IntJ=0.5*senv*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp(-1.*xenv2**2)
+      IntI1=(((senv+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
+      IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
+      IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp(-1.*xenv1**2)-exp(-1.*xenv2**2))
+
+!      IntI1=0.5*(0.5*sqrtpi*(erf(xenv2)-erf(xenv1))+xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
+!      IntI2=xenv2*(exp(-1.*xenv2**2)-exp(-1.*xenv1**2))
+!      IntI3=0.5*sqrtpi*xenv2**2*(erf(xenv2)-erf(xenv1))
+
+      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
+!      qlenv(ind1,ind2)=IntJ 
+!      print*, qlenv(ind1,ind2),'VERIF EAU'
+
+      IntJ=0.5*sth*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp(-1.*xth2**2)
+      IntI1=(((sth+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
+      IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp(-1.*xth1**2)-xth2*exp(-1.*xth2**2))
+      IntI3=((sqrt2*sigma2s*(sth+deltasth))/(4*sqrtpi*deltasth))*(exp(-1.*xth1**2)-exp(-1.*xth2**2))
+      
+      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
+!      qlth(ind1,ind2)=IntJ
+!      print*, IntJ,IntI1,IntI2,IntI3,qlth(ind1,ind2),'VERIF EAU2'
+      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
+      
+
+
+
+      ENDIF ! of if (iflag_cloudth_vert==1 or 2)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      if (cenv(ind1,ind2).lt.1.e-10.or.cth(ind1,ind2).lt.1.e-10) then
+      ctot(ind1,ind2)=0.
+      qcloud(ind1)=zqsatenv(ind1,ind2) 
+
+      else 
+                
+      ctot(ind1,ind2)=ctot(ind1,ind2) 
+      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
+!      qcloud(ind1)=fraca(ind1,ind2)*qlth(ind1,ind2)/cth(ind1,ind2) &
+!    &             +(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)/cenv(ind1,ind2)+zqs(ind1) 
+
+      endif  
+                       
+      
+          
+!     print*,sth,sigma2s,qlth(ind1,ind2),ctot(ind1,ind2),qltot(ind1,ind2),'verif'
+
+
+      else  ! gaussienne environnement seule
+      
+      zqenv(ind1)=po(ind1)
+      Tbef=t(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatenv(ind1,ind2)=qsatbef
+      
+
+!      qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
+      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
+      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
+      aenv=1./(1.+(alenv*Lv/cppd))
+      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2)) 
+      
+
+      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
+
+      sqrt2pi=sqrt(2.*pi)
+      xenv=senv/(sqrt(2.)*sigma1s)
+      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
+      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
+      
+      if (ctot(ind1,ind2).lt.1.e-3) then
+      ctot(ind1,ind2)=0.
+      qcloud(ind1)=zqsatenv(ind1,ind2) 
+
+      else   
+                
+      ctot(ind1,ind2)=ctot(ind1,ind2) 
+      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
+
+      endif    
+ 
+ 
+ 
+ 
+ 
+ 
+      endif   
+      enddo
+     
+      return
+!     end
+END SUBROUTINE cloudth_vert
+
+
+
+
+       SUBROUTINE cloudth_v3(ngrid,klev,ind2,  &
+     &           ztv,po,zqta,fraca, & 
+     &           qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
+     &           ratqs,zqs,t, &
+     &           cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+      use lmdz_cloudth_ini, only: iflag_cloudth_vert
+
+      IMPLICIT NONE
+
+
+!===========================================================================
+! Author : Arnaud Octavio Jam (LMD/CNRS)
+! Date : 25 Mai 2010
+! Objet : calcule les valeurs de qc et rneb dans les thermiques
+!===========================================================================
+
+
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOETHF.h"
+      INCLUDE "FCTTRE.h"
+
+      integer, intent(in) :: ind2
+      integer, intent(in) :: ngrid,klev
+      
+      real, dimension(ngrid,klev), intent(in) :: ztv
+      real, dimension(ngrid), intent(in) :: po
+      real, dimension(ngrid,klev), intent(in) :: zqta
+      real, dimension(ngrid,klev+1), intent(in) :: fraca
+      real, dimension(ngrid), intent(out) :: qcloud
+      real, dimension(ngrid,klev), intent(out) :: ctot
+      real, dimension(ngrid,klev), intent(out) :: ctot_vol
+      real, dimension(ngrid,klev), intent(in) :: zpspsk
+      real, dimension(ngrid,klev+1), intent(in) :: paprs
+      real, dimension(ngrid,klev), intent(in) :: pplay
+      real, dimension(ngrid,klev), intent(in) :: ztla
+      real, dimension(ngrid,klev), intent(inout) :: zthl
+      real, dimension(ngrid,klev), intent(in) :: ratqs
+      real, dimension(ngrid), intent(in) :: zqs
+      real, dimension(ngrid,klev), intent(in) :: t
+      real, dimension(ngrid,klev), intent(out) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
+
+
+      REAL zqenv(ngrid)   
+      REAL zqsatth(ngrid,klev)
+      REAL zqsatenv(ngrid,klev)
+      
+      REAL sigma1(ngrid,klev)                                                         
+      REAL sigma2(ngrid,klev)
+      REAL qlth(ngrid,klev)
+      REAL qlenv(ngrid,klev)
+      REAL qltot(ngrid,klev) 
+      REAL cth(ngrid,klev)
+      REAL cenv(ngrid,klev)   
+      REAL cth_vol(ngrid,klev)
+      REAL cenv_vol(ngrid,klev)
+      REAL rneb(ngrid,klev)      
+      REAL qsatmmussig1,qsatmmussig2,sqrt2pi,sqrt2,sqrtpi,pi
+      REAL rdd,cppd,Lv
+      REAL alth,alenv,ath,aenv
+      REAL sth,senv,sigma1s,sigma2s,xth,xenv, exp_xenv1, exp_xenv2,exp_xth1,exp_xth2
+      REAL inverse_rho,beta,a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks
+      REAL Tbef,zdelta,qsatbef,zcor
+      REAL qlbef  
+      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
+      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 
+      REAL erf
+
+
+      INTEGER :: ind1,l, ig
+
+      IF (iflag_cloudth_vert.GE.1) THEN
+      CALL cloudth_vert_v3(ngrid,klev,ind2,  &
+     &           ztv,po,zqta,fraca, & 
+     &           qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
+     &           ratqs,zqs,t, &
+     &           cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+      RETURN
+      ENDIF
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!-------------------------------------------------------------------------------
+! Initialisation des variables r?elles
+!-------------------------------------------------------------------------------
+      sigma1(:,:)=0.
+      sigma2(:,:)=0.
+      qlth(:,:)=0.
+      qlenv(:,:)=0.  
+      qltot(:,:)=0.
+      rneb(:,:)=0.
+      qcloud(:)=0.
+      cth(:,:)=0.
+      cenv(:,:)=0.
+      ctot(:,:)=0.
+      cth_vol(:,:)=0.
+      cenv_vol(:,:)=0.
+      ctot_vol(:,:)=0.
+      qsatmmussig1=0.
+      qsatmmussig2=0.
+      rdd=287.04
+      cppd=1005.7
+      pi=3.14159 
+      Lv=2.5e6
+      sqrt2pi=sqrt(2.*pi)
+      sqrt2=sqrt(2.)
+      sqrtpi=sqrt(pi)
+
+
+!-------------------------------------------------------------------------------
+! Cloud fraction in the thermals and standard deviation of the PDFs
+!-------------------------------------------------------------------------------                 
+      do ind1=1,ngrid
+
+      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then 
+
+      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
+
+      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES*FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatenv(ind1,ind2)=qsatbef
+
+
+      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84
+      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84
+      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84
+
+!po = qt de l'environnement ET des thermique
+!zqenv = qt environnement
+!zqsatenv = qsat environnement
+!zthl = Tl environnement
+
+
+      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatth(ind1,ind2)=qsatbef
+            
+      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)       !qsl, p84
+      ath=1./(1.+(alth*Lv/cppd))                                        !al, p84
+      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))                      !s, p84
+      
+!zqta = qt thermals
+!zqsatth = qsat thermals
+!ztla = Tl thermals
+
+!------------------------------------------------------------------------------
+! s standard deviations
+!------------------------------------------------------------------------------
+
+!     tests
+!     sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
+!     sigma1s=(0.92*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5))+ratqs(ind1,ind2)*po(ind1)
+!     sigma2s=(0.09*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**0.5))+0.002*zqta(ind1,ind2)
+!     final option
+      sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
+      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2)
+ 
+!------------------------------------------------------------------------------
+! Condensed water and cloud cover
+!------------------------------------------------------------------------------
+      xth=sth/(sqrt2*sigma2s)
+      xenv=senv/(sqrt2*sigma1s)
+      cth(ind1,ind2)=0.5*(1.+1.*erf(xth))       !4.18 p 111, l.7 p115 & 4.20 p 119 thesis Arnaud Jam
+      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv))     !4.18 p 111, l.7 p115 & 4.20 p 119 thesis Arnaud Jam
+      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
+      ctot_vol(ind1,ind2)=ctot(ind1,ind2)
+
+      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt2*cth(ind1,ind2))
+      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*cenv(ind1,ind2))
+      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
+
+      if (ctot(ind1,ind2).lt.1.e-10) then
+      ctot(ind1,ind2)=0.
+      qcloud(ind1)=zqsatenv(ind1,ind2) 
+      else
+      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
+      endif
+
+      else  ! Environnement only, follow the if l.110
+      
+      zqenv(ind1)=po(ind1)
+      Tbef=t(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatenv(ind1,ind2)=qsatbef
+
+!     qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
+      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
+      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
+      aenv=1./(1.+(alenv*Lv/cppd))
+      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))
+      
+      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
+
+      xenv=senv/(sqrt2*sigma1s)
+      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
+      ctot_vol(ind1,ind2)=ctot(ind1,ind2)
+      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*cenv(ind1,ind2))
+
+      if (ctot(ind1,ind2).lt.1.e-3) then
+      ctot(ind1,ind2)=0.
+      qcloud(ind1)=zqsatenv(ind1,ind2)
+      else   
+      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
+      endif
+
+
+      endif       ! From the separation (thermal/envrionnement) et (environnement) only, l.110 et l.183
+      enddo       ! from the loop on ngrid l.108
+      return
+!     end
+END SUBROUTINE cloudth_v3
+
+
+
+!===========================================================================
+     SUBROUTINE cloudth_vert_v3(ngrid,klev,ind2,  &
+     &           ztv,po,zqta,fraca, & 
+     &           qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
+     &           ratqs,zqs,t, &
+     &           cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+!===========================================================================
+! Auteur : Arnaud Octavio Jam (LMD/CNRS)
+! Date : 25 Mai 2010
+! Objet : calcule les valeurs de qc et rneb dans les thermiques
+!===========================================================================
+
+      use lmdz_cloudth_ini, only : iflag_cloudth_vert,iflag_ratqs
+      use lmdz_cloudth_ini, only : vert_alpha,vert_alpha_th, sigma1s_factor, sigma1s_power , sigma2s_factor , sigma2s_power , cloudth_ratqsmin , iflag_cloudth_vert_noratqs
+
+      IMPLICIT NONE
+
+
+
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOETHF.h"
+      INCLUDE "FCTTRE.h"
+      
+      INTEGER itap,ind1,ind2
+      INTEGER ngrid,klev,klon,l,ig 
+      real, dimension(ngrid,klev), intent(out) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
+      
+      REAL ztv(ngrid,klev)
+      REAL po(ngrid)
+      REAL zqenv(ngrid)   
+      REAL zqta(ngrid,klev)
+          
+      REAL fraca(ngrid,klev+1)
+      REAL zpspsk(ngrid,klev)
+      REAL paprs(ngrid,klev+1)
+      REAL pplay(ngrid,klev)
+      REAL ztla(ngrid,klev)
+      REAL zthl(ngrid,klev)
+
+      REAL zqsatth(ngrid,klev)
+      REAL zqsatenv(ngrid,klev)
+      
+      REAL sigma1(ngrid,klev)                                                         
+      REAL sigma2(ngrid,klev)
+      REAL qlth(ngrid,klev)
+      REAL qlenv(ngrid,klev)
+      REAL qltot(ngrid,klev) 
+      REAL cth(ngrid,klev)
+      REAL cenv(ngrid,klev)   
+      REAL ctot(ngrid,klev)
+      REAL cth_vol(ngrid,klev)
+      REAL cenv_vol(ngrid,klev)
+      REAL ctot_vol(ngrid,klev)
+      REAL rneb(ngrid,klev)
+      REAL t(ngrid,klev)                                                                  
+      REAL qsatmmussig1,qsatmmussig2,sqrtpi,sqrt2,sqrt2pi,pi
+      REAL rdd,cppd,Lv
+      REAL alth,alenv,ath,aenv
+      REAL sth,senv,sigma1s,sigma2s,sigma1s_fraca,sigma1s_ratqs
+      REAL inverse_rho,beta,a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks
+      REAL xth,xenv,exp_xenv1,exp_xenv2,exp_xth1,exp_xth2
+      REAL xth1,xth2,xenv1,xenv2,deltasth, deltasenv
+      REAL IntJ,IntI1,IntI2,IntI3,IntJ_CF,IntI1_CF,IntI3_CF,coeffqlenv,coeffqlth
+      REAL Tbef,zdelta,qsatbef,zcor
+      REAL qlbef  
+      REAL ratqs(ngrid,klev) ! determine la largeur de distribution de vapeur
+      ! Change the width of the PDF used for vertical subgrid scale heterogeneity
+      ! (J Jouhaud, JL Dufresne, JB Madeleine)
+
+      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
+      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 
+      REAL zqs(ngrid), qcloud(ngrid)
+      REAL erf
+
+      REAL rhodz(ngrid,klev)
+      REAL zrho(ngrid,klev)
+      REAL dz(ngrid,klev)
+
+      DO ind1 = 1, ngrid
+        !Layer calculation
+        rhodz(ind1,ind2) = (paprs(ind1,ind2)-paprs(ind1,ind2+1))/rg !kg/m2
+        zrho(ind1,ind2) = pplay(ind1,ind2)/t(ind1,ind2)/rd !kg/m3
+        dz(ind1,ind2) = rhodz(ind1,ind2)/zrho(ind1,ind2) !m : epaisseur de la couche en metre
+      END DO
+
+!------------------------------------------------------------------------------
+! Initialize
+!------------------------------------------------------------------------------
+
+      sigma1(:,:)=0.
+      sigma2(:,:)=0.
+      qlth(:,:)=0.
+      qlenv(:,:)=0.  
+      qltot(:,:)=0.
+      rneb(:,:)=0.
+      qcloud(:)=0.
+      cth(:,:)=0.
+      cenv(:,:)=0.
+      ctot(:,:)=0.
+      cth_vol(:,:)=0.
+      cenv_vol(:,:)=0.
+      ctot_vol(:,:)=0.
+      qsatmmussig1=0.
+      qsatmmussig2=0.
+      rdd=287.04
+      cppd=1005.7
+      pi=3.14159 
+      Lv=2.5e6
+      sqrt2pi=sqrt(2.*pi)
+      sqrt2=sqrt(2.)
+      sqrtpi=sqrt(pi)
+
+
+
+!-------------------------------------------------------------------------------
+! Calcul de la fraction du thermique et des ecart-types des distributions
+!-------------------------------------------------------------------------------                 
+      do ind1=1,ngrid
+
+      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then !Thermal and environnement
+
+      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2)) !qt = a*qtth + (1-a)*qtenv
+
+
+      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES*FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatenv(ind1,ind2)=qsatbef
+
+
+      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84
+      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84
+      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84
+
+!zqenv = qt environnement
+!zqsatenv = qsat environnement
+!zthl = Tl environnement
+
+
+      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatth(ind1,ind2)=qsatbef
+            
+      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)       !qsl, p84
+      ath=1./(1.+(alth*Lv/cppd))                                        !al, p84
+      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))                      !s, p84
+      
+      
+!zqta = qt thermals
+!zqsatth = qsat thermals
+!ztla = Tl thermals
+!------------------------------------------------------------------------------
+! s standard deviation
+!------------------------------------------------------------------------------
+
+      sigma1s_fraca = (sigma1s_factor**0.5)*(fraca(ind1,ind2)**sigma1s_power) / &
+     &                (1-fraca(ind1,ind2))*((sth-senv)**2)**0.5
+!     sigma1s_fraca = (1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5
+      IF (cloudth_ratqsmin>0.) THEN
+         sigma1s_ratqs = cloudth_ratqsmin*po(ind1)
+      ELSE
+         sigma1s_ratqs = ratqs(ind1,ind2)*po(ind1)
+      ENDIF
+      sigma1s = sigma1s_fraca + sigma1s_ratqs
+      IF (iflag_ratqs.eq.11) then
+         sigma1s = ratqs(ind1,ind2)*po(ind1)*aenv
+      ENDIF
+      sigma2s=(sigma2s_factor*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**sigma2s_power))+0.002*zqta(ind1,ind2)
+!      tests
+!      sigma1s=(0.92**0.5)*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
+!      sigma1s=(0.92*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5))+0.002*zqenv(ind1)
+!      sigma2s=0.09*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.5+0.002*zqta(ind1,ind2) 
+!      sigma2s=(0.09*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**0.5))+ratqs(ind1,ind2)*zqta(ind1,ind2)
+!       if (paprs(ind1,ind2).gt.90000) then
+!       ratqs(ind1,ind2)=0.002
+!       else 
+!       ratqs(ind1,ind2)=0.002+0.0*(90000-paprs(ind1,ind2))/20000
+!       endif
+!       sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
+!       sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2) 
+!       sigma1s=ratqs(ind1,ind2)*po(ind1)
+!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.00003  
+ 
+       IF (iflag_cloudth_vert == 1) THEN
+!-------------------------------------------------------------------------------
+!  Version 2: Modification from Arnaud Jam according to JL Dufrense. Condensate from qsat-ratqs
+!-------------------------------------------------------------------------------
+
+      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
+      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
+
+      xenv1=(senv-deltasenv)/(sqrt(2.)*sigma1s)
+      xenv2=(senv+deltasenv)/(sqrt(2.)*sigma1s)
+      xth1=(sth-deltasth)/(sqrt(2.)*sigma2s)
+      xth2=(sth+deltasth)/(sqrt(2.)*sigma2s)
+      coeffqlenv=(sigma1s)**2/(2*sqrtpi*deltasenv)
+      coeffqlth=(sigma2s)**2/(2*sqrtpi*deltasth)
+      
+      cth(ind1,ind2)=0.5*(1.+1.*erf(xth2))
+      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv2)) 
+      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
+
+      ! Environment
+      IntJ=sigma1s*(exp(-1.*xenv1**2)/sqrt2pi)+0.5*senv*(1+erf(xenv1))
+      IntI1=coeffqlenv*0.5*(0.5*sqrtpi*(erf(xenv2)-erf(xenv1))+xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
+      IntI2=coeffqlenv*xenv2*(exp(-1.*xenv2**2)-exp(-1.*xenv1**2))
+      IntI3=coeffqlenv*0.5*sqrtpi*xenv2**2*(erf(xenv2)-erf(xenv1))
+
+      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
+
+      ! Thermal
+      IntJ=sigma2s*(exp(-1.*xth1**2)/sqrt2pi)+0.5*sth*(1+erf(xth1))
+      IntI1=coeffqlth*0.5*(0.5*sqrtpi*(erf(xth2)-erf(xth1))+xth1*exp(-1.*xth1**2)-xth2*exp(-1.*xth2**2))
+      IntI2=coeffqlth*xth2*(exp(-1.*xth2**2)-exp(-1.*xth1**2))
+      IntI3=coeffqlth*0.5*sqrtpi*xth2**2*(erf(xth2)-erf(xth1))
+      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
+      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
+
+      ELSE IF (iflag_cloudth_vert >= 3) THEN
+      IF (iflag_cloudth_vert < 5) THEN
+!-------------------------------------------------------------------------------
+!  Version 3: Changes by J. Jouhaud; condensation for q > -delta s
+!-------------------------------------------------------------------------------
+!      deltasenv=aenv*ratqs(ind1,ind2)*po(ind1)
+!      deltasth=ath*ratqs(ind1,ind2)*zqta(ind1,ind2)
+!      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
+!      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
+      IF (iflag_cloudth_vert == 3) THEN
+        deltasenv=aenv*vert_alpha*sigma1s
+        deltasth=ath*vert_alpha_th*sigma2s
+      ELSE IF (iflag_cloudth_vert == 4) THEN
+        IF (iflag_cloudth_vert_noratqs == 1) THEN
+          deltasenv=vert_alpha*max(sigma1s_fraca,1e-10)
+          deltasth=vert_alpha_th*sigma2s
+        ELSE
+          deltasenv=vert_alpha*sigma1s
+          deltasth=vert_alpha_th*sigma2s
+        ENDIF
+      ENDIF
+      
+      xenv1=-(senv+deltasenv)/(sqrt(2.)*sigma1s)
+      xenv2=-(senv-deltasenv)/(sqrt(2.)*sigma1s)
+      exp_xenv1 = exp(-1.*xenv1**2)
+      exp_xenv2 = exp(-1.*xenv2**2)
+      xth1=-(sth+deltasth)/(sqrt(2.)*sigma2s)
+      xth2=-(sth-deltasth)/(sqrt(2.)*sigma2s)
+      exp_xth1 = exp(-1.*xth1**2)
+      exp_xth2 = exp(-1.*xth2**2)
+      
+      !CF_surfacique
+      cth(ind1,ind2)=0.5*(1.-1.*erf(xth1))
+      cenv(ind1,ind2)=0.5*(1.-1.*erf(xenv1))
+      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2) 
+
+
+      !CF_volumique & eau condense
+      !environnement
+      IntJ=0.5*senv*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp_xenv2
+      IntJ_CF=0.5*(1.-1.*erf(xenv2))
+      if (deltasenv .lt. 1.e-10) then 
+      qlenv(ind1,ind2)=IntJ
+      cenv_vol(ind1,ind2)=IntJ_CF
+      else
+      IntI1=(((senv+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
+      IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp_xenv1-xenv2*exp_xenv2)
+      IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp_xenv1-exp_xenv2)
+      IntI1_CF=((senv+deltasenv)*(erf(xenv2)-erf(xenv1)))/(4*deltasenv)
+      IntI3_CF=(sqrt2*sigma1s*(exp_xenv1-exp_xenv2))/(4*sqrtpi*deltasenv)
+      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
+      cenv_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
+      endif
+
+      !thermique
+      IntJ=0.5*sth*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
+      IntJ_CF=0.5*(1.-1.*erf(xth2))
+      if (deltasth .lt. 1.e-10) then
+      qlth(ind1,ind2)=IntJ
+      cth_vol(ind1,ind2)=IntJ_CF
+      else
+      IntI1=(((sth+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
+      IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
+      IntI3=((sqrt2*sigma2s*(sth+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
+      IntI1_CF=((sth+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
+      IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
+      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
+      cth_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
+      endif
+
+      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
+      ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
+
+      ELSE IF (iflag_cloudth_vert == 5) THEN
+         sigma1s=(0.71794+0.000498239*dz(ind1,ind2))*(fraca(ind1,ind2)**0.5) &
+              /(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5) &
+              +ratqs(ind1,ind2)*po(ind1) !Environment
+      sigma2s=(0.03218+0.000092655*dz(ind1,ind2))/((fraca(ind1,ind2)+0.02)**0.5)*(((sth-senv)**2)**0.5)+0.002*zqta(ind1,ind2)                   !Thermals
+      !sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
+      !sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2) 
+      xth=sth/(sqrt(2.)*sigma2s)
+      xenv=senv/(sqrt(2.)*sigma1s)
+
+      !Volumique
+      cth_vol(ind1,ind2)=0.5*(1.+1.*erf(xth))
+      cenv_vol(ind1,ind2)=0.5*(1.+1.*erf(xenv))
+      ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
+      !print *,'jeanjean_CV=',ctot_vol(ind1,ind2)
+
+      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt(2.)*cth_vol(ind1,ind2))
+      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv_vol(ind1,ind2))  
+      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
+
+      !Surfacique
+      !Neggers
+      !beta=0.0044
+      !inverse_rho=1.+beta*dz(ind1,ind2)
+      !print *,'jeanjean : beta=',beta
+      !cth(ind1,ind2)=cth_vol(ind1,ind2)*inverse_rho
+      !cenv(ind1,ind2)=cenv_vol(ind1,ind2)*inverse_rho
+      !ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
+
+      !Brooks
+      a_Brooks=0.6694
+      b_Brooks=0.1882
+      A_Maj_Brooks=0.1635 !-- sans shear
+      !A_Maj_Brooks=0.17   !-- ARM LES
+      !A_Maj_Brooks=0.18   !-- RICO LES
+      !A_Maj_Brooks=0.19   !-- BOMEX LES
+      Dx_Brooks=200000.
+      f_Brooks=A_Maj_Brooks*(dz(ind1,ind2)**(a_Brooks))*(Dx_Brooks**(-b_Brooks))
+      !print *,'jeanjean_f=',f_Brooks
+
+      cth(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(cth_vol(ind1,ind2),1.)))- 1.))
+      cenv(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(cenv_vol(ind1,ind2),1.)))- 1.))
+      ctot(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(ctot_vol(ind1,ind2),1.)))- 1.))
+      !print *,'JJ_ctot_1',ctot(ind1,ind2)
+
+
+
+
+
+      ENDIF ! of if (iflag_cloudth_vert<5)
+      ENDIF ! of if (iflag_cloudth_vert==1 or 3 or 4)
+
+!      if (ctot(ind1,ind2).lt.1.e-10) then
+      if (cenv(ind1,ind2).lt.1.e-10.or.cth(ind1,ind2).lt.1.e-10) then
+      ctot(ind1,ind2)=0.
+      ctot_vol(ind1,ind2)=0.
+      qcloud(ind1)=zqsatenv(ind1,ind2)
+
+      else
+                
+      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
+!      qcloud(ind1)=fraca(ind1,ind2)*qlth(ind1,ind2)/cth(ind1,ind2) &
+!    &             +(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)/cenv(ind1,ind2)+zqs(ind1) 
+
+      endif  
+
+      else  ! gaussienne environnement seule
+      
+
+      zqenv(ind1)=po(ind1)
+      Tbef=t(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatenv(ind1,ind2)=qsatbef
+      
+
+!      qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
+      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
+      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)
+      aenv=1./(1.+(alenv*Lv/cppd))
+      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))
+      sth=0.
+      
+
+      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
+      sigma2s=0.
+
+      sqrt2pi=sqrt(2.*pi)
+      xenv=senv/(sqrt(2.)*sigma1s)
+      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
+      ctot_vol(ind1,ind2)=ctot(ind1,ind2)
+      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
+      
+      if (ctot(ind1,ind2).lt.1.e-3) then
+      ctot(ind1,ind2)=0.
+      qcloud(ind1)=zqsatenv(ind1,ind2)
+
+      else   
+                
+!      ctot(ind1,ind2)=ctot(ind1,ind2) 
+      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
+
+      endif  
+ 
+
+
+
+      endif       ! From the separation (thermal/envrionnement) et (environnement) only, l.335 et l.492
+      ! Outputs used to check the PDFs
+      cloudth_senv(ind1,ind2) = senv
+      cloudth_sth(ind1,ind2) = sth
+      cloudth_sigmaenv(ind1,ind2) = sigma1s
+      cloudth_sigmath(ind1,ind2) = sigma2s
+
+      enddo       ! from the loop on ngrid l.333
+      return
+!     end
+END SUBROUTINE cloudth_vert_v3
+!
+
+
+
+
+
+
+
+
+
+
+
+       SUBROUTINE cloudth_v6(ngrid,klev,ind2,  &
+     &           ztv,po,zqta,fraca, & 
+     &           qcloud,ctot_surf,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
+     &           ratqs,zqs,T, &
+     &           cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+      use lmdz_cloudth_ini, only: iflag_cloudth_vert
+
+      IMPLICIT NONE
+
+
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOETHF.h"
+      INCLUDE "FCTTRE.h"
+
+
+        !Domain variables
+      INTEGER ngrid !indice Max lat-lon
+      INTEGER klev  !indice Max alt
+      real, dimension(ngrid,klev), intent(out) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
+      INTEGER ind1  !indice in [1:ngrid]
+      INTEGER ind2  !indice in [1:klev]
+        !thermal plume fraction
+      REAL fraca(ngrid,klev+1)   !thermal plumes fraction in the gridbox
+        !temperatures
+      REAL T(ngrid,klev)       !temperature
+      REAL zpspsk(ngrid,klev)  !factor (p/p0)**kappa (used for potential variables)
+      REAL ztv(ngrid,klev)     !potential temperature (voir thermcell_env.F90)
+      REAL ztla(ngrid,klev)    !liquid temperature in the thermals (Tl_th)
+      REAL zthl(ngrid,klev)    !liquid temperature in the environment (Tl_env)
+        !pressure
+      REAL paprs(ngrid,klev+1)   !pressure at the interface of levels
+      REAL pplay(ngrid,klev)     !pressure at the middle of the level
+        !humidity
+      REAL ratqs(ngrid,klev)   !width of the total water subgrid-scale distribution
+      REAL po(ngrid)           !total water (qt)
+      REAL zqenv(ngrid)        !total water in the environment (qt_env)
+      REAL zqta(ngrid,klev)    !total water in the thermals (qt_th)
+      REAL zqsatth(ngrid,klev)   !water saturation level in the thermals (q_sat_th)
+      REAL zqsatenv(ngrid,klev)  !water saturation level in the environment (q_sat_env)
+      REAL qlth(ngrid,klev)    !condensed water in the thermals
+      REAL qlenv(ngrid,klev)   !condensed water in the environment
+      REAL qltot(ngrid,klev)   !condensed water in the gridbox
+        !cloud fractions
+      REAL cth_vol(ngrid,klev)   !cloud fraction by volume in the thermals
+      REAL cenv_vol(ngrid,klev)  !cloud fraction by volume in the environment
+      REAL ctot_vol(ngrid,klev)  !cloud fraction by volume in the gridbox
+      REAL cth_surf(ngrid,klev)  !cloud fraction by surface in the thermals
+      REAL cenv_surf(ngrid,klev) !cloud fraction by surface in the environment  
+      REAL ctot_surf(ngrid,klev) !cloud fraction by surface in the gridbox
+        !PDF of saturation deficit variables
+      REAL rdd,cppd,Lv
+      REAL Tbef,zdelta,qsatbef,zcor
+      REAL alth,alenv,ath,aenv
+      REAL sth,senv              !saturation deficits in the thermals and environment
+      REAL sigma_env,sigma_th    !standard deviations of the biGaussian PDF
+        !cloud fraction variables
+      REAL xth,xenv
+      REAL inverse_rho,beta                                  !Neggers et al. (2011) method
+      REAL a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks !Brooks et al. (2005) method
+        !Incloud total water variables
+      REAL zqs(ngrid)    !q_sat
+      REAL qcloud(ngrid) !eau totale dans le nuage
+        !Some arithmetic variables
+      REAL erf,pi,sqrt2,sqrt2pi
+        !Depth of the layer
+      REAL dz(ngrid,klev)    !epaisseur de la couche en metre
+      REAL rhodz(ngrid,klev)
+      REAL zrho(ngrid,klev)
+      DO ind1 = 1, ngrid
+        rhodz(ind1,ind2) = (paprs(ind1,ind2)-paprs(ind1,ind2+1))/rg ![kg/m2]
+        zrho(ind1,ind2) = pplay(ind1,ind2)/T(ind1,ind2)/rd          ![kg/m3]
+        dz(ind1,ind2) = rhodz(ind1,ind2)/zrho(ind1,ind2)            ![m]
+      END DO
+
+!------------------------------------------------------------------------------
+! Initialization
+!------------------------------------------------------------------------------
+      qlth(:,:)=0.
+      qlenv(:,:)=0.  
+      qltot(:,:)=0.
+      cth_vol(:,:)=0.
+      cenv_vol(:,:)=0.
+      ctot_vol(:,:)=0.
+      cth_surf(:,:)=0.
+      cenv_surf(:,:)=0.
+      ctot_surf(:,:)=0.
+      qcloud(:)=0.
+      rdd=287.04
+      cppd=1005.7
+      pi=3.14159 
+      Lv=2.5e6
+      sqrt2=sqrt(2.)
+      sqrt2pi=sqrt(2.*pi)
+
+
+      DO ind1=1,ngrid
+!-------------------------------------------------------------------------------
+!Both thermal and environment in the gridbox
+!-------------------------------------------------------------------------------
+      IF ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) THEN
+        !--------------------------------------------
+        !calcul de qsat_env
+        !--------------------------------------------
+      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES*FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatenv(ind1,ind2)=qsatbef
+        !--------------------------------------------
+        !calcul de s_env
+        !--------------------------------------------
+      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84 these Arnaud Jam
+      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84 these Arnaud Jam
+      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84 these Arnaud Jam
+        !--------------------------------------------
+        !calcul de qsat_th
+        !--------------------------------------------
+      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatth(ind1,ind2)=qsatbef
+        !--------------------------------------------
+        !calcul de s_th  
+        !--------------------------------------------
+      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)       !qsl, p84 these Arnaud Jam
+      ath=1./(1.+(alth*Lv/cppd))                                        !al, p84 these Arnaud Jam
+      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))                      !s, p84 these Arnaud Jam
+        !--------------------------------------------
+        !calcul standard deviations bi-Gaussian PDF
+        !--------------------------------------------
+      sigma_th=(0.03218+0.000092655*dz(ind1,ind2))/((fraca(ind1,ind2)+0.01)**0.5)*(((sth-senv)**2)**0.5)+0.002*zqta(ind1,ind2)
+      sigma_env=(0.71794+0.000498239*dz(ind1,ind2))*(fraca(ind1,ind2)**0.5) &
+           /(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5) &
+           +ratqs(ind1,ind2)*po(ind1)
+      xth=sth/(sqrt2*sigma_th)
+      xenv=senv/(sqrt2*sigma_env)
+        !--------------------------------------------
+        !Cloud fraction by volume CF_vol
+        !--------------------------------------------
+      cth_vol(ind1,ind2)=0.5*(1.+1.*erf(xth))
+      cenv_vol(ind1,ind2)=0.5*(1.+1.*erf(xenv))
+      ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
+        !-------------------------------------------- 
+        !Condensed water qc
+        !--------------------------------------------
+      qlth(ind1,ind2)=sigma_th*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt2*cth_vol(ind1,ind2))
+      qlenv(ind1,ind2)=sigma_env*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*cenv_vol(ind1,ind2))  
+      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
+        !--------------------------------------------
+        !Cloud fraction by surface CF_surf
+        !--------------------------------------------
+        !Method Neggers et al. (2011) : ok for cumulus clouds only
+      !beta=0.0044 (Jouhaud et al.2018)
+      !inverse_rho=1.+beta*dz(ind1,ind2)
+      !ctot_surf(ind1,ind2)=ctot_vol(ind1,ind2)*inverse_rho
+        !Method Brooks et al. (2005) : ok for all types of clouds
+      a_Brooks=0.6694
+      b_Brooks=0.1882
+      A_Maj_Brooks=0.1635 !-- sans dependence au cisaillement de vent
+      Dx_Brooks=200000.   !-- si l'on considere des mailles de 200km de cote
+      f_Brooks=A_Maj_Brooks*(dz(ind1,ind2)**(a_Brooks))*(Dx_Brooks**(-b_Brooks))
+      ctot_surf(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(ctot_vol(ind1,ind2),1.)))- 1.))
+        !--------------------------------------------
+        !Incloud Condensed water qcloud
+        !--------------------------------------------
+      if (ctot_surf(ind1,ind2) .lt. 1.e-10) then
+      ctot_vol(ind1,ind2)=0.
+      ctot_surf(ind1,ind2)=0.
+      qcloud(ind1)=zqsatenv(ind1,ind2)
+      else
+      qcloud(ind1)=qltot(ind1,ind2)/ctot_vol(ind1,ind2)+zqs(ind1)
+      endif
+
+
+
+!-------------------------------------------------------------------------------
+!Environment only in the gridbox
+!-------------------------------------------------------------------------------
+      ELSE
+        !--------------------------------------------
+        !calcul de qsat_env
+        !--------------------------------------------
+      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatenv(ind1,ind2)=qsatbef
+        !--------------------------------------------
+        !calcul de s_env
+        !--------------------------------------------
+      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84 these Arnaud Jam
+      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84 these Arnaud Jam
+      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84 these Arnaud Jam 
+        !--------------------------------------------
+        !calcul standard deviations Gaussian PDF
+        !--------------------------------------------
+      zqenv(ind1)=po(ind1)
+      sigma_env=ratqs(ind1,ind2)*zqenv(ind1)
+      xenv=senv/(sqrt2*sigma_env)
+        !--------------------------------------------
+        !Cloud fraction by volume CF_vol
+        !--------------------------------------------
+      ctot_vol(ind1,ind2)=0.5*(1.+1.*erf(xenv))
+        !--------------------------------------------
+        !Condensed water qc
+        !--------------------------------------------
+      qltot(ind1,ind2)=sigma_env*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*ctot_vol(ind1,ind2))
+        !--------------------------------------------
+        !Cloud fraction by surface CF_surf
+        !--------------------------------------------
+        !Method Neggers et al. (2011) : ok for cumulus clouds only
+      !beta=0.0044 (Jouhaud et al.2018)
+      !inverse_rho=1.+beta*dz(ind1,ind2)
+      !ctot_surf(ind1,ind2)=ctot_vol(ind1,ind2)*inverse_rho
+        !Method Brooks et al. (2005) : ok for all types of clouds
+      a_Brooks=0.6694
+      b_Brooks=0.1882
+      A_Maj_Brooks=0.1635 !-- sans dependence au shear
+      Dx_Brooks=200000.
+      f_Brooks=A_Maj_Brooks*(dz(ind1,ind2)**(a_Brooks))*(Dx_Brooks**(-b_Brooks))
+      ctot_surf(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(ctot_vol(ind1,ind2),1.)))- 1.))
+        !--------------------------------------------
+        !Incloud Condensed water qcloud
+        !--------------------------------------------
+      if (ctot_surf(ind1,ind2) .lt. 1.e-8) then
+      ctot_vol(ind1,ind2)=0.
+      ctot_surf(ind1,ind2)=0.
+      qcloud(ind1)=zqsatenv(ind1,ind2)
+      else
+      qcloud(ind1)=qltot(ind1,ind2)/ctot_vol(ind1,ind2)+zqsatenv(ind1,ind2)
+      endif
+
+
+      END IF  ! From the separation (thermal/envrionnement) et (environnement only)
+
+      ! Outputs used to check the PDFs
+      cloudth_senv(ind1,ind2) = senv
+      cloudth_sth(ind1,ind2) = sth
+      cloudth_sigmaenv(ind1,ind2) = sigma_env
+      cloudth_sigmath(ind1,ind2) = sigma_th
+
+      END DO  ! From the loop on ngrid
+      return
+
+END SUBROUTINE cloudth_v6
+
+
+
+
+
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+SUBROUTINE cloudth_mpc(klon,klev,ind2,iflag_mpc_bl,mpc_bl_points,           &
+&           temp,ztv,po,zqta,fraca,zpspsk,paprs,pplay,ztla,zthl,            &
+&           ratqs,zqs,snowflux,qcloud,qincloud,icefrac,ctot,ctot_vol,       &
+&           cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! Author : Arnaud Octavio Jam (LMD/CNRS), Etienne Vignon (LMDZ/CNRS)
+! Date: Adapted from cloudth_vert_v3 in 2021
+! Aim : computes qc and rneb in thermals with cold microphysical considerations
+!       + for mixed phase boundary layer clouds, calculate ql and qi from 
+!       a stationary MPC model
+! IMPORTANT NOTE: we assume iflag_clouth_vert=3
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+      use lmdz_cloudth_ini, only: iflag_cloudth_vert,iflag_ratqs
+      use lmdz_cloudth_ini, only:  C_mpc ,Ni,C_cap,Ei,d_top ,vert_alpha, vert_alpha_th ,sigma1s_factor,sigma1s_power,sigma2s_factor,sigma2s_power,cloudth_ratqsmin ,iflag_cloudth_vert_noratqs
+      use lmdz_lscp_tools, ONLY: CALC_QSAT_ECMWF, FALLICE_VELOCITY
+
+      use phys_local_var_mod, ONLY : qlth, qith, qsith, wiceth
+
+      IMPLICIT NONE
+
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOETHF.h"
+      INCLUDE "FCTTRE.h"
+      
+
+!------------------------------------------------------------------------------
+! Declaration
+!------------------------------------------------------------------------------
+
+! INPUT/OUTPUT
+
+      INTEGER, INTENT(IN)                         :: klon,klev,ind2
+      
+
+      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  temp          ! Temperature [K]
+      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  ztv           ! Virtual potential temp [K]
+      REAL, DIMENSION(klon),      INTENT(IN)      ::  po            ! specific humidity [kg/kg]
+      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  zqta          ! specific humidity within thermals [kg/kg]
+      REAL, DIMENSION(klon,klev+1), INTENT(IN)    ::  fraca         ! Fraction of the mesh covered by thermals [0-1] 
+      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  zpspsk
+      REAL, DIMENSION(klon,klev+1), INTENT(IN)    ::  paprs         ! Pressure at layer interfaces [Pa]
+      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  pplay         ! Pressure at the center of layers [Pa]
+      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  ztla          ! Liquid temp [K]
+      REAL, DIMENSION(klon,klev), INTENT(INOUT)      ::  zthl       ! Liquid potential temp [K]
+      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  ratqs         ! Parameter that determines the width of the total water distrib.
+      REAL, DIMENSION(klon),      INTENT(IN)      ::  zqs           ! Saturation specific humidity in the mesh [kg/kg]
+      REAL, DIMENSION(klon,klev+1), INTENT(IN)    ::  snowflux      ! snow flux at the interface of the layer [kg/m2/s]
+      INTEGER,                      INTENT(IN)    ::  iflag_mpc_bl  ! option flag for mpc boundary layer clouds param.
+
+
+      INTEGER, DIMENSION(klon,klev), INTENT(INOUT) :: mpc_bl_points  ! grid points with convective (thermals) mixed phase clouds
+      
+      REAL, DIMENSION(klon,klev), INTENT(OUT)      ::  ctot         ! Cloud fraction [0-1]
+      REAL, DIMENSION(klon,klev), INTENT(OUT)      ::  ctot_vol     ! Volume cloud fraction [0-1]
+      REAL, DIMENSION(klon),      INTENT(OUT)      ::  qcloud       ! In cloud total water content [kg/kg] 
+      REAL, DIMENSION(klon),      INTENT(OUT)      ::  qincloud       ! In cloud condensed water content [kg/kg] 
+      REAL, DIMENSION(klon,klev), INTENT(OUT)      ::  icefrac      ! Fraction of ice in clouds [0-1]
+      real, dimension(klon,klev), intent(out) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
+
+
+! LOCAL VARIABLES
+
+      INTEGER itap,ind1,l,ig,iter,k 
+      INTEGER iflag_topthermals, niter
+      LOGICAL falseklon(klon)
+
+      REAL zqsatth(klon), zqsatenv(klon), zqsatenvonly(klon)
+      REAL sigma1(klon,klev)                                                         
+      REAL sigma2(klon,klev)
+      REAL qcth(klon,klev)
+      REAL qcenv(klon,klev)
+      REAL qctot(klon,klev) 
+      REAL cth(klon,klev)
+      REAL cenv(klon,klev)   
+      REAL cth_vol(klon,klev)
+      REAL cenv_vol(klon,klev)
+      REAL rneb(klon,klev)
+      REAL zqenv(klon), zqth(klon), zqenvonly(klon) 
+      REAL qsatmmussig1,qsatmmussig2,sqrtpi,sqrt2,sqrt2pi,pi
+      REAL rdd,cppd,Lv
+      REAL alth,alenv,ath,aenv
+      REAL sth,senv,sigma1s,sigma2s,sigma1s_fraca,sigma1s_ratqs
+      REAL inverse_rho,beta,a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks
+      REAL xth,xenv,exp_xenv1,exp_xenv2,exp_xth1,exp_xth2
+      REAL xth1,xth2,xenv1,xenv2,deltasth, deltasenv
+      REAL IntJ,IntI1,IntI2,IntI3,IntJ_CF,IntI1_CF,IntI3_CF,coeffqlenv,coeffqlth
+      REAL zdelta,qsatbef,zcor
+      REAL Tbefth(klon), Tbefenv(klon), Tbefenvonly(klon), rhoth(klon)
+      REAL qlbef
+      REAL dqsatenv(klon), dqsatth(klon), dqsatenvonly(klon)
+      REAL erf
+      REAL zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
+      REAL zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon) 
+      REAL rhodz(klon,klev)
+      REAL zrho(klon,klev)
+      REAL dz(klon,klev)
+      REAL qslenv(klon), qslth(klon) 
+      REAL alenvl, aenvl
+      REAL sthi, sthl, sthil, althl, athl, althi, athi, sthlc, deltasthc, sigma2sc
+      REAL senvi, senvl, qbase, sbase, qliqth, qiceth
+      REAL qmax, ttarget, stmp, cout, coutref, fraci
+      REAL maxi, mini, pas, temp_lim
+      REAL deltazlev_mpc(klev), temp_mpc(klev), pres_mpc(klev), fraca_mpc(klev+1), snowf_mpc(klev+1)
+
+      ! Modifty the saturation deficit PDF in thermals 
+      ! in the presence of ice crystals
+      CHARACTER (len = 80) :: abort_message
+      CHARACTER (len = 20) :: routname = 'cloudth_mpc'
+
+
+!------------------------------------------------------------------------------
+! Initialisation
+!------------------------------------------------------------------------------
+
+
+! Few initial checksS
+
+      IF (iflag_cloudth_vert.NE.3) THEN
+         abort_message = 'clouth_mpc cannot be used if iflag_cloudth_vert .NE. 3'
+         CALL abort_physic(routname,abort_message,1)
+      ENDIF
+
+      DO k = 1,klev
+      DO ind1 = 1, klon
+        rhodz(ind1,k) = (paprs(ind1,k)-paprs(ind1,k+1))/rg !kg/m2
+        zrho(ind1,k) = pplay(ind1,k)/temp(ind1,k)/rd !kg/m3
+        dz(ind1,k) = rhodz(ind1,k)/zrho(ind1,k) !m : epaisseur de la couche en metre
+      END DO
+      END DO
+
+
+      sigma1(:,:)=0.
+      sigma2(:,:)=0.
+      qcth(:,:)=0.
+      qcenv(:,:)=0.  
+      qctot(:,:)=0.
+      qlth(:,ind2)=0.
+      qith(:,ind2)=0.
+      wiceth(:,ind2)=0.
+      rneb(:,:)=0.
+      qcloud(:)=0.
+      cth(:,:)=0.
+      cenv(:,:)=0.
+      ctot(:,:)=0.
+      cth_vol(:,:)=0.
+      cenv_vol(:,:)=0.
+      ctot_vol(:,:)=0.
+      falseklon(:)=.false.
+      qsatmmussig1=0.
+      qsatmmussig2=0.
+      rdd=287.04
+      cppd=1005.7
+      pi=3.14159 
+      sqrt2pi=sqrt(2.*pi)
+      sqrt2=sqrt(2.)
+      sqrtpi=sqrt(pi)
+      icefrac(:,ind2)=0.
+      althl=0.
+      althi=0.
+      athl=0.
+      athi=0.
+      senvl=0.
+      senvi=0.
+      sthi=0.
+      sthl=0.
+      sthil=0.
+
+!-------------------------------------------------------------------------------
+! Identify grid points with potential mixed-phase conditions
+!-------------------------------------------------------------------------------
+
+      temp_lim=RTT-40.0
+
+      DO ind1=1,klon
+            IF ((temp(ind1,ind2) .LT. RTT) .AND. (temp(ind1,ind2) .GT. temp_lim) &
+            .AND. (iflag_mpc_bl .GE. 1) .AND. (ind2<=klev-2)  &
+            .AND. (ztv(ind1,1).GT.ztv(ind1,2)) .AND.(fraca(ind1,ind2).GT.1.e-10)) THEN
+                mpc_bl_points(ind1,ind2)=1
+            ELSE
+                mpc_bl_points(ind1,ind2)=0
+            ENDIF
+      ENDDO
+
+
+!-------------------------------------------------------------------------------
+! Thermal fraction calculation and standard deviation of the distribution
+!-------------------------------------------------------------------------------  
+
+! calculation of temperature, humidity and saturation specific humidity
+
+Tbefenv(:)=zthl(:,ind2)*zpspsk(:,ind2)
+Tbefth(:)=ztla(:,ind2)*zpspsk(:,ind2)
+Tbefenvonly(:)=temp(:,ind2)
+rhoth(:)=paprs(:,ind2)/Tbefth(:)/RD
+
+zqenv(:)=(po(:)-fraca(:,ind2)*zqta(:,ind2))/(1.-fraca(:,ind2)) !qt = a*qtth + (1-a)*qtenv 
+zqth(:)=zqta(:,ind2)
+zqenvonly(:)=po(:)
+
+
+CALL CALC_QSAT_ECMWF(klon,Tbefenvonly,zqenvonly,paprs(:,ind2),RTT,0,.false.,zqsatenvonly,dqsatenv)
+
+CALL CALC_QSAT_ECMWF(klon,Tbefenv,zqenv,paprs(:,ind2),RTT,0,.false.,zqsatenv,dqsatenv)
+CALL CALC_QSAT_ECMWF(klon,Tbefenv,zqenv,paprs(:,ind2),RTT,1,.false.,qslenv,dqsatenv)
+
+CALL CALC_QSAT_ECMWF(klon,Tbefth,zqth,paprs(:,ind2),RTT,1,.false.,qslth,dqsatth)
+CALL CALC_QSAT_ECMWF(klon,Tbefth,zqth,paprs(:,ind2),RTT,2,.false.,qsith(:,ind2),dqsatth)
+CALL CALC_QSAT_ECMWF(klon,Tbefth,zqth,paprs(:,ind2),RTT,0,.false.,zqsatth,dqsatth)
+
+
+  DO ind1=1,klon
+
+
+    IF ((ztv(ind1,1).GT.ztv(ind1,2)).AND.(fraca(ind1,ind2).GT.1.e-10)) THEN !Thermal and environnement
+
+
+! Environment:
+
+
+        IF (Tbefenv(ind1) .GE. RTT) THEN
+               Lv=RLVTT
+        ELSE
+               Lv=RLSTT
+        ENDIF
+        
+
+        alenv=(0.622*Lv*zqsatenv(ind1))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84
+        aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84
+        senv=aenv*(po(ind1)-zqsatenv(ind1))                          !s, p84
+     
+        ! For MPCs:
+        IF (mpc_bl_points(ind1,ind2) .EQ. 1) THEN
+        alenvl=(0.622*RLVTT*qslenv(ind1))/(rdd*zthl(ind1,ind2)**2)     
+        aenvl=1./(1.+(alenv*Lv/cppd))         
+        senvl=aenvl*(po(ind1)-qslenv(ind1))    
+        senvi=senv
+        ENDIF
+
+
+! Thermals:
+
+
+        IF (Tbefth(ind1) .GE. RTT) THEN
+            Lv=RLVTT
+        ELSE
+            Lv=RLSTT
+        ENDIF
+
+        
+        alth=(0.622*Lv*zqsatth(ind1))/(rdd*ztla(ind1,ind2)**2)       
+        ath=1./(1.+(alth*Lv/cppd))                                                         
+        sth=ath*(zqta(ind1,ind2)-zqsatth(ind1))                      
+
+       ! For MPCs:
+        IF (mpc_bl_points(ind1,ind2) .GT. 0) THEN
+         althi=alth
+         althl=(0.622*RLVTT*qslth(ind1))/(rdd*ztla(ind1,ind2)**2)                    
+         athl=1./(1.+(alth*RLVTT/cppd)) 
+         athi=alth     
+         sthl=athl*(zqta(ind1,ind2)-qslth(ind1))   
+         sthi=athi*(zqta(ind1,ind2)-qsith(ind1,ind2))  
+         sthil=athi*(zqta(ind1,ind2)-qslth(ind1))
+        ENDIF     
+
+
+
+!-------------------------------------------------------------------------------
+!  Version 3: Changes by J. Jouhaud; condensation for q > -delta s
+!  Rq: in this subroutine, we assume iflag_clouth_vert .EQ. 3 
+!-------------------------------------------------------------------------------
+
+        IF (mpc_bl_points(ind1,ind2) .EQ. 0) THEN ! No BL MPC
+
+       ! Standard deviation of the distributions
+
+           sigma1s_fraca = (sigma1s_factor**0.5)*(fraca(ind1,ind2)**sigma1s_power) / &
+           &                (1-fraca(ind1,ind2))*((sth-senv)**2)**0.5
+
+           IF (cloudth_ratqsmin>0.) THEN
+             sigma1s_ratqs = cloudth_ratqsmin*po(ind1)
+           ELSE
+             sigma1s_ratqs = ratqs(ind1,ind2)*po(ind1)
+           ENDIF
+ 
+           sigma1s = sigma1s_fraca + sigma1s_ratqs
+           IF (iflag_ratqs.eq.11) then
+              sigma1s = ratqs(ind1,ind2)*po(ind1)*aenv
+           ENDIF
+           sigma2s=(sigma2s_factor*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**sigma2s_power))+0.002*zqta(ind1,ind2)
+
+
+           deltasenv=aenv*vert_alpha*sigma1s
+           deltasth=ath*vert_alpha_th*sigma2s
+
+           xenv1=-(senv+deltasenv)/(sqrt(2.)*sigma1s)
+           xenv2=-(senv-deltasenv)/(sqrt(2.)*sigma1s)
+           exp_xenv1 = exp(-1.*xenv1**2)
+           exp_xenv2 = exp(-1.*xenv2**2)
+           xth1=-(sth+deltasth)/(sqrt(2.)*sigma2s)
+           xth2=-(sth-deltasth)/(sqrt(2.)*sigma2s)
+           exp_xth1 = exp(-1.*xth1**2)
+           exp_xth2 = exp(-1.*xth2**2)
+      
+      !surface CF
+
+           cth(ind1,ind2)=0.5*(1.-1.*erf(xth1))
+           cenv(ind1,ind2)=0.5*(1.-1.*erf(xenv1))
+           ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2) 
+
+
+      !volume CF and condensed water
+
+            !environnement
+
+            IntJ=0.5*senv*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp_xenv2
+            IntJ_CF=0.5*(1.-1.*erf(xenv2))
+
+            IF (deltasenv .LT. 1.e-10) THEN 
+              qcenv(ind1,ind2)=IntJ
+              cenv_vol(ind1,ind2)=IntJ_CF
+            ELSE
+              IntI1=(((senv+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
+              IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp_xenv1-xenv2*exp_xenv2)
+              IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp_xenv1-exp_xenv2)
+              IntI1_CF=((senv+deltasenv)*(erf(xenv2)-erf(xenv1)))/(4*deltasenv)
+              IntI3_CF=(sqrt2*sigma1s*(exp_xenv1-exp_xenv2))/(4*sqrtpi*deltasenv)
+              qcenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
+              cenv_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
+            ENDIF
+             
+
+
+            !thermals
+
+            IntJ=0.5*sth*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
+            IntJ_CF=0.5*(1.-1.*erf(xth2))
+     
+            IF (deltasth .LT. 1.e-10) THEN
+              qcth(ind1,ind2)=IntJ
+              cth_vol(ind1,ind2)=IntJ_CF
+            ELSE
+              IntI1=(((sth+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
+              IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
+              IntI3=((sqrt2*sigma2s*(sth+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
+              IntI1_CF=((sth+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
+              IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
+              qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
+              cth_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
+            ENDIF
+
+              qctot(ind1,ind2)=fraca(ind1,ind2)*qcth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qcenv(ind1,ind2)
+              ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
+              
+
+            IF (cenv(ind1,ind2).LT.1.e-10.or.cth(ind1,ind2).LT.1.e-10) THEN
+                ctot(ind1,ind2)=0.
+                ctot_vol(ind1,ind2)=0.
+                qcloud(ind1)=zqsatenv(ind1)
+                qincloud(ind1)=0.
+            ELSE               
+                qcloud(ind1)=qctot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
+                qincloud(ind1)=qctot(ind1,ind2)/ctot(ind1,ind2)
+            ENDIF 
+
+
+        ELSE ! mpc_bl_points>0
+
+            ! Treat boundary layer mixed phase clouds
+            
+            ! thermals
+            !=========
+
+            ! ice phase
+            !...........
+
+            qiceth=0.
+            deltazlev_mpc=dz(ind1,:)
+            temp_mpc=ztla(ind1,:)*zpspsk(ind1,:)
+            pres_mpc=pplay(ind1,:)
+            fraca_mpc=fraca(ind1,:)
+            snowf_mpc=snowflux(ind1,:)
+            iflag_topthermals=0
+            IF ((mpc_bl_points(ind1,ind2) .EQ. 1) .AND. (mpc_bl_points(ind1,ind2+1) .EQ. 0))  THEN
+                iflag_topthermals = 1
+            ELSE IF ((mpc_bl_points(ind1,ind2) .EQ. 1) .AND. (mpc_bl_points(ind1,ind2+1) .EQ. 1) & 
+                    .AND. (mpc_bl_points(ind1,ind2+2) .EQ. 0) ) THEN
+                iflag_topthermals = 2
+            ELSE 
+                iflag_topthermals = 0
+            ENDIF
+
+            CALL ICE_MPC_BL_CLOUDS(ind1,ind2,klev,Ni,Ei,C_cap,d_top,iflag_topthermals,temp_mpc,pres_mpc,zqta(ind1,:), &
+                                   qsith(ind1,:),qlth(ind1,:),deltazlev_mpc,wiceth(ind1,:),fraca_mpc,qith(ind1,:))
+
+            ! qmax calculation
+            sigma2s=(sigma2s_factor*((MAX((sthl-senvl),0.)**2)**0.5)/((fraca(ind1,ind2)+0.02)**sigma2s_power))+0.002*zqta(ind1,ind2)
+            deltasth=athl*vert_alpha_th*sigma2s
+            xth1=-(sthl+deltasth)/(sqrt(2.)*sigma2s)
+            xth2=-(sthl-deltasth)/(sqrt(2.)*sigma2s)
+            exp_xth1 = exp(-1.*xth1**2)
+            exp_xth2 = exp(-1.*xth2**2)
+            IntJ=0.5*sthl*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
+            IntJ_CF=0.5*(1.-1.*erf(xth2))
+            IntI1=(((sthl+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
+            IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
+            IntI3=((sqrt2*sigma2s*(sthl+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
+            IntI1_CF=((sthl+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
+            IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
+            qmax=MAX(IntJ+IntI1+IntI2+IntI3,0.)
+
+
+            ! Liquid phase
+            !................
+            ! We account for the effect of ice crystals in thermals on sthl
+            ! and on the width of the distribution
+
+            sthlc=sthl*1./(1.+C_mpc*qith(ind1,ind2))  &
+                + (1.-1./(1.+C_mpc*qith(ind1,ind2))) * athl*(qsith(ind1,ind2)-qslth(ind1))  
+
+            sigma2sc=(sigma2s_factor*((MAX((sthlc-senvl),0.)**2)**0.5) &
+                 /((fraca(ind1,ind2)+0.02)**sigma2s_power)) &
+                 +0.002*zqta(ind1,ind2)
+            deltasthc=athl*vert_alpha_th*sigma2sc
+     
+            
+            xth1=-(sthlc+deltasthc)/(sqrt(2.)*sigma2sc)
+            xth2=-(sthlc-deltasthc)/(sqrt(2.)*sigma2sc)           
+            exp_xth1 = exp(-1.*xth1**2)
+            exp_xth2 = exp(-1.*xth2**2)
+            IntJ=0.5*sthlc*(1-erf(xth2))+(sigma2sc/sqrt2pi)*exp_xth2
+            IntJ_CF=0.5*(1.-1.*erf(xth2))
+            IntI1=(((sthlc+deltasthc)**2+(sigma2sc)**2)/(8*deltasthc))*(erf(xth2)-erf(xth1))
+            IntI2=(sigma2sc**2/(4*deltasthc*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
+            IntI3=((sqrt2*sigma2sc*(sthlc+deltasthc))/(4*sqrtpi*deltasthc))*(exp_xth1-exp_xth2)
+            IntI1_CF=((sthlc+deltasthc)*(erf(xth2)-erf(xth1)))/(4*deltasthc)
+            IntI3_CF=(sqrt2*sigma2sc*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasthc)
+            qliqth=IntJ+IntI1+IntI2+IntI3
+            
+            qlth(ind1,ind2)=MAX(0.,qliqth)
+
+            ! Condensed water
+            
+            qcth(ind1,ind2)=qlth(ind1,ind2)+qith(ind1,ind2)
+
+
+            ! consistency with subgrid distribution
+           
+             IF ((qcth(ind1,ind2) .GT. qmax) .AND. (qcth(ind1,ind2) .GT. 0)) THEN
+                 fraci=qith(ind1,ind2)/qcth(ind1,ind2)
+                 qcth(ind1,ind2)=qmax
+                 qith(ind1,ind2)=fraci*qmax
+                 qlth(ind1,ind2)=(1.-fraci)*qmax
+             ENDIF
+
+            ! Cloud Fraction
+            !...............
+            ! calculation of qbase which is the value of the water vapor within mixed phase clouds
+            ! such that the total water in cloud = qbase+qliqth+qiceth
+            ! sbase is the value of s such that int_sbase^\intfy s ds = cloud fraction
+            ! sbase and qbase calculation (note that sbase is wrt liq so negative)
+            ! look for an approximate solution with iteration
+            
+            ttarget=qcth(ind1,ind2)
+            mini= athl*(qsith(ind1,ind2)-qslth(ind1))
+            maxi= 0. !athl*(3.*sqrt(sigma2s))
+            niter=20
+            pas=(maxi-mini)/niter
+            stmp=mini
+            sbase=stmp
+            coutref=1.E6
+            DO iter=1,niter
+                cout=ABS(sigma2s/SQRT(2.*RPI)*EXP(-((sthl-stmp)/sigma2s)**2)+(sthl-stmp)/SQRT(2.)*(1.-erf(-(sthl-stmp)/sigma2s)) &
+                     + stmp/2.*(1.-erf(-(sthl-stmp)/sigma2s)) -ttarget)
+               IF (cout .LT. coutref) THEN
+                     sbase=stmp
+                     coutref=cout
+                ELSE
+                     stmp=stmp+pas
+                ENDIF
+            ENDDO
+            qbase=MAX(0., sbase/athl+qslth(ind1))
+
+            ! surface cloud fraction in thermals
+            cth(ind1,ind2)=0.5*(1.-erf((sbase-sthl)/sqrt(2.)/sigma2s))
+            cth(ind1,ind2)=MIN(MAX(cth(ind1,ind2),0.),1.)
+
+
+            !volume cloud fraction in thermals
+            !to be checked
+            xth1=-(sthl+deltasth-sbase)/(sqrt(2.)*sigma2s)
+            xth2=-(sthl-deltasth-sbase)/(sqrt(2.)*sigma2s)           
+            exp_xth1 = exp(-1.*xth1**2)
+            exp_xth2 = exp(-1.*xth2**2)
+
+            IntJ=0.5*sthl*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
+            IntJ_CF=0.5*(1.-1.*erf(xth2))
+     
+            IF (deltasth .LT. 1.e-10) THEN
+              cth_vol(ind1,ind2)=IntJ_CF
+            ELSE
+              IntI1=(((sthl+deltasth-sbase)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
+              IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
+              IntI3=((sqrt2*sigma2s*(sthl+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
+              IntI1_CF=((sthl-sbase+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
+              IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
+              cth_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
+            ENDIF
+              cth_vol(ind1,ind2)=MIN(MAX(0.,cth_vol(ind1,ind2)),1.)
+
+
+
+            ! Environment
+            !=============
+            ! In the environment/downdrafts, only liquid clouds
+            ! See Shupe et al. 2008, JAS
+
+            ! standard deviation of the distribution in the environment
+            sth=sthl
+            senv=senvl
+            sigma1s_fraca = (sigma1s_factor**0.5)*(fraca(ind1,ind2)**sigma1s_power) / &
+                          &                (1-fraca(ind1,ind2))*(MAX((sth-senv),0.)**2)**0.5
+            ! for mixed phase clouds, there is no contribution from large scale ratqs to the distribution
+            ! in the environement
+
+            sigma1s_ratqs=1E-10
+            IF (cloudth_ratqsmin>0.) THEN
+                sigma1s_ratqs = cloudth_ratqsmin*po(ind1)
+            ENDIF
+
+            sigma1s = sigma1s_fraca + sigma1s_ratqs
+            IF (iflag_ratqs.eq.11) then
+               sigma1s = ratqs(ind1,ind2)*po(ind1)*aenv
+            ENDIF
+            IF (iflag_ratqs.eq.11) then
+              sigma1s = ratqs(ind1,ind2)*po(ind1)*aenvl
+            ENDIF
+            deltasenv=aenvl*vert_alpha*sigma1s
+            xenv1=-(senvl+deltasenv)/(sqrt(2.)*sigma1s)
+            xenv2=-(senvl-deltasenv)/(sqrt(2.)*sigma1s)
+            exp_xenv1 = exp(-1.*xenv1**2)
+            exp_xenv2 = exp(-1.*xenv2**2)
+
+            !surface CF
+            cenv(ind1,ind2)=0.5*(1.-1.*erf(xenv1))
+
+            !volume CF and condensed water
+            IntJ=0.5*senvl*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp_xenv2
+            IntJ_CF=0.5*(1.-1.*erf(xenv2))
+
+            IF (deltasenv .LT. 1.e-10) THEN
+              qcenv(ind1,ind2)=IntJ
+              cenv_vol(ind1,ind2)=IntJ_CF
+            ELSE
+              IntI1=(((senvl+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
+              IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp_xenv1-xenv2*exp_xenv2)
+              IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp_xenv1-exp_xenv2)
+              IntI1_CF=((senvl+deltasenv)*(erf(xenv2)-erf(xenv1)))/(4*deltasenv)
+              IntI3_CF=(sqrt2*sigma1s*(exp_xenv1-exp_xenv2))/(4*sqrtpi*deltasenv)
+              qcenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3 ! only liquid water in environment
+              cenv_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
+            ENDIF
+
+            qcenv(ind1,ind2)=MAX(qcenv(ind1,ind2),0.)
+            cenv_vol(ind1,ind2)=MIN(MAX(cenv_vol(ind1,ind2),0.),1.)
+
+
+            
+            ! Thermals + environment
+            ! ======================= 
+            ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2) 
+            qctot(ind1,ind2)=fraca(ind1,ind2)*qcth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qcenv(ind1,ind2)
+            ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
+            IF (qcth(ind1,ind2) .GT. 0) THEN
+               icefrac(ind1,ind2)=fraca(ind1,ind2)*qith(ind1,ind2) &
+                    /(fraca(ind1,ind2)*qcth(ind1,ind2) &
+                    +(1.-1.*fraca(ind1,ind2))*qcenv(ind1,ind2))
+                icefrac(ind1,ind2)=MAX(MIN(1.,icefrac(ind1,ind2)),0.)
+            ELSE
+                icefrac(ind1,ind2)=0.
+            ENDIF
+
+            IF (cenv(ind1,ind2).LT.1.e-10.or.cth(ind1,ind2).LT.1.e-10) THEN
+                ctot(ind1,ind2)=0.
+                ctot_vol(ind1,ind2)=0.
+                qincloud(ind1)=0.
+                qcloud(ind1)=zqsatenv(ind1)
+            ELSE               
+                qcloud(ind1)=fraca(ind1,ind2)*(qcth(ind1,ind2)/cth(ind1,ind2)+qbase) &
+                            +(1.-1.*fraca(ind1,ind2))*(qcenv(ind1,ind2)/cenv(ind1,ind2)+qslenv(ind1))
+                qincloud(ind1)=MAX(fraca(ind1,ind2)*(qcth(ind1,ind2)/cth(ind1,ind2)) &
+                            +(1.-1.*fraca(ind1,ind2))*(qcenv(ind1,ind2)/cenv(ind1,ind2)),0.)
+            ENDIF 
+
+        ENDIF ! mpc_bl_points
+
+
+    ELSE  ! gaussian for environment only
+
+      
+
+
+        IF (Tbefenvonly(ind1) .GE. RTT) THEN
+                Lv=RLVTT
+        ELSE
+                Lv=RLSTT
+        ENDIF
+        
+
+        zthl(ind1,ind2)=temp(ind1,ind2)*(101325./paprs(ind1,ind2))**(rdd/cppd)
+        alenv=(0.622*Lv*zqsatenvonly(ind1))/(rdd*zthl(ind1,ind2)**2)
+        aenv=1./(1.+(alenv*Lv/cppd))
+        senv=aenv*(po(ind1)-zqsatenvonly(ind1))
+        sth=0.
+      
+        sigma1s=ratqs(ind1,ind2)*zqenvonly(ind1)
+        sigma2s=0.
+
+        sqrt2pi=sqrt(2.*pi)
+        xenv=senv/(sqrt(2.)*sigma1s)
+        ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
+        ctot_vol(ind1,ind2)=ctot(ind1,ind2)
+        qctot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
+      
+        IF (ctot(ind1,ind2).LT.1.e-3) THEN
+          ctot(ind1,ind2)=0.
+          qcloud(ind1)=zqsatenvonly(ind1)
+          qincloud(ind1)=0.
+        ELSE 
+          qcloud(ind1)=qctot(ind1,ind2)/ctot(ind1,ind2)+zqsatenvonly(ind1)
+          qincloud(ind1)=MAX(qctot(ind1,ind2)/ctot(ind1,ind2),0.)
+        ENDIF
+ 
+
+    ENDIF       ! From the separation (thermal/envrionnement) and (environnement only,) l.335 et l.492
+
+    ! Outputs used to check the PDFs
+    cloudth_senv(ind1,ind2) = senv
+    cloudth_sth(ind1,ind2) = sth
+    cloudth_sigmaenv(ind1,ind2) = sigma1s
+    cloudth_sigmath(ind1,ind2) = sigma2s
+
+
+    ENDDO       !loop on klon
+
+    ! Calcule ice fall velocity in thermals
+
+    CALL FALLICE_VELOCITY(klon,qith(:,ind2),Tbefth(:),rhoth(:),paprs(:,ind2),falseklon(:),wiceth(:,ind2))
+
+RETURN
+
+
+END SUBROUTINE cloudth_mpc
+
+!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+SUBROUTINE ICE_MPC_BL_CLOUDS(ind1,ind2,klev,Ni,Ei,C_cap,d_top,iflag_topthermals,temp,pres,qth,qsith,qlth,deltazlev,vith,fraca,qith)
+
+! parameterization of ice for boundary
+! layer mixed-phase clouds assuming a stationary system
+!
+! Note that vapor deposition on ice crystals and riming of liquid droplets
+! depend on the ice number concentration Ni
+! One could assume that Ni depends on qi, e.g.,  Ni=beta*(qi*rho)**xi
+! and use values from Hong et al. 2004, MWR for instance
+! One may also estimate Ni as a function of T, as in Meyers 1922 or Fletcher 1962 
+! One could also think of a more complex expression of Ni;
+! function of qi, T, the concentration in aerosols or INP ..
+! Here we prefer fixing Ni to a tuning parameter
+! By default we take 2.0L-1=2.0e3m-3, median value from measured vertical profiles near Svalbard
+! in Mioche et al. 2017
+!
+!
+! References:
+!------------
+! This parameterization is thoroughly described in Vignon et al. 
+!
+! More specifically
+! for the Water vapor deposition process:
+!
+! Rotstayn, L. D., 1997: A physically based scheme for the treat-
+! ment of stratiform cloudfs and precipitation in large-scale
+! models. I: Description and evaluation of the microphysical
+! processes. Quart. J. Roy. Meteor. Soc., 123, 1227–1282.
+!
+!  Morrison, H., and A. Gettelman, 2008: A new two-moment bulk
+!  stratiform cloud microphysics scheme in the NCAR Com-
+!  munity Atmosphere Model (CAM3). Part I: Description and
+!  numerical tests. J. Climate, 21, 3642–3659
+!
+! for the Riming process:
+!
+! Rutledge, S. A., and P. V. Hobbs, 1983: The mesoscale and micro-
+! scale structure and organization of clouds and precipitation in
+! midlatitude cyclones. VII: A model for the ‘‘seeder-feeder’’
+! process in warm-frontal rainbands. J. Atmos. Sci., 40, 1185–1206
+!
+! Thompson, G., R. M. Rasmussen, and K. Manning, 004: Explicit
+! forecasts of winter precipitation using an improved bulk
+! microphysics scheme. Part I: Description and sensitivityThompson, G., R. M. Rasmussen, and K. Manning, 2004: Explicit
+! forecasts of winter precipitation using an improved bulk
+! microphysics scheme. Part I: Description and sensitivity analysis. Mon. Wea. Rev., 132, 519–542
+!
+! For the formation of clouds by thermals:
+!
+! Rio, C., & Hourdin, F. (2008). A thermal plume model for the convective boundary layer : Representation of cumulus clouds. Journal of
+! the Atmospheric Sciences, 65, 407–425.
+!
+! Jam, A., Hourdin, F., Rio, C., & Couvreux, F. (2013). Resolved versus parametrized boundary-layer plumes. Part III: Derivation of a
+! statistical scheme for cumulus clouds. Boundary-layer Meteorology, 147, 421–441. https://doi.org/10.1007/s10546-012-9789-3
+!
+!
+!
+! Contact: Etienne Vignon, etienne.vignon@lmd.ipsl.fr
+!=============================================================================
+
+    use phys_state_var_mod, ONLY : fm_therm, detr_therm, entr_therm
+
+    IMPLICIT none
+
+    INCLUDE "YOMCST.h"
+
+    INTEGER, INTENT(IN) :: ind1,ind2, klev           ! horizontal and vertical indices and dimensions
+    INTEGER, INTENT(IN) :: iflag_topthermals         ! uppermost layer of thermals ?
+    REAL, INTENT(IN)    :: Ni                        ! ice number concentration [m-3]
+    REAL, INTENT(IN)    :: Ei                        ! ice-droplet collision efficiency
+    REAL, INTENT(IN)    :: C_cap                     ! ice crystal capacitance
+    REAL, INTENT(IN)    :: d_top                     ! cloud-top ice crystal mixing parameter
+    REAL,  DIMENSION(klev), INTENT(IN) :: temp       ! temperature [K] within thermals
+    REAL,  DIMENSION(klev), INTENT(IN) :: pres       ! pressure [Pa]
+    REAL,  DIMENSION(klev), INTENT(IN) :: qth        ! mean specific water content in thermals [kg/kg]
+    REAL,  DIMENSION(klev), INTENT(IN) :: qsith        ! saturation specific humidity wrt ice in thermals [kg/kg]
+    REAL,  DIMENSION(klev), INTENT(IN) :: qlth       ! condensed liquid water in thermals, approximated value [kg/kg]
+    REAL,  DIMENSION(klev), INTENT(IN) :: deltazlev  ! layer thickness [m]
+    REAL,  DIMENSION(klev), INTENT(IN) :: vith       ! ice crystal fall velocity [m/s]
+    REAL,  DIMENSION(klev+1), INTENT(IN) :: fraca      ! fraction of the mesh covered by thermals
+    REAL,  DIMENSION(klev), INTENT(INOUT) :: qith       ! condensed ice water , thermals [kg/kg]
+
+
+    INTEGER ind2p1,ind2p2
+    REAL rho(klev)
+    REAL unsurtaudet, unsurtaustardep, unsurtaurim
+    REAL qi, AA, BB, Ka, Dv, rhoi
+    REAL p0, t0, fp1, fp2
+    REAL alpha, flux_term
+    REAL det_term, precip_term, rim_term, dep_term
+
+
+    ind2p1=ind2+1
+    ind2p2=ind2+2
+
+    rho=pres/temp/RD  ! air density kg/m3
+
+    Ka=2.4e-2      ! thermal conductivity of the air, SI
+    p0=101325.0    ! ref pressure
+    T0=273.15      ! ref temp
+    rhoi=500.0     ! cloud ice density following Reisner et al. 1998
+    alpha=700.     ! fallvelocity param
+
+
+    IF (iflag_topthermals .GT. 0) THEN ! uppermost thermals levels
+
+    Dv=0.0001*0.211*(p0/pres(ind2))*((temp(ind2)/T0)**1.94) ! water vapor diffusivity in air, SI
+
+    ! Detrainment term:
+
+    unsurtaudet=detr_therm(ind1,ind2)/rho(ind2)/deltazlev(ind2)
+ 
+
+    ! Deposition term
+    AA=RLSTT/Ka/temp(ind2)*(RLSTT/RV/temp(ind2)-1.)
+    BB=1./(rho(ind2)*Dv*qsith(ind2))
+    unsurtaustardep=C_cap*(Ni**0.66)*(qth(ind2)-qsith(ind2))/qsith(ind2) &
+                    *4.*RPI/(AA+BB)*(6.*rho(ind2)/rhoi/RPI/Gamma(4.))**(0.33)
+
+    ! Riming term  neglected at this level
+    !unsurtaurim=rho(ind2)*alpha*3./rhoi/2.*Ei*qlth(ind2)*((p0/pres(ind2))**0.4)
+
+    qi=fraca(ind2)*unsurtaustardep/MAX((d_top*unsurtaudet),1E-12)
+    qi=MAX(qi,0.)**(3./2.)
+
+    ELSE ! other levels, estimate qi(k) from variables at k+1 and k+2
+
+    Dv=0.0001*0.211*(p0/pres(ind2p1))*((temp(ind2p1)/T0)**1.94) ! water vapor diffusivity in air, SI
+
+    ! Detrainment term:
+
+    unsurtaudet=detr_therm(ind1,ind2p1)/rho(ind2p1)/deltazlev(ind2p1)
+    det_term=-unsurtaudet*qith(ind2p1)*rho(ind2p1)
+    
+    
+    ! Deposition term
+
+    AA=RLSTT/Ka/temp(ind2p1)*(RLSTT/RV/temp(ind2p1)-1.)
+    BB=1./(rho(ind2p1)*Dv*qsith(ind2p1))
+    unsurtaustardep=C_cap*(Ni**0.66)*(qth(ind2p1)-qsith(ind2p1)) &
+         /qsith(ind2p1)*4.*RPI/(AA+BB) &
+         *(6.*rho(ind2p1)/rhoi/RPI/Gamma(4.))**(0.33)
+    dep_term=rho(ind2p1)*fraca(ind2p1)*(qith(ind2p1)**0.33)*unsurtaustardep
+ 
+    ! Riming term
+
+    unsurtaurim=rho(ind2p1)*alpha*3./rhoi/2.*Ei*qlth(ind2p1)*((p0/pres(ind2p1))**0.4)
+    rim_term=rho(ind2p1)*fraca(ind2p1)*qith(ind2p1)*unsurtaurim
+
+    ! Precip term
+
+    ! We assume that there is no solid precipitation outside thermals 
+    ! so the precipitation flux within thermals is equal to the precipitation flux
+    ! at mesh-scale divided by  thermals fraction
+    
+    fp2=0.
+    fp1=0.
+    IF (fraca(ind2p1) .GT. 0.) THEN
+    fp2=-qith(ind2p2)*rho(ind2p2)*vith(ind2p2)*fraca(ind2p2)! flux defined positive upward
+    fp1=-qith(ind2p1)*rho(ind2p1)*vith(ind2p1)*fraca(ind2p1)
+    ENDIF
+
+    precip_term=-1./deltazlev(ind2p1)*(fp2-fp1)
+
+    ! Calculation in a top-to-bottom loop
+
+    IF (fm_therm(ind1,ind2p1) .GT. 0.) THEN
+          qi= 1./fm_therm(ind1,ind2p1)* &
+              (deltazlev(ind2p1)*(-rim_term-dep_term-det_term-precip_term) + &
+              fm_therm(ind1,ind2p2)*(qith(ind2p1)))
+    END IF
+
+    ENDIF ! top thermals
+
+    qith(ind2)=MAX(0.,qi)
+
+    RETURN
+
+END SUBROUTINE ICE_MPC_BL_CLOUDS
+
+END MODULE lmdz_cloudth
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_cloudth_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_cloudth_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_cloudth_ini.F90	(revision 4727)
@@ -0,0 +1,53 @@
+module lmdz_cloudth_ini
+
+real, save, protected :: C_cap ,cloudth_ratqsmin ,sigma1s_factor ,sigma1s_power ,sigma2s_factor ,sigma2s_power ,vert_alpha_th ,vert_alpha ,C_mpc , d_top , Ei , Ni
+integer, save, protected :: iflag_cloudth_vert_noratqs,iflag_cloudth_vert,iflag_ratqs
+
+!$OMP THREADPRIVATE(C_cap ,cloudth_ratqsmin ,sigma1s_factor ,sigma1s_power ,sigma2s_factor ,sigma2s_power ,vert_alpha_th ,vert_alpha ,C_mpc , d_top , Ei , Ni)
+!$OMP THREADPRIVATE(iflag_cloudth_vert_noratqs,iflag_cloudth_vert,iflag_ratqs)
+
+
+contains
+
+subroutine cloudth_ini(iflag_cloudth_vert_in,iflag_ratqs_in)
+
+use ioipsl_getin_p_mod, ONLY : getin_p
+implicit none
+integer, intent(in) :: iflag_cloudth_vert_in,iflag_ratqs_in
+
+
+        iflag_cloudth_vert=iflag_cloudth_vert_in
+        iflag_ratqs=iflag_ratqs_in
+
+        vert_alpha=0.5
+        sigma1s_factor=1.1
+        sigma1s_power=0.6
+        sigma2s_factor=0.09
+        sigma2s_power=0.5
+        cloudth_ratqsmin=-1.
+        iflag_cloudth_vert_noratqs=0
+        C_mpc=1.e4
+        Ni=2.0e3
+        Ei=0.5
+        C_cap=0.5
+        d_top=1.2
+
+
+        CALL getin_p('C_cap', C_cap)
+        CALL getin_p('cloudth_ratqsmin',cloudth_ratqsmin)
+        CALL getin_p('cloudth_sigma1s_factor',sigma1s_factor)
+        CALL getin_p('cloudth_sigma1s_power',sigma1s_power)
+        CALL getin_p('cloudth_sigma2s_factor',sigma2s_factor)
+        CALL getin_p('cloudth_sigma2s_power',sigma2s_power)
+        CALL getin_p('cloudth_vert_alpha',vert_alpha)
+        vert_alpha_th=vert_alpha
+        CALL getin_p('cloudth_vert_alpha_th',vert_alpha_th)
+        CALL getin_p('C_mpc',C_mpc)
+        CALL getin_p('d_top', d_top)
+        CALL getin_p('Ei', Ei)
+        CALL getin_p('iflag_cloudth_vert_noratqs',iflag_cloudth_vert_noratqs)
+        CALL getin_p('Ni', Ni)
+
+end subroutine cloudth_ini
+
+end module lmdz_cloudth_ini
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_lscp.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_lscp.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_lscp.F90	(revision 4727)
@@ -0,0 +1,1344 @@
+MODULE lmdz_lscp
+
+IMPLICIT NONE
+
+CONTAINS
+
+!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+SUBROUTINE lscp(klon,klev,dtime,missing_val,            &
+     paprs,pplay,temp,qt,ptconv,ratqs,                  &
+     d_t, d_q, d_ql, d_qi, rneb, rneblsvol, rneb_seri,  &
+     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,temp_cltop,                               &
+     qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss,   &
+     Tcontr, qcontr, qcontr2, fcontrN, fcontrP,         &
+      cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! Authors: Z.X. Li (LMD), J-L Dufresne (LMD), C. Rio (LMD), J-Y Grandpeix (LMD)
+!          A. JAM (LMD), J-B Madeleine (LMD), E. Vignon (LMD), L. Touzze-Peiffert (LMD)
+!--------------------------------------------------------------------------------
+! Date: 01/2021
+!--------------------------------------------------------------------------------
+! Aim: Large Scale Clouds and Precipitation (LSCP)
+!
+! This code is a new version of the fisrtilp.F90 routine, which is itself a 
+! merge of 'first' (superrsaturation physics, P. LeVan K. Laval)
+! and 'ilp' (il pleut, L. Li)
+!
+! Compared to the original fisrtilp code, lscp
+! -> assumes thermcep = .TRUE. all the time (fisrtilp inconsistent when .FALSE.)
+! -> consider always precipitation thermalisation (fl_cor_ebil>0)
+! -> option iflag_fisrtilp_qsat<0 no longer possible (qsat does not evolve with T) 
+! -> option "oldbug" by JYG has been removed
+! -> iflag_t_glace >0 always
+! -> the 'all or nothing' cloud approach is no longer available (cpartiel=T always)
+! -> rectangular distribution from L. Li no longer available
+! -> We always account for the Wegener-Findeisen-Bergeron process (iflag_bergeron = 2 in fisrt) 
+!--------------------------------------------------------------------------------
+! References: 
+!
+! - Bony, S., & Emanuel, K. A. 2001, JAS, doi: 10.1175/1520-0469(2001)058<3158:APOTCA>2.0.CO;2
+! - Hourdin et al. 2013, Clim Dyn, doi:10.1007/s00382-012-1343-y
+! - Jam et al. 2013, Boundary-Layer Meteorol, doi:10.1007/s10546-012-9789-3
+! - Jouhaud, et al. 2018. JAMES, doi:10.1029/2018MS001379
+! - Madeleine et al. 2020, JAMES, doi:10.1029/2020MS002046
+! - Touzze-Peifert Ludo, PhD thesis, p117-124
+! -------------------------------------------------------------------------------
+! Code structure:
+!
+! P0>     Thermalization of the precipitation coming from the overlying layer
+! P1>     Evaporation of the precipitation (falling from the k+1 level)
+! P2>     Cloud formation (at the k level) 
+! P2.A.1> With the PDFs, calculation of cloud properties using the inital
+!         values of T and Q
+! P2.A.2> Coupling between condensed water and temperature
+! P2.A.3> Calculation of final quantities associated with cloud formation
+! P2.B>   Release of Latent heat after cloud formation
+! P3>     Autoconversion to precipitation (k-level)
+! P4>     Wet scavenging
+!------------------------------------------------------------------------------
+! Some preliminary comments (JBM) :
+!
+! The cloud water that the radiation scheme sees is not the same that the cloud
+! water used in the physics and the dynamics 
+! 
+! During the autoconversion to precipitation (P3 step), radocond (cloud water used
+! by the radiation scheme) is calculated as an average of the water that remains
+! in the cloud during the precipitation and not the water remaining at the end
+! of the time step. The latter is used in the rest of the physics and advected
+! by the dynamics. 
+!
+! In summary:
+!
+! Radiation:
+! xflwc(newmicro)+xfiwc(newmicro) =
+!   radocond=lwcon(nc)+iwcon(nc)
+!
+! Notetheless, be aware of:
+!
+! radocond .NE. ocond(nc)
+! i.e.:
+! lwcon(nc)+iwcon(nc) .NE. ocond(nc)
+! but oliq+(ocond-oliq) .EQ. ocond
+! (which is not trivial)
+!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+!
+
+! USE de modules contenant des fonctions.
+USE lmdz_cloudth, ONLY : cloudth, cloudth_v3, cloudth_v6, cloudth_mpc 
+USE lmdz_lscp_tools, ONLY : calc_qsat_ecmwf, icefrac_lscp, calc_gammasat
+USE lmdz_lscp_tools, ONLY : fallice_velocity, distance_to_cloud_top
+USE ice_sursat_mod, ONLY : ice_sursat
+
+! Use du module lmdz_lscp_ini contenant les constantes
+USE lmdz_lscp_ini, ONLY : prt_level, lunout
+USE lmdz_lscp_ini, ONLY : seuil_neb, niter_lscp, iflag_evap_prec, t_coup, DDT0, ztfondue, rain_int_min
+USE lmdz_lscp_ini, ONLY : iflag_mpc_bl, ok_radocond_snow, a_tr_sca, cld_expo_con, cld_expo_lsc
+USE lmdz_lscp_ini, ONLY : iflag_cloudth_vert, iflag_rain_incloud_vol, iflag_t_glace, t_glace_min 
+USE lmdz_lscp_ini, ONLY : coef_eva, coef_eva_i,cld_tau_lsc, cld_tau_con, cld_lc_lsc, cld_lc_con
+USE lmdz_lscp_ini, ONLY : iflag_bergeron, iflag_fisrtilp_qsat, iflag_vice, cice_velo, dice_velo
+USE lmdz_lscp_ini, ONLY : iflag_autoconversion, ffallv_con, ffallv_lsc
+USE lmdz_lscp_ini, ONLY : RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RG
+
+IMPLICIT NONE
+
+!===============================================================================
+! VARIABLES DECLARATION
+!===============================================================================
+
+! INPUT VARIABLES:
+!-----------------
+
+  INTEGER,                         INTENT(IN)   :: klon,klev       ! number of horizontal grid points and vertical levels
+  REAL,                            INTENT(IN)   :: dtime           ! time step [s]
+  REAL,                            INTENT(IN)   :: missing_val     ! missing value for output
+
+  REAL, DIMENSION(klon,klev+1),    INTENT(IN)   :: paprs           ! inter-layer pressure [Pa]
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: pplay           ! mid-layer pressure [Pa]
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: temp            ! temperature (K)
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: qt              ! total specific humidity (in vapor phase in input) [kg/kg] 
+  INTEGER,                         INTENT(IN)   :: iflag_cld_th    ! flag that determines the distribution of convective clouds
+  INTEGER,                         INTENT(IN)   :: iflag_ice_thermo! flag to activate the ice thermodynamics
+                                                                   ! CR: if iflag_ice_thermo=2, only convection is active
+  LOGICAL,                         INTENT(IN)   :: ok_ice_sursat   ! flag to determine if ice sursaturation is activated
+
+  LOGICAL, DIMENSION(klon,klev),   INTENT(IN)   :: ptconv          ! grid points where deep convection scheme is active
+
+  !Inputs associated with thermal plumes
+
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: ztv             ! virtual potential temperature [K]
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: zqta            ! specific humidity within thermals [kg/kg]
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: fraca           ! fraction of thermals within the mesh [-]
+  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]
+
+  ! 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
+
+
+  ! Input sursaturation en glace
+  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: rneb_seri        ! fraction nuageuse en memoire
+  
+  ! OUTPUT variables
+  !-----------------
+
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_t              ! temperature increment [K]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_q              ! specific humidity increment [kg/kg]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_ql             ! liquid water increment [kg/kg]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_qi             ! cloud ice mass increment [kg/kg]
+  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
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rhcl             ! clear-sky relative humidity [-]
+  REAL, DIMENSION(klon),           INTENT(OUT)  :: rain             ! surface large-scale rainfall [kg/s/m2] 
+  REAL, DIMENSION(klon),           INTENT(OUT)  :: snow             ! surface large-scale snowfall [kg/s/m2]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qsatl            ! saturation specific humidity wrt liquid [kg/kg]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qsats            ! saturation specific humidity wrt ice [kg/kg]  
+  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]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: temp_cltop       ! temperature of cloud top [K]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: beta             ! conversion rate of condensed water
+
+  ! fraction of aerosol scavenging through impaction and nucleation (for on-line)
+  
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_impa        ! scavenging fraction due tu impaction [-]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_nucl        ! scavenging fraction due tu nucleation [-]
+  
+  ! for supersaturation and contrails parameterisation
+  
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qclr             ! specific total water content in clear sky region [kg/kg]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qcld             ! specific total water content in cloudy region [kg/kg]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qss              ! specific total water content in supersat region [kg/kg]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qvc              ! specific vapor content in clouds [kg/kg] 
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rnebclr          ! mesh fraction of clear sky [-]   
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rnebss           ! mesh fraction of ISSR [-]  
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: gamma_ss         ! coefficient governing the ice nucleation RHi threshold [-]      
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: Tcontr           ! threshold temperature for contrail formation [K]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qcontr           ! threshold humidity for contrail formation [kg/kg]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qcontr2          ! // (2nd expression more consistent with LMDZ expression of q)          
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: fcontrN          ! fraction of grid favourable to non-persistent contrails
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: fcontrP          ! fraction of grid favourable to persistent contrails
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: cloudth_sth      ! mean saturation deficit in thermals
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: cloudth_senv     ! mean saturation deficit in environment
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: cloudth_sigmath  ! std of saturation deficit in thermals
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: cloudth_sigmaenv ! std of saturation deficit in environment
+
+
+
+  ! LOCAL VARIABLES:
+  !----------------
+
+  REAL,DIMENSION(klon) :: qsl, qsi
+  REAL :: zct, zcl,zexpo
+  REAL, DIMENSION(klon,klev) :: ctot
+  REAL, DIMENSION(klon,klev) :: ctot_vol
+  REAL, DIMENSION(klon) :: zqs, zdqs
+  REAL :: zdelta, zcor, zcvm5
+  REAL, DIMENSION(klon) :: zdqsdT_raw
+  REAL, DIMENSION(klon) :: gammasat,dgammasatdt                ! coefficient to make cold condensation at the correct RH and derivative wrt T
+  REAL, DIMENSION(klon) :: Tbef,qlbef,DT
+  REAL :: num,denom
+  REAL :: cste
+  REAL, DIMENSION(klon) :: zpdf_sig,zpdf_k,zpdf_delta
+  REAL, DIMENSION(klon) :: Zpdf_a,zpdf_b,zpdf_e1,zpdf_e2
+  REAL :: erf
+  REAL, DIMENSION(klon,klev) :: icefrac_mpc
+  REAL, DIMENSION(klon) :: qcloud, qincloud_mpc
+  REAL, DIMENSION(klon) :: zrfl, zrfln
+  REAL :: zqev, zqevt 
+  REAL, DIMENSION(klon) :: zifl, zifln, ziflprev
+  REAL :: zqev0,zqevi, zqevti
+  REAL, DIMENSION(klon) :: zoliq, zcond, zq, zqn
+  REAL, DIMENSION(klon) :: zoliql, zoliqi
+  REAL, DIMENSION(klon) :: zt
+  REAL, DIMENSION(klon,klev) :: zrho
+  REAL, DIMENSION(klon) :: zdz,iwc
+  REAL :: zchau,zfroi
+  REAL, DIMENSION(klon) :: zfice,zneb,znebprecip
+  REAL :: zmelt,zrain,zsnow,zprecip
+  REAL, DIMENSION(klon) :: dzfice
+  REAL :: zsolid
+  REAL, DIMENSION(klon) :: qtot, qzero
+  REAL, DIMENSION(klon) :: dqsl,dqsi
+  REAL :: smallestreal
+  !  Variables for Bergeron process
+  REAL :: zcp, coef1, DeltaT, Deltaq, Deltaqprecl
+  REAL, DIMENSION(klon) :: zqpreci, zqprecl
+  ! Variables precipitation energy conservation
+  REAL, DIMENSION(klon) :: zmqc
+  REAL :: zalpha_tr
+  REAL :: zfrac_lessi
+  REAL, DIMENSION(klon) :: zprec_cond
+  REAL, DIMENSION(klon) :: zmair
+  REAL :: zcpair, zcpeau
+  REAL, DIMENSION(klon) :: zlh_solid
+  REAL :: zm_solid         ! for liquid -> solid conversion
+  REAL, DIMENSION(klon) :: zrflclr, zrflcld
+  REAL, DIMENSION(klon) :: d_zrfl_clr_cld, d_zifl_clr_cld
+  REAL, DIMENSION(klon) :: d_zrfl_cld_clr, d_zifl_cld_clr 
+  REAL, DIMENSION(klon) :: ziflclr, ziflcld
+  REAL, DIMENSION(klon) :: znebprecipclr, znebprecipcld
+  REAL, DIMENSION(klon) :: tot_zneb, tot_znebn, d_tot_zneb
+  REAL, DIMENSION(klon) :: d_znebprecip_clr_cld, d_znebprecip_cld_clr
+  REAL, DIMENSION(klon,klev) :: velo
+  REAL :: vr, ffallv
+  REAL :: qlmpc, qimpc, rnebmpc
+  REAL, DIMENSION(klon,klev) :: radocondi, radocondl
+  REAL :: effective_zneb
+  REAL, DIMENSION(klon) :: distcltop1D, temp_cltop1D
+
+
+  INTEGER i, k, n, kk, iter
+  INTEGER, DIMENSION(klon) :: n_i
+  INTEGER ncoreczq
+  INTEGER, DIMENSION(klon,klev) :: mpc_bl_points
+
+  LOGICAL, DIMENSION(klon) :: lognormale
+  LOGICAL, DIMENSION(klon) :: keepgoing
+
+  CHARACTER (len = 20) :: modname = 'lscp'
+  CHARACTER (len = 80) :: abort_message
+  
+
+!===============================================================================
+! INITIALISATION
+!===============================================================================
+
+! Few initial checks
+
+
+IF (iflag_fisrtilp_qsat .LT. 0) THEN
+    abort_message = 'lscp cannot be used with iflag_fisrtilp<0'
+    CALL abort_physic(modname,abort_message,1)
+ENDIF
+
+! Few initialisations
+
+znebprecip(:)=0.0
+ctot_vol(1:klon,1:klev)=0.0
+rneblsvol(1:klon,1:klev)=0.0
+smallestreal=1.e-9
+znebprecipclr(:)=0.0
+znebprecipcld(:)=0.0
+mpc_bl_points(:,:)=0
+
+IF (prt_level>9) WRITE(lunout,*) 'NUAGES4 A. JAM'
+
+! AA for 'safety' reasons
+zalpha_tr   = 0.
+zfrac_lessi = 0.
+beta(:,:)= 0.
+
+! Initialisation of variables:
+
+prfl(:,:) = 0.0
+psfl(:,:) = 0.0
+d_t(:,:) = 0.0
+d_q(:,:) = 0.0
+d_ql(:,:) = 0.0
+d_qi(:,:) = 0.0
+rneb(:,:) = 0.0
+pfraclr(:,:)=0.0
+pfracld(:,:)=0.0
+radocond(:,:) = 0.0
+radicefrac(:,:) = 0.0
+frac_nucl(:,:) = 1.0 
+frac_impa(:,:) = 1.0 
+rain(:) = 0.0
+snow(:) = 0.0
+zoliq(:)=0.0
+zfice(:)=0.0
+dzfice(:)=0.0
+zqprecl(:)=0.0
+zqpreci(:)=0.0
+zrfl(:) = 0.0
+zifl(:) = 0.0
+ziflprev(:)=0.0
+zneb(:) = seuil_neb
+zrflclr(:) = 0.0
+ziflclr(:) = 0.0
+zrflcld(:) = 0.0
+ziflcld(:) = 0.0
+tot_zneb(:) = 0.0
+tot_znebn(:) = 0.0
+d_tot_zneb(:) = 0.0
+qzero(:) = 0.0
+distcltop1D(:)=0.0
+temp_cltop1D(:) = 0.0
+!--ice supersaturation
+gamma_ss(:,:) = 1.0
+qss(:,:) = 0.0
+rnebss(:,:) = 0.0
+Tcontr(:,:) = missing_val
+qcontr(:,:) = missing_val
+qcontr2(:,:) = missing_val
+fcontrN(:,:) = 0.0
+fcontrP(:,:) = 0.0
+distcltop(:,:)=0.
+temp_cltop(:,:)=0.
+
+!c_iso: variable initialisation for iso 
+
+
+!===============================================================================
+!              BEGINNING OF VERTICAL LOOP FROM TOP TO BOTTOM
+!===============================================================================
+
+ncoreczq=0
+
+DO k = klev, 1, -1
+
+    ! Initialisation temperature and specific humidity
+    DO i = 1, klon
+        zt(i)=temp(i,k)
+        zq(i)=qt(i,k)
+        !c_iso init of iso
+    ENDDO
+    
+    ! --------------------------------------------------------------------
+    ! P0> Thermalization of precipitation falling from the overlying layer
+    ! --------------------------------------------------------------------
+    ! Computes air temperature variation due to enthalpy transported by
+    ! precipitation. Precipitation is then thermalized with the air in the
+    ! layer. 
+    ! The precipitation should remain thermalized throughout the different
+    ! thermodynamical transformations. 
+    ! The corresponding water mass should
+    ! be added when calculating the layer's enthalpy change with 
+    ! temperature
+    ! See lmdzpedia page todoan
+    ! todoan: check consistency with ice phase
+    ! todoan: understand why several steps
+    ! ---------------------------------------------------------------------
+    
+    IF (k.LE.klev-1) THEN 
+
+        DO i = 1, klon
+ 
+            zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
+            ! no condensed water so cp=cp(vapor+dry air)
+            ! RVTMP2=rcpv/rcpd-1
+            zcpair=RCPD*(1.0+RVTMP2*zq(i)) 
+            zcpeau=RCPD*RVTMP2
+
+            ! zmqc: precipitation mass that has to be thermalized with 
+            ! layer's air so that precipitation at the ground has the
+            ! same temperature as the lowermost layer
+            zmqc(i) = (zrfl(i)+zifl(i))*dtime/zmair(i)
+            ! t(i,k+1)+d_t(i,k+1): new temperature of the overlying layer
+            zt(i) = ( (temp(i,k+1)+d_t(i,k+1))*zmqc(i)*zcpeau + zcpair*zt(i) ) &
+             / (zcpair + zmqc(i)*zcpeau)
+
+        ENDDO
+ 
+    ELSE
+ 
+        DO i = 1, klon 
+            zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG 
+            zmqc(i) = 0.
+        ENDDO
+ 
+    ENDIF
+
+    ! --------------------------------------------------------------------
+    ! P1> Precipitation evaporation/sublimation
+    ! --------------------------------------------------------------------
+    ! A part of the precipitation coming from above is evaporated/sublimated.
+    ! --------------------------------------------------------------------
+
+    IF (iflag_evap_prec.GE.1) THEN 
+
+        ! Calculation of saturation specific humidity
+        ! depending on temperature:
+        CALL calc_qsat_ecmwf(klon,zt(:),qzero(:),pplay(:,k),RTT,0,.false.,zqs(:),zdqs(:))
+        ! wrt liquid water
+        CALL calc_qsat_ecmwf(klon,zt(:),qzero(:),pplay(:,k),RTT,1,.false.,qsl(:),dqsl(:))
+        ! wrt ice
+        CALL calc_qsat_ecmwf(klon,zt(:),qzero(:),pplay(:,k),RTT,2,.false.,qsi(:),dqsi(:))
+
+        DO i = 1, klon
+
+            ! if precipitation
+            IF (zrfl(i)+zifl(i).GT.0.) THEN
+
+            ! 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.GE.4) THEN
+                    zrfl(i) = zrflclr(i)
+                    zifl(i) = ziflclr(i)
+                ENDIF
+
+                IF (iflag_evap_prec.EQ.1) THEN
+                    znebprecip(i)=zneb(i)
+                ELSE
+                    znebprecip(i)=MAX(zneb(i),znebprecip(i))
+                ENDIF
+
+                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
+                ! Max evap not to saturate the fraction below the cloud
+                    zqev0 = MAX(0.0, (zqs(i)-zq(i))*znebprecip(i))
+                ENDIF
+
+                ! Evaporation of liquid precipitation coming from above
+                ! 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)
+
+                IF (iflag_evap_prec.EQ.3) THEN
+                    zqevt = znebprecip(i)*coef_eva*(1.0-zq(i)/qsl(i)) &
+                    *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.GE.4) THEN
+                     zqevt = znebprecipclr(i)*coef_eva*(1.0-zq(i)/qsl(i)) &
+                    *SQRT(zrfl(i)/max(1.e-8,znebprecipclr(i))) &
+                    *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+                ELSE
+                    zqevt = 1.*coef_eva*(1.0-zq(i)/qsl(i))*SQRT(zrfl(i)) &
+                    *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+                ENDIF
+
+                zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) &
+                    *RG*dtime/(paprs(i,k)-paprs(i,k+1)) 
+
+                ! sublimation of the solid precipitation coming from above
+                IF (iflag_evap_prec.EQ.3) THEN
+                    zqevti = znebprecip(i)*coef_eva_i*(1.0-zq(i)/qsi(i)) &
+                    *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.GE.4) THEN
+                     zqevti = znebprecipclr(i)*coef_eva_i*(1.0-zq(i)/qsi(i)) &
+                    *SQRT(zifl(i)/max(1.e-8,znebprecipclr(i))) &
+                    *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+                ELSE
+                    zqevti = 1.*coef_eva_i*(1.0-zq(i)/qsi(i))*SQRT(zifl(i)) &
+                    *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+                ENDIF
+
+                zqevti = MAX(0.0,MIN(zqevti,zifl(i))) &
+                *RG*dtime/(paprs(i,k)-paprs(i,k+1))
+
+                ! A. JAM
+                ! Evaporation limit: we ensure that the layer's fraction below
+                ! the cloud or the whole mesh (depending on iflag_evap_prec)
+                ! does not reach saturation. In this case, we 
+                ! redistribute zqev0 conserving the ratio liquid/ice 
+
+                ! todoan: check the consistency of this formula
+                IF (zqevt+zqevti.GT.zqev0) THEN
+                    zqev=zqev0*zqevt/(zqevt+zqevti)
+                    zqevi=zqev0*zqevti/(zqevt+zqevti)
+                ELSE
+                    zqev=zqevt
+                    zqevi=zqevti
+                ENDIF
+
+
+                ! New solid and liquid precipitation fluxes after evap and sublimation
+                zrfln(i) = Max(0.,zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1))  &
+                         /RG/dtime)
+                zifln(i) = Max(0.,zifl(i) - zqevi*(paprs(i,k)-paprs(i,k+1)) &
+                         /RG/dtime)
+
+
+                ! vapor, temperature, precip fluxes update
+                zq(i) = zq(i) - (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
+                * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
+                zmqc(i) = zmqc(i) + (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
+                * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
+                zt(i) = zt(i) + (zrfln(i)-zrfl(i))        &
+                * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime    &
+                * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i))) &
+                + (zifln(i)-zifl(i))                      &
+                * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime    &
+                * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
+
+                ! New values of liquid and solid precipitation 
+                zrfl(i) = zrfln(i)
+                zifl(i) = zifln(i)
+
+                ! c_iso here call_reevap that updates isotopic zrfl, zifl (in inout)
+                !                         due to evap + sublim                                     
+                                           
+
+                IF (iflag_evap_prec.GE.4) THEN
+                    zrflclr(i) = zrfl(i)
+                    ziflclr(i) = zifl(i)
+                    IF(zrflclr(i) + ziflclr(i).LE.0) THEN
+                        znebprecipclr(i) = 0.0
+                    ENDIF
+                    zrfl(i) = zrflclr(i) + zrflcld(i)
+                    zifl(i) = ziflclr(i) + ziflcld(i)
+                ENDIF
+
+                ! c_iso duplicate for isotopes or loop on isotopes
+
+                ! Melting:
+                zmelt = ((zt(i)-RTT)/(ztfondue-RTT)) ! JYG
+                ! precip fraction that is melted
+                zmelt = MIN(MAX(zmelt,0.),1.)
+
+                ! update of rainfall and snowfall due to melting
+                IF (iflag_evap_prec.GE.4) THEN
+                    zrflclr(i)=zrflclr(i)+zmelt*ziflclr(i)
+                    zrflcld(i)=zrflcld(i)+zmelt*ziflcld(i)
+                    zrfl(i)=zrflclr(i)+zrflcld(i)
+
+                    ziflclr(i)=ziflclr(i)*(1.-zmelt)
+                    ziflcld(i)=ziflcld(i)*(1.-zmelt)
+                    zifl(i)=ziflclr(i)+ziflcld(i)
+
+                ELSE
+                    zrfl(i)=zrfl(i)+zmelt*zifl(i)
+
+                    zifl(i)=zifl(i)*(1.-zmelt)
+                ENDIF
+
+
+                ! c_iso: melting of isotopic precipi with zmelt (no fractionation)
+
+                ! Latent heat of melting with precipitation thermalization
+                zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
+                *RLMLT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
+                
+
+            ELSE
+                ! if no precip, we reinitialize the cloud fraction used for the precip to 0 
+                znebprecip(i)=0.
+
+            ENDIF ! (zrfl(i)+zifl(i).GT.0.)
+
+        ENDDO
+
+    ENDIF ! (iflag_evap_prec>=1)
+
+    ! --------------------------------------------------------------------
+    ! End precip evaporation
+    ! --------------------------------------------------------------------
+    
+    ! Calculation of qsat, L/Cp*dqsat/dT and ncoreczq counter
+    !-------------------------------------------------------
+
+     qtot(:)=zq(:)+zmqc(:)
+     CALL calc_qsat_ecmwf(klon,zt(:),qtot(:),pplay(:,k),RTT,0,.false.,zqs(:),zdqs(:))
+     DO i = 1, klon
+            zdelta = MAX(0.,SIGN(1.,RTT-zt(i)))
+            zdqsdT_raw(i) = zdqs(i)*RCPD*(1.0+RVTMP2*zq(i)) / (RLVTT*(1.-zdelta) + RLSTT*zdelta)
+            IF (zq(i) .LT. 1.e-15) THEN
+                ncoreczq=ncoreczq+1
+                zq(i)=1.e-15
+            ENDIF
+            ! c_iso: do something similar for isotopes
+
+     ENDDO
+    
+    ! --------------------------------------------------------------------
+    ! P2> Cloud formation
+    !---------------------------------------------------------------------
+    !
+    ! Unlike fisrtilp, we always assume a 'fractional cloud' approach 
+    ! i.e. clouds occupy only a fraction of the mesh (the subgrid distribution
+    ! is prescribed and depends on large scale variables and boundary layer
+    ! properties)
+    ! The decrease in condensed part due tu latent heating is taken into
+    ! account
+    ! -------------------------------------------------------------------
+
+        ! P2.1> With the PDFs (log-normal, bigaussian) 
+        ! cloud properties calculation with the initial values of t and q
+        ! ----------------------------------------------------------------
+
+        ! initialise gammasat and qincloud_mpc
+        gammasat(:)=1.
+        qincloud_mpc(:)=0.
+
+        IF (iflag_cld_th.GE.5) THEN
+
+             IF (iflag_mpc_bl .LT. 1) THEN 
+
+                IF (iflag_cloudth_vert.LE.2) THEN
+
+                    CALL cloudth(klon,klev,k,ztv,                  &
+                         zq,zqta,fraca,                            &
+                         qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
+                         ratqs,zqs,temp,                              &
+                         cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+
+
+
+
+                ELSEIF (iflag_cloudth_vert.GE.3 .AND. iflag_cloudth_vert.LE.5) THEN
+
+                    CALL cloudth_v3(klon,klev,k,ztv,                        &
+                         zq,zqta,fraca,                                     &
+                         qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
+                         ratqs,zqs,temp, &
+                         cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+                !Jean Jouhaud's version, Decembre 2018 
+                !-------------------------------------
+
+                ELSEIF (iflag_cloudth_vert.EQ.6) THEN
+
+                    CALL cloudth_v6(klon,klev,k,ztv,                        &
+                         zq,zqta,fraca,                                     &
+                         qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
+                         ratqs,zqs,temp, &
+                         cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+                ENDIF
+
+         ELSE 
+                ! cloudth_v3 + cold microphysical considerations 
+                ! + stationary mixed-phase cloud model
+
+                    CALL cloudth_mpc(klon,klev,k,iflag_mpc_bl,mpc_bl_points, &
+                         temp,ztv,zq,zqta,fraca, zpspsk,                      &
+                         paprs,pplay,ztla,zthl,ratqs,zqs,psfl,             &
+                         qcloud,qincloud_mpc,icefrac_mpc,ctot,ctot_vol,    &
+                         cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+         ENDIF ! iflag_mpc_bl
+
+                DO i=1,klon
+                    rneb(i,k)=ctot(i,k)
+                    rneblsvol(i,k)=ctot_vol(i,k)
+                    zqn(i)=qcloud(i)
+                ENDDO
+
+        ENDIF
+
+        IF (iflag_cld_th .LE. 4) THEN
+            
+                ! lognormal 
+            lognormale = .TRUE.
+
+        ELSEIF (iflag_cld_th .GE. 6) THEN
+            
+                ! lognormal distribution when no thermals 
+            lognormale = fraca(:,k) < 1e-10
+
+        ELSE
+                ! When iflag_cld_th=5, we always assume
+                ! bi-gaussian distribution
+            lognormale = .FALSE.
+        
+        ENDIF
+
+        DT(:) = 0.
+        n_i(:)=0
+        Tbef(:)=zt(:)
+        qlbef(:)=0.
+
+        ! Treatment of non-boundary layer clouds (lognormale)
+        ! condensation with qsat(T) variation (adaptation)
+        ! Iterative resolution to converge towards qsat
+        ! with update of temperature, ice fraction and qsat at 
+        ! each iteration
+
+        ! todoan -> sensitivity to iflag_fisrtilp_qsat
+        DO iter=1,iflag_fisrtilp_qsat+1
+
+                DO i=1,klon
+
+                    ! keepgoing = .true. while convergence is not satisfied
+                    keepgoing(i)=ABS(DT(i)).GT.DDT0
+
+                    IF ((keepgoing(i) .OR. (n_i(i) .EQ. 0)) .AND. lognormale(i)) THEN
+
+                        ! if not convergence:
+
+                        ! P2.2.1> cloud fraction and condensed water mass calculation
+                        ! Calculated variables: 
+                        ! rneb : cloud fraction
+                        ! zqn : total water within the cloud
+                        ! zcond: mean condensed water within the mesh
+                        ! rhcl: clear-sky relative humidity
+                        !---------------------------------------------------------------
+
+                        ! new temperature that only serves in the iteration process:
+                        Tbef(i)=Tbef(i)+DT(i)
+
+                        ! Rneb, qzn and zcond for lognormal PDFs
+                        qtot(i)=zq(i)+zmqc(i)
+
+                      ENDIF
+
+                  ENDDO
+
+                  ! Calculation of saturation specific humidity and ice fraction
+                  CALL calc_qsat_ecmwf(klon,Tbef(:),qtot(:),pplay(:,k),RTT,0,.false.,zqs(:),zdqs(:))
+                  CALL calc_gammasat(klon,Tbef(:),qtot(:),pplay(:,k),gammasat(:),dgammasatdt(:))
+                  ! saturation may occur at a humidity different from qsat (gamma qsat), so gamma correction for dqs
+                  zdqs(:) = gammasat(:)*zdqs(:)+zqs(:)*dgammasatdt(:)
+                  ! 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,temp,pplay,paprs,rneb,distcltop1D,temp_cltop1D)
+                  ENDIF
+                  CALL icefrac_lscp(klon, zt(:), iflag_ice_thermo, distcltop1D(:),temp_cltop1D(:),zfice(:),dzfice(:))
+
+                  DO i=1,klon !todoan : check if loop in i is needed
+
+                      IF ((keepgoing(i) .OR. (n_i(i) .EQ. 0)) .AND. lognormale(i)) THEN
+
+                        zpdf_sig(i)=ratqs(i,k)*zq(i)
+                        zpdf_k(i)=-sqrt(log(1.+(zpdf_sig(i)/zq(i))**2))
+                        zpdf_delta(i)=log(zq(i)/(gammasat(i)*zqs(i)))
+                        zpdf_a(i)=zpdf_delta(i)/(zpdf_k(i)*sqrt(2.))
+                        zpdf_b(i)=zpdf_k(i)/(2.*sqrt(2.))
+                        zpdf_e1(i)=zpdf_a(i)-zpdf_b(i)
+                        zpdf_e1(i)=sign(min(ABS(zpdf_e1(i)),5.),zpdf_e1(i))
+                        zpdf_e1(i)=1.-erf(zpdf_e1(i))
+                        zpdf_e2(i)=zpdf_a(i)+zpdf_b(i)
+                        zpdf_e2(i)=sign(min(ABS(zpdf_e2(i)),5.),zpdf_e2(i))
+                        zpdf_e2(i)=1.-erf(zpdf_e2(i))
+
+                        IF ((.NOT.ok_ice_sursat).OR.(Tbef(i).GT.t_glace_min)) THEN
+
+                          IF (zpdf_e1(i).LT.1.e-10) THEN
+                              rneb(i,k)=0.
+                              zqn(i)=gammasat(i)*zqs(i)
+                          ELSE
+                              rneb(i,k)=0.5*zpdf_e1(i)
+                              zqn(i)=zq(i)*zpdf_e2(i)/zpdf_e1(i)
+                          ENDIF
+
+                          rnebss(i,k)=0.0   !--added by OB (needed because of the convergence loop on time)
+                          fcontrN(i,k)=0.0  !--idem
+                          fcontrP(i,k)=0.0  !--idem
+                          qss(i,k)=0.0      !--idem
+
+                       ELSE ! in case of ice supersaturation by Audran
+
+                        !------------------------------------
+                        ! ICE SUPERSATURATION
+                        !------------------------------------
+
+                        CALL ice_sursat(pplay(i,k), paprs(i,k)-paprs(i,k+1), dtime, i, k, temp(i,k), zq(i), &
+                             gamma_ss(i,k), zqs(i), Tbef(i), rneb_seri(i,k), ratqs(i,k),                 &
+                             rneb(i,k), zqn(i), rnebss(i,k), qss(i,k),                                   & 
+                             Tcontr(i,k), qcontr(i,k), qcontr2(i,k), fcontrN(i,k), fcontrP(i,k) )
+
+                        ENDIF ! ((flag_ice_sursat.eq.0).or.(Tbef(i).gt.t_glace_min))
+
+                        ! If vertical heterogeneity, change fraction by volume as well
+                        IF (iflag_cloudth_vert.GE.3) THEN
+                            ctot_vol(i,k)=rneb(i,k)
+                            rneblsvol(i,k)=ctot_vol(i,k)
+                        ENDIF
+
+
+                       ! P2.2.2> Approximative calculation of temperature variation DT 
+                       !           due to condensation.
+                       ! Calculated variables: 
+                       ! dT : temperature change due to condensation
+                       !---------------------------------------------------------------
+
+                
+                        IF (zfice(i).LT.1) THEN
+                            cste=RLVTT
+                        ELSE
+                            cste=RLSTT
+                        ENDIF
+
+                        qlbef(i)=max(0.,zqn(i)-zqs(i))
+                        num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT &
+                              +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
+                        denom = 1.+rneb(i,k)*((1-zfice(i))*RLVTT+zfice(i)*RLSTT)/cste*zdqs(i) &
+                              -(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*rneb(i,k)      &
+                              *qlbef(i)*dzfice(i)
+                        ! here we update a provisory temperature variable that only serves in the iteration
+                        ! process
+                        DT(i)=num/denom
+                        n_i(i)=n_i(i)+1
+
+                    ENDIF ! end keepgoing
+
+                ENDDO     ! end loop on i
+
+        ENDDO         ! iter=1,iflag_fisrtilp_qsat+1
+
+        ! P2.3> Final quantities calculation 
+        ! Calculated variables: 
+        !   rneb : cloud fraction
+        !   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,temp,pplay,paprs,rneb,distcltop1D,temp_cltop1D)
+            distcltop(:,k)=distcltop1D(:)
+            temp_cltop(:,k)=temp_cltop1D(:)
+        ENDIF   
+
+        ! Partition function in stratiform clouds (will be overwritten in boundary-layer MPCs)
+        CALL icefrac_lscp(klon,zt(:),iflag_ice_thermo,distcltop1D(:),temp_cltop1D(:),zfice(:), dzfice(:))
+
+
+        ! Water vapor update, Phase determination and subsequent latent heat exchange
+        DO i=1, klon
+
+            IF (mpc_bl_points(i,k) .GT. 0) THEN
+                zcond(i) = MAX(0.0,qincloud_mpc(i))*rneb(i,k)
+                ! following line is very strange and probably wrong
+                rhcl(i,k)= (zqs(i)+zq(i))/2./zqs(i)
+                ! water vapor update and partition function if thermals
+                zq(i) = zq(i) - zcond(i)        
+                zfice(i)=icefrac_mpc(i,k)
+
+            ELSE
+
+                ! Checks on rneb, rhcl and zqn
+                IF (rneb(i,k) .LE. 0.0) THEN
+                    zqn(i) = 0.0
+                    rneb(i,k) = 0.0
+                    zcond(i) = 0.0
+                    rhcl(i,k)=zq(i)/zqs(i)
+                ELSE IF (rneb(i,k) .GE. 1.0) THEN
+                    zqn(i) = zq(i)
+                    rneb(i,k) = 1.0
+                    zcond(i) = MAX(0.0,zqn(i)-gammasat(i)*zqs(i))
+                    rhcl(i,k)=1.0
+                ELSE
+                    zcond(i) = MAX(0.0,zqn(i)-gammasat(i)*zqs(i))*rneb(i,k)
+                    ! following line is very strange and probably wrong:
+                    rhcl(i,k)=(zqs(i)+zq(i))/2./zqs(i)
+                ENDIF
+
+                ! water vapor update 
+                zq(i) = zq(i) - zcond(i)
+
+            ENDIF
+
+            ! c_iso : routine that computes in-cloud supersaturation
+            ! c_iso condensation of isotopes (zcond, zsursat, zfice, zq in input) 
+
+            ! temperature update due to phase change
+            zt(i) = zt(i) + (1.-zfice(i))*zcond(i) & 
+            &     * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i))) &
+                  +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
+        ENDDO
+
+        ! If vertical heterogeneity, change volume fraction 
+        IF (iflag_cloudth_vert .GE. 3) THEN
+          ctot_vol(1:klon,k)=min(max(ctot_vol(1:klon,k),0.),1.)
+          rneblsvol(1:klon,k)=ctot_vol(1:klon,k)
+        ENDIF
+
+    ! ----------------------------------------------------------------
+    ! P3> Precipitation formation 
+    ! ----------------------------------------------------------------
+
+    ! LTP:
+    IF (iflag_evap_prec .GE. 4) THEN
+
+        !Partitionning between precipitation coming from clouds and that coming from CS
+
+        !0) Calculate tot_zneb, total cloud fraction above the cloud
+        !assuming a maximum-random overlap (voir Jakob and Klein, 2000)
+        
+        DO i=1, klon
+                tot_znebn(i) = 1. - (1.-tot_zneb(i))*(1 - max(rneb(i,k),zneb(i))) &
+                        /(1.-min(zneb(i),1.-smallestreal))
+                d_tot_zneb(i) = tot_znebn(i) - tot_zneb(i)
+                tot_zneb(i) = tot_znebn(i)
+
+
+                !1) Cloudy to clear air
+                d_znebprecip_cld_clr(i) = znebprecipcld(i) - min(rneb(i,k),znebprecipcld(i)) 
+                IF (znebprecipcld(i) .GT. 0.) THEN
+                        d_zrfl_cld_clr(i) = d_znebprecip_cld_clr(i)/znebprecipcld(i)*zrflcld(i) 
+                        d_zifl_cld_clr(i) = d_znebprecip_cld_clr(i)/znebprecipcld(i)*ziflcld(i) 
+                ELSE 
+                        d_zrfl_cld_clr(i) = 0. 
+                        d_zifl_cld_clr(i) = 0. 
+                ENDIF
+
+                !2) Clear to cloudy air
+                d_znebprecip_clr_cld(i) = max(0., min(znebprecipclr(i), rneb(i,k) - d_tot_zneb(i) - zneb(i)))
+                IF (znebprecipclr(i) .GT. 0) THEN
+                        d_zrfl_clr_cld(i) = d_znebprecip_clr_cld(i)/znebprecipclr(i)*zrflclr(i) 
+                        d_zifl_clr_cld(i) = d_znebprecip_clr_cld(i)/znebprecipclr(i)*ziflclr(i)
+                ELSE
+                        d_zrfl_clr_cld(i) = 0. 
+                        d_zifl_clr_cld(i) = 0. 
+                ENDIF 
+
+                !Update variables
+                znebprecipcld(i) = znebprecipcld(i) + d_znebprecip_clr_cld(i) - d_znebprecip_cld_clr(i)
+                znebprecipclr(i) = znebprecipclr(i) + d_znebprecip_cld_clr(i) - d_znebprecip_clr_cld(i) 
+                zrflcld(i) = zrflcld(i) + d_zrfl_clr_cld(i) - d_zrfl_cld_clr(i) 
+                ziflcld(i) = ziflcld(i) + d_zifl_clr_cld(i) - d_zifl_cld_clr(i)
+                zrflclr(i) = zrflclr(i) + d_zrfl_cld_clr(i) - d_zrfl_clr_cld(i)
+                ziflclr(i) = ziflclr(i) + d_zifl_cld_clr(i) - d_zifl_clr_cld(i)
+
+                ! c_iso  do the same thing for isotopes precip
+        ENDDO
+    ENDIF
+
+
+    ! Autoconversion
+    ! -------------------------------------------------------------------------------
+
+
+    ! Initialisation of zoliq and radocond variables
+
+    DO i = 1, klon
+            zoliq(i) = zcond(i)
+            zoliqi(i)= zoliq(i)*zfice(i)
+            zoliql(i)= zoliq(i)*(1.-zfice(i))
+            ! c_iso : initialisation of zoliq* also for isotopes
+            zrho(i,k)  = pplay(i,k) / zt(i) / RD
+            zdz(i)   = (paprs(i,k)-paprs(i,k+1)) / (zrho(i,k)*RG)
+            iwc(i)   = 0. 
+            zneb(i)  = MAX(rneb(i,k),seuil_neb)
+            radocond(i,k) = zoliq(i)/REAL(niter_lscp+1)
+            radicefrac(i,k) = zfice(i)
+            radocondi(i,k)=zoliq(i)*zfice(i)/REAL(niter_lscp+1)
+            radocondl(i,k)=zoliq(i)*(1.-zfice(i))/REAL(niter_lscp+1)
+    ENDDO
+
+       
+    DO n = 1, niter_lscp
+
+        DO i=1,klon
+            IF (rneb(i,k).GT.0.0) THEN
+                iwc(i) = zrho(i,k) * zoliqi(i) / zneb(i) ! in-cloud ice condensate content
+            ENDIF
+        ENDDO
+
+        CALL fallice_velocity(klon,iwc(:),zt(:),zrho(:,k),pplay(:,k),ptconv(:,k),velo(:,k))
+
+        DO i = 1, klon
+
+            IF (rneb(i,k).GT.0.0) THEN
+
+                ! Initialization of zrain, zsnow and zprecip:
+                zrain=0.
+                zsnow=0.
+                zprecip=0.
+                ! c_iso same init for isotopes. Externalisation?
+
+                IF (zneb(i).EQ.seuil_neb) THEN
+                    zprecip = 0.0
+                    zsnow = 0.0
+                    zrain= 0.0
+                ELSE
+
+                    IF (ptconv(i,k)) THEN ! if convective point
+                        zcl=cld_lc_con
+                        zct=1./cld_tau_con
+                        zexpo=cld_expo_con
+                        ffallv=ffallv_con
+                    ELSE
+                        zcl=cld_lc_lsc
+                        zct=1./cld_tau_lsc
+                        zexpo=cld_expo_lsc
+                        ffallv=ffallv_lsc
+                    ENDIF
+
+
+                    ! if vertical heterogeneity is taken into account, we use
+                    ! the "true" volume fraction instead of a modified 
+                    ! surface fraction (which is larger and artificially
+                    ! 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
+
+                    ! if vertical heterogeneity is taken into account, we use
+                    ! the "true" volume fraction instead of a modified 
+                    ! surface fraction (which is larger and artificially
+                    ! reduces the in-cloud water).
+                        effective_zneb=ctot_vol(i,k)
+                    ELSE
+                        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
+
+
+                    ! 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))
+                    zsnow   = MIN(MAX(zfroi,0.0),zoliqi(i)) 
+                    zprecip = MAX(zrain + zsnow,0.0)
+
+                ENDIF
+
+                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(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
+
+        ENDDO  ! i = 1,klon
+
+    ENDDO      ! n = 1,niter
+
+    ! Precipitation flux calculation
+
+    DO i = 1, klon
+            
+            IF (iflag_evap_prec.GE.4) THEN
+                ziflprev(i)=ziflcld(i)
+            ELSE
+                ziflprev(i)=zifl(i)*zneb(i)
+            ENDIF
+
+            IF (rneb(i,k) .GT. 0.0) THEN
+
+               ! CR&JYG: We account for the Wegener-Findeisen-Bergeron process in the precipitation flux:
+               ! If T<0C, liquid precip are converted into ice, which leads to an increase in
+               ! temperature DeltaT. The effect of DeltaT on condensates and precipitation is roughly
+               ! taken into account through a linearization of the equations and by approximating
+               ! the liquid precipitation process with a "threshold" process. We assume that
+               ! condensates are not modified during this operation. Liquid precipitation is
+               ! removed (in the limit DeltaT<273.15-T). Solid precipitation increases.
+               ! Water vapor increases as well
+               ! Note that compared to fisrtilp, we always assume iflag_bergeron=2
+
+                    zqpreci(i)=(zcond(i)-zoliq(i))*zfice(i)
+                    zqprecl(i)=(zcond(i)-zoliq(i))*(1.-zfice(i))
+                    zcp=RCPD*(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
+                    coef1 = rneb(i,k)*RLSTT/zcp*zdqsdT_raw(i)
+                    ! Computation of DT if all the liquid precip freezes
+                    DeltaT = RLMLT*zqprecl(i) / (zcp*(1.+coef1))
+                    ! T should not exceed the freezing point
+                    ! that is Delta > RTT-zt(i)
+                    DeltaT = max( min( RTT-zt(i), DeltaT) , 0. )
+                    zt(i)  = zt(i) + DeltaT
+                    ! water vaporization due to temp. increase
+                    Deltaq = rneb(i,k)*zdqsdT_raw(i)*DeltaT
+                    ! we add this vaporized water to the total vapor and we remove it from the precip
+                    zq(i) = zq(i) +  Deltaq
+                    ! The three "max" lines herebelow protect from rounding errors
+                    zcond(i) = max( zcond(i)- Deltaq, 0. )
+                    ! liquid precipitation converted to ice precip 
+                    Deltaqprecl = -zcp/RLMLT*(1.+coef1)*DeltaT
+                    zqprecl(i) = max( zqprecl(i) + Deltaqprecl, 0. )
+                    ! iced water budget
+                    zqpreci(i) = max (zqpreci(i) - Deltaqprecl - Deltaq, 0.)
+
+                    ! c_iso : mv here condensation of isotopes + redispatchage en precip 
+
+                IF (iflag_evap_prec.GE.4) THEN
+                    zrflcld(i) = zrflcld(i)+zqprecl(i) &
+                    *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
+                    ziflcld(i) = ziflcld(i)+ zqpreci(i) &
+                        *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
+                    znebprecipcld(i) = rneb(i,k)
+                    zrfl(i) = zrflcld(i) + zrflclr(i)
+                    zifl(i) = ziflcld(i) + ziflclr(i)
+                ELSE
+                    zrfl(i) = zrfl(i)+ zqprecl(i)        &
+                    *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
+                    zifl(i) = zifl(i)+ zqpreci(i)        &
+                   *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
+                ENDIF
+                ! c_iso : same for isotopes
+ 
+           ENDIF ! rneb>0
+
+   ENDDO
+
+    ! LTP: limit of surface cloud fraction covered by precipitation when the local intensity of the flux is below rain_int_min
+    ! if iflag_evap_prec>=4
+    IF (iflag_evap_prec.GE.4) THEN
+
+        DO i=1,klon
+
+            IF ((zrflclr(i) + ziflclr(i)) .GT. 0. ) THEN
+                znebprecipclr(i) = min(znebprecipclr(i),max(zrflclr(i)/ &
+                (MAX(znebprecipclr(i),seuil_neb)*rain_int_min), ziflclr(i)/(MAX(znebprecipclr(i),seuil_neb)*rain_int_min)))
+            ELSE
+                znebprecipclr(i)=0.0
+            ENDIF
+
+            IF ((zrflcld(i) + ziflcld(i)) .GT. 0.) THEN
+                znebprecipcld(i) = min(znebprecipcld(i), max(zrflcld(i)/ &
+                (MAX(znebprecipcld(i),seuil_neb)*rain_int_min), ziflcld(i)/(MAX(znebprecipcld(i),seuil_neb)*rain_int_min)))
+            ELSE
+                znebprecipcld(i)=0.0
+            ENDIF
+
+        ENDDO
+
+
+    ENDIF
+
+    ! End of precipitation formation
+    ! --------------------------------
+
+    ! Outputs:
+    ! Precipitation fluxes at layer interfaces
+    ! + 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)
+        d_q(i,k) = zq(i) - qt(i,k)
+        ! c_iso: same for isotopes
+        d_t(i,k) = zt(i) - temp(i,k)
+    ENDDO
+
+    ! Calculation of the concentration of condensates seen by the radiation scheme
+    ! for liquid phase, we take radocondl
+    ! for ice phase, we take radocondi if we neglect snowfall, otherwise (ok_radocond_snow=true) 
+    ! we recaulate radocondi to account for contributions from the precipitation flux
+
+    IF ((ok_radocond_snow) .AND. (k .LT. klev)) THEN
+        ! for the solid phase (crystals + snowflakes)
+        ! we recalculate radocondi by summing
+        ! the ice content calculated in the mesh
+        ! + the contribution of the non-evaporated snowfall 
+        ! from the overlying layer
+        DO i=1,klon
+           IF (ziflprev(i) .NE. 0.0) THEN
+              radocondi(i,k)=zoliq(i)*zfice(i)+zqpreci(i)+ziflprev(i)/zrho(i,k+1)/velo(i,k+1)
+           ELSE
+              radocondi(i,k)=zoliq(i)*zfice(i)+zqpreci(i)
+           ENDIF
+           radocond(i,k)=radocondl(i,k)+radocondi(i,k)
+        ENDDO
+    ENDIF
+
+    ! caculate the percentage of ice in "radocond" so cloud+precip seen by the radiation scheme
+    DO i=1,klon
+        IF (radocond(i,k) .GT. 0.) THEN
+            radicefrac(i,k)=MIN(MAX(radocondi(i,k)/radocond(i,k),0.),1.)
+        ENDIF
+    ENDDO
+
+    ! ----------------------------------------------------------------
+    ! P4> Wet scavenging
+    ! ----------------------------------------------------------------
+
+    !Scavenging through nucleation in the layer
+
+    DO i = 1,klon
+        
+        IF(zcond(i).GT.zoliq(i)+1.e-10) THEN
+            beta(i,k) = (zcond(i)-zoliq(i))/zcond(i)/dtime
+        ELSE
+            beta(i,k) = 0.
+        ENDIF
+
+        zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0)*(paprs(i,k)-paprs(i,k+1))/RG
+
+        IF (rneb(i,k).GT.0.0.AND.zprec_cond(i).GT.0.) THEN
+
+            IF (temp(i,k) .GE. t_glace_min) THEN
+                zalpha_tr = a_tr_sca(3)
+            ELSE
+                zalpha_tr = a_tr_sca(4)
+            ENDIF
+
+            zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
+            frac_nucl(i,k)= 1.-zneb(i)*zfrac_lessi 
+
+            ! Nucleation with a factor of -1 instead of -0.5
+            zfrac_lessi = 1. - EXP(-zprec_cond(i)/zneb(i))
+
+        ENDIF
+
+    ENDDO
+
+    ! Scavenging through impaction in the underlying layer
+
+    DO kk = k-1, 1, -1
+
+        DO i = 1, klon
+
+            IF (rneb(i,k).GT.0.0.AND.zprec_cond(i).GT.0.) THEN
+
+                IF (temp(i,kk) .GE. t_glace_min) THEN
+                    zalpha_tr = a_tr_sca(1)
+                ELSE
+                    zalpha_tr = a_tr_sca(2)
+                ENDIF
+
+              zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
+              frac_impa(i,kk)= 1.-zneb(i)*zfrac_lessi
+
+            ENDIF
+
+        ENDDO
+
+    ENDDO
+
+    !--save some variables for ice supersaturation
+    !
+    DO i = 1, klon
+        ! for memory 
+        rneb_seri(i,k) = rneb(i,k)
+
+        ! for diagnostics
+        rnebclr(i,k) = 1.0 - rneb(i,k) - rnebss(i,k)
+
+        qvc(i,k) = zqs(i) * rneb(i,k)
+        qclr(i,k) = MAX(1.e-10,zq(i) - qvc(i,k) - qss(i,k))  !--added by OB because of pathologic cases with the lognormal
+        qcld(i,k) = qvc(i,k) + zcond(i)
+   ENDDO
+   !q_sat
+   CALL calc_qsat_ecmwf(klon,Tbef(:),qzero(:),pplay(:,k),RTT,1,.false.,qsatl(:,k),zdqs(:))
+   CALL calc_qsat_ecmwf(klon,Tbef(:),qzero(:),pplay(:,k),RTT,2,.false.,qsats(:,k),zdqs(:))
+
+ENDDO
+
+!======================================================================
+!                      END OF VERTICAL LOOP
+!======================================================================
+
+  ! Rain or snow at the surface (depending on the first layer temperature)
+  DO i = 1, klon
+      snow(i) = zifl(i)
+      rain(i) = zrfl(i)
+      ! c_iso final output
+  ENDDO
+
+  IF (ncoreczq>0) THEN
+      WRITE(lunout,*)'WARNING : ZQ in LSCP ',ncoreczq,' val < 1.e-15.'
+  ENDIF
+
+
+RETURN
+
+END SUBROUTINE lscp
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+END MODULE lmdz_lscp
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_lscp_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_lscp_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_lscp_ini.F90	(revision 4727)
@@ -0,0 +1,278 @@
+MODULE lmdz_lscp_ini
+
+IMPLICIT NONE
+
+  ! 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 :: lunout, prt_level            ! Logical unit number and level for standard output
+  !$OMP THREADPRIVATE(lunout,prt_level)
+
+  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
+                                                ! pay attention that iflag_evap_prec=4 may lead to unrealistic and overestimated
+                                                ! evaporation. Use 5 instead
+  !$OMP THREADPRIVATE(iflag_evap_prec)
+
+  REAL t_coup                                   ! temperature threshold which determines the phase 
+  PARAMETER (t_coup=234.0)                      ! for which the saturation vapor pressure is calculated
+
+  REAL DDT0                                     ! iteration parameter 
+  PARAMETER (DDT0=.01)
+
+  REAL ztfondue                                 ! parameter to calculate melting fraction of precipitation
+  PARAMETER (ztfondue=278.15)
+
+  REAL temp_nowater                             ! temperature below which liquid water no longer exists
+  PARAMETER (temp_nowater=233.15)
+
+  REAL, SAVE    :: rain_int_min=0.001           ! Minimum local rain intensity [mm/s] before the decrease in associated precipitation fraction 
+  !$OMP THREADPRIVATE(rain_int_min)
+
+  REAL, SAVE :: a_tr_sca(4)                     ! Variables for tracers temporary: alpha parameter for scavenging, 4 possible scavenging processes
+  !$OMP THREADPRIVATE(a_tr_sca)
+  
+  INTEGER, SAVE ::  iflag_mpc_bl=0              ! flag to activate boundary layer mixed phase cloud param
+  !$OMP THREADPRIVATE(iflag_mpc_bl)
+  
+  LOGICAL, SAVE :: ok_radocond_snow=.false.       ! take into account the mass of ice precip in the cloud ice content seen by radiation
+  !$OMP THREADPRIVATE(ok_radocond_snow)
+
+  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)
+
+! Two parameters used for lmdz_lscp_old only
+  INTEGER, SAVE :: iflag_oldbug_fisrtilp=0, fl_cor_ebil 
+  !$OMP THREADPRIVATE(iflag_oldbug_fisrtilp,fl_cor_ebil)
+
+CONTAINS
+
+SUBROUTINE lscp_ini(dtime,lunout_in,prt_level_in,ok_ice_sursat, iflag_ratqs, fl_cor_ebil_in, RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in, &
+                    RVTMP2_in, RTT_in,RD_in,RG_in)
+
+
+   USE ioipsl_getin_p_mod, ONLY : getin_p
+   USE ice_sursat_mod, ONLY: ice_sursat_init
+   USE lmdz_cloudth_ini, ONLY : cloudth_ini
+
+   REAL, INTENT(IN)      :: dtime
+   INTEGER, INTENT(IN)   :: lunout_in,prt_level_in,iflag_ratqs,fl_cor_ebil_in
+   LOGICAL, INTENT(IN)   :: ok_ice_sursat
+
+   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
+
+
+    lunout=lunout_in
+    prt_level=prt_level_in
+    fl_cor_ebil=fl_cor_ebil_in
+
+    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)
+    CALL getin_p('rain_int_min',rain_int_min) 
+    CALL getin_p('iflag_mpc_bl',iflag_mpc_bl)
+    CALL getin_p('ok_radocond_snow',ok_radocond_snow) 
+    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)
+    CALL getin_p('iflag_oldbug_fisrtilp',iflag_oldbug_fisrtilp)
+
+
+
+
+    WRITE(lunout,*) 'lscp_ini, niter_lscp:', niter_lscp
+    WRITE(lunout,*) 'lscp_ini, iflag_evap_prec:', iflag_evap_prec
+    WRITE(lunout,*) 'lscp_ini, seuil_neb:', seuil_neb
+    WRITE(lunout,*) 'lscp_ini, rain_int_min:', rain_int_min
+    WRITE(lunout,*) 'lscp_ini, iflag_mpc_bl:', iflag_mpc_bl
+    WRITE(lunout,*) 'lscp_ini, ok_radocond_snow:', ok_radocond_snow
+    WRITE(lunout,*) 'lscp_ini, t_glace_max:', t_glace_max
+    WRITE(lunout,*) 'lscp_ini, t_glace_min:', t_glace_min
+    WRITE(lunout,*) 'lscp_ini, exposant_glace:', exposant_glace
+    WRITE(lunout,*) 'lscp_ini, iflag_vice:', iflag_vice
+    WRITE(lunout,*) 'lscp_ini, iflag_t_glace:', iflag_t_glace
+    WRITE(lunout,*) 'lscp_ini, iflag_cloudth_vert:', iflag_cloudth_vert
+    WRITE(lunout,*) 'lscp_ini, iflag_gammasat:', iflag_gammasat
+    WRITE(lunout,*) 'lscp_ini, iflag_rain_incloud_vol:', iflag_rain_incloud_vol
+    WRITE(lunout,*) 'lscp_ini, iflag_bergeron:', iflag_bergeron
+    WRITE(lunout,*) 'lscp_ini, iflag_fisrtilp_qsat:', iflag_fisrtilp_qsat
+    WRITE(lunout,*) 'lscp_ini, iflag_pdf', iflag_pdf
+    WRITE(lunout,*) 'lscp_ini, reevap_ice', reevap_ice
+    WRITE(lunout,*) 'lscp_ini, cld_lc_lsc', cld_lc_lsc
+    WRITE(lunout,*) 'lscp_ini, cld_lc_con', cld_lc_con
+    WRITE(lunout,*) 'lscp_ini, cld_tau_lsc', cld_tau_lsc
+    WRITE(lunout,*) 'lscp_ini, cld_tau_con', cld_tau_con
+    WRITE(lunout,*) 'lscp_ini, cld_expo_lsc', cld_expo_lsc
+    WRITE(lunout,*) 'lscp_ini, cld_expo_con', cld_expo_con
+    WRITE(lunout,*) 'lscp_ini, ffallv_lsc', ffallv_lsc
+    WRITE(lunout,*) 'lscp_ini, ffallv_con', ffallv_con
+    WRITE(lunout,*) 'lscp_ini, coef_eva', coef_eva
+    WRITE(lunout,*) 'lscp_ini, coef_eva_i', coef_eva_i
+    WRITE(lunout,*) 'lscp_ini, iflag_autoconversion', iflag_autoconversion
+    WRITE(lunout,*) 'lscp_ini, dist_liq', dist_liq
+    WRITE(lunout,*) 'lscp_ini, tresh_cl', tresh_cl
+    WRITE(lunout,*) 'lscp_ini, iflag_oldbug_fisrtilp', iflag_oldbug_fisrtilp
+    WRITE(lunout,*) 'lscp_ini, fl_cor_ebil', fl_cor_ebil
+
+
+
+
+
+    ! check for precipitation sub-time steps
+    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
+
+
+    !AA Temporary initialisation
+    a_tr_sca(1) = -0.5
+    a_tr_sca(2) = -0.5
+    a_tr_sca(3) = -0.5
+    a_tr_sca(4) = -0.5
+    
+    IF (ok_ice_sursat) CALL ice_sursat_init()
+
+    CALL cloudth_ini(iflag_cloudth_vert,iflag_ratqs)
+
+RETURN
+
+END SUBROUTINE lscp_ini
+
+END MODULE lmdz_lscp_ini
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_lscp_old.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_lscp_old.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_lscp_old.F90	(revision 4727)
@@ -0,0 +1,1682 @@
+! $Id$
+!
+!
+MODULE lmdz_lscp_old
+CONTAINS
+SUBROUTINE fisrtilp(klon,klev,dtime,paprs,pplay,t,q,ptconv,ratqs, &
+     d_t, d_q, d_ql, d_qi, rneb,rneblsvol,radliq, rain, snow,          &
+     pfrac_impa, pfrac_nucl, pfrac_1nucl,               &
+     frac_impa, frac_nucl, beta,                        &
+     prfl, psfl, rhcl, zqta, fraca,                     &
+     ztv, zpspsk, ztla, zthl, iflag_cld_th,             &
+     iflag_ice_thermo,                                  &
+     cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+
+  !
+  USE icefrac_lsc_mod ! compute ice fraction (JBM 3/14)
+  USE lmdz_cloudth, only : cloudth, cloudth_v3, cloudth_v6
+
+  USE lmdz_lscp_ini, ONLY: prt_level, lunout
+  USE lmdz_lscp_ini, ONLY : fl_cor_ebil 
+  USE lmdz_lscp_ini, ONLY: iflag_t_glace,t_glace_min, t_glace_max, exposant_glace
+  USE lmdz_lscp_ini, ONLY : seuil_neb, rain_int_min, iflag_evap_prec, iflag_oldbug_fisrtilp,a_tr_sca
+  USE lmdz_lscp_ini, ONLY: iflag_cloudth_vert, iflag_rain_incloud_vol 
+  USE lmdz_lscp_ini, ONLY: coef_eva, coef_eva_i, ffallv_lsc, ffallv_con
+  USE lmdz_lscp_ini, ONLY: cld_tau_lsc, cld_tau_con, cld_lc_lsc, cld_lc_con
+  USE lmdz_lscp_ini, ONLY: reevap_ice, iflag_bergeron, iflag_fisrtilp_qsat, iflag_pdf 
+
+
+
+  IMPLICIT none
+  !======================================================================
+  ! Auteur(s): Z.X. Li (LMD/CNRS)
+  ! Date: le 20 mars 1995
+  ! Objet: condensation et precipitation stratiforme.
+  !        schema de nuage
+  ! Fusion de fisrt (physique sursaturation, P. LeVan K. Laval)
+  !             et ilp (il pleut, L. Li)
+  ! Principales parties:
+  ! P0> Thermalisation des precipitations venant de la couche du dessus
+  ! P1> Evaporation de la precipitation (qui vient du niveau k+1)
+  ! P2> Formation du nuage (en k) 
+  ! P2.A.0> Calcul des grandeurs nuageuses une pdf en creneau
+  ! P2.A.1> Avec les nouvelles PDFs, calcul des grandeurs nuageuses pour 
+  ! les valeurs de T et Q initiales
+  ! P2.A.2> Prise en compte du couplage entre eau condensee et T.
+  ! P2.A.3> Calcul des valeures finales associees a la formation des nuages
+  ! P2.B> Nuage "tout ou rien"
+  ! P2.C> Prise en compte de la Chaleur latente apres formation nuage
+  ! P3> Formation de la precipitation (en k)
+  !======================================================================
+  ! JLD: 
+  ! * Routine probablement fausse (au moins incoherente) si thermcep = .false.
+  ! * fl_cor_ebil doit etre > 0 ; 
+  !   fl_cor_ebil= 0 pour reproduire anciens bugs
+  !======================================================================
+  include "YOMCST.h"
+  include "YOETHF.h"
+  include "FCTTRE.h"
+  !
+  ! Principaux inputs:
+  !
+  REAL, INTENT(IN)                              :: dtime  ! intervalle du temps (s)
+  INTEGER, INTENT(IN)                           :: klon, klev
+  REAL, DIMENSION(klon,klev+1),    INTENT(IN)   :: paprs  ! pression a inter-couche
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: pplay  ! pression au milieu de couche
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: t      ! temperature (K)
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: q      ! humidite specifique (kg/kg)
+  LOGICAL, DIMENSION(klon,klev),   INTENT(IN)   :: ptconv ! points ou le schema de conv. prof. est actif
+  INTEGER,                         INTENT(IN)   :: iflag_cld_th
+  INTEGER,                         INTENT(IN)   :: iflag_ice_thermo
+  !
+  ! Inputs lies aux thermiques
+  ! 
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: ztv
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: zqta, fraca 
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: zpspsk, ztla
+  REAL, DIMENSION(klon,klev),      INTENT(INOUT)   :: zthl
+  !
+  !  Input/output
+  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: ratqs  ! determine la largeur de distribution de vapeur
+  !
+  ! Principaux outputs:
+  !
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_t  ! incrementation de la temperature (K)
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_q  ! incrementation de la vapeur d'eau
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_ql ! incrementation de l'eau liquide
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_qi ! incrementation de l'eau glace
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rneb, rneblsvol ! fraction nuageuse
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: beta ! taux de conversion de l'eau cond
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: radliq ! eau liquide utilisee dans rayonnements
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rhcl ! humidite relative en ciel clair
+  REAL, DIMENSION(klon),           INTENT(OUT)  :: rain
+  REAL, DIMENSION(klon),           INTENT(OUT)  :: snow
+  REAL, DIMENSION(klon,klev+1),    INTENT(OUT)  :: prfl
+  REAL, DIMENSION(klon,klev+1),    INTENT(OUT)  :: psfl 
+
+  !AA
+  ! Coeffients de fraction lessivee : pour OFF-LINE
+  !
+  REAL, DIMENSION(klon,klev),      INTENT(INOUT)  :: pfrac_nucl
+  REAL, DIMENSION(klon,klev),      INTENT(INOUT)  :: pfrac_1nucl
+  REAL, DIMENSION(klon,klev),      INTENT(INOUT)  :: pfrac_impa
+  !
+  ! Fraction d'aerosols lessivee par impaction et par nucleation
+  ! POur ON-LINE
+  !
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_impa
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_nucl
+  REAL, DIMENSION(klon,klev), INTENT(OUT) :: cloudth_sth,cloudth_senv
+  REAL, DIMENSION(klon,klev), INTENT(OUT) :: cloudth_sigmath,cloudth_sigmaenv
+  !AA
+  ! --------------------------------------------------------------------------------
+  !
+  ! Options du programme:
+  !
+
+  REAL :: smallestreal
+
+  INTEGER, PARAMETER :: ninter=5 ! sous-intervals pour la precipitation
+  LOGICAL, PARAMETER :: cpartiel=.TRUE. ! condensation partielle
+  REAL, PARAMETER :: t_coup=234.0
+  REAL, PARAMETER :: DDT0=.01
+  REAL, PARAMETER :: ztfondue=278.15
+  ! --------------------------------------------------------------------------------
+  !
+  ! Variables locales:
+  !
+  INTEGER :: i, k, n, kk
+  REAL :: qsl, qsi
+  REAL :: zct      ,zcl
+  INTEGER :: ncoreczq  
+  REAL, DIMENSION(klon,klev) :: ctot,ctot_vol
+  REAL, DIMENSION(klon) :: zqs, zdqs, zdqsdT_raw, Tbef,qlbef,DT
+  REAL :: zdelta, zcor, zcvm5  
+  REAL ::num,denom
+
+  LOGICAL, DIMENSION(klon) :: lognormale,convergence
+  LOGICAL :: ice_thermo
+  INTEGER, DIMENSION(klon) :: n_i
+  INTEGER :: iter
+  REAL :: cste
+
+  REAL, DIMENSION(klon) :: zpdf_sig,zpdf_k,zpdf_delta, Zpdf_a,zpdf_b,zpdf_e1,zpdf_e2, qcloud
+  REAL :: erf   
+ 
+  REAL :: zqev, zqevt, zqev0,zqevi, zqevti, zdelq 
+  REAL, DIMENSION(klon) :: zrfl(klon), zrfln(klon), zrflclr(klon), zrflcld(klon), d_zrfl_clr_cld(klon), d_zifl_clr_cld(klon), d_zrfl_cld_clr(klon), d_zifl_cld_clr(klon) 
+
+  REAL, DIMENSION(klon) :: zifl, zifln, ziflclr, ziflcld, zoliq, zcond, zq, zqn, zoliqp, zoliqi, zt
+! JBM (3/14) nexpo is replaced by exposant_glace
+! REAL nexpo ! exponentiel pour glace/eau
+! INTEGER, PARAMETER :: nexpo=6
+  INTEGER :: exposant_glace_old
+  REAL :: t_glace_min_old, ztot
+  REAL, DIMENSION(klon) ::  zdz,zrho , zrhol, zfice,zneb,znebprecip
+  REAL :: zchau      ,zfroi      
+  REAL, DIMENSION(klon) :: znebprecipclr, znebprecipcld, tot_zneb, tot_znebn, d_tot_zneb, d_znebprecip_clr_cld, d_znebprecip_cld_clr, dzfice
+  REAL :: zmelt, zpluie, zice
+  REAL :: zsolid
+!!!!
+!  Variables pour Bergeron
+  REAL :: zcp, coef1, DeltaT, Deltaq, Deltaqprecl
+  REAL, DIMENSION(klon) :: zqpreci, zqprecl
+! Variable pour conservation enegie des precipitations
+  REAL, DIMENSION(klon) :: zmqc
+  !
+  LOGICAL, SAVE :: appel1er=.TRUE.
+  !$OMP THREADPRIVATE(appel1er)
+  !
+! iflag_oldbug_fisrtilp=0 enleve le BUG par JYG : tglace_min -> tglace_max
+! iflag_oldbug_fisrtilp=1 ajoute le BUG
+  !---------------------------------------------------------------
+  !
+  ! Fonctions en ligne:
+  !
+  REAL ::  fallvs,fallvc, zzz ! Vitesse de chute pour cristaux de glace
+                     ! (Heymsfield & Donner, 1990)
+  fallvc (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_con
+  fallvs (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_lsc
+  !
+  !---------------------------------------------------------------
+  !AA Variables traceurs:
+  !AA  Provisoire !!! Parametres alpha du lessivage
+  !AA  A priori on a 4 scavenging # possibles
+  !
+  ! Variables intermediaires
+  !
+  REAL :: zalpha_tr, zfrac_lessi
+  REAL, DIMENSION(klon) :: zprec_cond
+  !AA
+! RomP >>> 15 nov 2012
+! RomP <<<
+  REAL, DIMENSION(klon) :: zmair
+  REAL :: zcpair, zcpeau
+  !     Pour la conversion eau-neige
+  REAL, DIMENSION(klon) :: zlh_solid
+  REAL :: zm_solid
+
+
+  !
+  !ym
+!CR: pour iflag_ice_thermo=2, on active que la convection
+!  ice_thermo = iflag_ice_thermo .GE. 1
+
+  
+  znebprecip(:)=0.
+
+!<LTP
+  smallestreal=1.e-9
+  znebprecipclr(:)=0.
+  znebprecipcld(:)=0.
+!>LTP
+
+  ice_thermo = (iflag_ice_thermo .EQ. 1).OR.(iflag_ice_thermo .GE. 3)
+  zdelq=0.0
+  ctot_vol(1:klon,1:klev)=0.0
+  rneblsvol(1:klon,1:klev)=0.0
+
+  if (prt_level>9)write(lunout,*)'NUAGES4 A. JAM'
+  IF (appel1er) THEN
+     WRITE(lunout,*) 'fisrtilp, ninter:', ninter
+     WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel
+     WRITE(lunout,*) 'FISRTILP VERSION LUDO'
+     
+     IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
+        WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
+        WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes'
+        !         CALL abort
+     ENDIF
+     appel1er = .FALSE.
+     !
+     !cdir collapse
+     DO k = 1, klev
+        DO i = 1, klon
+           pfrac_nucl(i,k)=1.
+           pfrac_1nucl(i,k)=1.
+           pfrac_impa(i,k)=1.
+           beta(i,k)=0.  !RomP initialisation
+        ENDDO
+     ENDDO
+
+  ENDIF          !  test sur appel1er
+  !
+  !MAf Initialisation a 0 de zoliq
+  !      DO i = 1, klon
+  !         zoliq(i)=0.
+  !      ENDDO 
+  ! Determiner les nuages froids par leur temperature
+  !  nexpo regle la raideur de la transition eau liquide / eau glace.
+  !
+!CR: on est oblige de definir des valeurs fisrt car les valeurs de newmicro ne sont pas les memes par defaut
+  IF (iflag_t_glace.EQ.0) THEN
+!   ztglace = RTT - 15.0
+    t_glace_min_old = RTT - 15.0
+    !AJ<
+    IF (ice_thermo) THEN
+!     nexpo = 2
+      exposant_glace_old = 2
+    ELSE
+!     nexpo = 6
+      exposant_glace_old = 6
+    ENDIF
+    
+  ENDIF
+  
+!!  RLVTT = 2.501e6 ! pas de redefinition des constantes physiques (jyg)
+!!  RLSTT = 2.834e6 ! pas de redefinition des constantes physiques (jyg)
+!>AJ
+  !cc      nexpo = 1
+  !
+  ! Initialiser les sorties:
+  !
+  !cdir collapse
+  DO k = 1, klev+1
+     DO i = 1, klon
+        prfl(i,k) = 0.0
+        psfl(i,k) = 0.0
+     ENDDO
+  ENDDO
+
+  !cdir collapse
+
+  DO k = 1, klev
+     DO i = 1, klon
+        d_t(i,k) = 0.0
+        d_q(i,k) = 0.0
+        d_ql(i,k) = 0.0
+        d_qi(i,k) = 0.0
+        rneb(i,k) = 0.0
+        radliq(i,k) = 0.0
+        frac_nucl(i,k) = 1. 
+        frac_impa(i,k) = 1. 
+     ENDDO
+  ENDDO
+  DO i = 1, klon
+     rain(i) = 0.0
+     snow(i) = 0.0
+     zoliq(i)=0.
+     !     ENDDO
+     !
+     ! Initialiser le flux de precipitation a zero
+     !
+     !     DO i = 1, klon
+     zrfl(i) = 0.0
+     zifl(i) = 0.0
+!<LTP
+     zrflclr(i) = 0.0
+     ziflclr(i) = 0.0
+     zrflcld(i) = 0.0
+     ziflcld(i) = 0.0
+     tot_zneb(i) = 0.0
+     tot_znebn(i) = 0.0
+     d_tot_zneb(i) = 0.0
+!>LTP
+
+     zneb(i) = seuil_neb
+  ENDDO
+  !
+  !
+  !AA Pour plus de securite 
+
+  zalpha_tr   = 0.
+  zfrac_lessi = 0.
+
+  !AA==================================================================
+  !
+  ncoreczq=0
+  ! BOUCLE VERTICALE (DU HAUT VERS LE BAS)
+  !
+  DO k = klev, 1, -1
+     !
+     !AA===============================================================
+     !
+     ! Initialisation temperature et vapeur
+     DO i = 1, klon
+        zt(i)=t(i,k)
+        zq(i)=q(i,k)
+     ENDDO
+     !
+     ! ----------------------------------------------------------------
+     ! P0> Thermalisation des precipitations venant de la couche du dessus
+     ! ----------------------------------------------------------------
+     ! Calculer la varition de temp. de l'air du a la chaleur sensible
+     ! transporter par la pluie. On thermalise la pluie avec l'air de la couche.
+     ! Cette quantite de pluie qui est thermalisee, et devra continue a l'etre lors
+     ! des differentes transformations thermodynamiques. Cette masse d'eau doit
+     ! donc etre ajoute a l'humidite de la couche lorsque l'on calcule la variation
+     ! de l'enthalpie  de la couche avec la temperature
+     ! Variables calculees ou modifiees:
+     !   -  zt: temperature de la cocuhe
+     !   - zmqc: masse de precip qui doit etre thermalisee
+     !
+     IF(k.LE.klev-1) THEN         
+        DO i = 1, klon
+           !IM
+           zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
+           ! il n'y a pas encore d'eau liquide ni glace dans la maiille, donc zq suffit
+           zcpair=RCPD*(1.0+RVTMP2*zq(i))
+           zcpeau=RCPD*RVTMP2
+         if (fl_cor_ebil .GT. 0) then
+           ! zmqc: masse de precip qui doit etre thermalisee avec l'air de la couche atm 
+           ! pour s'assurer que la precip arrivant au sol aura bien la temperature de la 
+           ! derniere couche
+           zmqc(i) = (zrfl(i)+zifl(i))*dtime/zmair(i)
+           ! t(i,k+1)+d_t(i,k+1): nouvelle temp de la couche au dessus
+           zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zmqc(i)*zcpeau + zcpair*zt(i) ) &
+                 / (zcpair + zmqc(i)*zcpeau)
+         else ! si on maintient les anciennes erreurs
+           zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zrfl(i)*dtime*zcpeau &
+                + zmair(i)*zcpair*zt(i) ) &
+                / (zmair(i)*zcpair + zrfl(i)*dtime*zcpeau)
+         end if
+        ENDDO
+     ELSE  ! IF(k.LE.klev-1) 
+        DO i = 1, klon 
+           zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG 
+           zmqc(i) = 0.
+        ENDDO
+     ENDIF ! end IF(k.LE.klev-1)
+     !
+     ! ----------------------------------------------------------------
+     ! P1> Calcul de l'evaporation de la precipitation
+     ! ----------------------------------------------------------------
+     ! On evapore une partie des precipitations venant de la maille du dessus.
+     ! On calcule l'evaporation et la sublimation des precipitations, jusqu'a
+     ! ce que la fraction de cette couche qui est sous le nuage soit saturee.
+     ! Variables calculees ou modifiees:
+     !   - zrfl et zifl: flux de precip liquide et glace
+     !   - zq, zt: humidite et temperature de la cocuhe
+     !   - zmqc: masse de precip qui doit etre thermalisee
+     !
+     IF (iflag_evap_prec>=1) THEN
+        DO i = 1, klon
+!          S'il y a des precipitations
+           IF (zrfl(i)+zifl(i).GT.0.) THEN
+              ! Calcul du qsat
+              IF (thermcep) THEN
+                 zdelta=MAX(0.,SIGN(1.,RTT-zt(i)))
+                 zqs(i)= R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
+                 zqs(i)=MIN(0.5,zqs(i))
+                 zcor=1./(1.-RETV*zqs(i))
+                 zqs(i)=zqs(i)*zcor
+              ELSE
+                 IF (zt(i) .LT. t_coup) THEN
+                    zqs(i) = qsats(zt(i)) / pplay(i,k)
+                 ELSE
+                    zqs(i) = qsatl(zt(i)) / pplay(i,k)
+                 ENDIF
+              ENDIF
+           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
+        ENDDO
+!AJ<
+
+       IF (.NOT. ice_thermo) THEN
+        DO i = 1, klon
+!          S'il y a des precipitations
+           IF (zrfl(i)+zifl(i).GT.0.) THEN
+                ! Evap max pour ne pas saturer la fraction sous le nuage
+                ! Evap max jusqu'à atteindre la saturation dans la partie
+                ! de la maille qui est sous le nuage de la couche du dessus
+                !!! On ne tient compte de cette fraction que sous une seule
+                !!! couche sous le nuage
+                zqev = MAX (0.0, (zqs(i)-zq(i))*zneb(i) )
+             ! Ajout de la prise en compte des precip a thermiser
+             ! avec petite reecriture 
+             if  (fl_cor_ebil .GT. 0) then ! nouveau
+                ! Calcul de l'evaporation du flux de precip herite
+                !   d'au-dessus
+                zqevt = coef_eva * (1.0-zq(i)/zqs(i)) * SQRT(zrfl(i)) &
+                     * zmair(i)/pplay(i,k)*zt(i)*RD
+                zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) * dtime/zmair(i)
+
+                ! Seuil pour ne pas saturer la fraction sous le nuage
+                zqev = MIN (zqev, zqevt)
+                ! Nouveau flux de precip
+                zrfln(i) = zrfl(i) - zqev*zmair(i)/dtime
+                ! Aucun flux liquide pour T < t_coup, on reevapore tout.
+                IF (zt(i) .LT. t_coup.and.reevap_ice) THEN
+                  zrfln(i)=0.
+                  zqev = (zrfl(i)-zrfln(i))/zmair(i)*dtime
+                END IF
+                ! Nouvelle vapeur 
+                zq(i) = zq(i) + zqev
+                zmqc(i) = zmqc(i)-zqev
+                ! Nouvelle temperature (chaleur latente)
+                zt(i) = zt(i) - zqev &
+                     * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
+!!JLD debut de partie a supprimer a terme
+            else ! if  (fl_cor_ebil .GT. 0)
+                ! Calcul de l'evaporation du flux de precip herite
+                !   d'au-dessus
+                zqevt = coef_eva * (1.0-zq(i)/zqs(i)) * SQRT(zrfl(i)) &
+                     * (paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+                zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) &
+                     * RG*dtime/(paprs(i,k)-paprs(i,k+1))
+                ! Seuil pour ne pas saturer la fraction sous le nuage
+                zqev = MIN (zqev, zqevt)
+                ! Nouveau flux de precip
+                zrfln(i) = zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1)) &
+                     /RG/dtime
+                ! Aucun flux liquide pour T < t_coup
+                IF (zt(i) .LT. t_coup.and.reevap_ice) zrfln(i)=0.
+                ! Nouvelle vapeur 
+                zq(i) = zq(i) - (zrfln(i)-zrfl(i)) &
+                     * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
+                ! Nouvelle temperature (chaleur latente)
+                zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
+                     * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
+                     * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
+              end if ! if  (fl_cor_ebil .GT. 0)
+!!JLD fin de partie a supprimer a terme
+                zrfl(i) = zrfln(i)
+                zifl(i) = 0.
+           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
+        ENDDO
+!
+       ELSE ! (.NOT. ice_thermo) 
+!      ================================
+!      Avec thermodynamique de la glace
+!      ================================
+        DO i = 1, klon
+
+
+!AJ<
+!        S'il y a des precipitations
+         IF (zrfl(i)+zifl(i).GT.0.) THEN
+
+        !LTP<
+        !On ne tient compte que du flux de précipitation en ciel clair dans le calcul de l'évaporation.
+                IF (iflag_evap_prec==4) THEN
+                        zrfl(i) = zrflclr(i)
+                        zifl(i) = ziflclr(i)
+                ENDIF
+        
+        !>LTP
+
+         IF (iflag_evap_prec==1) THEN
+            znebprecip(i)=zneb(i)
+         ELSE
+            znebprecip(i)=MAX(zneb(i),znebprecip(i))
+         ENDIF
+         
+         IF (iflag_evap_prec==4) THEN
+        ! Evap max pour ne pas saturer toute la maille
+         zqev0 = MAX (0.0, zqs(i)-zq(i))
+         ELSE 
+        ! Evap max pour ne pas saturer la fraction sous le nuage
+         zqev0 = MAX (0.0, (zqs(i)-zq(i))*znebprecip(i) )
+         ENDIF
+
+         !JAM
+         ! On differencie qsat pour l'eau et la glace
+         ! Si zdelta=1. --> glace
+         ! Si zdelta=0. --> eau liquide
+        
+         ! Calcul du qsat par rapport a l'eau liquide
+         qsl= R2ES*FOEEW(zt(i),0.)/pplay(i,k)
+         qsl= MIN(0.5,qsl)
+         zcor= 1./(1.-RETV*qsl)
+         qsl= qsl*zcor
+         
+         ! Calcul de l'evaporation du flux de precip venant du dessus
+         ! Formulation en racine du flux de precip
+         ! (Klemp & Wilhelmson, 1978; Sundqvist, 1988)
+         IF (iflag_evap_prec==3) THEN
+         zqevt = znebprecip(i)*coef_eva*(1.0-zq(i)/qsl) &
+              *SQRT(zrfl(i)/max(1.e-4,znebprecip(i))) &
+              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+!<LTP
+         ELSE IF (iflag_evap_prec==4) THEN
+         zqevt = znebprecipclr(i)*coef_eva*(1.0-zq(i)/qsl) &
+              *SQRT(zrfl(i)/max(1.e-8,znebprecipclr(i))) &
+              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+!>LTP
+        ELSE 
+         zqevt = 1.*coef_eva*(1.0-zq(i)/qsl)*SQRT(zrfl(i)) &
+              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+         ENDIF
+
+
+         zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) &
+              *RG*dtime/(paprs(i,k)-paprs(i,k+1)) 
+         
+         ! Calcul du qsat par rapport a la glace
+         qsi= R2ES*FOEEW(zt(i),1.)/pplay(i,k)
+         qsi= MIN(0.5,qsi)
+         zcor= 1./(1.-RETV*qsi)
+         qsi= qsi*zcor
+
+         ! Calcul de la sublimation du flux de precip solide herite
+         !   d'au-dessus
+         IF (iflag_evap_prec==3) THEN
+         zqevti = znebprecip(i)*coef_eva*(1.0-zq(i)/qsi) &
+              *SQRT(zifl(i)/max(1.e-4,znebprecip(i))) &
+              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+!<LTP
+         ELSE IF (iflag_evap_prec==4) THEN
+         zqevti = znebprecipclr(i)*coef_eva*(1.0-zq(i)/qsi) &
+              *SQRT(zifl(i)/max(1.e-8,znebprecipclr(i))) &
+              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+!>LTP
+         ELSE
+         zqevti = 1.*coef_eva*(1.0-zq(i)/qsi)*SQRT(zifl(i)) &
+              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+         ENDIF
+         zqevti = MAX(0.0,MIN(zqevti,zifl(i))) &
+              *RG*dtime/(paprs(i,k)-paprs(i,k+1))   
+
+       
+        !JAM
+        ! Limitation de l'evaporation. On s'assure qu'on ne sature pas 
+        ! la fraction de la couche sous le nuage sinon on repartit zqev0 
+        ! en conservant la proportion liquide / glace
+     
+         IF (zqevt+zqevti.GT.zqev0) THEN
+            zqev=zqev0*zqevt/(zqevt+zqevti)
+            zqevi=zqev0*zqevti/(zqevt+zqevti)
+         ELSE
+!JLD je ne comprends pas les lignes ci-dessous. On repartit les precips
+!       liquides et solides meme si on ne sature pas la couche. 
+!       A mon avis, le test est inutile, et il faudrait tout remplacer par:
+!            zqev=zqevt
+!            zqevi=zqevti
+             IF (zqevt+zqevti.GT.0.) THEN
+                zqev=MIN(zqev0*zqevt/(zqevt+zqevti),zqevt)
+                zqevi=MIN(zqev0*zqevti/(zqevt+zqevti),zqevti)
+             ELSE
+             zqev=0.
+             zqevi=0.
+             ENDIF
+         ENDIF
+
+         ! Nouveaux flux de precip liquide et solide 
+         zrfln(i) = Max(0.,zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1)) &
+                                 /RG/dtime)
+         zifln(i) = Max(0.,zifl(i) - zqevi*(paprs(i,k)-paprs(i,k+1)) &
+                                 /RG/dtime)
+
+         ! Mise a jour de la vapeur, temperature et flux de precip
+         zq(i) = zq(i) - (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
+                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
+       if (fl_cor_ebil .GT. 0) then ! avec correction thermalisation des precips
+         zmqc(i) = zmqc(i) + (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
+                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
+         zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
+                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
+                  * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i))) &
+                  + (zifln(i)-zifl(i)) &
+                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
+                  * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
+       else ! sans correction thermalisation des precips
+         zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
+                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
+                  * RLVTT/RCPD/(1.0+RVTMP2*zq(i)) &
+                  + (zifln(i)-zifl(i)) &
+                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
+                  * RLSTT/RCPD/(1.0+RVTMP2*zq(i))
+       end if
+        ! Nouvelles vaeleurs des precips liquides et solides 
+         zrfl(i) = zrfln(i)
+         zifl(i) = zifln(i)
+
+!<LTP
+        IF (iflag_evap_prec==4) THEN
+                zrflclr(i) = zrfl(i)
+                ziflclr(i) = zifl(i)    
+                IF(zrflclr(i) + ziflclr(i) .LE. 0) THEN
+                        znebprecipclr(i) = 0.
+                ENDIF   
+                zrfl(i) = zrflclr(i) + zrflcld(i)
+                zifl(i) = ziflclr(i) + ziflcld(i) 
+        ENDIF
+!>LTP        
+
+
+!CR ATTENTION: deplacement de la fonte de la glace
+!jyg : Bug !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! jyg
+!!!        zmelt = ((zt(i)-273.15)/(ztfondue-273.15))**2  !!!!!!!!! jyg
+!jyg : Bug !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! jyg
+           zmelt = ((zt(i)-273.15)/(ztfondue-273.15))             ! jyg
+           ! fraction de la precip solide qui est fondue
+           zmelt = MIN(MAX(zmelt,0.),1.)
+           ! Fusion de la glace
+!<LTP
+           IF (iflag_evap_prec==4) THEN
+                   zrflclr(i)=zrflclr(i)+zmelt*ziflclr(i)
+                   zrflcld(i)=zrflcld(i)+zmelt*ziflcld(i)
+                   zrfl(i)=zrflclr(i)+zrflcld(i)
+!>LTP        
+           ELSE
+                   zrfl(i)=zrfl(i)+zmelt*zifl(i)
+           ENDIF
+           if (fl_cor_ebil .LE. 0) then
+             ! the following line should not be here. Indeed, if zifl is modified
+             ! now, zifl(i)*zmelt is no more the amount of ice that has melt
+             ! and therefore the change in temperature computed below is wrong
+             zifl(i)=zifl(i)*(1.-zmelt)
+           end if
+           ! Chaleur latente de fusion
+        if (fl_cor_ebil .GT. 0) then ! avec correction thermalisation des precips
+           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
+                      *RLMLT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
+        else ! sans correction thermalisation des precips
+           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
+                      *RLMLT/RCPD/(1.0+RVTMP2*zq(i))
+        end if
+           if (fl_cor_ebil .GT. 0) then ! correction bug, deplacement ligne precedente
+!<LTP
+             IF (iflag_evap_prec==4) THEN
+                   ziflclr(i)=ziflclr(i)*(1.-zmelt)
+                   ziflcld(i)=ziflcld(i)*(1.-zmelt)
+                   zifl(i)=ziflclr(i)+ziflcld(i)
+!>LTP        
+             ELSE
+                   zifl(i)=zifl(i)*(1.-zmelt)
+             ENDIF
+           end if
+
+           ELSE
+              ! Si on n'a plus de pluies, on reinitialise a 0 la farcion
+              ! sous nuageuse utilisee pour la pluie.
+              znebprecip(i)=0.
+           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
+        ENDDO
+
+      ENDIF ! (.NOT. ice_thermo) 
+     
+     ! ----------------------------------------------------------------
+     ! Fin evaporation de la precipitation
+     ! ----------------------------------------------------------------
+     ENDIF ! (iflag_evap_prec>=1)
+     !
+     ! Calculer Qs et L/Cp*dQs/dT:
+     !
+     IF (thermcep) THEN
+        DO i = 1, klon
+           zdelta = MAX(0.,SIGN(1.,RTT-zt(i)))
+           zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
+       if  (fl_cor_ebil .GT. 0) then ! nouveau
+           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
+       else    
+           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i))
+       endif
+           zqs(i) = R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
+           zqs(i) = MIN(0.5,zqs(i))
+           zcor = 1./(1.-RETV*zqs(i))
+           zqs(i) = zqs(i)*zcor
+           zdqs(i) = FOEDE(zt(i),zdelta,zcvm5,zqs(i),zcor)
+           zdqsdT_raw(i) = zdqs(i)*  &
+         &         RCPD*(1.0+RVTMP2*zq(i)) / (RLVTT*(1.-zdelta) + RLSTT*zdelta)
+        ENDDO
+     ELSE
+        DO i = 1, klon
+           IF (zt(i).LT.t_coup) THEN
+              zqs(i) = qsats(zt(i))/pplay(i,k)
+              zdqs(i) = dqsats(zt(i),zqs(i))
+           ELSE
+              zqs(i) = qsatl(zt(i))/pplay(i,k)
+              zdqs(i) = dqsatl(zt(i),zqs(i))
+           ENDIF
+        ENDDO
+     ENDIF
+     !
+     ! Determiner la condensation partielle et calculer la quantite
+     ! de l'eau condensee:
+     !
+!verification de la valeur de iflag_fisrtilp_qsat pour iflag_ice_thermo=1
+!       if ((iflag_ice_thermo.eq.1).and.(iflag_fisrtilp_qsat.ne.0)) then
+!         write(*,*) " iflag_ice_thermo==1 requires iflag_fisrtilp_qsat==0", &
+!        " but iflag_fisrtilp_qsat=",iflag_fisrtilp_qsat, ". Might as well stop here."
+!         stop
+!       endif
+
+     ! ----------------------------------------------------------------
+     ! P2> Formation du nuage
+     ! ----------------------------------------------------------------
+     ! Variables calculees:
+     !   rneb  : fraction nuageuse
+     !   zcond : eau condensee moyenne dans la maille.
+     !   rhcl: humidite relative ciel-clair
+     !   zt : temperature de la maille
+     ! ----------------------------------------------------------------
+     !
+     IF (cpartiel) THEN
+        ! -------------------------
+        ! P2.A> Nuage fractionnaire
+        ! -------------------------
+        !
+        !   Calcul de l'eau condensee et de la fraction nuageuse et de l'eau
+        !   nuageuse a partir des PDF de Sandrine Bony.
+        !   rneb  : fraction nuageuse
+        !   zqn   : eau totale dans le nuage
+        !   zcond : eau condensee moyenne dans la maille.
+        !  on prend en compte le réchauffement qui diminue la partie
+        ! condensee
+        !
+        !   Version avec les raqts
+
+        ! ----------------------------------------------------------------
+        ! P2.A.0> Calcul des grandeurs nuageuses une pdf en creneau
+        ! ----------------------------------------------------------------
+        if (iflag_pdf.eq.0) then
+
+           ! version creneau de (Li, 1998)
+           do i=1,klon
+              zdelq = min(ratqs(i,k),0.99) * zq(i)
+              rneb(i,k) = (zq(i)+zdelq-zqs(i)) / (2.0*zdelq)
+              zqn(i) = (zq(i)+zdelq+zqs(i))/2.0
+           enddo
+
+        else !  if (iflag_pdf.eq.0)
+           ! ----------------------------------------------------------------
+           ! P2.A.1> Avec les nouvelles PDFs, calcul des grandeurs nuageuses pour 
+           ! les valeurs de T et Q initiales
+           ! ----------------------------------------------------------------
+           do i=1,klon
+              if(zq(i).lt.1.e-15) then
+                 ncoreczq=ncoreczq+1
+                 zq(i)=1.e-15
+              endif
+           enddo
+
+           if (iflag_cld_th>=5) then
+
+              if (iflag_cloudth_vert<=2) then
+               call cloudth(klon,klev,k,ztv, &
+                   zq,zqta,fraca, &
+                   qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
+                   ratqs,zqs,t, &
+                   cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+              elseif (iflag_cloudth_vert>=3 .and. iflag_cloudth_vert<=5) then
+               call cloudth_v3(klon,klev,k,ztv, &
+                   zq,zqta,fraca, &
+                   qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
+                   ratqs,zqs,t, &
+                   cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+              !----------------------------------
+              !Version these Jean Jouhaud, Decembre 2018 
+              !----------------------------------              
+              elseif (iflag_cloudth_vert==6) then
+               call cloudth_v6(klon,klev,k,ztv, &
+                   zq,zqta,fraca, &
+                   qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
+                   ratqs,zqs,t, &
+                   cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+              endif
+              do i=1,klon
+                 rneb(i,k)=ctot(i,k)
+                 rneblsvol(i,k)=ctot_vol(i,k)
+                 zqn(i)=qcloud(i)
+              enddo
+
+           endif
+
+           if (iflag_cld_th <= 4) then
+              lognormale = .true.
+           elseif (iflag_cld_th >= 6) then
+              ! lognormale en l'absence des thermiques
+              lognormale = fraca(:,k) < 1e-10
+           else
+              ! Dans le cas iflag_cld_th=5, on prend systématiquement la
+              ! bi-gaussienne
+              lognormale = .false.
+           end if
+
+!CR: variation de qsat avec T en presence de glace ou non
+!initialisations
+           do i=1,klon
+              DT(i) = 0.
+              n_i(i)=0
+              Tbef(i)=zt(i)
+              qlbef(i)=0.
+           enddo
+
+        ! ----------------------------------------------------------------
+        ! P2.A.2> Prise en compte du couplage entre eau condensee et T.
+        ! Calcul des grandeurs nuageuses en tenant compte de l'effet de
+        ! la condensation sur T, et donc sur qsat et sur les grandeurs nuageuses
+        ! qui en dependent. Ce changement de temperature est provisoire, et
+        ! la valeur definitive sera calcule plus tard.
+        ! Variables calculees: 
+        !   rneb : nebulosite
+        !   zcond: eau condensee en moyenne dans la maille
+        ! note JLD: si on n'a pas de pdf lognormale, ce qui se passe ne me semble
+        ! pas clair, il n'y a probablement pas de prise en compte de l'effet de
+        ! T sur qsat
+        ! ----------------------------------------------------------------
+
+!Boucle iterative: ATTENTION, l'option -1 n'est plus activable ici
+           if (iflag_fisrtilp_qsat.ge.0) then
+             ! Iteration pour condensation avec variation de qsat(T) 
+             ! -----------------------------------------------------
+             do iter=1,iflag_fisrtilp_qsat+1
+                
+               do i=1,klon
+!                 do while ((abs(DT(i)).gt.DDT0).or.(n_i(i).eq.0))
+                 ! !! convergence = .true. tant que l'on n'a pas converge !!
+                 ! ------------------------------
+                 convergence(i)=abs(DT(i)).gt.DDT0
+                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
+                 ! si on n'a pas converge
+                 !
+                 ! P2.A.2.1> Calcul de la fraction nuageuse et de la quantite d'eau condensee
+                 ! ---------------------------------------------------------------
+                 ! Variables calculees: 
+                 ! rneb : nebulosite
+                 ! zqn : eau condensee, dans le nuage (in cloud water content)
+                 ! zcond: eau condensee en moyenne dans la maille
+                 ! rhcl: humidite relative ciel-clair
+                 !
+                 Tbef(i)=Tbef(i)+DT(i) ! nouvelle temperature
+                 if (.not.ice_thermo) then   
+                    zdelta = MAX(0.,SIGN(1.,RTT-Tbef(i)))
+                 else
+                    if (iflag_t_glace.eq.0) then
+                    zdelta = MAX(0.,SIGN(1.,t_glace_min_old-Tbef(i)))
+                    else if (iflag_t_glace.ge.1) then
+                       if (iflag_oldbug_fisrtilp.EQ.0) then
+                          zdelta = MAX(0.,SIGN(1.,t_glace_max-Tbef(i)))
+                       else
+                          !avec bug : zdelta = MAX(0.,SIGN(1.,t_glace_min-Tbef(i)))
+                          zdelta = MAX(0.,SIGN(1.,t_glace_min-Tbef(i)))
+                       endif
+                    endif
+                 endif
+                 ! Calcul de rneb, qzn et zcond pour les PDF lognormales
+                 zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
+               if (fl_cor_ebil .GT. 0) then
+                 zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
+               else
+                 zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i))
+               end if
+                 zqs(i) = R2ES*FOEEW(Tbef(i),zdelta)/pplay(i,k)
+                 zqs(i) = MIN(0.5,zqs(i))
+                 zcor = 1./(1.-RETV*zqs(i))
+                 zqs(i) = zqs(i)*zcor
+                 zdqs(i) = FOEDE(Tbef(i),zdelta,zcvm5,zqs(i),zcor)
+                 zpdf_sig(i)=ratqs(i,k)*zq(i)
+                 zpdf_k(i)=-sqrt(log(1.+(zpdf_sig(i)/zq(i))**2))
+                 zpdf_delta(i)=log(zq(i)/zqs(i))
+                 zpdf_a(i)=zpdf_delta(i)/(zpdf_k(i)*sqrt(2.))
+                 zpdf_b(i)=zpdf_k(i)/(2.*sqrt(2.))
+                 zpdf_e1(i)=zpdf_a(i)-zpdf_b(i)
+                 zpdf_e1(i)=sign(min(abs(zpdf_e1(i)),5.),zpdf_e1(i))
+                 zpdf_e1(i)=1.-erf(zpdf_e1(i))
+                 zpdf_e2(i)=zpdf_a(i)+zpdf_b(i)
+                 zpdf_e2(i)=sign(min(abs(zpdf_e2(i)),5.),zpdf_e2(i))
+                 zpdf_e2(i)=1.-erf(zpdf_e2(i))
+             
+                 if (zpdf_e1(i).lt.1.e-10) then
+                    rneb(i,k)=0.
+                    zqn(i)=zqs(i)
+                 else
+                    rneb(i,k)=0.5*zpdf_e1(i)
+                    zqn(i)=zq(i)*zpdf_e2(i)/zpdf_e1(i)
+                 endif
+
+                 ! If vertical heterogeneity, change fraction by volume as well
+                 if (iflag_cloudth_vert>=3) then
+                   ctot_vol(i,k)=rneb(i,k)
+                   rneblsvol(i,k)=ctot_vol(i,k)
+                 endif
+
+                 endif !convergence
+
+               enddo ! boucle en i
+
+                 ! P2.A.2.2> Calcul APPROCHE de la variation de temperature DT 
+                 !         due a la condensation.
+                 ! ---------------------------------------------------------------
+                 ! Variables calculees: 
+                 ! DT : variation de temperature due a la condensation 
+
+                 if (.not. ice_thermo) then
+                 ! --------------------------
+                 do i=1,klon
+                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
+
+                 qlbef(i)=max(0.,zqn(i)-zqs(i))
+               if (fl_cor_ebil .GT. 0) then
+                 num=-Tbef(i)+zt(i)+rneb(i,k)*RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
+               else
+                 num=-Tbef(i)+zt(i)+rneb(i,k)*RLVTT/RCPD/(1.0+RVTMP2*zq(i))*qlbef(i)
+               end if
+                 denom=1.+rneb(i,k)*zdqs(i)
+                 DT(i)=num/denom
+                 n_i(i)=n_i(i)+1
+                 endif
+                 enddo
+
+                 else ! if (.not. ice_thermo)
+                 ! --------------------------
+                 if (iflag_t_glace.ge.1) then
+                 CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
+                 endif
+
+                 do i=1,klon
+                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
+                 
+                 if (iflag_t_glace.eq.0) then
+                    zfice(i) = 1.0 - (Tbef(i)-t_glace_min_old) / (RTT-t_glace_min_old)
+                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
+                    zfice(i) = zfice(i)**exposant_glace_old
+                    dzfice(i)= exposant_glace_old * zfice(i)**(exposant_glace_old-1) &
+          &                     / (t_glace_min_old - RTT)
+                 endif
+                 
+                 if (iflag_t_glace.ge.1.and.zfice(i)>0.) then
+                 dzfice(i)= exposant_glace * zfice(i)**(exposant_glace-1) &
+          &                    / (t_glace_min - t_glace_max)
+                 endif
+               
+                 if ((zfice(i).eq.0).or.(zfice(i).eq.1)) then
+                    dzfice(i)=0.
+                 endif
+
+                 if (zfice(i).lt.1) then
+                    cste=RLVTT
+                 else
+                    cste=RLSTT
+                 endif
+
+                 qlbef(i)=max(0.,zqn(i)-zqs(i))
+               if (fl_cor_ebil .GT. 0) then
+                 num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT &
+           &          +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
+                 denom = 1.+rneb(i,k)*((1-zfice(i))*RLVTT+zfice(i)*RLSTT)/cste*zdqs(i) &
+                         -(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*rneb(i,k)    &
+           &               *qlbef(i)*dzfice(i)
+               else
+                 num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT &
+           &         +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*zq(i))*qlbef(i)
+                 denom = 1.+rneb(i,k)*((1-zfice(i))*RLVTT+zfice(i)*RLSTT)/cste*zdqs(i) &
+                         -(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*zq(i))*rneb(i,k)*qlbef(i)*dzfice(i)
+               end if
+                 DT(i)=num/denom
+                 n_i(i)=n_i(i)+1
+
+                 endif ! fin convergence
+                 enddo ! fin boucle i
+
+                 endif !ice_thermo
+
+             enddo ! iter=1,iflag_fisrtilp_qsat+1
+             ! Fin d'iteration pour condensation avec variation de qsat(T) 
+             ! -----------------------------------------------------------
+           endif !  if (iflag_fisrtilp_qsat.ge.0)
+     ! ----------------------------------------------------------------
+     ! Fin de P2.A.2> la prise en compte du couplage entre eau condensee et T
+     ! ----------------------------------------------------------------
+
+        endif ! iflag_pdf
+
+!        if (iflag_fisrtilp_qsat.eq.-1) then 
+!------------------------------------------
+!CR: ATTENTION option fausse mais a existe:
+! pour la re-activer, prendre iflag_fisrtilp_qsat=0 et
+! activer les lignes suivantes: 
+       IF (1.eq.0) THEN 
+       DO i=1,klon
+           IF (rneb(i,k) .LE. 0.0) THEN
+              zqn(i) = 0.0
+              rneb(i,k) = 0.0
+              zcond(i) = 0.0
+              rhcl(i,k)=zq(i)/zqs(i)
+           ELSE IF (rneb(i,k) .GE. 1.0) THEN
+              zqn(i) = zq(i)
+              rneb(i,k) = 1.0                 
+              zcond(i) = MAX(0.0,zqn(i)-zqs(i))/(1+zdqs(i))
+              rhcl(i,k)=1.0
+           ELSE
+              zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)/(1+zdqs(i))
+              rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
+           ENDIF
+       ENDDO
+       ENDIF
+!------------------------------------------
+
+!        ELSE
+        ! ----------------------------------------------------------------
+        ! P2.A.3> Calcul des valeures finales associees a la formation des nuages
+        ! Variables calculees: 
+        !   rneb : nebulosite
+        !   zcond: eau condensee en moyenne dans la maille
+        !   zq : eau vapeur dans la maille
+        !   zt : temperature de la maille
+        !   rhcl: humidite relative ciel-clair
+        ! ----------------------------------------------------------------
+        !
+        ! Bornage de l'eau in-cloud (zqn) et de la fraction nuageuse (rneb) 
+        ! Calcule de l'eau condensee moyenne dans la maille (zcond),
+        ! et de l'humidite relative ciel-clair (rhcl)
+        DO i=1,klon
+           IF (rneb(i,k) .LE. 0.0) THEN
+              zqn(i) = 0.0
+              rneb(i,k) = 0.0
+              zcond(i) = 0.0
+              rhcl(i,k)=zq(i)/zqs(i)
+           ELSE IF (rneb(i,k) .GE. 1.0) THEN
+              zqn(i) = zq(i)
+              rneb(i,k) = 1.0
+              zcond(i) = MAX(0.0,zqn(i)-zqs(i))
+              rhcl(i,k)=1.0
+           ELSE
+              zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)
+              rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
+           ENDIF
+        ENDDO
+
+       
+        ! If vertical heterogeneity, change fraction by volume as well
+        if (iflag_cloudth_vert>=3) then
+          ctot_vol(1:klon,k)=min(max(ctot_vol(1:klon,k),0.),1.)
+          rneblsvol(1:klon,k)=ctot_vol(1:klon,k)
+        endif
+
+!        ENDIF
+
+     ELSE ! de IF (cpartiel) 
+        ! -------------------------
+        ! P2.B> Nuage "tout ou rien"
+        ! -------------------------
+        ! note JLD: attention, rhcl non calcule. Ca peut avoir des consequences?
+        DO i = 1, klon
+           IF (zq(i).GT.zqs(i)) THEN
+              rneb(i,k) = 1.0
+           ELSE
+              rneb(i,k) = 0.0
+           ENDIF
+           zcond(i) = MAX(0.0,zq(i)-zqs(i))/(1.+zdqs(i))
+        ENDDO
+     ENDIF ! de IF (cpartiel) 
+     !
+     ! Mise a jour vapeur d'eau
+     ! -------------------------
+     DO i = 1, klon
+        zq(i) = zq(i) - zcond(i)
+        !         zt(i) = zt(i) + zcond(i) * RLVTT/RCPD
+     ENDDO
+!AJ<
+     ! ------------------------------------
+     ! P2.C> Prise en compte de la Chaleur latente apres formation nuage
+     ! -------------------------------------
+     ! Variable calcule:
+     !   zt : temperature de la maille
+     !
+     IF (.NOT. ice_thermo) THEN
+        if (iflag_fisrtilp_qsat.lt.1) then
+           DO i = 1, klon
+             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
+           ENDDO
+        else if (iflag_fisrtilp_qsat.gt.0) then
+           DO i= 1, klon
+    if (fl_cor_ebil .GT. 0) then
+             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
+    else
+             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i)))
+    end if
+           ENDDO
+        endif
+     ELSE
+         if (iflag_t_glace.ge.1) then
+            CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
+         endif
+         if (iflag_fisrtilp_qsat.lt.1) then
+           DO i = 1, klon
+! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
+!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
+!                                     t_glace_max, exposant_glace)
+              if (iflag_t_glace.eq.0) then
+                    zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
+                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
+                    zfice(i) = zfice(i)**exposant_glace_old
+              endif
+              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i)) &
+                       +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*zq(i))
+           ENDDO
+         else
+           DO i=1, klon
+! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
+!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
+!                                     t_glace_max, exposant_glace)
+              if (iflag_t_glace.eq.0) then
+                    zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
+                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
+                    zfice(i) = zfice(i)**exposant_glace_old
+              endif
+        if (fl_cor_ebil .GT. 0) then
+              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) & 
+           &             * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i))) &
+                      +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
+        else 
+              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i))) &
+                      +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i)))
+        end if
+           ENDDO
+         endif
+!         print*,zt(i),zrfl(i),zifl(i),'temp1'
+       ENDIF
+!>AJ
+
+     ! ----------------------------------------------------------------
+     ! P3> Formation des precipitations
+     ! ----------------------------------------------------------------
+     !
+     ! Partager l'eau condensee en precipitation et eau liquide nuageuse
+     !
+
+!<LTP
+
+IF (iflag_evap_prec==4) THEN
+        !Partitionnement des precipitations venant du dessus en précipitations nuageuses
+        !et précipitations ciel clair
+
+        !0) Calculate tot_zneb, la fraction nuageuse totale au-dessus du nuage
+        !en supposant un recouvrement maximum aléatoire (voir Jakob and Klein, 2000)
+        
+        DO i=1, klon
+                tot_znebn(i) = 1 - (1-tot_zneb(i))*(1 - max(rneb(i,k),zneb(i))) &
+                        /(1-min(zneb(i),1-smallestreal))
+                d_tot_zneb(i) = tot_znebn(i) - tot_zneb(i)
+                tot_zneb(i) = tot_znebn(i)
+
+
+                !1) Cloudy to clear air
+                d_znebprecip_cld_clr(i) = znebprecipcld(i) - min(rneb(i,k),znebprecipcld(i)) 
+                IF (znebprecipcld(i) .GT. 0) THEN
+                        d_zrfl_cld_clr(i) = d_znebprecip_cld_clr(i)/znebprecipcld(i)*zrflcld(i) 
+                        d_zifl_cld_clr(i) = d_znebprecip_cld_clr(i)/znebprecipcld(i)*ziflcld(i) 
+                ELSE 
+                        d_zrfl_cld_clr(i) = 0. 
+                        d_zifl_cld_clr(i) = 0. 
+                ENDIF
+
+                !2) Clear to cloudy air
+                d_znebprecip_clr_cld(i) = max(0., min(znebprecipclr(i), rneb(i,k) &
+                        - d_tot_zneb(i) - zneb(i)))
+                IF (znebprecipclr(i) .GT. 0) THEN
+                        d_zrfl_clr_cld(i) = d_znebprecip_clr_cld(i)/znebprecipclr(i)*zrflclr(i) 
+                        d_zifl_clr_cld(i) = d_znebprecip_clr_cld(i)/znebprecipclr(i)*ziflclr(i)
+                ELSE
+                        d_zrfl_clr_cld(i) = 0. 
+                        d_zifl_clr_cld(i) = 0. 
+                ENDIF 
+
+                !Update variables
+                znebprecipcld(i) = znebprecipcld(i) + d_znebprecip_clr_cld(i) - d_znebprecip_cld_clr(i)  
+                znebprecipclr(i) = znebprecipclr(i) + d_znebprecip_cld_clr(i) - d_znebprecip_clr_cld(i) 
+                zrflcld(i) = zrflcld(i) + d_zrfl_clr_cld(i) - d_zrfl_cld_clr(i) 
+                ziflcld(i) = ziflcld(i) + d_zifl_clr_cld(i) - d_zifl_cld_clr(i)
+                zrflclr(i) = zrflclr(i) + d_zrfl_cld_clr(i) - d_zrfl_clr_cld(i)
+                ziflclr(i) = ziflclr(i) + d_zifl_cld_clr(i) - d_zifl_clr_cld(i)
+
+        ENDDO
+ENDIF
+
+!>LTP
+
+
+
+     ! Initialisation de zoliq (eau condensee moyenne dans la maille)
+     DO i = 1, klon
+        IF (rneb(i,k).GT.0.0) THEN
+           zoliq(i) = zcond(i)
+           zrho(i) = pplay(i,k) / zt(i) / RD
+           zdz(i) = (paprs(i,k)-paprs(i,k+1)) / (zrho(i)*RG)
+        ENDIF
+     ENDDO
+!AJ<
+     IF (.NOT. ice_thermo) THEN
+       IF (iflag_t_glace.EQ.0) THEN
+         DO i = 1, klon
+            IF (rneb(i,k).GT.0.0) THEN
+               zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (273.13-t_glace_min_old)
+               zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
+               zfice(i) = zfice(i)**exposant_glace_old
+!              zfice(i) = zfice(i)**nexpo
+         !!      zfice(i)=0.
+            ENDIF
+         ENDDO
+       ELSE ! of IF (iflag_t_glace.EQ.0)
+         CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
+!         DO i = 1, klon
+!            IF (rneb(i,k).GT.0.0) THEN
+! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
+!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
+!                                     t_glace_max, exposant_glace)
+!            ENDIF
+!         ENDDO
+       ENDIF
+     ENDIF
+
+     ! Calcul de radliq (eau condensee pour le rayonnement)
+     ! Iteration pour realiser une moyenne de l'eau nuageuse lors de la precip
+     ! Remarque: ce n'est donc pas l'eau restante en fin de precip mais une
+     ! eau moyenne restante dans le nuage sur la duree du pas de temps qui est
+     ! transmise au rayonnement;
+     ! ----------------------------------------------------------------
+     DO i = 1, klon
+        IF (rneb(i,k).GT.0.0) THEN
+           zneb(i) = MAX(rneb(i,k), seuil_neb)
+     !      zt(i) = zt(i)+zcond(i)*zfice(i)*RLMLT/RCPD/(1.0+RVTMP2*zq(i))  
+!           print*,zt(i),'fractionglace'
+!>AJ
+           radliq(i,k) = zoliq(i)/REAL(ninter+1)
+        ENDIF
+     ENDDO
+     !
+     DO n = 1, ninter
+        DO i = 1, klon
+           IF (rneb(i,k).GT.0.0) THEN
+              zrhol(i) = zrho(i) * zoliq(i) / zneb(i)
+              ! Initialization of zpluie and zice:
+              zpluie=0
+              zice=0
+              IF (zneb(i).EQ.seuil_neb) THEN
+                 ztot = 0.0
+              ELSE
+                 !  quantite d'eau a eliminer: zchau (Sundqvist, 1978)
+                 !  meme chose pour la glace: zfroi (Zender & Kiehl, 1997)
+                 if (ptconv(i,k)) then
+                    zcl   =cld_lc_con
+                    zct   =1./cld_tau_con
+                    zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i) &
+                         *fallvc(zrhol(i)) * zfice(i)
+                 else
+                    zcl   =cld_lc_lsc
+                    zct   =1./cld_tau_lsc
+                    zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i) &
+                         *fallvs(zrhol(i)) * zfice(i)
+                 endif
+
+                 ! si l'heterogeneite verticale est active, on utilise 
+                 ! la fraction volumique "vraie" plutot que la fraction
+                 ! surfacique modifiee, qui est plus grande et reduit
+                 ! sinon l'eau in-cloud de facon artificielle
+                 if ((iflag_cloudth_vert>=3).AND.(iflag_rain_incloud_vol==1)) then
+                    zchau    = zct   *dtime/REAL(ninter) * zoliq(i) &
+                         *(1.0-EXP(-(zoliq(i)/ctot_vol(i,k)/zcl   )**2)) *(1.-zfice(i))
+                 else
+                    zchau    = zct   *dtime/REAL(ninter) * zoliq(i) &
+                         *(1.0-EXP(-(zoliq(i)/zneb(i)/zcl   )**2)) *(1.-zfice(i))
+                 endif
+!AJ<
+                 IF (.NOT. ice_thermo) THEN
+                   ztot    = zchau + zfroi
+                 ELSE
+                   zpluie = MIN(MAX(zchau,0.0),zoliq(i)*(1.-zfice(i)))
+                   zice = MIN(MAX(zfroi,0.0),zoliq(i)*zfice(i)) 
+                   ztot    = zpluie    + zice
+                 ENDIF
+!>AJ
+                 ztot    = MAX(ztot   ,0.0)
+              ENDIF
+              ztot    = MIN(ztot,zoliq(i))
+!AJ<
+     !         zoliqp = MAX(zoliq(i)*(1.-zfice(i))-1.*zpluie   , 0.0)
+     !         zoliqi = MAX(zoliq(i)*zfice(i)-1.*zice   , 0.0)
+!JLD : les 2 variables zoliqp et zoliqi crorresponent a des pseudo precip
+!      temporaires et ne doivent pas etre calcule (alors qu'elles le sont
+!      si iflag_bergeron <> 2
+!      A SUPPRIMER A TERME
+              zoliqp(i) = MAX(zoliq(i)*(1.-zfice(i))-1.*zpluie  , 0.0)
+              zoliqi(i) = MAX(zoliq(i)*zfice(i)-1.*zice  , 0.0)
+              zoliq(i) = MAX(zoliq(i)-ztot   , 0.0)
+!>AJ
+              radliq(i,k) = radliq(i,k) + zoliq(i)/REAL(ninter+1)
+           ENDIF
+        ENDDO  ! i = 1,klon
+     ENDDO     ! n = 1,ninter
+
+     ! ----------------------------------------------------------------
+     !
+     IF (.NOT. ice_thermo) THEN
+       DO i = 1, klon
+         IF (rneb(i,k).GT.0.0) THEN
+           d_ql(i,k) = zoliq(i)
+           zrfl(i) = zrfl(i)+ MAX(zcond(i)-zoliq(i),0.0) &
+                * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
+         ENDIF
+       ENDDO
+     ELSE
+!
+!CR&JYG<
+! On prend en compte l'effet Bergeron dans les flux de precipitation :
+! Si T < 0 C, alors les precipitations liquides sont converties en glace, ce qui
+! provoque un accroissement de temperature DeltaT. L'effet de DeltaT sur le condensat
+! et les precipitations est grossierement pris en compte en linearisant les equations 
+! et en approximant le processus de precipitation liquide par un processus a seuil.
+! On fait l'hypothese que le condensat nuageux n'est pas modifié dans cette opération.
+! Le condensat precipitant liquide est supprime (dans la limite DeltaT<273-T).
+! Le condensat precipitant solide est augmente.
+! La vapeur d'eau est augmentee.
+!
+       IF ((iflag_bergeron .EQ. 2)) THEN
+         DO i = 1, klon
+           IF (rneb(i,k) .GT. 0.0) THEN
+             zqpreci(i)=(zcond(i)-zoliq(i))*zfice(i)
+             zqprecl(i)=(zcond(i)-zoliq(i))*(1.-zfice(i))
+           if (fl_cor_ebil .GT. 0) then
+             zcp=RCPD*(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
+             coef1 = rneb(i,k)*RLSTT/zcp*zdqsdT_raw(i)
+!            Calcul de DT si toute les precips liquides congelent
+             DeltaT = RLMLT*zqprecl(i) / (zcp*(1.+coef1))
+!            On ne veut pas que T devienne superieur a la temp. de congelation.
+!            donc que Delta > RTT-zt(i
+             DeltaT = max( min( RTT-zt(i), DeltaT) , 0. )
+             zt(i)      = zt(i)      + DeltaT
+!            Eau vaporisee du fait de l'augmentation de T
+             Deltaq = rneb(i,k)*zdqsdT_raw(i)*DeltaT
+!            on reajoute cette eau vaporise a la vapeur et on l'enleve des precips
+             zq(i) = zq(i) +  Deltaq
+!            Les 3 max si dessous prtotegent uniquement des erreurs d'arrondies
+             zcond(i)   = max( zcond(i)- Deltaq, 0. )
+!            precip liquide qui congele ou qui s'evapore
+             Deltaqprecl = -zcp/RLMLT*(1.+coef1)*DeltaT
+             zqprecl(i) = max( zqprecl(i) + Deltaqprecl, 0. )
+!            bilan eau glacee
+             zqpreci(i) = max (zqpreci(i) - Deltaqprecl - Deltaq, 0.)
+           else ! if (fl_cor_ebil .GT. 0)
+!            ancien calcul
+             zcp=RCPD*(1.0+RVTMP2*(zq(i)+zcond(i)))
+             coef1 = RLMLT*zdqs(i)/RLVTT
+             DeltaT = max( min( RTT-zt(i), RLMLT*zqprecl(i)/zcp/(1.+coef1) ) , 0.)
+             zqpreci(i) = zqpreci(i) + zcp/RLMLT*DeltaT
+             zqprecl(i) = max( zqprecl(i) - zcp/RLMLT*(1.+coef1)*DeltaT, 0. )
+             zcond(i)   = max( zcond(i)   - zcp/RLVTT*zdqs(i)*DeltaT, 0. )
+             zq(i)      = zq(i)      + zcp/RLVTT*zdqs(i)*DeltaT
+             zt(i)      = zt(i)      + DeltaT
+           end if ! if (fl_cor_ebil .GT. 0)
+           ENDIF  ! rneb(i,k) .GT. 0.0
+         ENDDO
+         DO i = 1, klon
+           IF (rneb(i,k).GT.0.0) THEN
+             d_ql(i,k) = (1-zfice(i))*zoliq(i)
+             d_qi(i,k) = zfice(i)*zoliq(i)
+!<LTP
+             IF (iflag_evap_prec == 4) THEN
+                zrflcld(i) = zrflcld(i)+zqprecl(i) &
+                 *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
+                ziflcld(i) = ziflcld(i)+ zqpreci(i) &
+                      *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
+                znebprecipcld(i) = rneb(i,k)
+                zrfl(i) = zrflcld(i) + zrflclr(i)
+                zifl(i) = ziflcld(i) + ziflclr(i)        
+!>LTP
+             ELSE
+                zrfl(i) = zrfl(i)+ zqprecl(i) &
+                 *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
+                zifl(i) = zifl(i)+ zqpreci(i) &
+                      *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)  
+             
+             ENDIF !iflag_evap_prec==4
+
+           ENDIF                      
+         ENDDO
+!!
+       ELSE  ! iflag_bergeron
+!>CR&JYG
+!!
+       DO i = 1, klon
+         IF (rneb(i,k).GT.0.0) THEN
+!CR on prend en compte la phase glace
+!JLD inutile car on ne passe jamais ici si .not.ice_thermo
+!           if (.not.ice_thermo) then
+!           d_ql(i,k) = zoliq(i)
+!           d_qi(i,k) = 0.
+!           else
+           d_ql(i,k) = (1-zfice(i))*zoliq(i)
+           d_qi(i,k) = zfice(i)*zoliq(i)
+!           endif
+!<LTP
+             IF (iflag_evap_prec == 4) THEN
+                zrflcld(i) = zrflcld(i)+ MAX(zcond(i)*(1.-zfice(i))-zoliqp(i),0.0) &
+                       *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
+                ziflcld(i) = ziflcld(i)+ MAX(zcond(i)*zfice(i)-zoliqi(i),0.0) &
+                        *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)  
+                znebprecipcld(i) = rneb(i,k)
+                zrfl(i) = zrflcld(i) + zrflclr(i)
+                zifl(i) = ziflcld(i) + ziflclr(i)        
+!>LTP
+             ELSE
+!AJ<
+                   zrfl(i) = zrfl(i)+ MAX(zcond(i)*(1.-zfice(i))-zoliqp(i),0.0) &
+                       *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
+                        zifl(i) = zifl(i)+ MAX(zcond(i)*zfice(i)-zoliqi(i),0.0) &
+                        *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)  
+     !      zrfl(i) = zrfl(i)+  zpluie                         &
+     !          *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
+     !      zifl(i) = zifl(i)+  zice                    &
+     !               *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)                                    
+             ENDIF !iflag_evap_prec == 4             
+
+!CR : on prend en compte l'effet Bergeron dans les flux de precipitation
+           IF ((iflag_bergeron .EQ. 1) .AND. (zt(i) .LT. 273.15)) THEN
+!<LTP
+                IF (iflag_evap_prec == 4) THEN
+                     zsolid = zrfl(i)
+                     ziflclr(i) = ziflclr(i) +zrflclr(i)
+                     ziflcld(i) = ziflcld(i) +zrflcld(i)
+                     zifl(i) = ziflclr(i)+ziflcld(i)
+                     zrflcld(i)=0.
+                     zrflclr(i)=0.   
+                     zrfl(i) = zrflclr(i)+zrflcld(i)
+!>LTP
+                ELSE
+                     zsolid = zrfl(i)
+                     zifl(i) = zifl(i)+zrfl(i)
+                     zrfl(i) = 0.
+                 ENDIF!iflag_evap_prec==4
+
+           if (fl_cor_ebil .GT. 0) then
+              zt(i)=zt(i)+zsolid*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
+                      *(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
+           else
+              zt(i)=zt(i)+zsolid*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
+                      *(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*zq(i))
+           end if
+           ENDIF  ! (iflag_bergeron .EQ. 1) .AND. (zt(i) .LT. 273.15)
+!RC   
+
+         ENDIF ! rneb(i,k).GT.0.0
+       ENDDO
+
+       ENDIF  ! iflag_bergeron .EQ. 2
+     ENDIF  ! .NOT. ice_thermo
+
+!CR: la fonte est faite au debut
+!      IF (ice_thermo) THEN
+!       DO i = 1, klon
+!           zmelt = ((zt(i)-273.15)/(ztfondue-273.15))**2
+!           zmelt = MIN(MAX(zmelt,0.),1.)
+!           zrfl(i)=zrfl(i)+zmelt*zifl(i)
+!           zifl(i)=zifl(i)*(1.-zmelt)
+!           print*,zt(i),'octavio1'
+!           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
+!                      *RLMLT/RCPD/(1.0+RVTMP2*zq(i))
+!           print*,zt(i),zrfl(i),zifl(i),zmelt,'octavio2'
+!       ENDDO
+!     ENDIF
+
+
+!<LTP
+
+!Limitation de la fraction surfacique couverte par les précipitations lorsque l'intensité locale du flux de précipitation descend en
+!dessous de rain_int_min
+    IF (iflag_evap_prec==4) THEN
+        DO i=1, klon
+            IF (zrflclr(i) + ziflclr(i) .GT. 0 ) THEN
+               znebprecipclr(i) = min(znebprecipclr(i), max(zrflclr(i) &
+                    /(znebprecipclr(i)*rain_int_min), &
+                    ziflclr(i)/(znebprecipclr(i)*rain_int_min)))
+            ELSE
+                znebprecipclr(i)=0.
+            ENDIF
+
+            IF (zrflcld(i) + ziflcld(i) .GT. 0 ) THEN
+               znebprecipcld(i) = min(znebprecipcld(i), &
+                    max(zrflcld(i)/(znebprecipcld(i)*rain_int_min), &
+                    ziflcld(i)/(znebprecipcld(i)*rain_int_min)))
+            ELSE
+                znebprecipcld(i)=0.
+            ENDIF
+       ENDDO
+    ENDIf
+
+!>LTP
+
+
+
+
+       
+     IF (.NOT. ice_thermo) THEN
+       DO i = 1, klon
+         IF (zt(i).LT.RTT) THEN
+           psfl(i,k)=zrfl(i)
+         ELSE
+           prfl(i,k)=zrfl(i)
+         ENDIF
+       ENDDO
+     ELSE
+     ! JAM*************************************************
+     ! Revoir partie ci-dessous: a quoi servent psfl et prfl?
+     ! *****************************************************
+
+       DO i = 1, klon
+     !   IF (zt(i).LT.RTT) THEN
+           psfl(i,k)=zifl(i) 
+     !   ELSE
+           prfl(i,k)=zrfl(i)
+     !   ENDIF
+!>AJ
+       ENDDO
+     ENDIF
+     ! ----------------------------------------------------------------
+     ! Fin de formation des precipitations
+     ! ----------------------------------------------------------------
+     !
+     ! Calculer les tendances de q et de t:
+     !
+     DO i = 1, klon
+        d_q(i,k) = zq(i) - q(i,k)
+        d_t(i,k) = zt(i) - t(i,k)
+     ENDDO
+     !
+     !AA--------------- Calcul du lessivage stratiforme  -------------
+
+     DO i = 1,klon
+        !
+        if(zcond(i).gt.zoliq(i)+1.e-10) then
+         beta(i,k) = (zcond(i)-zoliq(i))/zcond(i)/dtime
+        else
+         beta(i,k) = 0.
+        endif
+        zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0) &
+             * (paprs(i,k)-paprs(i,k+1))/RG
+        IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
+           !AA lessivage nucleation LMD5 dans la couche elle-meme
+          IF (iflag_t_glace.EQ.0) THEN
+           if (t(i,k) .GE. t_glace_min_old) THEN
+              zalpha_tr = a_tr_sca(3)
+           else
+              zalpha_tr = a_tr_sca(4)
+           endif
+          ELSE ! of IF (iflag_t_glace.EQ.0)
+           if (t(i,k) .GE. t_glace_min) THEN
+              zalpha_tr = a_tr_sca(3)
+           else
+              zalpha_tr = a_tr_sca(4)
+           endif
+          ENDIF
+           zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
+           pfrac_nucl(i,k)=pfrac_nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
+           frac_nucl(i,k)= 1.-zneb(i)*zfrac_lessi 
+           !
+           ! nucleation avec un facteur -1 au lieu de -0.5
+           zfrac_lessi = 1. - EXP(-zprec_cond(i)/zneb(i))
+           pfrac_1nucl(i,k)=pfrac_1nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
+        ENDIF
+        !
+     ENDDO      ! boucle sur i
+     !
+     !AA Lessivage par impaction dans les couches en-dessous
+     DO kk = k-1, 1, -1
+        DO i = 1, klon
+           IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
+             IF (iflag_t_glace.EQ.0) THEN
+              if (t(i,kk) .GE. t_glace_min_old) THEN
+                 zalpha_tr = a_tr_sca(1)
+              else
+                 zalpha_tr = a_tr_sca(2)
+              endif
+             ELSE ! of IF (iflag_t_glace.EQ.0)
+              if (t(i,kk) .GE. t_glace_min) THEN
+                 zalpha_tr = a_tr_sca(1)
+              else
+                 zalpha_tr = a_tr_sca(2)
+              endif
+             ENDIF
+              zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
+              pfrac_impa(i,kk)=pfrac_impa(i,kk)*(1.-zneb(i)*zfrac_lessi)
+              frac_impa(i,kk)= 1.-zneb(i)*zfrac_lessi
+           ENDIF
+        ENDDO
+     ENDDO
+     !
+     !AA===============================================================
+     !                     FIN DE LA BOUCLE VERTICALE  
+  end DO
+  !
+  !AA==================================================================
+  !
+  ! Pluie ou neige au sol selon la temperature de la 1ere couche
+  !
+!CR: si la thermo de la glace est active, on calcule zifl directement
+  IF (.NOT.ice_thermo) THEN
+  DO i = 1, klon
+     IF ((t(i,1)+d_t(i,1)) .LT. RTT) THEN
+!AJ<
+!        snow(i) = zrfl(i)
+        snow(i) = zrfl(i)+zifl(i)
+!>AJ
+        zlh_solid(i) = RLSTT-RLVTT
+     ELSE
+        rain(i) = zrfl(i)
+        zlh_solid(i) = 0.
+     ENDIF
+  ENDDO
+
+  ELSE
+     DO i = 1, klon
+        snow(i) = zifl(i)
+        rain(i) = zrfl(i)
+     ENDDO
+   
+   ENDIF
+  !
+  ! For energy conservation : when snow is present, the solification
+  ! latent heat is considered.
+!CR: si thermo de la glace, neige deja prise en compte
+  IF (.not.ice_thermo) THEN
+  DO k = 1, klev
+     DO i = 1, klon
+        zcpair=RCPD*(1.0+RVTMP2*(q(i,k)+d_q(i,k)))
+        zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
+        zm_solid = (prfl(i,k)-prfl(i,k+1)+psfl(i,k)-psfl(i,k+1))*dtime
+        d_t(i,k) = d_t(i,k) + zlh_solid(i) *zm_solid / (zcpair*zmair(i))
+     END DO
+  END DO
+  ENDIF
+  !
+
+  if (ncoreczq>0) then
+     WRITE(lunout,*)'WARNING : ZQ dans fisrtilp ',ncoreczq,' val < 1.e-15.'
+  endif
+
+RETURN
+END SUBROUTINE fisrtilp
+END MODULE lmdz_lscp_old
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_lscp_tools.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_lscp_tools.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_lscp_tools.F90	(revision 4727)
@@ -0,0 +1,456 @@
+MODULE lmdz_lscp_tools
+
+    IMPLICIT NONE
+
+CONTAINS
+
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+SUBROUTINE FALLICE_VELOCITY(klon,iwc,temp,rho,pres,ptconv,velo)
+
+    ! Ref:
+    ! Stubenrauch, C. J., Bonazzola, M.,
+    ! Protopapadaki, S. E., & Musat, I. (2019).
+    ! New cloud system metrics to assess bulk
+    ! ice cloud schemes in a GCM. Journal of
+    ! Advances in Modeling Earth Systems, 11,
+    ! 3212–3234. https://doi.org/10.1029/2019MS001642
+    
+    use lmdz_lscp_ini, only: iflag_vice, ffallv_con, ffallv_lsc
+    use lmdz_lscp_ini, only: cice_velo, dice_velo 
+
+    IMPLICIT NONE
+
+    INTEGER, INTENT(IN) :: klon
+    REAL, INTENT(IN), DIMENSION(klon) :: iwc       ! specific ice water content [kg/m3]
+    REAL, INTENT(IN), DIMENSION(klon) :: temp      ! temperature [K]
+    REAL, INTENT(IN), DIMENSION(klon) :: rho       ! dry air density [kg/m3]
+    REAL, INTENT(IN), DIMENSION(klon) :: pres      ! air pressure [Pa]
+    LOGICAL, INTENT(IN), DIMENSION(klon) :: ptconv    ! convective point  [-]
+
+    REAL, INTENT(OUT), DIMENSION(klon) :: velo    ! fallspeed velocity of crystals [m/s]
+
+
+    INTEGER i
+    REAL logvm,iwcg,tempc,phpa,fallv_tun
+    REAL m2ice, m2snow, vmice, vmsnow
+    REAL aice, bice, asnow, bsnow
+    
+
+    DO i=1,klon
+
+        IF (ptconv(i)) THEN
+            fallv_tun=ffallv_con
+        ELSE
+            fallv_tun=ffallv_lsc
+        ENDIF
+
+        tempc=temp(i)-273.15 ! celcius temp
+        iwcg=MAX(iwc(i)*1000.,1E-3) ! iwc in g/m3. We set a minimum value to prevent from division by 0
+        phpa=pres(i)/100.    ! pressure in hPa
+
+    IF (iflag_vice .EQ. 1) THEN
+        ! so-called 'empirical parameterization' in Stubenrauch et al. 2019
+        if (tempc .GE. -60.0) then
+
+            logvm= -0.0000414122*tempc*tempc*log(iwcg)-0.00538922*tempc*log(iwcg) &
+                    -0.0516344*log(iwcg)+0.00216078*tempc + 1.9714    
+            velo(i)=exp(logvm)
+        else
+            velo(i)=65.0*(iwcg**0.2)*(150./phpa)**0.15
+        endif
+        
+        velo(i)=fallv_tun*velo(i)/100.0 ! from cm/s to m/s
+
+    ELSE IF (iflag_vice .EQ. 2) THEN
+        ! so called  PSDM empirical coherent bulk ice scheme in Stubenrauch et al. 2019
+        aice=0.587
+        bice=2.45
+        asnow=0.0444
+        bsnow=2.1
+        
+        m2ice=((iwcg*0.001/aice)/(exp(13.6-bice*7.76+0.479*bice**2)* & 
+                exp((-0.0361+bice*0.0151+0.00149*bice**2)*tempc)))   &
+                **(1./(0.807+bice*0.00581+0.0457*bice**2))
+
+        vmice=100.*1042.4*exp(13.6-(bice+1)*7.76+0.479*(bice+1.)**2)*exp((-0.0361+ &
+                 (bice+1.)*0.0151+0.00149*(bice+1.)**2)*tempc) &
+                 *(m2ice**(0.807+(bice+1.)*0.00581+0.0457*(bice+1.)**2))/(iwcg*0.001/aice)
+
+       
+        vmice=vmice*((1000./phpa)**0.2)
+      
+        m2snow=((iwcg*0.001/asnow)/(exp(13.6-bsnow*7.76+0.479*bsnow**2)* &
+               exp((-0.0361+bsnow*0.0151+0.00149*bsnow**2)*tempc)))         &
+               **(1./(0.807+bsnow*0.00581+0.0457*bsnow**2))
+
+
+        vmsnow=100.*14.3*exp(13.6-(bsnow+.416)*7.76+0.479*(bsnow+.416)**2)&
+                  *exp((-0.0361+(bsnow+.416)*0.0151+0.00149*(bsnow+.416)**2)*tempc)&
+                  *(m2snow**(0.807+(bsnow+.416)*0.00581+0.0457*(bsnow+.416)**2))/(iwcg*0.001/asnow)
+
+        vmsnow=vmsnow*((1000./phpa)**0.35)
+        velo(i)=fallv_tun*min(vmsnow,vmice)/100. ! to m/s
+
+    ELSE
+        ! By default, fallspeed velocity of ice crystals according to Heymsfield & Donner 1990
+        velo(i) = fallv_tun*cice_velo*((iwcg/1000.)**dice_velo)
+    ENDIF
+    ENDDO
+
+END SUBROUTINE FALLICE_VELOCITY
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+SUBROUTINE ICEFRAC_LSCP(klon, temp, iflag_ice_thermo, distcltop, temp_cltop, icefrac, dicefracdT)
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  
+  ! Compute the ice fraction 1-xliq (see e.g.
+  ! Doutriaux-Boucher & Quaas 2004, section 2.2.)
+  ! as a function of temperature
+  ! see also Fig 3 of Madeleine et al. 2020, JAMES
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+    USE print_control_mod, ONLY: lunout, prt_level
+    USE lmdz_lscp_ini, ONLY: t_glace_min, t_glace_max, exposant_glace, iflag_t_glace
+    USE lmdz_lscp_ini, ONLY : RTT, dist_liq, temp_nowater
+
+    IMPLICIT NONE
+
+
+    INTEGER, INTENT(IN)                 :: klon              ! number of horizontal grid points
+    REAL, INTENT(IN), DIMENSION(klon)   :: temp              ! temperature
+    REAL, INTENT(IN), DIMENSION(klon)   :: distcltop         ! distance to cloud top
+    REAL, INTENT(IN), DIMENSION(klon)   :: temp_cltop        ! temperature of cloud top
+    INTEGER, INTENT(IN)                 :: iflag_ice_thermo
+    REAL, INTENT(OUT), DIMENSION(klon)  :: icefrac
+    REAL, INTENT(OUT), DIMENSION(klon)  :: dicefracdT
+
+
+    INTEGER i
+    REAL    liqfrac_tmp, dicefrac_tmp
+    REAL    Dv, denomdep,beta,qsi,dqsidt
+    LOGICAL ice_thermo
+
+    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
+
+    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
+ 
+        ! 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
+                 dicefracdT(i)= exposant_glace * (icefrac(i)**(exposant_glace-1.)) &
+                           / (t_glace_min - t_glace_max)
+            ENDIF
+
+            IF ((icefrac(i).EQ.0).OR.(icefrac(i).EQ.1)) THEN
+                 dicefracdT(i)=0.
+            ENDIF
+
+        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
+
+        ! if temperature of cloud top <-40°C, 
+        IF (iflag_t_glace .GE. 4) THEN
+                IF ((temp_cltop(i) .LE. temp_nowater) .AND. (temp(i) .LE. t_glace_max)) THEN 
+                        icefrac(i) = 1.
+                        dicefracdT(i) = 0.
+                ENDIF 
+        ENDIF
+
+
+     ENDDO ! klon
+ 
+     RETURN
+ 
+END SUBROUTINE ICEFRAC_LSCP
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+
+SUBROUTINE CALC_QSAT_ECMWF(klon,temp,qtot,pressure,tref,phase,flagth,qs,dqs)
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    ! Calculate qsat following ECMWF method
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+    IMPLICIT NONE
+
+    include "YOMCST.h"
+    include "YOETHF.h"
+    include "FCTTRE.h"
+
+    INTEGER, INTENT(IN) :: klon  ! number of horizontal grid points
+    REAL, INTENT(IN), DIMENSION(klon) :: temp     ! temperature in K
+    REAL, INTENT(IN), DIMENSION(klon) :: qtot     ! total specific water in kg/kg
+    REAL, INTENT(IN), DIMENSION(klon) :: pressure ! pressure in Pa
+    REAL, INTENT(IN)                  :: tref     ! reference temperature in K
+    LOGICAL, INTENT(IN) :: flagth     ! flag for qsat calculation for thermals
+    INTEGER, INTENT(IN) :: phase 
+    ! phase: 0=depend on temperature sign (temp>tref -> liquid, temp<tref, solid)
+    !        1=liquid
+    !        2=solid
+
+    REAL, INTENT(OUT), DIMENSION(klon) :: qs      ! saturation specific humidity [kg/kg]
+    REAL, INTENT(OUT), DIMENSION(klon) :: dqs     ! derivation of saturation specific humidity wrt T
+
+    REAL delta, cor, cvm5
+    INTEGER i
+
+    DO i=1,klon
+
+    IF (phase .EQ. 1) THEN
+        delta=0.
+    ELSEIF (phase .EQ. 2) THEN
+        delta=1.
+    ELSE
+        delta=MAX(0.,SIGN(1.,tref-temp(i)))
+    ENDIF
+
+    IF (flagth) THEN
+    cvm5=R5LES*(1.-delta) + R5IES*delta
+    ELSE
+    cvm5 = R5LES*RLVTT*(1.-delta) + R5IES*RLSTT*delta
+    cvm5 = cvm5 /RCPD/(1.0+RVTMP2*(qtot(i)))
+    ENDIF
+
+    qs(i)= R2ES*FOEEW(temp(i),delta)/pressure(i)
+    qs(i)=MIN(0.5,qs(i))
+    cor=1./(1.-RETV*qs(i))
+    qs(i)=qs(i)*cor
+    dqs(i)= FOEDE(temp(i),delta,cvm5,qs(i),cor)
+
+    END DO
+
+END SUBROUTINE CALC_QSAT_ECMWF
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+SUBROUTINE CALC_GAMMASAT(klon,temp,qtot,pressure,gammasat,dgammasatdt)
+
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+    ! programme that calculates the gammasat parameter that determines the
+    ! homogeneous condensation thresholds for cold (<0oC) clouds
+    ! condensation at q>gammasat*qsat
+    ! Etienne Vignon, March 2021
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+    use lmdz_lscp_ini, only: iflag_gammasat, t_glace_min, RTT
+
+    IMPLICIT NONE
+
+
+    INTEGER, INTENT(IN) :: klon                       ! number of horizontal grid points
+    REAL, INTENT(IN), DIMENSION(klon) :: temp         ! temperature in K
+    REAL, INTENT(IN), DIMENSION(klon) :: qtot         ! total specific water in kg/kg
+
+    REAL, INTENT(IN), DIMENSION(klon) :: pressure     ! pressure in Pa
+
+    REAL, INTENT(OUT), DIMENSION(klon) :: gammasat    ! coefficient to multiply qsat with to calculate saturation
+    REAL, INTENT(OUT), DIMENSION(klon) :: dgammasatdt ! derivative of gammasat wrt temperature
+
+    REAL, DIMENSION(klon) ::  qsi,qsl,dqsl,dqsi
+    REAL  fcirrus, fac
+    REAL, PARAMETER :: acirrus=2.349
+    REAL, PARAMETER :: bcirrus=259.0
+
+    INTEGER i
+    
+        CALL CALC_QSAT_ECMWF(klon,temp,qtot,pressure,RTT,1,.false.,qsl,dqsl)
+        CALL CALC_QSAT_ECMWF(klon,temp,qtot,pressure,RTT,2,.false.,qsi,dqsi)
+
+    DO i=1,klon
+
+        IF (temp(i) .GE. RTT) THEN
+            ! warm clouds: condensation at saturation wrt liquid
+            gammasat(i)=1.
+            dgammasatdt(i)=0.
+
+        ELSEIF ((temp(i) .LT. RTT) .AND. (temp(i) .GT. t_glace_min)) THEN
+            
+            IF (iflag_gammasat .GE. 2) THEN          
+               gammasat(i)=qsl(i)/qsi(i)
+               dgammasatdt(i)=(dqsl(i)*qsi(i)-dqsi(i)*qsl(i))/qsi(i)/qsi(i)
+            ELSE
+               gammasat(i)=1.
+               dgammasatdt(i)=0.
+            ENDIF
+
+        ELSE
+
+            IF (iflag_gammasat .GE.1) THEN
+            ! homogeneous freezing of aerosols, according to
+            ! Koop, 2000 and Karcher 2008, QJRMS
+            ! 'Cirrus regime'
+               fcirrus=acirrus-temp(i)/bcirrus
+               IF (fcirrus .LT. qsl(i)/qsi(i)) THEN
+                  gammasat(i)=qsl(i)/qsi(i)
+                  dgammasatdt(i)=(dqsl(i)*qsi(i)-dqsi(i)*qsl(i))/qsi(i)/qsi(i)
+               ELSE
+                  gammasat(i)=fcirrus
+                  dgammasatdt(i)=-1.0/bcirrus
+               ENDIF
+           
+            ELSE
+
+               gammasat(i)=1.
+               dgammasatdt(i)=0.
+
+            ENDIF
+
+        ENDIF
+   
+    END DO
+
+
+END SUBROUTINE CALC_GAMMASAT
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+SUBROUTINE DISTANCE_TO_CLOUD_TOP(klon,klev,k,temp,pplay,paprs,rneb,distcltop1D,temp_cltop)
+!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+   
+   USE lmdz_lscp_ini, 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, INTENT(OUT), DIMENSION(klon) :: temp_cltop     ! temperature of 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
+   
+   DO i=1,klon
+          k_top = k
+          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
+          temp_cltop(i)  = temp(i,k_top)
+   ENDDO ! klon
+
+END SUBROUTINE DISTANCE_TO_CLOUD_TOP
+!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+END MODULE lmdz_lscp_tools
+
+
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_ratqs_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_ratqs_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_ratqs_ini.F90	(revision 4727)
@@ -0,0 +1,80 @@
+MODULE lmdz_ratqs_ini
+
+IMPLICIT NONE
+
+save
+
+integer :: lunout
+
+INTEGER, SAVE, PROTECTED :: nbsrf,is_lic,is_ter
+REAL, SAVE, PROTECTED :: RG,RV,RD,RCPD,RLSTT,RLVTT,RTT
+REAL, SAVE, PROTECTED :: a_ratqs_cv
+REAL, SAVE, PROTECTED :: tau_var
+REAL, SAVE, PROTECTED :: fac_tau
+REAL, SAVE, PROTECTED :: tau_cumul
+REAL, SAVE, PROTECTED :: a_ratqs_wake
+INTEGER, SAVE, PROTECTED :: dqimpl
+
+real, allocatable, SAVE :: povariance(:,:)
+!$OMP THREADPRIVATE(povariance)
+real, allocatable, SAVE :: var_conv(:,:)
+!$OMP THREADPRIVATE(var_conv)
+
+!$OMP THREADPRIVATE(a_ratqs_cv,tau_var,fac_tau,tau_cumul,a_ratqs_wake)
+
+
+CONTAINS
+SUBROUTINE ratqs_ini(klon,klev,iflag_thermals,lunout_in,nbsrf_in,is_lic_in,is_ter_in,RG_in,RV_in,RD_in,RCPD_in,RLSTT_in,RLVTT_in,RTT_in)
+
+   USE ioipsl_getin_p_mod, ONLY : getin_p
+
+integer, intent(in) :: klon,klev,iflag_thermals,lunout_in
+integer, intent(in) :: nbsrf_in,is_lic_in,is_ter_in
+real, intent(in) :: RG_in,RV_in,RD_in,RCPD_in,RLSTT_in,RLVTT_in,RTT_in
+
+integer :: i,k
+
+nbsrf   =nbsrf_in
+is_lic  =is_lic_in
+is_ter  =is_ter_in
+RG      =RG_in    
+RV      =RV_in
+RD      =RD_in
+RCPD    =RCPD_in
+RLSTT   =RLSTT_in
+RLVTT   =RLVTT_in
+RTT     =RTT_in
+
+print*,'ratqs_ini'
+if (iflag_thermals==15.or.iflag_thermals==16) then
+   dqimpl=-1
+else
+   dqimpl=1
+endif
+lunout=lunout_in
+
+allocate(povariance(klon,klev))
+allocate(var_conv(klon,klev))
+
+
+tau_var = 700. ! temps de relaxation de la variabilité pour les thermiques
+fac_tau = 2. 
+tau_cumul = 1000 
+a_ratqs_wake = 3.    ! paramètre pilotant l'importance du terme dépendant des poches froides
+a_ratqs_cv = 1.
+CALL getin_p('tau_var', tau_var)
+CALL getin_p('fac_tau', fac_tau)
+CALL getin_p('tau_cumul', tau_cumul)
+CALL getin_p('a_ratqs_wake', a_ratqs_wake) 
+CALL getin_p('a_ratqs_cv', a_ratqs_cv)         
+do k=1,klev
+  do i=1,klon
+   povariance(i,k) = 0.00001
+   var_conv(i,k) = 0.
+  enddo
+enddo
+
+ RETURN
+
+END SUBROUTINE ratqs_ini
+END MODULE lmdz_ratqs_ini
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_ratqs_main.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_ratqs_main.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_ratqs_main.F90	(revision 4727)
@@ -0,0 +1,285 @@
+MODULE lmdz_ratqs_main
+
+CONTAINS
+
+SUBROUTINE ratqs_main(klon,klev,nbsrf,prt_level,lunout,       &
+           iflag_ratqs,iflag_con,iflag_cld_th,pdtphys, &
+           ratqsbas,ratqshaut,ratqsp0,ratqsdp, &
+           pctsrf,s_pblh,zstd, &
+           tau_ratqs,fact_cldcon,wake_s, wake_deltaq,   &
+           ptconv,ptconvth,clwcon0th, rnebcon0th,       &
+           paprs,pplay,t_seri,q_seri,                   &
+           qtc_cv, sigt_cv,detrain_cv,fm_cv,fqd,fqcomp,sigd,zqsat,             &
+           omega,tke,tke_dissip,lmix,wprime, &
+           t2m,q2m,fm_therm,entr_therm,detr_therm,cell_area,&
+           ratqs,ratqsc,ratqs_inter_)
+
+
+USE lmdz_ratqs_multi,   ONLY: ratqs_inter, ratqs_oro, ratqs_hetero, ratqs_tke
+
+implicit none
+
+!========================================================================
+! Computation of ratqs, the width of the subrid scale water distribution
+! (normalized by the mean value)
+! Various options controled by flags iflag_con and iflag_ratqs
+! F Hourdin 2012/12/06
+!========================================================================
+
+! Declarations
+
+! Input
+integer,intent(in) :: klon,klev,nbsrf,prt_level,lunout
+integer,intent(in) :: iflag_con,iflag_cld_th,iflag_ratqs
+real,intent(in) :: pdtphys,ratqsbas,ratqshaut,fact_cldcon,tau_ratqs
+real,intent(in) :: ratqsp0, ratqsdp
+real, dimension(klon,klev),intent(in) :: omega
+real, dimension(klon,klev+1),intent(in) :: paprs,tke,tke_dissip,lmix,wprime
+real, dimension(klon,klev),intent(in) :: pplay,t_seri,q_seri,zqsat
+real, dimension(klon,klev),intent(in) :: entr_therm,detr_therm,qtc_cv, sigt_cv
+real, dimension(klon,klev) :: detrain_cv,fm_cv,fqd,fqcomp
+real, dimension(klon) :: sigd
+
+real, dimension(klon,klev+1),intent(in) :: fm_therm
+logical, dimension(klon,klev),intent(in) :: ptconv
+real, dimension(klon,klev),intent(in) :: rnebcon0th,clwcon0th
+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
+real, dimension(klon,nbsrf),intent(in) :: pctsrf
+real, dimension(klon),intent(in) :: s_pblh
+real, dimension(klon),intent(in) :: zstd
+
+! Output
+real, dimension(klon,klev),intent(inout) :: ratqs,ratqsc,ratqs_inter_
+
+logical, dimension(klon,klev),intent(inout) :: ptconvth
+
+! local
+integer i,k
+real, dimension(klon,klev) :: ratqss
+real facteur,zfratqs1,zfratqs2
+real, dimension(klon,klev) :: ratqs_hetero_,ratqs_oro_,ratqs_tke_
+real resol,resolmax,fact
+
+!-------------------------------------------------------------------------
+!  Caclul des ratqs
+!-------------------------------------------------------------------------
+
+!      print*,'calcul des ratqs'
+!   ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q
+!   ----------------
+!   on ecrase le tableau ratqsc calcule par clouds_gno
+      if (iflag_cld_th.eq.1) then
+         do k=1,klev
+         do i=1,klon
+            if(ptconv(i,k)) then
+              ratqsc(i,k)=ratqsbas &
+              +fact_cldcon*(q_seri(i,1)-q_seri(i,k))/q_seri(i,k)
+            else
+               ratqsc(i,k)=0.
+            endif
+         enddo
+         enddo
+
+!-----------------------------------------------------------------------
+!  par nversion de la fonction log normale
+!-----------------------------------------------------------------------
+      else if (iflag_cld_th.eq.4) then
+         ptconvth(:,:)=.false.
+         ratqsc(:,:)=0.
+         if(prt_level.ge.9) print*,'avant clouds_gno thermique'
+         call clouds_gno &
+         (klon,klev,q_seri,zqsat,clwcon0th,ptconvth,ratqsc,rnebcon0th)
+         if(prt_level.ge.9) print*,' CLOUDS_GNO OK'
+       
+       endif
+
+!   ratqs stables
+!   -------------
+
+      if (iflag_ratqs.eq.0) then
+
+! Le cas iflag_ratqs=0 correspond a la version IPCC 2005 du modele.
+         do k=1,klev
+            do i=1, klon
+               ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)* &
+               min((paprs(i,1)-pplay(i,k))/(paprs(i,1)-30000.),1.) 
+            enddo 
+         enddo
+
+! Pour iflag_ratqs=1 ou 2, le ratqs est constant au dessus de 
+! 300 hPa (ratqshaut), varie lineariement en fonction de la pression
+! entre 600 et 300 hPa et est soit constant (ratqsbas) pour iflag_ratqs=1
+! soit lineaire (entre 0 a la surface et ratqsbas) pour iflag_ratqs=2
+! Il s'agit de differents tests dans la phase de reglage du modele
+! avec thermiques.
+
+      else if (iflag_ratqs.eq.1) then
+
+         do k=1,klev
+            do i=1, klon
+               if (pplay(i,k).ge.60000.) then
+                  ratqss(i,k)=ratqsbas
+               else if ((pplay(i,k).ge.30000.).and.(pplay(i,k).lt.60000.)) then
+                  ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*(60000.-pplay(i,k))/(60000.-30000.)
+               else
+                  ratqss(i,k)=ratqshaut
+               endif
+            enddo
+         enddo
+
+      else if (iflag_ratqs.eq.2) then
+
+         do k=1,klev
+            do i=1, klon
+               if (pplay(i,k).ge.60000.) then
+                  ratqss(i,k)=ratqsbas*(paprs(i,1)-pplay(i,k))/(paprs(i,1)-60000.)
+               else if ((pplay(i,k).ge.30000.).and.(pplay(i,k).lt.60000.)) then
+                    ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*(60000.-pplay(i,k))/(60000.-30000.)
+               else
+                    ratqss(i,k)=ratqshaut
+               endif
+            enddo
+         enddo
+
+      else if (iflag_ratqs==3) then
+         do k=1,klev
+           ratqss(:,k)=ratqsbas+(ratqshaut-ratqsbas) &
+           *min( ((paprs(:,1)-pplay(:,k))/70000.)**2 , 1. )
+         enddo
+
+      else if (iflag_ratqs==4) then 
+         do k=1,klev
+           ratqss(:,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) &
+!          *( tanh( (50000.-pplay(:,k))/20000.) + 1.)
+           *( 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
+ 
+       ! interactive ratqs calculations that depend on cold pools, orography, surface heterogeneity and small-scale turbulence
+       ! This should help getting a more realistic ratqs in the low and mid troposphere
+       ! We however need a "background" ratqs to account for subgrid distribution of qt (or qt/qs)
+       ! in the high troposphere
+       
+       ! background ratqs and initialisations
+          do k=1,klev
+             do i=1,klon
+              ratqss(i,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) &
+              *( tanh( (ratqsp0-pplay(i,k))/ratqsdp) + 1.)
+              ratqss(i,k)=max(ratqss(i,k),0.0)
+              ratqs_hetero_(i,k)=0.
+              ratqs_oro_(i,k)=0.
+              ratqs_tke_(i,k)=0.
+              ratqs_inter_(i,k)=0
+             enddo
+          enddo
+      
+          if (iflag_ratqs .EQ. 10) then 
+             ! interactive ratqs in presence of cold pools     
+             call ratqs_inter(klon,klev,iflag_ratqs,pdtphys,paprs, &
+                       ratqsbas,wake_deltaq,wake_s,q_seri,qtc_cv, sigt_cv, &
+                       fm_therm,entr_therm,detr_therm,detrain_cv,fm_cv,fqd,fqcomp,sigd, &
+                       ratqs_inter_)
+             do k=1,klev
+                do i=1,klon
+                    ratqs_inter_(i,k)=ratqs_inter_(i,k)-0.5*ratqs_inter_(i,k)*(tanh((ratqsp0-pplay(i,k))/ratqsdp)+1.)
+                enddo
+             enddo
+             ratqss=ratqss+ratqs_inter_
+          else if (iflag_ratqs .EQ. 11) then
+            print*,'avant ratqs_inter'
+            ! interactive ratqs with several sources
+             call ratqs_inter(klon,klev,iflag_ratqs,pdtphys,paprs, &
+                       ratqsbas,wake_deltaq,wake_s,q_seri,qtc_cv, sigt_cv, &
+                       fm_therm,entr_therm,detr_therm,detrain_cv,fm_cv,fqd,fqcomp,sigd, &
+                       ratqs_inter_)
+             ratqss=ratqss+ratqs_inter_
+          else if (iflag_ratqs .EQ. 12) then
+             ! contribution of surface heterogeneities to ratqs
+             call ratqs_hetero(klon,klev,pctsrf,s_pblh,t2m,q2m,t_seri,q_seri,pplay,paprs,ratqs_hetero_)
+             ratqss=ratqss+ratqs_hetero_
+          else if (iflag_ratqs .EQ. 13) then
+             ! contribution of ubgrid orography to ratqs
+             call ratqs_oro(klon,klev,pctsrf,zstd,zqsat,t_seri,pplay,paprs,ratqs_oro_)
+             ratqss=ratqss+ratqs_oro_
+          else if (iflag_ratqs .EQ. 14) then
+             ! effect of subgrid-scale TKE on ratqs (in development)
+             call ratqs_tke(klon,klev,pdtphys,t_seri,q_seri,zqsat,pplay,paprs,omega,tke,tke_dissip,lmix,wprime,ratqs_tke_)     
+             ratqss=ratqss+ratqs_tke_
+          endif
+          
+      
+      endif
+
+
+!  ratqs final
+!  -----------
+
+      if (iflag_cld_th.eq.1 .or.iflag_cld_th.eq.2.or.iflag_cld_th.eq.4) then
+
+! On ajoute une constante au ratqsc*2 pour tenir compte de 
+! fluctuations turbulentes de petite echelle
+
+         do k=1,klev
+            do i=1,klon
+               if ((fm_therm(i,k)>1.e-10)) then
+                  ratqsc(i,k)=sqrt(ratqsc(i,k)**2+0.05**2)
+               endif
+            enddo
+         enddo
+
+!   les ratqs sont une combinaison de ratqss et ratqsc
+       if(prt_level.ge.9) write(lunout,*)'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs
+
+         if (tau_ratqs>1.e-10) then
+            facteur=exp(-pdtphys/tau_ratqs)
+         else
+            facteur=0.
+         endif
+         ratqs(:,:)=ratqsc(:,:)*(1.-facteur)+ratqs(:,:)*facteur
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! FH 22/09/2009
+! La ligne ci-dessous faisait osciller le modele et donnait une solution
+! assymptotique bidon et dépendant fortement du pas de temps.
+!        ratqs(:,:)=sqrt(ratqs(:,:)**2+ratqss(:,:)**2)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+         ratqs(:,:)=max(ratqs(:,:),ratqss(:,:))
+      else if (iflag_cld_th<=6) then
+!   on ne prend que le ratqs stable pour fisrtilp
+         ratqs(:,:)=ratqss(:,:)
+      else
+          zfratqs1=exp(-pdtphys/10800.)
+          zfratqs2=exp(-pdtphys/10800.)
+          do k=1,klev
+             do i=1,klon
+                if (ratqsc(i,k).gt.1.e-10) then
+                   ratqs(i,k)=ratqs(i,k)*zfratqs2+(iflag_cld_th/100.)*ratqsc(i,k)*(1.-zfratqs2)
+                endif
+                ratqs(i,k)=min(ratqs(i,k)*zfratqs1+ratqss(i,k)*(1.-zfratqs1),0.5)
+             enddo
+          enddo
+      endif
+
+
+return
+END SUBROUTINE ratqs_main
+
+END MODULE lmdz_ratqs_main
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_ratqs_multi.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_ratqs_multi.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_ratqs_multi.F90	(revision 4727)
@@ -0,0 +1,483 @@
+MODULE lmdz_ratqs_multi
+
+!=============================================
+! A FAIRE :
+! Traiter le probleme de USE lmdz_lscp_tools, ONLY: CALC_QSAT_ECMWF
+!=============================================
+
+!=============================================
+! module containing subroutines that take 
+! into account the effect of convection, orography,
+! surface heterogeneities and subgrid-scale
+! turbulence on ratqs, i.e. on the width of the
+! total water subgrid distribution.
+!=============================================
+
+IMPLICIT NONE
+
+! Include
+!=============================================
+    INCLUDE "YOETHF.h"
+
+
+      CONTAINS
+
+
+!========================================================================    
+SUBROUTINE ratqs_inter(klon,klev,iflag_ratqs,pdtphys,paprs, &
+           ratqsbas, wake_deltaq, wake_s, q_seri,qtc_cv, sigt_cv,     &
+           fm_therm,entr_therm,detr_therm,detrain_cv,fm_cv,fqd,fqcomp,sigd, &
+           ratqs_inter_)
+
+USE lmdz_ratqs_ini, ONLY : a_ratqs_cv,tau_var,fac_tau,tau_cumul,a_ratqs_wake, dqimpl
+USE lmdz_ratqs_ini, ONLY : RG
+USE lmdz_ratqs_ini, ONLY : povariance, var_conv
+USE lmdz_thermcell_dq,  ONLY : thermcell_dq
+
+implicit none
+
+!========================================================================
+! L. d'Alençon, 25/02/2021
+! Cette subroutine calcule une valeur de ratqsbas interactive  
+! Elle est appelée par la subroutine ratqs lorsque iflag_ratqs = 11. 
+!========================================================================
+
+! Declarations
+! Input
+integer,intent(in) :: klon,klev,iflag_ratqs
+real,intent(in) :: pdtphys,ratqsbas
+real, dimension(klon,klev+1),intent(in) :: paprs
+real, dimension(klon,klev),intent(in) :: wake_deltaq, q_seri,qtc_cv, sigt_cv
+real, dimension(klon),intent(in) :: wake_s
+real, dimension(klon,klev+1),intent(in) :: fm_therm
+real, dimension(klon,klev),intent(in) :: entr_therm,detr_therm,detrain_cv,fm_cv,fqd,fqcomp
+real, dimension(klon),intent(in) :: sigd
+
+! Output
+real, dimension(klon,klev),intent(inout) :: ratqs_inter_
+
+! local
+LOGICAL :: klein = .false.
+LOGICAL :: klein_conv = .true.
+REAL :: taup0 = 70000
+REAL :: taudp = 500
+integer :: lev_out=10
+REAL, DIMENSION (klon,klev) :: zmasse,entr0,detr0,detraincv,dqp,detrain_p,q0,qd0,tau_diss
+REAL, DIMENSION (klon,klev+1) :: fm0
+integer i,k
+real, dimension(klon,klev) :: wake_dq
+
+
+real, dimension(klon) :: max_sigd, max_dqconv,max_sigt
+real, dimension(klon,klev) :: zoa,zocarrea,pdocarreadj,pocarre,po,pdoadj,varq_therm
+
+
+lev_out=0.
+
+print*,'ratqs_inter'
+
+!-----------------------------------------------------------------------
+!   Calcul des masses
+!-----------------------------------------------------------------------
+
+      do k=1,klev
+         zmasse(:,k)=(paprs(:,k)-paprs(:,k+1))/RG
+      enddo
+!-------------------------------------------------------------------------
+!  Caclul du terme de détrainement de la variance pour les thermiques
+!-------------------------------------------------------------------------
+
+! initialisations 
+
+
+      do k=1,klev
+         do i=1,klon
+            tau_diss(i,k)=tau_var +0.5*fac_tau*tau_var*(tanh((taup0-paprs(i,k))/taudp) + 1.)
+         enddo
+      enddo
+       
+                    
+      
+      entr0(:,:) = entr_therm(:,:) 
+      fm0(:,:) = fm_therm(:,:)  
+      detr0(:,:) = detr_therm(:,:) 
+
+! calcul du carré de l'humidité spécifique
+      po(:,:) = q_seri(:,:)
+      call thermcell_dq(klon,klev,dqimpl,pdtphys,fm0,entr0,zmasse,  &
+     &                   po,pdoadj,zoa,lev_out)
+      do k=1,klev
+         do i=1,klon
+            pocarre(i,k)=po(i,k)*po(i,k) + povariance(i,k)
+         enddo
+      enddo
+      call thermcell_dq(klon,klev,dqimpl,pdtphys,fm0,entr0,zmasse,  &
+      &                   pocarre,pdocarreadj,zocarrea,lev_out) 
+
+      
+      do k=1,klev
+         do i=1,klon      
+            varq_therm(i,k)=zocarrea(i,k)-zoa(i,k)*zoa(i,k)
+         enddo
+      enddo
+
+      
+      if (klein) then
+         do k=1,klev-1
+            do i=1,klon
+              qd0(:,:) = 0.0
+              if (sigd(i).ne.0) then
+                qd0(i,k) = fqd(i,k)*tau_cumul/sigd(i) 
+              endif
+            enddo
+         enddo
+         do k=1,klev-1
+            do i=1,klon      
+               povariance(i,k)= (detr0(i,k)*((zoa(i,k)-po(i,k))**2 + (varq_therm(i,k)-povariance(i,k)))/zmasse(i,k) + fm0(i,k+1)*povariance(i,k+1)/zmasse(i,k) -  &
+               fm0(i,k)*povariance(i,k)/zmasse(i,k) +  &
+               a_ratqs_cv*(detrain_cv(i,k)/zmasse(i,k)) +  sigd(i)*(1-sigd(i))*qd0(i,k)**2/tau_cumul  &   
+                + ((povariance(i,k+1)-povariance(i,k))*(fm_cv(i,k)/zmasse(i,k))))*pdtphys + povariance(i,k)
+               povariance(i,k)= povariance(i,k)*exp(-pdtphys/tau_diss(i,k))
+            enddo
+         enddo
+         povariance(:,klev) = povariance(:,klev-1)
+         
+      else ! calcul direct     
+         qd0(:,:) = 0.0
+         q0(:,:) = 0.0
+         do k=1,klev-1
+            do i=1,klon
+               if (sigd(i).ne.0) then
+                 qd0(i,k) = fqd(i,k)*tau_cumul/sigd(i) 
+               endif
+               if (sigt_cv(i,k).ne.0) then
+                 q0(i,k) = fqcomp(i,k)*tau_cumul/sigt_cv(i,k)
+               endif
+            enddo
+         enddo
+         do k=1,klev-1
+            do i=1,klon      
+               povariance(i,k)= (pdocarreadj(i,k)-2.*po(i,k)*pdoadj(i,k) +  &
+               a_ratqs_cv*(sigt_cv(i,k)*(1-sigt_cv(i,k))*q0(i,k)**2/tau_cumul + sigd(i)*(1-sigd(i))*qd0(i,k)**2/tau_cumul) +  &
+               ((povariance(i,k+1)-povariance(i,k))*(fm_cv(i,k)/zmasse(i,k))))*pdtphys + povariance(i,k)
+               povariance(i,k)=povariance(i,k)*exp(-pdtphys/tau_diss(i,k))
+            enddo
+         enddo
+         povariance(:,klev) = povariance(:,klev-1)
+!         fqd(:,:)=sigt_cv(:,:)*(1-sigt_cv(:,:))*q0(:,:)**2/tau_cumul 
+      endif
+      
+!-------------------------------------------------------------------------
+!  Caclul du terme de détrainement de la variance pour la convection (version fausse avec deux calculs de variance indépendants)
+!-------------------------------------------------------------------------
+
+!      if (klein_conv) then
+!        detrain_p(:,:) = 0.
+!        detraincv(:,:) = 0.
+!        dqp(:,:)    = 0. 
+      
+!        do k=1,klev-1
+!          do i=1,klon
+!           dqp(i,k) = q_seri(i,k) - qp(i,k)
+!           detraincv(i,k) = abs(detrain_cv(i,k))
+         
+!         if ((mp(i,k)-mp(i,k+1)).le.0) then
+!            detrain_p(i,k) = (mp(i,k+1)-mp(i,k))
+!         endif
+!          enddo
+!        enddo
+
+!        do k=1,klev-1
+!          do i=1,klon
+!            qd0(:,:) = 0.0
+!            if (sigd(i).ne.0) then
+!              qd0(i,k) = fqd(i,k)*tau_cumul/sigd(i) 
+!            endif
+!          enddo
+!        enddo
+
+!        do k=1,klev-1
+!          do i=1,klon            
+!            var_conv(i,k)= var_conv(i,k)*exp(-pdtphys/tau_conv) +  &
+!                (a_ratqs_cv*(detraincv(i,k)/zmasse(i,k)) +  sigd(i)*(1-sigd(i))*qd0(i,k)**2/tau_cumul  &   
+!                + ((var_conv(i,k+1)-var_conv(i,k))*(fm_cv(i,k)/zmasse(i,k))))* &
+!              ((dqp(i,k)**2)*(detrain_p(i,k)/zmasse(i,k))))* & ! les termes de descentes précipitantes qui seront traités autrement
+!              (((mp(i,k)-mp(i,k+1))/zmasse(i,k))*dqp(i,k)**2) + (2*mp(i,k)*dqp(i,k)*(qp(i,k+1)-qp(i,k))/zmasse(i,k)))* &
+!                (1.-exp(-pdtphys/tau_conv))/(1/tau_conv)      
+!          enddo
+!        enddo
+!        var_conv(:,klev) = var_conv(:,klev-1)
+!        fqd(:,:) = var_conv(:,:)
+!      else
+
+
+!        do k=1,klev-1
+!          do i=1,klon            
+!            var_conv(i,k)= var_conv(i,k)*exp(-pdtphys/tau_conv) +  &
+!                (a_ratqs_cv*(sigt_cv(i,k)*(1-sigt_cv(i,k))*q0(i,k)**2/pdtphys + sigd(i)*(1-sigd(i))*qd0(i,k)**2/tau_cumul) +  &   ! somme des contributions des descentes précipitantes et des flux mélangés
+!                + ((var_conv(i,k+1)-var_conv(i,k))*(fm_cv(i,k)/zmasse(i,k))))* & ! flux compensatoires dans l'environnement
+!                (1.-exp(-pdtphys/tau_conv))/(1/tau_conv) 
+!             ((var_conv(i,k+1)-var_conv(i,k))*(fm_cv(i,k)/zmasse(i,k)))  
+!          enddo
+!        enddo
+!        var_conv(:,klev) = var_conv(:,klev-1) 
+!      endif
+
+!-------------------------------------------------------------------------
+!  Caclul du ratqs_inter_
+!-------------------------------------------------------------------------
+
+      do k=1,klev
+        do i=1,klon
+           if(q_seri(i,k).ge.1E-7) then
+               ratqs_inter_(i,k) = abs(povariance(i,k))**0.5/q_seri(i,k) 
+           else 
+               ratqs_inter_(i,k) = 0.  
+           endif
+        enddo
+      enddo
+      
+return
+end             
+
+!------------------------------------------------------------------
+SUBROUTINE ratqs_oro(klon,klev,pctsrf,zstd,qsat,temp,pplay,paprs,ratqs_oro_)
+
+! Etienne Vignon, November 2021: effect of subgrid orography on ratqs
+
+USE lmdz_ratqs_ini, ONLY : RG,RV,RD,RLSTT,RLVTT,RTT,nbsrf,is_lic,is_ter
+
+IMPLICIT NONE
+
+! Declarations
+!--------------
+
+! INPUTS
+
+INTEGER, INTENT(IN) :: klon                       ! number of horizontal grid points
+INTEGER, INTENT(IN) :: klev                       ! number of vertical layers
+REAL, DIMENSION(klon,nbsrf) :: pctsrf
+REAL, DIMENSION(klon,klev), INTENT(IN) :: qsat    ! saturation specific humidity [kg/kg]
+REAL, DIMENSION(klon), INTENT(IN) :: zstd    ! sub grid orography standard deviation
+REAL, DIMENSION(klon,klev), INTENT(IN) :: temp    ! air temperature [K]
+REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay    ! air pressure, layer's center [Pa]
+REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs    ! air pressure, lower inteface [Pa]
+
+! OUTPUTS
+
+REAL, DIMENSION(klon,klev), INTENT(out) :: ratqs_oro_ ! ratqs profile due to subgrid orography
+
+
+! LOCAL
+
+INTEGER :: i,k
+REAL, DIMENSION(klon) :: orogradT,xsi0
+REAL, DIMENSION (klon,klev) :: zlay
+REAL :: Lvs, temp0
+
+
+! Calculation of the near-surface temperature gradient along the topography
+!--------------------------------------------------------------------------
+
+! at the moment, we fix it at a constant value (moist adiab. lapse rate)
+
+orogradT(:)=-6.5/1000. ! K/m
+
+! Calculation of near-surface surface ratqs
+!-------------------------------------------
+
+DO i=1,klon
+    temp0=temp(i,1)
+    IF (temp0 .LT. RTT) THEN
+        Lvs=RLSTT
+    ELSE
+        Lvs=RLVTT
+    ENDIF
+    xsi0(i)=zstd(i)*ABS(orogradT(i))*Lvs/temp0/temp0/RV
+    ratqs_oro_(i,1)=xsi0(i)
+END DO
+
+! Vertical profile of ratqs assuming an exponential decrease with height
+!------------------------------------------------------------------------
+     
+! calculation of geop. height AGL        
+zlay(:,1)= RD*temp(:,1)/(0.5*(paprs(:,1)+pplay(:,1))) &
+           *(paprs(:,1)-pplay(:,1))/RG
+
+DO k=2,klev
+   DO i = 1, klon
+      zlay(i,k)= zlay(i,k-1)+RD*0.5*(temp(i,k-1)+temp(i,k)) &
+               /paprs(i,k)*(pplay(i,k-1)-pplay(i,k))/RG
+               
+      ratqs_oro_(i,k)=MAX(0.0,pctsrf(i,is_ter)*xsi0(i)*exp(-zlay(i,k)/MAX(zstd(i),1.)))   
+    END DO
+END DO
+
+
+
+
+END SUBROUTINE ratqs_oro
+
+!=============================================
+
+SUBROUTINE ratqs_hetero(klon,klev,pctsrf,s_pblh,t2m,q2m,temp,q,pplay,paprs,ratqs_hetero_)
+
+! Etienne Vignon, November 2021
+! Effect of subgrid surface heterogeneities on ratqs
+
+USE lmdz_lscp_tools, ONLY: CALC_QSAT_ECMWF
+
+USE lmdz_ratqs_ini, ONLY : RG,RD,RTT,nbsrf
+
+IMPLICIT NONE
+
+! INPUTS
+
+
+INTEGER, INTENT(IN) :: klon                       ! number of horizontal grid points
+INTEGER, INTENT(IN) :: klev                       ! number of vertical layers
+REAL, DIMENSION(klon)                   :: s_pblh ! height of the planetary boundary layer(HPBL)
+REAL, DIMENSION(klon,nbsrf)             :: pctsrf ! Fractional cover of subsurfaces
+REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: t2m    ! 2m temperature for each tile [K]
+REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: q2m    ! 2m specific humidity for each tile [kg/kg]
+REAL, DIMENSION(klon,klev), INTENT(IN) :: temp    ! air temperature [K]
+REAL, DIMENSION(klon,klev), INTENT(IN) :: q       ! specific humidity [kg/kg]
+REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay   ! air pressure, layer's center [Pa]
+REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs ! air pressure, lower inteface [Pa]
+
+! OUTPUTS
+
+REAL, DIMENSION(klon,klev), INTENT(out) :: ratqs_hetero_ ! ratsq profile due to surface heterogeneities
+
+
+INTEGER :: i,k,nsrf
+REAL, DIMENSION(klon) :: xsi0, ratiom, qsat2m, dqsatdT
+REAL, DIMENSION (klon,klev) :: zlay
+
+
+
+! Calculation of near-surface surface ratqs
+!-------------------------------------------
+
+    
+    ratiom(:)=0.
+    xsi0(:)=0.
+    
+    DO nsrf=1,nbsrf
+    CALL CALC_QSAT_ECMWF(klon,t2m(:,nsrf),q2m(:,nsrf),paprs(:,1),RTT,0,.false.,qsat2m,dqsatdT)
+    ratiom(:)=ratiom(:)+pctsrf(:,nsrf)*(q2m(:,nsrf)/qsat2m(:))
+    xsi0(:)=xsi0(:)+pctsrf(:,nsrf)*((q2m(:,nsrf)/qsat2m(:)-ratiom(:))**2)
+    END DO
+    
+    xsi0(:)=sqrt(xsi0(:))/(ratiom(:)+1E-6)
+
+
+
+! Vertical profile of ratqs assuming an exponential decrease with height
+!------------------------------------------------------------------------
+        
+! calculation of geop. height AGL
+
+zlay(:,1)= RD*temp(:,1)/(0.5*(paprs(:,1)+pplay(:,1))) &
+           *(paprs(:,1)-pplay(:,1))/RG
+ratqs_hetero_(:,1)=xsi0(:)
+
+DO k=2,klev
+   DO i = 1, klon
+      zlay(i,k)= zlay(i,k-1)+RD*0.5*(temp(i,k-1)+temp(i,k)) &
+               /paprs(i,k)*(pplay(i,k-1)-pplay(i,k))/RG
+               
+      ratqs_hetero_(i,k)=MAX(xsi0(i)*exp(-zlay(i,k)/(s_pblh(i)+1.0)),0.0)   
+    END DO
+END DO
+
+END SUBROUTINE ratqs_hetero
+
+!=============================================
+
+SUBROUTINE ratqs_tke(klon,klev,pdtphys,temp,q,qsat,pplay,paprs,omega,tke,tke_dissip,lmix,wprime,ratqs_tke_)
+
+! References:
+!
+! Etienne Vignon: effect of subgrid turbulence on ratqs
+!
+! Field, P.R., Hill, A., Furtado, K., Korolev, A., 2014b. Mixed-phase clouds in a turbulent environment. Part
+! 2: analytic treatment. Q. J. R. Meteorol. Soc. 21, 2651–2663. https://doi.org/10.1002/qj.2175.
+! 
+! Furtado, K., Field, P.R., Boutle, I.A., Morcrette, C.R., Wilkinson, J., 2016. A physically-based, subgrid
+! parametrization for the production and maintenance of mixed-phase clouds in a general circulation
+! model. J. Atmos. Sci. 73, 279–291. https://doi.org/10.1175/JAS-D-15-0021.
+
+USE lmdz_ratqs_ini, ONLY : RG,RV,RD,RCPD,RLSTT,RLVTT,RTT
+
+IMPLICIT NONE
+
+! INPUTS
+
+INTEGER, INTENT(IN) :: klon                             ! number of horizontal grid points
+INTEGER, INTENT(IN) :: klev                             ! number of vertical layers
+REAL, INTENT(IN) :: pdtphys                             ! physics time step [s]
+REAL, DIMENSION(klon,klev), INTENT(IN) :: temp          ! air temperature [K]
+REAL, DIMENSION(klon,klev), INTENT(IN) :: q             ! specific humidity [kg/kg]
+REAL, DIMENSION(klon,klev), INTENT(IN) :: qsat          ! saturation specific humidity [kg/kg]
+REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay         ! air pressure, layer's center [Pa]
+REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs       ! air pressure, lower inteface [Pa]
+REAL, DIMENSION(klon,klev), INTENT(IN) :: omega       ! air pressure, lower inteface [Pa]
+REAL, DIMENSION(klon,klev+1), INTENT(IN) :: tke         ! Turbulent Kinetic Energy [m2/s2]
+REAL, DIMENSION(klon,klev+1), INTENT(IN) :: tke_dissip  ! Turbulent Kinetic Energy Dissipation rate [m2/s3]
+REAL, DIMENSION(klon,klev+1), INTENT(IN) :: lmix  ! Turbulent mixing length
+REAL, DIMENSION(klon,klev+1), INTENT(IN) :: wprime      ! Turbulent vertical velocity scale [m/s]
+
+! OUTPUTS
+
+REAL, DIMENSION(klon,klev), INTENT(out) :: ratqs_tke_  ! ratsq profile due to subgrid TKE
+
+! LOCAL
+INTEGER :: i, k
+REAL :: AA, DD, NW, AAprime, VARLOG,rho,Lvs,taue,lhomo,dissmin,maxvarlog
+REAL, DIMENSION(klon,klev) :: sigmaw,w
+REAL, PARAMETER :: C0=10.0
+REAL, PARAMETER :: lmin=0.001
+REAL, PARAMETER :: ratqsmin=1E-6
+REAL, PARAMETER :: ratqsmax=0.5
+
+
+! Calculation of large scale and turbulent vertical velocities
+!---------------------------------------------------------------
+
+DO k=1,klev
+    DO i=1,klon
+        rho=pplay(i,k)/temp(i,k)/RD
+        w(i,k)=-rho*RG*omega(i,k)
+        sigmaw(i,k)=0.5*(wprime(i,k+1)+wprime(i,k)) ! turbulent vertical velocity at the middle of model layers. 
+    END DO
+END DO
+
+! Calculation of ratqs
+!---------------------------------------------------------------
+ratqs_tke_(:,1)=ratqsmin ! set to a very low value to avoid division by 0 in order parts
+                        ! of the code
+DO k=2,klev ! we start from second model level since TKE is not defined at k=1
+    DO i=1,klon
+
+       IF (temp(i,k) .LT. RTT) THEN
+           Lvs=RLSTT
+       ELSE
+           Lvs=RLVTT
+       ENDIF
+       dissmin=0.01*(0.5*(tke(i,k)+tke(i,k+1))/pdtphys)
+       maxvarlog=LOG(1.0+ratqsmax**2)! to prevent ratqs from exceeding an arbitrary threshold value 
+       AA=RG*(Lvs/(RCPD*temp(i,k)*temp(i,k)*RV) - 1./(RD*temp(i,k)))
+       lhomo=MAX(0.5*(lmix(i,k)+lmix(i,k+1)),lmin)
+       taue=(lhomo*lhomo/MAX(0.5*(tke_dissip(i,k)+tke_dissip(i,k+1)),dissmin))**(1./3) ! Fields et al. 2014
+       DD=1.0/taue
+       NW=(sigmaw(i,k)**2)*SQRT(2./(C0*MAX(0.5*(tke_dissip(i,k)+tke_dissip(i,k+1)),dissmin)))
+       AAprime=AA*NW
+       VARLOG=AAprime/2./DD
+       VARLOG=MIN(VARLOG,maxvarlog)
+       ratqs_tke_(i,k)=SQRT(MAX(EXP(VARLOG)-1.0,ratqsmin))
+       END DO
+END DO
+END SUBROUTINE ratqs_tke
+
+END MODULE lmdz_ratqs_multi
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_alim.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_alim.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_alim.F90	(revision 4727)
@@ -0,0 +1,127 @@
+MODULE lmdz_thermcell_alim
+!
+! $Id: thermcell_plume.F90 2311 2015-06-25 07:45:24Z emillour $
+!
+CONTAINS
+
+      SUBROUTINE thermcell_alim(flag,ngrid,klev,ztv,d_temp,zlev,alim_star,lalim)
+IMPLICIT NONE
+
+!--------------------------------------------------------------------------
+! FH : 2015/11/06
+! thermcell_alim: calcule la distribution verticale de l'alimentation 
+! laterale a la base des panaches thermiques
+!--------------------------------------------------------------------------
+
+      INTEGER, INTENT(IN) :: ngrid,klev
+      REAL, INTENT(IN) :: ztv(ngrid,klev)
+      REAL, INTENT(IN) :: d_temp(ngrid)
+      REAL, INTENT(IN) :: zlev(ngrid,klev+1)
+      REAL, INTENT(OUT) :: alim_star(ngrid,klev)
+      INTEGER, INTENT(OUT) :: lalim(ngrid)
+      INTEGER, INTENT(IN) :: flag
+
+      REAL :: alim_star_tot(ngrid),zi(ngrid),zh(ngrid)
+      REAL :: zlay(ngrid,klev)
+      REAL ztv_parcel
+
+      INTEGER ig,l
+
+      REAL h,z,falim
+      falim(h,z)=0.2*((z-h)**5+h**5)
+
+
+!===================================================================
+
+   lalim(:)=1
+   alim_star_tot(:)=0.
+
+!-------------------------------------------------------------------------
+! Definition de l'alimentation
+!-------------------------------------------------------------------------
+   IF (flag==0) THEN ! CMIP5 version
+      do l=1,klev-1
+         do ig=1,ngrid
+            if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) then
+               alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
+     &                       *sqrt(zlev(ig,l+1)) 
+               lalim(ig)=l+1
+               alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
+            endif
+         enddo
+      enddo
+      do l=1,klev
+         do ig=1,ngrid 
+            if (alim_star_tot(ig) > 1.e-10 ) then
+               alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
+            endif
+         enddo
+      enddo
+      alim_star_tot(:)=1.
+
+!-------------------------------------------------------------------------
+! Nouvelle definition avec possibilite d'introduire un DT en surface
+! On suppose que la forme du profile d'alimentation scale avec la hauteur
+! d'inversion calculée avec une particule partant de la premieere couche
+
+! Fonction  f(z) = z ( h - z ) , avec h = zi/3
+! On utilise l'integralle
+! Int_0^z f(z') dz' = z^2 ( h/2 - z/3 ) = falim(h,z)
+! Pour calculer l'alimentation des couches
+!-------------------------------------------------------------------------
+   ELSE
+! Computing inversion height zi and zh=zi/3.
+      zi(:)=0.
+! Il faut recalculer zlay qui n'est pas dispo dans thermcell_plume
+! A changer eventuellement.
+      do l=1,klev
+         zlay(:,l)=0.5*(zlev(:,l)+zlev(:,l+1))
+      enddo
+
+      do l=klev-1,1,-1
+         do ig=1,ngrid
+            ztv_parcel=ztv(ig,1)+d_temp(ig)
+            if (ztv_parcel<ztv(ig,l+1)) lalim(ig)=l
+         enddo
+      enddo
+
+      do ig=1,ngrid
+         l=lalim(ig)
+         IF (l==1) THEN
+            zi(ig)=0.
+         ELSE
+            ztv_parcel=ztv(ig,1)+d_temp(ig)
+            zi(ig)=zlay(ig,l)+(zlay(ig,l+1)-zlay(ig,l))/(ztv(ig,l+1)-ztv(ig,l))*(ztv_parcel-ztv(ig,l))
+         ENDIF
+      enddo
+
+      zh(:)=zi(:)/2.
+      alim_star_tot(:)=0.
+      alim_star(:,:)=0.
+      lalim(:)=0
+      do l=1,klev-1
+         do ig=1,ngrid
+            IF (zh(ig)==0.) THEN
+               alim_star(ig,l)=0.
+               lalim(ig)=1
+            ELSE IF (zlev(ig,l+1)<=zh(ig)) THEN
+               alim_star(ig,l)=(falim(zh(ig),zlev(ig,l+1))-falim(zh(ig),zlev(ig,l)))/falim(zh(ig),zh(ig))
+               lalim(ig)=l
+            ELSE IF (zlev(ig,l)<=zh(ig)) THEN
+               alim_star(ig,l)=(falim(zh(ig),zh(ig))-falim(zh(ig),zlev(ig,l)))/falim(zh(ig),zh(ig))
+               lalim(ig)=l
+            ELSE
+               alim_star(ig,l)=0.
+            ENDIF
+         ENDDO
+         alim_star_tot(:)=alim_star_tot(:)+alim_star(:,l)
+      ENDDO
+      IF (ngrid==1) print*,'NEW ALIM CALCUL DE ZI ',alim_star_tot,lalim,zi,zh
+      alim_star_tot(:)=1.
+
+   ENDIF
+
+
+RETURN
+END
+END MODULE lmdz_thermcell_alim
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_alp.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_alp.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_alp.F90	(revision 4727)
@@ -0,0 +1,405 @@
+MODULE lmdz_thermcell_alp
+! $Id: thermcell_main.F90 2351 2015-08-25 15:14:59Z emillour $
+!
+CONTAINS
+
+      SUBROUTINE thermcell_alp(ngrid,nlay,ptimestep  &                         ! in
+     &                  ,pplay,pplev  &                                        ! in
+     &                  ,fm0,entr0,lmax  &                                     ! in
+     &                  ,pbl_tke,pctsrf,omega,airephy &                        ! in
+     &                  ,zw2,fraca &                                           ! in
+     &                  ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &  ! in
+!
+     &                  ,ale_bl,alp_bl,lalim_conv,wght_th &                    ! out
+     &                  ,zlcl,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &   ! out
+     &                  ,n2,s2,ale_bl_stat &                                   ! out
+     &                  ,therm_tke_max,env_tke_max &                           ! out
+     &                  ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &          ! out
+     &                  ,alp_bl_conv,alp_bl_stat &                             ! out
+     &)
+
+      USE indice_sol_mod
+      USE lmdz_thermcell_main, ONLY : thermcell_tke_transport
+      IMPLICIT NONE
+
+!=======================================================================
+!
+!   Auteurs: Catherine Rio
+!   Modifications :
+!   Nicolas Rochetin et Jean-Yves Grandpeix
+!         pour la fermeture stochastique. 2012
+!   Frédéric Hourdin :
+!         netoyage informatique. 2022
+!   
+!=======================================================================
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+
+      INCLUDE "YOMCST.h"
+      INCLUDE "YOETHF.h"
+      INCLUDE "FCTTRE.h"
+      INCLUDE "alpale.h"
+
+!   arguments:
+!   ----------
+
+!------Entrees
+      integer, intent(in) :: ngrid,nlay
+      real, intent(in) :: ptimestep
+      real, intent(in) :: pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      integer, intent(in), dimension(ngrid) ::lmax,lalim
+      real, intent(in), dimension(ngrid) :: zmax
+      real, intent(in), dimension(ngrid,nlay+1) :: zw2
+      real, intent(in), dimension(ngrid,nlay+1) :: fraca
+      real, intent(in), dimension(ngrid,nlay) :: wth3
+      real, intent(in), dimension(ngrid,nlay) :: rhobarz
+      real, intent(in), dimension(ngrid) :: wmax_sec
+      real, intent(in), dimension(ngrid,nlay) :: entr0
+      real, intent(in), dimension(ngrid,nlay+1) :: fm0,fm
+      real, intent(in), dimension(ngrid) :: pcon
+      real, intent(in), dimension(ngrid,nlay) :: alim_star
+      real, intent(in), dimension(ngrid,nlay+1,nbsrf) :: pbl_tke
+      real, intent(in), dimension(ngrid,nbsrf) :: pctsrf
+      real, intent(in), dimension(ngrid,nlay) :: omega
+      real, intent(in), dimension(ngrid) :: airephy
+!------Sorties
+      real, intent(out), dimension(ngrid) :: ale_bl,alp_bl
+      real, intent(out), dimension(ngrid,nlay) :: wght_th
+      integer, intent(out), dimension(ngrid) :: lalim_conv
+      real, intent(out), dimension(ngrid) :: zlcl,fraca0,w0,w_conv
+      real, intent(out), dimension(ngrid) :: therm_tke_max0,env_tke_max0,n2,s2,ale_bl_stat
+      real, intent(out), dimension(ngrid,nlay) :: therm_tke_max,env_tke_max
+      real, intent(out), dimension(ngrid) :: alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke
+      real, intent(out), dimension(ngrid) :: alp_bl_conv,alp_bl_stat
+
+!=============================================================================================
+!------Local
+!=============================================================================================
+
+      REAL susqr2pi, reuler
+      INTEGER ig,k,l
+      integer nsrf
+      real rhobarz0(ngrid)                    ! Densité au LCL
+      logical ok_lcl(ngrid)                   ! Existence du LCL des thermiques
+      integer klcl(ngrid)                     ! Niveau du LCL
+      real interp(ngrid)                      ! Coef d'interpolation pour le LCL
+!--Triggering
+      real, parameter :: su_cst=4e4              ! Surface unite: celle d'un updraft élémentaire
+      real, parameter :: hcoef=1             ! Coefficient directeur pour le calcul de s2
+      real, parameter :: hmincoef=0.3        ! Coefficient directeur pour l'ordonnée à l'origine pour le calcul de s2 
+      real, parameter :: eps1=0.3            ! Fraction de surface occupée par la population 1 : eps1=n1*s1/(fraca0*Sd)
+      real, dimension(ngrid) :: hmin         ! Ordonnée à l'origine pour le calcul de s2
+      real, dimension(ngrid) :: zmax_moy     ! Hauteur moyenne des thermiques : zmax_moy = zlcl + 0.33 (zmax-zlcl)
+      real, parameter :: zmax_moy_coef=0.33
+      real, dimension(ngrid) :: depth        ! Epaisseur moyenne du cumulus
+      real, dimension(ngrid) ::  w_max                 ! Vitesse max statistique 
+      real, dimension(ngrid) ::  s_max(ngrid)
+!--Closure
+      real, dimension(ngrid,nlay) :: pbl_tke_max       ! Profil de TKE moyenne 
+      real, dimension(ngrid) :: pbl_tke_max0           ! TKE moyenne au LCL
+      real, dimension(ngrid,nlay) :: w_ls              ! Vitesse verticale grande échelle (m/s)
+      real, parameter :: coef_m=1.            ! On considère un rendement pour alp_bl_fluct_m
+      real, parameter :: coef_tke=1.          ! On considère un rendement pour alp_bl_fluct_tke
+      real :: zdp
+      real, dimension(ngrid) :: alp_int,dp_int
+      real, dimension(ngrid) :: fm_tot
+
+!------------------------------------------------------------
+!  Initialize output arrays related to stochastic triggering
+!------------------------------------------------------------
+  DO ig = 1,ngrid
+     zlcl(ig) = 0.
+     fraca0(ig) = 0.
+     w0(ig) = 0.
+     w_conv(ig) = 0.
+     therm_tke_max0(ig) = 0.
+     env_tke_max0(ig) = 0.
+     n2(ig) = 0.
+     s2(ig) = 0.
+     ale_bl_stat(ig) = 0.
+     alp_bl_det(ig) = 0.
+     alp_bl_fluct_m(ig) = 0.
+     alp_bl_fluct_tke(ig) = 0.
+     alp_bl_conv(ig) = 0.
+     alp_bl_stat(ig) = 0.
+  ENDDO
+  DO l = 1,nlay
+    DO ig = 1,ngrid
+     therm_tke_max(ig,l) = 0.
+     env_tke_max(ig,l) = 0.
+    ENDDO
+  ENDDO
+
+!------------Test sur le LCL des thermiques
+    do ig=1,ngrid
+      ok_lcl(ig)=.false.
+      if ( (pcon(ig) .gt. pplay(ig,nlay-1)) .and. (pcon(ig) .lt. pplay(ig,1)) ) ok_lcl(ig)=.true.
+    enddo
+
+!------------Localisation des niveaux entourant le LCL et du coef d'interpolation
+    do l=1,nlay-1
+      do ig=1,ngrid
+        if (ok_lcl(ig)) then 
+!ATTENTION,zw2 calcule en pplev
+!          if ((pplay(ig,l) .ge. pcon(ig)) .and. (pplay(ig,l+1) .le. pcon(ig))) then
+!          klcl(ig)=l
+!          interp(ig)=(pcon(ig)-pplay(ig,klcl(ig)))/(pplay(ig,klcl(ig)+1)-pplay(ig,klcl(ig)))
+!          endif
+          if ((pplev(ig,l) .ge. pcon(ig)) .and. (pplev(ig,l+1) .le. pcon(ig))) then
+          klcl(ig)=l
+          interp(ig)=(pcon(ig)-pplev(ig,klcl(ig)))/(pplev(ig,klcl(ig)+1)-pplev(ig,klcl(ig)))
+          endif
+        endif
+      enddo
+    enddo
+
+    do ig =1,ngrid
+!CR:REHABILITATION ZMAX CONTINU
+     if (ok_lcl(ig)) then 
+      rhobarz0(ig)=rhobarz(ig,klcl(ig))+(rhobarz(ig,klcl(ig)+1) &
+ &               -rhobarz(ig,klcl(ig)))*interp(ig)
+      zlcl(ig)=(pplev(ig,1)-pcon(ig))/(rhobarz0(ig)*RG)
+      zlcl(ig)=min(zlcl(ig),zmax(ig))   ! Si zlcl > zmax alors on pose zlcl = zmax
+     else
+      rhobarz0(ig)=0.
+      zlcl(ig)=zmax(ig)
+     endif
+    enddo
+!!jyg fin
+
+!------------Calcul des propriétés du thermique au LCL 
+  IF ( (iflag_trig_bl.ge.1) .or. (iflag_clos_bl.ge.1) ) THEN 
+
+  !-----Initialisation de la TKE moyenne 
+   do l=1,nlay
+    do ig=1,ngrid
+     pbl_tke_max(ig,l)=0.
+    enddo
+   enddo
+
+!-----Calcul de la TKE moyenne 
+   do nsrf=1,nbsrf
+    do l=1,nlay
+     do ig=1,ngrid
+     pbl_tke_max(ig,l)=pctsrf(ig,nsrf)*pbl_tke(ig,l,nsrf)+pbl_tke_max(ig,l)
+     enddo
+    enddo
+   enddo
+
+!-----Initialisations des TKE dans et hors des thermiques 
+   do l=1,nlay
+    do ig=1,ngrid
+    therm_tke_max(ig,l)=pbl_tke_max(ig,l)
+    env_tke_max(ig,l)=pbl_tke_max(ig,l)
+    enddo
+   enddo
+
+!-----Calcul de la TKE transportée par les thermiques : therm_tke_max
+   call thermcell_tke_transport(ngrid,nlay,ptimestep,fm0,entr0,  &  ! in
+  &           rg,pplev,therm_tke_max)                               ! out
+!   print *,' thermcell_tke_transport -> '   !!jyg
+
+!-----Calcul des profils verticaux de TKE hors thermiques : env_tke_max, et de la vitesse verticale grande échelle : W_ls
+   do l=1,nlay
+    do ig=1,ngrid
+     pbl_tke_max(ig,l)=fraca(ig,l)*therm_tke_max(ig,l)+(1.-fraca(ig,l))*env_tke_max(ig,l)         !  Recalcul de TKE moyenne aprés transport de TKE_TH
+     env_tke_max(ig,l)=(pbl_tke_max(ig,l)-fraca(ig,l)*therm_tke_max(ig,l))/(1.-fraca(ig,l))       !  Recalcul de TKE dans  l'environnement aprés transport de TKE_TH
+     w_ls(ig,l)=-1.*omega(ig,l)/(RG*rhobarz(ig,l))                                                !  Vitesse verticale de grande échelle
+    enddo
+   enddo
+!    print *,' apres w_ls = '   !!jyg
+
+  do ig=1,ngrid
+   if (ok_lcl(ig)) then
+     fraca0(ig)=fraca(ig,klcl(ig))+(fraca(ig,klcl(ig)+1) &
+ &             -fraca(ig,klcl(ig)))*interp(ig)
+     w0(ig)=zw2(ig,klcl(ig))+(zw2(ig,klcl(ig)+1) &
+ &         -zw2(ig,klcl(ig)))*interp(ig)
+     w_conv(ig)=w_ls(ig,klcl(ig))+(w_ls(ig,klcl(ig)+1) &
+ &             -w_ls(ig,klcl(ig)))*interp(ig)
+     therm_tke_max0(ig)=therm_tke_max(ig,klcl(ig)) &
+ &                     +(therm_tke_max(ig,klcl(ig)+1)-therm_tke_max(ig,klcl(ig)))*interp(ig)
+     env_tke_max0(ig)=env_tke_max(ig,klcl(ig))+(env_tke_max(ig,klcl(ig)+1) &
+ &                   -env_tke_max(ig,klcl(ig)))*interp(ig)
+     pbl_tke_max0(ig)=pbl_tke_max(ig,klcl(ig))+(pbl_tke_max(ig,klcl(ig)+1) &
+ &                   -pbl_tke_max(ig,klcl(ig)))*interp(ig)
+     if (therm_tke_max0(ig).ge.20.) therm_tke_max0(ig)=20.
+     if (env_tke_max0(ig).ge.20.) env_tke_max0(ig)=20.
+     if (pbl_tke_max0(ig).ge.20.) pbl_tke_max0(ig)=20.
+   else 
+     fraca0(ig)=0.
+     w0(ig)=0.
+!!jyg le 27/04/2012
+!!     zlcl(ig)=0.
+!!
+   endif
+  enddo
+
+  ENDIF ! IF ( (iflag_trig_bl.ge.1) .or. (iflag_clos_bl.ge.1) )
+!  print *,'ENDIF  ( (iflag_trig_bl.ge.1) .or. (iflag_clos_bl.ge.1) ) '    !!jyg
+
+!------------Triggering------------------
+  IF (iflag_trig_bl.ge.1) THEN 
+
+!-----Initialisations
+   depth(:)=0.
+   n2(:)=0.
+   s2(:)=100. ! some low value, arbitrary
+   s_max(:)=0.
+
+!-----Epaisseur du nuage (depth) et détermination de la queue du spectre de panaches (n2,s2) et du panache le plus gros (s_max)
+   do ig=1,ngrid
+     zmax_moy(ig)=zlcl(ig)+zmax_moy_coef*(zmax(ig)-zlcl(ig))
+     depth(ig)=zmax_moy(ig)-zlcl(ig)
+     hmin(ig)=hmincoef*zlcl(ig)
+     if (depth(ig).ge.10.) then 
+       s2(ig)=(hcoef*depth(ig)+hmin(ig))**2
+       n2(ig)=(1.-eps1)*fraca0(ig)*airephy(ig)/s2(ig)
+!!
+!!jyg le 27/04/2012
+!!       s_max(ig)=s2(ig)*log(n2(ig))
+!!       if (n2(ig) .lt. 1) s_max(ig)=0.
+       s_max(ig)=s2(ig)*log(max(n2(ig),1.))
+!!fin jyg
+     else
+       n2(ig)=0.
+       s_max(ig)=0.
+     endif
+   enddo
+!   print *,'avant Calcul de Wmax '    !!jyg
+
+   susqr2pi=su_cst*sqrt(2.*Rpi)
+   reuler=exp(1.)
+   do ig=1,ngrid
+     if ( (depth(ig).ge.10.) .and. (s_max(ig).gt.susqr2pi*reuler) ) then
+      w_max(ig)=w0(ig)*(1.+sqrt(2.*log(s_max(ig)/susqr2pi)-log(2.*log(s_max(ig)/susqr2pi))))
+      ale_bl_stat(ig)=0.5*w_max(ig)**2
+     else
+      w_max(ig)=0.
+      ale_bl_stat(ig)=0.
+     endif
+   enddo
+
+  ENDIF ! iflag_trig_bl
+!  print *,'ENDIF  iflag_trig_bl'    !!jyg
+
+!------------Closure------------------
+
+  IF (iflag_clos_bl.ge.2) THEN 
+
+!-----Calcul de ALP_BL_STAT
+  do ig=1,ngrid
+  alp_bl_det(ig)=0.5*coef_m*rhobarz0(ig)*(w0(ig)**3)*fraca0(ig)*(1.-2.*fraca0(ig))/((1.-fraca0(ig))**2)
+  alp_bl_fluct_m(ig)=1.5*rhobarz0(ig)*fraca0(ig)*(w_conv(ig)+coef_m*w0(ig))* &
+ &                   (w0(ig)**2)
+  alp_bl_fluct_tke(ig)=3.*coef_m*rhobarz0(ig)*w0(ig)*fraca0(ig)*(therm_tke_max0(ig)-env_tke_max0(ig)) &
+ &                    +3.*rhobarz0(ig)*w_conv(ig)*pbl_tke_max0(ig)
+    if (iflag_clos_bl.ge.2) then 
+    alp_bl_conv(ig)=1.5*coef_m*rhobarz0(ig)*fraca0(ig)*(fraca0(ig)/(1.-fraca0(ig)))*w_conv(ig)* &
+ &                   (w0(ig)**2)
+    else
+    alp_bl_conv(ig)=0.
+    endif
+  alp_bl_stat(ig)=alp_bl_det(ig)+alp_bl_fluct_m(ig)+alp_bl_fluct_tke(ig)+alp_bl_conv(ig)
+  enddo
+
+!-----Sécurité ALP infinie
+  do ig=1,ngrid
+   if (fraca0(ig).gt.0.98) alp_bl_stat(ig)=2.
+  enddo
+
+  ENDIF ! (iflag_clos_bl.ge.2)
+
+!!! fin nrlmd le 10/04/2012
+
+!      print*,'avant calcul ale et alp' 
+!calcul de ALE et ALP pour la convection
+      alp_bl(:)=0.
+      ale_bl(:)=0.
+!          print*,'ALE,ALP ,l,zw2(ig,l),ale_bl(ig),alp_bl(ig)'
+      do l=1,nlay
+      do ig=1,ngrid
+           alp_bl(ig)=max(alp_bl(ig),0.5*rhobarz(ig,l)*wth3(ig,l) )
+           ale_bl(ig)=max(ale_bl(ig),0.5*zw2(ig,l)**2)
+!          print*,'ALE,ALP',l,zw2(ig,l),ale_bl(ig),alp_bl(ig)
+      enddo
+      enddo
+
+! ale sec (max de wmax/2 sous la zone d'inhibition) dans
+! le cas iflag_trig_bl=3
+      IF (iflag_trig_bl==3) ale_bl(:)=0.5*wmax_sec(:)**2
+
+!test:calcul de la ponderation des couches pour KE
+!initialisations
+
+      fm_tot(:)=0.
+      wght_th(:,:)=1.
+      lalim_conv(:)=lalim(:)
+
+      do k=1,nlay
+         do ig=1,ngrid
+            if (k<=lalim_conv(ig)) fm_tot(ig)=fm_tot(ig)+fm(ig,k)
+         enddo
+      enddo
+
+! assez bizarre car, si on est dans la couche d'alim et que alim_star et
+! plus petit que 1.e-10, on prend wght_th=1.
+      do k=1,nlay
+         do ig=1,ngrid
+            if (k<=lalim_conv(ig).and.alim_star(ig,k)>1.e-10) then
+               wght_th(ig,k)=alim_star(ig,k)
+            endif
+         enddo
+      enddo
+
+!      print*,'apres wght_th'
+!test pour prolonger la convection
+      do ig=1,ngrid
+!v1d  if ((alim_star(ig,1).lt.1.e-10).and.(therm)) then
+      if ((alim_star(ig,1).lt.1.e-10)) then
+      lalim_conv(ig)=1
+      wght_th(ig,1)=1.
+!      print*,'lalim_conv ok',lalim_conv(ig),wght_th(ig,1)
+      endif
+      enddo
+
+!------------------------------------------------------------------------
+! Modif CR/FH 20110310 : alp integree sur la verticale.
+! Integrale verticale de ALP.
+! wth3 etant aux niveaux inter-couches, on utilise d play comme masse des
+! couches
+!------------------------------------------------------------------------
+
+      alp_int(:)=0.
+      dp_int(:)=0.
+      do l=2,nlay
+        do ig=1,ngrid
+           if(l.LE.lmax(ig)) THEN
+           zdp=pplay(ig,l-1)-pplay(ig,l)
+           alp_int(ig)=alp_int(ig)+0.5*rhobarz(ig,l)*wth3(ig,l)*zdp
+           dp_int(ig)=dp_int(ig)+zdp
+           endif
+        enddo
+      enddo
+
+      if (iflag_coupl>=3 .and. iflag_coupl<=5) then
+      do ig=1,ngrid
+!valeur integree de alp_bl * 0.5:
+        if (dp_int(ig)>0.) then
+        alp_bl(ig)=alp_int(ig)/dp_int(ig)
+        endif
+      enddo!
+      endif
+
+
+! Facteur multiplicatif sur alp_bl
+      alp_bl(:)=alp_bl_k*alp_bl(:)
+
+!------------------------------------------------------------------------
+
+
+
+      return
+      end
+END MODULE lmdz_thermcell_alp
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_closure.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_closure.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_closure.F90	(revision 4727)
@@ -0,0 +1,75 @@
+MODULE lmdz_thermcell_closure
+!
+! $Header$
+!
+CONTAINS
+
+      SUBROUTINE thermcell_closure(ngrid,nlay,r_aspect,ptimestep,rho,  &
+     &   zlev,lalim,alim_star,zmax,wmax,f)
+
+!-------------------------------------------------------------------------
+!thermcell_closure: fermeture, determination de f
+!
+! Modification 7 septembre 2009
+! 1. On enleve alim_star_tot des arguments pour le recalculer et etre ainis
+! coherent avec l'integrale au numerateur.
+! 2. On ne garde qu'une version des couples wmax,zmax et wmax_sec,zmax_sec
+! l'idee etant que le choix se fasse a l'appel de thermcell_closure
+! 3. Vectorisation en mettant les boucles en l l'exterieur avec des if
+!-------------------------------------------------------------------------
+      IMPLICIT NONE
+
+! --- arguments ------------------------------------------
+integer, intent(in) :: ngrid,nlay
+real, intent(in) :: r_aspect,ptimestep
+real, intent(in), dimension(ngrid,nlay) :: alim_star,rho,zlev
+integer, intent(in), dimension(ngrid) :: lalim
+real, intent(in), dimension(ngrid) :: zmax,wmax
+
+real, intent(out), dimension(ngrid) :: f
+
+
+! --- local ------------------------------------------
+real, dimension(ngrid) :: zdenom,alim_star2,alim_star_tot
+INTEGER llmax
+INTEGER ig,k       
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!print*,'THERMCELL CLOSURE 26E'
+
+alim_star2(:)=0.
+alim_star_tot(:)=0.
+f(:)=0.
+
+! Indice vertical max (max de lalim) atteint par les thermiques sur le domaine
+llmax=1
+do ig=1,ngrid
+   if (lalim(ig)>llmax) llmax=lalim(ig)
+enddo
+
+
+! Calcul des integrales sur la verticale de alim_star et de
+!   alim_star^2/(rho dz)
+do k=1,llmax-1
+   do ig=1,ngrid
+      if (k<lalim(ig)) then
+         alim_star2(ig)=alim_star2(ig)+alim_star(ig,k)**2  &
+&                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
+         alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,k)
+      endif
+   enddo
+enddo
+
+
+do ig=1,ngrid
+   if (alim_star2(ig)>1.e-10) then
+      f(ig)=wmax(ig)*alim_star_tot(ig)/  &
+&     (max(500.,zmax(ig))*r_aspect*alim_star2(ig))
+   endif
+enddo
+
+
+
+ RETURN
+      end
+END MODULE lmdz_thermcell_closure
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_down.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_down.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_down.F90	(revision 4727)
@@ -0,0 +1,304 @@
+MODULE lmdz_thermcell_down
+CONTAINS
+
+SUBROUTINE thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,eup,dup,edn,ddn,masse,trac,dtrac)
+
+USE lmdz_thermcell_ini, ONLY: iflag_thermals_down
+
+
+!-----------------------------------------------------------------
+! thermcell_updown_dq: computes the tendency of tracers associated
+! with the presence of convective up/down drafts
+! This routine that has been collectively written during the 
+! "ateliers downdrafts" in 2022/2023
+! Maelle, Frédéric, Catherine, Fleur, Florent, Etienne
+!------------------------------------------------------------------
+
+
+   IMPLICIT NONE
+
+! declarations
+!==============================================================
+
+! input/output
+
+   integer,intent(in)  :: ngrid ! number of horizontal grid points
+   integer, intent(in) :: nlay  ! number of vertical layers
+   real,intent(in) :: ptimestep ! time step of the physics [s]
+   real,intent(in), dimension(ngrid,nlay) :: eup ! entrainment to updrafts * dz [same unit as flux]
+   real,intent(in), dimension(ngrid,nlay) :: dup ! detrainment from updrafts * dz [same unit as flux]
+   real,intent(in), dimension(ngrid,nlay) :: edn ! entrainment to downdrafts * dz [same unit as flux]
+   real,intent(in), dimension(ngrid,nlay) :: ddn ! detrainment from downdrafts * dz [same unit as flux]
+   real,intent(in), dimension(ngrid,nlay) :: masse ! mass of layers = rho dz 
+   real,intent(in), dimension(ngrid,nlay) :: trac ! tracer 
+   integer, intent(in), dimension(ngrid) :: lmax ! max level index at which downdraft are present
+   real,intent(out),dimension(ngrid,nlay) ::dtrac ! tendance du traceur
+
+   
+! Local
+
+   real, dimension(ngrid,nlay+1) :: fup,fdn,fc,fthu,fthd,fthe,fthtot
+   real, dimension(ngrid,nlay) :: tracu,tracd,traci,tracold
+   real :: www, mstar_inv
+   integer ig,ilay
+   real, dimension(ngrid,nlay):: s1,s2,num !coefficients pour la resolution implicite
+   integer :: iflag_impl=1 ! 0 pour explicite, 1 pour implicite "classique", 2 pour implicite avec entrainement et detrainement
+   
+   fdn(:,:)=0.
+   fup(:,:)=0.
+   fc(:,:)=0.
+   fthu(:,:)=0.
+   fthd(:,:)=0.
+   fthe(:,:)=0.
+   fthtot(:,:)=0.
+   tracd(:,:)=0.
+   tracu(:,:)=0.
+   traci(:,:)=trac(:,:)
+   tracold(:,:)=trac(:,:)
+   s1(:,:)=0.
+   s2(:,:)=0.
+   num(:,:)=1.
+
+   if ( iflag_thermals_down < 10 ) then
+      call abort_physic("thermcell_updown_dq", &
+           'thermcell_down_dq = 0 or >= 10', 1)
+   else
+        iflag_impl=iflag_thermals_down-10
+   endif
+      
+
+   ! lmax : indice tel que fu(kmax+1)=0
+   ! Dans ce cas, pas besoin d'initialiser tracd(lmax) ( =trac(lmax) )
+   ! Boucle pour le downdraft
+   do ilay=nlay,1,-1
+      do ig=1,ngrid
+         !if ( lmax(ig) > nlay - 2 ) stop "les thermiques montent trop haut"
+         if (ilay.le.lmax(ig) .and. lmax(ig)>1 ) then
+            fdn(ig,ilay)=fdn(ig,ilay+1)+edn(ig,ilay)-ddn(ig,ilay)
+            if ( fdn(ig,ilay)+ddn(ig,ilay) > 0. ) then
+               www=fdn(ig,ilay+1)/ (fdn(ig,ilay)+ddn(ig,ilay))
+            else
+               www=0.
+            endif
+            tracd(ig,ilay)=www*tracd(ig,ilay+1) + (1.-www)*trac(ig,ilay)
+         endif
+      enddo 
+   enddo !Fin boucle sur l'updraft
+   fdn(:,1)=0.
+
+   !Boucle pour l'updraft
+   do ilay=1,nlay,1
+      do ig=1,ngrid
+         if (ilay.lt.lmax(ig) .and. lmax(ig)>1) then
+            fup(ig,ilay+1)=fup(ig,ilay)+eup(ig,ilay)-dup(ig,ilay)
+            if (fup(ig,ilay+1)+dup(ig,ilay) > 0.) then
+               www=fup(ig,ilay)/(fup(ig,ilay+1)+dup(ig,ilay))
+            else
+               www=0.
+            endif
+            if (ilay == 1 ) then
+               tracu(ig,ilay)=trac(ig,ilay)
+            else
+               tracu(ig,ilay)=www*tracu(ig,ilay-1)+(1.-www)*trac(ig,ilay)
+            endif
+         endif
+      enddo 
+      enddo !fin boucle sur le downdraft
+
+   ! Calcul des flux des traceurs dans les updraft et les downdrfat 
+   ! et du flux de masse compensateur
+   ! en ilay=1 et nlay+1, fthu=0 et fthd=0
+   fthu(:,1)=0.
+   fthu(:,nlay+1)=0.
+   fthd(:,1)=0.
+   fthd(:,nlay+1)=0.
+   fc(:,1)=0.
+   fc(:,nlay+1)=0.
+   do ilay=2,nlay,1 !boucle sur les interfaces
+     do ig=1,ngrid
+       fthu(ig,ilay)=fup(ig,ilay)*tracu(ig,ilay-1)
+       fthd(ig,ilay)=-fdn(ig,ilay)*tracd(ig,ilay)
+       fc(ig,ilay)=fup(ig,ilay)-fdn(ig,ilay)
+     enddo
+   enddo
+   
+
+   !Boucle pour calculer le flux du traceur flux updraft, flux downdraft, flux compensatoire
+   !Methode explicite : 
+   if(iflag_impl==0) then
+     do ilay=2,nlay,1
+       do ig=1,ngrid
+         !!!!ATTENTION HYPOTHESE de FLUX COMPENSATOIRE DESCENDANT ET DONC comme schema amont on va chercher trac au dessus!!!!!
+         !!!! tentative de prise en compte d'un flux compensatoire montant  !!!!
+         if (fup(ig,ilay)-fdn(ig,ilay) .lt. 0.) then
+            call abort_physic("thermcell_updown_dq", 'flux compensatoire '&
+                 // 'montant, cas non traite par thermcell_updown_dq', 1)
+            !fthe(ig,ilay)=(fup(ig,ilay)-fdn(ig,ilay))*trac(ig,ilay-1)
+         else
+            fthe(ig,ilay)=-(fup(ig,ilay)-fdn(ig,ilay))*trac(ig,ilay)
+         endif
+         !! si on voulait le prendre en compte on
+         !fthe(ig,ilay)=-(fup(ig,ilay)-fdn(ig,ilay))*trac(ig,ilay-1)
+         fthtot(ig,ilay)=fthu(ig,ilay)+fthd(ig,ilay)+fthe(ig,ilay)
+       enddo
+     enddo
+     !Boucle pour calculer trac
+     do ilay=1,nlay
+       do ig=1,ngrid
+         dtrac(ig,ilay)=(fthtot(ig,ilay)-fthtot(ig,ilay+1))/masse(ig,ilay)
+!         trac(ig,ilay)=trac(ig,ilay) + (fthtot(ig,ilay)-fthtot(ig,ilay+1))*(ptimestep/masse(ig,ilay))
+       enddo
+     enddo !fin du calculer de la tendance du traceur avec la methode explicite
+
+   !!! Reecriture du schéma explicite avec les notations du schéma implicite
+   else if(iflag_impl==-1) then
+     write(*,*) 'nouveau schéma explicite !!!'
+     !!! Calcul de s1
+     do ilay=1,nlay
+       do ig=1,ngrid
+         s1(ig,ilay)=fthu(ig,ilay)-fthu(ig,ilay+1)+fthd(ig,ilay)-fthd(ig,ilay+1)
+         s2(ig,ilay)=s1(ig,ilay)+fthe(ig,ilay)-fthe(ig,ilay+1)
+       enddo
+     enddo
+
+     do ilay=2,nlay,1
+       do ig=1,ngrid
+         if (fup(ig,ilay)-fdn(ig,ilay) .lt. 0.) then
+            call abort_physic("thermcell_updown_dq", 'flux compensatoire ' &
+                 // 'montant, cas non traite par thermcell_updown_dq', 1)
+         else
+            fthe(ig,ilay)=-(fup(ig,ilay)-fdn(ig,ilay))*trac(ig,ilay)
+         endif
+         fthtot(ig,ilay)=fthu(ig,ilay)+fthd(ig,ilay)+fthe(ig,ilay)
+       enddo
+     enddo
+     !Boucle pour calculer trac
+     do ilay=1,nlay
+       do ig=1,ngrid
+         ! dtrac(ig,ilay)=(fthtot(ig,ilay)-fthtot(ig,ilay+1))/masse(ig,ilay)
+         dtrac(ig,ilay)=(s1(ig,ilay)+fthe(ig,ilay)-fthe(ig,ilay+1))/masse(ig,ilay)
+!         trac(ig,ilay)=trac(ig,ilay) + (fthtot(ig,ilay)-fthtot(ig,ilay+1))*(ptimestep/masse(ig,ilay))
+!         trac(ig,ilay)=trac(ig,ilay) + (s1(ig,ilay)+fthe(ig,ilay)-fthe(ig,ilay+1))*(ptimestep/masse(ig,ilay))
+       enddo
+     enddo !fin du calculer de la tendance du traceur avec la methode explicite
+
+   else if (iflag_impl==1) then
+     do ilay=1,nlay
+       do ig=1,ngrid
+         s1(ig,ilay)=fthu(ig,ilay)-fthu(ig,ilay+1)+fthd(ig,ilay)-fthd(ig,ilay+1)
+       enddo
+     enddo
+     
+     !Boucle pour calculer traci = trac((t+dt)
+     do ilay=nlay-1,1,-1
+       do ig=1,ngrid
+         if((fup(ig,ilay)-fdn(ig,ilay)) .lt. 0) then
+            write(*,*) 'flux compensatoire montant, cas non traite par thermcell_updown_dq dans le cas d une resolution implicite, ilay : ', ilay
+            call abort_physic("thermcell_updown_dq", "", 1)
+         else
+           mstar_inv=ptimestep/masse(ig,ilay)
+           traci(ig,ilay)=((traci(ig,ilay+1)*fc(ig,ilay+1)+s1(ig,ilay))*mstar_inv+tracold(ig,ilay))/(1.+fc(ig,ilay)*mstar_inv)
+         endif
+       enddo
+     enddo
+     do ilay=1,nlay
+       do ig=1,ngrid
+         dtrac(ig,ilay)=(traci(ig,ilay)-tracold(ig,ilay))/ptimestep
+       enddo
+     enddo
+
+   else
+      call abort_physic("thermcell_updown_dq", &
+           'valeur de iflag_impl non prevue', 1)
+   endif
+
+ RETURN
+   END
+
+!=========================================================================
+
+   SUBROUTINE thermcell_down(ngrid,nlay,po,pt,pu,pv,pplay,pplev,  &
+     &           lmax,fup,eup,dup,theta)
+
+!--------------------------------------------------------------
+!thermcell_down: calcul des propri??t??s du panache descendant.
+!--------------------------------------------------------------
+
+
+   USE lmdz_thermcell_ini, ONLY : prt_level,RLvCp,RKAPPA,RETV,fact_thermals_down
+   IMPLICIT NONE
+
+! arguments
+
+   integer,intent(in) :: ngrid,nlay
+   real,intent(in), dimension(ngrid,nlay) :: po,pt,pu,pv,pplay,eup,dup
+   real,intent(in), dimension(ngrid,nlay) :: theta
+   real,intent(in), dimension(ngrid,nlay+1) :: pplev,fup
+   integer, intent(in), dimension(ngrid) :: lmax
+
+
+   
+! Local
+
+   real, dimension(ngrid,nlay) :: edn,ddn,thetad
+   real, dimension(ngrid,nlay+1) :: fdn
+
+   integer ig,ilay
+   real dqsat_dT
+   logical mask(ngrid,nlay)
+
+   edn(:,:)=0.
+   ddn(:,:)=0.
+   fdn(:,:)=0.
+   thetad(:,:)=0.
+
+   ! lmax : indice tel que fu(kmax+1)=0
+   
+   ! Dans ce cas, pas besoin d'initialiser thetad(lmax) ( =theta(lmax) )
+
+! FH MODIFS APRES REUNIONS POUR COMMISSIONS
+! quelques erreurs de declaration
+! probleme si lmax=1 ce qui a l'air d'??tre le cas en d??but de simu. Devrait ??tre 0 ?
+! Remarques :
+! on pourrait ??crire la formule de thetad
+!    www=fdn(ig,ilay+1)/ (fdn(ig,ilay)+ddn(ig,ilay))
+!    thetad(ig,ilay)= www * thetad(ig,ilay+1) + (1.-www) * theta(ig,ilay) 
+! Elle a l'avantage de bien montr?? la conservation, l'id??e fondamentale dans le 
+!   transport qu'on ne fait que sommer des "sources" au travers d'un "propagateur"
+!   (Green)
+! Elle montre aussi beaucoup plus clairement pourquoi on n'a pas ?? se souccier (trop)
+!   de la possible nulit?? du d??nominateur
+
+
+   do ilay=nlay,1,-1
+      do ig=1,ngrid
+         if (ilay.le.lmax(ig).and.lmax(ig)>1) then
+            edn(ig,ilay)=fact_thermals_down*dup(ig,ilay)
+            ddn(ig,ilay)=fact_thermals_down*eup(ig,ilay)
+            fdn(ig,ilay)=fdn(ig,ilay+1)+edn(ig,ilay)-ddn(ig,ilay)
+            thetad(ig,ilay)=( fdn(ig,ilay+1)*thetad(ig,ilay+1) + edn(ig,ilay)*theta(ig,ilay) ) / (fdn(ig,ilay)+ddn(ig,ilay))
+         endif
+      enddo 
+   enddo
+
+   ! Suite du travail :
+   ! Ecrire la conservervation de theta_l dans le panache descendant
+   ! Eventuellement faire la transformation theta_l -> theta_v
+   ! Si l'air est sec (et qu'on oublie le c??t?? theta_v) on peut
+   ! se contenter de conserver theta.
+   !
+   ! Connaissant thetadn, on peut calculer la flotabilit??.
+   ! Connaissant la flotabilit??, on peut calculer w de proche en proche
+   ! On peut calculer le detrainement de facon ?? garder alpha*rho = cste
+   ! On en d??duit l'entrainement lat??ral
+   ! C'est le mod??le des mini-projets.
+
+!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+! Initialisations :
+!------------------
+
+
+!
+ RETURN
+   END
+END MODULE lmdz_thermcell_down
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_dq.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_dq.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_dq.F90	(revision 4727)
@@ -0,0 +1,331 @@
+MODULE lmdz_thermcell_dq
+CONTAINS
+
+      subroutine thermcell_dq(ngrid,nlay,impl,ptimestep,fm,entr,  &
+     &           masse,q,dq,qa,lev_out)
+      USE print_control_mod, ONLY: prt_level
+
+      implicit none
+
+!=======================================================================
+!
+!   Calcul du transport verticale dans la couche limite en presence
+!   de "thermiques" explicitement representes
+!   calcul du dq/dt une fois qu'on connait les ascendances
+!
+! Modif 2013/01/04 (FH hourdin@lmd.jussieu.fr)
+!  Introduction of an implicit computation of vertical advection in
+!  the environment of thermal plumes in thermcell_dq
+!  impl =     0 : explicit, 1 : implicit, -1 : old version
+!
+!=======================================================================
+
+! arguments
+      integer, intent(in) :: ngrid,nlay,impl
+      real, intent(in) :: ptimestep
+      real, intent(in), dimension(ngrid,nlay) :: masse
+      real, intent(inout), dimension(ngrid,nlay) :: entr,q
+      real, intent(in), dimension(ngrid,nlay+1) :: fm
+      real, intent(out), dimension(ngrid,nlay) :: dq,qa
+      integer, intent(in) :: lev_out                           ! niveau pour les print
+
+! Local
+      real, dimension(ngrid,nlay) :: detr,qold
+      real, dimension(ngrid,nlay+1) :: wqd,fqa
+      real zzm
+      integer ig,k
+      real cfl
+
+      integer niter,iter
+      CHARACTER (LEN=20) :: modname='thermcell_dq'
+      CHARACTER (LEN=80) :: abort_message
+
+
+! Old explicite scheme
+if (impl<=-1) then
+
+         call thermcell_dq_o(ngrid,nlay,impl,ptimestep,fm,entr,  &
+     &           masse,q,dq,qa,lev_out)
+
+else
+  
+
+! Calcul du critere CFL pour l'advection dans la subsidence
+      cfl = 0.
+      do k=1,nlay
+         do ig=1,ngrid
+            zzm=masse(ig,k)/ptimestep
+            cfl=max(cfl,fm(ig,k)/zzm)
+            if (entr(ig,k).gt.zzm) then
+               print*,'entr*dt>m,1',k,entr(ig,k)*ptimestep,masse(ig,k)
+               abort_message = 'entr dt > m, 1st'
+               CALL abort_physic (modname,abort_message,1)
+            endif
+         enddo
+      enddo
+
+      qold=q
+
+
+      if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0'
+
+!   calcul du detrainement
+      do k=1,nlay
+         do ig=1,ngrid
+            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
+!           print*,'Q2 DQ ',detr(ig,k),fm(ig,k),entr(ig,k)
+!test
+            if (detr(ig,k).lt.0.) then
+               entr(ig,k)=entr(ig,k)-detr(ig,k)
+               detr(ig,k)=0.
+!               print*,'detr2<0!!!','ig=',ig,'k=',k,'f=',fm(ig,k),
+!     s         'f+1=',fm(ig,k+1),'e=',entr(ig,k),'d=',detr(ig,k)
+            endif
+            if (fm(ig,k+1).lt.0.) then
+!               print*,'fm2<0!!!'
+            endif
+            if (entr(ig,k).lt.0.) then
+!               print*,'entr2<0!!!'
+            endif
+         enddo
+      enddo
+
+! Computation of tracer concentrations in the ascending plume
+      do ig=1,ngrid
+         qa(ig,1)=q(ig,1)
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
+     &         1.e-5*masse(ig,k)) then
+         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
+     &         /(fm(ig,k+1)+detr(ig,k))
+            else
+               qa(ig,k)=q(ig,k)
+            endif
+            if (qa(ig,k).lt.0.) then
+!               print*,'qa<0!!!'
+            endif
+            if (q(ig,k).lt.0.) then
+!               print*,'q<0!!!'
+            endif
+         enddo
+      enddo
+
+! Plume vertical flux
+      do k=2,nlay-1
+         fqa(:,k)=fm(:,k)*qa(:,k-1)
+      enddo
+      fqa(:,1)=0. ; fqa(:,nlay)=0.
+
+
+! Trace species evolution
+   if (impl==0) then
+      do k=1,nlay-1
+         q(:,k)=q(:,k)+(fqa(:,k)-fqa(:,k+1)-fm(:,k)*q(:,k)+fm(:,k+1)*q(:,k+1)) &
+     &               *ptimestep/masse(:,k)
+      enddo
+   else
+      do k=nlay-1,1,-1
+! FH debut de modif : le calcul ci dessous modifiait numériquement
+! la concentration quand le flux de masse etait nul car on divisait
+! puis multipliait par masse/ptimestep.
+!        q(:,k)=(masse(:,k)*q(:,k)/ptimestep+fqa(:,k)-fqa(:,k+1)+fm(:,k+1)*q(:,k+1)) &
+!    &               /(fm(:,k)+masse(:,k)/ptimestep)
+         q(:,k)=(q(:,k)+ptimestep/masse(:,k)*(fqa(:,k)-fqa(:,k+1)+fm(:,k+1)*q(:,k+1))) &
+      &               /(1.+fm(:,k)*ptimestep/masse(:,k))
+! FH fin de modif.
+      enddo
+   endif
+
+! Tendencies
+      do k=1,nlay
+         do ig=1,ngrid
+            dq(ig,k)=(q(ig,k)-qold(ig,k))/ptimestep
+            q(ig,k)=qold(ig,k)
+         enddo
+      enddo
+
+endif ! impl=-1
+RETURN
+end
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Obsolete version kept for convergence with Cmip5 NPv3.1 simulations
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      subroutine thermcell_dq_o(ngrid,nlay,impl,ptimestep,fm,entr,  &
+     &           masse,q,dq,qa,lev_out)
+      USE print_control_mod, ONLY: prt_level
+      implicit none
+
+!=======================================================================
+!
+!   Calcul du transport verticale dans la couche limite en presence
+!   de "thermiques" explicitement representes
+!   calcul du dq/dt une fois qu'on connait les ascendances
+!
+!=======================================================================
+
+      integer ngrid,nlay,impl
+
+      real ptimestep
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real entr(ngrid,nlay)
+      real q(ngrid,nlay)
+      real dq(ngrid,nlay)
+      integer lev_out                           ! niveau pour les print
+
+      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
+
+      real zzm
+
+      integer ig,k
+      real cfl
+
+      real qold(ngrid,nlay)
+      real ztimestep
+      integer niter,iter
+      CHARACTER (LEN=20) :: modname='thermcell_dq'
+      CHARACTER (LEN=80) :: abort_message
+
+
+
+! Calcul du critere CFL pour l'advection dans la subsidence
+      cfl = 0.
+      do k=1,nlay
+         do ig=1,ngrid
+            zzm=masse(ig,k)/ptimestep
+            cfl=max(cfl,fm(ig,k)/zzm)
+            if (entr(ig,k).gt.zzm) then
+               print*,'entr*dt>m,2',k,entr(ig,k)*ptimestep,masse(ig,k)
+               abort_message = 'entr dt > m, 2nd'
+               CALL abort_physic (modname,abort_message,1)
+            endif
+         enddo
+      enddo
+
+!IM 090508     print*,'CFL CFL CFL CFL ',cfl
+
+#undef CFL
+#ifdef CFL
+! On subdivise le calcul en niter pas de temps.
+      niter=int(cfl)+1
+#else
+      niter=1
+#endif
+
+      ztimestep=ptimestep/niter
+      qold=q
+
+
+do iter=1,niter
+      if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0'
+
+!   calcul du detrainement
+      do k=1,nlay
+         do ig=1,ngrid
+            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
+!           print*,'Q2 DQ ',detr(ig,k),fm(ig,k),entr(ig,k)
+!test
+            if (detr(ig,k).lt.0.) then
+               entr(ig,k)=entr(ig,k)-detr(ig,k)
+               detr(ig,k)=0.
+!               print*,'detr2<0!!!','ig=',ig,'k=',k,'f=',fm(ig,k),
+!     s         'f+1=',fm(ig,k+1),'e=',entr(ig,k),'d=',detr(ig,k)
+            endif
+            if (fm(ig,k+1).lt.0.) then
+!               print*,'fm2<0!!!'
+            endif
+            if (entr(ig,k).lt.0.) then
+!               print*,'entr2<0!!!'
+            endif
+         enddo
+      enddo
+
+!   calcul de la valeur dans les ascendances
+      do ig=1,ngrid
+         qa(ig,1)=q(ig,1)
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ztimestep.gt.  &
+     &         1.e-5*masse(ig,k)) then
+         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
+     &         /(fm(ig,k+1)+detr(ig,k))
+            else
+               qa(ig,k)=q(ig,k)
+            endif
+            if (qa(ig,k).lt.0.) then
+!               print*,'qa<0!!!'
+            endif
+            if (q(ig,k).lt.0.) then
+!               print*,'q<0!!!'
+            endif
+         enddo
+      enddo
+
+! Calcul du flux subsident
+
+      do k=2,nlay
+         do ig=1,ngrid
+#undef centre
+#ifdef centre
+             wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
+#else
+
+#define plusqueun
+#ifdef plusqueun
+! Schema avec advection sur plus qu'une maille.
+            zzm=masse(ig,k)/ztimestep
+            if (fm(ig,k)>zzm) then
+               wqd(ig,k)=zzm*q(ig,k)+(fm(ig,k)-zzm)*q(ig,k+1)
+            else
+               wqd(ig,k)=fm(ig,k)*q(ig,k)
+            endif
+#else
+            wqd(ig,k)=fm(ig,k)*q(ig,k)
+#endif
+#endif
+
+            if (wqd(ig,k).lt.0.) then
+!               print*,'wqd<0!!!'
+            endif
+         enddo
+      enddo
+      do ig=1,ngrid
+         wqd(ig,1)=0.
+         wqd(ig,nlay+1)=0.
+      enddo
+     
+
+! Calcul des tendances
+      do k=1,nlay
+         do ig=1,ngrid
+            q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)  &
+     &               -wqd(ig,k)+wqd(ig,k+1))  &
+     &               *ztimestep/masse(ig,k)
+!            if (dq(ig,k).lt.0.) then
+!               print*,'dq<0!!!'
+!            endif
+         enddo
+      enddo
+
+
+enddo
+
+
+! Calcul des tendances
+      do k=1,nlay
+         do ig=1,ngrid
+            dq(ig,k)=(q(ig,k)-qold(ig,k))/ptimestep
+            q(ig,k)=qold(ig,k)
+         enddo
+      enddo
+
+      return
+      end
+END MODULE lmdz_thermcell_dq
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_dry.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_dry.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_dry.F90	(revision 4727)
@@ -0,0 +1,169 @@
+MODULE lmdz_thermcell_dry
+!
+! $Id$
+!
+CONTAINS
+
+       SUBROUTINE thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star,  &
+     &                            lalim,lmin,zmax,wmax)
+
+!--------------------------------------------------------------------------
+!thermcell_dry: calcul de zmax et wmax du thermique sec
+! Calcul de la vitesse maximum et de la hauteur maximum pour un panache
+! ascendant avec une fonction d'alimentation alim_star et sans changement 
+! de phase.
+! Le calcul pourrait etre sans doute simplifier.
+! La temperature potentielle virtuelle dans la panache ascendant est
+! la temperature potentielle virtuelle pondÃ©rÃ©e par alim_star.
+!--------------------------------------------------------------------------
+       USE lmdz_thermcell_ini, ONLY: prt_level, RG
+       IMPLICIT NONE
+
+       integer, intent(in) :: ngrid,nlay
+       real, intent(in), dimension(ngrid,nlay+1) :: zlev,pphi,ztv,alim_star
+       integer, intent(in), dimension(ngrid) :: lalim
+       real, intent(out), dimension(ngrid) :: zmax,wmax
+
+!variables locales
+       REAL zw2(ngrid,nlay+1)
+       REAL f_star(ngrid,nlay+1)
+       REAL ztva(ngrid,nlay+1)
+       REAL wmaxa(ngrid)
+       REAL wa_moy(ngrid,nlay+1)
+       REAL linter(ngrid),zlevinter(ngrid)
+       INTEGER lmix(ngrid),lmax(ngrid),lmin(ngrid)
+      CHARACTER (LEN=20) :: modname='thermcell_dry'
+      CHARACTER (LEN=80) :: abort_message
+       INTEGER l,ig
+
+!initialisations
+       do ig=1,ngrid
+          do l=1,nlay+1
+             zw2(ig,l)=0.
+             wa_moy(ig,l)=0.
+          enddo
+       enddo
+       do ig=1,ngrid
+          do l=1,nlay
+             ztva(ig,l)=ztv(ig,l)
+          enddo
+       enddo
+       do ig=1,ngrid
+          wmax(ig)=0.
+          wmaxa(ig)=0.
+       enddo
+!calcul de la vitesse a partir de la CAPE en melangeant thetav
+
+
+! Calcul des F^*, integrale verticale de E^*
+       f_star(:,1)=0.
+       do l=1,nlay
+          f_star(:,l+1)=f_star(:,l)+alim_star(:,l)
+       enddo
+
+! niveau (reel) auquel zw2 s'annule FH :n'etait pas initialise
+       linter(:)=0.
+
+! couche la plus haute concernee par le thermique. 
+       lmax(:)=1
+
+! Le niveau linter est une variable continue qui se trouve dans la couche
+! lmax
+
+       do l=1,nlay-2
+         do ig=1,ngrid
+            if (l.eq.lmin(ig).and.lalim(ig).gt.1) then
+
+!------------------------------------------------------------------------
+!  Calcul de la vitesse en haut de la premiere couche instable.
+!  Premiere couche du panache thermique
+!------------------------------------------------------------------------
+
+               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)  &
+     &                     *(zlev(ig,l+1)-zlev(ig,l))  &
+     &                     *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l))
+
+!------------------------------------------------------------------------
+! Tant que la vitesse en bas de la couche et la somme du flux de masse
+! et de l'entrainement (c'est a dire le flux de masse en haut) sont
+! positifs, on calcul
+! 1. le flux de masse en haut  f_star(ig,l+1)
+! 2. la temperature potentielle virtuelle dans la couche ztva(ig,l)
+! 3. la vitesse au carré en haut zw2(ig,l+1)
+!------------------------------------------------------------------------
+
+            else if (zw2(ig,l).ge.1e-10) then
+
+               ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+alim_star(ig,l)  &
+     &                    *ztv(ig,l))/f_star(ig,l+1)
+               zw2(ig,l+1)=zw2(ig,l)*(f_star(ig,l)/f_star(ig,l+1))**2+  &
+     &                     2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
+     &                     *(zlev(ig,l+1)-zlev(ig,l))
+            endif
+! determination de zmax continu par interpolation lineaire
+!------------------------------------------------------------------------
+
+            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
+!               stop'On tombe sur le cas particulier de thermcell_dry'
+!               print*,'On tombe sur le cas particulier de thermcell_dry'
+                zw2(ig,l+1)=0.
+                linter(ig)=l+1
+                lmax(ig)=l
+            endif
+
+            if (zw2(ig,l+1).lt.0.) then
+               linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
+     &           -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
+               zw2(ig,l+1)=0.
+               lmax(ig)=l
+!            endif
+!CR:zmax continu 06/05/12: calcul de linter quand le thermique est stoppe par le detrainement
+            elseif (f_star(ig,l+1).lt.0.) then
+               linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
+     &           -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
+               zw2(ig,l+1)=0.
+               lmax(ig)=l
+            endif
+!CRfin
+               wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))
+
+            if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
+!   lmix est le niveau de la couche ou w (wa_moy) est maximum
+               lmix(ig)=l+1
+               wmaxa(ig)=wa_moy(ig,l+1)
+            endif
+         enddo
+      enddo
+       if (prt_level.ge.1) print*,'fin calcul zw2'
+!
+! Determination de zw2 max
+      do ig=1,ngrid
+         wmax(ig)=0.
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if (l.le.lmax(ig)) then
+                zw2(ig,l)=sqrt(zw2(ig,l))
+                wmax(ig)=max(wmax(ig),zw2(ig,l))
+            else
+                 zw2(ig,l)=0.
+            endif
+          enddo
+      enddo
+
+!   Longueur caracteristique correspondant a la hauteur des thermiques.
+      do  ig=1,ngrid
+         zmax(ig)=0.
+         zlevinter(ig)=zlev(ig,1)
+      enddo
+      do  ig=1,ngrid
+! calcul de zlevinter
+          zlevinter(ig)=zlev(ig,lmax(ig)) + &
+     &    (linter(ig)-lmax(ig))*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
+           zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
+      enddo
+
+ RETURN
+      END
+END MODULE lmdz_thermcell_dry
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_dtke.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_dtke.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_dtke.F90	(revision 4727)
@@ -0,0 +1,127 @@
+MODULE lmdz_thermcell_dtke
+CONTAINS
+
+      subroutine thermcell_dtke(ngrid,nlay,nsrf,ptimestep,fm0,entr0,  &
+     &           rg,pplev,tke)
+      USE print_control_mod, ONLY: prt_level
+      implicit none
+
+!=======================================================================
+!
+!   Calcul du transport verticale dans la couche limite en presence
+!   de "thermiques" explicitement representes
+!   calcul du dq/dt une fois qu'on connait les ascendances
+!
+!=======================================================================
+
+      integer ngrid,nlay,nsrf
+
+      real ptimestep
+      real masse0(ngrid,nlay),fm0(ngrid,nlay+1),pplev(ngrid,nlay+1)
+      real entr0(ngrid,nlay),rg
+      real tke(ngrid,nlay,nsrf)
+      real detr0(ngrid,nlay)
+
+
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real entr(ngrid,nlay)
+      real q(ngrid,nlay)
+      integer lev_out                           ! niveau pour les print
+
+      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
+
+      real zzm
+
+      integer ig,k
+      integer isrf
+
+
+      lev_out=0
+
+
+      if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0'
+
+!   calcul du detrainement
+      do k=1,nlay
+         detr0(:,k)=fm0(:,k)-fm0(:,k+1)+entr0(:,k)
+         masse0(:,k)=(pplev(:,k)-pplev(:,k+1))/RG
+      enddo
+
+
+! Decalage vertical des entrainements et detrainements.
+      masse(:,1)=0.5*masse0(:,1)
+      entr(:,1)=0.5*entr0(:,1)
+      detr(:,1)=0.5*detr0(:,1)
+      fm(:,1)=0.
+      do k=1,nlay-1
+         masse(:,k+1)=0.5*(masse0(:,k)+masse0(:,k+1))
+         entr(:,k+1)=0.5*(entr0(:,k)+entr0(:,k+1))
+         detr(:,k+1)=0.5*(detr0(:,k)+detr0(:,k+1))
+         fm(:,k+1)=fm(:,k)+entr(:,k)-detr(:,k)
+      enddo
+      fm(:,nlay+1)=0.
+
+!   calcul de la valeur dans les ascendances
+      do ig=1,ngrid
+         qa(ig,1)=q(ig,1)
+      enddo
+
+
+
+do isrf=1,nsrf
+
+   q(:,:)=tke(:,:,isrf)
+
+    if (1==1) then
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
+     &         1.e-5*masse(ig,k)) then
+         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
+     &         /(fm(ig,k+1)+detr(ig,k))
+            else
+               qa(ig,k)=q(ig,k)
+            endif
+            if (qa(ig,k).lt.0.) then
+!               print*,'qa<0!!!'
+            endif
+            if (q(ig,k).lt.0.) then
+!               print*,'q<0!!!'
+            endif
+         enddo
+      enddo
+
+! Calcul du flux subsident
+
+      do k=2,nlay
+         do ig=1,ngrid
+            wqd(ig,k)=fm(ig,k)*q(ig,k)
+            if (wqd(ig,k).lt.0.) then
+!               print*,'wqd<0!!!'
+            endif
+         enddo
+      enddo
+      do ig=1,ngrid
+         wqd(ig,1)=0.
+         wqd(ig,nlay+1)=0.
+      enddo
+     
+
+! Calcul des tendances
+      do k=1,nlay
+         do ig=1,ngrid
+            q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)  &
+     &               -wqd(ig,k)+wqd(ig,k+1))  &
+     &               *ptimestep/masse(ig,k)
+         enddo
+      enddo
+
+ endif
+
+   tke(:,:,isrf)=q(:,:)
+
+enddo
+
+      return
+      end
+END MODULE lmdz_thermcell_dtke
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_dv2.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_dv2.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_dv2.F90	(revision 4727)
@@ -0,0 +1,197 @@
+MODULE lmdz_thermcell_dv2
+CONTAINS
+
+      subroutine thermcell_dv2(ngrid,nlay,ptimestep,fm,entr,masse  &
+     &    ,fraca,larga  &
+     &    ,u,v,du,dv,ua,va,lev_out)
+      USE print_control_mod, ONLY: prt_level,lunout
+      implicit none
+
+!=======================================================================
+!
+!   Calcul du transport verticale dans la couche limite en presence
+!   de "thermiques" explicitement representes
+!   calcul du dq/dt une fois qu'on connait les ascendances
+!
+! Vectorisation, FH : 2010/03/08
+!
+!=======================================================================
+
+
+      integer ngrid,nlay
+
+      real ptimestep
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real fraca(ngrid,nlay+1)
+      real larga(ngrid)
+      real entr(ngrid,nlay)
+      real u(ngrid,nlay)
+      real ua(ngrid,nlay)
+      real du(ngrid,nlay)
+      real v(ngrid,nlay)
+      real va(ngrid,nlay)
+      real dv(ngrid,nlay)
+      integer lev_out                           ! niveau pour les print
+
+      real qa(ngrid,nlay),detr(ngrid,nlay),zf,zf2
+      real wvd(ngrid,nlay+1),wud(ngrid,nlay+1)
+      real gamma0(ngrid,nlay+1),gamma(ngrid,nlay+1)
+      real ue(ngrid,nlay),ve(ngrid,nlay)
+      LOGICAL ltherm(ngrid,nlay)
+      real dua(ngrid,nlay),dva(ngrid,nlay)
+      integer iter
+
+      integer ig,k,nlarga0
+
+!-------------------------------------------------------------------------
+
+!   calcul du detrainement
+!---------------------------
+
+!      print*,'THERMCELL DV2 OPTIMISE 3'
+
+      nlarga0=0.
+
+      do k=1,nlay
+         do ig=1,ngrid
+            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
+         enddo
+      enddo
+
+!   calcul de la valeur dans les ascendances
+      do ig=1,ngrid
+         ua(ig,1)=u(ig,1)
+         va(ig,1)=v(ig,1)
+         ue(ig,1)=u(ig,1)
+         ve(ig,1)=v(ig,1)
+      enddo
+
+      IF(prt_level>9)WRITE(lunout,*)                                    &
+     &      'WARNING on initialise gamma(1:ngrid,1)=0.'
+      gamma(1:ngrid,1)=0.
+      do k=2,nlay
+         do ig=1,ngrid
+            ltherm(ig,k)=(fm(ig,k+1)+detr(ig,k))*ptimestep > 1.e-5*masse(ig,k)
+            if(ltherm(ig,k).and.larga(ig)>0.) then
+               gamma0(ig,k)=masse(ig,k)  &
+     &         *sqrt( 0.5*(fraca(ig,k+1)+fraca(ig,k)) )  &
+     &         *0.5/larga(ig)  &
+     &         *1.
+            else
+               gamma0(ig,k)=0.
+            endif
+            if (ltherm(ig,k).and.larga(ig)<=0.) nlarga0=nlarga0+1
+         enddo
+      enddo
+
+      gamma(:,:)=0.
+
+      do k=2,nlay
+
+         do ig=1,ngrid
+            if (ltherm(ig,k)) then
+               dua(ig,k)=ua(ig,k-1)-u(ig,k-1)
+               dva(ig,k)=va(ig,k-1)-v(ig,k-1)
+            else
+               ua(ig,k)=u(ig,k)
+               va(ig,k)=v(ig,k)
+               ue(ig,k)=u(ig,k)
+               ve(ig,k)=v(ig,k)
+            endif
+         enddo
+
+
+! Debut des iterations
+!----------------------
+do iter=1,5
+         do ig=1,ngrid
+! Pour memoire : calcul prenant en compte la fraction reelle
+!              zf=0.5*(fraca(ig,k)+fraca(ig,k+1))
+!              zf2=1./(1.-zf)
+! Calcul avec fraction infiniement petite
+               zf=0.
+               zf2=1.
+
+!  la première fois on multiplie le coefficient de freinage
+!  par le module du vent dans la couche en dessous.
+!  Mais pourquoi donc ???
+               if (ltherm(ig,k)) then
+!   On choisit une relaxation lineaire.
+!                 gamma(ig,k)=gamma0(ig,k)
+!   On choisit une relaxation quadratique.
+                  gamma(ig,k)=gamma0(ig,k)*sqrt(dua(ig,k)**2+dva(ig,k)**2)
+                  ua(ig,k)=(fm(ig,k)*ua(ig,k-1)  &
+     &               +(zf2*entr(ig,k)+gamma(ig,k))*u(ig,k))  &
+     &               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2  &
+     &                 +gamma(ig,k))
+                  va(ig,k)=(fm(ig,k)*va(ig,k-1)  &
+     &               +(zf2*entr(ig,k)+gamma(ig,k))*v(ig,k))  &
+     &               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2  &
+     &                 +gamma(ig,k))
+!                 print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua(ig,k),dva(ig,k)
+                  dua(ig,k)=ua(ig,k)-u(ig,k)
+                  dva(ig,k)=va(ig,k)-v(ig,k)
+                  ue(ig,k)=(u(ig,k)-zf*ua(ig,k))*zf2
+                  ve(ig,k)=(v(ig,k)-zf*va(ig,k))*zf2
+               endif
+         enddo
+! Fin des iterations
+!--------------------
+enddo
+
+      enddo ! k=2,nlay
+
+
+! Calcul du flux vertical de moment dans l'environnement.
+!---------------------------------------------------------
+      do k=2,nlay
+         do ig=1,ngrid
+            wud(ig,k)=fm(ig,k)*ue(ig,k)
+            wvd(ig,k)=fm(ig,k)*ve(ig,k)
+         enddo
+      enddo
+      do ig=1,ngrid
+         wud(ig,1)=0.
+         wud(ig,nlay+1)=0.
+         wvd(ig,1)=0.
+         wvd(ig,nlay+1)=0.
+      enddo
+
+! calcul des tendances.
+!-----------------------
+      do k=1,nlay
+         do ig=1,ngrid
+            du(ig,k)=((detr(ig,k)+gamma(ig,k))*ua(ig,k)  &
+     &               -(entr(ig,k)+gamma(ig,k))*ue(ig,k)  &
+     &               -wud(ig,k)+wud(ig,k+1))  &
+     &               /masse(ig,k)
+            dv(ig,k)=((detr(ig,k)+gamma(ig,k))*va(ig,k)  &
+     &               -(entr(ig,k)+gamma(ig,k))*ve(ig,k)  &
+     &               -wvd(ig,k)+wvd(ig,k+1))  &
+     &               /masse(ig,k)
+         enddo
+      enddo
+
+
+! Sorties eventuelles.
+!----------------------
+
+   if(prt_level.GE.10) then
+      do k=1,nlay
+         do ig=1,ngrid
+           print*,'th_dv2 ig k gamma entr detr ua ue va ve wud wvd masse',ig,k,gamma(ig,k), &
+     &   entr(ig,k),detr(ig,k),ua(ig,k),ue(ig,k),va(ig,k),ve(ig,k),wud(ig,k),wvd(ig,k),wud(ig,k+1),wvd(ig,k+1), &
+     &   masse(ig,k)
+         enddo
+      enddo
+   endif
+!
+     if (nlarga0>0) then
+          print*,'WARNING !!!!!! DANS THERMCELL_DV2 '
+          print*,nlarga0,' points pour lesquels laraga=0. dans un thermique'
+          print*,'Il faudrait decortiquer ces points'
+     endif
+
+      return
+      end
+END MODULE lmdz_thermcell_dv2
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_env.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_env.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_env.F90	(revision 4727)
@@ -0,0 +1,83 @@
+MODULE lmdz_thermcell_env
+CONTAINS
+
+   SUBROUTINE thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
+     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,pqsat,lev_out)
+
+!--------------------------------------------------------------
+!thermcell_env: calcule les caracteristiques de l environnement
+!necessaires au calcul des proprietes dans le thermique
+!--------------------------------------------------------------
+
+
+   USE lmdz_thermcell_ini, ONLY : prt_level,RLvCp,RKAPPA,RETV
+   USE lmdz_thermcell_qsat, ONLY : thermcell_qsat
+   IMPLICIT NONE
+
+! arguments
+
+   integer,intent(in) :: ngrid,nlay,lev_out
+   real,intent(in), dimension(ngrid,nlay) :: po,pt,pu,pv,pplay
+   real,intent(in), dimension(ngrid,nlay+1) :: pplev
+   real,intent(out), dimension(ngrid,nlay) :: zo,zl,zh,ztv,zthl
+   real,intent(out), dimension(ngrid,nlay) :: zpspsk,zu,zv,pqsat
+   
+! Local
+
+   integer ig,ll
+   real dqsat_dT
+   logical mask(ngrid,nlay)
+
+
+!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+! Initialisations :
+!------------------
+
+   mask(:,:)=.true.
+
+!
+! calcul des caracteristiques de l environnement
+   DO  ll=1,nlay
+     DO ig=1,ngrid
+        zo(ig,ll)=po(ig,ll)
+        zl(ig,ll)=0.
+        zh(ig,ll)=pt(ig,ll)
+     enddo
+   enddo
+
+! Condensation :
+!---------------
+! Calcul de l'humidite a saturation et de la condensation
+
+   call thermcell_qsat(ngrid*nlay,mask,pplev,pt,po,pqsat)
+   do ll=1,nlay
+      do ig=1,ngrid
+         zl(ig,ll) = max(0.,po(ig,ll)-pqsat(ig,ll))
+         zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)         !   T = Tl + Lv/Cp ql
+         zo(ig,ll) = po(ig,ll)-zl(ig,ll)
+      enddo
+   enddo
+
+!-----------------------------------------------------------------------
+   if (prt_level.ge.1) print*,'0 OK convect8'
+
+   do ll=1,nlay
+      do ig=1,ngrid
+          zpspsk(ig,ll)=(pplay(ig,ll)/100000.)**RKAPPA
+          zu(ig,ll)=pu(ig,ll)
+          zv(ig,ll)=pv(ig,ll)
+!attention zh est maintenant le profil de T et plus le profil de theta !
+! Quelle horreur ! A eviter.
+!   T-> Theta
+            ztv(ig,ll)=zh(ig,ll)/zpspsk(ig,ll)
+!Theta_v
+            ztv(ig,ll)=ztv(ig,ll)*(1.+RETV*(zo(ig,ll))-zl(ig,ll))
+!Thetal
+            zthl(ig,ll)=pt(ig,ll)/zpspsk(ig,ll)
+!            
+      enddo
+   enddo
+ 
+ RETURN
+   END
+END MODULE lmdz_thermcell_env
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_flux2.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_flux2.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_flux2.F90	(revision 4727)
@@ -0,0 +1,515 @@
+MODULE lmdz_thermcell_flux2
+!
+! $Id$
+!
+CONTAINS
+
+      SUBROUTINE thermcell_flux2(ngrid,nlay,ptimestep,masse, &
+     &       lalim,lmax,alim_star,  &
+     &       entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr,  &
+     &       detr,zqla,lev_out,lunout1,igout)
+!IM 060508    &       detr,zqla,zmax,lev_out,lunout,igout)
+
+
+!---------------------------------------------------------------------------
+!thermcell_flux: deduction des flux
+!---------------------------------------------------------------------------
+
+      USE lmdz_thermcell_ini, ONLY : prt_level,iflag_thermals_optflux
+      IMPLICIT NONE
+      
+! arguments
+      INTEGER, intent(in) :: ngrid,nlay
+      REAL, intent(in) :: ptimestep
+      REAL, intent(in), dimension(ngrid,nlay) :: masse
+      INTEGER, intent(in), dimension(ngrid) :: lalim,lmax
+      REAL, intent(in), dimension(ngrid,nlay) :: alim_star,entr_star,detr_star
+      REAL, intent(in), dimension(ngrid) :: f
+      REAL, intent(in), dimension(ngrid,nlay) :: rhobarz
+      REAL, intent(in), dimension(ngrid,nlay+1) :: zw2,zlev
+! FH : laisser ca le temps de verifier qu'on a bien fait de commenter les
+!      lignes faisant apparaitre zqla, zmax ...
+!     REAL, intent(in), dimension(ngrid) :: zmax(ngrid)
+!     enlever aussi zqla
+      REAL, intent(in), dimension(ngrid,nlay) :: zqla  ! not used
+      integer, intent(in) :: lev_out, lunout1
+
+      REAL,intent(out), dimension(ngrid,nlay) :: entr,detr
+      REAL,intent(out), dimension(ngrid,nlay+1) :: fm
+
+! local
+      INTEGER ig,l
+      integer igout,lout
+      REAL zfm
+      integer ncorecfm1,ncorecfm2,ncorecfm3,ncorecalpha
+      integer ncorecfm4,ncorecfm5,ncorecfm6,ncorecfm7,ncorecfm8
+      
+
+      REAL f_old,ddd0,eee0,ddd,eee,zzz
+
+      REAL,SAVE :: fomass_max=0.5
+      REAL,SAVE :: alphamax=0.7
+!$OMP THREADPRIVATE(fomass_max,alphamax)
+
+      logical check_debug,labort_physic
+
+      character (len=20) :: modname='thermcell_flux2'
+      character (len=80) :: abort_message
+
+
+      ncorecfm1=0
+      ncorecfm2=0
+      ncorecfm3=0
+      ncorecfm4=0
+      ncorecfm5=0
+      ncorecfm6=0
+      ncorecfm7=0
+      ncorecfm8=0
+      ncorecalpha=0
+
+!initialisation
+      fm(:,:)=0.
+      
+      if (prt_level.ge.10) then
+         write(lunout1,*) 'Dans thermcell_flux 0'
+         write(lunout1,*) 'flux base ',f(igout)
+         write(lunout1,*) 'lmax ',lmax(igout)
+         write(lunout1,*) 'lalim ',lalim(igout)
+         write(lunout1,*) 'ig= ',igout
+         write(lunout1,*) ' l E*    A*     D*  '
+         write(lunout1,'(i4,3e15.5)') (l,entr_star(igout,l),alim_star(igout,l),detr_star(igout,l) &
+     &    ,l=1,lmax(igout))
+      endif
+
+
+!-------------------------------------------------------------------------
+! Verification de la nullite des entrainement et detrainement au dessus
+! de lmax(ig)
+! Active uniquement si check_debug=.true. ou prt_level>=10
+!-------------------------------------------------------------------------
+
+      check_debug=.false..or.prt_level>=10
+
+      if (check_debug) then
+      do l=1,nlay
+         do ig=1,ngrid
+            if (l.le.lmax(ig)) then
+               if (entr_star(ig,l).gt.1.) then
+                    print*,'WARNING thermcell_flux 1 ig,l,lmax(ig)',ig,l,lmax(ig)
+                    print*,'entr_star(ig,l)',entr_star(ig,l)
+                    print*,'alim_star(ig,l)',alim_star(ig,l)
+                    print*,'detr_star(ig,l)',detr_star(ig,l)
+               endif
+            else
+               if (abs(entr_star(ig,l))+abs(alim_star(ig,l))+abs(detr_star(ig,l)).gt.0.) then
+                    print*,'cas 1 : ig,l,lmax(ig)',ig,l,lmax(ig)
+                    print*,'entr_star(ig,l)',entr_star(ig,l)
+                    print*,'alim_star(ig,l)',alim_star(ig,l)
+                    print*,'detr_star(ig,l)',detr_star(ig,l)
+                    abort_message = ''
+                    labort_physic=.true.
+                    CALL abort_physic (modname,abort_message,1)
+               endif
+            endif
+         enddo
+      enddo
+      endif
+
+!-------------------------------------------------------------------------
+! Multiplication par le flux de masse issu de la femreture
+!-------------------------------------------------------------------------
+
+      do l=1,nlay
+         entr(:,l)=f(:)*(entr_star(:,l)+alim_star(:,l))
+         detr(:,l)=f(:)*detr_star(:,l)
+      enddo
+
+      if (prt_level.ge.10) then
+         write(lunout1,*) 'Dans thermcell_flux 1'
+         write(lunout1,*) 'flux base ',f(igout)
+         write(lunout1,*) 'lmax ',lmax(igout)
+         write(lunout1,*) 'lalim ',lalim(igout)
+         write(lunout1,*) 'ig= ',igout
+         write(lunout1,*) ' l   E    D     W2'
+         write(lunout1,'(i4,3e15.5)') (l,entr(igout,l),detr(igout,l) &
+     &    ,zw2(igout,l+1),l=1,lmax(igout))
+      endif
+
+      fm(:,1)=0.
+      do l=1,nlay
+         do ig=1,ngrid
+            if (l.lt.lmax(ig)) then
+               fm(ig,l+1)=fm(ig,l)+entr(ig,l)-detr(ig,l)
+            elseif(l.eq.lmax(ig)) then
+               fm(ig,l+1)=0.
+               detr(ig,l)=fm(ig,l)+entr(ig,l)
+            else
+               fm(ig,l+1)=0.
+            endif
+         enddo
+      enddo
+
+
+
+! Test provisoire : pour comprendre pourquoi on corrige plein de fois 
+! le cas fm6, on commence par regarder une premiere fois avant les
+! autres corrections.
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if (detr(ig,l).gt.fm(ig,l)) then
+               ncorecfm8=ncorecfm8+1
+!              igout=ig
+            endif
+         enddo
+      enddo
+
+!      if (prt_level.ge.10) &
+!    &    call printflux(ngrid,nlay,lunout1,igout,f,lmax,lalim, &
+!    &    ptimestep,masse,entr,detr,fm,'2  ')
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! FH Version en cours de test;
+! par rapport a thermcell_flux, on fait une grande boucle sur "l"
+! et on modifie le flux avec tous les contr�les appliques d'affilee
+! pour la meme couche
+! Momentanement, on duplique le calcule du flux pour pouvoir comparer
+! les flux avant et apres modif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      do l=1,nlay
+
+         do ig=1,ngrid
+            if (l.lt.lmax(ig)) then
+               fm(ig,l+1)=fm(ig,l)+entr(ig,l)-detr(ig,l)
+            elseif(l.eq.lmax(ig)) then
+               fm(ig,l+1)=0.
+               detr(ig,l)=fm(ig,l)+entr(ig,l)
+            else
+               fm(ig,l+1)=0.
+            endif
+         enddo
+
+
+!-------------------------------------------------------------------------
+! Verification de la positivite des flux de masse
+!-------------------------------------------------------------------------
+
+!     do l=1,nlay
+         do ig=1,ngrid
+            if (fm(ig,l+1).lt.0.) then
+!              print*,'fm1<0',l+1,lmax(ig),fm(ig,l+1)
+                ncorecfm1=ncorecfm1+1
+               fm(ig,l+1)=fm(ig,l)
+               detr(ig,l)=entr(ig,l)
+            endif
+         enddo
+!     enddo
+
+      if (prt_level.ge.10) &
+     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
+     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
+
+!-------------------------------------------------------------------------
+!Test sur fraca croissant
+!-------------------------------------------------------------------------
+      if (iflag_thermals_optflux==0) then 
+!     do l=1,nlay
+         do ig=1,ngrid
+          if (l.ge.lalim(ig).and.l.le.lmax(ig) &
+     &    .and.(zw2(ig,l+1).gt.1.e-10).and.(zw2(ig,l).gt.1.e-10) ) then
+!  zzz est le flux en l+1 a frac constant
+             zzz=fm(ig,l)*rhobarz(ig,l+1)*zw2(ig,l+1)  &
+     &                          /(rhobarz(ig,l)*zw2(ig,l))
+             if (fm(ig,l+1).gt.zzz) then
+                detr(ig,l)=detr(ig,l)+fm(ig,l+1)-zzz
+                fm(ig,l+1)=zzz
+                ncorecfm4=ncorecfm4+1
+             endif
+          endif
+        enddo
+!     enddo
+      endif
+
+      if (prt_level.ge.10) &
+     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
+     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
+
+
+!-------------------------------------------------------------------------
+!test sur flux de masse croissant
+!-------------------------------------------------------------------------
+      if (iflag_thermals_optflux==0) then
+!     do l=1,nlay
+         do ig=1,ngrid
+            if ((fm(ig,l+1).gt.fm(ig,l)).and.(l.gt.lalim(ig))) then
+              f_old=fm(ig,l+1)
+              fm(ig,l+1)=fm(ig,l)
+              detr(ig,l)=detr(ig,l)+f_old-fm(ig,l+1)
+               ncorecfm5=ncorecfm5+1
+            endif
+         enddo
+!     enddo
+      endif
+
+      if (prt_level.ge.10) &
+     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
+     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
+
+!fin 1.eq.0
+!-------------------------------------------------------------------------
+!detr ne peut pas etre superieur a fm
+!-------------------------------------------------------------------------
+
+      if(1.eq.1) then
+
+!     do l=1,nlay
+
+
+
+         labort_physic=.false.
+         do ig=1,ngrid
+            if (entr(ig,l)<0.) then
+               labort_physic=.true.
+               igout=ig
+               lout=l
+            endif
+         enddo
+
+         if (labort_physic) then
+            print*,'N1 ig,l,entr',igout,lout,entr(igout,lout)
+            abort_message = 'entr negatif'
+            CALL abort_physic (modname,abort_message,1)
+         endif
+
+         do ig=1,ngrid
+            if (detr(ig,l).gt.fm(ig,l)) then
+               ncorecfm6=ncorecfm6+1
+               detr(ig,l)=fm(ig,l)
+               entr(ig,l)=fm(ig,l+1)
+
+! Dans le cas ou on est au dessus de la couche d'alimentation et que le
+! detrainement est plus fort que le flux de masse, on stope le thermique.
+!test:on commente
+!               if (l.gt.lalim(ig)) then
+!                  lmax(ig)=l
+!                  fm(ig,l+1)=0.
+!                  entr(ig,l)=0.
+!               else
+!                  ncorecfm7=ncorecfm7+1
+!               endif
+            endif
+
+            if(l.gt.lmax(ig)) then
+               detr(ig,l)=0.
+               fm(ig,l+1)=0.
+               entr(ig,l)=0.
+            endif
+         enddo
+
+         labort_physic=.false.
+         do ig=1,ngrid
+            if (entr(ig,l).lt.0.) then
+               labort_physic=.true.
+               igout=ig
+            endif
+         enddo
+         if (labort_physic) then
+            ig=igout
+            print*,'ig,l,lmax(ig)',ig,l,lmax(ig)
+            print*,'entr(ig,l)',entr(ig,l)
+            print*,'fm(ig,l)',fm(ig,l)
+            abort_message = 'probleme dans thermcell flux'
+            CALL abort_physic (modname,abort_message,1)
+         endif
+
+
+!     enddo
+      endif
+
+
+      if (prt_level.ge.10) &
+     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
+     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
+
+!-------------------------------------------------------------------------
+!fm ne peut pas etre negatif
+!-------------------------------------------------------------------------
+
+!     do l=1,nlay
+         do ig=1,ngrid
+            if (fm(ig,l+1).lt.0.) then
+               detr(ig,l)=detr(ig,l)+fm(ig,l+1)
+               fm(ig,l+1)=0.
+               ncorecfm2=ncorecfm2+1
+            endif
+         enddo
+
+         labort_physic=.false.
+         do ig=1,ngrid
+            if (detr(ig,l).lt.0.) then
+               labort_physic=.true.
+               igout=ig
+            endif
+        enddo
+        if (labort_physic) then
+               ig=igout
+               print*,'cas 2 : ig,l,lmax(ig)',ig,l,lmax(ig)
+               print*,'detr(ig,l)',detr(ig,l)
+               print*,'fm(ig,l)',fm(ig,l)
+               abort_message = 'probleme dans thermcell flux'
+               CALL abort_physic (modname,abort_message,1)
+        endif
+!    enddo
+
+      if (prt_level.ge.10) &
+     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
+     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
+
+!-----------------------------------------------------------------------
+!la fraction couverte ne peut pas etre superieure a 1            
+!-----------------------------------------------------------------------
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! FH Partie a revisiter.
+! Il semble qu'etaient codees ici deux optiques dans le cas
+! F/ (rho *w) > 1
+! soit limiter la hauteur du thermique en considerant que c'est 
+! la derniere chouche, soit limiter F a rho w.
+! Dans le second cas, il faut en fait limiter a un peu moins
+! que ca parce qu'on a des 1 / ( 1 -alpha) un peu plus loin
+! dans thermcell_main et qu'il semble de toutes facons deraisonable
+! d'avoir des fractions de 1..
+! Ci dessous, et dans l'etat actuel, le premier des  deux if est
+! sans doute inutile.
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!    do l=1,nlay
+        do ig=1,ngrid
+           if (zw2(ig,l+1).gt.1.e-10) then
+           zfm=rhobarz(ig,l+1)*zw2(ig,l+1)*alphamax
+           if ( fm(ig,l+1) .gt. zfm) then
+              f_old=fm(ig,l+1)
+              fm(ig,l+1)=zfm
+              detr(ig,l)=detr(ig,l)+f_old-fm(ig,l+1)
+!             lmax(ig)=l+1
+!             zmax(ig)=zlev(ig,lmax(ig))
+!             print*,'alpha>1',l+1,lmax(ig)
+              ncorecalpha=ncorecalpha+1
+           endif
+           endif
+        enddo
+!    enddo
+!
+
+
+      if (prt_level.ge.10) &
+     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
+     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
+
+! Fin de la grande boucle sur les niveaux verticaux
+      enddo
+
+!      if (prt_level.ge.10) &
+!    &    call printflux(ngrid,nlay,lunout1,igout,f,lmax,lalim, &
+!    &    ptimestep,masse,entr,detr,fm,'8  ')
+
+
+!-----------------------------------------------------------------------
+! On fait en sorte que la quantite totale d'air entraine dans le 
+! panache ne soit pas trop grande comparee a la masse de la maille
+!-----------------------------------------------------------------------
+
+      if (1.eq.1) then
+      labort_physic=.false.
+      do l=1,nlay-1
+         do ig=1,ngrid
+            eee0=entr(ig,l)
+            ddd0=detr(ig,l)
+            eee=entr(ig,l)-masse(ig,l)*fomass_max/ptimestep
+            ddd=detr(ig,l)-eee
+            if (eee.gt.0.) then
+                ncorecfm3=ncorecfm3+1
+                entr(ig,l)=entr(ig,l)-eee
+                if ( ddd.gt.0.) then
+!   l'entrainement est trop fort mais l'exces peut etre compense par une
+!   diminution du detrainement)
+                   detr(ig,l)=ddd
+                else
+!   l'entrainement est trop fort mais l'exces doit etre compense en partie
+!   par un entrainement plus fort dans la couche superieure
+                   if(l.eq.lmax(ig)) then
+                      detr(ig,l)=fm(ig,l)+entr(ig,l)
+                   else
+                      if(l.ge.lmax(ig).and.0.eq.1) then
+                         igout=ig
+                         lout=l
+                         labort_physic=.true.
+                      endif
+                      entr(ig,l+1)=entr(ig,l+1)-ddd
+                      detr(ig,l)=0.
+                      fm(ig,l+1)=fm(ig,l)+entr(ig,l)
+                      detr(ig,l)=0.
+                   endif
+                endif
+            endif
+         enddo
+      enddo
+      if (labort_physic) then
+                         ig=igout
+                         l=lout
+                         print*,'ig,l',ig,l
+                         print*,'eee0',eee0
+                         print*,'ddd0',ddd0
+                         print*,'eee',eee
+                         print*,'ddd',ddd
+                         print*,'entr',entr(ig,l)
+                         print*,'detr',detr(ig,l)
+                         print*,'masse',masse(ig,l)
+                         print*,'fomass_max',fomass_max
+                         print*,'masse(ig,l)*fomass_max/ptimestep',masse(ig,l)*fomass_max/ptimestep
+                         print*,'ptimestep',ptimestep
+                         print*,'lmax(ig)',lmax(ig)
+                         print*,'fm(ig,l+1)',fm(ig,l+1)
+                         print*,'fm(ig,l)',fm(ig,l)
+                         abort_message = 'probleme dans thermcell_flux'
+                         CALL abort_physic (modname,abort_message,1)
+      endif
+      endif
+!                  
+!              ddd=detr(ig)-entre
+!on s assure que tout s annule bien en zmax
+      do ig=1,ngrid
+         fm(ig,lmax(ig)+1)=0.
+         entr(ig,lmax(ig))=0.
+         detr(ig,lmax(ig))=fm(ig,lmax(ig))+entr(ig,lmax(ig))
+      enddo
+
+!-----------------------------------------------------------------------
+! Impression du nombre de bidouilles qui ont ete necessaires
+!-----------------------------------------------------------------------
+
+!IM 090508 beg
+!     if (ncorecfm1+ncorecfm2+ncorecfm3+ncorecfm4+ncorecfm5+ncorecalpha > 0 ) then
+!
+!         print*,'PB thermcell : on a du coriger ',ncorecfm1,'x fm1',&
+!   &     ncorecfm2,'x fm2',ncorecfm3,'x fm3 et', &
+!   &     ncorecfm4,'x fm4',ncorecfm5,'x fm5 et', &
+!   &     ncorecfm6,'x fm6', &
+!   &     ncorecfm7,'x fm7', &
+!   &     ncorecfm8,'x fm8', &
+!   &     ncorecalpha,'x alpha'
+!     endif
+!IM 090508 end
+
+!      if (prt_level.ge.10) &
+!    &    call printflux(ngrid,nlay,lunout1,igout,f,lmax,lalim, &
+!    &    ptimestep,masse,entr,detr,fm,'fin')
+
+
+ RETURN
+      end
+END MODULE lmdz_thermcell_flux2
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_height.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_height.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_height.F90	(revision 4727)
@@ -0,0 +1,163 @@
+MODULE lmdz_thermcell_height
+CONTAINS
+
+      SUBROUTINE thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,  &
+     &           zw2,zlev,lmax,zmax,zmax0,zmix,wmax)
+      IMPLICIT NONE
+
+!-----------------------------------------------------------------------------
+!thermcell_height: calcul des caracteristiques du thermique: zmax,wmax,zmix
+!-----------------------------------------------------------------------------
+
+! arguments
+
+! Entree
+      integer, intent(in) :: ngrid,nlay
+      real, intent(in), dimension(ngrid) :: linter
+      real, intent(in), dimension(ngrid,nlay+1) :: zlev
+! Sortie
+      real, intent(out), dimension(ngrid) :: wmax,zmax,zmax0,zmix
+      integer, intent(out), dimension(ngrid) :: lmax
+! Les deux
+     integer, intent(inout), dimension(ngrid) :: lmix,lalim,lmin
+     real, intent(inout), dimension(ngrid,nlay+1) :: zw2
+
+! local
+     real, dimension(ngrid) :: num,denom,zlevinter
+     integer ig,l
+
+!calcul de la hauteur max du thermique
+      do ig=1,ngrid
+         lmax(ig)=lalim(ig)
+      enddo
+      do ig=1,ngrid
+         do l=nlay,lalim(ig)+1,-1
+            if (zw2(ig,l).le.1.e-10) then
+               lmax(ig)=l-1
+            endif
+         enddo
+      enddo
+
+! On traite le cas particulier qu'il faudrait éviter ou le thermique
+! atteind le haut du modele ...
+      do ig=1,ngrid
+      if ( zw2(ig,nlay) > 1.e-10 ) then
+          print*,'WARNING !!!!! W2 thermiques non nul derniere couche '
+          lmax(ig)=nlay
+      endif
+      enddo
+
+! pas de thermique si couche 1 stable
+      do ig=1,ngrid
+         if (lmin(ig).gt.1) then
+             lmax(ig)=1
+             lmin(ig)=1
+             lalim(ig)=1
+         endif
+      enddo 
+!    
+! Determination de zw2 max
+      do ig=1,ngrid
+         wmax(ig)=0.
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if (l.le.lmax(ig)) then
+                if (zw2(ig,l).lt.0.)then
+                  print*,'pb2 zw2<0'
+                endif
+                zw2(ig,l)=sqrt(zw2(ig,l))
+                wmax(ig)=max(wmax(ig),zw2(ig,l))
+            else
+                 zw2(ig,l)=0.
+            endif
+          enddo
+      enddo
+
+!   Longueur caracteristique correspondant a la hauteur des thermiques.
+      do  ig=1,ngrid
+         zmax(ig)=0.
+         zlevinter(ig)=zlev(ig,1)
+      enddo
+
+!     if (iflag_thermals_ed.ge.1) then
+      if (1==0) then
+!CR:date de quand le calcul du zmax continu etait buggue 
+         num(:)=0.
+         denom(:)=0.
+         do ig=1,ngrid
+          do l=1,nlay
+             num(ig)=num(ig)+zw2(ig,l)*zlev(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+             denom(ig)=denom(ig)+zw2(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+          enddo
+       enddo
+       do ig=1,ngrid
+       if (denom(ig).gt.1.e-10) then
+          zmax(ig)=2.*num(ig)/denom(ig)
+          zmax0(ig)=zmax(ig)
+       endif 
+       enddo
+ 
+      else
+!CR:Calcul de zmax continu via le linter      
+      do  ig=1,ngrid
+! calcul de zlevinter
+          zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*  &
+     &    linter(ig)+zlev(ig,lmax(ig))-lmax(ig)*(zlev(ig,lmax(ig)+1)  &
+     &    -zlev(ig,lmax(ig)))
+!pour le cas ou on prend tjs lmin=1
+!       zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
+       zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,1))
+       zmax0(ig)=zmax(ig)
+      enddo
+
+
+      endif
+!endif iflag_thermals_ed
+!
+! def de  zmix continu (profil parabolique des vitesses)
+      do ig=1,ngrid
+           if (lmix(ig).gt.1) then
+! test 
+              if (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
+     &        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))  &
+     &        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))  &
+     &        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))).gt.1e-10)  &
+     &        then
+!             
+            zmix(ig)=((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
+     &        *((zlev(ig,lmix(ig)))**2-(zlev(ig,lmix(ig)+1))**2)  &
+     &        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))  &
+     &        *((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))  &
+     &        /(2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
+     &        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))  &
+     &        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))  &
+     &        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
+              else
+              zmix(ig)=zlev(ig,lmix(ig))
+              print*,'pb zmix'
+              endif
+          else 
+              zmix(ig)=0.
+          endif
+!test
+         if ((zmax(ig)-zmix(ig)).le.0.) then
+            zmix(ig)=0.9*zmax(ig)
+!            print*,'pb zmix>zmax'
+         endif
+      enddo
+!
+! calcul du nouveau lmix correspondant
+      do ig=1,ngrid
+         do l=1,nlay
+            if (zmix(ig).ge.zlev(ig,l).and.  &
+     &          zmix(ig).lt.zlev(ig,l+1)) then
+              lmix(ig)=l
+             endif
+          enddo
+      enddo
+!
+ RETURN
+      end
+END MODULE lmdz_thermcell_height
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_ini.F90	(revision 4727)
@@ -0,0 +1,140 @@
+MODULE lmdz_thermcell_ini
+
+IMPLICIT NONE
+
+save
+
+
+integer, protected :: dvdq=1,dqimpl=-1,prt_level=0,lunout
+real   , protected :: RG,RD,RCPD,RKAPPA,RLVTT,RLvCp,RETV
+
+!$OMP THREADPRIVATE(dvdq,dqimpl,prt_level,lunout)
+!$OMP THREADPRIVATE(RG,RD,RCPD,RKAPPA,RLVTT,RLvCp)
+
+
+! Parameters that can be modified directly by a getin call
+real,    protected :: r_aspect_thermals=2.       ! Aspect ratio for thermal celles
+real,    protected :: tau_thermals = 0.          ! relaxation time constant
+real,    protected :: fact_thermals_ed_dz = 0.1  ! bouyancy computed with a delta
+real,    protected :: betalpha=0.9               !
+real,    protected :: afact=2./3.                !
+real,    protected :: fact_shell=1.              !
+real,    protected :: detr_min=1.e-5             !
+real,    protected :: entr_min=1.e-5             !
+real,    protected :: detr_q_coef=0.012          !
+real,    protected :: detr_q_power=0.5           !
+real,    protected :: mix0=0.                    !
+integer, protected :: iflag_thermals_ed = 0      !
+integer, protected :: iflag_thermals_optflux = 0 !
+integer, protected :: iflag_thermals_closure = 1 !
+integer, protected :: iflag_thermals_down = 0    !
+integer, protected :: fact_thermals_down = 0.5   !
+integer, protected :: thermals_flag_alim=0       !
+integer, protected :: iflag_thermals_tenv=0      ! 
+
+   ! WARNING !!! fact_epsilon is not protected. It can be modified in thermcell_plume*
+   ! depending on other flags.
+
+   real               :: fact_epsilon=0.002
+
+!$OMP THREADPRIVATE(r_aspect_thermals,tau_thermals,fact_thermals_ed_dz)
+!$OMP THREADPRIVATE(iflag_thermals_ed,iflag_thermals_optflux,iflag_thermals_closure)
+!$OMP THREADPRIVATE(iflag_thermals_down)
+!$OMP THREADPRIVATE(fact_thermals_down)
+!$OMP THREADPRIVATE(fact_epsilon, betalpha, afact, fact_shell)
+!$OMP THREADPRIVATE(detr_min, entr_min, detr_q_coef, detr_q_power)
+!$OMP THREADPRIVATE( mix0, thermals_flag_alim)
+!$OMP THREADPRIVATE(iflag_thermals_tenv)
+
+
+CONTAINS
+
+SUBROUTINE thermcell_ini(iflag_thermals,prt_level_in,tau_thermals_in,lunout_in, &
+   &    RG_in,RD_in,RCPD_in,RKAPPA_in,RLVTT_in,RETV_in)
+
+   USE ioipsl_getin_p_mod, ONLY : getin_p
+
+integer, intent(in) :: iflag_thermals,prt_level_in,lunout_in
+real, intent(in) :: RG_in,RD_in,RCPD_in,RKAPPA_in,RLVTT_in,RETV_in,tau_thermals_in
+
+print*,'thermcell_ini'
+      if (iflag_thermals==15.or.iflag_thermals==16) then
+         dvdq=0
+         dqimpl=-1
+      else
+         dvdq=1
+         dqimpl=1
+      endif
+   prt_level=prt_level_in
+   RG=RG_in
+   RD=RD_in
+   RCPD=RCPD_in
+   RKAPPA=RKAPPA_in
+   RLVTT=RLVTT_in
+   RLvCp = RLVTT/RCPD
+   RETV=RETV_in
+   tau_thermals=tau_thermals_in
+   lunout=lunout_in
+
+
+!=====================================================================
+! a la fois les vieilles param et thermcell_main :
+!=====================================================================
+
+   CALL getin_p('r_aspect_thermals',r_aspect_thermals)
+   CALL getin_p('tau_thermals',tau_thermals)
+   CALL getin_p('fact_thermals_ed_dz',fact_thermals_ed_dz)
+   CALL getin_p('iflag_thermals_ed',iflag_thermals_ed)
+   CALL getin_p('iflag_thermals_optflux',iflag_thermals_optflux)
+   CALL getin_p('iflag_thermals_closure',iflag_thermals_closure)
+   CALL getin_p('iflag_thermals_down',iflag_thermals_down)
+   CALL getin_p('fact_thermals_down',fact_thermals_down)
+   CALL getin_p('thermals_fact_epsilon',fact_epsilon)
+   CALL getin_p('thermals_betalpha',betalpha)
+   CALL getin_p('thermals_afact',afact)
+   CALL getin_p('thermals_fact_shell',fact_shell)
+   CALL getin_p('thermals_detr_min',detr_min)
+   CALL getin_p('thermals_entr_min',entr_min)
+   CALL getin_p('thermals_detr_q_coef',detr_q_coef)
+   CALL getin_p('thermals_detr_q_power',detr_q_power)
+   CALL getin_p('thermals_mix0',mix0)
+   CALL getin_p('thermals_flag_alim',thermals_flag_alim)
+   CALL getin_p('iflag_thermals_tenv',iflag_thermals_tenv)
+
+
+
+write(lunout,*) 'thermcell_ini ,prt_level                =',  prt_level                   
+write(lunout,*) 'thermcell_ini ,RG                       =',  RG                      
+write(lunout,*) 'thermcell_ini ,RD                       =',  RD                       
+write(lunout,*) 'thermcell_ini ,RCPD                     =',  RCPD                    
+write(lunout,*) 'thermcell_ini ,RKAPPA                   =',  RKAPPA                  
+write(lunout,*) 'thermcell_ini ,RLVTT                    =',  RLVTT                   
+write(lunout,*) 'thermcell_ini ,RLvCp                    =',  RLvCp                   
+write(lunout,*) 'thermcell_ini ,RETV                     =',  RETV                    
+write(lunout,*) 'thermcell_ini ,tau_thermals             =',  tau_thermals            
+write(lunout,*) 'thermcell_ini ,lunout                   =',  lunout                  
+write(lunout,*) 'thermcell_ini ,r_aspect_thermals        =',  r_aspect_thermals       
+write(lunout,*) 'thermcell_ini ,tau_thermals             =',  tau_thermals            
+write(lunout,*) 'thermcell_ini ,fact_thermals_ed_dz      =',  fact_thermals_ed_dz
+write(lunout,*) 'thermcell_ini ,fact_thermals_ed_dz      =',  fact_thermals_ed_dz
+write(lunout,*) 'thermcell_ini ,iflag_thermals_ed        =',  iflag_thermals_ed       
+write(lunout,*) 'thermcell_ini ,iflag_thermals_optflux   =',  iflag_thermals_optflux
+write(lunout,*) 'thermcell_ini ,iflag_thermals_closure   =',  iflag_thermals_closure
+write(lunout,*) 'thermcell_ini ,iflag_thermals_down      =',  iflag_thermals_down
+write(lunout,*) 'thermcell_ini ,fact_thermals_down       =',  fact_thermals_down
+write(lunout,*) 'thermcell_ini ,fact_epsilon             =',  fact_epsilon            
+write(lunout,*) 'thermcell_ini ,betalpha                 =',  betalpha                
+write(lunout,*) 'thermcell_ini ,afact                    =',  afact                   
+write(lunout,*) 'thermcell_ini ,fact_shell               =',  fact_shell              
+write(lunout,*) 'thermcell_ini ,detr_min                 =',  detr_min                
+write(lunout,*) 'thermcell_ini ,entr_min                 =',  entr_min                
+write(lunout,*) 'thermcell_ini ,detr_q_coef              =',  detr_q_coef             
+write(lunout,*) 'thermcell_ini ,detr_q_power             =',  detr_q_power            
+write(lunout,*) 'thermcell_ini ,mix0                     =',  mix0                    
+write(lunout,*) 'thermcell_ini ,thermals_flag_alim       =',  thermals_flag_alim
+write(lunout,*) 'thermcell_ini ,iflag_thermals_tenv      =',  iflag_thermals_tenv
+
+ RETURN
+
+END SUBROUTINE thermcell_ini
+END MODULE lmdz_thermcell_ini
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_main.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_main.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_main.F90	(revision 4727)
@@ -0,0 +1,991 @@
+MODULE lmdz_thermcell_main
+! $Id$
+!
+! A REGARDER !!!!!!!!!!!!!!!!!
+! ATTENTION : zpspsk est inout et out mais c'est pas forcement pour de bonnes raisons (FH, 2023)
+! ATTENTION : dans thermcell_env, on condense potentiellement de l'eau. Mais comme on ne mélange pas l'eau liquide supposant qu'il n'y en n'a pas, c'est potentiellement un souci
+CONTAINS
+
+      subroutine thermcell_main(itap,ngrid,nlay,ptimestep  &
+     &                  ,pplay,pplev,pphi,debut  &
+     &                  ,puwind,pvwind,ptemp,p_o,ptemp_env, po_env  &
+     &                  ,pduadj,pdvadj,pdtadj,pdoadj  &
+     &                  ,fm0,entr0,detr0,zqta,zqla,lmax  &
+     &                  ,ratqscth,ratqsdiff,zqsatth  &
+     &                  ,zmax0, f0,zw2,fraca,ztv &
+     &                  ,zpspsk,ztla,zthl,ztva &
+     &                  ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &
+#ifdef ISO         
+     &      ,xtpo,xtpdoadj &
+#endif         
+     &   )
+
+
+
+! USE necessaires pour les lignes importees de thermcell_env
+      USE lmdz_thermcell_ini, ONLY: thermcell_ini,dqimpl,dvdq,prt_level,lunout,prt_level
+      USE lmdz_thermcell_ini, ONLY: iflag_thermals_closure,iflag_thermals_ed,tau_thermals,r_aspect_thermals
+      USE lmdz_thermcell_ini, ONLY: iflag_thermals_down,fact_thermals_down
+      USE lmdz_thermcell_ini, ONLY: iflag_thermals_tenv
+      USE lmdz_thermcell_ini, ONLY: RD,RG
+
+      USE lmdz_thermcell_down, ONLY: thermcell_updown_dq
+      USE lmdz_thermcell_closure, ONLY: thermcell_closure
+      USE lmdz_thermcell_dq, ONLY: thermcell_dq
+      USE lmdz_thermcell_dry, ONLY: thermcell_dry
+      USE lmdz_thermcell_dv2, ONLY: thermcell_dv2
+      USE lmdz_thermcell_env, ONLY: thermcell_env
+      USE lmdz_thermcell_flux2, ONLY: thermcell_flux2
+      USE lmdz_thermcell_height, ONLY: thermcell_height
+      USE lmdz_thermcell_plume, ONLY: thermcell_plume
+      USE lmdz_thermcell_plume_6A, ONLY: thermcell_plume_6A,thermcell_plume_5B
+
+! USE necessaires pour les lignes importees de thermcell_env
+   USE lmdz_thermcell_ini, ONLY : RLvCp,RKAPPA,RETV
+   USE lmdz_thermcell_qsat, ONLY : thermcell_qsat
+
+
+#ifdef ISO
+  USE infotrac_phy, ONLY : ntiso
+#ifdef ISOVERIF
+  USE isotopes_mod, ONLY : iso_eau,iso_HDO
+  USE isotopes_verif_mod, ONLY: iso_verif_egalite, &
+        iso_verif_aberrant_encadre
+#endif
+#endif
+
+
+      IMPLICIT NONE
+
+!=======================================================================
+!   Auteurs: Frederic Hourdin, Catherine Rio, Anne Mathieu
+!   Version du 09.02.07
+!   Calcul du transport vertical dans la couche limite en presence
+!   de "thermiques" explicitement representes avec processus nuageux
+!
+!   Reecriture a partir d'un listing papier a Habas, le 14/02/00
+!
+!   le thermique est suppose homogene et dissipe par melange avec
+!   son environnement. la longueur l_mix controle l'efficacite du
+!   melange
+!
+!   Le calcul du transport des differentes especes se fait en prenant
+!   en compte:
+!     1. un flux de masse montant
+!     2. un flux de masse descendant
+!     3. un entrainement
+!     4. un detrainement
+!
+! Modif 2013/01/04 (FH hourdin@lmd.jussieu.fr)
+!    Introduction of an implicit computation of vertical advection in
+!    the environment of thermal plumes in thermcell_dq
+!    impl =     0 : explicit, 1 : implicit, -1 : old version
+!    controled by iflag_thermals =
+!       15, 16 run with impl=-1 : numerical convergence with NPv3
+!       17, 18 run with impl=1  : more stable
+!    15 and 17 correspond to the activation of the stratocumulus "bidouille"
+!
+! Using
+!    abort_physic 
+!    iso_verif_aberrant_encadre
+!    iso_verif_egalite
+!    test_ltherm
+!    thermcell_closure
+!    thermcell_dq
+!    thermcell_dry
+!    thermcell_dv2
+!    thermcell_env
+!    thermcell_flux2
+!    thermcell_height
+!    thermcell_plume
+!    thermcell_plume_5B
+!    thermcell_plume_6A
+!
+!=======================================================================
+
+
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+
+
+!   arguments:
+!   ----------
+      integer, intent(in) :: itap,ngrid,nlay
+      real, intent(in) ::  ptimestep
+      real, intent(in), dimension(ngrid,nlay)    :: ptemp,puwind,pvwind,pplay,pphi,ptemp_env,po_env
+! ATTENTION : zpspsk est inout et out mais c'est pas forcement pour de bonnes raisons (FH, 2023)
+      real, intent(in), dimension(ngrid,nlay)    :: p_o
+      real, intent(out), dimension(ngrid,nlay)    :: zpspsk
+      real, intent(in), dimension(ngrid,nlay+1)  :: pplev
+      integer, intent(out), dimension(ngrid) :: lmax
+      real, intent(out), dimension(ngrid,nlay)   :: pdtadj,pduadj,pdvadj,pdoadj,entr0,detr0
+      real, intent(out), dimension(ngrid,nlay)   :: ztla,zqla,zqta,zqsatth,zthl
+      real, intent(out), dimension(ngrid,nlay+1) :: fm0,zw2,fraca
+      real, intent(inout), dimension(ngrid) :: zmax0,f0
+      real, intent(out), dimension(ngrid,nlay) :: ztva,ztv
+      logical, intent(in) :: debut
+      real,intent(out), dimension(ngrid,nlay) :: ratqscth,ratqsdiff
+
+      real, intent(out), dimension(ngrid) :: pcon
+      real, intent(out), dimension(ngrid,nlay) :: rhobarz,wth3
+      real, intent(out), dimension(ngrid) :: wmax_sec
+      integer,intent(out), dimension(ngrid) :: lalim
+      real, intent(out), dimension(ngrid,nlay+1) :: fm
+      real, intent(out), dimension(ngrid,nlay) :: alim_star
+      real, intent(out), dimension(ngrid) :: zmax
+
+!   local:
+!   ------
+
+
+      integer,save :: igout=1
+!$OMP THREADPRIVATE(igout)
+      integer,save :: lunout1=6
+!$OMP THREADPRIVATE(lunout1)
+      integer,save :: lev_out=10
+!$OMP THREADPRIVATE(lev_out)
+
+      real lambda, zf,zf2,var,vardiff,CHI
+      integer ig,k,l,ierr,ll
+      logical sorties
+      real, dimension(ngrid) :: linter,zmix, zmax_sec
+      integer,dimension(ngrid) :: lmin,lmix,lmix_bis,nivcon
+      real, dimension(ngrid,nlay) :: ztva_est
+      real, dimension(ngrid,nlay) :: deltaz,zlay,zdthladj,zu,zv,z_o,zl,zva,zua,z_oa
+      real, dimension(ngrid,nlay) :: ztemp_env ! temperarure liquide de l'environnement
+      real, dimension(ngrid,nlay) :: zta,zha,q2,wq,wthl,wthv,thetath2,wth2
+      real, dimension(ngrid,nlay) :: rho,masse
+      real, dimension(ngrid,nlay+1) :: zw_est,zlev
+      real, dimension(ngrid) :: wmax,wmax_tmp
+      real, dimension(ngrid,nlay+1) :: f_star
+      real, dimension(ngrid,nlay) :: entr,detr,entr_star,detr_star,alim_star_clos
+      real, dimension(ngrid,nlay) :: zqsat,csc
+      real, dimension(ngrid) :: zcon,zcon2,alim_star_tot,f
+      real, dimension(ngrid,nlay) :: entrdn,detrdn
+      logical, dimension(ngrid,nlay) :: mask
+
+      character (len=20) :: modname='thermcell_main'
+      character (len=80) :: abort_message
+
+
+#ifdef ISO
+      REAL xtpo(ntiso,ngrid,nlay),xtpdoadj(ntiso,ngrid,nlay)
+      REAL xtzo(ntiso,ngrid,nlay)
+      REAL xtpdoadj_tmp(ngrid,nlay)
+      REAL xtpo_tmp(ngrid,nlay)
+      REAL xtzo_tmp(ngrid,nlay)
+      integer ixt
+#endif
+
+!
+
+!-----------------------------------------------------------------------
+!   initialisation:
+!   ---------------
+!
+   fm=0. ; entr=0. ; detr=0.
+
+      if (prt_level.ge.1) print*,'thermcell_main V4'
+
+       sorties=.true.
+      IF(ngrid.NE.ngrid) THEN
+         PRINT*
+         PRINT*,'STOP dans convadj'
+         PRINT*,'ngrid    =',ngrid
+         PRINT*,'ngrid  =',ngrid
+      ENDIF
+!
+!print*,'thermcell_main debut'
+!     write(lunout,*)'WARNING thermcell_main f0=max(f0,1.e-2)'
+     do ig=1,ngrid
+         f0(ig)=max(f0(ig),1.e-2)
+         zmax0(ig)=max(zmax0(ig),40.)
+!IMmarche pas ?!       if (f0(ig)<1.e-2) f0(ig)=1.e-2
+     enddo
+
+      if (prt_level.ge.20) then
+       do ig=1,ngrid
+          print*,'th_main ig f0',ig,f0(ig)
+       enddo
+      endif
+
+!-----------------------------------------------------------------------
+! Calcul de T,q,ql a partir de Tl et qT dans l environnement
+!   --------------------------------------------------------------------
+!
+          ! On condense l'eau liquide si besoin.
+          ! En fait on arrive ici d'habitude (jusque 6A) après réévaporation
+          ! Dans une nouvelle mouture, on passe les profiles 
+          ! avant la couche limite : iflag_thermals_tenv=1
+          !     dés le début de la physique : iflag_thermals_tenv=2
+          ! Mais même pour 2) on ne veut sans doute pas réévaporer.
+          ! On veut comparer thetav dans le thermique, après condensation,
+          ! avec le theta_v effectif de l'environnement.
+
+      if (iflag_thermals_tenv - 10 * ( iflag_thermals_tenv / 10 ) == 0) then
+
+          CALL thermcell_env(ngrid,nlay,p_o,ptemp_env,puwind,pvwind,pplay,  &
+         &           pplev,z_o,ztemp_env,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out)
+
+      else
+
+        ! Chantier en cours : ne pas effacer (Fredho). 15 septembre 2023
+        ! Dans la version originale de thermcell_env, on condense l'eau de l'environnement
+        ! pour calculer une temperature potentielle liquide.
+        ! On en déduit un Theta v.
+
+ ! ... 
+        ! contenu de thermcell_env
+        !    SUBROUTINE thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
+        ! &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,pqsat,lev_out)
+        ! contenu thermcell_env : call thermcell_qsat(ngrid*nlay,mask,pplev,pt,po,pqsat)
+        ! contenu thermcell_env : do ll=1,nlay
+        ! contenu thermcell_env :    do ig=1,ngrid
+        ! contenu thermcell_env :       zl(ig,ll) = max(0.,po(ig,ll)-pqsat(ig,ll))
+        ! contenu thermcell_env :       zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)         !   T = Tl + Lv/Cp ql
+        ! contenu thermcell_env :       zo(ig,ll) = po(ig,ll)-zl(ig,ll)
+        ! contenu thermcell_env :    enddo
+        ! contenu thermcell_env : enddo
+        ! contenu thermcell_env : do ll=1,nlay
+        ! contenu thermcell_env :    do ig=1,ngrid
+        ! contenu thermcell_env :        zpspsk(ig,ll)=(pplay(ig,ll)/100000.)**RKAPPA
+        ! contenu thermcell_env :        zu(ig,ll)=pu(ig,ll)
+        ! contenu thermcell_env :        zv(ig,ll)=pv(ig,ll)
+        ! contenu thermcell_env :          ztv(ig,ll)=zh(ig,ll)/zpspsk(ig,ll)
+        ! contenu thermcell_env :          ztv(ig,ll)=ztv(ig,ll)*(1.+RETV*(zo(ig,ll))-zl(ig,ll))
+        ! contenu thermcell_env :          zthl(ig,ll)=pt(ig,ll)/zpspsk(ig,ll)
+        ! contenu thermcell_env :    enddo
+        ! contenu thermcell_env : enddo
+
+        do l=1,nlay
+            do ig=1,ngrid
+                 zl(ig,l)=0.
+                 zu(ig,l)=puwind(ig,l)
+                 zv(ig,l)=pvwind(ig,l)
+                 ztemp_env(ig,l)=ptemp_env(ig,l)
+                 zpspsk(ig,l)=(pplay(ig,l)/100000.)**RKAPPA
+                 ztv(ig,l)=ztemp_env(ig,l)/zpspsk(ig,l)
+                 ztv(ig,l)=ztv(ig,l)*(1.+RETV*po_env(ig,l))
+                 zthl(ig,l)=ptemp(ig,l)/zpspsk(ig,l)
+                 mask(ig,l)=.true.
+            enddo
+        enddo
+        call thermcell_qsat(ngrid*nlay,mask,pplev,ptemp_env,p_o,zqsat)
+          
+      endif
+       
+      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_env'
+
+!------------------------------------------------------------------------
+!                       --------------------
+!
+!
+!                       + + + + + + + + + + +
+!
+!
+!  wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+!  wh,wt,wo ...
+!
+!                       + + + + + + + + + + +  zh,zu,zv,z_o,rho
+!
+!
+!                       --------------------   zlev(1)
+!                       \\\\\\\\\\\\\\\\\\\\
+!
+!
+
+!-----------------------------------------------------------------------
+!   Calcul des altitudes des couches
+!-----------------------------------------------------------------------
+
+      do l=2,nlay
+         zlev(:,l)=0.5*(pphi(:,l)+pphi(:,l-1))/RG
+      enddo
+      zlev(:,1)=0.
+      zlev(:,nlay+1)=(2.*pphi(:,nlay)-pphi(:,nlay-1))/RG
+      do l=1,nlay
+         zlay(:,l)=pphi(:,l)/RG
+      enddo
+      do l=1,nlay
+         deltaz(:,l)=zlev(:,l+1)-zlev(:,l)
+      enddo
+
+!-----------------------------------------------------------------------
+!   Calcul des densites et masses
+!-----------------------------------------------------------------------
+
+      rho(:,:)=pplay(:,:)/(zpspsk(:,:)*RD*ztv(:,:))
+      if (prt_level.ge.10) write(lunout,*) 'WARNING thermcell_main rhobarz(:,1)=rho(:,1)'
+      rhobarz(:,1)=rho(:,1)
+      do l=2,nlay
+         rhobarz(:,l)=0.5*(rho(:,l)+rho(:,l-1))
+      enddo
+      do l=1,nlay
+         masse(:,l)=(pplev(:,l)-pplev(:,l+1))/RG
+      enddo
+      if (prt_level.ge.1) print*,'thermcell_main apres initialisation'
+
+!------------------------------------------------------------------
+!
+!             /|\
+!    --------  |  F_k+1 -------   
+!                              ----> D_k
+!             /|\              <---- E_k , A_k
+!    --------  |  F_k --------- 
+!                              ----> D_k-1
+!                              <---- E_k-1 , A_k-1
+!
+!
+!
+!
+!
+!    ---------------------------
+!
+!    ----- F_lmax+1=0 ----------         \
+!            lmax     (zmax)              |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------          |
+!                                         |  E
+!    ---------------------------          |  D
+!                                         |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------  \       |
+!            lalim                 |      |
+!    ---------------------------   |      |
+!                                  |      |
+!    ---------------------------   |      |
+!                                  | A    |
+!    ---------------------------   |      |
+!                                  |      |
+!    ---------------------------   |      |
+!    lmin  (=1 pour le moment)     |      |
+!    ----- F_lmin=0 ------------  /      /
+!
+!    ---------------------------
+!    //////////////////////////
+!
+!
+!=============================================================================
+!  Calculs initiaux ne faisant pas intervenir les changements de phase
+!=============================================================================
+
+!------------------------------------------------------------------
+!  1. alim_star est le profil vertical de l'alimentation a la base du
+!     panache thermique, calcule a partir de la flotabilite de l'air sec
+!  2. lmin et lalim sont les indices inferieurs et superieurs de alim_star
+!------------------------------------------------------------------
+!
+      entr_star=0. ; detr_star=0. ; alim_star=0. ; alim_star_tot=0.
+      lmin=1
+
+!-----------------------------------------------------------------------------
+!  3. wmax_sec et zmax_sec sont les vitesses et altitudes maximum d'un
+!     panache sec conservatif (e=d=0) alimente selon alim_star 
+!     Il s'agit d'un calcul de type CAPE
+!     zmax_sec est utilise pour determiner la geometrie du thermique.
+!------------------------------------------------------------------------------
+!---------------------------------------------------------------------------------
+!calcul du melange et des variables dans le thermique
+!--------------------------------------------------------------------------------
+!
+      if (prt_level.ge.1) print*,'avant thermcell_plume ',lev_out
+
+!=====================================================================
+! Old version of thermcell_plume in thermcell_plume_6A.F90
+! It includes both thermcell_plume_6A and thermcell_plume_5B corresponding
+! to the 5B and 6A versions used for CMIP5 and CMIP6.
+! The latest was previously named thermcellV1_plume.
+! The new thermcell_plume is a clean version (removing obsolete
+! options) of thermcell_plume_6A.
+! The 3 versions are controled by
+! flag_thermals_ed <= 9 thermcell_plume_6A
+!                  <= 19 thermcell_plume_5B
+!                  else thermcell_plume (default 20 for convergence with 6A)
+! Fredho
+!=====================================================================
+
+      if (iflag_thermals_ed<=9) then
+!         print*,'THERM NOUVELLE/NOUVELLE Arnaud'
+         CALL thermcell_plume_6A(itap,ngrid,nlay,ptimestep,ztv,zthl,p_o,zl,rhobarz,&
+     &    zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
+     &    lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
+     &    ztla,zqla,zqta,zha,zw2,zw_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
+     &    ,lev_out,lunout1,igout)
+
+      elseif (iflag_thermals_ed<=19) then
+!        print*,'THERM RIO et al 2010, version d Arnaud'
+         CALL thermcell_plume_5B(itap,ngrid,nlay,ptimestep,ztv,zthl,p_o,zl,rhobarz,&
+     &    zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
+     &    lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
+     &    ztla,zqla,zqta,zha,zw2,zw_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
+     &    ,lev_out,lunout1,igout)
+      else
+         CALL thermcell_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,p_o,zl,rhobarz,&
+     &    zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
+     &    lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
+     &    ztla,zqla,zqta,zha,zw2,zw_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
+     &    ,lev_out,lunout1,igout)
+      endif
+
+      if (prt_level.ge.1) print*,'apres thermcell_plume ',lev_out
+
+      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_plum lalim ')
+      call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_plum lmix  ')
+
+      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_plume'
+      if (prt_level.ge.10) then
+         write(lunout1,*) 'Dans thermcell_main 2'
+         write(lunout1,*) 'lmin ',lmin(igout)
+         write(lunout1,*) 'lalim ',lalim(igout)
+         write(lunout1,*) ' ig l alim_star entr_star detr_star f_star '
+         write(lunout1,'(i6,i4,4e15.5)') (igout,l,alim_star(igout,l),entr_star(igout,l),detr_star(igout,l) &
+     &    ,f_star(igout,l+1),l=1,nint(linter(igout))+5)
+      endif
+
+!-------------------------------------------------------------------------------
+! Calcul des caracteristiques du thermique:zmax,zmix,wmax
+!-------------------------------------------------------------------------------
+!
+      CALL thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,zw2,  &
+     &           zlev,lmax,zmax,zmax0,zmix,wmax)
+! Attention, w2 est transforme en sa racine carree dans cette routine
+! Le probleme vient du fait que linter et lmix sont souvent egaux a 1.
+      wmax_tmp=0.
+      do  l=1,nlay
+         wmax_tmp(:)=max(wmax_tmp(:),zw2(:,l))
+      enddo
+!     print*,"ZMAX ",lalim,lmin,linter,lmix,lmax,zmax,zmax0,zmix,wmax
+
+
+
+      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_heig lalim ')
+      call test_ltherm(ngrid,nlay,pplay,lmin ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_heig lmin  ')
+      call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_heig lmix  ')
+      call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_heig lmax  ')
+
+      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_height'
+
+!-------------------------------------------------------------------------------
+! Fermeture,determination de f
+!-------------------------------------------------------------------------------
+!
+!
+      CALL thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star,  &
+    &                      lalim,lmin,zmax_sec,wmax_sec)
+
+ 
+call test_ltherm(ngrid,nlay,pplay,lmin,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_dry  lmin  ')
+call test_ltherm(ngrid,nlay,pplay,lalim,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_dry  lalim ')
+
+      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_dry'
+      if (prt_level.ge.10) then
+         write(lunout1,*) 'Dans thermcell_main 1b'
+         write(lunout1,*) 'lmin ',lmin(igout)
+         write(lunout1,*) 'lalim ',lalim(igout)
+         write(lunout1,*) ' ig l alim_star entr_star detr_star f_star '
+         write(lunout1,'(i6,i4,e15.5)') (igout,l,alim_star(igout,l) &
+     &    ,l=1,lalim(igout)+4)
+      endif
+
+
+
+
+! Choix de la fonction d'alimentation utilisee pour la fermeture.
+! Apparemment sans importance
+      alim_star_clos(:,:)=alim_star(:,:)
+      alim_star_clos(:,:)=entr_star(:,:)+alim_star(:,:)
+!
+!CR Appel de la fermeture seche 
+      if (iflag_thermals_closure.eq.1) then
+
+     CALL thermcell_closure(ngrid,nlay,r_aspect_thermals,ptimestep,rho,  &
+    &   zlev,lalim,alim_star_clos,zmax_sec,wmax_sec,f)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Appel avec les zmax et wmax tenant compte de la condensation
+! Semble moins bien marcher
+     else if (iflag_thermals_closure.eq.2) then
+
+     CALL thermcell_closure(ngrid,nlay,r_aspect_thermals,ptimestep,rho,  &
+    &   zlev,lalim,alim_star,zmax,wmax,f)
+
+
+     endif
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      if(prt_level.ge.1)print*,'thermcell_closure apres thermcell_closure'
+
+      if (tau_thermals>1.) then
+         lambda=exp(-ptimestep/tau_thermals)
+         f0=(1.-lambda)*f+lambda*f0
+      else
+         f0=f
+      endif
+
+! Test valable seulement en 1D mais pas genant
+      if (.not. (f0(1).ge.0.) ) then
+              abort_message = '.not. (f0(1).ge.0.)'
+              CALL abort_physic (modname,abort_message,1)
+      endif
+
+!-------------------------------------------------------------------------------
+!deduction des flux
+
+      CALL thermcell_flux2(ngrid,nlay,ptimestep,masse, &
+     &       lalim,lmax,alim_star,  &
+     &       entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr,  &
+     &       detr,zqla,lev_out,lunout1,igout)
+
+!IM 060508    &       detr,zqla,zmax,lev_out,lunout,igout)
+
+      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_flux'
+      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_flux lalim ')
+      call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_flux lmax  ')
+
+!------------------------------------------------------------------
+!   On ne prend pas directement les profils issus des calculs precedents
+!   mais on s'autorise genereusement une relaxation vers ceci avec
+!   une constante de temps tau_thermals (typiquement 1800s).
+!------------------------------------------------------------------
+
+      if (tau_thermals>1.) then
+         lambda=exp(-ptimestep/tau_thermals)
+         fm0=(1.-lambda)*fm+lambda*fm0
+         entr0=(1.-lambda)*entr+lambda*entr0
+         detr0=(1.-lambda)*detr+lambda*detr0
+      else
+         fm0=fm
+         entr0=entr
+         detr0=detr
+      endif
+
+!------------------------------------------------------------------
+! Calcul de la fraction de l'ascendance
+!------------------------------------------------------------------
+      do ig=1,ngrid
+         fraca(ig,1)=0.
+         fraca(ig,nlay+1)=0.
+      enddo
+      do l=2,nlay
+         do ig=1,ngrid
+            if (zw2(ig,l).gt.1.e-10) then
+            fraca(ig,l)=fm(ig,l)/(rhobarz(ig,l)*zw2(ig,l))
+            else
+            fraca(ig,l)=0.
+            endif
+         enddo
+      enddo
+     
+!c------------------------------------------------------------------
+!   calcul du transport vertical
+!------------------------------------------------------------------
+      IF (iflag_thermals_down .GT. 0) THEN
+        if (debut) print*,'WARNING !!! routine thermcell_down en cours de developpement'
+        entrdn=fact_thermals_down*detr0
+        detrdn=fact_thermals_down*entr0 
+        ! we want to transport potential temperature, total water and momentum
+        CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,zthl,zdthladj)
+        CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,p_o,pdoadj)
+        CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,zu,pduadj)
+        CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,zv,pdvadj)
+      ELSE
+      !--------------------------------------------------------------
+
+        ! Temperature potentielle liquide effectivement mélangée par les thermiques
+        do ll=1,nlay
+           do ig=1,ngrid
+              zthl(ig,ll)=ptemp(ig,ll)/zpspsk(ig,ll)
+           enddo
+        enddo
+        call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse,  &
+        &                    zthl,zdthladj,zta,lev_out)
+
+        do ll=1,nlay
+           do ig=1,ngrid
+              z_o(ig,ll)=p_o(ig,ll)
+           enddo
+        enddo
+        call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse,  &
+        &                   z_o,pdoadj,z_oa,lev_out)
+
+#ifdef ISO
+        ! C Risi: on utilise directement la meme routine
+        do ixt=1,ntiso
+          do ll=1,nlay
+            DO ig=1,ngrid
+                xtpo_tmp(ig,ll)=xtpo(ixt,ig,ll)
+                xtzo_tmp(ig,ll)=xtzo(ixt,ig,ll)
+            enddo
+          enddo
+          call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse,  &
+     &                   xtpo_tmp,xtpdoadj_tmp,xtzo_tmp,lev_out)
+          do ll=1,nlay
+            DO ig=1,ngrid
+                xtpdoadj(ixt,ig,ll)=xtpdoadj_tmp(ig,ll)
+            enddo
+          enddo
+        enddo
+#endif
+
+#ifdef ISO      
+#ifdef ISOVERIF
+      DO  ll=1,nlay
+        DO ig=1,ngrid
+          if (iso_eau.gt.0) then
+              call iso_verif_egalite(xtpo(iso_eau,ig,ll), &
+     &          p_o(ig,ll),'thermcell_main 594')
+              call iso_verif_egalite(xtpdoadj(iso_eau,ig,ll), &
+     &          pdoadj(ig,ll),'thermcell_main 596')
+          endif
+          if (iso_HDO.gt.0) then
+              call iso_verif_aberrant_encadre(xtpo(iso_hdo,ig,ll) &
+     &           /p_o(ig,ll),'thermcell_main 610')
+          endif
+        enddo
+      enddo !DO  ll=1,nlay 
+      write(*,*) 'thermcell_main 600 tmp: apres thermcell_dq'
+#endif      
+#endif
+
+
+!------------------------------------------------------------------
+!  calcul du transport vertical du moment horizontal
+!------------------------------------------------------------------
+
+!IM 090508  
+      if (dvdq == 0 ) then
+
+! Calcul du transport de V tenant compte d'echange par gradient
+! de pression horizontal avec l'environnement
+
+         call thermcell_dv2(ngrid,nlay,ptimestep,fm0,entr0,masse  &
+!    &    ,fraca*dvdq,zmax &
+     &    ,fraca,zmax &
+     &    ,zu,zv,pduadj,pdvadj,zua,zva,lev_out)
+
+      else
+
+! calcul purement conservatif pour le transport de V
+         call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse  &
+     &    ,zu,pduadj,zua,lev_out)
+         call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse  &
+     &    ,zv,pdvadj,zva,lev_out)
+
+      endif
+    ENDIF
+
+!     print*,'13 OK convect8'
+      do l=1,nlay
+         do ig=1,ngrid
+           pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l)  
+         enddo
+      enddo
+
+      if (prt_level.ge.1) print*,'14 OK convect8'
+!------------------------------------------------------------------
+!   Calculs de diagnostiques pour les sorties
+!------------------------------------------------------------------
+!calcul de fraca pour les sorties
+      
+      if (sorties) then
+      if (prt_level.ge.1) print*,'14a OK convect8'
+! calcul du niveau de condensation
+! initialisation
+      do ig=1,ngrid
+         nivcon(ig)=0
+         zcon(ig)=0.
+      enddo 
+!nouveau calcul
+      do ig=1,ngrid
+      ! WARNING !!! verifier que c'est bien ztemp_env qu'on veut là
+      CHI=ztemp_env(ig,1)/(1669.0-122.0*z_o(ig,1)/zqsat(ig,1)-ztemp_env(ig,1))
+      pcon(ig)=pplay(ig,1)*(z_o(ig,1)/zqsat(ig,1))**CHI
+      enddo
+!IM   do k=1,nlay
+      do k=1,nlay-1
+         do ig=1,ngrid
+         if ((pcon(ig).le.pplay(ig,k))  &
+     &      .and.(pcon(ig).gt.pplay(ig,k+1))) then
+            zcon2(ig)=zlay(ig,k)-(pcon(ig)-pplay(ig,k))/(RG*rho(ig,k))/100.
+         endif
+         enddo
+      enddo
+!IM
+      ierr=0
+      do ig=1,ngrid
+        if (pcon(ig).le.pplay(ig,nlay)) then 
+           zcon2(ig)=zlay(ig,nlay)-(pcon(ig)-pplay(ig,nlay))/(RG*rho(ig,nlay))/100.
+           ierr=1
+        endif
+      enddo
+      if (ierr==1) then
+           abort_message = 'thermcellV0_main: les thermiques vont trop haut '
+           CALL abort_physic (modname,abort_message,1)
+      endif
+
+      if (prt_level.ge.1) print*,'14b OK convect8'
+      do k=nlay,1,-1
+         do ig=1,ngrid
+            if (zqla(ig,k).gt.1e-10) then
+               nivcon(ig)=k
+               zcon(ig)=zlev(ig,k)
+            endif
+         enddo
+      enddo
+      if (prt_level.ge.1) print*,'14c OK convect8'
+!calcul des moments
+!initialisation
+      do l=1,nlay
+         do ig=1,ngrid
+            q2(ig,l)=0.
+            wth2(ig,l)=0.
+            wth3(ig,l)=0.
+            ratqscth(ig,l)=0.
+            ratqsdiff(ig,l)=0.
+         enddo
+      enddo      
+      if (prt_level.ge.1) print*,'14d OK convect8'
+      if (prt_level.ge.10)write(lunout,*)                                &
+    &     'WARNING thermcell_main wth2=0. si zw2 > 1.e-10'
+      do l=1,nlay
+         do ig=1,ngrid
+            zf=fraca(ig,l)
+            zf2=zf/(1.-zf)
+!
+            thetath2(ig,l)=zf2*(ztla(ig,l)-zthl(ig,l))**2
+            if(zw2(ig,l).gt.1.e-10) then
+             wth2(ig,l)=zf2*(zw2(ig,l))**2
+            else
+             wth2(ig,l)=0.
+            endif
+            wth3(ig,l)=zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l))  &
+     &                *zw2(ig,l)*zw2(ig,l)*zw2(ig,l)
+            q2(ig,l)=zf2*(zqta(ig,l)*1000.-p_o(ig,l)*1000.)**2
+!test: on calcul q2/p_o=ratqsc
+            ratqscth(ig,l)=sqrt(max(q2(ig,l),1.e-6)/(p_o(ig,l)*1000.))
+         enddo
+      enddo
+!calcul des flux: q, thetal et thetav
+      do l=1,nlay
+         do ig=1,ngrid
+      wq(ig,l)=fraca(ig,l)*zw2(ig,l)*(zqta(ig,l)*1000.-p_o(ig,l)*1000.)
+      wthl(ig,l)=fraca(ig,l)*zw2(ig,l)*(ztla(ig,l)-zthl(ig,l))
+      wthv(ig,l)=fraca(ig,l)*zw2(ig,l)*(ztva(ig,l)-ztv(ig,l))
+         enddo
+      enddo
+
+!calcul du ratqscdiff
+      if (prt_level.ge.1) print*,'14e OK convect8'
+      var=0.
+      vardiff=0.
+      ratqsdiff(:,:)=0.
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if (l<=lalim(ig)) then
+            var=var+alim_star(ig,l)*zqta(ig,l)*1000.
+            endif
+         enddo
+      enddo
+
+      if (prt_level.ge.1) print*,'14f OK convect8'
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if (l<=lalim(ig)) then
+               zf=fraca(ig,l)
+               zf2=zf/(1.-zf)
+               vardiff=vardiff+alim_star(ig,l)*(zqta(ig,l)*1000.-var)**2
+            endif
+         enddo
+      enddo
+
+      if (prt_level.ge.1) print*,'14g OK convect8'
+         do l=1,nlay
+            do ig=1,ngrid
+               ratqsdiff(ig,l)=sqrt(vardiff)/(p_o(ig,l)*1000.)   
+            enddo
+         enddo 
+      endif
+
+      if (prt_level.ge.1) print*,'thermcell_main FIN  OK'
+
+!print*,'thermcell_main fin'
+ RETURN
+      end subroutine thermcell_main
+
+!=============================================================================
+!/////////////////////////////////////////////////////////////////////////////
+!=============================================================================
+      subroutine test_ltherm(ngrid,nlay,pplay,long,ztv,p_o,ztva, &  ! in
+    &            zqla,f_star,zw2,comment)                          ! in
+!=============================================================================
+      USE lmdz_thermcell_ini, ONLY: prt_level
+      IMPLICIT NONE
+
+      integer i, k, ngrid,nlay
+      real, intent(in), dimension(ngrid,nlay) :: pplay,ztv,p_o,ztva,zqla
+      real, intent(in), dimension(ngrid,nlay) :: f_star,zw2
+      integer, intent(in), dimension(ngrid) :: long
+      real seuil
+      character*21 comment
+
+      seuil=0.25
+
+      if (prt_level.ge.1) THEN
+       print*,'WARNING !!! TEST ',comment
+      endif
+      return
+
+!  test sur la hauteur des thermiques ...
+         do i=1,ngrid
+!IMtemp           if (pplay(i,long(i)).lt.seuil*pplev(i,1)) then
+           if (prt_level.ge.10) then
+               print*,'WARNING ',comment,' au point ',i,' K= ',long(i)
+               print*,'  K  P(MB)  THV(K)     Qenv(g/kg)THVA        QLA(g/kg)   F*        W2'
+               do k=1,nlay
+                  write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*p_o(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k)
+               enddo
+           endif
+         enddo
+
+
+      return
+      end
+
+! nrlmd le 10/04/2012   Transport de la TKE par le thermique moyen pour la fermeture en ALP 
+!                       On transporte pbl_tke pour donner therm_tke
+!                       Copie conforme de la subroutine DTKE dans physiq.F ecrite par Frederic Hourdin
+
+!=======================================================================
+!///////////////////////////////////////////////////////////////////////
+!=======================================================================
+
+      subroutine thermcell_tke_transport( &
+     &     ngrid,nlay,ptimestep,fm0,entr0,rg,pplev,  &   ! in
+     &     therm_tke_max)                                ! out
+      USE lmdz_thermcell_ini, ONLY: prt_level
+      implicit none
+
+!=======================================================================
+!
+!   Calcul du transport verticale dans la couche limite en presence
+!   de "thermiques" explicitement representes
+!   calcul du dq/dt une fois qu'on connait les ascendances
+!
+!=======================================================================
+
+      integer ngrid,nlay
+
+      real, intent(in) :: ptimestep
+      real, intent(in), dimension(ngrid,nlay+1) :: fm0,pplev
+      real, intent(in), dimension(ngrid,nlay) :: entr0
+      real, intent(in) :: rg
+      real, intent(out), dimension(ngrid,nlay) :: therm_tke_max
+
+      real detr0(ngrid,nlay)
+      real masse0(ngrid,nlay)
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real entr(ngrid,nlay)
+      real q(ngrid,nlay)
+      integer lev_out                           ! niveau pour les print
+
+      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
+      integer ig,k
+
+
+      lev_out=0
+
+
+      if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0'
+
+!   calcul du detrainement
+      do k=1,nlay
+         detr0(:,k)=fm0(:,k)-fm0(:,k+1)+entr0(:,k)
+         masse0(:,k)=(pplev(:,k)-pplev(:,k+1))/RG
+      enddo
+
+
+! Decalage vertical des entrainements et detrainements.
+      masse(:,1)=0.5*masse0(:,1)
+      entr(:,1)=0.5*entr0(:,1)
+      detr(:,1)=0.5*detr0(:,1)
+      fm(:,1)=0.
+      do k=1,nlay-1
+         masse(:,k+1)=0.5*(masse0(:,k)+masse0(:,k+1))
+         entr(:,k+1)=0.5*(entr0(:,k)+entr0(:,k+1))
+         detr(:,k+1)=0.5*(detr0(:,k)+detr0(:,k+1))
+         fm(:,k+1)=fm(:,k)+entr(:,k)-detr(:,k)
+      enddo
+      fm(:,nlay+1)=0.
+
+
+   q(:,:)=therm_tke_max(:,:)
+!!! nrlmd le 16/09/2010
+      do ig=1,ngrid
+         qa(ig,1)=q(ig,1)
+      enddo
+!!!
+
+    if (1==1) then
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
+     &         1.e-5*masse(ig,k)) then
+         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
+     &         /(fm(ig,k+1)+detr(ig,k))
+            else
+               qa(ig,k)=q(ig,k)
+            endif
+            if (qa(ig,k).lt.0.) then
+!               print*,'qa<0!!!'
+            endif
+            if (q(ig,k).lt.0.) then
+!               print*,'q<0!!!'
+            endif
+         enddo
+      enddo
+
+! Calcul du flux subsident
+
+      do k=2,nlay
+         do ig=1,ngrid
+            wqd(ig,k)=fm(ig,k)*q(ig,k)
+            if (wqd(ig,k).lt.0.) then
+!               print*,'wqd<0!!!'
+            endif
+         enddo
+      enddo
+      do ig=1,ngrid
+         wqd(ig,1)=0.
+         wqd(ig,nlay+1)=0.
+      enddo
+
+! Calcul des tendances
+      do k=1,nlay
+         do ig=1,ngrid
+            q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)  &
+     &               -wqd(ig,k)+wqd(ig,k+1))  &
+     &               *ptimestep/masse(ig,k)
+         enddo
+      enddo
+
+ endif
+
+   therm_tke_max(:,:)=q(:,:)
+
+      return
+!!! fin nrlmd le 10/04/2012
+     end
+
+END MODULE lmdz_thermcell_main
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_old.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_old.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_old.F90	(revision 4727)
@@ -0,0 +1,6513 @@
+MODULE lmdz_thermcell_old
+CONTAINS
+
+SUBROUTINE thermcell_2002(ngrid, nlay, ptimestep, iflag_thermals, pplay, &
+    pplev, pphi, pu, pv, pt, po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0, &
+    fraca, wa_moy, r_aspect, l_mix, w2di, tho)
+
+  USE dimphy
+  USE write_field_phy
+  USE lmdz_thermcell_dv2, ONLY : thermcell_dv2
+  USE lmdz_thermcell_dq, ONLY : thermcell_dq
+  IMPLICIT NONE
+
+  ! =======================================================================
+
+  ! Calcul du transport verticale dans la couche limite en presence
+  ! de "thermiques" explicitement representes
+
+  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
+
+  ! le thermique est supposé homogène et dissipé par mélange avec
+  ! son environnement. la longueur l_mix contrôle l'efficacité du
+  ! mélange
+
+  ! Le calcul du transport des différentes espèces se fait en prenant
+  ! en compte:
+  ! 1. un flux de masse montant
+  ! 2. un flux de masse descendant
+  ! 3. un entrainement
+  ! 4. un detrainement
+
+  ! =======================================================================
+
+  ! -----------------------------------------------------------------------
+  ! declarations:
+  ! -------------
+
+  include "YOMCST.h"
+
+  ! arguments:
+  ! ----------
+
+  INTEGER ngrid, nlay, w2di, iflag_thermals
+  REAL tho
+  REAL ptimestep, l_mix, r_aspect
+  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
+  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
+  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
+  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
+  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
+  REAL pphi(ngrid, nlay)
+  REAL fraca(ngrid, nlay+1), zw2(ngrid, nlay+1)
+
+  INTEGER, SAVE :: idetr = 3, lev_out = 1
+  !$OMP THREADPRIVATE(idetr,lev_out)
+
+  ! local:
+  ! ------
+
+  INTEGER, SAVE :: dvdq = 0, flagdq = 0, dqimpl = 1
+  LOGICAL, SAVE :: debut = .TRUE.
+  !$OMP THREADPRIVATE(dvdq,flagdq,debut,dqimpl)
+
+  INTEGER ig, k, l, lmax(klon, klev+1), lmaxa(klon), lmix(klon)
+  REAL zmax(klon), zw, zz, ztva(klon, klev), zzz
+
+  REAL zlev(klon, klev+1), zlay(klon, klev)
+  REAL zh(klon, klev), zdhadj(klon, klev)
+  REAL ztv(klon, klev)
+  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
+  REAL wh(klon, klev+1)
+  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
+  REAL zla(klon, klev+1)
+  REAL zwa(klon, klev+1)
+  REAL zld(klon, klev+1)
+  REAL zwd(klon, klev+1)
+  REAL zsortie(klon, klev)
+  REAL zva(klon, klev)
+  REAL zua(klon, klev)
+  REAL zoa(klon, klev)
+
+  REAL zha(klon, klev)
+  REAL wa_moy(klon, klev+1)
+  REAL fracc(klon, klev+1)
+  REAL zf, zf2
+  REAL thetath2(klon, klev), wth2(klon, klev)
+  ! common/comtherm/thetath2,wth2
+
+  REAL count_time
+
+  LOGICAL sorties
+  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
+  REAL zpspsk(klon, klev)
+
+  REAL wmax(klon, klev), wmaxa(klon)
+
+  REAL wa(klon, klev, klev+1)
+  REAL wd(klon, klev+1)
+  REAL larg_part(klon, klev, klev+1)
+  REAL fracd(klon, klev+1)
+  REAL xxx(klon, klev+1)
+  REAL larg_cons(klon, klev+1)
+  REAL larg_detr(klon, klev+1)
+  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
+  REAL pu_therm(klon, klev), pv_therm(klon, klev)
+  REAL fm(klon, klev+1), entr(klon, klev)
+  REAL fmc(klon, klev+1)
+
+  CHARACTER (LEN=2) :: str2
+  CHARACTER (LEN=10) :: str10
+
+  CHARACTER (LEN=20) :: modname = 'thermcell2002'
+  CHARACTER (LEN=80) :: abort_message
+
+  LOGICAL vtest(klon), down
+
+  EXTERNAL scopy
+
+  INTEGER ncorrec, ll
+  SAVE ncorrec
+  DATA ncorrec/0/
+  !$OMP THREADPRIVATE(ncorrec)
+
+
+  ! -----------------------------------------------------------------------
+  ! initialisation:
+  ! ---------------
+
+  sorties = .TRUE.
+  IF (ngrid/=klon) THEN
+    PRINT *
+    PRINT *, 'STOP dans convadj'
+    PRINT *, 'ngrid    =', ngrid
+    PRINT *, 'klon  =', klon
+  END IF
+
+  ! -----------------------------------------------------------------------
+  ! incrementation eventuelle de tendances precedentes:
+  ! ---------------------------------------------------
+
+  ! print*,'0 OK convect8'
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
+      zh(ig, l) = pt(ig, l)/zpspsk(ig, l)
+      zu(ig, l) = pu(ig, l)
+      zv(ig, l) = pv(ig, l)
+      zo(ig, l) = po(ig, l)
+      ztv(ig, l) = zh(ig, l)*(1.+0.61*zo(ig,l))
+    END DO
+  END DO
+
+  ! print*,'1 OK convect8'
+  ! --------------------
+
+
+  ! + + + + + + + + + + +
+
+
+  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+  ! wh,wt,wo ...
+
+  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
+
+
+  ! --------------------   zlev(1)
+  ! \\\\\\\\\\\\\\\\\\\\
+
+
+
+  ! -----------------------------------------------------------------------
+  ! Calcul des altitudes des couches
+  ! -----------------------------------------------------------------------
+
+  IF (debut) THEN
+    flagdq = (iflag_thermals-1000)/100
+    dvdq = (iflag_thermals-(1000+flagdq*100))/10
+    IF (flagdq==2) dqimpl = -1
+    IF (flagdq==3) dqimpl = 1
+    debut = .FALSE.
+  END IF
+  PRINT *, 'TH flag th ', iflag_thermals, flagdq, dvdq, dqimpl
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    zlev(ig, 1) = 0.
+    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
+  END DO
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zlay(ig, l) = pphi(ig, l)/rg
+    END DO
+  END DO
+
+  ! print*,'2 OK convect8'
+  ! -----------------------------------------------------------------------
+  ! Calcul des densites
+  ! -----------------------------------------------------------------------
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*zh(ig,l))
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
+    END DO
+  END DO
+
+  DO k = 1, nlay
+    DO l = 1, nlay + 1
+      DO ig = 1, ngrid
+        wa(ig, k, l) = 0.
+      END DO
+    END DO
+  END DO
+
+  ! print*,'3 OK convect8'
+  ! ------------------------------------------------------------------
+  ! Calcul de w2, quarre de w a partir de la cape
+  ! a partir de w2, on calcule wa, vitesse de l'ascendance
+
+  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
+  ! w2 est stoke dans wa
+
+  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
+  ! independants par couches que pour calculer l'entrainement
+  ! a la base et la hauteur max de l'ascendance.
+
+  ! Indicages:
+  ! l'ascendance provenant du niveau k traverse l'interface l avec
+  ! une vitesse wa(k,l).
+
+  ! --------------------
+
+  ! + + + + + + + + + +
+
+  ! wa(k,l)   ----       --------------------    l
+  ! /\
+  ! /||\       + + + + + + + + + +
+  ! ||
+  ! ||        --------------------
+  ! ||
+  ! ||        + + + + + + + + + +
+  ! ||
+  ! ||        --------------------
+  ! ||__
+  ! |___      + + + + + + + + + +     k
+
+  ! --------------------
+
+
+
+  ! ------------------------------------------------------------------
+
+
+  DO k = 1, nlay - 1
+    DO ig = 1, ngrid
+      wa(ig, k, k) = 0.
+      wa(ig, k, k+1) = 2.*rg*(ztv(ig,k)-ztv(ig,k+1))/ztv(ig, k+1)* &
+        (zlev(ig,k+1)-zlev(ig,k))
+    END DO
+    DO l = k + 1, nlay - 1
+      DO ig = 1, ngrid
+        wa(ig, k, l+1) = wa(ig, k, l) + 2.*rg*(ztv(ig,k)-ztv(ig,l))/ztv(ig, l &
+          )*(zlev(ig,l+1)-zlev(ig,l))
+      END DO
+    END DO
+    DO ig = 1, ngrid
+      wa(ig, k, nlay+1) = 0.
+    END DO
+  END DO
+
+  ! print*,'4 OK convect8'
+  ! Calcul de la couche correspondant a la hauteur du thermique
+  DO k = 1, nlay - 1
+    DO ig = 1, ngrid
+      lmax(ig, k) = k
+    END DO
+    DO l = nlay, k + 1, -1
+      DO ig = 1, ngrid
+        IF (wa(ig,k,l)<=1.E-10) lmax(ig, k) = l - 1
+      END DO
+    END DO
+  END DO
+
+  ! print*,'5 OK convect8'
+  ! Calcule du w max du thermique
+  DO k = 1, nlay
+    DO ig = 1, ngrid
+      wmax(ig, k) = 0.
+    END DO
+  END DO
+
+  DO k = 1, nlay - 1
+    DO l = k, nlay
+      DO ig = 1, ngrid
+        IF (l<=lmax(ig,k)) THEN
+          wa(ig, k, l) = sqrt(wa(ig,k,l))
+          wmax(ig, k) = max(wmax(ig,k), wa(ig,k,l))
+        ELSE
+          wa(ig, k, l) = 0.
+        END IF
+      END DO
+    END DO
+  END DO
+
+  DO k = 1, nlay - 1
+    DO ig = 1, ngrid
+      pu_therm(ig, k) = sqrt(wmax(ig,k))
+      pv_therm(ig, k) = sqrt(wmax(ig,k))
+    END DO
+  END DO
+
+  ! print*,'6 OK convect8'
+  ! Longueur caracteristique correspondant a la hauteur des thermiques.
+  DO ig = 1, ngrid
+    zmax(ig) = 500.
+  END DO
+  ! print*,'LMAX LMAX LMAX '
+  DO k = 1, nlay - 1
+    DO ig = 1, ngrid
+      zmax(ig) = max(zmax(ig), zlev(ig,lmax(ig,k))-zlev(ig,k))
+    END DO
+    ! print*,k,lmax(1,k)
+  END DO
+  ! print*,'ZMAX ZMAX ZMAX ',zmax
+  ! call dump2d(iim,jjm-1,zmax(2:ngrid-1),'ZMAX      ')
+
+  ! print*,'OKl336'
+  ! Calcul de l'entrainement.
+  ! Le rapport d'aspect relie la largeur de l'ascendance a l'epaisseur
+  ! de la couche d'alimentation en partant du principe que la vitesse
+  ! maximum dans l'ascendance est la vitesse d'entrainement horizontale.
+  DO k = 1, nlay
+    DO ig = 1, ngrid
+      zzz = rho(ig, k)*wmax(ig, k)*(zlev(ig,k+1)-zlev(ig,k))/ &
+        (zmax(ig)*r_aspect)
+      IF (w2di==2) THEN
+        entr(ig, k) = entr(ig, k) + ptimestep*(zzz-entr(ig,k))/tho
+      ELSE
+        entr(ig, k) = zzz
+      END IF
+      ztva(ig, k) = ztv(ig, k)
+    END DO
+  END DO
+
+
+  ! print*,'7 OK convect8'
+  DO k = 1, klev + 1
+    DO ig = 1, ngrid
+      zw2(ig, k) = 0.
+      fmc(ig, k) = 0.
+      larg_cons(ig, k) = 0.
+      larg_detr(ig, k) = 0.
+      wa_moy(ig, k) = 0.
+    END DO
+  END DO
+
+  ! print*,'8 OK convect8'
+  DO ig = 1, ngrid
+    lmaxa(ig) = 1
+    lmix(ig) = 1
+    wmaxa(ig) = 0.
+  END DO
+
+
+  ! print*,'OKl372'
+  DO l = 1, nlay - 2
+    DO ig = 1, ngrid
+      ! if (zw2(ig,l).lt.1.e-10.and.ztv(ig,l).gt.ztv(ig,l+1)) then
+      ! print*,'COUCOU ',l,zw2(ig,l),ztv(ig,l),ztv(ig,l+1)
+      IF (zw2(ig,l)<1.E-10 .AND. ztv(ig,l)>ztv(ig,l+1) .AND. &
+          entr(ig,l)>1.E-10) THEN
+        ! print*,'COUCOU cas 1'
+        ! Initialisation de l'ascendance
+        ! lmix(ig)=1
+        ztva(ig, l) = ztv(ig, l)
+        fmc(ig, l) = 0.
+        fmc(ig, l+1) = entr(ig, l)
+        zw2(ig, l) = 0.
+        ! if (.not.ztv(ig,l+1).gt.150.) then
+        ! print*,'ig,l+1,ztv(ig,l+1)'
+        ! print*, ig,l+1,ztv(ig,l+1)
+        ! endif
+        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
+          (zlev(ig,l+1)-zlev(ig,l))
+        larg_detr(ig, l) = 0.
+      ELSE IF (zw2(ig,l)>=1.E-10 .AND. fmc(ig,l)+entr(ig,l)>1.E-10) THEN
+        ! Incrementation...
+        fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
+        ! if (.not.fmc(ig,l+1).gt.1.e-15) then
+        ! print*,'ig,l+1,fmc(ig,l+1)'
+        ! print*, ig,l+1,fmc(ig,l+1)
+        ! print*,'Fmc ',(fmc(ig,ll),ll=1,klev+1)
+        ! print*,'W2 ',(zw2(ig,ll),ll=1,klev+1)
+        ! print*,'Tv ',(ztv(ig,ll),ll=1,klev)
+        ! print*,'Entr ',(entr(ig,ll),ll=1,klev)
+        ! endif
+        ztva(ig, l) = (fmc(ig,l)*ztva(ig,l-1)+entr(ig,l)*ztv(ig,l))/ &
+          fmc(ig, l+1)
+        ! mise a jour de la vitesse ascendante (l'air entraine de la couche
+        ! consideree commence avec une vitesse nulle).
+        zw2(ig, l+1) = zw2(ig, l)*(fmc(ig,l)/fmc(ig,l+1))**2 + &
+          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
+      END IF
+      IF (zw2(ig,l+1)<0.) THEN
+        zw2(ig, l+1) = 0.
+        lmaxa(ig) = l
+      ELSE
+        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
+      END IF
+      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
+        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
+        lmix(ig) = l + 1
+        wmaxa(ig) = wa_moy(ig, l+1)
+      END IF
+      ! print*,'COUCOU cas 2 LMIX=',lmix(ig),wa_moy(ig,l+1),wmaxa(ig)
+    END DO
+  END DO
+
+  ! print*,'9 OK convect8'
+  ! print*,'WA1 ',wa_moy
+
+  ! determination de l'indice du debut de la mixed layer ou w decroit
+
+  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
+  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
+  ! d'une couche est égale à la hauteur de la couche alimentante.
+  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
+  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
+
+  ! print*,'OKl439'
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmaxa(ig)) THEN
+        zw = max(wa_moy(ig,l), 1.E-10)
+        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
+      END IF
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmaxa(ig)) THEN
+        ! if (idetr.eq.0) then
+        ! cette option est finalement en dur.
+        larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
+        ! else if (idetr.eq.1) then
+        ! larg_detr(ig,l)=larg_cons(ig,l)
+        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
+        ! else if (idetr.eq.2) then
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        ! s            *sqrt(wa_moy(ig,l))
+        ! else if (idetr.eq.4) then
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        ! s            *wa_moy(ig,l)
+        ! endif
+      END IF
+    END DO
+  END DO
+
+  ! print*,'10 OK convect8'
+  ! print*,'WA2 ',wa_moy
+  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
+  ! compte de l'epluchage du thermique.
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (larg_cons(ig,l)>1.) THEN
+        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
+        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
+        IF (l>lmix(ig)) THEN
+          xxx(ig, l) = (lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
+          IF (idetr==0) THEN
+            fraca(ig, l) = fraca(ig, lmix(ig))
+          ELSE IF (idetr==1) THEN
+            fraca(ig, l) = fraca(ig, lmix(ig))*xxx(ig, l)
+          ELSE IF (idetr==2) THEN
+            fraca(ig, l) = fraca(ig, lmix(ig))*(1.-(1.-xxx(ig,l))**2)
+          ELSE
+            fraca(ig, l) = fraca(ig, lmix(ig))*xxx(ig, l)**2
+          END IF
+        END IF
+        ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
+        fraca(ig, l) = max(fraca(ig,l), 0.)
+        fraca(ig, l) = min(fraca(ig,l), 0.5)
+        fracd(ig, l) = 1. - fraca(ig, l)
+        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
+      ELSE
+        ! wa_moy(ig,l)=0.
+        fraca(ig, l) = 0.
+        fracc(ig, l) = 0.
+        fracd(ig, l) = 1.
+      END IF
+    END DO
+  END DO
+
+  ! print*,'11 OK convect8'
+  ! print*,'Ea3 ',wa_moy
+  ! ------------------------------------------------------------------
+  ! Calcul de fracd, wd
+  ! somme wa - wd = 0
+  ! ------------------------------------------------------------------
+
+
+  DO ig = 1, ngrid
+    fm(ig, 1) = 0.
+    fm(ig, nlay+1) = 0.
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
+    END DO
+    DO ig = 1, ngrid
+      IF (fracd(ig,l)<0.1) THEN
+        abort_message = 'fracd trop petit'
+        CALL abort_physic(modname, abort_message, 1)
+      ELSE
+        ! vitesse descendante "diagnostique"
+        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
+    END DO
+  END DO
+
+  ! print*,'12 OK convect8'
+  ! print*,'WA4 ',wa_moy
+  ! c------------------------------------------------------------------
+  ! calcul du transport vertical
+  ! ------------------------------------------------------------------
+
+  GO TO 4444
+  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
+  DO l = 2, nlay - 1
+    DO ig = 1, ngrid
+      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
+          ig,l+1)) THEN
+        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
+        ! s         ,fm(ig,l+1)*ptimestep
+        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
+        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
+        ! s         ,entr(ig,l)*ptimestep
+        ! s         ,'   M=',masse(ig,l)
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
+        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
+        ! s         ,'   FM=',fm(ig,l)
+      END IF
+      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
+        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
+        ! s         ,'   M=',masse(ig,l)
+        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
+        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
+        ! print*,'zlev(ig,l+1),zlev(ig,l)'
+        ! s                ,zlev(ig,l+1),zlev(ig,l)
+        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
+        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
+      END IF
+      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
+        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
+        ! s         ,'   E=',entr(ig,l)
+      END IF
+    END DO
+  END DO
+
+4444 CONTINUE
+  ! print*,'OK 444 '
+
+  IF (w2di==1) THEN
+    fm0 = fm0 + ptimestep*(fm-fm0)/tho
+    entr0 = entr0 + ptimestep*(entr-entr0)/tho
+  ELSE
+    fm0 = fm
+    entr0 = entr
+  END IF
+
+  IF (flagdq==0) THEN
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zh, zdhadj, &
+      zha)
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zo, pdoadj, &
+      zoa)
+    PRINT *, 'THERMALS OPT 1'
+  ELSE IF (flagdq==1) THEN
+    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
+      zdhadj, zha)
+    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
+      pdoadj, zoa)
+    PRINT *, 'THERMALS OPT 2'
+  ELSE
+    CALL thermcell_dq(ngrid, nlay, dqimpl, ptimestep, fm0, entr0, masse, zh, &
+      zdhadj, zha, lev_out)
+    CALL thermcell_dq(ngrid, nlay, dqimpl, ptimestep, fm0, entr0, masse, zo, &
+      pdoadj, zoa, lev_out)
+    PRINT *, 'THERMALS OPT 3', dqimpl
+  END IF
+
+  PRINT *, 'TH VENT ', dvdq
+  IF (dvdq==0) THEN
+    ! print*,'TH VENT OK ',dvdq
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
+      zua)
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
+      zva)
+  ELSE IF (dvdq==1) THEN
+    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
+      zu, zv, pduadj, pdvadj, zua, zva)
+  ELSE IF (dvdq==2) THEN
+    CALL thermcell_dv2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, &
+      zmax, zu, zv, pduadj, pdvadj, zua, zva, lev_out)
+  ELSE IF (dvdq==3) THEN
+    CALL thermcell_dq(ngrid, nlay, dqimpl, ptimestep, fm0, entr0, masse, zu, &
+      pduadj, zua, lev_out)
+    CALL thermcell_dq(ngrid, nlay, dqimpl, ptimestep, fm0, entr0, masse, zv, &
+      pdvadj, zva, lev_out)
+  END IF
+
+  ! CALL writefield_phy('duadj',pduadj,klev)
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
+      zf2 = zf/(1.-zf)
+      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
+      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
+    END DO
+  END DO
+
+
+
+  ! print*,'13 OK convect8'
+  ! print*,'WA5 ',wa_moy
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      pdtadj(ig, l) = zdhadj(ig, l)*zpspsk(ig, l)
+    END DO
+  END DO
+
+
+  ! do l=1,nlay
+  ! do ig=1,ngrid
+  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
+  ! print*,'WARN!!! ig=',ig,'  l=',l
+  ! s         ,'   pdtadj=',pdtadj(ig,l)
+  ! endif
+  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
+  ! print*,'WARN!!! ig=',ig,'  l=',l
+  ! s         ,'   pdoadj=',pdoadj(ig,l)
+  ! endif
+  ! enddo
+  ! enddo
+
+  ! print*,'14 OK convect8'
+  ! ------------------------------------------------------------------
+  ! Calculs pour les sorties
+  ! ------------------------------------------------------------------
+
+  IF (sorties) THEN
+    DO l = 1, nlay
+      DO ig = 1, ngrid
+        zla(ig, l) = (1.-fracd(ig,l))*zmax(ig)
+        zld(ig, l) = fracd(ig, l)*zmax(ig)
+        IF (1.-fracd(ig,l)>1.E-10) zwa(ig, l) = wd(ig, l)*fracd(ig, l)/ &
+          (1.-fracd(ig,l))
+      END DO
+    END DO
+
+    DO l = 1, nlay
+      DO ig = 1, ngrid
+        detr(ig, l) = fm(ig, l) + entr(ig, l) - fm(ig, l+1)
+        IF (detr(ig,l)<0.) THEN
+          entr(ig, l) = entr(ig, l) - detr(ig, l)
+          detr(ig, l) = 0.
+          ! print*,'WARNING !!! detrainement negatif ',ig,l
+        END IF
+      END DO
+    END DO
+  END IF
+
+  ! print*,'15 OK convect8'
+
+
+  ! if(wa_moy(1,4).gt.1.e-10) stop
+
+  ! print*,'19 OK convect8'
+  RETURN
+END SUBROUTINE thermcell_2002
+
+SUBROUTINE thermcell_cld(ngrid, nlay, ptimestep, pplay, pplev, pphi, zlev, &
+    debut, pu, pv, pt, po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0, zqla, &
+    lmax, zmax_sec, wmax_sec, zw_sec, lmix_sec, ratqscth, ratqsdiff & ! s
+                                                                      ! ,pu_therm,pv_therm
+    , r_aspect, l_mix, w2di, tho)
+
+  USE dimphy
+  IMPLICIT NONE
+
+  ! =======================================================================
+
+  ! Calcul du transport verticale dans la couche limite en presence
+  ! de "thermiques" explicitement representes
+
+  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
+
+  ! le thermique est supposé homogène et dissipé par mélange avec
+  ! son environnement. la longueur l_mix contrôle l'efficacité du
+  ! mélange
+
+  ! Le calcul du transport des différentes espèces se fait en prenant
+  ! en compte:
+  ! 1. un flux de masse montant
+  ! 2. un flux de masse descendant
+  ! 3. un entrainement
+  ! 4. un detrainement
+
+  ! =======================================================================
+
+  ! -----------------------------------------------------------------------
+  ! declarations:
+  ! -------------
+
+  include "YOMCST.h"
+  include "YOETHF.h"
+  include "FCTTRE.h"
+
+  ! arguments:
+  ! ----------
+
+  INTEGER ngrid, nlay, w2di
+  REAL tho
+  REAL ptimestep, l_mix, r_aspect
+  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
+  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
+  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
+  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
+  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
+  REAL pphi(ngrid, nlay)
+
+  INTEGER idetr
+  SAVE idetr
+  DATA idetr/3/
+  !$OMP THREADPRIVATE(idetr)
+
+  ! local:
+  ! ------
+
+  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
+  REAL zsortie1d(klon)
+  ! CR: on remplace lmax(klon,klev+1)
+  INTEGER lmax(klon), lmin(klon), lentr(klon)
+  REAL linter(klon)
+  REAL zmix(klon), fracazmix(klon)
+  REAL alpha
+  SAVE alpha
+  DATA alpha/1./
+  !$OMP THREADPRIVATE(alpha)
+
+  ! RC
+  REAL zmax(klon), zw, zz, zw2(klon, klev+1), ztva(klon, klev), zzz
+  REAL zmax_sec(klon)
+  REAL zmax_sec2(klon)
+  REAL zw_sec(klon, klev+1)
+  INTEGER lmix_sec(klon)
+  REAL w_est(klon, klev+1)
+  ! on garde le zmax du pas de temps precedent
+  ! real zmax0(klon)
+  ! save zmax0
+  ! real zmix0(klon)
+  ! save zmix0
+  REAL, SAVE, ALLOCATABLE :: zmax0(:), zmix0(:)
+  !$OMP THREADPRIVATE(zmax0, zmix0)
+
+  REAL zlev(klon, klev+1), zlay(klon, klev)
+  REAL deltaz(klon, klev)
+  REAL zh(klon, klev), zdhadj(klon, klev)
+  REAL zthl(klon, klev), zdthladj(klon, klev)
+  REAL ztv(klon, klev)
+  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
+  REAL zl(klon, klev)
+  REAL wh(klon, klev+1)
+  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
+  REAL zla(klon, klev+1)
+  REAL zwa(klon, klev+1)
+  REAL zld(klon, klev+1)
+  REAL zwd(klon, klev+1)
+  REAL zsortie(klon, klev)
+  REAL zva(klon, klev)
+  REAL zua(klon, klev)
+  REAL zoa(klon, klev)
+
+  REAL zta(klon, klev)
+  REAL zha(klon, klev)
+  REAL wa_moy(klon, klev+1)
+  REAL fraca(klon, klev+1)
+  REAL fracc(klon, klev+1)
+  REAL zf, zf2
+  REAL thetath2(klon, klev), wth2(klon, klev), wth3(klon, klev)
+  REAL q2(klon, klev)
+  REAL dtheta(klon, klev)
+  ! common/comtherm/thetath2,wth2
+
+  REAL ratqscth(klon, klev)
+  REAL sum
+  REAL sumdiff
+  REAL ratqsdiff(klon, klev)
+  REAL count_time
+  INTEGER ialt
+
+  LOGICAL sorties
+  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
+  REAL zpspsk(klon, klev)
+
+  ! real wmax(klon,klev),wmaxa(klon)
+  REAL wmax(klon), wmaxa(klon)
+  REAL wmax_sec(klon)
+  REAL wmax_sec2(klon)
+  REAL wa(klon, klev, klev+1)
+  REAL wd(klon, klev+1)
+  REAL larg_part(klon, klev, klev+1)
+  REAL fracd(klon, klev+1)
+  REAL xxx(klon, klev+1)
+  REAL larg_cons(klon, klev+1)
+  REAL larg_detr(klon, klev+1)
+  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
+  REAL massetot(klon, klev)
+  REAL detr0(klon, klev)
+  REAL alim0(klon, klev)
+  REAL pu_therm(klon, klev), pv_therm(klon, klev)
+  REAL fm(klon, klev+1), entr(klon, klev)
+  REAL fmc(klon, klev+1)
+
+  REAL zcor, zdelta, zcvm5, qlbef
+  REAL tbef(klon), qsatbef(klon)
+  REAL dqsat_dt, dt, num, denom
+  REAL reps, rlvcp, ddt0
+  REAL ztla(klon, klev), zqla(klon, klev), zqta(klon, klev)
+  ! CR niveau de condensation
+  REAL nivcon(klon)
+  REAL zcon(klon)
+  REAL zqsat(klon, klev)
+  REAL zqsatth(klon, klev)
+  PARAMETER (ddt0=.01)
+
+
+  ! CR:nouvelles variables
+  REAL f_star(klon, klev+1), entr_star(klon, klev)
+  REAL detr_star(klon, klev)
+  REAL alim_star_tot(klon), alim_star2(klon)
+  REAL entr_star_tot(klon)
+  REAL detr_star_tot(klon)
+  REAL alim_star(klon, klev)
+  REAL alim(klon, klev)
+  REAL nu(klon, klev)
+  REAL nu_e(klon, klev)
+  REAL nu_min
+  REAL nu_max
+  REAL nu_r
+  REAL f(klon)
+  ! real f(klon), f0(klon)
+  ! save f0
+  REAL, SAVE, ALLOCATABLE :: f0(:)
+  !$OMP THREADPRIVATE(f0)
+
+  REAL f_old
+  REAL zlevinter(klon)
+  LOGICAL, SAVE :: first = .TRUE.
+  !$OMP THREADPRIVATE(first)
+  ! data first /.false./
+  ! save first
+  LOGICAL nuage
+  ! save nuage
+  LOGICAL boucle
+  LOGICAL therm
+  LOGICAL debut
+  LOGICAL rale
+  INTEGER test(klon)
+  INTEGER signe_zw2
+  ! RC
+
+  CHARACTER *2 str2
+  CHARACTER *10 str10
+
+  CHARACTER (LEN=20) :: modname = 'thermcell_cld'
+  CHARACTER (LEN=80) :: abort_message
+
+  LOGICAL vtest(klon), down
+  LOGICAL zsat(klon)
+
+  EXTERNAL scopy
+
+  INTEGER ncorrec, ll
+  SAVE ncorrec
+  DATA ncorrec/0/
+  !$OMP THREADPRIVATE(ncorrec)
+
+
+
+  ! -----------------------------------------------------------------------
+  ! initialisation:
+  ! ---------------
+
+  IF (first) THEN
+    ALLOCATE (zmix0(klon))
+    ALLOCATE (zmax0(klon))
+    ALLOCATE (f0(klon))
+    first = .FALSE.
+  END IF
+
+  sorties = .FALSE.
+  ! print*,'NOUVEAU DETR PLUIE '
+  IF (ngrid/=klon) THEN
+    PRINT *
+    PRINT *, 'STOP dans convadj'
+    PRINT *, 'ngrid    =', ngrid
+    PRINT *, 'klon  =', klon
+  END IF
+
+  ! Initialisation
+  rlvcp = rlvtt/rcpd
+  reps = rd/rv
+  ! initialisations de zqsat
+  DO ll = 1, nlay
+    DO ig = 1, ngrid
+      zqsat(ig, ll) = 0.
+      zqsatth(ig, ll) = 0.
+    END DO
+  END DO
+
+  ! on met le first a true pour le premier passage de la journée
+  DO ig = 1, klon
+    test(ig) = 0
+  END DO
+  IF (debut) THEN
+    DO ig = 1, klon
+      test(ig) = 1
+      f0(ig) = 0.
+      zmax0(ig) = 0.
+    END DO
+  END IF
+  DO ig = 1, klon
+    IF ((.NOT. debut) .AND. (f0(ig)<1.E-10)) THEN
+      test(ig) = 1
+    END IF
+  END DO
+  ! do ig=1,klon
+  ! print*,'test(ig)',test(ig),zmax0(ig)
+  ! enddo
+  nuage = .FALSE.
+  ! -----------------------------------------------------------------------
+  ! AM Calcul de T,q,ql a partir de Tl et qT
+  ! ---------------------------------------------------
+
+  ! Pr Tprec=Tl calcul de qsat
+  ! Si qsat>qT T=Tl, q=qT
+  ! Sinon DDT=(-Tprec+Tl+RLVCP (qT-qsat(T')) / (1+RLVCP dqsat/dt)
+  ! On cherche DDT < DDT0
+
+  ! defaut
+  DO ll = 1, nlay
+    DO ig = 1, ngrid
+      zo(ig, ll) = po(ig, ll)
+      zl(ig, ll) = 0.
+      zh(ig, ll) = pt(ig, ll)
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    zsat(ig) = .FALSE.
+  END DO
+
+
+  DO ll = 1, nlay
+    ! les points insatures sont definitifs
+    DO ig = 1, ngrid
+      tbef(ig) = pt(ig, ll)
+      zdelta = max(0., sign(1.,rtt-tbef(ig)))
+      qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, ll)
+      qsatbef(ig) = min(0.5, qsatbef(ig))
+      zcor = 1./(1.-retv*qsatbef(ig))
+      qsatbef(ig) = qsatbef(ig)*zcor
+      zsat(ig) = (max(0.,po(ig,ll)-qsatbef(ig))>1.E-10)
+    END DO
+
+    DO ig = 1, ngrid
+      IF (zsat(ig) .AND. (1==1)) THEN
+        qlbef = max(0., po(ig,ll)-qsatbef(ig))
+        ! si sature: ql est surestime, d'ou la sous-relax
+        dt = 0.5*rlvcp*qlbef
+        ! write(18,*),'DT0=',DT
+        ! on pourra enchainer 2 ou 3 calculs sans Do while
+        DO WHILE (abs(dt)>ddt0)
+          ! il faut verifier si c,a conserve quand on repasse en insature ...
+          tbef(ig) = tbef(ig) + dt
+          zdelta = max(0., sign(1.,rtt-tbef(ig)))
+          qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, ll)
+          qsatbef(ig) = min(0.5, qsatbef(ig))
+          zcor = 1./(1.-retv*qsatbef(ig))
+          qsatbef(ig) = qsatbef(ig)*zcor
+          ! on veut le signe de qlbef
+          qlbef = po(ig, ll) - qsatbef(ig)
+          zdelta = max(0., sign(1.,rtt-tbef(ig)))
+          zcvm5 = r5les*(1.-zdelta) + r5ies*zdelta
+          zcor = 1./(1.-retv*qsatbef(ig))
+          dqsat_dt = foede(tbef(ig), zdelta, zcvm5, qsatbef(ig), zcor)
+          num = -tbef(ig) + pt(ig, ll) + rlvcp*qlbef
+          denom = 1. + rlvcp*dqsat_dt
+          IF (denom<1.E-10) THEN
+            PRINT *, 'pb denom'
+          END IF
+          dt = num/denom
+        END DO
+        ! on ecrit de maniere conservative (sat ou non)
+        zl(ig, ll) = max(0., qlbef)
+        ! T = Tl +Lv/Cp ql
+        zh(ig, ll) = pt(ig, ll) + rlvcp*zl(ig, ll)
+        zo(ig, ll) = po(ig, ll) - zl(ig, ll)
+      END IF
+      ! on ecrit zqsat
+      zqsat(ig, ll) = qsatbef(ig)
+    END DO
+  END DO
+  ! AM fin
+
+  ! -----------------------------------------------------------------------
+  ! incrementation eventuelle de tendances precedentes:
+  ! ---------------------------------------------------
+
+  ! print*,'0 OK convect8'
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zpspsk(ig, l) = (pplay(ig,l)/100000.)**rkappa
+      ! zpspsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**RKAPPA
+      ! zh(ig,l)=pt(ig,l)/zpspsk(ig,l)
+      zu(ig, l) = pu(ig, l)
+      zv(ig, l) = pv(ig, l)
+      ! zo(ig,l)=po(ig,l)
+      ! ztv(ig,l)=zh(ig,l)*(1.+0.61*zo(ig,l))
+      ! AM attention zh est maintenant le profil de T et plus le profil de
+      ! theta !
+
+      ! T-> Theta
+      ztv(ig, l) = zh(ig, l)/zpspsk(ig, l)
+      ! AM Theta_v
+      ztv(ig, l) = ztv(ig, l)*(1.+retv*(zo(ig,l))-zl(ig,l))
+      ! AM Thetal
+      zthl(ig, l) = pt(ig, l)/zpspsk(ig, l)
+
+    END DO
+  END DO
+
+  ! print*,'1 OK convect8'
+  ! --------------------
+
+
+  ! + + + + + + + + + + +
+
+
+  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+  ! wh,wt,wo ...
+
+  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
+
+
+  ! --------------------   zlev(1)
+  ! \\\\\\\\\\\\\\\\\\\\
+
+
+
+  ! -----------------------------------------------------------------------
+  ! Calcul des altitudes des couches
+  ! -----------------------------------------------------------------------
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    zlev(ig, 1) = 0.
+    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
+  END DO
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zlay(ig, l) = pphi(ig, l)/rg
+    END DO
+  END DO
+  ! calcul de deltaz
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      deltaz(ig, l) = zlev(ig, l+1) - zlev(ig, l)
+    END DO
+  END DO
+
+  ! print*,'2 OK convect8'
+  ! -----------------------------------------------------------------------
+  ! Calcul des densites
+  ! -----------------------------------------------------------------------
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      ! rho(ig,l)=pplay(ig,l)/(zpspsk(ig,l)*RD*zh(ig,l))
+      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*ztv(ig,l))
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
+    END DO
+  END DO
+
+  DO k = 1, nlay
+    DO l = 1, nlay + 1
+      DO ig = 1, ngrid
+        wa(ig, k, l) = 0.
+      END DO
+    END DO
+  END DO
+  ! Cr:ajout:calcul de la masse
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
+    END DO
+  END DO
+  ! print*,'3 OK convect8'
+  ! ------------------------------------------------------------------
+  ! Calcul de w2, quarre de w a partir de la cape
+  ! a partir de w2, on calcule wa, vitesse de l'ascendance
+
+  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
+  ! w2 est stoke dans wa
+
+  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
+  ! independants par couches que pour calculer l'entrainement
+  ! a la base et la hauteur max de l'ascendance.
+
+  ! Indicages:
+  ! l'ascendance provenant du niveau k traverse l'interface l avec
+  ! une vitesse wa(k,l).
+
+  ! --------------------
+
+  ! + + + + + + + + + +
+
+  ! wa(k,l)   ----       --------------------    l
+  ! /\
+  ! /||\       + + + + + + + + + +
+  ! ||
+  ! ||        --------------------
+  ! ||
+  ! ||        + + + + + + + + + +
+  ! ||
+  ! ||        --------------------
+  ! ||__
+  ! |___      + + + + + + + + + +     k
+
+  ! --------------------
+
+
+
+  ! ------------------------------------------------------------------
+
+  ! CR: ponderation entrainement des couches instables
+  ! def des alim_star tels que alim=f*alim_star
+  DO l = 1, klev
+    DO ig = 1, ngrid
+      alim_star(ig, l) = 0.
+      alim(ig, l) = 0.
+    END DO
+  END DO
+  ! determination de la longueur de la couche d entrainement
+  DO ig = 1, ngrid
+    lentr(ig) = 1
+  END DO
+
+  ! on ne considere que les premieres couches instables
+  therm = .FALSE.
+  DO k = nlay - 2, 1, -1
+    DO ig = 1, ngrid
+      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<=ztv(ig,k+2)) THEN
+        lentr(ig) = k + 1
+        therm = .TRUE.
+      END IF
+    END DO
+  END DO
+
+  ! determination du lmin: couche d ou provient le thermique
+  DO ig = 1, ngrid
+    lmin(ig) = 1
+  END DO
+  DO ig = 1, ngrid
+    DO l = nlay, 2, -1
+      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
+        lmin(ig) = l - 1
+      END IF
+    END DO
+  END DO
+
+  ! definition de l'entrainement des couches
+  DO l = 1, klev - 1
+    DO ig = 1, ngrid
+      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<lentr(ig)) THEN
+        ! def possibles pour alim_star: zdthetadz, dthetadz, zdtheta
+        alim_star(ig, l) = max((ztv(ig,l)-ztv(ig,l+1)), 0.) & ! s
+                                                              ! *(zlev(ig,l+1)-zlev(ig,l))
+          *sqrt(zlev(ig,l+1))
+        ! alim_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
+        ! s                         /zlev(ig,lentr(ig)+2)))**(3./2.)
+      END IF
+    END DO
+  END DO
+
+  ! pas de thermique si couche 1 stable
+  DO ig = 1, ngrid
+    ! if (lmin(ig).gt.1) then
+    ! CRnouveau test
+    IF (alim_star(ig,1)<1.E-10) THEN
+      DO l = 1, klev
+        alim_star(ig, l) = 0.
+      END DO
+    END IF
+  END DO
+  ! calcul de l entrainement total
+  DO ig = 1, ngrid
+    alim_star_tot(ig) = 0.
+    entr_star_tot(ig) = 0.
+    detr_star_tot(ig) = 0.
+  END DO
+  DO ig = 1, ngrid
+    DO k = 1, klev
+      alim_star_tot(ig) = alim_star_tot(ig) + alim_star(ig, k)
+    END DO
+  END DO
+
+  ! Calcul entrainement normalise
+  DO ig = 1, ngrid
+    IF (alim_star_tot(ig)>1.E-10) THEN
+      ! do l=1,lentr(ig)
+      DO l = 1, klev
+        ! def possibles pour entr_star: zdthetadz, dthetadz, zdtheta
+        alim_star(ig, l) = alim_star(ig, l)/alim_star_tot(ig)
+      END DO
+    END IF
+  END DO
+
+  ! print*,'fin calcul alim_star'
+
+  ! AM:initialisations
+  DO k = 1, nlay
+    DO ig = 1, ngrid
+      ztva(ig, k) = ztv(ig, k)
+      ztla(ig, k) = zthl(ig, k)
+      zqla(ig, k) = 0.
+      zqta(ig, k) = po(ig, k)
+      zsat(ig) = .FALSE.
+    END DO
+  END DO
+  DO k = 1, klev
+    DO ig = 1, ngrid
+      detr_star(ig, k) = 0.
+      entr_star(ig, k) = 0.
+      detr(ig, k) = 0.
+      entr(ig, k) = 0.
+    END DO
+  END DO
+  ! print*,'7 OK convect8'
+  DO k = 1, klev + 1
+    DO ig = 1, ngrid
+      zw2(ig, k) = 0.
+      fmc(ig, k) = 0.
+      ! CR
+      f_star(ig, k) = 0.
+      ! RC
+      larg_cons(ig, k) = 0.
+      larg_detr(ig, k) = 0.
+      wa_moy(ig, k) = 0.
+    END DO
+  END DO
+
+  ! n     print*,'8 OK convect8'
+  DO ig = 1, ngrid
+    linter(ig) = 1.
+    lmaxa(ig) = 1
+    lmix(ig) = 1
+    wmaxa(ig) = 0.
+  END DO
+
+  nu_min = l_mix
+  nu_max = 1000.
+  ! do ig=1,ngrid
+  ! nu_max=wmax_sec(ig)
+  ! enddo
+  DO ig = 1, ngrid
+    DO k = 1, klev
+      nu(ig, k) = 0.
+      nu_e(ig, k) = 0.
+    END DO
+  END DO
+  ! Calcul de l'excès de température du à la diffusion turbulente
+  DO ig = 1, ngrid
+    DO l = 1, klev
+      dtheta(ig, l) = 0.
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    DO l = 1, lentr(ig) - 1
+      dtheta(ig, l) = sqrt(10.*0.4*zlev(ig,l+1)**2*1.*((ztv(ig,l+1)- &
+        ztv(ig,l))/(zlev(ig,l+1)-zlev(ig,l)))**2)
+    END DO
+  END DO
+  ! do l=1,nlay-2
+  DO l = 1, klev - 1
+    DO ig = 1, ngrid
+      IF (ztv(ig,l)>ztv(ig,l+1) .AND. alim_star(ig,l)>1.E-10 .AND. &
+          zw2(ig,l)<1E-10) THEN
+        ! AM
+        ! test:on rajoute un excès de T dans couche alim
+        ! ztla(ig,l)=zthl(ig,l)+dtheta(ig,l)
+        ztla(ig, l) = zthl(ig, l)
+        ! test: on rajoute un excès de q dans la couche alim
+        ! zqta(ig,l)=po(ig,l)+0.001
+        zqta(ig, l) = po(ig, l)
+        zqla(ig, l) = zl(ig, l)
+        ! AM
+        f_star(ig, l+1) = alim_star(ig, l)
+        ! test:calcul de dteta
+        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
+          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
+        w_est(ig, l+1) = zw2(ig, l+1)
+        larg_detr(ig, l) = 0.
+        ! print*,'coucou boucle 1'
+      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+alim_star(ig, &
+          l))>1.E-10) THEN
+        ! print*,'coucou boucle 2'
+        ! estimation du detrainement a partir de la geometrie du pas
+        ! precedent
+        IF ((test(ig)==1) .OR. ((.NOT. debut) .AND. (f0(ig)<1.E-10))) THEN
+          detr_star(ig, l) = 0.
+          entr_star(ig, l) = 0.
+          ! print*,'coucou test(ig)',test(ig),f0(ig),zmax0(ig)
+        ELSE
+          ! print*,'coucou debut detr'
+          ! tests sur la definition du detr
+          IF (zqla(ig,l-1)>1.E-10) THEN
+            nuage = .TRUE.
+          END IF
+
+          w_est(ig, l+1) = zw2(ig, l)*((f_star(ig,l))**2)/(f_star(ig,l)+ &
+            alim_star(ig,l))**2 + 2.*rg*(ztva(ig,l-1)-ztv(ig,l))/ztv(ig, l)*( &
+            zlev(ig,l+1)-zlev(ig,l))
+          IF (w_est(ig,l+1)<0.) THEN
+            w_est(ig, l+1) = zw2(ig, l)
+          END IF
+          IF (l>2) THEN
+            IF ((w_est(ig,l+1)>w_est(ig,l)) .AND. (zlev(ig, &
+                l+1)<zmax_sec(ig)) .AND. (zqla(ig,l-1)<1.E-10)) THEN
+              detr_star(ig, l) = max(0., (rhobarz(ig, &
+                l+1)*sqrt(w_est(ig,l+1))*sqrt(nu(ig,l)* &
+                zlev(ig,l+1))-rhobarz(ig,l)*sqrt(w_est(ig,l))*sqrt(nu(ig,l)* &
+                zlev(ig,l)))/(r_aspect*zmax_sec(ig)))
+            ELSE IF ((zlev(ig,l+1)<zmax_sec(ig)) .AND. (zqla(ig, &
+                l-1)<1.E-10)) THEN
+              detr_star(ig, l) = -f0(ig)*f_star(ig, lmix(ig))/(rhobarz(ig, &
+                lmix(ig))*wmaxa(ig))*(rhobarz(ig,l+1)*sqrt(w_est(ig, &
+                l+1))*((zmax_sec(ig)-zlev(ig,l+1))/((zmax_sec(ig)-zlev(ig, &
+                lmix(ig)))))**2.-rhobarz(ig,l)*sqrt(w_est(ig, &
+                l))*((zmax_sec(ig)-zlev(ig,l))/((zmax_sec(ig)-zlev(ig,lmix(ig &
+                )))))**2.)
+            ELSE
+              detr_star(ig, l) = 0.002*f0(ig)*f_star(ig, l)* &
+                (zlev(ig,l+1)-zlev(ig,l))
+
+            END IF
+          ELSE
+            detr_star(ig, l) = 0.
+          END IF
+
+          detr_star(ig, l) = detr_star(ig, l)/f0(ig)
+          IF (nuage) THEN
+            entr_star(ig, l) = 0.4*detr_star(ig, l)
+          ELSE
+            entr_star(ig, l) = 0.4*detr_star(ig, l)
+          END IF
+
+          IF ((detr_star(ig,l))>f_star(ig,l)) THEN
+            detr_star(ig, l) = f_star(ig, l)
+            ! entr_star(ig,l)=0.
+          END IF
+
+          IF ((l<lentr(ig))) THEN
+            entr_star(ig, l) = 0.
+            ! detr_star(ig,l)=0.
+          END IF
+
+          ! print*,'ok detr_star'
+        END IF
+        ! prise en compte du detrainement dans le calcul du flux
+        f_star(ig, l+1) = f_star(ig, l) + alim_star(ig, l) + &
+          entr_star(ig, l) - detr_star(ig, l)
+        ! test
+        ! if (f_star(ig,l+1).lt.0.) then
+        ! f_star(ig,l+1)=0.
+        ! entr_star(ig,l)=0.
+        ! detr_star(ig,l)=f_star(ig,l)+alim_star(ig,l)
+        ! endif
+        ! test sur le signe de f_star
+        IF (f_star(ig,l+1)>1.E-10) THEN
+          ! then
+          ! test
+          ! if (((f_star(ig,l+1)+detr_star(ig,l)).gt.1.e-10)) then
+          ! AM on melange Tl et qt du thermique
+          ! on rajoute un excès de T dans la couche alim
+          ! if (l.lt.lentr(ig)) then
+          ! ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+
+          ! s
+          ! (alim_star(ig,l)+entr_star(ig,l))*(zthl(ig,l)+dtheta(ig,l)))
+          ! s     /(f_star(ig,l+1)+detr_star(ig,l))
+          ! else
+          ztla(ig, l) = (f_star(ig,l)*ztla(ig,l-1)+(alim_star(ig, &
+            l)+entr_star(ig,l))*zthl(ig,l))/(f_star(ig,l+1)+detr_star(ig,l))
+          ! s                    /(f_star(ig,l+1))
+          ! endif
+          ! on rajoute un excès de q dans la couche alim
+          ! if (l.lt.lentr(ig)) then
+          ! zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+
+          ! s           (alim_star(ig,l)+entr_star(ig,l))*(po(ig,l)+0.001))
+          ! s                 /(f_star(ig,l+1)+detr_star(ig,l))
+          ! else
+          zqta(ig, l) = (f_star(ig,l)*zqta(ig,l-1)+(alim_star(ig, &
+            l)+entr_star(ig,l))*po(ig,l))/(f_star(ig,l+1)+detr_star(ig,l))
+          ! s                   /(f_star(ig,l+1))
+          ! endif
+          ! AM on en deduit thetav et ql du thermique
+          ! CR test
+          ! Tbef(ig)=ztla(ig,l)*zpspsk(ig,l)
+          tbef(ig) = ztla(ig, l)*zpspsk(ig, l)
+          zdelta = max(0., sign(1.,rtt-tbef(ig)))
+          qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, l)
+          qsatbef(ig) = min(0.5, qsatbef(ig))
+          zcor = 1./(1.-retv*qsatbef(ig))
+          qsatbef(ig) = qsatbef(ig)*zcor
+          zsat(ig) = (max(0.,zqta(ig,l)-qsatbef(ig))>1.E-10)
+
+          IF (zsat(ig) .AND. (1==1)) THEN
+            qlbef = max(0., zqta(ig,l)-qsatbef(ig))
+            dt = 0.5*rlvcp*qlbef
+            ! write(17,*)'DT0=',DT
+            DO WHILE (abs(dt)>ddt0)
+              ! print*,'aie'
+              tbef(ig) = tbef(ig) + dt
+              zdelta = max(0., sign(1.,rtt-tbef(ig)))
+              qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, l)
+              qsatbef(ig) = min(0.5, qsatbef(ig))
+              zcor = 1./(1.-retv*qsatbef(ig))
+              qsatbef(ig) = qsatbef(ig)*zcor
+              qlbef = zqta(ig, l) - qsatbef(ig)
+
+              zdelta = max(0., sign(1.,rtt-tbef(ig)))
+              zcvm5 = r5les*(1.-zdelta) + r5ies*zdelta
+              zcor = 1./(1.-retv*qsatbef(ig))
+              dqsat_dt = foede(tbef(ig), zdelta, zcvm5, qsatbef(ig), zcor)
+              num = -tbef(ig) + ztla(ig, l)*zpspsk(ig, l) + rlvcp*qlbef
+              denom = 1. + rlvcp*dqsat_dt
+              IF (denom<1.E-10) THEN
+                PRINT *, 'pb denom'
+              END IF
+              dt = num/denom
+              ! write(17,*)'DT=',DT
+            END DO
+            zqla(ig, l) = max(0., zqta(ig,l)-qsatbef(ig))
+            zqla(ig, l) = max(0., qlbef)
+            ! zqla(ig,l)=0.
+          END IF
+          ! zqla(ig,l) = max(0.,zqta(ig,l)-qsatbef(ig))
+
+          ! on ecrit de maniere conservative (sat ou non)
+          ! T = Tl +Lv/Cp ql
+          ! CR rq utilisation de humidite specifique ou rapport de melange?
+          ztva(ig, l) = ztla(ig, l)*zpspsk(ig, l) + rlvcp*zqla(ig, l)
+          ztva(ig, l) = ztva(ig, l)/zpspsk(ig, l)
+          ! on rajoute le calcul de zha pour diagnostiques (temp potentielle)
+          zha(ig, l) = ztva(ig, l)
+          ! if (l.lt.lentr(ig)) then
+          ! ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)
+          ! s              -zqla(ig,l))-zqla(ig,l)) + 0.1
+          ! else
+          ztva(ig, l) = ztva(ig, l)*(1.+retv*(zqta(ig,l)-zqla(ig, &
+            l))-zqla(ig,l))
+          ! endif
+          ! ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
+          ! s                 /(1.-retv*zqla(ig,l))
+          ! ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
+          ! ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)
+          ! s                 /(1.-retv*zqta(ig,l))
+          ! s              -zqla(ig,l)/(1.-retv*zqla(ig,l)))
+          ! s              -zqla(ig,l)/(1.-retv*zqla(ig,l)))
+          ! write(13,*)zqla(ig,l),zqla(ig,l)/(1.-retv*zqla(ig,l))
+          ! on ecrit zqsat
+          zqsatth(ig, l) = qsatbef(ig)
+          ! enddo
+          ! DO ig=1,ngrid
+          ! if (zw2(ig,l).ge.1.e-10.and.
+          ! s               f_star(ig,l)+entr_star(ig,l).gt.1.e-10) then
+          ! mise a jour de la vitesse ascendante (l'air entraine de la couche
+          ! consideree commence avec une vitesse nulle).
+
+          ! if (f_star(ig,l+1).gt.1.e-10) then
+          zw2(ig, l+1) = zw2(ig, l)* & ! s
+                                       ! ((f_star(ig,l)-detr_star(ig,l))**2)
+          ! s                  /f_star(ig,l+1)**2+
+            ((f_star(ig,l))**2)/(f_star(ig,l+1)+detr_star(ig,l))**2 + & ! s
+                                                                        ! /(f_star(ig,l+1))**2+
+            2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
+          ! s                   *(f_star(ig,l)/f_star(ig,l+1))**2
+
+        END IF
+      END IF
+
+      IF (zw2(ig,l+1)<0.) THEN
+        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
+          ig,l))
+        zw2(ig, l+1) = 0.
+        ! print*,'linter=',linter(ig)
+        ! else if ((zw2(ig,l+1).lt.1.e-10).and.(zw2(ig,l+1).ge.0.)) then
+        ! linter(ig)=l+1
+        ! print*,'linter=l',zw2(ig,l),zw2(ig,l+1)
+      ELSE
+        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
+        ! wa_moy(ig,l+1)=zw2(ig,l+1)
+      END IF
+      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
+        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
+        lmix(ig) = l + 1
+        wmaxa(ig) = wa_moy(ig, l+1)
+      END IF
+    END DO
+  END DO
+  PRINT *, 'fin calcul zw2'
+
+  ! Calcul de la couche correspondant a la hauteur du thermique
+  DO ig = 1, ngrid
+    lmax(ig) = lentr(ig)
+  END DO
+  DO ig = 1, ngrid
+    DO l = nlay, lentr(ig) + 1, -1
+      IF (zw2(ig,l)<=1.E-10) THEN
+        lmax(ig) = l - 1
+      END IF
+    END DO
+  END DO
+  ! pas de thermique si couche 1 stable
+  DO ig = 1, ngrid
+    IF (lmin(ig)>1) THEN
+      lmax(ig) = 1
+      lmin(ig) = 1
+      lentr(ig) = 1
+    END IF
+  END DO
+
+  ! Determination de zw2 max
+  DO ig = 1, ngrid
+    wmax(ig) = 0.
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmax(ig)) THEN
+        IF (zw2(ig,l)<0.) THEN
+          PRINT *, 'pb2 zw2<0'
+        END IF
+        zw2(ig, l) = sqrt(zw2(ig,l))
+        wmax(ig) = max(wmax(ig), zw2(ig,l))
+      ELSE
+        zw2(ig, l) = 0.
+      END IF
+    END DO
+  END DO
+
+  ! Longueur caracteristique correspondant a la hauteur des thermiques.
+  DO ig = 1, ngrid
+    zmax(ig) = 0.
+    zlevinter(ig) = zlev(ig, 1)
+  END DO
+  DO ig = 1, ngrid
+    ! calcul de zlevinter
+    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
+      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
+    ! pour le cas ou on prend tjs lmin=1
+    ! zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
+    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,1))
+    zmax0(ig) = zmax(ig)
+    WRITE (11, *) 'ig,lmax,linter', ig, lmax(ig), linter(ig)
+    WRITE (12, *) 'ig,zlevinter,zmax', ig, zmax(ig), zlevinter(ig)
+  END DO
+
+  ! Calcul de zmax_sec et wmax_sec
+  CALL fermeture_seche(ngrid, nlay, pplay, pplev, pphi, zlev, rhobarz, f0, &
+    zpspsk, alim, zh, zo, lentr, lmin, nu_min, nu_max, r_aspect, zmax_sec2, &
+    wmax_sec2)
+
+  PRINT *, 'avant fermeture'
+  ! Fermeture,determination de f
+  ! en lmax f=d-e
+  DO ig = 1, ngrid
+    ! entr_star(ig,lmax(ig))=0.
+    ! f_star(ig,lmax(ig)+1)=0.
+    ! detr_star(ig,lmax(ig))=f_star(ig,lmax(ig))+entr_star(ig,lmax(ig))
+    ! s                       +alim_star(ig,lmax(ig))
+  END DO
+
+  DO ig = 1, ngrid
+    alim_star2(ig) = 0.
+  END DO
+  ! calcul de entr_star_tot
+  DO ig = 1, ngrid
+    DO k = 1, lmix(ig)
+      entr_star_tot(ig) = entr_star_tot(ig) & ! s
+                                              ! +entr_star(ig,k)
+        +alim_star(ig, k)
+      ! s                        -detr_star(ig,k)
+      detr_star_tot(ig) = detr_star_tot(ig) & ! s
+                                              ! +alim_star(ig,k)
+        -detr_star(ig, k) + entr_star(ig, k)
+    END DO
+  END DO
+
+  DO ig = 1, ngrid
+    IF (alim_star_tot(ig)<1.E-10) THEN
+      f(ig) = 0.
+    ELSE
+      ! do k=lmin(ig),lentr(ig)
+      DO k = 1, lentr(ig)
+        alim_star2(ig) = alim_star2(ig) + alim_star(ig, k)**2/(rho(ig,k)*( &
+          zlev(ig,k+1)-zlev(ig,k)))
+      END DO
+      IF ((zmax_sec(ig)>1.E-10) .AND. (1==1)) THEN
+        f(ig) = wmax_sec(ig)/(max(500.,zmax_sec(ig))*r_aspect*alim_star2(ig))
+        f(ig) = f(ig) + (f0(ig)-f(ig))*exp((-ptimestep/zmax_sec(ig))*wmax_sec &
+          (ig))
+      ELSE
+        f(ig) = wmax(ig)/(max(500.,zmax(ig))*r_aspect*alim_star2(ig))
+        f(ig) = f(ig) + (f0(ig)-f(ig))*exp((-ptimestep/zmax(ig))*wmax(ig))
+      END IF
+    END IF
+    f0(ig) = f(ig)
+  END DO
+  PRINT *, 'apres fermeture'
+  ! Calcul de l'entrainement
+  DO ig = 1, ngrid
+    DO k = 1, klev
+      alim(ig, k) = f(ig)*alim_star(ig, k)
+    END DO
+  END DO
+  ! CR:test pour entrainer moins que la masse
+  ! do ig=1,ngrid
+  ! do l=1,lentr(ig)
+  ! if ((alim(ig,l)*ptimestep).gt.(0.9*masse(ig,l))) then
+  ! alim(ig,l+1)=alim(ig,l+1)+alim(ig,l)
+  ! s                       -0.9*masse(ig,l)/ptimestep
+  ! alim(ig,l)=0.9*masse(ig,l)/ptimestep
+  ! endif
+  ! enddo
+  ! enddo
+  ! calcul du détrainement
+  DO ig = 1, klon
+    DO k = 1, klev
+      detr(ig, k) = f(ig)*detr_star(ig, k)
+      IF (detr(ig,k)<0.) THEN
+        ! print*,'detr1<0!!!'
+      END IF
+    END DO
+    DO k = 1, klev
+      entr(ig, k) = f(ig)*entr_star(ig, k)
+      IF (entr(ig,k)<0.) THEN
+        ! print*,'entr1<0!!!'
+      END IF
+    END DO
+  END DO
+
+  ! do ig=1,ngrid
+  ! do l=1,klev
+  ! if (((detr(ig,l)+entr(ig,l)+alim(ig,l))*ptimestep).gt.
+  ! s          (masse(ig,l))) then
+  ! print*,'d2+e2+a2>m2','ig=',ig,'l=',l,'lmax(ig)=',lmax(ig),'d+e+a='
+  ! s,(detr(ig,l)+entr(ig,l)+alim(ig,l))*ptimestep,'m=',masse(ig,l)
+  ! endif
+  ! enddo
+  ! enddo
+  ! Calcul des flux
+
+  DO ig = 1, ngrid
+    DO l = 1, lmax(ig)
+      ! do l=1,klev
+      ! fmc(ig,l+1)=f(ig)*f_star(ig,l+1)
+      fmc(ig, l+1) = fmc(ig, l) + alim(ig, l) + entr(ig, l) - detr(ig, l)
+      ! print*,'??!!','ig=',ig,'l=',l,'lmax=',lmax(ig),'lmix=',lmix(ig),
+      ! s  'e=',entr(ig,l),'d=',detr(ig,l),'a=',alim(ig,l),'f=',fmc(ig,l),
+      ! s  'f+1=',fmc(ig,l+1)
+      IF (fmc(ig,l+1)<0.) THEN
+        PRINT *, 'fmc1<0', l + 1, lmax(ig), fmc(ig, l+1)
+        fmc(ig, l+1) = fmc(ig, l)
+        detr(ig, l) = alim(ig, l) + entr(ig, l)
+        ! fmc(ig,l+1)=0.
+        ! print*,'fmc1<0',l+1,lmax(ig),fmc(ig,l+1)
+      END IF
+      ! if ((fmc(ig,l+1).gt.fmc(ig,l)).and.(l.gt.lentr(ig))) then
+      ! f_old=fmc(ig,l+1)
+      ! fmc(ig,l+1)=fmc(ig,l)
+      ! detr(ig,l)=detr(ig,l)+f_old-fmc(ig,l+1)
+      ! endif
+
+      ! if ((fmc(ig,l+1).gt.fmc(ig,l)).and.(l.gt.lentr(ig))) then
+      ! f_old=fmc(ig,l+1)
+      ! fmc(ig,l+1)=fmc(ig,l)
+      ! detr(ig,l)=detr(ig,l)+f_old-fmc(ig,l)
+      ! endif
+      ! rajout du test sur alpha croissant
+      ! if test
+      ! if (1.eq.0) then
+
+      IF (l==klev) THEN
+        PRINT *, 'THERMCELL PB ig=', ig, '   l=', l
+        abort_message = 'THERMCELL PB'
+        CALL abort_physic(modname, abort_message, 1)
+      END IF
+      ! if ((zw2(ig,l+1).gt.1.e-10).and.(zw2(ig,l).gt.1.e-10).and.
+      ! s     (l.ge.lentr(ig)).and.
+      IF ((zw2(ig,l+1)>1.E-10) .AND. (zw2(ig,l)>1.E-10) .AND. (l>=lentr(ig))) &
+          THEN
+        IF (((fmc(ig,l+1)/(rhobarz(ig,l+1)*zw2(ig,l+1)))>(fmc(ig,l)/ &
+            (rhobarz(ig,l)*zw2(ig,l))))) THEN
+          f_old = fmc(ig, l+1)
+          fmc(ig, l+1) = fmc(ig, l)*rhobarz(ig, l+1)*zw2(ig, l+1)/ &
+            (rhobarz(ig,l)*zw2(ig,l))
+          detr(ig, l) = detr(ig, l) + f_old - fmc(ig, l+1)
+          ! detr(ig,l)=(fmc(ig,l+1)-fmc(ig,l))/(0.4-1.)
+          ! entr(ig,l)=0.4*detr(ig,l)
+          ! entr(ig,l)=fmc(ig,l+1)-fmc(ig,l)+detr(ig,l)
+        END IF
+      END IF
+      IF ((fmc(ig,l+1)>fmc(ig,l)) .AND. (l>lentr(ig))) THEN
+        f_old = fmc(ig, l+1)
+        fmc(ig, l+1) = fmc(ig, l)
+        detr(ig, l) = detr(ig, l) + f_old - fmc(ig, l+1)
+      END IF
+      IF (detr(ig,l)>fmc(ig,l)) THEN
+        detr(ig, l) = fmc(ig, l)
+        entr(ig, l) = fmc(ig, l+1) - alim(ig, l)
+      END IF
+      IF (fmc(ig,l+1)<0.) THEN
+        detr(ig, l) = detr(ig, l) + fmc(ig, l+1)
+        fmc(ig, l+1) = 0.
+        PRINT *, 'fmc2<0', l + 1, lmax(ig)
+      END IF
+
+      ! test pour ne pas avoir f=0 et d=e/=0
+      ! if (fmc(ig,l+1).lt.1.e-10) then
+      ! detr(ig,l+1)=0.
+      ! entr(ig,l+1)=0.
+      ! zqla(ig,l+1)=0.
+      ! zw2(ig,l+1)=0.
+      ! lmax(ig)=l+1
+      ! zmax(ig)=zlev(ig,lmax(ig))
+      ! endif
+      IF (zw2(ig,l+1)>1.E-10) THEN
+        IF ((((fmc(ig,l+1))/(rhobarz(ig,l+1)*zw2(ig,l+1)))>1.)) THEN
+          f_old = fmc(ig, l+1)
+          fmc(ig, l+1) = rhobarz(ig, l+1)*zw2(ig, l+1)
+          zw2(ig, l+1) = 0.
+          zqla(ig, l+1) = 0.
+          detr(ig, l) = detr(ig, l) + f_old - fmc(ig, l+1)
+          lmax(ig) = l + 1
+          zmax(ig) = zlev(ig, lmax(ig))
+          PRINT *, 'alpha>1', l + 1, lmax(ig)
+        END IF
+      END IF
+      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+      ! endif test
+      ! endif
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    ! if (fmc(ig,lmax(ig)+1).ne.0.) then
+    fmc(ig, lmax(ig)+1) = 0.
+    entr(ig, lmax(ig)) = 0.
+    detr(ig, lmax(ig)) = fmc(ig, lmax(ig)) + entr(ig, lmax(ig)) + &
+      alim(ig, lmax(ig))
+    ! endif
+  END DO
+  ! test sur le signe de fmc
+  DO ig = 1, ngrid
+    DO l = 1, klev + 1
+      IF (fmc(ig,l)<0.) THEN
+        PRINT *, 'fm1<0!!!', 'ig=', ig, 'l=', l, 'a=', alim(ig, l-1), 'e=', &
+          entr(ig, l-1), 'f=', fmc(ig, l-1), 'd=', detr(ig, l-1), 'f+1=', &
+          fmc(ig, l)
+      END IF
+    END DO
+  END DO
+  ! test de verification
+  DO ig = 1, ngrid
+    DO l = 1, lmax(ig)
+      IF ((abs(fmc(ig,l+1)-fmc(ig,l)-alim(ig,l)-entr(ig,l)+ &
+          detr(ig,l)))>1.E-4) THEN
+        ! print*,'pbcm!!','ig=',ig,'l=',l,'lmax=',lmax(ig),'lmix=',lmix(ig),
+        ! s  'e=',entr(ig,l),'d=',detr(ig,l),'a=',alim(ig,l),'f=',fmc(ig,l),
+        ! s  'f+1=',fmc(ig,l+1)
+      END IF
+      IF (detr(ig,l)<0.) THEN
+        PRINT *, 'detrdemi<0!!!'
+      END IF
+    END DO
+  END DO
+
+  ! RC
+  ! CR def de  zmix continu (profil parabolique des vitesses)
+  DO ig = 1, ngrid
+    IF (lmix(ig)>1.) THEN
+      ! test
+      IF (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
+          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
+          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))- &
+          (zlev(ig,lmix(ig)))))>1E-10) THEN
+
+        zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)) &
+          )**2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
+          lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
+          (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
+          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
+          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
+      ELSE
+        zmix(ig) = zlev(ig, lmix(ig))
+        PRINT *, 'pb zmix'
+      END IF
+    ELSE
+      zmix(ig) = 0.
+    END IF
+    ! test
+    IF ((zmax(ig)-zmix(ig))<=0.) THEN
+      zmix(ig) = 0.9*zmax(ig)
+      ! print*,'pb zmix>zmax'
+    END IF
+  END DO
+  DO ig = 1, klon
+    zmix0(ig) = zmix(ig)
+  END DO
+
+  ! calcul du nouveau lmix correspondant
+  DO ig = 1, ngrid
+    DO l = 1, klev
+      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
+        lmix(ig) = l
+      END IF
+    END DO
+  END DO
+
+  ! ne devrait pas arriver!!!!!
+  DO ig = 1, ngrid
+    DO l = 1, klev
+      IF (detr(ig,l)>(fmc(ig,l)+alim(ig,l))+entr(ig,l)) THEN
+        PRINT *, 'detr2>fmc2!!!', 'ig=', ig, 'l=', l, 'd=', detr(ig, l), &
+          'f=', fmc(ig, l), 'lmax=', lmax(ig)
+        ! detr(ig,l)=fmc(ig,l)+alim(ig,l)+entr(ig,l)
+        ! entr(ig,l)=0.
+        ! fmc(ig,l+1)=0.
+        ! zw2(ig,l+1)=0.
+        ! zqla(ig,l+1)=0.
+        PRINT *, 'pb!fm=0 et f_star>0', l, lmax(ig)
+        ! lmax(ig)=l
+      END IF
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    DO l = lmax(ig) + 1, klev + 1
+      ! fmc(ig,l)=0.
+      ! detr(ig,l)=0.
+      ! entr(ig,l)=0.
+      ! zw2(ig,l)=0.
+      ! zqla(ig,l)=0.
+    END DO
+  END DO
+
+  ! Calcul du detrainement lors du premier passage
+  ! print*,'9 OK convect8'
+  ! print*,'WA1 ',wa_moy
+
+  ! determination de l'indice du debut de la mixed layer ou w decroit
+
+  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
+  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
+  ! d'une couche est égale à la hauteur de la couche alimentante.
+  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
+  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmax(ig) .AND. (test(ig)==1)) THEN
+        zw = max(wa_moy(ig,l), 1.E-10)
+        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
+      END IF
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmax(ig) .AND. (test(ig)==1)) THEN
+        ! if (idetr.eq.0) then
+        ! cette option est finalement en dur.
+        IF ((l_mix*zlev(ig,l))<0.) THEN
+          PRINT *, 'pb l_mix*zlev<0'
+        END IF
+        ! CR: test: nouvelle def de lambda
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        IF (zw2(ig,l)>1.E-10) THEN
+          larg_detr(ig, l) = sqrt((l_mix/zw2(ig,l))*zlev(ig,l))
+        ELSE
+          larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
+        END IF
+        ! else if (idetr.eq.1) then
+        ! larg_detr(ig,l)=larg_cons(ig,l)
+        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
+        ! else if (idetr.eq.2) then
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        ! s            *sqrt(wa_moy(ig,l))
+        ! else if (idetr.eq.4) then
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        ! s            *wa_moy(ig,l)
+        ! endif
+      END IF
+    END DO
+  END DO
+
+  ! print*,'10 OK convect8'
+  ! print*,'WA2 ',wa_moy
+  ! cal1cul de la fraction de la maille concernée par l'ascendance en tenant
+  ! compte de l'epluchage du thermique.
+
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (larg_cons(ig,l)>1. .AND. (test(ig)==1)) THEN
+        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
+        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
+        ! test
+        fraca(ig, l) = max(fraca(ig,l), 0.)
+        fraca(ig, l) = min(fraca(ig,l), 0.5)
+        fracd(ig, l) = 1. - fraca(ig, l)
+        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
+      ELSE
+        ! wa_moy(ig,l)=0.
+        fraca(ig, l) = 0.
+        fracc(ig, l) = 0.
+        fracd(ig, l) = 1.
+      END IF
+    END DO
+  END DO
+  ! CR: calcul de fracazmix
+  DO ig = 1, ngrid
+    IF (test(ig)==1) THEN
+      fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
+        (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
+        fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca( &
+        ig,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
+    END IF
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (larg_cons(ig,l)>1. .AND. (test(ig)==1)) THEN
+        IF (l>lmix(ig)) THEN
+          ! test
+          IF (zmax(ig)-zmix(ig)<1.E-10) THEN
+            ! print*,'pb xxx'
+            xxx(ig, l) = (lmax(ig)+1.-l)/(lmax(ig)+1.-lmix(ig))
+          ELSE
+            xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
+          END IF
+          IF (idetr==0) THEN
+            fraca(ig, l) = fracazmix(ig)
+          ELSE IF (idetr==1) THEN
+            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
+          ELSE IF (idetr==2) THEN
+            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
+          ELSE
+            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
+          END IF
+          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
+          fraca(ig, l) = max(fraca(ig,l), 0.)
+          fraca(ig, l) = min(fraca(ig,l), 0.5)
+          fracd(ig, l) = 1. - fraca(ig, l)
+          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
+        END IF
+      END IF
+    END DO
+  END DO
+
+  PRINT *, 'fin calcul fraca'
+  ! print*,'11 OK convect8'
+  ! print*,'Ea3 ',wa_moy
+  ! ------------------------------------------------------------------
+  ! Calcul de fracd, wd
+  ! somme wa - wd = 0
+  ! ------------------------------------------------------------------
+
+
+  DO ig = 1, ngrid
+    fm(ig, 1) = 0.
+    fm(ig, nlay+1) = 0.
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (test(ig)==1) THEN
+        fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
+        ! CR:test
+        IF (alim(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) &
+            THEN
+          fm(ig, l) = fm(ig, l-1)
+          ! write(1,*)'ajustement fm, l',l
+        END IF
+        ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+        ! RC
+      END IF
+    END DO
+    DO ig = 1, ngrid
+      IF (fracd(ig,l)<0.1 .AND. (test(ig)==1)) THEN
+        abort_message = 'fracd trop petit'
+        CALL abort_physic(modname, abort_message, 1)
+      ELSE
+        ! vitesse descendante "diagnostique"
+        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay + 1
+    DO ig = 1, ngrid
+      IF (test(ig)==0) THEN
+        fm(ig, l) = fmc(ig, l)
+      END IF
+    END DO
+  END DO
+
+  ! fin du first
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
+    END DO
+  END DO
+
+  ! print*,'12 OK convect8'
+  ! print*,'WA4 ',wa_moy
+  ! c------------------------------------------------------------------
+  ! calcul du transport vertical
+  ! ------------------------------------------------------------------
+
+  GO TO 4444
+  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
+  DO l = 2, nlay - 1
+    DO ig = 1, ngrid
+      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
+          ig,l+1)) THEN
+        PRINT *, 'WARN!!! FM>M ig=', ig, ' l=', l, '  FM=', &
+          fm(ig, l+1)*ptimestep, '   M=', masse(ig, l), masse(ig, l+1)
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF ((alim(ig,l)+entr(ig,l))*ptimestep>masse(ig,l)) THEN
+        PRINT *, 'WARN!!! E>M ig=', ig, ' l=', l, '  E==', &
+          (entr(ig,l)+alim(ig,l))*ptimestep, '   M=', masse(ig, l)
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
+        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
+        ! s         ,'   FM=',fm(ig,l)
+      END IF
+      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
+        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
+        ! s         ,'   M=',masse(ig,l)
+        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
+        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
+        ! print*,'zlev(ig,l+1),zlev(ig,l)'
+        ! s                ,zlev(ig,l+1),zlev(ig,l)
+        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
+        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
+      END IF
+      IF (.NOT. alim(ig,l)>=0. .OR. .NOT. alim(ig,l)<=10.) THEN
+        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
+        ! s         ,'   E=',entr(ig,l)
+      END IF
+    END DO
+  END DO
+
+4444 CONTINUE
+
+  ! CR:redefinition du entr
+  ! CR:test:on ne change pas la def du entr mais la def du fm
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (test(ig)==1) THEN
+        detr(ig, l) = fm(ig, l) + alim(ig, l) - fm(ig, l+1)
+        IF (detr(ig,l)<0.) THEN
+          ! entr(ig,l)=entr(ig,l)-detr(ig,l)
+          fm(ig, l+1) = fm(ig, l) + alim(ig, l)
+          detr(ig, l) = 0.
+          ! write(11,*)'l,ig,entr',l,ig,entr(ig,l)
+          ! print*,'WARNING !!! detrainement negatif ',ig,l
+        END IF
+      END IF
+    END DO
+  END DO
+  ! RC
+
+  IF (w2di==1) THEN
+    fm0 = fm0 + ptimestep*(fm-fm0)/tho
+    entr0 = entr0 + ptimestep*(alim+entr-entr0)/tho
+  ELSE
+    fm0 = fm
+    entr0 = alim + entr
+    detr0 = detr
+    alim0 = alim
+    ! zoa=zqta
+    ! entr0=alim
+  END IF
+
+  IF (1==1) THEN
+    ! call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+    ! .    ,zh,zdhadj,zha)
+    ! call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+    ! .    ,zo,pdoadj,zoa)
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zthl, &
+      zdthladj, zta)
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, po, pdoadj, &
+      zoa)
+  ELSE
+    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
+      zdhadj, zha)
+    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
+      pdoadj, zoa)
+  END IF
+
+  IF (1==0) THEN
+    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
+      zu, zv, pduadj, pdvadj, zua, zva)
+  ELSE
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
+      zua)
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
+      zva)
+  END IF
+
+  ! Calcul des moments
+  ! do l=1,nlay
+  ! do ig=1,ngrid
+  ! zf=0.5*(fracc(ig,l)+fracc(ig,l+1))
+  ! zf2=zf/(1.-zf)
+  ! thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l))**2
+  ! wth2(ig,l)=zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
+  ! enddo
+  ! enddo
+
+
+
+
+
+
+  ! print*,'13 OK convect8'
+  ! print*,'WA5 ',wa_moy
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      ! pdtadj(ig,l)=zdhadj(ig,l)*zpspsk(ig,l)
+      pdtadj(ig, l) = zdthladj(ig, l)*zpspsk(ig, l)
+    END DO
+  END DO
+
+
+  ! do l=1,nlay
+  ! do ig=1,ngrid
+  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
+  ! print*,'WARN!!! ig=',ig,'  l=',l
+  ! s         ,'   pdtadj=',pdtadj(ig,l)
+  ! endif
+  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
+  ! print*,'WARN!!! ig=',ig,'  l=',l
+  ! s         ,'   pdoadj=',pdoadj(ig,l)
+  ! endif
+  ! enddo
+  ! enddo
+
+  ! print*,'14 OK convect8'
+  ! ------------------------------------------------------------------
+  ! Calculs pour les sorties
+  ! ------------------------------------------------------------------
+  ! calcul de fraca pour les sorties
+  DO l = 2, klev
+    DO ig = 1, klon
+      IF (zw2(ig,l)>1.E-10) THEN
+        fraca(ig, l) = fm(ig, l)/(rhobarz(ig,l)*zw2(ig,l))
+      ELSE
+        fraca(ig, l) = 0.
+      END IF
+    END DO
+  END DO
+  IF (sorties) THEN
+    DO l = 1, nlay
+      DO ig = 1, ngrid
+        zla(ig, l) = (1.-fracd(ig,l))*zmax(ig)
+        zld(ig, l) = fracd(ig, l)*zmax(ig)
+        IF (1.-fracd(ig,l)>1.E-10) zwa(ig, l) = wd(ig, l)*fracd(ig, l)/ &
+          (1.-fracd(ig,l))
+      END DO
+    END DO
+    ! CR calcul du niveau de condensation
+    ! initialisation
+    DO ig = 1, ngrid
+      nivcon(ig) = 0.
+      zcon(ig) = 0.
+    END DO
+    DO k = nlay, 1, -1
+      DO ig = 1, ngrid
+        IF (zqla(ig,k)>1E-10) THEN
+          nivcon(ig) = k
+          zcon(ig) = zlev(ig, k)
+        END IF
+        ! if (zcon(ig).gt.1.e-10) then
+        ! nuage=.true.
+        ! else
+        ! nuage=.false.
+        ! endif
+      END DO
+    END DO
+
+    DO l = 1, nlay
+      DO ig = 1, ngrid
+        zf = fraca(ig, l)
+        zf2 = zf/(1.-zf)
+        thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l)/zpspsk(ig,l))**2
+        wth2(ig, l) = zf2*(zw2(ig,l))**2
+        ! print*,'wth2=',wth2(ig,l)
+        wth3(ig, l) = zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l))*zw2(ig, l)* &
+          zw2(ig, l)*zw2(ig, l)
+        q2(ig, l) = zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2
+        ! test: on calcul q2/po=ratqsc
+        ! if (nuage) then
+        ratqscth(ig, l) = sqrt(q2(ig,l))/(po(ig,l)*1000.)
+        ! else
+        ! ratqscth(ig,l)=0.
+        ! endif
+      END DO
+    END DO
+    ! calcul du ratqscdiff
+    sum = 0.
+    sumdiff = 0.
+    ratqsdiff(:, :) = 0.
+    DO ig = 1, ngrid
+      DO l = 1, lentr(ig)
+        sum = sum + alim_star(ig, l)*zqta(ig, l)*1000.
+      END DO
+    END DO
+    DO ig = 1, ngrid
+      DO l = 1, lentr(ig)
+        zf = fraca(ig, l)
+        zf2 = zf/(1.-zf)
+        sumdiff = sumdiff + alim_star(ig, l)*(zqta(ig,l)*1000.-sum)**2
+        ! ratqsdiff=ratqsdiff+alim_star(ig,l)*
+        ! s          (zqta(ig,l)*1000.-po(ig,l)*1000.)**2
+      END DO
+    END DO
+    DO l = 1, klev
+      DO ig = 1, ngrid
+        ratqsdiff(ig, l) = sqrt(sumdiff)/(po(ig,l)*1000.)
+        ! write(11,*)'ratqsdiff=',ratqsdiff(ig,l)
+      END DO
+    END DO
+
+  END IF
+
+  ! print*,'19 OK convect8'
+  RETURN
+END SUBROUTINE thermcell_cld
+
+SUBROUTINE thermcell_eau(ngrid, nlay, ptimestep, pplay, pplev, pphi, pu, pv, &
+    pt, po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0 & ! s
+                                                         ! ,pu_therm,pv_therm
+    , r_aspect, l_mix, w2di, tho)
+
+  USE dimphy
+  IMPLICIT NONE
+
+  ! =======================================================================
+
+  ! Calcul du transport verticale dans la couche limite en presence
+  ! de "thermiques" explicitement representes
+
+  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
+
+  ! le thermique est supposé homogène et dissipé par mélange avec
+  ! son environnement. la longueur l_mix contrôle l'efficacité du
+  ! mélange
+
+  ! Le calcul du transport des différentes espèces se fait en prenant
+  ! en compte:
+  ! 1. un flux de masse montant
+  ! 2. un flux de masse descendant
+  ! 3. un entrainement
+  ! 4. un detrainement
+
+  ! =======================================================================
+
+  ! -----------------------------------------------------------------------
+  ! declarations:
+  ! -------------
+
+  include "YOMCST.h"
+  include "YOETHF.h"
+  include "FCTTRE.h"
+
+  ! arguments:
+  ! ----------
+
+  INTEGER ngrid, nlay, w2di
+  REAL tho
+  REAL ptimestep, l_mix, r_aspect
+  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
+  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
+  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
+  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
+  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
+  REAL pphi(ngrid, nlay)
+
+  INTEGER idetr
+  SAVE idetr
+  DATA idetr/3/
+  !$OMP THREADPRIVATE(idetr)
+
+  ! local:
+  ! ------
+
+  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
+  REAL zsortie1d(klon)
+  ! CR: on remplace lmax(klon,klev+1)
+  INTEGER lmax(klon), lmin(klon), lentr(klon)
+  REAL linter(klon)
+  REAL zmix(klon), fracazmix(klon)
+  ! RC
+  REAL zmax(klon), zw, zz, zw2(klon, klev+1), ztva(klon, klev), zzz
+
+  REAL zlev(klon, klev+1), zlay(klon, klev)
+  REAL zh(klon, klev), zdhadj(klon, klev)
+  REAL zthl(klon, klev), zdthladj(klon, klev)
+  REAL ztv(klon, klev)
+  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
+  REAL zl(klon, klev)
+  REAL wh(klon, klev+1)
+  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
+  REAL zla(klon, klev+1)
+  REAL zwa(klon, klev+1)
+  REAL zld(klon, klev+1)
+  REAL zwd(klon, klev+1)
+  REAL zsortie(klon, klev)
+  REAL zva(klon, klev)
+  REAL zua(klon, klev)
+  REAL zoa(klon, klev)
+
+  REAL zta(klon, klev)
+  REAL zha(klon, klev)
+  REAL wa_moy(klon, klev+1)
+  REAL fraca(klon, klev+1)
+  REAL fracc(klon, klev+1)
+  REAL zf, zf2
+  REAL thetath2(klon, klev), wth2(klon, klev)
+  ! common/comtherm/thetath2,wth2
+
+  REAL count_time
+  INTEGER ialt
+
+  LOGICAL sorties
+  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
+  REAL zpspsk(klon, klev)
+
+  ! real wmax(klon,klev),wmaxa(klon)
+  REAL wmax(klon), wmaxa(klon)
+  REAL wa(klon, klev, klev+1)
+  REAL wd(klon, klev+1)
+  REAL larg_part(klon, klev, klev+1)
+  REAL fracd(klon, klev+1)
+  REAL xxx(klon, klev+1)
+  REAL larg_cons(klon, klev+1)
+  REAL larg_detr(klon, klev+1)
+  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
+  REAL pu_therm(klon, klev), pv_therm(klon, klev)
+  REAL fm(klon, klev+1), entr(klon, klev)
+  REAL fmc(klon, klev+1)
+
+  REAL zcor, zdelta, zcvm5, qlbef
+  REAL tbef(klon), qsatbef(klon)
+  REAL dqsat_dt, dt, num, denom
+  REAL reps, rlvcp, ddt0
+  REAL ztla(klon, klev), zqla(klon, klev), zqta(klon, klev)
+
+  PARAMETER (ddt0=.01)
+
+  ! CR:nouvelles variables
+  REAL f_star(klon, klev+1), entr_star(klon, klev)
+  REAL entr_star_tot(klon), entr_star2(klon)
+  REAL f(klon), f0(klon)
+  REAL zlevinter(klon)
+  LOGICAL first
+  DATA first/.FALSE./
+  SAVE first
+  !$OMP THREADPRIVATE(first)
+
+  ! RC
+
+  CHARACTER *2 str2
+  CHARACTER *10 str10
+
+  CHARACTER (LEN=20) :: modname = 'thermcell_eau'
+  CHARACTER (LEN=80) :: abort_message
+
+  LOGICAL vtest(klon), down
+  LOGICAL zsat(klon)
+
+  EXTERNAL scopy
+
+  INTEGER ncorrec, ll
+  SAVE ncorrec
+  DATA ncorrec/0/
+  !$OMP THREADPRIVATE(ncorrec)
+
+
+
+  ! -----------------------------------------------------------------------
+  ! initialisation:
+  ! ---------------
+
+  sorties = .TRUE.
+  IF (ngrid/=klon) THEN
+    PRINT *
+    PRINT *, 'STOP dans convadj'
+    PRINT *, 'ngrid    =', ngrid
+    PRINT *, 'klon  =', klon
+  END IF
+
+  ! Initialisation
+  rlvcp = rlvtt/rcpd
+  reps = rd/rv
+
+  ! -----------------------------------------------------------------------
+  ! AM Calcul de T,q,ql a partir de Tl et qT
+  ! ---------------------------------------------------
+
+  ! Pr Tprec=Tl calcul de qsat
+  ! Si qsat>qT T=Tl, q=qT
+  ! Sinon DDT=(-Tprec+Tl+RLVCP (qT-qsat(T')) / (1+RLVCP dqsat/dt)
+  ! On cherche DDT < DDT0
+
+  ! defaut
+  DO ll = 1, nlay
+    DO ig = 1, ngrid
+      zo(ig, ll) = po(ig, ll)
+      zl(ig, ll) = 0.
+      zh(ig, ll) = pt(ig, ll)
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    zsat(ig) = .FALSE.
+  END DO
+
+
+  DO ll = 1, nlay
+    ! les points insatures sont definitifs
+    DO ig = 1, ngrid
+      tbef(ig) = pt(ig, ll)
+      zdelta = max(0., sign(1.,rtt-tbef(ig)))
+      qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, ll)
+      qsatbef(ig) = min(0.5, qsatbef(ig))
+      zcor = 1./(1.-retv*qsatbef(ig))
+      qsatbef(ig) = qsatbef(ig)*zcor
+      zsat(ig) = (max(0.,po(ig,ll)-qsatbef(ig))>0.00001)
+    END DO
+
+    DO ig = 1, ngrid
+      IF (zsat(ig)) THEN
+        qlbef = max(0., po(ig,ll)-qsatbef(ig))
+        ! si sature: ql est surestime, d'ou la sous-relax
+        dt = 0.5*rlvcp*qlbef
+        ! on pourra enchainer 2 ou 3 calculs sans Do while
+        DO WHILE (dt>ddt0)
+          ! il faut verifier si c,a conserve quand on repasse en insature ...
+          tbef(ig) = tbef(ig) + dt
+          zdelta = max(0., sign(1.,rtt-tbef(ig)))
+          qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, ll)
+          qsatbef(ig) = min(0.5, qsatbef(ig))
+          zcor = 1./(1.-retv*qsatbef(ig))
+          qsatbef(ig) = qsatbef(ig)*zcor
+          ! on veut le signe de qlbef
+          qlbef = po(ig, ll) - qsatbef(ig)
+          ! dqsat_dT
+          zdelta = max(0., sign(1.,rtt-tbef(ig)))
+          zcvm5 = r5les*(1.-zdelta) + r5ies*zdelta
+          zcor = 1./(1.-retv*qsatbef(ig))
+          dqsat_dt = foede(tbef(ig), zdelta, zcvm5, qsatbef(ig), zcor)
+          num = -tbef(ig) + pt(ig, ll) + rlvcp*qlbef
+          denom = 1. + rlvcp*dqsat_dt
+          dt = num/denom
+        END DO
+        ! on ecrit de maniere conservative (sat ou non)
+        zl(ig, ll) = max(0., qlbef)
+        ! T = Tl +Lv/Cp ql
+        zh(ig, ll) = pt(ig, ll) + rlvcp*zl(ig, ll)
+        zo(ig, ll) = po(ig, ll) - zl(ig, ll)
+      END IF
+    END DO
+  END DO
+  ! AM fin
+
+  ! -----------------------------------------------------------------------
+  ! incrementation eventuelle de tendances precedentes:
+  ! ---------------------------------------------------
+
+  ! print*,'0 OK convect8'
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
+      ! zh(ig,l)=pt(ig,l)/zpspsk(ig,l)
+      zu(ig, l) = pu(ig, l)
+      zv(ig, l) = pv(ig, l)
+      ! zo(ig,l)=po(ig,l)
+      ! ztv(ig,l)=zh(ig,l)*(1.+0.61*zo(ig,l))
+      ! AM attention zh est maintenant le profil de T et plus le profil de
+      ! theta !
+
+      ! T-> Theta
+      ztv(ig, l) = zh(ig, l)/zpspsk(ig, l)
+      ! AM Theta_v
+      ztv(ig, l) = ztv(ig, l)*(1.+retv*(zo(ig,l))-zl(ig,l))
+      ! AM Thetal
+      zthl(ig, l) = pt(ig, l)/zpspsk(ig, l)
+
+    END DO
+  END DO
+
+  ! print*,'1 OK convect8'
+  ! --------------------
+
+
+  ! + + + + + + + + + + +
+
+
+  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+  ! wh,wt,wo ...
+
+  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
+
+
+  ! --------------------   zlev(1)
+  ! \\\\\\\\\\\\\\\\\\\\
+
+
+
+  ! -----------------------------------------------------------------------
+  ! Calcul des altitudes des couches
+  ! -----------------------------------------------------------------------
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    zlev(ig, 1) = 0.
+    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
+  END DO
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zlay(ig, l) = pphi(ig, l)/rg
+    END DO
+  END DO
+
+  ! print*,'2 OK convect8'
+  ! -----------------------------------------------------------------------
+  ! Calcul des densites
+  ! -----------------------------------------------------------------------
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      ! rho(ig,l)=pplay(ig,l)/(zpspsk(ig,l)*RD*zh(ig,l))
+      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*ztv(ig,l))
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
+    END DO
+  END DO
+
+  DO k = 1, nlay
+    DO l = 1, nlay + 1
+      DO ig = 1, ngrid
+        wa(ig, k, l) = 0.
+      END DO
+    END DO
+  END DO
+
+  ! print*,'3 OK convect8'
+  ! ------------------------------------------------------------------
+  ! Calcul de w2, quarre de w a partir de la cape
+  ! a partir de w2, on calcule wa, vitesse de l'ascendance
+
+  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
+  ! w2 est stoke dans wa
+
+  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
+  ! independants par couches que pour calculer l'entrainement
+  ! a la base et la hauteur max de l'ascendance.
+
+  ! Indicages:
+  ! l'ascendance provenant du niveau k traverse l'interface l avec
+  ! une vitesse wa(k,l).
+
+  ! --------------------
+
+  ! + + + + + + + + + +
+
+  ! wa(k,l)   ----       --------------------    l
+  ! /\
+  ! /||\       + + + + + + + + + +
+  ! ||
+  ! ||        --------------------
+  ! ||
+  ! ||        + + + + + + + + + +
+  ! ||
+  ! ||        --------------------
+  ! ||__
+  ! |___      + + + + + + + + + +     k
+
+  ! --------------------
+
+
+
+  ! ------------------------------------------------------------------
+
+  ! CR: ponderation entrainement des couches instables
+  ! def des entr_star tels que entr=f*entr_star
+  DO l = 1, klev
+    DO ig = 1, ngrid
+      entr_star(ig, l) = 0.
+    END DO
+  END DO
+  ! determination de la longueur de la couche d entrainement
+  DO ig = 1, ngrid
+    lentr(ig) = 1
+  END DO
+
+  ! on ne considere que les premieres couches instables
+  DO k = nlay - 1, 1, -1
+    DO ig = 1, ngrid
+      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<ztv(ig,k+2)) THEN
+        lentr(ig) = k
+      END IF
+    END DO
+  END DO
+
+  ! determination du lmin: couche d ou provient le thermique
+  DO ig = 1, ngrid
+    lmin(ig) = 1
+  END DO
+  DO ig = 1, ngrid
+    DO l = nlay, 2, -1
+      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
+        lmin(ig) = l - 1
+      END IF
+    END DO
+  END DO
+
+  ! definition de l'entrainement des couches
+  DO l = 1, klev - 1
+    DO ig = 1, ngrid
+      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<=lentr(ig)) THEN
+        entr_star(ig, l) = (ztv(ig,l)-ztv(ig,l+1))*(zlev(ig,l+1)-zlev(ig,l))
+      END IF
+    END DO
+  END DO
+  ! pas de thermique si couche 1 stable
+  DO ig = 1, ngrid
+    IF (lmin(ig)>1) THEN
+      DO l = 1, klev
+        entr_star(ig, l) = 0.
+      END DO
+    END IF
+  END DO
+  ! calcul de l entrainement total
+  DO ig = 1, ngrid
+    entr_star_tot(ig) = 0.
+  END DO
+  DO ig = 1, ngrid
+    DO k = 1, klev
+      entr_star_tot(ig) = entr_star_tot(ig) + entr_star(ig, k)
+    END DO
+  END DO
+
+  DO k = 1, klev
+    DO ig = 1, ngrid
+      ztva(ig, k) = ztv(ig, k)
+    END DO
+  END DO
+  ! RC
+  ! AM:initialisations
+  DO k = 1, nlay
+    DO ig = 1, ngrid
+      ztva(ig, k) = ztv(ig, k)
+      ztla(ig, k) = zthl(ig, k)
+      zqla(ig, k) = 0.
+      zqta(ig, k) = po(ig, k)
+      zsat(ig) = .FALSE.
+    END DO
+  END DO
+
+  ! print*,'7 OK convect8'
+  DO k = 1, klev + 1
+    DO ig = 1, ngrid
+      zw2(ig, k) = 0.
+      fmc(ig, k) = 0.
+      ! CR
+      f_star(ig, k) = 0.
+      ! RC
+      larg_cons(ig, k) = 0.
+      larg_detr(ig, k) = 0.
+      wa_moy(ig, k) = 0.
+    END DO
+  END DO
+
+  ! print*,'8 OK convect8'
+  DO ig = 1, ngrid
+    linter(ig) = 1.
+    lmaxa(ig) = 1
+    lmix(ig) = 1
+    wmaxa(ig) = 0.
+  END DO
+
+  ! CR:
+  DO l = 1, nlay - 2
+    DO ig = 1, ngrid
+      IF (ztv(ig,l)>ztv(ig,l+1) .AND. entr_star(ig,l)>1.E-10 .AND. &
+          zw2(ig,l)<1E-10) THEN
+        ! AM
+        ztla(ig, l) = zthl(ig, l)
+        zqta(ig, l) = po(ig, l)
+        zqla(ig, l) = zl(ig, l)
+        ! AM
+        f_star(ig, l+1) = entr_star(ig, l)
+        ! test:calcul de dteta
+        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
+          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
+        larg_detr(ig, l) = 0.
+      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+entr_star(ig, &
+          l)>1.E-10)) THEN
+        f_star(ig, l+1) = f_star(ig, l) + entr_star(ig, l)
+
+        ! AM on melange Tl et qt du thermique
+        ztla(ig, l) = (f_star(ig,l)*ztla(ig,l-1)+entr_star(ig,l)*zthl(ig,l))/ &
+          f_star(ig, l+1)
+        zqta(ig, l) = (f_star(ig,l)*zqta(ig,l-1)+entr_star(ig,l)*po(ig,l))/ &
+          f_star(ig, l+1)
+
+        ! ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)
+        ! s                    *ztv(ig,l))/f_star(ig,l+1)
+
+        ! AM on en deduit thetav et ql du thermique
+        tbef(ig) = ztla(ig, l)*zpspsk(ig, l)
+        zdelta = max(0., sign(1.,rtt-tbef(ig)))
+        qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, l)
+        qsatbef(ig) = min(0.5, qsatbef(ig))
+        zcor = 1./(1.-retv*qsatbef(ig))
+        qsatbef(ig) = qsatbef(ig)*zcor
+        zsat(ig) = (max(0.,zqta(ig,l)-qsatbef(ig))>0.00001)
+      END IF
+    END DO
+    DO ig = 1, ngrid
+      IF (zsat(ig)) THEN
+        qlbef = max(0., zqta(ig,l)-qsatbef(ig))
+        dt = 0.5*rlvcp*qlbef
+        DO WHILE (dt>ddt0)
+          tbef(ig) = tbef(ig) + dt
+          zdelta = max(0., sign(1.,rtt-tbef(ig)))
+          qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, l)
+          qsatbef(ig) = min(0.5, qsatbef(ig))
+          zcor = 1./(1.-retv*qsatbef(ig))
+          qsatbef(ig) = qsatbef(ig)*zcor
+          qlbef = zqta(ig, l) - qsatbef(ig)
+
+          zdelta = max(0., sign(1.,rtt-tbef(ig)))
+          zcvm5 = r5les*(1.-zdelta) + r5ies*zdelta
+          zcor = 1./(1.-retv*qsatbef(ig))
+          dqsat_dt = foede(tbef(ig), zdelta, zcvm5, qsatbef(ig), zcor)
+          num = -tbef(ig) + ztla(ig, l)*zpspsk(ig, l) + rlvcp*qlbef
+          denom = 1. + rlvcp*dqsat_dt
+          dt = num/denom
+        END DO
+        zqla(ig, l) = max(0., zqta(ig,l)-qsatbef(ig))
+      END IF
+      ! on ecrit de maniere conservative (sat ou non)
+      ! T = Tl +Lv/Cp ql
+      ztva(ig, l) = ztla(ig, l)*zpspsk(ig, l) + rlvcp*zqla(ig, l)
+      ztva(ig, l) = ztva(ig, l)/zpspsk(ig, l)
+      ztva(ig, l) = ztva(ig, l)*(1.+retv*(zqta(ig,l)-zqla(ig,l))-zqla(ig,l))
+
+    END DO
+    DO ig = 1, ngrid
+      IF (zw2(ig,l)>=1.E-10 .AND. f_star(ig,l)+entr_star(ig,l)>1.E-10) THEN
+        ! mise a jour de la vitesse ascendante (l'air entraine de la couche
+        ! consideree commence avec une vitesse nulle).
+
+        zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/f_star(ig,l+1))**2 + &
+          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
+      END IF
+      ! determination de zmax continu par interpolation lineaire
+      IF (zw2(ig,l+1)<0.) THEN
+        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
+          ig,l))
+        zw2(ig, l+1) = 0.
+        lmaxa(ig) = l
+      ELSE
+        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
+      END IF
+      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
+        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
+        lmix(ig) = l + 1
+        wmaxa(ig) = wa_moy(ig, l+1)
+      END IF
+    END DO
+  END DO
+
+  ! Calcul de la couche correspondant a la hauteur du thermique
+  DO ig = 1, ngrid
+    lmax(ig) = lentr(ig)
+  END DO
+  DO ig = 1, ngrid
+    DO l = nlay, lentr(ig) + 1, -1
+      IF (zw2(ig,l)<=1.E-10) THEN
+        lmax(ig) = l - 1
+      END IF
+    END DO
+  END DO
+  ! pas de thermique si couche 1 stable
+  DO ig = 1, ngrid
+    IF (lmin(ig)>1) THEN
+      lmax(ig) = 1
+      lmin(ig) = 1
+    END IF
+  END DO
+
+  ! Determination de zw2 max
+  DO ig = 1, ngrid
+    wmax(ig) = 0.
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmax(ig)) THEN
+        zw2(ig, l) = sqrt(zw2(ig,l))
+        wmax(ig) = max(wmax(ig), zw2(ig,l))
+      ELSE
+        zw2(ig, l) = 0.
+      END IF
+    END DO
+  END DO
+
+  ! Longueur caracteristique correspondant a la hauteur des thermiques.
+  DO ig = 1, ngrid
+    zmax(ig) = 500.
+    zlevinter(ig) = zlev(ig, 1)
+  END DO
+  DO ig = 1, ngrid
+    ! calcul de zlevinter
+    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
+      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
+    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,lmin(ig)))
+  END DO
+
+  ! Fermeture,determination de f
+  DO ig = 1, ngrid
+    entr_star2(ig) = 0.
+  END DO
+  DO ig = 1, ngrid
+    IF (entr_star_tot(ig)<1.E-10) THEN
+      f(ig) = 0.
+    ELSE
+      DO k = lmin(ig), lentr(ig)
+        entr_star2(ig) = entr_star2(ig) + entr_star(ig, k)**2/(rho(ig,k)*( &
+          zlev(ig,k+1)-zlev(ig,k)))
+      END DO
+      ! Nouvelle fermeture
+      f(ig) = wmax(ig)/(zmax(ig)*r_aspect*entr_star2(ig))*entr_star_tot(ig)
+      ! test
+      IF (first) THEN
+        f(ig) = f(ig) + (f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)*wmax(ig))
+      END IF
+    END IF
+    f0(ig) = f(ig)
+    first = .TRUE.
+  END DO
+
+  ! Calcul de l'entrainement
+  DO k = 1, klev
+    DO ig = 1, ngrid
+      entr(ig, k) = f(ig)*entr_star(ig, k)
+    END DO
+  END DO
+  ! Calcul des flux
+  DO ig = 1, ngrid
+    DO l = 1, lmax(ig) - 1
+      fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
+    END DO
+  END DO
+
+  ! RC
+
+
+  ! print*,'9 OK convect8'
+  ! print*,'WA1 ',wa_moy
+
+  ! determination de l'indice du debut de la mixed layer ou w decroit
+
+  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
+  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
+  ! d'une couche est égale à la hauteur de la couche alimentante.
+  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
+  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmaxa(ig)) THEN
+        zw = max(wa_moy(ig,l), 1.E-10)
+        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
+      END IF
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmaxa(ig)) THEN
+        ! if (idetr.eq.0) then
+        ! cette option est finalement en dur.
+        larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
+        ! else if (idetr.eq.1) then
+        ! larg_detr(ig,l)=larg_cons(ig,l)
+        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
+        ! else if (idetr.eq.2) then
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        ! s            *sqrt(wa_moy(ig,l))
+        ! else if (idetr.eq.4) then
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        ! s            *wa_moy(ig,l)
+        ! endif
+      END IF
+    END DO
+  END DO
+
+  ! print*,'10 OK convect8'
+  ! print*,'WA2 ',wa_moy
+  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
+  ! compte de l'epluchage du thermique.
+
+  ! CR def de  zmix continu (profil parabolique des vitesses)
+  DO ig = 1, ngrid
+    IF (lmix(ig)>1.) THEN
+      zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig))) &
+        **2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
+        lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
+        (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
+        (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))*((zlev( &
+        ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
+    ELSE
+      zmix(ig) = 0.
+    END IF
+  END DO
+
+  ! calcul du nouveau lmix correspondant
+  DO ig = 1, ngrid
+    DO l = 1, klev
+      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
+        lmix(ig) = l
+      END IF
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (larg_cons(ig,l)>1.) THEN
+        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
+        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
+        ! test
+        fraca(ig, l) = max(fraca(ig,l), 0.)
+        fraca(ig, l) = min(fraca(ig,l), 0.5)
+        fracd(ig, l) = 1. - fraca(ig, l)
+        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
+      ELSE
+        ! wa_moy(ig,l)=0.
+        fraca(ig, l) = 0.
+        fracc(ig, l) = 0.
+        fracd(ig, l) = 1.
+      END IF
+    END DO
+  END DO
+  ! CR: calcul de fracazmix
+  DO ig = 1, ngrid
+    fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
+      (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
+      fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca(ig &
+      ,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (larg_cons(ig,l)>1.) THEN
+        IF (l>lmix(ig)) THEN
+          xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
+          IF (idetr==0) THEN
+            fraca(ig, l) = fracazmix(ig)
+          ELSE IF (idetr==1) THEN
+            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
+          ELSE IF (idetr==2) THEN
+            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
+          ELSE
+            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
+          END IF
+          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
+          fraca(ig, l) = max(fraca(ig,l), 0.)
+          fraca(ig, l) = min(fraca(ig,l), 0.5)
+          fracd(ig, l) = 1. - fraca(ig, l)
+          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
+        END IF
+      END IF
+    END DO
+  END DO
+
+  ! print*,'11 OK convect8'
+  ! print*,'Ea3 ',wa_moy
+  ! ------------------------------------------------------------------
+  ! Calcul de fracd, wd
+  ! somme wa - wd = 0
+  ! ------------------------------------------------------------------
+
+
+  DO ig = 1, ngrid
+    fm(ig, 1) = 0.
+    fm(ig, nlay+1) = 0.
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
+      ! CR:test
+      IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
+        fm(ig, l) = fm(ig, l-1)
+        ! write(1,*)'ajustement fm, l',l
+      END IF
+      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+      ! RC
+    END DO
+    DO ig = 1, ngrid
+      IF (fracd(ig,l)<0.1) THEN
+        abort_message = 'fracd trop petit'
+        CALL abort_physic(modname, abort_message, 1)
+      ELSE
+        ! vitesse descendante "diagnostique"
+        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
+    END DO
+  END DO
+
+  ! print*,'12 OK convect8'
+  ! print*,'WA4 ',wa_moy
+  ! c------------------------------------------------------------------
+  ! calcul du transport vertical
+  ! ------------------------------------------------------------------
+
+  GO TO 4444
+  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
+  DO l = 2, nlay - 1
+    DO ig = 1, ngrid
+      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
+          ig,l+1)) THEN
+        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
+        ! s         ,fm(ig,l+1)*ptimestep
+        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
+        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
+        ! s         ,entr(ig,l)*ptimestep
+        ! s         ,'   M=',masse(ig,l)
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
+        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
+        ! s         ,'   FM=',fm(ig,l)
+      END IF
+      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
+        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
+        ! s         ,'   M=',masse(ig,l)
+        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
+        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
+        ! print*,'zlev(ig,l+1),zlev(ig,l)'
+        ! s                ,zlev(ig,l+1),zlev(ig,l)
+        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
+        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
+      END IF
+      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
+        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
+        ! s         ,'   E=',entr(ig,l)
+      END IF
+    END DO
+  END DO
+
+4444 CONTINUE
+
+  IF (w2di==1) THEN
+    fm0 = fm0 + ptimestep*(fm-fm0)/tho
+    entr0 = entr0 + ptimestep*(entr-entr0)/tho
+  ELSE
+    fm0 = fm
+    entr0 = entr
+  END IF
+
+  IF (1==1) THEN
+    ! call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+    ! .    ,zh,zdhadj,zha)
+    ! call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+    ! .    ,zo,pdoadj,zoa)
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zthl, &
+      zdthladj, zta)
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, po, pdoadj, &
+      zoa)
+  ELSE
+    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
+      zdhadj, zha)
+    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
+      pdoadj, zoa)
+  END IF
+
+  IF (1==0) THEN
+    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
+      zu, zv, pduadj, pdvadj, zua, zva)
+  ELSE
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
+      zua)
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
+      zva)
+  END IF
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
+      zf2 = zf/(1.-zf)
+      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
+      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
+    END DO
+  END DO
+
+
+
+  ! print*,'13 OK convect8'
+  ! print*,'WA5 ',wa_moy
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      ! pdtadj(ig,l)=zdhadj(ig,l)*zpspsk(ig,l)
+      pdtadj(ig, l) = zdthladj(ig, l)*zpspsk(ig, l)
+    END DO
+  END DO
+
+
+  ! do l=1,nlay
+  ! do ig=1,ngrid
+  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
+  ! print*,'WARN!!! ig=',ig,'  l=',l
+  ! s         ,'   pdtadj=',pdtadj(ig,l)
+  ! endif
+  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
+  ! print*,'WARN!!! ig=',ig,'  l=',l
+  ! s         ,'   pdoadj=',pdoadj(ig,l)
+  ! endif
+  ! enddo
+  ! enddo
+
+  ! print*,'14 OK convect8'
+  ! ------------------------------------------------------------------
+  ! Calculs pour les sorties
+  ! ------------------------------------------------------------------
+
+  RETURN
+END SUBROUTINE thermcell_eau
+
+SUBROUTINE thermcell(ngrid, nlay, ptimestep, pplay, pplev, pphi, pu, pv, pt, &
+    po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0 & ! s
+                                                     ! ,pu_therm,pv_therm
+    , r_aspect, l_mix, w2di, tho)
+
+  USE dimphy
+  IMPLICIT NONE
+
+  ! =======================================================================
+
+  ! Calcul du transport verticale dans la couche limite en presence
+  ! de "thermiques" explicitement representes
+
+  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
+
+  ! le thermique est supposé homogène et dissipé par mélange avec
+  ! son environnement. la longueur l_mix contrôle l'efficacité du
+  ! mélange
+
+  ! Le calcul du transport des différentes espèces se fait en prenant
+  ! en compte:
+  ! 1. un flux de masse montant
+  ! 2. un flux de masse descendant
+  ! 3. un entrainement
+  ! 4. un detrainement
+
+  ! =======================================================================
+
+  ! -----------------------------------------------------------------------
+  ! declarations:
+  ! -------------
+
+  include "YOMCST.h"
+
+  ! arguments:
+  ! ----------
+
+  INTEGER ngrid, nlay, w2di
+  REAL tho
+  REAL ptimestep, l_mix, r_aspect
+  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
+  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
+  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
+  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
+  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
+  REAL pphi(ngrid, nlay)
+
+  INTEGER idetr
+  SAVE idetr
+  DATA idetr/3/
+  !$OMP THREADPRIVATE(idetr)
+
+  ! local:
+  ! ------
+
+  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
+  REAL zsortie1d(klon)
+  ! CR: on remplace lmax(klon,klev+1)
+  INTEGER lmax(klon), lmin(klon), lentr(klon)
+  REAL linter(klon)
+  REAL zmix(klon), fracazmix(klon)
+  ! RC
+  REAL zmax(klon), zw, zz, zw2(klon, klev+1), ztva(klon, klev), zzz
+
+  REAL zlev(klon, klev+1), zlay(klon, klev)
+  REAL zh(klon, klev), zdhadj(klon, klev)
+  REAL ztv(klon, klev)
+  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
+  REAL wh(klon, klev+1)
+  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
+  REAL zla(klon, klev+1)
+  REAL zwa(klon, klev+1)
+  REAL zld(klon, klev+1)
+  REAL zwd(klon, klev+1)
+  REAL zsortie(klon, klev)
+  REAL zva(klon, klev)
+  REAL zua(klon, klev)
+  REAL zoa(klon, klev)
+
+  REAL zha(klon, klev)
+  REAL wa_moy(klon, klev+1)
+  REAL fraca(klon, klev+1)
+  REAL fracc(klon, klev+1)
+  REAL zf, zf2
+  REAL thetath2(klon, klev), wth2(klon, klev)
+  ! common/comtherm/thetath2,wth2
+
+  REAL count_time
+  INTEGER ialt
+
+  LOGICAL sorties
+  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
+  REAL zpspsk(klon, klev)
+
+  ! real wmax(klon,klev),wmaxa(klon)
+  REAL wmax(klon), wmaxa(klon)
+  REAL wa(klon, klev, klev+1)
+  REAL wd(klon, klev+1)
+  REAL larg_part(klon, klev, klev+1)
+  REAL fracd(klon, klev+1)
+  REAL xxx(klon, klev+1)
+  REAL larg_cons(klon, klev+1)
+  REAL larg_detr(klon, klev+1)
+  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
+  REAL pu_therm(klon, klev), pv_therm(klon, klev)
+  REAL fm(klon, klev+1), entr(klon, klev)
+  REAL fmc(klon, klev+1)
+
+  ! CR:nouvelles variables
+  REAL f_star(klon, klev+1), entr_star(klon, klev)
+  REAL entr_star_tot(klon), entr_star2(klon)
+  REAL f(klon), f0(klon)
+  REAL zlevinter(klon)
+  LOGICAL first
+  DATA first/.FALSE./
+  SAVE first
+  !$OMP THREADPRIVATE(first)
+  ! RC
+
+  CHARACTER *2 str2
+  CHARACTER *10 str10
+
+  CHARACTER (LEN=20) :: modname = 'thermcell'
+  CHARACTER (LEN=80) :: abort_message
+
+  LOGICAL vtest(klon), down
+
+  EXTERNAL scopy
+
+  INTEGER ncorrec, ll
+  SAVE ncorrec
+  DATA ncorrec/0/
+  !$OMP THREADPRIVATE(ncorrec)
+
+
+  ! -----------------------------------------------------------------------
+  ! initialisation:
+  ! ---------------
+
+  sorties = .TRUE.
+  IF (ngrid/=klon) THEN
+    PRINT *
+    PRINT *, 'STOP dans convadj'
+    PRINT *, 'ngrid    =', ngrid
+    PRINT *, 'klon  =', klon
+  END IF
+
+  ! -----------------------------------------------------------------------
+  ! incrementation eventuelle de tendances precedentes:
+  ! ---------------------------------------------------
+
+  ! print*,'0 OK convect8'
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
+      zh(ig, l) = pt(ig, l)/zpspsk(ig, l)
+      zu(ig, l) = pu(ig, l)
+      zv(ig, l) = pv(ig, l)
+      zo(ig, l) = po(ig, l)
+      ztv(ig, l) = zh(ig, l)*(1.+0.61*zo(ig,l))
+    END DO
+  END DO
+
+  ! print*,'1 OK convect8'
+  ! --------------------
+
+
+  ! + + + + + + + + + + +
+
+
+  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+  ! wh,wt,wo ...
+
+  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
+
+
+  ! --------------------   zlev(1)
+  ! \\\\\\\\\\\\\\\\\\\\
+
+
+
+  ! -----------------------------------------------------------------------
+  ! Calcul des altitudes des couches
+  ! -----------------------------------------------------------------------
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    zlev(ig, 1) = 0.
+    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
+  END DO
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zlay(ig, l) = pphi(ig, l)/rg
+    END DO
+  END DO
+
+  ! print*,'2 OK convect8'
+  ! -----------------------------------------------------------------------
+  ! Calcul des densites
+  ! -----------------------------------------------------------------------
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*zh(ig,l))
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
+    END DO
+  END DO
+
+  DO k = 1, nlay
+    DO l = 1, nlay + 1
+      DO ig = 1, ngrid
+        wa(ig, k, l) = 0.
+      END DO
+    END DO
+  END DO
+
+  ! print*,'3 OK convect8'
+  ! ------------------------------------------------------------------
+  ! Calcul de w2, quarre de w a partir de la cape
+  ! a partir de w2, on calcule wa, vitesse de l'ascendance
+
+  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
+  ! w2 est stoke dans wa
+
+  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
+  ! independants par couches que pour calculer l'entrainement
+  ! a la base et la hauteur max de l'ascendance.
+
+  ! Indicages:
+  ! l'ascendance provenant du niveau k traverse l'interface l avec
+  ! une vitesse wa(k,l).
+
+  ! --------------------
+
+  ! + + + + + + + + + +
+
+  ! wa(k,l)   ----       --------------------    l
+  ! /\
+  ! /||\       + + + + + + + + + +
+  ! ||
+  ! ||        --------------------
+  ! ||
+  ! ||        + + + + + + + + + +
+  ! ||
+  ! ||        --------------------
+  ! ||__
+  ! |___      + + + + + + + + + +     k
+
+  ! --------------------
+
+
+
+  ! ------------------------------------------------------------------
+
+  ! CR: ponderation entrainement des couches instables
+  ! def des entr_star tels que entr=f*entr_star
+  DO l = 1, klev
+    DO ig = 1, ngrid
+      entr_star(ig, l) = 0.
+    END DO
+  END DO
+  ! determination de la longueur de la couche d entrainement
+  DO ig = 1, ngrid
+    lentr(ig) = 1
+  END DO
+
+  ! on ne considere que les premieres couches instables
+  DO k = nlay - 2, 1, -1
+    DO ig = 1, ngrid
+      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<=ztv(ig,k+2)) THEN
+        lentr(ig) = k
+      END IF
+    END DO
+  END DO
+
+  ! determination du lmin: couche d ou provient le thermique
+  DO ig = 1, ngrid
+    lmin(ig) = 1
+  END DO
+  DO ig = 1, ngrid
+    DO l = nlay, 2, -1
+      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
+        lmin(ig) = l - 1
+      END IF
+    END DO
+  END DO
+
+  ! definition de l'entrainement des couches
+  DO l = 1, klev - 1
+    DO ig = 1, ngrid
+      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<=lentr(ig)) THEN
+        entr_star(ig, l) = (ztv(ig,l)-ztv(ig,l+1))*(zlev(ig,l+1)-zlev(ig,l))
+      END IF
+    END DO
+  END DO
+  ! pas de thermique si couches 1->5 stables
+  DO ig = 1, ngrid
+    IF (lmin(ig)>5) THEN
+      DO l = 1, klev
+        entr_star(ig, l) = 0.
+      END DO
+    END IF
+  END DO
+  ! calcul de l entrainement total
+  DO ig = 1, ngrid
+    entr_star_tot(ig) = 0.
+  END DO
+  DO ig = 1, ngrid
+    DO k = 1, klev
+      entr_star_tot(ig) = entr_star_tot(ig) + entr_star(ig, k)
+    END DO
+  END DO
+
+  PRINT *, 'fin calcul entr_star'
+  DO k = 1, klev
+    DO ig = 1, ngrid
+      ztva(ig, k) = ztv(ig, k)
+    END DO
+  END DO
+  ! RC
+  ! print*,'7 OK convect8'
+  DO k = 1, klev + 1
+    DO ig = 1, ngrid
+      zw2(ig, k) = 0.
+      fmc(ig, k) = 0.
+      ! CR
+      f_star(ig, k) = 0.
+      ! RC
+      larg_cons(ig, k) = 0.
+      larg_detr(ig, k) = 0.
+      wa_moy(ig, k) = 0.
+    END DO
+  END DO
+
+  ! print*,'8 OK convect8'
+  DO ig = 1, ngrid
+    linter(ig) = 1.
+    lmaxa(ig) = 1
+    lmix(ig) = 1
+    wmaxa(ig) = 0.
+  END DO
+
+  ! CR:
+  DO l = 1, nlay - 2
+    DO ig = 1, ngrid
+      IF (ztv(ig,l)>ztv(ig,l+1) .AND. entr_star(ig,l)>1.E-10 .AND. &
+          zw2(ig,l)<1E-10) THEN
+        f_star(ig, l+1) = entr_star(ig, l)
+        ! test:calcul de dteta
+        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
+          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
+        larg_detr(ig, l) = 0.
+      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+entr_star(ig, &
+          l)>1.E-10)) THEN
+        f_star(ig, l+1) = f_star(ig, l) + entr_star(ig, l)
+        ztva(ig, l) = (f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)*ztv(ig,l))/ &
+          f_star(ig, l+1)
+        zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/f_star(ig,l+1))**2 + &
+          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
+      END IF
+      ! determination de zmax continu par interpolation lineaire
+      IF (zw2(ig,l+1)<0.) THEN
+        ! test
+        IF (abs(zw2(ig,l+1)-zw2(ig,l))<1E-10) THEN
+          PRINT *, 'pb linter'
+        END IF
+        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
+          ig,l))
+        zw2(ig, l+1) = 0.
+        lmaxa(ig) = l
+      ELSE
+        IF (zw2(ig,l+1)<0.) THEN
+          PRINT *, 'pb1 zw2<0'
+        END IF
+        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
+      END IF
+      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
+        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
+        lmix(ig) = l + 1
+        wmaxa(ig) = wa_moy(ig, l+1)
+      END IF
+    END DO
+  END DO
+  PRINT *, 'fin calcul zw2'
+
+  ! Calcul de la couche correspondant a la hauteur du thermique
+  DO ig = 1, ngrid
+    lmax(ig) = lentr(ig)
+  END DO
+  DO ig = 1, ngrid
+    DO l = nlay, lentr(ig) + 1, -1
+      IF (zw2(ig,l)<=1.E-10) THEN
+        lmax(ig) = l - 1
+      END IF
+    END DO
+  END DO
+  ! pas de thermique si couches 1->5 stables
+  DO ig = 1, ngrid
+    IF (lmin(ig)>5) THEN
+      lmax(ig) = 1
+      lmin(ig) = 1
+    END IF
+  END DO
+
+  ! Determination de zw2 max
+  DO ig = 1, ngrid
+    wmax(ig) = 0.
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmax(ig)) THEN
+        IF (zw2(ig,l)<0.) THEN
+          PRINT *, 'pb2 zw2<0'
+        END IF
+        zw2(ig, l) = sqrt(zw2(ig,l))
+        wmax(ig) = max(wmax(ig), zw2(ig,l))
+      ELSE
+        zw2(ig, l) = 0.
+      END IF
+    END DO
+  END DO
+
+  ! Longueur caracteristique correspondant a la hauteur des thermiques.
+  DO ig = 1, ngrid
+    zmax(ig) = 0.
+    zlevinter(ig) = zlev(ig, 1)
+  END DO
+  DO ig = 1, ngrid
+    ! calcul de zlevinter
+    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
+      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
+    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,lmin(ig)))
+  END DO
+
+  PRINT *, 'avant fermeture'
+  ! Fermeture,determination de f
+  DO ig = 1, ngrid
+    entr_star2(ig) = 0.
+  END DO
+  DO ig = 1, ngrid
+    IF (entr_star_tot(ig)<1.E-10) THEN
+      f(ig) = 0.
+    ELSE
+      DO k = lmin(ig), lentr(ig)
+        entr_star2(ig) = entr_star2(ig) + entr_star(ig, k)**2/(rho(ig,k)*( &
+          zlev(ig,k+1)-zlev(ig,k)))
+      END DO
+      ! Nouvelle fermeture
+      f(ig) = wmax(ig)/(max(500.,zmax(ig))*r_aspect*entr_star2(ig))* &
+        entr_star_tot(ig)
+      ! test
+      ! if (first) then
+      ! f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
+      ! s             *wmax(ig))
+      ! endif
+    END IF
+    ! f0(ig)=f(ig)
+    ! first=.true.
+  END DO
+  PRINT *, 'apres fermeture'
+
+  ! Calcul de l'entrainement
+  DO k = 1, klev
+    DO ig = 1, ngrid
+      entr(ig, k) = f(ig)*entr_star(ig, k)
+    END DO
+  END DO
+  ! Calcul des flux
+  DO ig = 1, ngrid
+    DO l = 1, lmax(ig) - 1
+      fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
+    END DO
+  END DO
+
+  ! RC
+
+
+  ! print*,'9 OK convect8'
+  ! print*,'WA1 ',wa_moy
+
+  ! determination de l'indice du debut de la mixed layer ou w decroit
+
+  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
+  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
+  ! d'une couche est égale à la hauteur de la couche alimentante.
+  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
+  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmaxa(ig)) THEN
+        zw = max(wa_moy(ig,l), 1.E-10)
+        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
+      END IF
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmaxa(ig)) THEN
+        ! if (idetr.eq.0) then
+        ! cette option est finalement en dur.
+        IF ((l_mix*zlev(ig,l))<0.) THEN
+          PRINT *, 'pb l_mix*zlev<0'
+        END IF
+        larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
+        ! else if (idetr.eq.1) then
+        ! larg_detr(ig,l)=larg_cons(ig,l)
+        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
+        ! else if (idetr.eq.2) then
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        ! s            *sqrt(wa_moy(ig,l))
+        ! else if (idetr.eq.4) then
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        ! s            *wa_moy(ig,l)
+        ! endif
+      END IF
+    END DO
+  END DO
+
+  ! print*,'10 OK convect8'
+  ! print*,'WA2 ',wa_moy
+  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
+  ! compte de l'epluchage du thermique.
+
+  ! CR def de  zmix continu (profil parabolique des vitesses)
+  DO ig = 1, ngrid
+    IF (lmix(ig)>1.) THEN
+      ! test
+      IF (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
+          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
+          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))- &
+          (zlev(ig,lmix(ig)))))>1E-10) THEN
+
+        zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)) &
+          )**2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
+          lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
+          (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
+          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
+          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
+      ELSE
+        zmix(ig) = zlev(ig, lmix(ig))
+        PRINT *, 'pb zmix'
+      END IF
+    ELSE
+      zmix(ig) = 0.
+    END IF
+    ! test
+    IF ((zmax(ig)-zmix(ig))<0.) THEN
+      zmix(ig) = 0.99*zmax(ig)
+      ! print*,'pb zmix>zmax'
+    END IF
+  END DO
+
+  ! calcul du nouveau lmix correspondant
+  DO ig = 1, ngrid
+    DO l = 1, klev
+      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
+        lmix(ig) = l
+      END IF
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (larg_cons(ig,l)>1.) THEN
+        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
+        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
+        ! test
+        fraca(ig, l) = max(fraca(ig,l), 0.)
+        fraca(ig, l) = min(fraca(ig,l), 0.5)
+        fracd(ig, l) = 1. - fraca(ig, l)
+        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
+      ELSE
+        ! wa_moy(ig,l)=0.
+        fraca(ig, l) = 0.
+        fracc(ig, l) = 0.
+        fracd(ig, l) = 1.
+      END IF
+    END DO
+  END DO
+  ! CR: calcul de fracazmix
+  DO ig = 1, ngrid
+    fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
+      (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
+      fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca(ig &
+      ,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (larg_cons(ig,l)>1.) THEN
+        IF (l>lmix(ig)) THEN
+          ! test
+          IF (zmax(ig)-zmix(ig)<1.E-10) THEN
+            ! print*,'pb xxx'
+            xxx(ig, l) = (lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
+          ELSE
+            xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
+          END IF
+          IF (idetr==0) THEN
+            fraca(ig, l) = fracazmix(ig)
+          ELSE IF (idetr==1) THEN
+            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
+          ELSE IF (idetr==2) THEN
+            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
+          ELSE
+            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
+          END IF
+          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
+          fraca(ig, l) = max(fraca(ig,l), 0.)
+          fraca(ig, l) = min(fraca(ig,l), 0.5)
+          fracd(ig, l) = 1. - fraca(ig, l)
+          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
+        END IF
+      END IF
+    END DO
+  END DO
+
+  PRINT *, 'fin calcul fraca'
+  ! print*,'11 OK convect8'
+  ! print*,'Ea3 ',wa_moy
+  ! ------------------------------------------------------------------
+  ! Calcul de fracd, wd
+  ! somme wa - wd = 0
+  ! ------------------------------------------------------------------
+
+
+  DO ig = 1, ngrid
+    fm(ig, 1) = 0.
+    fm(ig, nlay+1) = 0.
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
+      ! CR:test
+      IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
+        fm(ig, l) = fm(ig, l-1)
+        ! write(1,*)'ajustement fm, l',l
+      END IF
+      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+      ! RC
+    END DO
+    DO ig = 1, ngrid
+      IF (fracd(ig,l)<0.1) THEN
+        abort_message = 'fracd trop petit'
+        CALL abort_physic(modname, abort_message, 1)
+      ELSE
+        ! vitesse descendante "diagnostique"
+        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
+    END DO
+  END DO
+
+  ! print*,'12 OK convect8'
+  ! print*,'WA4 ',wa_moy
+  ! c------------------------------------------------------------------
+  ! calcul du transport vertical
+  ! ------------------------------------------------------------------
+
+  GO TO 4444
+  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
+  DO l = 2, nlay - 1
+    DO ig = 1, ngrid
+      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
+          ig,l+1)) THEN
+        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
+        ! s         ,fm(ig,l+1)*ptimestep
+        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
+        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
+        ! s         ,entr(ig,l)*ptimestep
+        ! s         ,'   M=',masse(ig,l)
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
+        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
+        ! s         ,'   FM=',fm(ig,l)
+      END IF
+      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
+        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
+        ! s         ,'   M=',masse(ig,l)
+        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
+        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
+        ! print*,'zlev(ig,l+1),zlev(ig,l)'
+        ! s                ,zlev(ig,l+1),zlev(ig,l)
+        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
+        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
+      END IF
+      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
+        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
+        ! s         ,'   E=',entr(ig,l)
+      END IF
+    END DO
+  END DO
+
+4444 CONTINUE
+
+  ! CR:redefinition du entr
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      detr(ig, l) = fm(ig, l) + entr(ig, l) - fm(ig, l+1)
+      IF (detr(ig,l)<0.) THEN
+        entr(ig, l) = entr(ig, l) - detr(ig, l)
+        detr(ig, l) = 0.
+        ! print*,'WARNING !!! detrainement negatif ',ig,l
+      END IF
+    END DO
+  END DO
+  ! RC
+  IF (w2di==1) THEN
+    fm0 = fm0 + ptimestep*(fm-fm0)/tho
+    entr0 = entr0 + ptimestep*(entr-entr0)/tho
+  ELSE
+    fm0 = fm
+    entr0 = entr
+  END IF
+
+  IF (1==1) THEN
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zh, zdhadj, &
+      zha)
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zo, pdoadj, &
+      zoa)
+  ELSE
+    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
+      zdhadj, zha)
+    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
+      pdoadj, zoa)
+  END IF
+
+  IF (1==0) THEN
+    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
+      zu, zv, pduadj, pdvadj, zua, zva)
+  ELSE
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
+      zua)
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
+      zva)
+  END IF
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
+      zf2 = zf/(1.-zf)
+      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
+      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
+    END DO
+  END DO
+
+
+
+  ! print*,'13 OK convect8'
+  ! print*,'WA5 ',wa_moy
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      pdtadj(ig, l) = zdhadj(ig, l)*zpspsk(ig, l)
+    END DO
+  END DO
+
+
+  ! do l=1,nlay
+  ! do ig=1,ngrid
+  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
+  ! print*,'WARN!!! ig=',ig,'  l=',l
+  ! s         ,'   pdtadj=',pdtadj(ig,l)
+  ! endif
+  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
+  ! print*,'WARN!!! ig=',ig,'  l=',l
+  ! s         ,'   pdoadj=',pdoadj(ig,l)
+  ! endif
+  ! enddo
+  ! enddo
+
+  ! print*,'14 OK convect8'
+  ! ------------------------------------------------------------------
+  ! Calculs pour les sorties
+  ! ------------------------------------------------------------------
+
+  IF (sorties) THEN
+    DO l = 1, nlay
+      DO ig = 1, ngrid
+        zla(ig, l) = (1.-fracd(ig,l))*zmax(ig)
+        zld(ig, l) = fracd(ig, l)*zmax(ig)
+        IF (1.-fracd(ig,l)>1.E-10) zwa(ig, l) = wd(ig, l)*fracd(ig, l)/ &
+          (1.-fracd(ig,l))
+      END DO
+    END DO
+
+    ! deja fait
+    ! do l=1,nlay
+    ! do ig=1,ngrid
+    ! detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
+    ! if (detr(ig,l).lt.0.) then
+    ! entr(ig,l)=entr(ig,l)-detr(ig,l)
+    ! detr(ig,l)=0.
+    ! print*,'WARNING !!! detrainement negatif ',ig,l
+    ! endif
+    ! enddo
+    ! enddo
+
+    ! print*,'15 OK convect8'
+
+
+    ! #define und
+    GO TO 123
+#ifdef und
+    CALL writeg1d(1, nlay, wd, 'wd      ', 'wd      ')
+    CALL writeg1d(1, nlay, zwa, 'wa      ', 'wa      ')
+    CALL writeg1d(1, nlay, fracd, 'fracd      ', 'fracd      ')
+    CALL writeg1d(1, nlay, fraca, 'fraca      ', 'fraca      ')
+    CALL writeg1d(1, nlay, wa_moy, 'wam         ', 'wam         ')
+    CALL writeg1d(1, nlay, zla, 'la      ', 'la      ')
+    CALL writeg1d(1, nlay, zld, 'ld      ', 'ld      ')
+    CALL writeg1d(1, nlay, pt, 'pt      ', 'pt      ')
+    CALL writeg1d(1, nlay, zh, 'zh      ', 'zh      ')
+    CALL writeg1d(1, nlay, zha, 'zha      ', 'zha      ')
+    CALL writeg1d(1, nlay, zu, 'zu      ', 'zu      ')
+    CALL writeg1d(1, nlay, zv, 'zv      ', 'zv      ')
+    CALL writeg1d(1, nlay, zo, 'zo      ', 'zo      ')
+    CALL writeg1d(1, nlay, wh, 'wh      ', 'wh      ')
+    CALL writeg1d(1, nlay, wu, 'wu      ', 'wu      ')
+    CALL writeg1d(1, nlay, wv, 'wv      ', 'wv      ')
+    CALL writeg1d(1, nlay, wo, 'w15uo     ', 'wXo     ')
+    CALL writeg1d(1, nlay, zdhadj, 'zdhadj      ', 'zdhadj      ')
+    CALL writeg1d(1, nlay, pduadj, 'pduadj      ', 'pduadj      ')
+    CALL writeg1d(1, nlay, pdvadj, 'pdvadj      ', 'pdvadj      ')
+    CALL writeg1d(1, nlay, pdoadj, 'pdoadj      ', 'pdoadj      ')
+    CALL writeg1d(1, nlay, entr, 'entr        ', 'entr        ')
+    CALL writeg1d(1, nlay, detr, 'detr        ', 'detr        ')
+    CALL writeg1d(1, nlay, fm, 'fm          ', 'fm          ')
+
+    CALL writeg1d(1, nlay, pdtadj, 'pdtadj    ', 'pdtadj    ')
+    CALL writeg1d(1, nlay, pplay, 'pplay     ', 'pplay     ')
+    CALL writeg1d(1, nlay, pplev, 'pplev     ', 'pplev     ')
+
+    ! recalcul des flux en diagnostique...
+    ! print*,'PAS DE TEMPS ',ptimestep
+    CALL dt2f(pplev, pplay, pt, pdtadj, wh)
+    CALL writeg1d(1, nlay, wh, 'wh2     ', 'wh2     ')
+#endif
+123 CONTINUE
+
+  END IF
+
+  ! if(wa_moy(1,4).gt.1.e-10) stop
+
+  ! print*,'19 OK convect8'
+  RETURN
+END SUBROUTINE thermcell
+
+SUBROUTINE dqthermcell(ngrid, nlay, ptimestep, fm, entr, masse, q, dq, qa)
+  USE dimphy
+  IMPLICIT NONE
+
+  ! =======================================================================
+
+  ! Calcul du transport verticale dans la couche limite en presence
+  ! de "thermiques" explicitement representes
+  ! calcul du dq/dt une fois qu'on connait les ascendances
+
+  ! =======================================================================
+
+  INTEGER ngrid, nlay
+
+  REAL ptimestep
+  REAL masse(ngrid, nlay), fm(ngrid, nlay+1)
+  REAL entr(ngrid, nlay)
+  REAL q(ngrid, nlay)
+  REAL dq(ngrid, nlay)
+
+  REAL qa(klon, klev), detr(klon, klev), wqd(klon, klev+1)
+
+  INTEGER ig, k
+
+  ! calcul du detrainement
+
+  DO k = 1, nlay
+    DO ig = 1, ngrid
+      detr(ig, k) = fm(ig, k) - fm(ig, k+1) + entr(ig, k)
+      ! test
+      IF (detr(ig,k)<0.) THEN
+        entr(ig, k) = entr(ig, k) - detr(ig, k)
+        detr(ig, k) = 0.
+        ! print*,'detr2<0!!!','ig=',ig,'k=',k,'f=',fm(ig,k),
+        ! s         'f+1=',fm(ig,k+1),'e=',entr(ig,k),'d=',detr(ig,k)
+      END IF
+      IF (fm(ig,k+1)<0.) THEN
+        ! print*,'fm2<0!!!'
+      END IF
+      IF (entr(ig,k)<0.) THEN
+        ! print*,'entr2<0!!!'
+      END IF
+    END DO
+  END DO
+
+  ! calcul de la valeur dans les ascendances
+  DO ig = 1, ngrid
+    qa(ig, 1) = q(ig, 1)
+  END DO
+
+  DO k = 2, nlay
+    DO ig = 1, ngrid
+      IF ((fm(ig,k+1)+detr(ig,k))*ptimestep>1.E-5*masse(ig,k)) THEN
+        qa(ig, k) = (fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))/ &
+          (fm(ig,k+1)+detr(ig,k))
+      ELSE
+        qa(ig, k) = q(ig, k)
+      END IF
+      IF (qa(ig,k)<0.) THEN
+        ! print*,'qa<0!!!'
+      END IF
+      IF (q(ig,k)<0.) THEN
+        ! print*,'q<0!!!'
+      END IF
+    END DO
+  END DO
+
+  DO k = 2, nlay
+    DO ig = 1, ngrid
+      ! wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
+      wqd(ig, k) = fm(ig, k)*q(ig, k)
+      IF (wqd(ig,k)<0.) THEN
+        ! print*,'wqd<0!!!'
+      END IF
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    wqd(ig, 1) = 0.
+    wqd(ig, nlay+1) = 0.
+  END DO
+
+  DO k = 1, nlay
+    DO ig = 1, ngrid
+      dq(ig, k) = (detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)-wqd(ig,k)+wqd(ig,k+ &
+        1))/masse(ig, k)
+      ! if (dq(ig,k).lt.0.) then
+      ! print*,'dq<0!!!'
+      ! endif
+    END DO
+  END DO
+
+  RETURN
+END SUBROUTINE dqthermcell
+SUBROUTINE dvthermcell(ngrid, nlay, ptimestep, fm, entr, masse, fraca, larga, &
+    u, v, du, dv, ua, va)
+  USE dimphy
+  IMPLICIT NONE
+
+  ! =======================================================================
+
+  ! Calcul du transport verticale dans la couche limite en presence
+  ! de "thermiques" explicitement representes
+  ! calcul du dq/dt une fois qu'on connait les ascendances
+
+  ! =======================================================================
+
+  INTEGER ngrid, nlay
+
+  REAL ptimestep
+  REAL masse(ngrid, nlay), fm(ngrid, nlay+1)
+  REAL fraca(ngrid, nlay+1)
+  REAL larga(ngrid)
+  REAL entr(ngrid, nlay)
+  REAL u(ngrid, nlay)
+  REAL ua(ngrid, nlay)
+  REAL du(ngrid, nlay)
+  REAL v(ngrid, nlay)
+  REAL va(ngrid, nlay)
+  REAL dv(ngrid, nlay)
+
+  REAL qa(klon, klev), detr(klon, klev)
+  REAL wvd(klon, klev+1), wud(klon, klev+1)
+  REAL gamma0, gamma(klon, klev+1)
+  REAL dua, dva
+  INTEGER iter
+
+  INTEGER ig, k
+
+  ! calcul du detrainement
+
+  DO k = 1, nlay
+    DO ig = 1, ngrid
+      detr(ig, k) = fm(ig, k) - fm(ig, k+1) + entr(ig, k)
+    END DO
+  END DO
+
+  ! calcul de la valeur dans les ascendances
+  DO ig = 1, ngrid
+    ua(ig, 1) = u(ig, 1)
+    va(ig, 1) = v(ig, 1)
+  END DO
+
+  DO k = 2, nlay
+    DO ig = 1, ngrid
+      IF ((fm(ig,k+1)+detr(ig,k))*ptimestep>1.E-5*masse(ig,k)) THEN
+        ! On itère sur la valeur du coeff de freinage.
+        ! gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
+        gamma0 = masse(ig, k)*sqrt(0.5*(fraca(ig,k+1)+fraca(ig, &
+          k)))*0.5/larga(ig)
+        ! gamma0=0.
+        ! la première fois on multiplie le coefficient de freinage
+        ! par le module du vent dans la couche en dessous.
+        dua = ua(ig, k-1) - u(ig, k-1)
+        dva = va(ig, k-1) - v(ig, k-1)
+        DO iter = 1, 5
+          gamma(ig, k) = gamma0*sqrt(dua**2+dva**2)
+          ua(ig, k) = (fm(ig,k)*ua(ig,k-1)+(entr(ig,k)+gamma(ig, &
+            k))*u(ig,k))/(fm(ig,k+1)+detr(ig,k)+gamma(ig,k))
+          va(ig, k) = (fm(ig,k)*va(ig,k-1)+(entr(ig,k)+gamma(ig, &
+            k))*v(ig,k))/(fm(ig,k+1)+detr(ig,k)+gamma(ig,k))
+          ! print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
+          dua = ua(ig, k) - u(ig, k)
+          dva = va(ig, k) - v(ig, k)
+        END DO
+      ELSE
+        ua(ig, k) = u(ig, k)
+        va(ig, k) = v(ig, k)
+        gamma(ig, k) = 0.
+      END IF
+    END DO
+  END DO
+
+  DO k = 2, nlay
+    DO ig = 1, ngrid
+      wud(ig, k) = fm(ig, k)*u(ig, k)
+      wvd(ig, k) = fm(ig, k)*v(ig, k)
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    wud(ig, 1) = 0.
+    wud(ig, nlay+1) = 0.
+    wvd(ig, 1) = 0.
+    wvd(ig, nlay+1) = 0.
+  END DO
+
+  DO k = 1, nlay
+    DO ig = 1, ngrid
+      du(ig, k) = ((detr(ig,k)+gamma(ig,k))*ua(ig,k)-(entr(ig,k)+gamma(ig, &
+        k))*u(ig,k)-wud(ig,k)+wud(ig,k+1))/masse(ig, k)
+      dv(ig, k) = ((detr(ig,k)+gamma(ig,k))*va(ig,k)-(entr(ig,k)+gamma(ig, &
+        k))*v(ig,k)-wvd(ig,k)+wvd(ig,k+1))/masse(ig, k)
+    END DO
+  END DO
+
+  RETURN
+END SUBROUTINE dvthermcell
+SUBROUTINE dqthermcell2(ngrid, nlay, ptimestep, fm, entr, masse, frac, q, dq, &
+    qa)
+  USE dimphy
+  IMPLICIT NONE
+
+  ! =======================================================================
+
+  ! Calcul du transport verticale dans la couche limite en presence
+  ! de "thermiques" explicitement representes
+  ! calcul du dq/dt une fois qu'on connait les ascendances
+
+  ! =======================================================================
+
+  INTEGER ngrid, nlay
+
+  REAL ptimestep
+  REAL masse(ngrid, nlay), fm(ngrid, nlay+1)
+  REAL entr(ngrid, nlay), frac(ngrid, nlay)
+  REAL q(ngrid, nlay)
+  REAL dq(ngrid, nlay)
+
+  REAL qa(klon, klev), detr(klon, klev), wqd(klon, klev+1)
+  REAL qe(klon, klev), zf, zf2
+
+  INTEGER ig, k
+
+  ! calcul du detrainement
+
+  DO k = 1, nlay
+    DO ig = 1, ngrid
+      detr(ig, k) = fm(ig, k) - fm(ig, k+1) + entr(ig, k)
+    END DO
+  END DO
+
+  ! calcul de la valeur dans les ascendances
+  DO ig = 1, ngrid
+    qa(ig, 1) = q(ig, 1)
+    qe(ig, 1) = q(ig, 1)
+  END DO
+
+  DO k = 2, nlay
+    DO ig = 1, ngrid
+      IF ((fm(ig,k+1)+detr(ig,k))*ptimestep>1.E-5*masse(ig,k)) THEN
+        zf = 0.5*(frac(ig,k)+frac(ig,k+1))
+        zf2 = 1./(1.-zf)
+        qa(ig, k) = (fm(ig,k)*qa(ig,k-1)+zf2*entr(ig,k)*q(ig,k))/ &
+          (fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2)
+        qe(ig, k) = (q(ig,k)-zf*qa(ig,k))*zf2
+      ELSE
+        qa(ig, k) = q(ig, k)
+        qe(ig, k) = q(ig, k)
+      END IF
+    END DO
+  END DO
+
+  DO k = 2, nlay
+    DO ig = 1, ngrid
+      ! wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
+      wqd(ig, k) = fm(ig, k)*qe(ig, k)
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    wqd(ig, 1) = 0.
+    wqd(ig, nlay+1) = 0.
+  END DO
+
+  DO k = 1, nlay
+    DO ig = 1, ngrid
+      dq(ig, k) = (detr(ig,k)*qa(ig,k)-entr(ig,k)*qe(ig,k)-wqd(ig,k)+wqd(ig,k &
+        +1))/masse(ig, k)
+    END DO
+  END DO
+
+  RETURN
+END SUBROUTINE dqthermcell2
+SUBROUTINE dvthermcell2(ngrid, nlay, ptimestep, fm, entr, masse, fraca, &
+    larga, u, v, du, dv, ua, va)
+  USE dimphy
+  IMPLICIT NONE
+
+  ! =======================================================================
+
+  ! Calcul du transport verticale dans la couche limite en presence
+  ! de "thermiques" explicitement representes
+  ! calcul du dq/dt une fois qu'on connait les ascendances
+
+  ! =======================================================================
+
+  INTEGER ngrid, nlay
+
+  REAL ptimestep
+  REAL masse(ngrid, nlay), fm(ngrid, nlay+1)
+  REAL fraca(ngrid, nlay+1)
+  REAL larga(ngrid)
+  REAL entr(ngrid, nlay)
+  REAL u(ngrid, nlay)
+  REAL ua(ngrid, nlay)
+  REAL du(ngrid, nlay)
+  REAL v(ngrid, nlay)
+  REAL va(ngrid, nlay)
+  REAL dv(ngrid, nlay)
+
+  REAL qa(klon, klev), detr(klon, klev), zf, zf2
+  REAL wvd(klon, klev+1), wud(klon, klev+1)
+  REAL gamma0, gamma(klon, klev+1)
+  REAL ue(klon, klev), ve(klon, klev)
+  REAL dua, dva
+  INTEGER iter
+
+  INTEGER ig, k
+
+  ! calcul du detrainement
+
+  DO k = 1, nlay
+    DO ig = 1, ngrid
+      detr(ig, k) = fm(ig, k) - fm(ig, k+1) + entr(ig, k)
+    END DO
+  END DO
+
+  ! calcul de la valeur dans les ascendances
+  DO ig = 1, ngrid
+    ua(ig, 1) = u(ig, 1)
+    va(ig, 1) = v(ig, 1)
+    ue(ig, 1) = u(ig, 1)
+    ve(ig, 1) = v(ig, 1)
+  END DO
+
+  DO k = 2, nlay
+    DO ig = 1, ngrid
+      IF ((fm(ig,k+1)+detr(ig,k))*ptimestep>1.E-5*masse(ig,k)) THEN
+        ! On itère sur la valeur du coeff de freinage.
+        ! gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
+        gamma0 = masse(ig, k)*sqrt(0.5*(fraca(ig,k+1)+fraca(ig, &
+          k)))*0.5/larga(ig)*1.
+        ! s         *0.5
+        ! gamma0=0.
+        zf = 0.5*(fraca(ig,k)+fraca(ig,k+1))
+        zf = 0.
+        zf2 = 1./(1.-zf)
+        ! la première fois on multiplie le coefficient de freinage
+        ! par le module du vent dans la couche en dessous.
+        dua = ua(ig, k-1) - u(ig, k-1)
+        dva = va(ig, k-1) - v(ig, k-1)
+        DO iter = 1, 5
+          ! On choisit une relaxation lineaire.
+          gamma(ig, k) = gamma0
+          ! On choisit une relaxation quadratique.
+          gamma(ig, k) = gamma0*sqrt(dua**2+dva**2)
+          ua(ig, k) = (fm(ig,k)*ua(ig,k-1)+(zf2*entr(ig,k)+gamma(ig, &
+            k))*u(ig,k))/(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2+gamma(ig,k) &
+            )
+          va(ig, k) = (fm(ig,k)*va(ig,k-1)+(zf2*entr(ig,k)+gamma(ig, &
+            k))*v(ig,k))/(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2+gamma(ig,k) &
+            )
+          ! print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
+          dua = ua(ig, k) - u(ig, k)
+          dva = va(ig, k) - v(ig, k)
+          ue(ig, k) = (u(ig,k)-zf*ua(ig,k))*zf2
+          ve(ig, k) = (v(ig,k)-zf*va(ig,k))*zf2
+        END DO
+      ELSE
+        ua(ig, k) = u(ig, k)
+        va(ig, k) = v(ig, k)
+        ue(ig, k) = u(ig, k)
+        ve(ig, k) = v(ig, k)
+        gamma(ig, k) = 0.
+      END IF
+    END DO
+  END DO
+
+  DO k = 2, nlay
+    DO ig = 1, ngrid
+      wud(ig, k) = fm(ig, k)*ue(ig, k)
+      wvd(ig, k) = fm(ig, k)*ve(ig, k)
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    wud(ig, 1) = 0.
+    wud(ig, nlay+1) = 0.
+    wvd(ig, 1) = 0.
+    wvd(ig, nlay+1) = 0.
+  END DO
+
+  DO k = 1, nlay
+    DO ig = 1, ngrid
+      du(ig, k) = ((detr(ig,k)+gamma(ig,k))*ua(ig,k)-(entr(ig,k)+gamma(ig, &
+        k))*ue(ig,k)-wud(ig,k)+wud(ig,k+1))/masse(ig, k)
+      dv(ig, k) = ((detr(ig,k)+gamma(ig,k))*va(ig,k)-(entr(ig,k)+gamma(ig, &
+        k))*ve(ig,k)-wvd(ig,k)+wvd(ig,k+1))/masse(ig, k)
+    END DO
+  END DO
+
+  RETURN
+END SUBROUTINE dvthermcell2
+SUBROUTINE thermcell_sec(ngrid, nlay, ptimestep, pplay, pplev, pphi, zlev, &
+    pu, pv, pt, po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0 & ! s
+                                                                 ! ,pu_therm,pv_therm
+    , r_aspect, l_mix, w2di, tho)
+
+  USE dimphy
+  IMPLICIT NONE
+
+  ! =======================================================================
+
+  ! Calcul du transport verticale dans la couche limite en presence
+  ! de "thermiques" explicitement representes
+
+  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
+
+  ! le thermique est supposé homogène et dissipé par mélange avec
+  ! son environnement. la longueur l_mix contrôle l'efficacité du
+  ! mélange
+
+  ! Le calcul du transport des différentes espèces se fait en prenant
+  ! en compte:
+  ! 1. un flux de masse montant
+  ! 2. un flux de masse descendant
+  ! 3. un entrainement
+  ! 4. un detrainement
+
+  ! =======================================================================
+
+  ! -----------------------------------------------------------------------
+  ! declarations:
+  ! -------------
+
+  include "YOMCST.h"
+
+  ! arguments:
+  ! ----------
+
+  INTEGER ngrid, nlay, w2di
+  REAL tho
+  REAL ptimestep, l_mix, r_aspect
+  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
+  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
+  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
+  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
+  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
+  REAL pphi(ngrid, nlay)
+
+  INTEGER idetr
+  SAVE idetr
+  DATA idetr/3/
+  !$OMP THREADPRIVATE(idetr)
+
+  ! local:
+  ! ------
+
+  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
+  REAL zsortie1d(klon)
+  ! CR: on remplace lmax(klon,klev+1)
+  INTEGER lmax(klon), lmin(klon), lentr(klon)
+  REAL linter(klon)
+  REAL zmix(klon), fracazmix(klon)
+  ! RC
+  REAL zmax(klon), zw, zz, zw2(klon, klev+1), ztva(klon, klev), zzz
+
+  REAL zlev(klon, klev+1), zlay(klon, klev)
+  REAL zh(klon, klev), zdhadj(klon, klev)
+  REAL ztv(klon, klev)
+  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
+  REAL wh(klon, klev+1)
+  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
+  REAL zla(klon, klev+1)
+  REAL zwa(klon, klev+1)
+  REAL zld(klon, klev+1)
+  REAL zwd(klon, klev+1)
+  REAL zsortie(klon, klev)
+  REAL zva(klon, klev)
+  REAL zua(klon, klev)
+  REAL zoa(klon, klev)
+
+  REAL zha(klon, klev)
+  REAL wa_moy(klon, klev+1)
+  REAL fraca(klon, klev+1)
+  REAL fracc(klon, klev+1)
+  REAL zf, zf2
+  REAL thetath2(klon, klev), wth2(klon, klev)
+  ! common/comtherm/thetath2,wth2
+
+  REAL count_time
+  INTEGER ialt
+
+  LOGICAL sorties
+  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
+  REAL zpspsk(klon, klev)
+
+  ! real wmax(klon,klev),wmaxa(klon)
+  REAL wmax(klon), wmaxa(klon)
+  REAL wa(klon, klev, klev+1)
+  REAL wd(klon, klev+1)
+  REAL larg_part(klon, klev, klev+1)
+  REAL fracd(klon, klev+1)
+  REAL xxx(klon, klev+1)
+  REAL larg_cons(klon, klev+1)
+  REAL larg_detr(klon, klev+1)
+  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
+  REAL pu_therm(klon, klev), pv_therm(klon, klev)
+  REAL fm(klon, klev+1), entr(klon, klev)
+  REAL fmc(klon, klev+1)
+
+  ! CR:nouvelles variables
+  REAL f_star(klon, klev+1), entr_star(klon, klev)
+  REAL entr_star_tot(klon), entr_star2(klon)
+  REAL f(klon), f0(klon)
+  REAL zlevinter(klon)
+  LOGICAL first
+  DATA first/.FALSE./
+  SAVE first
+  !$OMP THREADPRIVATE(first)
+  ! RC
+
+  CHARACTER *2 str2
+  CHARACTER *10 str10
+
+  CHARACTER (LEN=20) :: modname = 'thermcell_sec'
+  CHARACTER (LEN=80) :: abort_message
+
+  LOGICAL vtest(klon), down
+
+  EXTERNAL scopy
+
+  INTEGER ncorrec, ll
+  SAVE ncorrec
+  DATA ncorrec/0/
+  !$OMP THREADPRIVATE(ncorrec)
+
+
+  ! -----------------------------------------------------------------------
+  ! initialisation:
+  ! ---------------
+
+  sorties = .TRUE.
+  IF (ngrid/=klon) THEN
+    PRINT *
+    PRINT *, 'STOP dans convadj'
+    PRINT *, 'ngrid    =', ngrid
+    PRINT *, 'klon  =', klon
+  END IF
+
+  ! -----------------------------------------------------------------------
+  ! incrementation eventuelle de tendances precedentes:
+  ! ---------------------------------------------------
+
+  ! print*,'0 OK convect8'
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
+      zh(ig, l) = pt(ig, l)/zpspsk(ig, l)
+      zu(ig, l) = pu(ig, l)
+      zv(ig, l) = pv(ig, l)
+      zo(ig, l) = po(ig, l)
+      ztv(ig, l) = zh(ig, l)*(1.+0.61*zo(ig,l))
+    END DO
+  END DO
+
+  ! print*,'1 OK convect8'
+  ! --------------------
+
+
+  ! + + + + + + + + + + +
+
+
+  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+  ! wh,wt,wo ...
+
+  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
+
+
+  ! --------------------   zlev(1)
+  ! \\\\\\\\\\\\\\\\\\\\
+
+
+
+  ! -----------------------------------------------------------------------
+  ! Calcul des altitudes des couches
+  ! -----------------------------------------------------------------------
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    zlev(ig, 1) = 0.
+    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
+  END DO
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zlay(ig, l) = pphi(ig, l)/rg
+    END DO
+  END DO
+
+  ! print*,'2 OK convect8'
+  ! -----------------------------------------------------------------------
+  ! Calcul des densites
+  ! -----------------------------------------------------------------------
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*zh(ig,l))
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
+    END DO
+  END DO
+
+  DO k = 1, nlay
+    DO l = 1, nlay + 1
+      DO ig = 1, ngrid
+        wa(ig, k, l) = 0.
+      END DO
+    END DO
+  END DO
+
+  ! print*,'3 OK convect8'
+  ! ------------------------------------------------------------------
+  ! Calcul de w2, quarre de w a partir de la cape
+  ! a partir de w2, on calcule wa, vitesse de l'ascendance
+
+  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
+  ! w2 est stoke dans wa
+
+  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
+  ! independants par couches que pour calculer l'entrainement
+  ! a la base et la hauteur max de l'ascendance.
+
+  ! Indicages:
+  ! l'ascendance provenant du niveau k traverse l'interface l avec
+  ! une vitesse wa(k,l).
+
+  ! --------------------
+
+  ! + + + + + + + + + +
+
+  ! wa(k,l)   ----       --------------------    l
+  ! /\
+  ! /||\       + + + + + + + + + +
+  ! ||
+  ! ||        --------------------
+  ! ||
+  ! ||        + + + + + + + + + +
+  ! ||
+  ! ||        --------------------
+  ! ||__
+  ! |___      + + + + + + + + + +     k
+
+  ! --------------------
+
+
+
+  ! ------------------------------------------------------------------
+
+  ! CR: ponderation entrainement des couches instables
+  ! def des entr_star tels que entr=f*entr_star
+  DO l = 1, klev
+    DO ig = 1, ngrid
+      entr_star(ig, l) = 0.
+    END DO
+  END DO
+  ! determination de la longueur de la couche d entrainement
+  DO ig = 1, ngrid
+    lentr(ig) = 1
+  END DO
+
+  ! on ne considere que les premieres couches instables
+  DO k = nlay - 2, 1, -1
+    DO ig = 1, ngrid
+      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<=ztv(ig,k+2)) THEN
+        lentr(ig) = k
+      END IF
+    END DO
+  END DO
+
+  ! determination du lmin: couche d ou provient le thermique
+  DO ig = 1, ngrid
+    lmin(ig) = 1
+  END DO
+  DO ig = 1, ngrid
+    DO l = nlay, 2, -1
+      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
+        lmin(ig) = l - 1
+      END IF
+    END DO
+  END DO
+
+  ! definition de l'entrainement des couches
+  DO l = 1, klev - 1
+    DO ig = 1, ngrid
+      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<=lentr(ig)) THEN
+        entr_star(ig, l) = (ztv(ig,l)-ztv(ig,l+1))** & ! s
+                                                       ! (zlev(ig,l+1)-zlev(ig,l))
+          sqrt(zlev(ig,l+1))
+      END IF
+    END DO
+  END DO
+  ! pas de thermique si couche 1 stable
+  DO ig = 1, ngrid
+    IF (lmin(ig)>1) THEN
+      DO l = 1, klev
+        entr_star(ig, l) = 0.
+      END DO
+    END IF
+  END DO
+  ! calcul de l entrainement total
+  DO ig = 1, ngrid
+    entr_star_tot(ig) = 0.
+  END DO
+  DO ig = 1, ngrid
+    DO k = 1, klev
+      entr_star_tot(ig) = entr_star_tot(ig) + entr_star(ig, k)
+    END DO
+  END DO
+
+  ! print*,'fin calcul entr_star'
+  DO k = 1, klev
+    DO ig = 1, ngrid
+      ztva(ig, k) = ztv(ig, k)
+    END DO
+  END DO
+  ! RC
+  ! print*,'7 OK convect8'
+  DO k = 1, klev + 1
+    DO ig = 1, ngrid
+      zw2(ig, k) = 0.
+      fmc(ig, k) = 0.
+      ! CR
+      f_star(ig, k) = 0.
+      ! RC
+      larg_cons(ig, k) = 0.
+      larg_detr(ig, k) = 0.
+      wa_moy(ig, k) = 0.
+    END DO
+  END DO
+
+  ! print*,'8 OK convect8'
+  DO ig = 1, ngrid
+    linter(ig) = 1.
+    lmaxa(ig) = 1
+    lmix(ig) = 1
+    wmaxa(ig) = 0.
+  END DO
+
+  ! CR:
+  DO l = 1, nlay - 2
+    DO ig = 1, ngrid
+      IF (ztv(ig,l)>ztv(ig,l+1) .AND. entr_star(ig,l)>1.E-10 .AND. &
+          zw2(ig,l)<1E-10) THEN
+        f_star(ig, l+1) = entr_star(ig, l)
+        ! test:calcul de dteta
+        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
+          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
+        larg_detr(ig, l) = 0.
+      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+entr_star(ig, &
+          l)>1.E-10)) THEN
+        f_star(ig, l+1) = f_star(ig, l) + entr_star(ig, l)
+        ztva(ig, l) = (f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)*ztv(ig,l))/ &
+          f_star(ig, l+1)
+        zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/f_star(ig,l+1))**2 + &
+          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
+      END IF
+      ! determination de zmax continu par interpolation lineaire
+      IF (zw2(ig,l+1)<0.) THEN
+        ! test
+        IF (abs(zw2(ig,l+1)-zw2(ig,l))<1E-10) THEN
+          ! print*,'pb linter'
+        END IF
+        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
+          ig,l))
+        zw2(ig, l+1) = 0.
+        lmaxa(ig) = l
+      ELSE
+        IF (zw2(ig,l+1)<0.) THEN
+          ! print*,'pb1 zw2<0'
+        END IF
+        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
+      END IF
+      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
+        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
+        lmix(ig) = l + 1
+        wmaxa(ig) = wa_moy(ig, l+1)
+      END IF
+    END DO
+  END DO
+  ! print*,'fin calcul zw2'
+
+  ! Calcul de la couche correspondant a la hauteur du thermique
+  DO ig = 1, ngrid
+    lmax(ig) = lentr(ig)
+  END DO
+  DO ig = 1, ngrid
+    DO l = nlay, lentr(ig) + 1, -1
+      IF (zw2(ig,l)<=1.E-10) THEN
+        lmax(ig) = l - 1
+      END IF
+    END DO
+  END DO
+  ! pas de thermique si couche 1 stable
+  DO ig = 1, ngrid
+    IF (lmin(ig)>1) THEN
+      lmax(ig) = 1
+      lmin(ig) = 1
+    END IF
+  END DO
+
+  ! Determination de zw2 max
+  DO ig = 1, ngrid
+    wmax(ig) = 0.
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmax(ig)) THEN
+        IF (zw2(ig,l)<0.) THEN
+          ! print*,'pb2 zw2<0'
+        END IF
+        zw2(ig, l) = sqrt(zw2(ig,l))
+        wmax(ig) = max(wmax(ig), zw2(ig,l))
+      ELSE
+        zw2(ig, l) = 0.
+      END IF
+    END DO
+  END DO
+
+  ! Longueur caracteristique correspondant a la hauteur des thermiques.
+  DO ig = 1, ngrid
+    zmax(ig) = 0.
+    zlevinter(ig) = zlev(ig, 1)
+  END DO
+  DO ig = 1, ngrid
+    ! calcul de zlevinter
+    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
+      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
+    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,lmin(ig)))
+  END DO
+
+  ! print*,'avant fermeture'
+  ! Fermeture,determination de f
+  DO ig = 1, ngrid
+    entr_star2(ig) = 0.
+  END DO
+  DO ig = 1, ngrid
+    IF (entr_star_tot(ig)<1.E-10) THEN
+      f(ig) = 0.
+    ELSE
+      DO k = lmin(ig), lentr(ig)
+        entr_star2(ig) = entr_star2(ig) + entr_star(ig, k)**2/(rho(ig,k)*( &
+          zlev(ig,k+1)-zlev(ig,k)))
+      END DO
+      ! Nouvelle fermeture
+      f(ig) = wmax(ig)/(max(500.,zmax(ig))*r_aspect*entr_star2(ig))* &
+        entr_star_tot(ig)
+      ! test
+      ! if (first) then
+      ! f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
+      ! s             *wmax(ig))
+      ! endif
+    END IF
+    ! f0(ig)=f(ig)
+    ! first=.true.
+  END DO
+  ! print*,'apres fermeture'
+
+  ! Calcul de l'entrainement
+  DO k = 1, klev
+    DO ig = 1, ngrid
+      entr(ig, k) = f(ig)*entr_star(ig, k)
+    END DO
+  END DO
+  ! CR:test pour entrainer moins que la masse
+  DO ig = 1, ngrid
+    DO l = 1, lentr(ig)
+      IF ((entr(ig,l)*ptimestep)>(0.9*masse(ig,l))) THEN
+        entr(ig, l+1) = entr(ig, l+1) + entr(ig, l) - &
+          0.9*masse(ig, l)/ptimestep
+        entr(ig, l) = 0.9*masse(ig, l)/ptimestep
+      END IF
+    END DO
+  END DO
+  ! CR: fin test
+  ! Calcul des flux
+  DO ig = 1, ngrid
+    DO l = 1, lmax(ig) - 1
+      fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
+    END DO
+  END DO
+
+  ! RC
+
+
+  ! print*,'9 OK convect8'
+  ! print*,'WA1 ',wa_moy
+
+  ! determination de l'indice du debut de la mixed layer ou w decroit
+
+  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
+  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
+  ! d'une couche est égale à la hauteur de la couche alimentante.
+  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
+  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmaxa(ig)) THEN
+        zw = max(wa_moy(ig,l), 1.E-10)
+        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
+      END IF
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmaxa(ig)) THEN
+        ! if (idetr.eq.0) then
+        ! cette option est finalement en dur.
+        IF ((l_mix*zlev(ig,l))<0.) THEN
+          ! print*,'pb l_mix*zlev<0'
+        END IF
+        ! CR: test: nouvelle def de lambda
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        IF (zw2(ig,l)>1.E-10) THEN
+          larg_detr(ig, l) = sqrt((l_mix/zw2(ig,l))*zlev(ig,l))
+        ELSE
+          larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
+        END IF
+        ! RC
+        ! else if (idetr.eq.1) then
+        ! larg_detr(ig,l)=larg_cons(ig,l)
+        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
+        ! else if (idetr.eq.2) then
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        ! s            *sqrt(wa_moy(ig,l))
+        ! else if (idetr.eq.4) then
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        ! s            *wa_moy(ig,l)
+        ! endif
+      END IF
+    END DO
+  END DO
+
+  ! print*,'10 OK convect8'
+  ! print*,'WA2 ',wa_moy
+  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
+  ! compte de l'epluchage du thermique.
+
+  ! CR def de  zmix continu (profil parabolique des vitesses)
+  DO ig = 1, ngrid
+    IF (lmix(ig)>1.) THEN
+      ! test
+      IF (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
+          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
+          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))- &
+          (zlev(ig,lmix(ig)))))>1E-10) THEN
+
+        zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)) &
+          )**2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
+          lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
+          (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
+          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
+          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
+      ELSE
+        zmix(ig) = zlev(ig, lmix(ig))
+        ! print*,'pb zmix'
+      END IF
+    ELSE
+      zmix(ig) = 0.
+    END IF
+    ! test
+    IF ((zmax(ig)-zmix(ig))<0.) THEN
+      zmix(ig) = 0.99*zmax(ig)
+      ! print*,'pb zmix>zmax'
+    END IF
+  END DO
+
+  ! calcul du nouveau lmix correspondant
+  DO ig = 1, ngrid
+    DO l = 1, klev
+      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
+        lmix(ig) = l
+      END IF
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (larg_cons(ig,l)>1.) THEN
+        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
+        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
+        ! test
+        fraca(ig, l) = max(fraca(ig,l), 0.)
+        fraca(ig, l) = min(fraca(ig,l), 0.5)
+        fracd(ig, l) = 1. - fraca(ig, l)
+        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
+      ELSE
+        ! wa_moy(ig,l)=0.
+        fraca(ig, l) = 0.
+        fracc(ig, l) = 0.
+        fracd(ig, l) = 1.
+      END IF
+    END DO
+  END DO
+  ! CR: calcul de fracazmix
+  DO ig = 1, ngrid
+    fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
+      (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
+      fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca(ig &
+      ,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (larg_cons(ig,l)>1.) THEN
+        IF (l>lmix(ig)) THEN
+          ! test
+          IF (zmax(ig)-zmix(ig)<1.E-10) THEN
+            ! print*,'pb xxx'
+            xxx(ig, l) = (lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
+          ELSE
+            xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
+          END IF
+          IF (idetr==0) THEN
+            fraca(ig, l) = fracazmix(ig)
+          ELSE IF (idetr==1) THEN
+            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
+          ELSE IF (idetr==2) THEN
+            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
+          ELSE
+            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
+          END IF
+          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
+          fraca(ig, l) = max(fraca(ig,l), 0.)
+          fraca(ig, l) = min(fraca(ig,l), 0.5)
+          fracd(ig, l) = 1. - fraca(ig, l)
+          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
+        END IF
+      END IF
+    END DO
+  END DO
+
+  ! print*,'fin calcul fraca'
+  ! print*,'11 OK convect8'
+  ! print*,'Ea3 ',wa_moy
+  ! ------------------------------------------------------------------
+  ! Calcul de fracd, wd
+  ! somme wa - wd = 0
+  ! ------------------------------------------------------------------
+
+
+  DO ig = 1, ngrid
+    fm(ig, 1) = 0.
+    fm(ig, nlay+1) = 0.
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
+      ! CR:test
+      IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
+        fm(ig, l) = fm(ig, l-1)
+        ! write(1,*)'ajustement fm, l',l
+      END IF
+      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+      ! RC
+    END DO
+    DO ig = 1, ngrid
+      IF (fracd(ig,l)<0.1) THEN
+        abort_message = 'fracd trop petit'
+        CALL abort_physic(modname, abort_message, 1)
+      ELSE
+        ! vitesse descendante "diagnostique"
+        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
+    END DO
+  END DO
+
+  ! print*,'12 OK convect8'
+  ! print*,'WA4 ',wa_moy
+  ! c------------------------------------------------------------------
+  ! calcul du transport vertical
+  ! ------------------------------------------------------------------
+
+  GO TO 4444
+  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
+  DO l = 2, nlay - 1
+    DO ig = 1, ngrid
+      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
+          ig,l+1)) THEN
+        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
+        ! s         ,fm(ig,l+1)*ptimestep
+        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
+        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
+        ! s         ,entr(ig,l)*ptimestep
+        ! s         ,'   M=',masse(ig,l)
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
+        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
+        ! s         ,'   FM=',fm(ig,l)
+      END IF
+      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
+        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
+        ! s         ,'   M=',masse(ig,l)
+        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
+        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
+        ! print*,'zlev(ig,l+1),zlev(ig,l)'
+        ! s                ,zlev(ig,l+1),zlev(ig,l)
+        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
+        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
+      END IF
+      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
+        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
+        ! s         ,'   E=',entr(ig,l)
+      END IF
+    END DO
+  END DO
+
+4444 CONTINUE
+
+  ! CR:redefinition du entr
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      detr(ig, l) = fm(ig, l) + entr(ig, l) - fm(ig, l+1)
+      IF (detr(ig,l)<0.) THEN
+        entr(ig, l) = entr(ig, l) - detr(ig, l)
+        detr(ig, l) = 0.
+        ! print*,'WARNING !!! detrainement negatif ',ig,l
+      END IF
+    END DO
+  END DO
+  ! RC
+  IF (w2di==1) THEN
+    fm0 = fm0 + ptimestep*(fm-fm0)/tho
+    entr0 = entr0 + ptimestep*(entr-entr0)/tho
+  ELSE
+    fm0 = fm
+    entr0 = entr
+  END IF
+
+  IF (1==1) THEN
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zh, zdhadj, &
+      zha)
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zo, pdoadj, &
+      zoa)
+  ELSE
+    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
+      zdhadj, zha)
+    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
+      pdoadj, zoa)
+  END IF
+
+  IF (1==0) THEN
+    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
+      zu, zv, pduadj, pdvadj, zua, zva)
+  ELSE
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
+      zua)
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
+      zva)
+  END IF
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
+      zf2 = zf/(1.-zf)
+      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
+      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
+    END DO
+  END DO
+
+
+
+  ! print*,'13 OK convect8'
+  ! print*,'WA5 ',wa_moy
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      pdtadj(ig, l) = zdhadj(ig, l)*zpspsk(ig, l)
+    END DO
+  END DO
+
+
+  ! do l=1,nlay
+  ! do ig=1,ngrid
+  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
+  ! print*,'WARN!!! ig=',ig,'  l=',l
+  ! s         ,'   pdtadj=',pdtadj(ig,l)
+  ! endif
+  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
+  ! print*,'WARN!!! ig=',ig,'  l=',l
+  ! s         ,'   pdoadj=',pdoadj(ig,l)
+  ! endif
+  ! enddo
+  ! enddo
+
+  ! print*,'14 OK convect8'
+  ! ------------------------------------------------------------------
+  ! Calculs pour les sorties
+  ! ------------------------------------------------------------------
+
+  RETURN
+END SUBROUTINE thermcell_sec
+
+SUBROUTINE calcul_sec(ngrid, nlay, ptimestep, pplay, pplev, pphi, zlev, pu, &
+    pv, pt, po, zmax, wmax, zw2, lmix & ! s
+                                        ! ,pu_therm,pv_therm
+    , r_aspect, l_mix, w2di, tho)
+
+  USE dimphy
+  IMPLICIT NONE
+
+  ! =======================================================================
+
+  ! Calcul du transport verticale dans la couche limite en presence
+  ! de "thermiques" explicitement representes
+
+  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
+
+  ! le thermique est supposé homogène et dissipé par mélange avec
+  ! son environnement. la longueur l_mix contrôle l'efficacité du
+  ! mélange
+
+  ! Le calcul du transport des différentes espèces se fait en prenant
+  ! en compte:
+  ! 1. un flux de masse montant
+  ! 2. un flux de masse descendant
+  ! 3. un entrainement
+  ! 4. un detrainement
+
+  ! =======================================================================
+
+  ! -----------------------------------------------------------------------
+  ! declarations:
+  ! -------------
+
+  include "YOMCST.h"
+
+  ! arguments:
+  ! ----------
+
+  INTEGER ngrid, nlay, w2di
+  REAL tho
+  REAL ptimestep, l_mix, r_aspect
+  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
+  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
+  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
+  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
+  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
+  REAL pphi(ngrid, nlay)
+
+  INTEGER idetr
+  SAVE idetr
+  DATA idetr/3/
+  !$OMP THREADPRIVATE(idetr)
+  ! local:
+  ! ------
+
+  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
+  REAL zsortie1d(klon)
+  ! CR: on remplace lmax(klon,klev+1)
+  INTEGER lmax(klon), lmin(klon), lentr(klon)
+  REAL linter(klon)
+  REAL zmix(klon), fracazmix(klon)
+  ! RC
+  REAL zmax(klon), zw, zw2(klon, klev+1), ztva(klon, klev)
+
+  REAL zlev(klon, klev+1), zlay(klon, klev)
+  REAL zh(klon, klev), zdhadj(klon, klev)
+  REAL ztv(klon, klev)
+  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
+  REAL wh(klon, klev+1)
+  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
+  REAL zla(klon, klev+1)
+  REAL zwa(klon, klev+1)
+  REAL zld(klon, klev+1)
+  ! real zwd(klon,klev+1)
+  REAL zsortie(klon, klev)
+  REAL zva(klon, klev)
+  REAL zua(klon, klev)
+  REAL zoa(klon, klev)
+
+  REAL zha(klon, klev)
+  REAL wa_moy(klon, klev+1)
+  REAL fraca(klon, klev+1)
+  REAL fracc(klon, klev+1)
+  REAL zf, zf2
+  REAL thetath2(klon, klev), wth2(klon, klev)
+  ! common/comtherm/thetath2,wth2
+
+  REAL count_time
+  ! integer isplit,nsplit
+  INTEGER isplit, nsplit, ialt
+  PARAMETER (nsplit=10)
+  DATA isplit/0/
+  SAVE isplit
+  !$OMP THREADPRIVATE(isplit)
+
+  LOGICAL sorties
+  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
+  REAL zpspsk(klon, klev)
+
+  ! real wmax(klon,klev),wmaxa(klon)
+  REAL wmax(klon), wmaxa(klon)
+  REAL wa(klon, klev, klev+1)
+  REAL wd(klon, klev+1)
+  REAL larg_part(klon, klev, klev+1)
+  REAL fracd(klon, klev+1)
+  REAL xxx(klon, klev+1)
+  REAL larg_cons(klon, klev+1)
+  REAL larg_detr(klon, klev+1)
+  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
+  REAL pu_therm(klon, klev), pv_therm(klon, klev)
+  REAL fm(klon, klev+1), entr(klon, klev)
+  REAL fmc(klon, klev+1)
+
+  ! CR:nouvelles variables
+  REAL f_star(klon, klev+1), entr_star(klon, klev)
+  REAL entr_star_tot(klon), entr_star2(klon)
+  REAL zalim(klon)
+  INTEGER lalim(klon)
+  REAL norme(klon)
+  REAL f(klon), f0(klon)
+  REAL zlevinter(klon)
+  LOGICAL therm
+  LOGICAL first
+  DATA first/.FALSE./
+  SAVE first
+  !$OMP THREADPRIVATE(first)
+  ! RC
+
+  CHARACTER *2 str2
+  CHARACTER *10 str10
+
+  CHARACTER (LEN=20) :: modname = 'calcul_sec'
+  CHARACTER (LEN=80) :: abort_message
+
+
+  ! LOGICAL vtest(klon),down
+
+  EXTERNAL scopy
+
+  INTEGER ncorrec
+  SAVE ncorrec
+  DATA ncorrec/0/
+  !$OMP THREADPRIVATE(ncorrec)
+
+
+  ! -----------------------------------------------------------------------
+  ! initialisation:
+  ! ---------------
+
+  sorties = .TRUE.
+  IF (ngrid/=klon) THEN
+    PRINT *
+    PRINT *, 'STOP dans convadj'
+    PRINT *, 'ngrid    =', ngrid
+    PRINT *, 'klon  =', klon
+  END IF
+
+  ! -----------------------------------------------------------------------
+  ! incrementation eventuelle de tendances precedentes:
+  ! ---------------------------------------------------
+
+  ! print*,'0 OK convect8'
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
+      zh(ig, l) = pt(ig, l)/zpspsk(ig, l)
+      zu(ig, l) = pu(ig, l)
+      zv(ig, l) = pv(ig, l)
+      zo(ig, l) = po(ig, l)
+      ztv(ig, l) = zh(ig, l)*(1.+0.61*zo(ig,l))
+    END DO
+  END DO
+
+  ! print*,'1 OK convect8'
+  ! --------------------
+
+
+  ! + + + + + + + + + + +
+
+
+  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+  ! wh,wt,wo ...
+
+  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
+
+
+  ! --------------------   zlev(1)
+  ! \\\\\\\\\\\\\\\\\\\\
+
+
+
+  ! -----------------------------------------------------------------------
+  ! Calcul des altitudes des couches
+  ! -----------------------------------------------------------------------
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    zlev(ig, 1) = 0.
+    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
+  END DO
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zlay(ig, l) = pphi(ig, l)/rg
+    END DO
+  END DO
+
+  ! print*,'2 OK convect8'
+  ! -----------------------------------------------------------------------
+  ! Calcul des densites
+  ! -----------------------------------------------------------------------
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*zh(ig,l))
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
+    END DO
+  END DO
+
+  DO k = 1, nlay
+    DO l = 1, nlay + 1
+      DO ig = 1, ngrid
+        wa(ig, k, l) = 0.
+      END DO
+    END DO
+  END DO
+
+  ! print*,'3 OK convect8'
+  ! ------------------------------------------------------------------
+  ! Calcul de w2, quarre de w a partir de la cape
+  ! a partir de w2, on calcule wa, vitesse de l'ascendance
+
+  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
+  ! w2 est stoke dans wa
+
+  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
+  ! independants par couches que pour calculer l'entrainement
+  ! a la base et la hauteur max de l'ascendance.
+
+  ! Indicages:
+  ! l'ascendance provenant du niveau k traverse l'interface l avec
+  ! une vitesse wa(k,l).
+
+  ! --------------------
+
+  ! + + + + + + + + + +
+
+  ! wa(k,l)   ----       --------------------    l
+  ! /\
+  ! /||\       + + + + + + + + + +
+  ! ||
+  ! ||        --------------------
+  ! ||
+  ! ||        + + + + + + + + + +
+  ! ||
+  ! ||        --------------------
+  ! ||__
+  ! |___      + + + + + + + + + +     k
+
+  ! --------------------
+
+
+
+  ! ------------------------------------------------------------------
+
+  ! CR: ponderation entrainement des couches instables
+  ! def des entr_star tels que entr=f*entr_star
+  DO l = 1, klev
+    DO ig = 1, ngrid
+      entr_star(ig, l) = 0.
+    END DO
+  END DO
+  ! determination de la longueur de la couche d entrainement
+  DO ig = 1, ngrid
+    lentr(ig) = 1
+  END DO
+
+  ! on ne considere que les premieres couches instables
+  therm = .FALSE.
+  DO k = nlay - 2, 1, -1
+    DO ig = 1, ngrid
+      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<=ztv(ig,k+2)) THEN
+        lentr(ig) = k + 1
+        therm = .TRUE.
+      END IF
+    END DO
+  END DO
+  ! limitation de la valeur du lentr
+  ! do ig=1,ngrid
+  ! lentr(ig)=min(5,lentr(ig))
+  ! enddo
+  ! determination du lmin: couche d ou provient le thermique
+  DO ig = 1, ngrid
+    lmin(ig) = 1
+  END DO
+  DO ig = 1, ngrid
+    DO l = nlay, 2, -1
+      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
+        lmin(ig) = l - 1
+      END IF
+    END DO
+  END DO
+  ! initialisations
+  DO ig = 1, ngrid
+    zalim(ig) = 0.
+    norme(ig) = 0.
+    lalim(ig) = 1
+  END DO
+  DO k = 1, klev - 1
+    DO ig = 1, ngrid
+      zalim(ig) = zalim(ig) + zlev(ig, k)*max(0., (ztv(ig,k)-ztv(ig, &
+        k+1))/(zlev(ig,k+1)-zlev(ig,k)))
+      ! s         *(zlev(ig,k+1)-zlev(ig,k))
+      norme(ig) = norme(ig) + max(0., (ztv(ig,k)-ztv(ig,k+1))/(zlev(ig, &
+        k+1)-zlev(ig,k)))
+      ! s          *(zlev(ig,k+1)-zlev(ig,k))
+    END DO
+  END DO
+  DO ig = 1, ngrid
+    IF (norme(ig)>1.E-10) THEN
+      zalim(ig) = max(10.*zalim(ig)/norme(ig), zlev(ig,2))
+      ! zalim(ig)=min(zalim(ig),zlev(ig,lentr(ig)))
+    END IF
+  END DO
+  ! détermination du lalim correspondant
+  DO k = 1, klev - 1
+    DO ig = 1, ngrid
+      IF ((zalim(ig)>zlev(ig,k)) .AND. (zalim(ig)<=zlev(ig,k+1))) THEN
+        lalim(ig) = k
+      END IF
+    END DO
+  END DO
+
+  ! definition de l'entrainement des couches
+  DO l = 1, klev - 1
+    DO ig = 1, ngrid
+      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<lentr(ig)) THEN
+        entr_star(ig, l) = max((ztv(ig,l)-ztv(ig,l+1)), 0.) & ! s
+                                                              ! *(zlev(ig,l+1)-zlev(ig,l))
+          *sqrt(zlev(ig,l+1))
+        ! autre def
+        ! entr_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
+        ! s                         /zlev(ig,lentr(ig)+2)))**(3./2.)
+      END IF
+    END DO
+  END DO
+  ! nouveau test
+  ! if (therm) then
+  DO l = 1, klev - 1
+    DO ig = 1, ngrid
+      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<=lalim(ig) .AND. &
+          zalim(ig)>1.E-10) THEN
+        ! if (l.le.lentr(ig)) then
+        ! entr_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
+        ! s                         /zalim(ig)))**(3./2.)
+        ! write(10,*)zlev(ig,l),entr_star(ig,l)
+      END IF
+    END DO
+  END DO
+  ! endif
+  ! pas de thermique si couche 1 stable
+  DO ig = 1, ngrid
+    IF (lmin(ig)>5) THEN
+      DO l = 1, klev
+        entr_star(ig, l) = 0.
+      END DO
+    END IF
+  END DO
+  ! calcul de l entrainement total
+  DO ig = 1, ngrid
+    entr_star_tot(ig) = 0.
+  END DO
+  DO ig = 1, ngrid
+    DO k = 1, klev
+      entr_star_tot(ig) = entr_star_tot(ig) + entr_star(ig, k)
+    END DO
+  END DO
+  ! Calcul entrainement normalise
+  DO ig = 1, ngrid
+    IF (entr_star_tot(ig)>1.E-10) THEN
+      ! do l=1,lentr(ig)
+      DO l = 1, klev
+        ! def possibles pour entr_star: zdthetadz, dthetadz, zdtheta
+        entr_star(ig, l) = entr_star(ig, l)/entr_star_tot(ig)
+      END DO
+    END IF
+  END DO
+
+  ! print*,'fin calcul entr_star'
+  DO k = 1, klev
+    DO ig = 1, ngrid
+      ztva(ig, k) = ztv(ig, k)
+    END DO
+  END DO
+  ! RC
+  ! print*,'7 OK convect8'
+  DO k = 1, klev + 1
+    DO ig = 1, ngrid
+      zw2(ig, k) = 0.
+      fmc(ig, k) = 0.
+      ! CR
+      f_star(ig, k) = 0.
+      ! RC
+      larg_cons(ig, k) = 0.
+      larg_detr(ig, k) = 0.
+      wa_moy(ig, k) = 0.
+    END DO
+  END DO
+
+  ! print*,'8 OK convect8'
+  DO ig = 1, ngrid
+    linter(ig) = 1.
+    lmaxa(ig) = 1
+    lmix(ig) = 1
+    wmaxa(ig) = 0.
+  END DO
+
+  ! CR:
+  DO l = 1, nlay - 2
+    DO ig = 1, ngrid
+      IF (ztv(ig,l)>ztv(ig,l+1) .AND. entr_star(ig,l)>1.E-10 .AND. &
+          zw2(ig,l)<1E-10) THEN
+        f_star(ig, l+1) = entr_star(ig, l)
+        ! test:calcul de dteta
+        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
+          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
+        larg_detr(ig, l) = 0.
+      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+entr_star(ig, &
+          l)>1.E-10)) THEN
+        f_star(ig, l+1) = f_star(ig, l) + entr_star(ig, l)
+        ztva(ig, l) = (f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)*ztv(ig,l))/ &
+          f_star(ig, l+1)
+        zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/f_star(ig,l+1))**2 + &
+          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
+      END IF
+      ! determination de zmax continu par interpolation lineaire
+      IF (zw2(ig,l+1)<0.) THEN
+        ! test
+        IF (abs(zw2(ig,l+1)-zw2(ig,l))<1E-10) THEN
+          ! print*,'pb linter'
+        END IF
+        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
+          ig,l))
+        zw2(ig, l+1) = 0.
+        lmaxa(ig) = l
+      ELSE
+        IF (zw2(ig,l+1)<0.) THEN
+          ! print*,'pb1 zw2<0'
+        END IF
+        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
+      END IF
+      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
+        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
+        lmix(ig) = l + 1
+        wmaxa(ig) = wa_moy(ig, l+1)
+      END IF
+    END DO
+  END DO
+  ! print*,'fin calcul zw2'
+
+  ! Calcul de la couche correspondant a la hauteur du thermique
+  DO ig = 1, ngrid
+    lmax(ig) = lentr(ig)
+    ! lmax(ig)=lalim(ig)
+  END DO
+  DO ig = 1, ngrid
+    DO l = nlay, lentr(ig) + 1, -1
+      ! do l=nlay,lalim(ig)+1,-1
+      IF (zw2(ig,l)<=1.E-10) THEN
+        lmax(ig) = l - 1
+      END IF
+    END DO
+  END DO
+  ! pas de thermique si couche 1 stable
+  DO ig = 1, ngrid
+    IF (lmin(ig)>5) THEN
+      lmax(ig) = 1
+      lmin(ig) = 1
+      lentr(ig) = 1
+      lalim(ig) = 1
+    END IF
+  END DO
+
+  ! Determination de zw2 max
+  DO ig = 1, ngrid
+    wmax(ig) = 0.
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmax(ig)) THEN
+        IF (zw2(ig,l)<0.) THEN
+          ! print*,'pb2 zw2<0'
+        END IF
+        zw2(ig, l) = sqrt(zw2(ig,l))
+        wmax(ig) = max(wmax(ig), zw2(ig,l))
+      ELSE
+        zw2(ig, l) = 0.
+      END IF
+    END DO
+  END DO
+
+  ! Longueur caracteristique correspondant a la hauteur des thermiques.
+  DO ig = 1, ngrid
+    zmax(ig) = 0.
+    zlevinter(ig) = zlev(ig, 1)
+  END DO
+  DO ig = 1, ngrid
+    ! calcul de zlevinter
+    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
+      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
+    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,lmin(ig)))
+  END DO
+  DO ig = 1, ngrid
+    ! write(8,*)zmax(ig),lmax(ig),lentr(ig),lmin(ig)
+  END DO
+  ! on stope après les calculs de zmax et wmax
+  RETURN
+
+  ! print*,'avant fermeture'
+  ! Fermeture,determination de f
+  ! Attention! entrainement normalisé ou pas?
+  DO ig = 1, ngrid
+    entr_star2(ig) = 0.
+  END DO
+  DO ig = 1, ngrid
+    IF (entr_star_tot(ig)<1.E-10) THEN
+      f(ig) = 0.
+    ELSE
+      DO k = lmin(ig), lentr(ig)
+        ! do k=lmin(ig),lalim(ig)
+        entr_star2(ig) = entr_star2(ig) + entr_star(ig, k)**2/(rho(ig,k)*( &
+          zlev(ig,k+1)-zlev(ig,k)))
+      END DO
+      ! Nouvelle fermeture
+      f(ig) = wmax(ig)/(max(500.,zmax(ig))*r_aspect*entr_star2(ig))
+      ! s            *entr_star_tot(ig)
+      ! test
+      ! if (first) then
+      f(ig) = f(ig) + (f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)*wmax(ig))
+      ! endif
+    END IF
+    f0(ig) = f(ig)
+    ! first=.true.
+  END DO
+  ! print*,'apres fermeture'
+  ! on stoppe après la fermeture
+  RETURN
+  ! Calcul de l'entrainement
+  DO k = 1, klev
+    DO ig = 1, ngrid
+      entr(ig, k) = f(ig)*entr_star(ig, k)
+    END DO
+  END DO
+  ! on stoppe après le calcul de entr
+  ! RETURN
+  ! CR:test pour entrainer moins que la masse
+  ! do ig=1,ngrid
+  ! do l=1,lentr(ig)
+  ! if ((entr(ig,l)*ptimestep).gt.(0.9*masse(ig,l))) then
+  ! entr(ig,l+1)=entr(ig,l+1)+entr(ig,l)
+  ! s                       -0.9*masse(ig,l)/ptimestep
+  ! entr(ig,l)=0.9*masse(ig,l)/ptimestep
+  ! endif
+  ! enddo
+  ! enddo
+  ! CR: fin test
+  ! Calcul des flux
+  DO ig = 1, ngrid
+    DO l = 1, lmax(ig) - 1
+      fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
+    END DO
+  END DO
+
+  ! RC
+
+
+  ! print*,'9 OK convect8'
+  ! print*,'WA1 ',wa_moy
+
+  ! determination de l'indice du debut de la mixed layer ou w decroit
+
+  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
+  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
+  ! d'une couche est égale à la hauteur de la couche alimentante.
+  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
+  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmaxa(ig)) THEN
+        zw = max(wa_moy(ig,l), 1.E-10)
+        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
+      END IF
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmaxa(ig)) THEN
+        ! if (idetr.eq.0) then
+        ! cette option est finalement en dur.
+        IF ((l_mix*zlev(ig,l))<0.) THEN
+          ! print*,'pb l_mix*zlev<0'
+        END IF
+        ! CR: test: nouvelle def de lambda
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        IF (zw2(ig,l)>1.E-10) THEN
+          larg_detr(ig, l) = sqrt((l_mix/zw2(ig,l))*zlev(ig,l))
+        ELSE
+          larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
+        END IF
+        ! RC
+        ! else if (idetr.eq.1) then
+        ! larg_detr(ig,l)=larg_cons(ig,l)
+        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
+        ! else if (idetr.eq.2) then
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        ! s            *sqrt(wa_moy(ig,l))
+        ! else if (idetr.eq.4) then
+        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+        ! s            *wa_moy(ig,l)
+        ! endif
+      END IF
+    END DO
+  END DO
+
+  ! print*,'10 OK convect8'
+  ! print*,'WA2 ',wa_moy
+  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
+  ! compte de l'epluchage du thermique.
+
+  ! CR def de  zmix continu (profil parabolique des vitesses)
+  DO ig = 1, ngrid
+    IF (lmix(ig)>1.) THEN
+      ! test
+      IF (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
+          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
+          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))- &
+          (zlev(ig,lmix(ig)))))>1E-10) THEN
+
+        zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)) &
+          )**2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
+          lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
+          (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
+          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
+          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
+      ELSE
+        zmix(ig) = zlev(ig, lmix(ig))
+        ! print*,'pb zmix'
+      END IF
+    ELSE
+      zmix(ig) = 0.
+    END IF
+    ! test
+    IF ((zmax(ig)-zmix(ig))<0.) THEN
+      zmix(ig) = 0.99*zmax(ig)
+      ! print*,'pb zmix>zmax'
+    END IF
+  END DO
+
+  ! calcul du nouveau lmix correspondant
+  DO ig = 1, ngrid
+    DO l = 1, klev
+      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
+        lmix(ig) = l
+      END IF
+    END DO
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (larg_cons(ig,l)>1.) THEN
+        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
+        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
+        ! test
+        fraca(ig, l) = max(fraca(ig,l), 0.)
+        fraca(ig, l) = min(fraca(ig,l), 0.5)
+        fracd(ig, l) = 1. - fraca(ig, l)
+        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
+      ELSE
+        ! wa_moy(ig,l)=0.
+        fraca(ig, l) = 0.
+        fracc(ig, l) = 0.
+        fracd(ig, l) = 1.
+      END IF
+    END DO
+  END DO
+  ! CR: calcul de fracazmix
+  DO ig = 1, ngrid
+    fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
+      (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
+      fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca(ig &
+      ,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      IF (larg_cons(ig,l)>1.) THEN
+        IF (l>lmix(ig)) THEN
+          ! test
+          IF (zmax(ig)-zmix(ig)<1.E-10) THEN
+            ! print*,'pb xxx'
+            xxx(ig, l) = (lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
+          ELSE
+            xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
+          END IF
+          IF (idetr==0) THEN
+            fraca(ig, l) = fracazmix(ig)
+          ELSE IF (idetr==1) THEN
+            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
+          ELSE IF (idetr==2) THEN
+            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
+          ELSE
+            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
+          END IF
+          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
+          fraca(ig, l) = max(fraca(ig,l), 0.)
+          fraca(ig, l) = min(fraca(ig,l), 0.5)
+          fracd(ig, l) = 1. - fraca(ig, l)
+          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
+        END IF
+      END IF
+    END DO
+  END DO
+
+  ! print*,'fin calcul fraca'
+  ! print*,'11 OK convect8'
+  ! print*,'Ea3 ',wa_moy
+  ! ------------------------------------------------------------------
+  ! Calcul de fracd, wd
+  ! somme wa - wd = 0
+  ! ------------------------------------------------------------------
+
+
+  DO ig = 1, ngrid
+    fm(ig, 1) = 0.
+    fm(ig, nlay+1) = 0.
+  END DO
+
+  DO l = 2, nlay
+    DO ig = 1, ngrid
+      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
+      ! CR:test
+      IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
+        fm(ig, l) = fm(ig, l-1)
+        ! write(1,*)'ajustement fm, l',l
+      END IF
+      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+      ! RC
+    END DO
+    DO ig = 1, ngrid
+      IF (fracd(ig,l)<0.1) THEN
+        abort_message = 'fracd trop petit'
+        CALL abort_physic(modname, abort_message, 1)
+
+      ELSE
+        ! vitesse descendante "diagnostique"
+        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
+    END DO
+  END DO
+
+  ! print*,'12 OK convect8'
+  ! print*,'WA4 ',wa_moy
+  ! c------------------------------------------------------------------
+  ! calcul du transport vertical
+  ! ------------------------------------------------------------------
+
+  GO TO 4444
+  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
+  DO l = 2, nlay - 1
+    DO ig = 1, ngrid
+      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
+          ig,l+1)) THEN
+        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
+        ! s         ,fm(ig,l+1)*ptimestep
+        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
+        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
+        ! s         ,entr(ig,l)*ptimestep
+        ! s         ,'   M=',masse(ig,l)
+      END IF
+    END DO
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
+        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
+        ! s         ,'   FM=',fm(ig,l)
+      END IF
+      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
+        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
+        ! s         ,'   M=',masse(ig,l)
+        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
+        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
+        ! print*,'zlev(ig,l+1),zlev(ig,l)'
+        ! s                ,zlev(ig,l+1),zlev(ig,l)
+        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
+        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
+      END IF
+      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
+        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
+        ! s         ,'   E=',entr(ig,l)
+      END IF
+    END DO
+  END DO
+
+4444 CONTINUE
+
+  ! CR:redefinition du entr
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      detr(ig, l) = fm(ig, l) + entr(ig, l) - fm(ig, l+1)
+      IF (detr(ig,l)<0.) THEN
+        ! entr(ig,l)=entr(ig,l)-detr(ig,l)
+        fm(ig, l+1) = fm(ig, l) + entr(ig, l)
+        detr(ig, l) = 0.
+        ! print*,'WARNING !!! detrainement negatif ',ig,l
+      END IF
+    END DO
+  END DO
+  ! RC
+  IF (w2di==1) THEN
+    fm0 = fm0 + ptimestep*(fm-fm0)/tho
+    entr0 = entr0 + ptimestep*(entr-entr0)/tho
+  ELSE
+    fm0 = fm
+    entr0 = entr
+  END IF
+
+  IF (1==1) THEN
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zh, zdhadj, &
+      zha)
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zo, pdoadj, &
+      zoa)
+  ELSE
+    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
+      zdhadj, zha)
+    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
+      pdoadj, zoa)
+  END IF
+
+  IF (1==0) THEN
+    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
+      zu, zv, pduadj, pdvadj, zua, zva)
+  ELSE
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
+      zua)
+    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
+      zva)
+  END IF
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
+      zf2 = zf/(1.-zf)
+      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
+      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
+    END DO
+  END DO
+
+
+
+  ! print*,'13 OK convect8'
+  ! print*,'WA5 ',wa_moy
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      pdtadj(ig, l) = zdhadj(ig, l)*zpspsk(ig, l)
+    END DO
+  END DO
+
+
+  ! do l=1,nlay
+  ! do ig=1,ngrid
+  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
+  ! print*,'WARN!!! ig=',ig,'  l=',l
+  ! s         ,'   pdtadj=',pdtadj(ig,l)
+  ! endif
+  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
+  ! print*,'WARN!!! ig=',ig,'  l=',l
+  ! s         ,'   pdoadj=',pdoadj(ig,l)
+  ! endif
+  ! enddo
+  ! enddo
+
+  ! print*,'14 OK convect8'
+  ! ------------------------------------------------------------------
+  ! Calculs pour les sorties
+  ! ------------------------------------------------------------------
+
+  IF (sorties) THEN
+    DO l = 1, nlay
+      DO ig = 1, ngrid
+        zla(ig, l) = (1.-fracd(ig,l))*zmax(ig)
+        zld(ig, l) = fracd(ig, l)*zmax(ig)
+        IF (1.-fracd(ig,l)>1.E-10) zwa(ig, l) = wd(ig, l)*fracd(ig, l)/ &
+          (1.-fracd(ig,l))
+      END DO
+    END DO
+
+    ! deja fait
+    ! do l=1,nlay
+    ! do ig=1,ngrid
+    ! detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
+    ! if (detr(ig,l).lt.0.) then
+    ! entr(ig,l)=entr(ig,l)-detr(ig,l)
+    ! detr(ig,l)=0.
+    ! print*,'WARNING !!! detrainement negatif ',ig,l
+    ! endif
+    ! enddo
+    ! enddo
+
+    ! print*,'15 OK convect8'
+
+    isplit = isplit + 1
+
+
+    ! #define und
+    GO TO 123
+#ifdef und
+    CALL writeg1d(1, nlay, wd, 'wd      ', 'wd      ')
+    CALL writeg1d(1, nlay, zwa, 'wa      ', 'wa      ')
+    CALL writeg1d(1, nlay, fracd, 'fracd      ', 'fracd      ')
+    CALL writeg1d(1, nlay, fraca, 'fraca      ', 'fraca      ')
+    CALL writeg1d(1, nlay, wa_moy, 'wam         ', 'wam         ')
+    CALL writeg1d(1, nlay, zla, 'la      ', 'la      ')
+    CALL writeg1d(1, nlay, zld, 'ld      ', 'ld      ')
+    CALL writeg1d(1, nlay, pt, 'pt      ', 'pt      ')
+    CALL writeg1d(1, nlay, zh, 'zh      ', 'zh      ')
+    CALL writeg1d(1, nlay, zha, 'zha      ', 'zha      ')
+    CALL writeg1d(1, nlay, zu, 'zu      ', 'zu      ')
+    CALL writeg1d(1, nlay, zv, 'zv      ', 'zv      ')
+    CALL writeg1d(1, nlay, zo, 'zo      ', 'zo      ')
+    CALL writeg1d(1, nlay, wh, 'wh      ', 'wh      ')
+    CALL writeg1d(1, nlay, wu, 'wu      ', 'wu      ')
+    CALL writeg1d(1, nlay, wv, 'wv      ', 'wv      ')
+    CALL writeg1d(1, nlay, wo, 'w15uo     ', 'wXo     ')
+    CALL writeg1d(1, nlay, zdhadj, 'zdhadj      ', 'zdhadj      ')
+    CALL writeg1d(1, nlay, pduadj, 'pduadj      ', 'pduadj      ')
+    CALL writeg1d(1, nlay, pdvadj, 'pdvadj      ', 'pdvadj      ')
+    CALL writeg1d(1, nlay, pdoadj, 'pdoadj      ', 'pdoadj      ')
+    CALL writeg1d(1, nlay, entr, 'entr        ', 'entr        ')
+    CALL writeg1d(1, nlay, detr, 'detr        ', 'detr        ')
+    CALL writeg1d(1, nlay, fm, 'fm          ', 'fm          ')
+
+    CALL writeg1d(1, nlay, pdtadj, 'pdtadj    ', 'pdtadj    ')
+    CALL writeg1d(1, nlay, pplay, 'pplay     ', 'pplay     ')
+    CALL writeg1d(1, nlay, pplev, 'pplev     ', 'pplev     ')
+
+    ! recalcul des flux en diagnostique...
+    ! print*,'PAS DE TEMPS ',ptimestep
+    CALL dt2f(pplev, pplay, pt, pdtadj, wh)
+    CALL writeg1d(1, nlay, wh, 'wh2     ', 'wh2     ')
+#endif
+123 CONTINUE
+
+  END IF
+
+  ! if(wa_moy(1,4).gt.1.e-10) stop
+
+  ! print*,'19 OK convect8'
+  RETURN
+END SUBROUTINE calcul_sec
+
+SUBROUTINE fermeture_seche(ngrid, nlay, pplay, pplev, pphi, zlev, rhobarz, &
+    f0, zpspsk, alim_star, zh, zo, lentr, lmin, nu_min, nu_max, r_aspect, &
+    zmax, wmax)
+
+  USE dimphy
+  IMPLICIT NONE
+
+  include "YOMCST.h"
+
+  INTEGER ngrid, nlay
+  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
+  REAL pphi(ngrid, nlay)
+  REAL zlev(klon, klev+1)
+  REAL alim_star(klon, klev)
+  REAL f0(klon)
+  INTEGER lentr(klon)
+  INTEGER lmin(klon)
+  REAL zmax(klon)
+  REAL wmax(klon)
+  REAL nu_min
+  REAL nu_max
+  REAL r_aspect
+  REAL rhobarz(klon, klev+1)
+  REAL zh(klon, klev)
+  REAL zo(klon, klev)
+  REAL zpspsk(klon, klev)
+
+  INTEGER ig, l
+
+  REAL f_star(klon, klev+1)
+  REAL detr_star(klon, klev)
+  REAL entr_star(klon, klev)
+  REAL zw2(klon, klev+1)
+  REAL linter(klon)
+  INTEGER lmix(klon)
+  INTEGER lmax(klon)
+  REAL zlevinter(klon)
+  REAL wa_moy(klon, klev+1)
+  REAL wmaxa(klon)
+  REAL ztv(klon, klev)
+  REAL ztva(klon, klev)
+  REAL nu(klon, klev)
+  ! real zmax0_sec(klon)
+  ! save zmax0_sec
+  REAL, SAVE, ALLOCATABLE :: zmax0_sec(:)
+  !$OMP THREADPRIVATE(zmax0_sec)
+  LOGICAL, SAVE :: first = .TRUE.
+  !$OMP THREADPRIVATE(first)
+
+  IF (first) THEN
+    ALLOCATE (zmax0_sec(klon))
+    first = .FALSE.
+  END IF
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      ztv(ig, l) = zh(ig, l)/zpspsk(ig, l)
+      ztv(ig, l) = ztv(ig, l)*(1.+retv*zo(ig,l))
+    END DO
+  END DO
+  DO l = 1, nlay - 2
+    DO ig = 1, ngrid
+      IF (ztv(ig,l)>ztv(ig,l+1) .AND. alim_star(ig,l)>1.E-10 .AND. &
+          zw2(ig,l)<1E-10) THEN
+        f_star(ig, l+1) = alim_star(ig, l)
+        ! test:calcul de dteta
+        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
+          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
+      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+alim_star(ig, &
+          l))>1.E-10) THEN
+        ! estimation du detrainement a partir de la geometrie du pas
+        ! precedent
+        ! tests sur la definition du detr
+        nu(ig, l) = (nu_min+nu_max)/2.*(1.-(nu_max-nu_min)/(nu_max+nu_min)* &
+          tanh((((ztva(ig,l-1)-ztv(ig,l))/ztv(ig,l))/0.0005)))
+
+        detr_star(ig, l) = rhobarz(ig, l)*sqrt(zw2(ig,l))/ &
+          (r_aspect*zmax0_sec(ig))* & ! s
+                                      ! /(r_aspect*zmax0(ig))*
+          (sqrt(nu(ig,l)*zlev(ig,l+1)/sqrt(zw2(ig,l)))-sqrt(nu(ig,l)*zlev(ig, &
+          l)/sqrt(zw2(ig,l))))
+        detr_star(ig, l) = detr_star(ig, l)/f0(ig)
+        IF ((detr_star(ig,l))>f_star(ig,l)) THEN
+          detr_star(ig, l) = f_star(ig, l)
+        END IF
+        entr_star(ig, l) = 0.9*detr_star(ig, l)
+        IF ((l<lentr(ig))) THEN
+          entr_star(ig, l) = 0.
+          ! detr_star(ig,l)=0.
+        END IF
+        ! print*,'ok detr_star'
+        ! prise en compte du detrainement dans le calcul du flux
+        f_star(ig, l+1) = f_star(ig, l) + alim_star(ig, l) + &
+          entr_star(ig, l) - detr_star(ig, l)
+        ! test sur le signe de f_star
+        IF ((f_star(ig,l+1)+detr_star(ig,l))>1.E-10) THEN
+          ! AM on melange Tl et qt du thermique
+          ztva(ig, l) = (f_star(ig,l)*ztva(ig,l-1)+(entr_star(ig, &
+            l)+alim_star(ig,l))*ztv(ig,l))/(f_star(ig,l+1)+detr_star(ig,l))
+          zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/(f_star(ig, &
+            l+1)+detr_star(ig,l)))**2 + 2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, &
+            l)*(zlev(ig,l+1)-zlev(ig,l))
+        END IF
+      END IF
+
+      IF (zw2(ig,l+1)<0.) THEN
+        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
+          ig,l))
+        zw2(ig, l+1) = 0.
+        ! print*,'linter=',linter(ig)
+      ELSE
+        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
+      END IF
+      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
+        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
+        lmix(ig) = l + 1
+        wmaxa(ig) = wa_moy(ig, l+1)
+      END IF
+    END DO
+  END DO
+  ! print*,'fin calcul zw2'
+
+  ! Calcul de la couche correspondant a la hauteur du thermique
+  DO ig = 1, ngrid
+    lmax(ig) = lentr(ig)
+  END DO
+  DO ig = 1, ngrid
+    DO l = nlay, lentr(ig) + 1, -1
+      IF (zw2(ig,l)<=1.E-10) THEN
+        lmax(ig) = l - 1
+      END IF
+    END DO
+  END DO
+  ! pas de thermique si couche 1 stable
+  DO ig = 1, ngrid
+    IF (lmin(ig)>1) THEN
+      lmax(ig) = 1
+      lmin(ig) = 1
+      lentr(ig) = 1
+    END IF
+  END DO
+
+  ! Determination de zw2 max
+  DO ig = 1, ngrid
+    wmax(ig) = 0.
+  END DO
+
+  DO l = 1, nlay
+    DO ig = 1, ngrid
+      IF (l<=lmax(ig)) THEN
+        IF (zw2(ig,l)<0.) THEN
+          ! print*,'pb2 zw2<0'
+        END IF
+        zw2(ig, l) = sqrt(zw2(ig,l))
+        wmax(ig) = max(wmax(ig), zw2(ig,l))
+      ELSE
+        zw2(ig, l) = 0.
+      END IF
+    END DO
+  END DO
+
+  ! Longueur caracteristique correspondant a la hauteur des thermiques.
+  DO ig = 1, ngrid
+    zmax(ig) = 0.
+    zlevinter(ig) = zlev(ig, 1)
+  END DO
+  DO ig = 1, ngrid
+    ! calcul de zlevinter
+    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
+      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
+    ! pour le cas ou on prend tjs lmin=1
+    ! zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
+    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,1))
+    zmax0_sec(ig) = zmax(ig)
+  END DO
+
+  RETURN
+END SUBROUTINE fermeture_seche
+
+END MODULE lmdz_thermcell_old
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_plume.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_plume.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_plume.F90	(revision 4727)
@@ -0,0 +1,454 @@
+MODULE lmdz_thermcell_plume
+!
+! $Id: thermcell_plume.F90 3074 2017-11-15 13:31:44Z fhourdin $
+!
+CONTAINS
+
+      SUBROUTINE thermcell_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
+     &           zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
+     &           lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
+     &           ztla,zqla,zqta,zha,zw2,w_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
+    &           ,lev_out,lunout1,igout)
+!     &           ,lev_out,lunout1,igout,zbuoy,zbuoyjam)
+!--------------------------------------------------------------------------
+! Auhtors : Catherine Rio, Frédéric Hourdin, Arnaud Jam
+!
+!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
+!   This versions starts from a cleaning of thermcell_plume_6A (2019/01/20)
+!   thermcell_plume_6A is activate for flag_thermas_ed < 10
+!   thermcell_plume_5B for flag_thermas_ed < 20
+!   thermcell_plume for flag_thermals_ed>= 20
+!   Various options are controled by the flag_thermals_ed parameter
+!   = 20 : equivalent to thermcell_plume_6A with flag_thermals_ed=8
+!   = 21 : the Jam strato-cumulus modif is not activated in detrainment
+!   = 29 : an other way to compute the modified buoyancy (to be tested)
+!--------------------------------------------------------------------------
+
+       USE lmdz_thermcell_ini, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
+       USE lmdz_thermcell_ini, ONLY: fact_epsilon, betalpha, afact, fact_shell
+       USE lmdz_thermcell_ini, ONLY: detr_min, entr_min, detr_q_coef, detr_q_power
+       USE lmdz_thermcell_ini, ONLY: mix0, thermals_flag_alim
+       USE lmdz_thermcell_alim, ONLY : thermcell_alim
+       USE lmdz_thermcell_qsat, ONLY : thermcell_qsat
+
+
+       IMPLICIT NONE
+
+      integer,intent(in) :: itap,lev_out,lunout1,igout,ngrid,nlay
+      real,intent(in) :: ptimestep
+      real,intent(in),dimension(ngrid,nlay) :: ztv
+      real,intent(in),dimension(ngrid,nlay) :: zthl
+      real,intent(in),dimension(ngrid,nlay) :: po
+      real,intent(in),dimension(ngrid,nlay) :: zl
+      real,intent(in),dimension(ngrid,nlay) :: rhobarz
+      real,intent(in),dimension(ngrid,nlay+1) :: zlev
+      real,intent(in),dimension(ngrid,nlay+1) :: pplev
+      real,intent(in),dimension(ngrid,nlay) :: pphi
+      real,intent(in),dimension(ngrid,nlay) :: zpspsk
+      real,intent(in),dimension(ngrid) :: f0
+
+      integer,intent(out) :: lalim(ngrid)
+      real,intent(out),dimension(ngrid,nlay) :: alim_star
+      real,intent(out),dimension(ngrid) :: alim_star_tot
+      real,intent(out),dimension(ngrid,nlay) :: detr_star
+      real,intent(out),dimension(ngrid,nlay) :: entr_star
+      real,intent(out),dimension(ngrid,nlay+1) :: f_star
+      real,intent(out),dimension(ngrid,nlay) :: csc
+      real,intent(out),dimension(ngrid,nlay) :: ztva
+      real,intent(out),dimension(ngrid,nlay) :: ztla
+      real,intent(out),dimension(ngrid,nlay) :: zqla
+      real,intent(out),dimension(ngrid,nlay) :: zqta
+      real,intent(out),dimension(ngrid,nlay) :: zha
+      real,intent(out),dimension(ngrid,nlay+1) :: zw2
+      real,intent(out),dimension(ngrid,nlay+1) :: w_est
+      real,intent(out),dimension(ngrid,nlay) :: ztva_est
+      real,intent(out),dimension(ngrid,nlay) :: zqsatth
+      integer,intent(out),dimension(ngrid) :: lmix(ngrid)
+      integer,intent(out),dimension(ngrid) :: lmix_bis(ngrid)
+      real,intent(out),dimension(ngrid) :: linter(ngrid)
+
+
+      REAL,dimension(ngrid,nlay+1) :: wa_moy
+      REAL,dimension(ngrid,nlay) :: entr,detr
+      REAL,dimension(ngrid,nlay) :: ztv_est
+      REAL,dimension(ngrid,nlay) :: zqla_est
+      REAL,dimension(ngrid,nlay) :: zta_est
+      REAL,dimension(ngrid) :: ztemp,zqsat
+      REAL zdw2,zdw2bis
+      REAL zw2modif
+      REAL zw2fact,zw2factbis
+      REAL,dimension(ngrid,nlay) :: zeps
+
+      REAL,dimension(ngrid) :: wmaxa
+
+      INTEGER ig,l,k,lt,it,lm,nbpb
+
+      real,dimension(ngrid,nlay) :: zbuoy,gamma,zdqt
+      real zdz,zalpha,zw2m
+      real,dimension(ngrid,nlay) :: zbuoyjam,zdqtjam
+      real zdz2,zdz3,lmel,entrbis,zdzbis
+      real,dimension(ngrid) :: d_temp
+      real ztv1,ztv2,factinv,zinv,zlmel
+      real zlmelup,zlmeldwn,zlt,zltdwn,zltup
+      real atv1,atv2,btv1,btv2
+      real ztv_est1,ztv_est2
+      real zcor,zdelta,zcvm5,qlbef
+      real zbetalpha, coefzlmel
+      real eps
+      logical Zsat
+      LOGICAL,dimension(ngrid) :: active,activetmp
+      REAL fact_gamma,fact_gamma2,fact_epsilon2
+
+
+      REAL,dimension(ngrid,nlay) :: c2
+
+      if (ngrid==1) print*,'THERMCELL PLUME MODIFIE 2014/07/11'
+      Zsat=.false.
+! Initialisation
+
+
+      zbetalpha=betalpha/(1.+betalpha)
+
+
+! Initialisations des variables r?elles
+if (1==1) then
+      ztva(:,:)=ztv(:,:)
+      ztva_est(:,:)=ztva(:,:)
+      ztv_est(:,:)=ztv(:,:)
+      ztla(:,:)=zthl(:,:)
+      zqta(:,:)=po(:,:)
+      zqla(:,:)=0.
+      zha(:,:) = ztva(:,:)
+else
+      ztva(:,:)=0.
+      ztv_est(:,:)=0.
+      ztva_est(:,:)=0.
+      ztla(:,:)=0.
+      zqta(:,:)=0.
+      zha(:,:) =0.
+endif
+
+      zqla_est(:,:)=0.
+      zqsatth(:,:)=0.
+      zqla(:,:)=0.
+      detr_star(:,:)=0.
+      entr_star(:,:)=0.
+      alim_star(:,:)=0.
+      alim_star_tot(:)=0.
+      csc(:,:)=0.
+      detr(:,:)=0.
+      entr(:,:)=0.
+      zw2(:,:)=0.
+      zbuoy(:,:)=0.
+      zbuoyjam(:,:)=0.
+      gamma(:,:)=0.
+      zeps(:,:)=0.
+      w_est(:,:)=0.
+      f_star(:,:)=0.
+      wa_moy(:,:)=0.
+      linter(:)=1.
+!     linter(:)=1.
+! Initialisation des variables entieres
+      lmix(:)=1
+      lmix_bis(:)=2
+      wmaxa(:)=0.
+
+
+!-------------------------------------------------------------------------
+! On ne considere comme actif que les colonnes dont les deux premieres
+! couches sont instables.
+!-------------------------------------------------------------------------
+
+      active(:)=ztv(:,1)>ztv(:,2)
+      d_temp(:)=0. ! Pour activer un contraste de temperature a la base
+                   ! du panache
+!  Cet appel pourrait être fait avant thermcell_plume dans thermcell_main
+      CALL thermcell_alim(thermals_flag_alim,ngrid,nlay,ztv,d_temp,zlev,alim_star,lalim)
+
+!------------------------------------------------------------------------------
+! Calcul dans la premiere couche
+! On decide dans cette version que le thermique n'est actif que si la premiere
+! couche est instable.
+! Pourrait etre change si on veut que le thermiques puisse se d??clencher
+! dans une couche l>1
+!------------------------------------------------------------------------------
+do ig=1,ngrid
+! Le panache va prendre au debut les caracteristiques de l'air contenu
+! dans cette couche.
+    if (active(ig)) then
+    ztla(ig,1)=zthl(ig,1) 
+    zqta(ig,1)=po(ig,1)
+    zqla(ig,1)=zl(ig,1)
+!cr: attention, prise en compte de f*(1)=1
+    f_star(ig,2)=alim_star(ig,1)
+    zw2(ig,2)=2.*RG*(ztv(ig,1)-ztv(ig,2))/ztv(ig,2)  &
+&                     *(zlev(ig,2)-zlev(ig,1))  &
+&                     *0.4*pphi(ig,1)/(pphi(ig,2)-pphi(ig,1))
+    w_est(ig,2)=zw2(ig,2)
+    endif
+enddo
+!
+
+!==============================================================================
+!boucle de calcul de la vitesse verticale dans le thermique
+!==============================================================================
+do l=2,nlay-1
+!==============================================================================
+
+
+! On decide si le thermique est encore actif ou non
+! AFaire : Il faut sans doute ajouter entr_star a alim_star dans ce test
+    do ig=1,ngrid
+       active(ig)=active(ig) &
+&                 .and. zw2(ig,l)>1.e-10 &
+&                 .and. f_star(ig,l)+alim_star(ig,l)>1.e-10
+    enddo
+
+
+
+!---------------------------------------------------------------------------
+! calcul des proprietes thermodynamiques et de la vitesse de la couche l
+! sans tenir compte du detrainement et de l'entrainement dans cette
+! couche
+! C'est a dire qu'on suppose 
+! ztla(l)=ztla(l-1) et zqta(l)=zqta(l-1)
+! Ici encore, on doit pouvoir ajouter entr_star (qui peut etre calculer
+! avant) a l'alimentation pour avoir un calcul plus propre
+!---------------------------------------------------------------------------
+
+   ztemp(:)=zpspsk(:,l)*ztla(:,l-1)
+   call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
+    do ig=1,ngrid 
+!       print*,'active',active(ig),ig,l
+        if(active(ig)) then 
+        zqla_est(ig,l)=max(0.,zqta(ig,l-1)-zqsat(ig))
+        ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l)
+        zta_est(ig,l)=ztva_est(ig,l)
+        ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l)
+        ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)  &
+     &      -zqla_est(ig,l))-zqla_est(ig,l))
+ 
+
+!Modif AJAM
+
+        zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) 
+        zdz=zlev(ig,l+1)-zlev(ig,l)         
+        lmel=fact_thermals_ed_dz*zlev(ig,l)
+!        lmel=0.09*zlev(ig,l)
+        zlmel=zlev(ig,l)+lmel
+        zlmelup=zlmel+(zdz/2)
+        zlmeldwn=zlmel-(zdz/2)
+
+        lt=l+1
+        zlt=zlev(ig,lt)
+        zdz3=zlev(ig,lt+1)-zlt
+        zltdwn=zlt-zdz3/2
+        zltup=zlt+zdz3/2
+         
+!=========================================================================
+! 3. Calcul de la flotabilite modifie par melange avec l'air au dessus
+!=========================================================================
+
+!--------------------------------------------------
+        lt=l+1
+        zlt=zlev(ig,lt)
+        zdz2=zlev(ig,lt)-zlev(ig,l)
+
+        do while (lmel.gt.zdz2)
+           lt=lt+1
+           zlt=zlev(ig,lt)
+           zdz2=zlt-zlev(ig,l)
+        enddo
+        zdz3=zlev(ig,lt+1)-zlt
+        zltdwn=zlev(ig,lt)-zdz3/2
+        zlmelup=zlmel+(zdz/2)
+        coefzlmel=Min(1.,(zlmelup-zltdwn)/zdz)
+        zbuoyjam(ig,l)=1.*RG*(coefzlmel*(ztva_est(ig,l)- & 
+    &   ztv(ig,lt))/ztv(ig,lt)+(1.-coefzlmel)*(ztva_est(ig,l)- &
+    &   ztv(ig,lt-1))/ztv(ig,lt-1))+0.*zbuoy(ig,l)
+
+!------------------------------------------------
+!AJAM:nouveau calcul de w?  
+!------------------------------------------------
+        zdz=zlev(ig,l+1)-zlev(ig,l)
+        zdzbis=zlev(ig,l)-zlev(ig,l-1)
+        zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
+        zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
+        zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
+        zdw2=afact*zbuoy(ig,l)/fact_epsilon
+        zdw2bis=afact*zbuoy(ig,l-1)/fact_epsilon
+        lm=Max(1,l-2)
+        w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2)+zdw2)
+       endif
+    enddo
+
+
+!-------------------------------------------------
+!calcul des taux d'entrainement et de detrainement
+!-------------------------------------------------
+
+     do ig=1,ngrid
+        if (active(ig)) then
+
+!          zw2m=max(0.5*(w_est(ig,l)+w_est(ig,l+1)),0.1)
+          zw2m=w_est(ig,l+1)
+          zdz=zlev(ig,l+1)-zlev(ig,l)
+          zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
+          zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l+1))/rhobarz(ig,l)
+          zdqt(ig,l)=max(zqta(ig,l-1)-po(ig,l),0.)/po(ig,l)
+
+!=========================================================================
+! 4. Calcul de l'entrainement et du detrainement
+!=========================================================================
+
+          detr_star(ig,l)=f_star(ig,l)*zdz             &
+    &     *( mix0 * 0.1 / (zalpha+0.001)               &
+    &     + MAX(detr_min, -afact*zbetalpha*zbuoyjam(ig,l)/zw2m   &
+    &     + detr_q_coef*(zdqt(ig,l)/zw2m)**detr_q_power))
+
+          if ( iflag_thermals_ed == 20 ) then
+             entr_star(ig,l)=f_star(ig,l)*zdz* (         &
+    &          mix0 * 0.1 / (zalpha+0.001)               &
+    &        + zbetalpha*MAX(entr_min,                   &
+    &        afact*zbuoyjam(ig,l)/zw2m - fact_epsilon))
+          else
+             entr_star(ig,l)=f_star(ig,l)*zdz* (         &
+    &          mix0 * 0.1 / (zalpha+0.001)               &
+    &        + zbetalpha*MAX(entr_min,                   &
+    &        afact*zbuoy(ig,l)/zw2m - fact_epsilon))
+          endif
+          
+! En dessous de lalim, on prend le max de alim_star et entr_star pour
+! alim_star et 0 sinon
+        if (l.lt.lalim(ig)) then
+          alim_star(ig,l)=max(alim_star(ig,l),entr_star(ig,l))
+          entr_star(ig,l)=0.
+        endif
+        f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)  &
+     &              -detr_star(ig,l)
+
+      endif
+   enddo
+
+
+!============================================================================
+! 5. calcul de la vitesse verticale en melangeant Tl et qt du thermique
+!===========================================================================
+
+   activetmp(:)=active(:) .and. f_star(:,l+1)>1.e-10
+   do ig=1,ngrid
+       if (activetmp(ig)) then 
+           Zsat=.false.
+           ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+  &
+     &            (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l))  &
+     &            /(f_star(ig,l+1)+detr_star(ig,l))
+           zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+  &
+     &            (alim_star(ig,l)+entr_star(ig,l))*po(ig,l))  &
+     &            /(f_star(ig,l+1)+detr_star(ig,l))
+
+        endif
+    enddo
+
+   ztemp(:)=zpspsk(:,l)*ztla(:,l)
+   call thermcell_qsat(ngrid,activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
+   do ig=1,ngrid
+      if (activetmp(ig)) then
+! on ecrit de maniere conservative (sat ou non)
+!          T = Tl +Lv/Cp ql
+           zqla(ig,l)=max(0.,zqta(ig,l)-zqsatth(ig,l))
+           ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
+           ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
+!on rajoute le calcul de zha pour diagnostiques (temp potentielle)
+           zha(ig,l) = ztva(ig,l)
+           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)  &
+     &              -zqla(ig,l))-zqla(ig,l))
+           zbuoy(ig,l)=RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
+           zdz=zlev(ig,l+1)-zlev(ig,l)
+           zdzbis=zlev(ig,l)-zlev(ig,l-1)
+           zeps(ig,l)=(entr_star(ig,l)+alim_star(ig,l))/(f_star(ig,l)*zdz)
+           zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
+           zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
+           zdw2= afact*zbuoy(ig,l)/(fact_epsilon)
+           zdw2bis= afact*zbuoy(ig,l-1)/(fact_epsilon)
+           zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2)+zdw2)
+      endif
+   enddo
+
+   if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l
+!
+!===========================================================================
+! 6. initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max 
+!===========================================================================
+
+   nbpb=0
+   do ig=1,ngrid
+            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
+!               stop'On tombe sur le cas particulier de thermcell_dry'
+!               print*,'On tombe sur le cas particulier de thermcell_plume'
+                nbpb=nbpb+1
+                zw2(ig,l+1)=0.
+                linter(ig)=l+1
+            endif
+
+        if (zw2(ig,l+1).lt.0.) then 
+           linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
+     &               -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
+           zw2(ig,l+1)=0.
+!+CR:04/05/12:correction calcul linter pour calcul de zmax continu
+        elseif (f_star(ig,l+1).lt.0.) then
+           linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
+     &               -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
+           zw2(ig,l+1)=0.
+!fin CR:04/05/12
+        endif
+
+           wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) 
+
+        if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
+!   lmix est le niveau de la couche ou w (wa_moy) est maximum
+!on rajoute le calcul de lmix_bis
+            if (zqla(ig,l).lt.1.e-10) then
+               lmix_bis(ig)=l+1
+            endif
+            lmix(ig)=l+1
+            wmaxa(ig)=wa_moy(ig,l+1)
+        endif
+   enddo
+
+   if (nbpb>0) then
+   print*,'WARNING on tombe ',nbpb,' x sur un pb pour l=',l,' dans thermcell_plume'
+   endif
+
+!=========================================================================
+! FIN DE LA BOUCLE VERTICALE
+      enddo
+!=========================================================================
+
+!on recalcule alim_star_tot
+       do ig=1,ngrid
+          alim_star_tot(ig)=0.
+       enddo
+       do ig=1,ngrid
+          do l=1,lalim(ig)-1
+          alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
+          enddo
+       enddo
+       
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
+
+#undef wrgrads_thermcell
+#ifdef wrgrads_thermcell
+         call wrgradsfi(1,nlay,entr_star(igout,1:nlay),'esta      ','esta      ')
+         call wrgradsfi(1,nlay,detr_star(igout,1:nlay),'dsta      ','dsta      ')
+         call wrgradsfi(1,nlay,zbuoy(igout,1:nlay),'buoy      ','buoy      ')
+         call wrgradsfi(1,nlay,zdqt(igout,1:nlay),'dqt      ','dqt      ')
+         call wrgradsfi(1,nlay,w_est(igout,1:nlay),'w_est     ','w_est     ')
+         call wrgradsfi(1,nlay,w_est(igout,2:nlay+1),'w_es2     ','w_es2     ')
+         call wrgradsfi(1,nlay,zw2(igout,1:nlay),'zw2A      ','zw2A      ')
+#endif
+
+
+ RETURN
+     end
+END MODULE lmdz_thermcell_plume
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_plume_6A.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_plume_6A.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_plume_6A.F90	(revision 4727)
@@ -0,0 +1,1118 @@
+MODULE lmdz_thermcell_plume_6A
+!
+! $Id$
+!
+CONTAINS
+
+      SUBROUTINE thermcell_plume_6A(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
+     &           zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
+     &           lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
+     &           ztla,zqla,zqta,zha,zw2,w_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
+    &           ,lev_out,lunout1,igout)
+!     &           ,lev_out,lunout1,igout,zbuoy,zbuoyjam)
+!--------------------------------------------------------------------------
+!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
+!--------------------------------------------------------------------------
+
+       USE lmdz_thermcell_ini, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
+       USE lmdz_thermcell_ini, ONLY: fact_epsilon, betalpha, afact, fact_shell
+       USE lmdz_thermcell_ini, ONLY: detr_min, entr_min, detr_q_coef, detr_q_power
+       USE lmdz_thermcell_ini, ONLY: mix0, thermals_flag_alim
+       USE lmdz_thermcell_alim, ONLY : thermcell_alim
+       USE lmdz_thermcell_qsat, ONLY : thermcell_qsat
+
+
+       IMPLICIT NONE
+
+      integer,intent(in) :: itap,lev_out,lunout1,igout,ngrid,nlay
+      real,intent(in) :: ptimestep
+      real,intent(in),dimension(ngrid,nlay) :: ztv
+      real,intent(in),dimension(ngrid,nlay) :: zthl
+      real,intent(in),dimension(ngrid,nlay) :: po
+      real,intent(in),dimension(ngrid,nlay) :: zl
+      real,intent(in),dimension(ngrid,nlay) :: rhobarz
+      real,intent(in),dimension(ngrid,nlay+1) :: zlev
+      real,intent(in),dimension(ngrid,nlay+1) :: pplev
+      real,intent(in),dimension(ngrid,nlay) :: pphi
+      real,intent(in),dimension(ngrid,nlay) :: zpspsk
+      real,intent(in),dimension(ngrid) :: f0
+
+      integer,intent(out) :: lalim(ngrid)
+      real,intent(out),dimension(ngrid,nlay) :: alim_star
+      real,intent(out),dimension(ngrid) :: alim_star_tot
+      real,intent(out),dimension(ngrid,nlay) :: detr_star
+      real,intent(out),dimension(ngrid,nlay) :: entr_star
+      real,intent(out),dimension(ngrid,nlay+1) :: f_star
+      real,intent(out),dimension(ngrid,nlay) :: csc
+      real,intent(out),dimension(ngrid,nlay) :: ztva
+      real,intent(out),dimension(ngrid,nlay) :: ztla
+      real,intent(out),dimension(ngrid,nlay) :: zqla
+      real,intent(out),dimension(ngrid,nlay) :: zqta
+      real,intent(out),dimension(ngrid,nlay) :: zha
+      real,intent(out),dimension(ngrid,nlay+1) :: zw2
+      real,intent(out),dimension(ngrid,nlay+1) :: w_est
+      real,intent(out),dimension(ngrid,nlay) :: ztva_est
+      real,intent(out),dimension(ngrid,nlay) :: zqsatth
+      integer,intent(out),dimension(ngrid) :: lmix
+      integer,intent(out),dimension(ngrid) :: lmix_bis
+      real,intent(out),dimension(ngrid) :: linter
+
+      REAL zdw2,zdw2bis
+      REAL zw2modif
+      REAL zw2fact,zw2factbis
+      REAL,dimension(ngrid,nlay) :: zeps
+
+      REAL, dimension(ngrid) ::    wmaxa(ngrid)
+
+      INTEGER ig,l,k,lt,it,lm
+      integer nbpb
+
+      real,dimension(ngrid,nlay) :: detr
+      real,dimension(ngrid,nlay) :: entr
+      real,dimension(ngrid,nlay+1) :: wa_moy
+      real,dimension(ngrid,nlay) :: ztv_est
+      real,dimension(ngrid) :: ztemp,zqsat
+      real,dimension(ngrid,nlay) :: zqla_est
+      real,dimension(ngrid,nlay) :: zta_est
+
+      real,dimension(ngrid,nlay) :: zbuoy,gamma,zdqt
+      real zdz,zalpha,zw2m
+      real,dimension(ngrid,nlay) :: zbuoyjam,zdqtjam
+      real zbuoybis,zdz2,zdz3,lmel,entrbis,zdzbis
+      real, dimension(ngrid) :: d_temp
+      real ztv1,ztv2,factinv,zinv,zlmel
+      real zlmelup,zlmeldwn,zlt,zltdwn,zltup
+      real atv1,atv2,btv1,btv2
+      real ztv_est1,ztv_est2
+      real zcor,zdelta,zcvm5,qlbef
+      real zbetalpha, coefzlmel
+      real eps
+      logical Zsat
+      LOGICAL,dimension(ngrid) :: active,activetmp
+      REAL fact_gamma,fact_gamma2,fact_epsilon2
+      REAL coefc
+      REAL,dimension(ngrid,nlay) :: c2
+
+      if (ngrid==1) print*,'THERMCELL PLUME MODIFIE 2014/07/11'
+      Zsat=.false.
+! Initialisation
+
+
+      zbetalpha=betalpha/(1.+betalpha)
+
+
+! Initialisations des variables r?elles
+if (1==1) then
+      ztva(:,:)=ztv(:,:)
+      ztva_est(:,:)=ztva(:,:)
+      ztv_est(:,:)=ztv(:,:)
+      ztla(:,:)=zthl(:,:)
+      zqta(:,:)=po(:,:)
+      zqla(:,:)=0.
+      zha(:,:) = ztva(:,:)
+else
+      ztva(:,:)=0.
+      ztv_est(:,:)=0.
+      ztva_est(:,:)=0.
+      ztla(:,:)=0.
+      zqta(:,:)=0.
+      zha(:,:) =0.
+endif
+
+      zqla_est(:,:)=0.
+      zqsatth(:,:)=0.
+      zqla(:,:)=0.
+      detr_star(:,:)=0.
+      entr_star(:,:)=0.
+      alim_star(:,:)=0.
+      alim_star_tot(:)=0.
+      csc(:,:)=0.
+      detr(:,:)=0.
+      entr(:,:)=0.
+      zw2(:,:)=0.
+      zbuoy(:,:)=0.
+      zbuoyjam(:,:)=0.
+      gamma(:,:)=0.
+      zeps(:,:)=0.
+      w_est(:,:)=0.
+      f_star(:,:)=0.
+      wa_moy(:,:)=0.
+      linter(:)=1.
+!     linter(:)=1.
+! Initialisation des variables entieres
+      lmix(:)=1
+      lmix_bis(:)=2
+      wmaxa(:)=0.
+
+! Initialisation a 0  en cas de sortie dans replay
+      zqsat(:)=0.
+      zta_est(:,:)=0.
+      zdqt(:,:)=0.
+      zdqtjam(:,:)=0.
+      c2(:,:)=0.
+
+
+!-------------------------------------------------------------------------
+! On ne considere comme actif que les colonnes dont les deux premieres
+! couches sont instables.
+!-------------------------------------------------------------------------
+
+      active(:)=ztv(:,1)>ztv(:,2)
+      d_temp(:)=0. ! Pour activer un contraste de temperature a la base
+                   ! du panache
+!  Cet appel pourrait être fait avant thermcell_plume dans thermcell_main
+      CALL thermcell_alim(thermals_flag_alim,ngrid,nlay,ztv,d_temp,zlev,alim_star,lalim)
+
+!------------------------------------------------------------------------------
+! Calcul dans la premiere couche
+! On decide dans cette version que le thermique n'est actif que si la premiere
+! couche est instable.
+! Pourrait etre change si on veut que le thermiques puisse se d??clencher
+! dans une couche l>1
+!------------------------------------------------------------------------------
+do ig=1,ngrid
+! Le panache va prendre au debut les caracteristiques de l'air contenu
+! dans cette couche.
+    if (active(ig)) then
+    ztla(ig,1)=zthl(ig,1) 
+    zqta(ig,1)=po(ig,1)
+    zqla(ig,1)=zl(ig,1)
+!cr: attention, prise en compte de f*(1)=1
+    f_star(ig,2)=alim_star(ig,1)
+    zw2(ig,2)=2.*RG*(ztv(ig,1)-ztv(ig,2))/ztv(ig,2)  &
+&                     *(zlev(ig,2)-zlev(ig,1))  &
+&                     *0.4*pphi(ig,1)/(pphi(ig,2)-pphi(ig,1))
+    w_est(ig,2)=zw2(ig,2)
+    endif
+enddo
+!
+
+!==============================================================================
+!boucle de calcul de la vitesse verticale dans le thermique
+!==============================================================================
+do l=2,nlay-1
+!==============================================================================
+
+
+! On decide si le thermique est encore actif ou non
+! AFaire : Il faut sans doute ajouter entr_star a alim_star dans ce test
+    do ig=1,ngrid
+       active(ig)=active(ig) &
+&                 .and. zw2(ig,l)>1.e-10 &
+&                 .and. f_star(ig,l)+alim_star(ig,l)>1.e-10
+    enddo
+
+
+
+!---------------------------------------------------------------------------
+! calcul des proprietes thermodynamiques et de la vitesse de la couche l
+! sans tenir compte du detrainement et de l'entrainement dans cette
+! couche
+! C'est a dire qu'on suppose 
+! ztla(l)=ztla(l-1) et zqta(l)=zqta(l-1)
+! Ici encore, on doit pouvoir ajouter entr_star (qui peut etre calculer
+! avant) a l'alimentation pour avoir un calcul plus propre
+!---------------------------------------------------------------------------
+
+   ztemp(:)=zpspsk(:,l)*ztla(:,l-1)
+   call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
+    do ig=1,ngrid 
+!       print*,'active',active(ig),ig,l
+        if(active(ig)) then 
+        zqla_est(ig,l)=max(0.,zqta(ig,l-1)-zqsat(ig))
+        ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l)
+        zta_est(ig,l)=ztva_est(ig,l)
+        ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l)
+        ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)  &
+     &      -zqla_est(ig,l))-zqla_est(ig,l))
+ 
+
+!Modif AJAM
+
+        zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) 
+        zdz=zlev(ig,l+1)-zlev(ig,l)         
+        lmel=fact_thermals_ed_dz*zlev(ig,l)
+!        lmel=0.09*zlev(ig,l)
+        zlmel=zlev(ig,l)+lmel
+        zlmelup=zlmel+(zdz/2)
+        zlmeldwn=zlmel-(zdz/2)
+
+        lt=l+1
+        zlt=zlev(ig,lt)
+        zdz3=zlev(ig,lt+1)-zlt
+        zltdwn=zlt-zdz3/2
+        zltup=zlt+zdz3/2
+         
+!=========================================================================
+! 3. Calcul de la flotabilite modifie par melange avec l'air au dessus
+!=========================================================================
+
+!--------------------------------------------------
+        if (iflag_thermals_ed.lt.8) then
+!--------------------------------------------------
+!AJ052014: J'ai remplac?? la boucle do par un do while
+! afin de faire moins de calcul dans la boucle
+!--------------------------------------------------
+            do while (zlmelup.gt.zltup)
+               lt=lt+1
+               zlt=zlev(ig,lt)
+               zdz3=zlev(ig,lt+1)-zlt
+               zltdwn=zlt-zdz3/2
+               zltup=zlt+zdz3/2        
+            enddo
+!--------------------------------------------------
+!AJ052014: Si iflag_thermals_ed<8 (par ex 6), alors
+! on cherche o?? se trouve l'altitude d'inversion 
+! en calculant ztv1 (interpolation de la valeur de 
+! theta au niveau lt en utilisant les niveaux lt-1 et
+! lt-2) et ztv2 (interpolation avec les niveaux lt+1
+! et lt+2). Si theta r??ellement calcul??e au niveau lt
+! comprise entre ztv1 et ztv2, alors il y a inversion
+! et on calcule son altitude zinv en supposant que ztv(lt)
+! est une combinaison lineaire de ztv1 et ztv2.
+! Ensuite, on calcule la flottabilite en comparant 
+! la temperature de la couche l a celle de l'air situe 
+! l+lmel plus haut, ce qui necessite de savoir quel fraction 
+! de cet air est au-dessus ou en-dessous de l'inversion   
+!--------------------------------------------------
+            atv1=(ztv(ig,lt-1)-ztv(ig,lt-2))/(zlev(ig,lt-1)-zlev(ig,lt-2))
+            btv1=(ztv(ig,lt-2)*zlev(ig,lt-1)-ztv(ig,lt-1)*zlev(ig,lt-2)) &
+    &          /(zlev(ig,lt-1)-zlev(ig,lt-2))
+            atv2=(ztv(ig,lt+2)-ztv(ig,lt+1))/(zlev(ig,lt+2)-zlev(ig,lt+1))
+            btv2=(ztv(ig,lt+1)*zlev(ig,lt+2)-ztv(ig,lt+2)*zlev(ig,lt+1)) &
+    &          /(zlev(ig,lt+2)-zlev(ig,lt+1))
+
+             ztv1=atv1*zlt+btv1
+             ztv2=atv2*zlt+btv2
+
+             if (ztv(ig,lt).gt.ztv1.and.ztv(ig,lt).lt.ztv2) then  
+
+!--------------------------------------------------
+!AJ052014: D??calage de zinv qui est entre le haut
+!          et le bas de la couche lt
+!--------------------------------------------------
+                factinv=(ztv2-ztv(ig,lt))/(ztv2-ztv1)
+                zinv=zltdwn+zdz3*factinv
+
+          
+                if (zlmeldwn.ge.zinv) then
+                   ztv_est(ig,l)=atv2*zlmel+btv2
+                   zbuoyjam(ig,l)=fact_shell*RG*(ztva_est(ig,l)-ztv_est(ig,l))/ztv_est(ig,l) &
+    &                    +(1.-fact_shell)*zbuoy(ig,l)
+                elseif (zlmelup.ge.zinv) then
+                 ztv_est2=atv2*0.5*(zlmelup+zinv)+btv2
+                   ztv_est1=atv1*0.5*(zinv+zlmeldwn)+btv1
+                   ztv_est(ig,l)=((zlmelup-zinv)/zdz)*ztv_est2+((zinv-zlmeldwn)/zdz)*ztv_est1
+
+                   zbuoyjam(ig,l)=fact_shell*RG*(((zlmelup-zinv)/zdz)*(ztva_est(ig,l)- & 
+    &            ztv_est2)/ztv_est2+((zinv-zlmeldwn)/zdz)*(ztva_est(ig,l)- &
+    &            ztv_est1)/ztv_est1)+(1.-fact_shell)*zbuoy(ig,l)
+
+                else 
+                   ztv_est(ig,l)=atv1*zlmel+btv1
+                   zbuoyjam(ig,l)=fact_shell*RG*(ztva_est(ig,l)-ztv_est(ig,l))/ztv_est(ig,l) & 
+    &                           +(1.-fact_shell)*zbuoy(ig,l)
+                endif
+
+             else ! if (ztv(ig,lt).gt.ztv1.and.ztv(ig,lt).lt.ztv2) then
+
+                if (zlmeldwn.gt.zltdwn) then
+                   zbuoyjam(ig,l)=fact_shell*RG*((ztva_est(ig,l)- & 
+    &                ztv(ig,lt))/ztv(ig,lt))+(1.-fact_shell)*zbuoy(ig,l)
+                else
+                   zbuoyjam(ig,l)=fact_shell*RG*(((zlmelup-zltdwn)/zdz)*(ztva_est(ig,l)- & 
+    &                ztv(ig,lt))/ztv(ig,lt)+((zltdwn-zlmeldwn)/zdz)*(ztva_est(ig,l)- &
+    &                ztv(ig,lt-1))/ztv(ig,lt-1))+(1.-fact_shell)*zbuoy(ig,l)
+
+                endif
+
+!          zbuoyjam(ig,l)=fact_shell*RG*(((zlmelup-zltdwn)/zdz)*(ztva_est(ig,l)- & 
+!    &          ztv1)/ztv1+((zltdwn-zlmeldwn)/zdz)*(ztva_est(ig,l)- &
+!    &          ztv(ig,lt-1))/ztv(ig,lt-1))+(1.-fact_shell)*zbuoy(ig,l)
+!         zdqt(ig,l)=Max(0.,((lmel+zdz3-zdz2)/zdz3)*(zqta(ig,l-1)- & 
+!    &          po(ig,lt))/po(ig,lt)+((zdz2-lmel)/zdz3)*(zqta(ig,l-1)- &
+!     &          po(ig,lt-1))/po(ig,lt-1))
+          endif ! if (ztv(ig,lt).gt.ztv1.and.ztv(ig,lt).lt.ztv2) then
+
+        else  !   if (iflag_thermals_ed.lt.8) then
+           lt=l+1
+           zlt=zlev(ig,lt)
+           zdz2=zlev(ig,lt)-zlev(ig,l)
+
+           do while (lmel.gt.zdz2)
+             lt=lt+1
+             zlt=zlev(ig,lt)
+             zdz2=zlt-zlev(ig,l)
+           enddo
+           zdz3=zlev(ig,lt+1)-zlt
+           zltdwn=zlev(ig,lt)-zdz3/2
+           zlmelup=zlmel+(zdz/2)
+           coefzlmel=Min(1.,(zlmelup-zltdwn)/zdz)
+           zbuoyjam(ig,l)=1.*RG*(coefzlmel*(ztva_est(ig,l)- & 
+    &          ztv(ig,lt))/ztv(ig,lt)+(1.-coefzlmel)*(ztva_est(ig,l)- &
+    &          ztv(ig,lt-1))/ztv(ig,lt-1))+0.*zbuoy(ig,l)
+        endif !   if (iflag_thermals_ed.lt.8) then
+
+!------------------------------------------------
+!AJAM:nouveau calcul de w?  
+!------------------------------------------------
+              zdz=zlev(ig,l+1)-zlev(ig,l)
+              zdzbis=zlev(ig,l)-zlev(ig,l-1)
+              zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
+
+              zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
+              zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
+              zdw2=afact*zbuoy(ig,l)/fact_epsilon
+              zdw2bis=afact*zbuoy(ig,l-1)/fact_epsilon
+!              zdw2bis=0.5*(zdw2+zdw2bis)
+              lm=Max(1,l-2)
+!              zdw2=(afact/fact_epsilon)*((zdz/zdzbis)*zbuoy(ig,l) &
+!    &              +((zdzbis-zdz)/zdzbis)*zbuoy(ig,l-1)) 
+!              zdw2bis=(afact/fact_epsilon)*((zdz/zdzbis)*zbuoy(ig,l-1) &
+!    &              +((zdzbis-zdz)/zdzbis)*zbuoy(ig,l-1))
+!             w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2)+zdw2)
+!             w_est(ig,l+1)=(zdz/zdzbis)*Max(0.0001,exp(-zw2fact)* &
+!    &                     (w_est(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
+!    &                     Max(0.0001,exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2)
+!              w_est(ig,l+1)=Max(0.0001,(1-exp(-zw2fact))*zdw2+w_est(ig,l)*exp(-zw2fact))
+
+!--------------------------------------------------
+!AJ052014: J'ai remplac? w_est(ig,l) par zw2(ig,l)
+!--------------------------------------------------
+         if (iflag_thermals_ed==8) then
+! Ancienne version
+!             w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
+!    &                     (w_est(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
+!    &                     (exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2))
+
+            w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2)+zdw2)
+
+! Nouvelle version Arnaud
+         else
+!             w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
+!    &                     (w_est(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
+!    &                     (exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2))
+
+            w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2bis)+zdw2)
+
+!             w_est(ig,l+1)=Max(0.0001,(zdz/(zdzbis+zdz))*(exp(-zw2fact)* &
+!    &                     (w_est(ig,l)-zdw2bis)+zdw2)+(zdzbis/(zdzbis+zdz))* &
+!    &                     (exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2bis))
+
+
+
+!            w_est(ig,l+1)=Max(0.0001,(w_est(ig,l)+zdw2bis*zw2fact)*exp(-zw2fact))
+
+!             w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact)+ &
+!    &                      (zdzbis-zdz)/zdzbis*(zw2(ig,l-1)+zdw2bis*zw2factbis)*exp(-zw2factbis))
+
+!             w_est(ig,l+1)=Max(0.0001,exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2)
+
+         endif
+
+
+         if (iflag_thermals_ed<6) then
+             zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l+1))/rhobarz(ig,l)
+!              fact_epsilon=0.0005/(zalpha+0.025)**0.5
+!              fact_epsilon=Min(0.003,0.0004/(zalpha)**0.5)
+              fact_epsilon=0.0002/(zalpha+0.1)
+              zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
+              zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
+              zdw2=afact*zbuoy(ig,l)/fact_epsilon
+              zdw2bis=afact*zbuoy(ig,l-1)/fact_epsilon
+!              w_est(ig,l+1)=Max(0.0001,(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact))
+
+!              w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
+!    &                     (zw2(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
+!    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2))
+
+            w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2bis)+zdw2)
+
+
+         endif
+!--------------------------------------------------
+!AJ052014: J'ai comment? ce if plus n?cessaire puisqu'
+!on fait max(0.0001,.....)
+!--------------------------------------------------         
+
+!             if (w_est(ig,l+1).lt.0.) then
+!               w_est(ig,l+1)=zw2(ig,l)
+!                w_est(ig,l+1)=0.0001
+!             endif
+
+       endif
+    enddo
+
+
+!-------------------------------------------------
+!calcul des taux d'entrainement et de detrainement
+!-------------------------------------------------
+
+     do ig=1,ngrid
+        if (active(ig)) then
+
+!          zw2m=max(0.5*(w_est(ig,l)+w_est(ig,l+1)),0.1)
+          zw2m=w_est(ig,l+1)
+!          zw2m=zw2(ig,l)
+          zdz=zlev(ig,l+1)-zlev(ig,l)
+          zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
+!          zbuoybis=zbuoy(ig,l)+RG*0.1/300.
+          zbuoybis=zbuoy(ig,l)
+          zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l+1))/rhobarz(ig,l)
+          zdqt(ig,l)=max(zqta(ig,l-1)-po(ig,l),0.)/po(ig,l)
+
+          
+!          entr_star(ig,l)=f_star(ig,l)*zdz*zbetalpha*MAX(0.,  &
+!    &     afact*zbuoybis/zw2m - fact_epsilon )
+
+!          entr_star(ig,l)=MAX(0.,f_star(ig,l)*zdz*zbetalpha*  &
+!    &     afact*zbuoybis/zw2m - fact_epsilon )
+
+
+
+!          zbuoyjam(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
+
+!=========================================================================
+! 4. Calcul de l'entrainement et du detrainement
+!=========================================================================
+
+!          entr_star(ig,l)=f_star(ig,l)*zdz*zbetalpha*MAX(0.,  &
+!    &     afact*zbuoyjam(ig,l)/zw2m - fact_epsilon ) 
+!          entrbis=entr_star(ig,l)
+
+          if (iflag_thermals_ed.lt.6) then
+          fact_epsilon=0.0002/(zalpha+0.1)
+          endif
+          
+
+
+          detr_star(ig,l)=f_star(ig,l)*zdz             &
+    &     *( mix0 * 0.1 / (zalpha+0.001)               &
+    &     + MAX(detr_min, -afact*zbetalpha*zbuoyjam(ig,l)/zw2m   &
+    &     + detr_q_coef*(zdqt(ig,l)/zw2m)**detr_q_power))
+
+!          detr_star(ig,l)=(zdz/zdzbis)*detr_star(ig,l)+ &
+!    &                          ((zdzbis-zdz)/zdzbis)*detr_star(ig,l-1)
+
+          zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
+
+          entr_star(ig,l)=f_star(ig,l)*zdz* (         &
+    &       mix0 * 0.1 / (zalpha+0.001)               &
+    &     + zbetalpha*MAX(entr_min,                   &
+    &     afact*zbuoyjam(ig,l)/zw2m - fact_epsilon))
+
+
+!          entr_star(ig,l)=f_star(ig,l)*zdz* (         &
+!    &       mix0 * 0.1 / (zalpha+0.001)               &
+!    &     + MAX(entr_min,                   &
+!    &     zbetalpha*afact*zbuoyjam(ig,l)/zw2m - fact_epsilon +  & 
+!    &     detr_q_coef*(zdqt(ig,l)/zw2m)**detr_q_power))
+
+
+!          entr_star(ig,l)=(zdz/zdzbis)*entr_star(ig,l)+ &
+!    &                          ((zdzbis-zdz)/zdzbis)*entr_star(ig,l-1)
+
+!          entr_star(ig,l)=Max(0.,f_star(ig,l)*zdz*zbetalpha*  &     
+!    &     afact*zbuoy(ig,l)/zw2m &
+!    &     - 1.*fact_epsilon)
+
+          
+! En dessous de lalim, on prend le max de alim_star et entr_star pour
+! alim_star et 0 sinon
+        if (l.lt.lalim(ig)) then
+          alim_star(ig,l)=max(alim_star(ig,l),entr_star(ig,l))
+          entr_star(ig,l)=0.
+        endif
+!        if (l.lt.lalim(ig).and.alim_star(ig,l)>alim_star(ig,l-1)) then
+!          alim_star(ig,l)=entrbis
+!        endif
+
+!        print*,'alim0',zlev(ig,l),entr_star(ig,l),detr_star(ig,l),zw2m,zbuoy(ig,l),f_star(ig,l)
+! Calcul du flux montant normalise
+      f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)  &
+     &              -detr_star(ig,l)
+
+      endif
+   enddo
+
+
+!============================================================================
+! 5. calcul de la vitesse verticale en melangeant Tl et qt du thermique
+!===========================================================================
+
+   activetmp(:)=active(:) .and. f_star(:,l+1)>1.e-10
+   do ig=1,ngrid
+       if (activetmp(ig)) then 
+           Zsat=.false.
+           ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+  &
+     &            (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l))  &
+     &            /(f_star(ig,l+1)+detr_star(ig,l))
+           zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+  &
+     &            (alim_star(ig,l)+entr_star(ig,l))*po(ig,l))  &
+     &            /(f_star(ig,l+1)+detr_star(ig,l))
+
+        endif
+    enddo
+
+   ztemp(:)=zpspsk(:,l)*ztla(:,l)
+   call thermcell_qsat(ngrid,activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
+   do ig=1,ngrid
+      if (activetmp(ig)) then
+! on ecrit de maniere conservative (sat ou non)
+!          T = Tl +Lv/Cp ql
+           zqla(ig,l)=max(0.,zqta(ig,l)-zqsatth(ig,l))
+           ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
+           ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
+!on rajoute le calcul de zha pour diagnostiques (temp potentielle)
+           zha(ig,l) = ztva(ig,l)
+           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)  &
+     &              -zqla(ig,l))-zqla(ig,l))
+           zbuoy(ig,l)=RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
+           zdz=zlev(ig,l+1)-zlev(ig,l)
+           zdzbis=zlev(ig,l)-zlev(ig,l-1)
+           zeps(ig,l)=(entr_star(ig,l)+alim_star(ig,l))/(f_star(ig,l)*zdz)
+!!!!!!!          fact_epsilon=0.002
+            zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
+            zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
+            zdw2= afact*zbuoy(ig,l)/(fact_epsilon)
+            zdw2bis= afact*zbuoy(ig,l-1)/(fact_epsilon)
+!              zdw2=(afact/fact_epsilon)*((zdz/zdzbis)*zbuoy(ig,l) &
+!    &              +((zdzbis-zdz)/zdzbis)*zbuoy(ig,l-1)) 
+!              lm=Max(1,l-2)
+!              zdw2bis=(afact/fact_epsilon)*((zdz/zdzbis)*zbuoy(ig,l-1) &
+!    &              +((zdzbis-zdz)/zdzbis)*zbuoy(ig,l-1))
+!            zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2bis)+zdw2)
+!            zw2(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact)+ &
+!     &                   (zdzbis-zdz)/zdzbis*(zw2(ig,l-1)+zdw2bis*zw2factbis)*exp(-zw2factbis))
+!            zw2(ig,l+1)=Max(0.0001,(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact))
+!            zw2(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
+!    &                     (zw2(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
+!    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2))
+            if (iflag_thermals_ed==8) then
+            zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2)+zdw2)
+            else
+            zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2bis)+zdw2)
+            endif
+!            zw2(ig,l+1)=Max(0.0001,(zdz/(zdz+zdzbis))*(exp(-zw2fact)* &
+!    &                     (zw2(ig,l)-zdw2)+zdw2bis)+(zdzbis/(zdz+zdzbis))* &
+!    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2bis))
+
+
+           if (iflag_thermals_ed.lt.6) then
+           zalpha=f0(ig)*f_star(ig,l)/sqrt(zw2(ig,l+1))/rhobarz(ig,l)
+!           fact_epsilon=0.0005/(zalpha+0.025)**0.5
+!           fact_epsilon=Min(0.003,0.0004/(zalpha)**0.5)
+           fact_epsilon=0.0002/(zalpha+0.1)**1
+            zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
+            zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
+            zdw2= afact*zbuoy(ig,l)/(fact_epsilon)
+            zdw2bis= afact*zbuoy(ig,l-1)/(fact_epsilon)
+
+!            zw2(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
+!    &                     (zw2(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
+!    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2))
+!            zw2(ig,l+1)=Max(0.0001,(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact))
+            zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2bis)+zdw2)
+
+           endif
+
+
+      endif
+   enddo
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l
+!
+!===========================================================================
+! 6. initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max 
+!===========================================================================
+
+   nbpb=0
+   do ig=1,ngrid
+            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
+!               stop'On tombe sur le cas particulier de thermcell_dry'
+!               print*,'On tombe sur le cas particulier de thermcell_plume'
+                nbpb=nbpb+1
+                zw2(ig,l+1)=0.
+                linter(ig)=l+1
+            endif
+
+        if (zw2(ig,l+1).lt.0.) then 
+           linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
+     &               -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
+           zw2(ig,l+1)=0.
+!+CR:04/05/12:correction calcul linter pour calcul de zmax continu
+        elseif (f_star(ig,l+1).lt.0.) then
+           linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
+     &               -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
+           zw2(ig,l+1)=0.
+!fin CR:04/05/12
+        endif
+
+           wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) 
+
+        if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
+!   lmix est le niveau de la couche ou w (wa_moy) est maximum
+!on rajoute le calcul de lmix_bis
+            if (zqla(ig,l).lt.1.e-10) then
+               lmix_bis(ig)=l+1
+            endif
+            lmix(ig)=l+1
+            wmaxa(ig)=wa_moy(ig,l+1)
+        endif
+   enddo
+
+   if (nbpb>0) then
+   print*,'WARNING on tombe ',nbpb,' x sur un pb pour l=',l,' dans thermcell_plume'
+   endif
+
+!=========================================================================
+! FIN DE LA BOUCLE VERTICALE
+      enddo
+!=========================================================================
+
+!on recalcule alim_star_tot
+       do ig=1,ngrid
+          alim_star_tot(ig)=0.
+       enddo
+       do ig=1,ngrid
+          do l=1,lalim(ig)-1
+          alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
+          enddo
+       enddo
+       
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
+
+#undef wrgrads_thermcell
+#ifdef wrgrads_thermcell
+         call wrgradsfi(1,nlay,entr_star(igout,1:nlay),'esta      ','esta      ')
+         call wrgradsfi(1,nlay,detr_star(igout,1:nlay),'dsta      ','dsta      ')
+         call wrgradsfi(1,nlay,zbuoy(igout,1:nlay),'buoy      ','buoy      ')
+         call wrgradsfi(1,nlay,zdqt(igout,1:nlay),'dqt      ','dqt      ')
+         call wrgradsfi(1,nlay,w_est(igout,1:nlay),'w_est     ','w_est     ')
+         call wrgradsfi(1,nlay,w_est(igout,2:nlay+1),'w_es2     ','w_es2     ')
+         call wrgradsfi(1,nlay,zw2(igout,1:nlay),'zw2A      ','zw2A      ')
+#endif
+
+
+ RETURN
+     end
+
+
+
+
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ SUBROUTINE thermcell_plume_5B(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
+&           zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
+&           lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
+&           ztla,zqla,zqta,zha,zw2,w_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
+&           ,lev_out,lunout1,igout)
+!&           ,lev_out,lunout1,igout,zbuoy,zbuoyjam)
+
+!--------------------------------------------------------------------------
+!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
+! Version conforme a l'article de Rio et al. 2010.
+! Code ecrit par Catherine Rio, Arnaud Jam et Frederic Hourdin
+!--------------------------------------------------------------------------
+
+      USE lmdz_thermcell_ini, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
+       USE lmdz_thermcell_qsat, ONLY : thermcell_qsat
+      IMPLICIT NONE
+
+      INTEGER itap
+      INTEGER lunout1,igout
+      INTEGER ngrid,nlay
+      REAL ptimestep
+      REAL ztv(ngrid,nlay)
+      REAL zthl(ngrid,nlay)
+      REAL, INTENT(IN) :: po(ngrid,nlay)
+      REAL zl(ngrid,nlay)
+      REAL rhobarz(ngrid,nlay)
+      REAL zlev(ngrid,nlay+1)
+      REAL pplev(ngrid,nlay+1)
+      REAL pphi(ngrid,nlay)
+      REAL zpspsk(ngrid,nlay)
+      REAL alim_star(ngrid,nlay)
+      REAL f0(ngrid)
+      INTEGER lalim(ngrid)
+      integer lev_out                           ! niveau pour les print
+      integer nbpb
+    
+      real alim_star_tot(ngrid)
+
+      REAL ztva(ngrid,nlay)
+      REAL ztla(ngrid,nlay)
+      REAL zqla(ngrid,nlay)
+      REAL zqta(ngrid,nlay)
+      REAL zha(ngrid,nlay)
+
+      REAL detr_star(ngrid,nlay)
+      REAL coefc
+      REAL entr_star(ngrid,nlay)
+      REAL detr(ngrid,nlay)
+      REAL entr(ngrid,nlay)
+
+      REAL csc(ngrid,nlay)
+
+      REAL zw2(ngrid,nlay+1)
+      REAL w_est(ngrid,nlay+1)
+      REAL f_star(ngrid,nlay+1)
+      REAL wa_moy(ngrid,nlay+1)
+
+      REAL ztva_est(ngrid,nlay)
+      REAL zqla_est(ngrid,nlay)
+      REAL zqsatth(ngrid,nlay)
+      REAL zta_est(ngrid,nlay)
+      REAL zbuoyjam(ngrid,nlay)
+      REAL ztemp(ngrid),zqsat(ngrid)
+      REAL zdw2
+      REAL zw2modif
+      REAL zw2fact
+      REAL zeps(ngrid,nlay)
+
+      REAL linter(ngrid)
+      INTEGER lmix(ngrid)
+      INTEGER lmix_bis(ngrid)
+      REAL    wmaxa(ngrid)
+
+      INTEGER ig,l,k
+
+      real zdz,zbuoy(ngrid,nlay),zalpha,gamma(ngrid,nlay),zdqt(ngrid,nlay),zw2m
+      real zbuoybis
+      real zcor,zdelta,zcvm5,qlbef,zdz2
+      real betalpha,zbetalpha
+      real eps, afact
+      logical Zsat
+      LOGICAL active(ngrid),activetmp(ngrid)
+      REAL fact_gamma,fact_epsilon,fact_gamma2,fact_epsilon2
+      REAL c2(ngrid,nlay)
+      Zsat=.false.
+! Initialisation
+
+      fact_epsilon=0.002
+      betalpha=0.9 
+      afact=2./3.            
+
+      zbetalpha=betalpha/(1.+betalpha)
+
+
+! Initialisations des variables reeles
+if (1==1) then
+      ztva(:,:)=ztv(:,:)
+      ztva_est(:,:)=ztva(:,:)
+      ztla(:,:)=zthl(:,:)
+      zqta(:,:)=po(:,:)
+      zha(:,:) = ztva(:,:)
+else
+      ztva(:,:)=0.
+      ztva_est(:,:)=0.
+      ztla(:,:)=0.
+      zqta(:,:)=0.
+      zha(:,:) =0.
+endif
+
+      zqla_est(:,:)=0.
+      zqsatth(:,:)=0.
+      zqla(:,:)=0.
+      detr_star(:,:)=0.
+      entr_star(:,:)=0.
+      alim_star(:,:)=0.
+      alim_star_tot(:)=0.
+      csc(:,:)=0.
+      detr(:,:)=0.
+      entr(:,:)=0.
+      zw2(:,:)=0.
+      zbuoy(:,:)=0.
+      zbuoyjam(:,:)=0.
+      gamma(:,:)=0.
+      zeps(:,:)=0.
+      w_est(:,:)=0.
+      f_star(:,:)=0.
+      wa_moy(:,:)=0.
+      linter(:)=1.
+!     linter(:)=1.
+! Initialisation des variables entieres
+      lmix(:)=1
+      lmix_bis(:)=2
+      wmaxa(:)=0.
+      lalim(:)=1
+
+
+!-------------------------------------------------------------------------
+! On ne considere comme actif que les colonnes dont les deux premieres
+! couches sont instables.
+!-------------------------------------------------------------------------
+      active(:)=ztv(:,1)>ztv(:,2)
+
+!-------------------------------------------------------------------------
+! Definition de l'alimentation
+!-------------------------------------------------------------------------
+      do l=1,nlay-1
+         do ig=1,ngrid
+            if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) then
+               alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
+     &                       *sqrt(zlev(ig,l+1)) 
+               lalim(ig)=l+1
+               alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
+            endif
+         enddo
+      enddo
+      do l=1,nlay
+         do ig=1,ngrid 
+            if (alim_star_tot(ig) > 1.e-10 ) then
+               alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
+            endif
+         enddo
+      enddo
+      alim_star_tot(:)=1.
+
+
+
+!------------------------------------------------------------------------------
+! Calcul dans la premiere couche
+! On decide dans cette version que le thermique n'est actif que si la premiere
+! couche est instable.
+! Pourrait etre change si on veut que le thermiques puisse se d??clencher
+! dans une couche l>1
+!------------------------------------------------------------------------------
+do ig=1,ngrid
+! Le panache va prendre au debut les caracteristiques de l'air contenu
+! dans cette couche.
+    if (active(ig)) then
+    ztla(ig,1)=zthl(ig,1) 
+    zqta(ig,1)=po(ig,1)
+    zqla(ig,1)=zl(ig,1)
+!cr: attention, prise en compte de f*(1)=1
+    f_star(ig,2)=alim_star(ig,1)
+    zw2(ig,2)=2.*RG*(ztv(ig,1)-ztv(ig,2))/ztv(ig,2)  &
+&                     *(zlev(ig,2)-zlev(ig,1))  &
+&                     *0.4*pphi(ig,1)/(pphi(ig,2)-pphi(ig,1))
+    w_est(ig,2)=zw2(ig,2)
+    endif
+enddo
+!
+
+!==============================================================================
+!boucle de calcul de la vitesse verticale dans le thermique
+!==============================================================================
+do l=2,nlay-1
+!==============================================================================
+
+
+! On decide si le thermique est encore actif ou non
+! AFaire : Il faut sans doute ajouter entr_star a alim_star dans ce test
+    do ig=1,ngrid
+       active(ig)=active(ig) &
+&                 .and. zw2(ig,l)>1.e-10 &
+&                 .and. f_star(ig,l)+alim_star(ig,l)>1.e-10
+    enddo
+
+
+
+!---------------------------------------------------------------------------
+! calcul des proprietes thermodynamiques et de la vitesse de la couche l
+! sans tenir compte du detrainement et de l'entrainement dans cette
+! couche
+! C'est a dire qu'on suppose 
+! ztla(l)=ztla(l-1) et zqta(l)=zqta(l-1)
+! Ici encore, on doit pouvoir ajouter entr_star (qui peut etre calculer
+! avant) a l'alimentation pour avoir un calcul plus propre
+!---------------------------------------------------------------------------
+
+   ztemp(:)=zpspsk(:,l)*ztla(:,l-1)
+   call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
+
+    do ig=1,ngrid 
+!       print*,'active',active(ig),ig,l
+        if(active(ig)) then 
+        zqla_est(ig,l)=max(0.,zqta(ig,l-1)-zqsat(ig))
+        ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l)
+        zta_est(ig,l)=ztva_est(ig,l)
+        ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l)
+        ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)  &
+     &      -zqla_est(ig,l))-zqla_est(ig,l))
+
+!------------------------------------------------
+!AJAM:nouveau calcul de w?  
+!------------------------------------------------
+              zdz=zlev(ig,l+1)-zlev(ig,l)
+              zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
+
+              zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
+              zdw2=(afact)*zbuoy(ig,l)/(fact_epsilon)
+              w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2)+zdw2)
+ 
+
+             if (w_est(ig,l+1).lt.0.) then
+                w_est(ig,l+1)=zw2(ig,l)
+             endif
+       endif
+    enddo
+
+
+!-------------------------------------------------
+!calcul des taux d'entrainement et de detrainement
+!-------------------------------------------------
+
+     do ig=1,ngrid
+        if (active(ig)) then
+
+          zw2m=max(0.5*(w_est(ig,l)+w_est(ig,l+1)),0.1)
+          zw2m=w_est(ig,l+1)
+          zdz=zlev(ig,l+1)-zlev(ig,l)
+          zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
+!          zbuoybis=zbuoy(ig,l)+RG*0.1/300.
+          zbuoybis=zbuoy(ig,l)
+          zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l+1))/rhobarz(ig,l)
+          zdqt(ig,l)=max(zqta(ig,l-1)-po(ig,l),0.)/po(ig,l)
+
+          
+          entr_star(ig,l)=f_star(ig,l)*zdz*  zbetalpha*MAX(0.,  &
+    &     afact*zbuoybis/zw2m - fact_epsilon )
+
+
+          detr_star(ig,l)=f_star(ig,l)*zdz                        &
+    &     *MAX(1.e-3, -afact*zbetalpha*zbuoy(ig,l)/zw2m          &
+    &     + 0.012*(zdqt(ig,l)/zw2m)**0.5 )
+          
+! En dessous de lalim, on prend le max de alim_star et entr_star pour
+! alim_star et 0 sinon
+        if (l.lt.lalim(ig)) then
+          alim_star(ig,l)=max(alim_star(ig,l),entr_star(ig,l))
+          entr_star(ig,l)=0.
+        endif
+
+! Calcul du flux montant normalise
+      f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)  &
+     &              -detr_star(ig,l)
+
+      endif
+   enddo
+
+
+!----------------------------------------------------------------------------
+!calcul de la vitesse verticale en melangeant Tl et qt du thermique
+!---------------------------------------------------------------------------
+   activetmp(:)=active(:) .and. f_star(:,l+1)>1.e-10
+   do ig=1,ngrid
+       if (activetmp(ig)) then 
+           Zsat=.false.
+           ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+  &
+     &            (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l))  &
+     &            /(f_star(ig,l+1)+detr_star(ig,l))
+           zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+  &
+     &            (alim_star(ig,l)+entr_star(ig,l))*po(ig,l))  &
+     &            /(f_star(ig,l+1)+detr_star(ig,l))
+
+        endif
+    enddo
+
+   ztemp(:)=zpspsk(:,l)*ztla(:,l)
+   call thermcell_qsat(ngrid,activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
+
+   do ig=1,ngrid
+      if (activetmp(ig)) then
+! on ecrit de maniere conservative (sat ou non)
+!          T = Tl +Lv/Cp ql
+           zqla(ig,l)=max(0.,zqta(ig,l)-zqsatth(ig,l))
+           ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
+           ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
+!on rajoute le calcul de zha pour diagnostiques (temp potentielle)
+           zha(ig,l) = ztva(ig,l)
+           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)  &
+     &              -zqla(ig,l))-zqla(ig,l))
+           zbuoy(ig,l)=RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
+           zdz=zlev(ig,l+1)-zlev(ig,l)
+           zeps(ig,l)=(entr_star(ig,l)+alim_star(ig,l))/(f_star(ig,l)*zdz)
+
+            zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
+            zdw2=afact*zbuoy(ig,l)/(fact_epsilon)
+            zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2)+zdw2) 
+      endif
+   enddo
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l
+!
+!---------------------------------------------------------------------------
+!initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max 
+!---------------------------------------------------------------------------
+
+   nbpb=0
+   do ig=1,ngrid
+            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
+!               stop'On tombe sur le cas particulier de thermcell_dry'
+!               print*,'On tombe sur le cas particulier de thermcell_plume'
+                nbpb=nbpb+1
+                zw2(ig,l+1)=0.
+                linter(ig)=l+1
+            endif
+
+        if (zw2(ig,l+1).lt.0.) then 
+           linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
+     &               -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
+           zw2(ig,l+1)=0.
+        elseif (f_star(ig,l+1).lt.0.) then
+           linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
+     &               -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
+!           print*,"linter plume", linter(ig)
+           zw2(ig,l+1)=0.
+        endif
+
+           wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) 
+
+        if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
+!   lmix est le niveau de la couche ou w (wa_moy) est maximum
+!on rajoute le calcul de lmix_bis
+            if (zqla(ig,l).lt.1.e-10) then
+               lmix_bis(ig)=l+1
+            endif
+            lmix(ig)=l+1
+            wmaxa(ig)=wa_moy(ig,l+1)
+        endif
+   enddo
+
+   if (nbpb>0) then
+   print*,'WARNING on tombe ',nbpb,' x sur un pb pour l=',l,' dans thermcell_plume'
+   endif
+
+!=========================================================================
+! FIN DE LA BOUCLE VERTICALE
+      enddo
+!=========================================================================
+
+!on recalcule alim_star_tot
+       do ig=1,ngrid
+          alim_star_tot(ig)=0.
+       enddo
+       do ig=1,ngrid
+          do l=1,lalim(ig)-1
+          alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
+          enddo
+       enddo
+       
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
+
+#undef wrgrads_thermcell
+#ifdef wrgrads_thermcell
+         call wrgradsfi(1,nlay,entr_star(igout,1:nlay),'esta      ','esta      ')
+         call wrgradsfi(1,nlay,detr_star(igout,1:nlay),'dsta      ','dsta      ')
+         call wrgradsfi(1,nlay,zbuoy(igout,1:nlay),'buoy      ','buoy      ')
+         call wrgradsfi(1,nlay,zdqt(igout,1:nlay),'dqt      ','dqt      ')
+         call wrgradsfi(1,nlay,w_est(igout,1:nlay),'w_est     ','w_est     ')
+         call wrgradsfi(1,nlay,w_est(igout,2:nlay+1),'w_es2     ','w_es2     ')
+         call wrgradsfi(1,nlay,zw2(igout,1:nlay),'zw2A      ','zw2A      ')
+#endif
+
+
+     return 
+     end
+END MODULE lmdz_thermcell_plume_6A
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_qsat.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_qsat.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_thermcell_qsat.F90	(revision 4727)
@@ -0,0 +1,99 @@
+MODULE lmdz_thermcell_qsat
+CONTAINS
+
+subroutine thermcell_qsat(klon,active,pplev,ztemp,zqta,zqsat)
+implicit none
+
+  INCLUDE "YOMCST.h"
+  INCLUDE "YOETHF.h"
+  INCLUDE "FCTTRE.h"
+
+
+!====================================================================
+! DECLARATIONS
+!====================================================================
+
+! Arguments
+INTEGER klon
+REAL zpspsk(klon),pplev(klon)
+REAL ztemp(klon),zqta(klon),zqsat(klon)
+LOGICAL active(klon)
+
+! Variables locales
+INTEGER ig,iter
+REAL Tbef(klon),DT(klon)
+REAL tdelta,qsatbef,zcor,qlbef,zdelta,zcvm5,dqsat,num,denom,dqsat_dT
+logical Zsat
+REAL RLvCp
+
+REAL, SAVE :: DDT0=.01
+!$OMP THREADPRIVATE(DDT0)
+
+LOGICAL afaire(klon),tout_converge
+
+!====================================================================
+! INITIALISATIONS
+!====================================================================
+
+RLvCp = RLVTT/RCPD
+tout_converge=.false.
+afaire(:)=.false.
+DT(:)=0.
+
+
+!====================================================================
+! Routine a vectoriser en copiant active dans converge et en mettant
+! la boucle sur les iterations a l'exterieur est en mettant
+! converge= false des que la convergence est atteinte.
+!====================================================================
+
+do ig=1,klon
+   if (active(ig)) then
+               Tbef(ig)=ztemp(ig)
+               zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+               qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig)
+               qsatbef=MIN(0.5,qsatbef)
+               zcor=1./(1.-retv*qsatbef)
+               qsatbef=qsatbef*zcor
+               qlbef=max(0.,zqta(ig)-qsatbef)
+               DT(ig) = 0.5*RLvCp*qlbef
+               zqsat(ig)=qsatbef
+     endif
+enddo
+
+! Traitement du cas ou il y a condensation mais faible
+! On ne condense pas mais on dit que le qsat est le qta
+do ig=1,klon
+   if (active(ig)) then
+      if (0.<abs(DT(ig)).and.abs(DT(ig))<=DDT0) then
+         zqsat(ig)=zqta(ig)
+      endif
+   endif
+enddo
+
+do iter=1,10
+    afaire(:)=abs(DT(:)).gt.DDT0
+    do ig=1,klon
+               if (afaire(ig)) then
+                 Tbef(ig)=Tbef(ig)+DT(ig)
+                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+                 qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig)
+                 qsatbef=MIN(0.5,qsatbef)
+                 zcor=1./(1.-retv*qsatbef)
+                 qsatbef=qsatbef*zcor
+                 qlbef=zqta(ig)-qsatbef
+                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
+                 zcor=1./(1.-retv*qsatbef)
+                 dqsat_dT=FOEDE(Tbef(ig),zdelta,zcvm5,qsatbef,zcor)
+                 num=-Tbef(ig)+ztemp(ig)+RLvCp*qlbef
+                 denom=1.+RLvCp*dqsat_dT
+                 zqsat(ig) = qsatbef
+                 DT(ig)=num/denom
+               endif
+    enddo
+enddo
+
+return
+end
+END MODULE lmdz_thermcell_qsat
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_wake.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_wake.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_wake.F90	(revision 4727)
@@ -0,0 +1,2689 @@
+MODULE lmdz_wake
+
+! $Id$
+
+CONTAINS
+
+SUBROUTINE wake(klon,klev,znatsurf, p, ph, pi, dtime, &
+                tenv0, qe0, omgb, &
+                dtdwn, dqdwn, amdwn, amup, dta, dqa, wgen, &
+                sigd_con, Cin, &
+                deltatw, deltaqw, sigmaw, awdens, wdens, &                  ! state variables           
+                dth, hw, wape, fip, gfl, &
+                dtls, dqls, ktopw, omgbdth, dp_omgb, tu, qu, &
+                dtke, dqke, omg, dp_deltomg, wkspread, cstar, &
+                d_deltat_gw, &                                                      ! tendencies
+                d_deltatw2, d_deltaqw2, d_sigmaw2, d_awdens2, d_wdens2)             ! tendencies
+
+
+  ! **************************************************************
+  ! *
+  ! WAKE                                                        *
+  ! retour a un Pupper fixe                                *
+  ! *
+  ! written by   :  GRANDPEIX Jean-Yves   09/03/2000            *
+  ! modified by :   ROEHRIG Romain        01/29/2007            *
+  ! **************************************************************
+
+
+  USE lmdz_wake_ini , ONLY : wake_ini
+  USE lmdz_wake_ini , ONLY : prt_level,epsim1,RG,RD
+  USE lmdz_wake_ini , ONLY : stark, wdens_ref, coefgw, alpk, wk_pupper
+  USE lmdz_wake_ini , ONLY : crep_upper, crep_sol, tau_cv, rzero, aa0, flag_wk_check_trgl
+  USE lmdz_wake_ini , ONLY : ok_bug_gfl
+  USE lmdz_wake_ini , ONLY : iflag_wk_act, iflag_wk_check_trgl, iflag_wk_pop_dyn, wdensmin
+  USE lmdz_wake_ini , ONLY : sigmad, hwmin, wapecut, cstart, sigmaw_max, dens_rate, epsilon_loc
+  USE lmdz_wake_ini , ONLY : iflag_wk_profile
+
+
+  IMPLICIT NONE
+  ! ============================================================================
+
+
+  ! But : Decrire le comportement des poches froides apparaissant dans les
+  ! grands systemes convectifs, et fournir l'energie disponible pour
+  ! le declenchement de nouvelles colonnes convectives.
+
+  ! State variables : 
+  ! deltatw    : temperature difference between wake and off-wake regions
+  ! deltaqw    : specific humidity difference between wake and off-wake regions
+  ! sigmaw     : fractional area covered by wakes.
+  ! wdens      : number of wakes per unit area
+
+  ! Variable de sortie :
+
+  ! wape : WAke Potential Energy
+  ! fip  : Front Incident Power (W/m2) - ALP
+  ! gfl  : Gust Front Length per unit area (m-1)
+  ! dtls : large scale temperature tendency due to wake
+  ! dqls : large scale humidity tendency due to wake
+  ! hw   : wake top hight (given by hw*deltatw(1)/2=wape)
+  ! dp_omgb : vertical gradient of large scale omega
+  ! awdens  : densite de poches actives
+  ! wdens   : densite de poches
+  ! omgbdth: flux of Delta_Theta transported by LS omega
+  ! dtKE   : differential heating (wake - unpertubed)
+  ! dqKE   : differential moistening (wake - unpertubed)
+  ! omg    : Delta_omg =vertical velocity diff. wake-undist. (Pa/s)
+  ! dp_deltomg  : vertical gradient of omg (s-1)
+  ! wkspread  : spreading term in d_t_wake and d_q_wake
+  ! deltatw     : updated temperature difference (T_w-T_u).
+  ! deltaqw     : updated humidity difference (q_w-q_u).
+  ! sigmaw      : updated wake fractional area.
+  ! d_deltat_gw : delta T tendency due to GW
+
+  ! Variables d'entree :
+
+  ! aire : aire de la maille
+  ! tenv0  : temperature dans l'environnement  (K)
+  ! qe0  : humidite dans l'environnement     (kg/kg)
+  ! omgb : vitesse verticale moyenne sur la maille (Pa/s)
+  ! dtdwn: source de chaleur due aux descentes (K/s)
+  ! dqdwn: source d'humidite due aux descentes (kg/kg/s)
+  ! dta  : source de chaleur due courants satures et detrain  (K/s)
+  ! dqa  : source d'humidite due aux courants satures et detra (kg/kg/s)
+  ! wgen : number of wakes generated per unit area and per sec (/m^2/s)
+  ! amdwn: flux de masse total des descentes, par unite de
+  !        surface de la maille (kg/m2/s)
+  ! amup : flux de masse total des ascendances, par unite de
+  !        surface de la maille (kg/m2/s)
+  ! sigd_con: 
+  ! Cin  : convective inhibition
+  ! p    : pressions aux milieux des couches (Pa)
+  ! ph   : pressions aux interfaces (Pa)
+  ! pi  : (p/p_0)**kapa (adim)
+  ! dtime: increment temporel (s)
+
+  ! Variables internes :
+
+  ! rhow : masse volumique de la poche froide
+  ! rho  : environment density at P levels
+  ! rhoh : environment density at Ph levels
+  ! tenv   : environment temperature | may change within
+  ! qe   : environment humidity    | sub-time-stepping
+  ! the  : environment potential temperature
+  ! thu  : potential temperature in undisturbed area
+  ! tu   :  temperature  in undisturbed area
+  ! qu   : humidity in undisturbed area
+  ! dp_omgb: vertical gradient og LS omega
+  ! omgbw  : wake average vertical omega
+  ! dp_omgbw: vertical gradient of omgbw
+  ! omgbdq : flux of Delta_q transported by LS omega
+  ! dth  : potential temperature diff. wake-undist.
+  ! th1  : first pot. temp. for vertical advection (=thu)
+  ! th2  : second pot. temp. for vertical advection (=thw)
+  ! q1   : first humidity for vertical advection
+  ! q2   : second humidity for vertical advection
+  ! d_deltatw   : terme de redistribution pour deltatw
+  ! d_deltaqw   : terme de redistribution pour deltaqw
+  ! deltatw0   : deltatw initial
+  ! deltaqw0   : deltaqw initial
+  ! hw0    : wake top hight (defined as the altitude at which deltatw=0)
+  ! amflux : horizontal mass flux through wake boundary
+  ! wdens_ref: initial number of wakes per unit area (3D) or per
+  ! unit length (2D), at the beginning of each time step
+  ! Tgw    : 1 sur la periode de onde de gravite
+  ! Cgw    : vitesse de propagation de onde de gravite
+  ! LL     : distance entre 2 poches
+
+  ! -------------------------------------------------------------------------
+  ! Declaration de variables
+  ! -------------------------------------------------------------------------
+
+
+  ! Arguments en entree
+  ! --------------------
+
+  INTEGER, INTENT(IN) :: klon,klev
+  INTEGER, DIMENSION (klon),        INTENT(IN)          :: znatsurf
+  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: p, pi
+  REAL, DIMENSION (klon, klev+1),   INTENT(IN)          :: ph
+  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: omgb
+  REAL,                             INTENT(IN)          :: dtime
+  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: tenv0, qe0
+  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: dtdwn, dqdwn
+  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: amdwn, amup
+  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: dta, dqa
+  REAL, DIMENSION (klon),           INTENT(IN)          :: wgen
+  REAL, DIMENSION (klon),           INTENT(IN)          :: sigd_con
+  REAL, DIMENSION (klon),           INTENT(IN)          :: Cin
+
+  !
+  ! Input/Output
+  ! State variables
+  REAL, DIMENSION (klon, klev),     INTENT(INOUT)       :: deltatw, deltaqw
+  REAL, DIMENSION (klon),           INTENT(INOUT)       :: sigmaw
+  REAL, DIMENSION (klon),           INTENT(INOUT)       :: awdens
+  REAL, DIMENSION (klon),           INTENT(INOUT)       :: wdens
+
+  ! Sorties
+  ! --------
+
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dth
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: tu, qu
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dtls, dqls
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dtke, dqke
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: wkspread    !  unused (jyg)
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: omgbdth, omg
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dp_omgb, dp_deltomg
+  REAL, DIMENSION (klon),           INTENT(OUT)         :: hw, wape, fip, gfl, cstar
+  INTEGER, DIMENSION (klon),        INTENT(OUT)         :: ktopw
+  ! Tendencies of state variables (2 is appended to the names of fields which are the cumul of fields 
+  !                                 computed at each sub-timestep; e.g. d_wdens2 is the cumul of d_wdens)
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: d_deltat_gw
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: d_deltatw2, d_deltaqw2
+  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_sigmaw2, d_awdens2, d_wdens2
+
+  ! Variables internes
+  ! -------------------
+
+  ! Variables a fixer
+
+  REAL                                                  :: delta_t_min
+  INTEGER                                               :: nsub
+  REAL                                                  :: dtimesub
+  REAL                                                  :: wdens0
+  ! IM 080208
+  LOGICAL, DIMENSION (klon)                             :: gwake
+
+  ! Variables de sauvegarde
+  REAL, DIMENSION (klon, klev)                          :: deltatw0
+  REAL, DIMENSION (klon, klev)                          :: deltaqw0
+  REAL, DIMENSION (klon, klev)                          :: tenv, qe
+!!  REAL, DIMENSION (klon)                                :: sigmaw1
+
+  ! Variables liees a la dynamique de population 1
+  REAL, DIMENSION(klon)                                 :: act
+  REAL, DIMENSION(klon)                                 :: rad_wk, tau_wk_inv
+  REAL, DIMENSION(klon)                                 :: f_shear
+  REAL, DIMENSION(klon)                                 :: drdt
+  
+  ! Variables liees a la dynamique de population 2
+  REAL, DIMENSION(klon)                                 :: cont_fact  
+  
+!!  REAL, DIMENSION(klon)                                 :: d_sig_gen, d_sig_death, d_sig_col
+  REAL, DIMENSION(klon)                                 :: wape1_act, wape2_act
+  LOGICAL, DIMENSION (klon)                             :: kill_wake
+  REAL                                                  :: drdt_pos
+  REAL                                                  :: tau_wk_inv_min
+  ! Some components of the tendencies of state variables  
+  REAL, DIMENSION (klon)                                :: d_sig_gen2, d_sig_death2, d_sig_col2, d_sig_spread2, d_sig_bnd2
+  REAL, DIMENSION (klon)                                :: d_dens_gen2, d_dens_death2, d_dens_col2, d_dens_bnd2
+  REAL, DIMENSION (klon)                                :: d_adens_death2, d_adens_icol2, d_adens_acol2, d_adens_bnd2
+
+  ! Variables pour les GW
+  REAL, DIMENSION (klon)                                :: ll
+  REAL, DIMENSION (klon, klev)                          :: n2
+  REAL, DIMENSION (klon, klev)                          :: cgw
+  REAL, DIMENSION (klon, klev)                          :: tgw
+
+  ! Variables liees au calcul de hw
+  REAL, DIMENSION (klon)                                :: ptop_provis, ptop, ptop_new
+  REAL, DIMENSION (klon)                                :: sum_dth
+  REAL, DIMENSION (klon)                                :: dthmin
+  REAL, DIMENSION (klon)                                :: z, dz, hw0
+  INTEGER, DIMENSION (klon)                             :: ktop, kupper
+
+  ! Variables liees au test de la forme triangulaire du profil de Delta_theta
+  REAL, DIMENSION (klon)                                :: sum_half_dth
+  REAL, DIMENSION (klon)                                :: dz_half
+
+  ! Sub-timestep tendencies and related variables
+  REAL, DIMENSION (klon, klev)                          :: d_deltatw, d_deltaqw
+  REAL, DIMENSION (klon, klev)                          :: d_tenv, d_qe
+  REAL, DIMENSION (klon)                                :: d_awdens, d_wdens, d_sigmaw 
+  REAL, DIMENSION (klon)                                :: d_sig_gen, d_sig_death, d_sig_col, d_sig_spread, d_sig_bnd
+  REAL, DIMENSION (klon)                                :: d_dens_gen, d_dens_death, d_dens_col, d_dens_bnd
+  REAL, DIMENSION (klon)                                :: d_adens_death, d_adens_icol, d_adens_acol, d_adens_bnd
+  REAL, DIMENSION (klon)                                :: alpha, alpha_tot
+  REAL, DIMENSION (klon)                                :: q0_min, q1_min
+  LOGICAL, DIMENSION (klon)                             :: wk_adv, ok_qx_qw
+
+  ! Autres variables internes
+  INTEGER                                               ::isubstep, k, i, igout
+
+  REAL                                                  :: sigmaw_targ
+  REAL                                                  :: wdens_targ
+  REAL                                                  :: d_sigmaw_targ
+  REAL                                                  :: d_wdens_targ
+
+  REAL, DIMENSION (klon)                                :: sum_thu, sum_tu, sum_qu, sum_thvu
+  REAL, DIMENSION (klon)                                :: sum_dq, sum_rho
+  REAL, DIMENSION (klon)                                :: sum_dtdwn, sum_dqdwn
+  REAL, DIMENSION (klon)                                :: av_thu, av_tu, av_qu, av_thvu
+  REAL, DIMENSION (klon)                                :: av_dth, av_dq, av_rho
+  REAL, DIMENSION (klon)                                :: av_dtdwn, av_dqdwn
+
+  REAL, DIMENSION (klon, klev)                          :: rho, rhow
+  REAL, DIMENSION (klon, klev+1)                        :: rhoh
+  REAL, DIMENSION (klon, klev)                          :: rhow_moyen
+  REAL, DIMENSION (klon, klev)                          :: zh
+  REAL, DIMENSION (klon, klev+1)                        :: zhh
+  REAL, DIMENSION (klon, klev)                          :: epaisseur1, epaisseur2
+
+  REAL, DIMENSION (klon, klev)                          :: the, thu
+
+  REAL, DIMENSION (klon, klev)                          :: omgbw
+  REAL, DIMENSION (klon)                                :: pupper
+  REAL, DIMENSION (klon)                                :: omgtop
+  REAL, DIMENSION (klon, klev)                          :: dp_omgbw
+  REAL, DIMENSION (klon)                                :: ztop, dztop
+  REAL, DIMENSION (klon, klev)                          :: alpha_up
+
+  REAL, DIMENSION (klon)                                :: rre1, rre2
+  REAL                                                  :: rrd1, rrd2
+  REAL, DIMENSION (klon, klev)                          :: th1, th2, q1, q2
+  REAL, DIMENSION (klon, klev)                          :: d_th1, d_th2, d_dth
+  REAL, DIMENSION (klon, klev)                          :: d_q1, d_q2, d_dq
+  REAL, DIMENSION (klon, klev)                          :: omgbdq
+
+  REAL, DIMENSION (klon)                                :: ff, gg
+  REAL, DIMENSION (klon)                                :: wape2, cstar2, heff
+                                                        
+  REAL, DIMENSION (klon, klev)                          :: crep
+                                                        
+  REAL, DIMENSION (klon, klev)                          :: ppi
+
+  ! cc nrlmd
+  REAL, DIMENSION (klon)                                :: death_rate
+!!  REAL, DIMENSION (klon)                                :: nat_rate
+  REAL, DIMENSION (klon, klev)                          :: entr
+  REAL, DIMENSION (klon, klev)                          :: detr
+
+  REAL, DIMENSION(klon)                                 :: sigmaw_in             ! pour les prints
+  REAL, DIMENSION(klon)                                 :: awdens_in, wdens_in   ! pour les prints
+
+  ! -------------------------------------------------------------------------
+  ! Initialisations
+  ! -------------------------------------------------------------------------
+  ! ALON = 3.e5
+  ! alon = 1.E6
+
+  !  Provisionnal; to be suppressed when f_shear is parameterized
+  f_shear(:) = 1.       ! 0. for strong shear, 1. for weak shear
+
+
+  ! Configuration de coefgw,stark,wdens (22/02/06 by YU Jingmei)
+
+  ! coefgw : Coefficient pour les ondes de gravite
+  ! stark : Coefficient k dans Cstar=k*sqrt(2*WAPE)
+  ! wdens : Densite surfacique de poche froide
+  ! -------------------------------------------------------------------------
+
+  ! cc nrlmd      coefgw=10
+  ! coefgw=1
+  ! wdens0 = 1.0/(alon**2)
+  ! cc nrlmd      wdens = 1.0/(alon**2)
+  ! cc nrlmd      stark = 0.50
+  ! CRtest
+  ! cc nrlmd      alpk=0.1
+  ! alpk = 1.0
+  ! alpk = 0.5
+  ! alpk = 0.05
+!print *,'XXXX dtime input ', dtime
+ igout = klon/2+1/klon
+
+ IF (iflag_wk_pop_dyn == 0) THEN
+  ! Initialisation de toutes des densites a wdens_ref.
+  ! Les densites peuvent evoluer si les poches debordent
+  ! (voir au tout debut de la boucle sur les substeps)
+  !jyg<
+  !!  wdens(:) = wdens_ref
+   DO i = 1,klon
+     wdens(i) = wdens_ref(znatsurf(i)+1)
+   ENDDO 
+  !>jyg
+ ENDIF  ! (iflag_wk_pop_dyn == 0)
+
+  ! print*,'stark',stark
+  ! print*,'alpk',alpk
+  ! print*,'wdens',wdens
+  ! print*,'coefgw',coefgw
+  ! cc
+  ! Minimum value for |T_wake - T_undist|. Used for wake top definition
+  ! -------------------------------------------------------------------------
+
+  delta_t_min = 0.2
+
+  ! 1. - Save initial values, initialize tendencies, initialize output fields
+  ! ------------------------------------------------------------------------
+
+!jyg<
+!!  DO k = 1, klev
+!!    DO i = 1, klon
+!!      ppi(i, k) = pi(i, k)
+!!      deltatw0(i, k) = deltatw(i, k)
+!!      deltaqw0(i, k) = deltaqw(i, k)
+!!      tenv(i, k) = tenv0(i, k)
+!!      qe(i, k) = qe0(i, k)
+!!      dtls(i, k) = 0.
+!!      dqls(i, k) = 0.
+!!      d_deltat_gw(i, k) = 0.
+!!      d_tenv(i, k) = 0.
+!!      d_qe(i, k) = 0.
+!!      d_deltatw(i, k) = 0.
+!!      d_deltaqw(i, k) = 0.
+!!      ! IM 060508 beg
+!!      d_deltatw2(i, k) = 0.
+!!      d_deltaqw2(i, k) = 0.
+!!      ! IM 060508 end
+!!    END DO
+!!  END DO
+      ppi(:,:) = pi(:,:)
+      deltatw0(:,:) = deltatw(:,:)
+      deltaqw0(:,:) = deltaqw(:,:)
+      tenv(:,:) = tenv0(:,:)
+      qe(:,:) = qe0(:,:)
+      dtls(:,:) = 0.
+      dqls(:,:) = 0.
+      d_deltat_gw(:,:) = 0.
+      d_tenv(:,:) = 0.
+      d_qe(:,:) = 0.
+      d_deltatw(:,:) = 0.
+      d_deltaqw(:,:) = 0.
+      d_deltatw2(:,:) = 0.
+      d_deltaqw2(:,:) = 0.
+
+      IF (iflag_wk_act == 0) THEN
+        act(:) = 0.
+      ELSEIF (iflag_wk_act == 1) THEN
+        act(:) = 1.
+      ENDIF
+
+!!  DO i = 1, klon
+!!   sigmaw_in(i) = sigmaw(i)
+!!  END DO
+   sigmaw_in(:) = sigmaw(:)
+!>jyg
+!
+  IF (iflag_wk_pop_dyn >= 1) THEN
+    awdens_in(:) = awdens(:)
+    wdens_in(:) = wdens(:)
+!!    wdens(:) = wdens(:) + wgen(:)*dtime
+!!    d_wdens2(:) = wgen(:)*dtime
+!!  ELSE
+  ENDIF  ! (iflag_wk_pop_dyn >= 1)
+
+
+  ! sigmaw1=sigmaw
+  ! IF (sigd_con.GT.sigmaw1) THEN
+  ! print*, 'sigmaw,sigd_con', sigmaw, sigd_con
+  ! ENDIF
+  IF (iflag_wk_pop_dyn >= 1) THEN
+    DO i = 1, klon
+      d_dens_gen2(i)   = 0.
+      d_dens_death2(i) = 0.
+      d_dens_col2(i)   = 0.
+      d_awdens2(i) = 0.
+!
+      wdens_targ = max(wdens(i),wdensmin)
+      d_dens_bnd2(i) = wdens_targ - wdens(i)
+      d_wdens2(i) = wdens_targ - wdens(i)
+      wdens(i) = wdens_targ
+    END DO
+    IF (iflag_wk_pop_dyn == 2) THEN
+       DO i = 1, klon  
+          d_adens_death2(i) = 0.
+          d_adens_icol2(i) = 0.
+          d_adens_acol2(i) = 0.
+!      
+          wdens_targ = min(max(awdens(i),0.),wdens(i))
+          d_adens_bnd2(i) = wdens_targ - awdens(i)
+          d_awdens2(i) = wdens_targ - awdens(i)
+          awdens(i) = wdens_targ
+       END DO
+    ENDIF ! (iflag_wk_pop_dyn == 2)
+  ELSE  
+    DO i = 1, klon
+      d_awdens2(i) = 0.
+      d_wdens2(i) = 0.
+    END DO
+  ENDIF  ! (iflag_wk_pop_dyn >= 1)
+!
+  DO i = 1, klon
+    ! c      sigmaw(i) = amax1(sigmaw(i),sigd_con(i))
+!jyg<
+!!    sigmaw(i) = amax1(sigmaw(i), sigmad)
+!!    sigmaw(i) = amin1(sigmaw(i), 0.99)
+    d_sig_gen2(i)   = 0.
+    d_sig_death2(i) = 0.
+    d_sig_col2(i)   = 0.
+    d_sig_spread2(i)= 0.
+    sigmaw_targ = min(max(sigmaw(i), sigmad),0.99)
+    d_sig_bnd2(i) = sigmaw_targ - sigmaw(i)
+    d_sigmaw2(i) = sigmaw_targ - sigmaw(i)
+!  print *,'XXXX1 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
+    sigmaw(i) = sigmaw_targ
+!>jyg
+  END DO
+
+  wape(:) = 0.
+  wape2(:) = 0.
+  d_sigmaw(:) = 0.
+  ktopw(:) = 0
+!
+!<jyg
+dth(:,:) = 0.
+tu(:,:) = 0.
+qu(:,:) = 0.
+dtke(:,:) = 0.
+dqke(:,:) = 0.
+wkspread(:,:) = 0.
+omgbdth(:,:) = 0.
+omg(:,:) = 0.
+dp_omgb(:,:) = 0.
+dp_deltomg(:,:) = 0.
+hw(:) = 0.
+wape(:) = 0.
+fip(:) = 0.
+gfl(:) = 0.
+cstar(:) = 0.
+ktopw(:) = 0
+!
+!  Vertical advection local variables
+omgbw(:,:) = 0.
+omgtop(:) = 0
+dp_omgbw(:,:) = 0.
+omgbdq(:,:) = 0.
+
+!>jyg
+!
+  IF (prt_level>=10) THEN
+    PRINT *, 'wake-1, sigmaw(igout) ', sigmaw(igout)
+    PRINT *, 'wake-1, deltatw(igout,k) ', (k,deltatw(igout,k), k=1,klev)
+    PRINT *, 'wake-1, deltaqw(igout,k) ', (k,deltaqw(igout,k), k=1,klev)
+    PRINT *, 'wake-1, dowwdraughts, amdwn(igout,k) ', (k,amdwn(igout,k), k=1,klev)
+    PRINT *, 'wake-1, dowwdraughts, dtdwn(igout,k) ', (k,dtdwn(igout,k), k=1,klev)
+    PRINT *, 'wake-1, dowwdraughts, dqdwn(igout,k) ', (k,dqdwn(igout,k), k=1,klev)
+    PRINT *, 'wake-1, updraughts, amup(igout,k) ', (k,amup(igout,k), k=1,klev)
+    PRINT *, 'wake-1, updraughts, dta(igout,k) ', (k,dta(igout,k), k=1,klev)
+    PRINT *, 'wake-1, updraughts, dqa(igout,k) ', (k,dqa(igout,k), k=1,klev)
+  ENDIF
+
+  ! 2. - Prognostic part
+  ! --------------------
+
+
+  ! 2.1 - Undisturbed area and Wake integrals
+  ! ---------------------------------------------------------
+
+  DO i = 1, klon
+    z(i) = 0.
+    ktop(i) = 0
+    kupper(i) = 0
+    sum_thu(i) = 0.
+    sum_tu(i) = 0.
+    sum_qu(i) = 0.
+    sum_thvu(i) = 0.
+    sum_dth(i) = 0.
+    sum_dq(i) = 0.
+    sum_rho(i) = 0.
+    sum_dtdwn(i) = 0.
+    sum_dqdwn(i) = 0.
+
+    av_thu(i) = 0.
+    av_tu(i) = 0.
+    av_qu(i) = 0.
+    av_thvu(i) = 0.
+    av_dth(i) = 0.
+    av_dq(i) = 0.
+    av_rho(i) = 0.
+    av_dtdwn(i) = 0.
+    av_dqdwn(i) = 0.
+  END DO
+
+  ! Distance between wakes
+  DO i = 1, klon
+    ll(i) = (1-sqrt(sigmaw(i)))/sqrt(wdens(i))
+  END DO
+  ! Potential temperatures and humidity
+  ! ----------------------------------------------------------
+  DO k = 1, klev
+    DO i = 1, klon
+      ! write(*,*)'wake 1',i,k,RD,tenv(i,k)
+      rho(i, k) = p(i, k)/(RD*tenv(i,k))
+      ! write(*,*)'wake 2',rho(i,k)
+      IF (k==1) THEN
+        ! write(*,*)'wake 3',i,k,rd,tenv(i,k)
+        rhoh(i, k) = ph(i, k)/(RD*tenv(i,k))
+        ! write(*,*)'wake 4',i,k,rd,tenv(i,k)
+        zhh(i, k) = 0
+      ELSE
+        ! write(*,*)'wake 5',rd,(tenv(i,k)+tenv(i,k-1))
+        rhoh(i, k) = ph(i, k)*2./(RD*(tenv(i,k)+tenv(i,k-1)))
+        ! write(*,*)'wake 6',(-rhoh(i,k)*RG)+zhh(i,k-1)
+        zhh(i, k) = (ph(i,k)-ph(i,k-1))/(-rhoh(i,k)*RG) + zhh(i, k-1)
+      END IF
+      ! write(*,*)'wake 7',ppi(i,k)
+      the(i, k) = tenv(i, k)/ppi(i, k)
+      thu(i, k) = (tenv(i,k)-deltatw(i,k)*sigmaw(i))/ppi(i, k)
+      tu(i, k) = tenv(i, k) - deltatw(i, k)*sigmaw(i)
+      qu(i, k) = qe(i, k) - deltaqw(i, k)*sigmaw(i)
+      ! write(*,*)'wake 8',(RD*(tenv(i,k)+deltatw(i,k)))
+      rhow(i, k) = p(i, k)/(RD*(tenv(i,k)+deltatw(i,k)))
+      dth(i, k) = deltatw(i, k)/ppi(i, k)
+    END DO
+  END DO
+
+  DO k = 1, klev - 1
+    DO i = 1, klon
+      IF (k==1) THEN
+        n2(i, k) = 0
+      ELSE
+        n2(i, k) = amax1(0., -RG**2/the(i,k)*rho(i,k)*(the(i,k+1)-the(i,k-1))/ &
+                             (p(i,k+1)-p(i,k-1)))
+      END IF
+      zh(i, k) = (zhh(i,k)+zhh(i,k+1))/2
+
+      cgw(i, k) = sqrt(n2(i,k))*zh(i, k)
+      tgw(i, k) = coefgw*cgw(i, k)/ll(i)
+    END DO
+  END DO
+
+  DO i = 1, klon
+    n2(i, klev) = 0
+    zh(i, klev) = 0
+    cgw(i, klev) = 0
+    tgw(i, klev) = 0
+  END DO
+
+  ! Calcul de la masse volumique moyenne de la colonne   (bdlmd)
+  ! -----------------------------------------------------------------
+
+  DO k = 1, klev
+    DO i = 1, klon
+      epaisseur1(i, k) = 0.
+      epaisseur2(i, k) = 0.
+    END DO
+  END DO
+
+  DO i = 1, klon
+    epaisseur1(i, 1) = -(ph(i,2)-ph(i,1))/(rho(i,1)*RG) + 1.
+    epaisseur2(i, 1) = -(ph(i,2)-ph(i,1))/(rho(i,1)*RG) + 1.
+    rhow_moyen(i, 1) = rhow(i, 1)
+  END DO
+
+  DO k = 2, klev
+    DO i = 1, klon
+      epaisseur1(i, k) = -(ph(i,k+1)-ph(i,k))/(rho(i,k)*RG) + 1.
+      epaisseur2(i, k) = epaisseur2(i, k-1) + epaisseur1(i, k)
+      rhow_moyen(i, k) = (rhow_moyen(i,k-1)*epaisseur2(i,k-1)+rhow(i,k)* &
+        epaisseur1(i,k))/epaisseur2(i, k)
+    END DO
+  END DO
+
+  
+  ! Choose an integration bound well above wake top
+  ! -----------------------------------------------------------------
+
+  ! Determine Wake top pressure (Ptop) from buoyancy integral
+  ! --------------------------------------------------------
+
+  ! -1/ Pressure of the level where dth becomes less than delta_t_min.
+
+  DO i = 1, klon
+    ptop_provis(i) = ph(i, 1)
+  END DO
+  DO k = 2, klev
+    DO i = 1, klon
+
+      ! IM v3JYG; ptop_provis(i).LT. ph(i,1)
+
+      IF (dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min .AND. &
+          ptop_provis(i)==ph(i,1)) THEN
+        ptop_provis(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)- &
+                          (dth(i,k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
+      END IF
+    END DO
+  END DO
+
+  ! -2/ dth integral
+
+  DO i = 1, klon
+    sum_dth(i) = 0.
+    dthmin(i) = -delta_t_min
+    z(i) = 0.
+  END DO
+
+  DO k = 1, klev
+    DO i = 1, klon
+      dz(i) = -(amax1(ph(i,k+1),ptop_provis(i))-ph(i,k))/(rho(i,k)*RG)
+      IF (dz(i)>0) THEN
+        z(i) = z(i) + dz(i)
+        sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
+        dthmin(i) = amin1(dthmin(i), dth(i,k))
+      END IF
+    END DO
+  END DO
+
+  ! -3/ height of triangle with area= sum_dth and base = dthmin
+
+  DO i = 1, klon
+    hw0(i) = 2.*sum_dth(i)/amin1(dthmin(i), -0.5)
+    hw0(i) = amax1(hwmin, hw0(i))
+  END DO
+
+  ! -4/ now, get Ptop
+
+  DO i = 1, klon
+    z(i) = 0.
+    ptop(i) = ph(i, 1)
+  END DO
+
+  DO k = 1, klev
+    DO i = 1, klon
+      dz(i) = amin1(-(ph(i,k+1)-ph(i,k))/(rho(i,k)*RG), hw0(i)-z(i))
+      IF (dz(i)>0) THEN
+        z(i) = z(i) + dz(i)
+        ptop(i) = ph(i, k) - rho(i, k)*RG*dz(i)
+      END IF
+    END DO
+  END DO
+
+  IF (prt_level>=10) THEN
+    PRINT *, 'wake-2, ptop_provis(igout), ptop(igout) ', ptop_provis(igout), ptop(igout)
+  ENDIF
+
+
+  ! -5/ Determination de ktop et kupper
+
+  CALL pkupper (klon, klev, ptop, ph, pupper, kupper)
+  
+  DO k = klev, 1, -1
+    DO i = 1, klon
+      IF (ph(i,k+1)<ptop(i)) ktop(i) = k
+    END DO
+  END DO
+  !print*, 'ptop, pupper, ktop, kupper', ptop, pupper, ktop, kupper
+ 
+
+
+  ! -6/ Correct ktop and ptop
+
+  DO i = 1, klon
+    ptop_new(i) = ptop(i)
+  END DO
+  DO k = klev, 2, -1
+    DO i = 1, klon
+      IF (k<=ktop(i) .AND. ptop_new(i)==ptop(i) .AND. &
+          dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN
+        ptop_new(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)-(dth(i, &
+          k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
+      END IF
+    END DO
+  END DO
+
+  DO i = 1, klon
+    ptop(i) = ptop_new(i)
+  END DO
+
+  DO k = klev, 1, -1
+    DO i = 1, klon
+      IF (ph(i,k+1)<ptop(i)) ktop(i) = k
+    END DO
+  END DO
+
+  IF (prt_level>=10) THEN
+    PRINT *, 'wake-3, ktop(igout), kupper(igout) ', ktop(igout), kupper(igout)
+  ENDIF
+
+  ! -5/ Set deltatw & deltaqw to 0 above kupper
+
+  DO k = 1, klev
+    DO i = 1, klon
+      IF (k>=kupper(i)) THEN
+        deltatw(i, k) = 0.
+        deltaqw(i, k) = 0.
+        d_deltatw2(i,k) = -deltatw0(i,k)
+        d_deltaqw2(i,k) = -deltaqw0(i,k)
+      END IF
+    END DO
+  END DO
+
+
+  ! Vertical gradient of LS omega
+
+  DO k = 1, klev
+    DO i = 1, klon
+      IF (k<=kupper(i)) THEN
+        dp_omgb(i, k) = (omgb(i,k+1)-omgb(i,k))/(ph(i,k+1)-ph(i,k))
+      END IF
+    END DO
+  END DO
+
+  ! Integrals (and wake top level number)
+  ! --------------------------------------
+
+  ! Initialize sum_thvu to 1st level virt. pot. temp.
+
+  DO i = 1, klon
+    z(i) = 1.
+    dz(i) = 1.
+    sum_thvu(i) = thu(i, 1)*(1.+epsim1*qu(i,1))*dz(i)
+    sum_dth(i) = 0.
+  END DO
+
+  DO k = 1, klev
+    DO i = 1, klon
+      dz(i) = -(amax1(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*RG)
+      IF (dz(i)>0) THEN
+        z(i) = z(i) + dz(i)
+        sum_thu(i) = sum_thu(i) + thu(i, k)*dz(i)
+        sum_tu(i) = sum_tu(i) + tu(i, k)*dz(i)
+        sum_qu(i) = sum_qu(i) + qu(i, k)*dz(i)
+        sum_thvu(i) = sum_thvu(i) + thu(i, k)*(1.+epsim1*qu(i,k))*dz(i)
+        sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
+        sum_dq(i) = sum_dq(i) + deltaqw(i, k)*dz(i)
+        sum_rho(i) = sum_rho(i) + rhow(i, k)*dz(i)
+        sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i, k)*dz(i)
+        sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i, k)*dz(i)
+      END IF
+    END DO
+  END DO
+
+  DO i = 1, klon
+    hw0(i) = z(i)
+  END DO
+
+
+  ! 2.1 - WAPE and mean forcing computation
+  ! ---------------------------------------
+
+  ! ---------------------------------------
+
+  ! Means
+
+  DO i = 1, klon
+    av_thu(i) = sum_thu(i)/hw0(i)
+    av_tu(i) = sum_tu(i)/hw0(i)
+    av_qu(i) = sum_qu(i)/hw0(i)
+    av_thvu(i) = sum_thvu(i)/hw0(i)
+    ! av_thve = sum_thve/hw0
+    av_dth(i) = sum_dth(i)/hw0(i)
+    av_dq(i) = sum_dq(i)/hw0(i)
+    av_rho(i) = sum_rho(i)/hw0(i)
+    av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
+    av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
+
+    wape(i) = -RG*hw0(i)*(av_dth(i)+ &
+        epsim1*(av_thu(i)*av_dq(i)+av_dth(i)*av_qu(i)+av_dth(i)*av_dq(i)))/av_thvu(i)
+
+  END DO
+
+  ! 2.2 Prognostic variable update
+  ! ------------------------------
+
+  ! Filter out bad wakes
+
+  DO k = 1, klev
+    DO i = 1, klon
+      IF (wape(i)<0.) THEN
+        deltatw(i, k) = 0.
+        deltaqw(i, k) = 0.
+        dth(i, k) = 0.
+        d_deltatw2(i,k) = -deltatw0(i,k)
+        d_deltaqw2(i,k) = -deltaqw0(i,k)
+      END IF
+    END DO
+  END DO
+
+  DO i = 1, klon
+    IF (wape(i)<0.) THEN
+      wape(i) = 0.
+      cstar(i) = 0.
+      hw(i) = hwmin
+!jyg<
+!!      sigmaw(i) = amax1(sigmad, sigd_con(i))
+      sigmaw_targ = max(sigmad, sigd_con(i))
+      d_sig_bnd2(i) = d_sig_bnd2(i) + sigmaw_targ - sigmaw(i)
+      d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
+!  print *,'XXXX2 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
+      sigmaw(i) = sigmaw_targ
+!>jyg
+      fip(i) = 0.
+      gwake(i) = .FALSE.
+    ELSE
+      hw(i) = hw0(i)
+      cstar(i) = stark*sqrt(2.*wape(i))
+      gwake(i) = .TRUE.
+    END IF
+  END DO
+
+
+  ! Check qx and qw positivity
+  ! --------------------------
+  DO i = 1, klon
+    q0_min(i) = min((qe(i,1)-sigmaw(i)*deltaqw(i,1)),  &
+                    (qe(i,1)+(1.-sigmaw(i))*deltaqw(i,1)))
+  END DO
+  DO k = 2, klev
+    DO i = 1, klon
+      q1_min(i) = min((qe(i,k)-sigmaw(i)*deltaqw(i,k)), &
+                      (qe(i,k)+(1.-sigmaw(i))*deltaqw(i,k)))
+      IF (q1_min(i)<=q0_min(i)) THEN
+        q0_min(i) = q1_min(i)
+      END IF
+    END DO
+  END DO
+
+  DO i = 1, klon
+    ok_qx_qw(i) = q0_min(i) >= 0.
+    alpha(i) = 1.
+    alpha_tot(i) = 1.
+  END DO
+
+  IF (prt_level>=10) THEN
+    PRINT *, 'wake-4, sigmaw(igout), cstar(igout), wape(igout), ktop(igout) ', &
+                      sigmaw(igout), cstar(igout), wape(igout), ktop(igout)
+  ENDIF
+
+
+  ! C -----------------------------------------------------------------
+  ! Sub-time-stepping
+  ! -----------------
+
+  nsub = 10
+  dtimesub = dtime/nsub
+
+
+  
+  ! ------------------------------------------------------------
+  DO isubstep = 1, nsub
+    ! ------------------------------------------------------------
+  CALL pkupper (klon, klev, ptop, ph, pupper, kupper)
+ 
+    !print*, 'ptop, pupper, ktop, kupper', ptop, pupper, ktop, kupper
+
+    ! wk_adv is the logical flag enabling wake evolution in the time advance
+    ! loop
+    DO i = 1, klon
+      wk_adv(i) = ok_qx_qw(i) .AND. alpha(i) >= 1.
+    END DO
+    IF (prt_level>=10) THEN
+      PRINT *, 'wake-4.1, isubstep,wk_adv(igout),cstar(igout),wape(igout), ptop(igout) ', &
+                          isubstep,wk_adv(igout),cstar(igout),wape(igout), ptop(igout)
+     
+    ENDIF
+
+    ! cc nrlmd   Ajout d'un recalcul de wdens dans le cas d'un entrainement
+    ! negatif de ktop a kupper --------
+    ! cc           On calcule pour cela une densite wdens0 pour laquelle on
+    ! aurait un entrainement nul ---
+    !jyg<
+    ! Dans la configuration avec wdens prognostique, il s'agit d'un cas ou 
+    ! les poches sont insuffisantes pour accueillir tout le flux de masse 
+    ! des descentes unsaturees. Nous faisons alors l'hypothese que la 
+    ! convection profonde cree directement de nouvelles poches, sans passer 
+    ! par les thermiques. La nouvelle valeur de wdens est alors imposee.
+
+    DO i = 1, klon
+      ! c       print *,' isubstep,wk_adv(i),cstar(i),wape(i) ',
+      ! c     $           isubstep,wk_adv(i),cstar(i),wape(i)
+      IF (wk_adv(i) .AND. cstar(i)>0.01) THEN
+        IF ( iflag_wk_profile == 0 ) THEN
+           omg(i, kupper(i)+1)=-RG*amdwn(i, kupper(i)+1)/sigmaw(i) + &
+                               RG*amup(i, kupper(i)+1)/(1.-sigmaw(i))
+        ELSE
+           omg(i, kupper(i)+1)=0.
+        ENDIF
+        wdens0 = (sigmaw(i)/(4.*3.14))* &
+          ((1.-sigmaw(i))*omg(i,kupper(i)+1)/((ph(i,1)-pupper(i))*cstar(i)))**(2)
+        IF (prt_level >= 10) THEN
+             print*,'omg(i,kupper(i)+1),wdens0,wdens(i),cstar(i), ph(i,1)-pupper(i)', &
+                     omg(i,kupper(i)+1),wdens0,wdens(i),cstar(i), ph(i,1)-pupper(i)
+        ENDIF
+        IF (wdens(i)<=wdens0*1.1) THEN
+          IF (iflag_wk_pop_dyn >= 1) THEN
+             d_dens_bnd2(i) = d_dens_bnd2(i) + wdens0 - wdens(i)
+             d_wdens2(i) = d_wdens2(i) + wdens0 - wdens(i)
+          ENDIF
+          wdens(i) = wdens0
+        END IF
+      END IF
+    END DO
+
+    IF (ok_bug_gfl) THEN
+!!--------------------------------------------------------
+!!Bug : computing gfl and rad_wk before changing sigmaw
+!!--------------------------------------------------------
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          gfl(i) = 2.*sqrt(3.14*wdens(i)*sigmaw(i))
+          rad_wk(i) = sqrt(sigmaw(i)/(3.14*wdens(i)))
+        END IF
+      END DO
+    ENDIF   ! (ok_bug_gfl)
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        sigmaw_targ = min(sigmaw(i), sigmaw_max)
+        d_sig_bnd2(i) = d_sig_bnd2(i) + sigmaw_targ - sigmaw(i)
+        d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
+        sigmaw(i) = sigmaw_targ
+      END IF
+    END DO
+
+    IF (.NOT.ok_bug_gfl) THEN
+!!--------------------------------------------------------
+!!Fix : computing gfl and rad_wk after changing sigmaw
+!!--------------------------------------------------------
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          gfl(i) = 2.*sqrt(3.14*wdens(i)*sigmaw(i))
+          rad_wk(i) = sqrt(sigmaw(i)/(3.14*wdens(i)))
+        END IF
+      END DO
+    ENDIF   ! (.NOT.ok_bug_gfl)
+
+    IF (iflag_wk_pop_dyn == 1) THEN
+  
+     CALL wake_popdyn_1 (klon, klev, dtime, cstar, tau_wk_inv, wgen, wdens, awdens, sigmaw, &
+                  dtimesub, gfl, rad_wk, f_shear, drdt_pos, &
+                  d_awdens, d_wdens, d_sigmaw, &
+                  iflag_wk_act, wk_adv, cin, wape, &
+                  drdt, &
+                  d_dens_gen, d_dens_death, d_dens_col, d_dens_bnd, &
+                  d_sig_gen, d_sig_death, d_sig_col, d_sig_spread, d_sig_bnd, &
+                  d_wdens_targ, d_sigmaw_targ)
+                      
+!    The variable "death_rate" is significant only when iflag_wk_pop_dyn = 0.
+!    Here, it has to be set to zero.
+      death_rate(:) = 0.
+    
+    ELSEIF (iflag_wk_pop_dyn == 2) THEN
+     CALL wake_popdyn_2 ( klon, klev, wk_adv, dtimesub, wgen, &
+                             sigmaw, wdens, awdens, &   !! states variables
+                             gfl, cstar, cin, wape, rad_wk, &
+                             d_sigmaw, d_wdens, d_awdens, &  !! tendences                              
+                             cont_fact, &
+                             d_sig_gen, d_sig_death, d_sig_col, d_sig_spread, d_sig_bnd, &
+                             d_dens_gen, d_dens_death, d_dens_col, d_dens_bnd, &
+                             d_adens_death, d_adens_icol, d_adens_acol, d_adens_bnd )
+     death_rate(:) = 0.
+sigmaw=sigmaw-d_sigmaw
+wdens=wdens-d_wdens
+awdens=awdens-d_awdens
+   
+    ELSEIF (iflag_wk_pop_dyn == 0) THEN
+    
+    ! cc nrlmd
+
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          ! cc nrlmd          Introduction du taux de mortalite des poches et
+          ! test sur sigmaw_max=0.4
+          ! cc         d_sigmaw(i) = gfl(i)*Cstar(i)*dtimesub
+          IF (sigmaw(i)>=sigmaw_max) THEN
+            death_rate(i) = gfl(i)*cstar(i)/sigmaw(i)
+          ELSE
+            death_rate(i) = 0.
+          END IF
+    
+          d_sigmaw(i) = gfl(i)*cstar(i)*dtimesub - death_rate(i)*sigmaw(i)* &
+            dtimesub
+          ! $              - nat_rate(i)*sigmaw(i)*dtimesub
+          ! c        print*, 'd_sigmaw(i),sigmaw(i),gfl(i),Cstar(i),wape(i),
+          ! c     $  death_rate(i),ktop(i),kupper(i)',
+          ! c     $	         d_sigmaw(i),sigmaw(i),gfl(i),Cstar(i),wape(i),
+          ! c     $  death_rate(i),ktop(i),kupper(i)
+    
+          ! sigmaw(i) =sigmaw(i) + gfl(i)*Cstar(i)*dtimesub
+          ! sigmaw(i) =min(sigmaw(i),0.99)     !!!!!!!!
+          ! wdens = wdens0/(10.*sigmaw)
+          ! sigmaw =max(sigmaw,sigd_con)
+          ! sigmaw =max(sigmaw,sigmad)
+        END IF
+      END DO
+
+    ENDIF   !  (iflag_wk_pop_dyn >= 1)
+
+
+    ! calcul de la difference de vitesse verticale poche - zone non perturbee
+    ! IM 060208 differences par rapport au code initial; init. a 0 dp_deltomg
+    ! IM 060208 et omg sur les niveaux de 1 a klev+1, alors que avant l'on definit
+    ! IM 060208 au niveau k=1...
+    !JYG 161013 Correction : maintenant omg est dimensionne a klev.
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN !!! nrlmd
+          dp_deltomg(i, k) = 0.
+        END IF
+      END DO
+    END DO
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN !!! nrlmd
+          omg(i, k) = 0.
+        END IF
+      END DO
+    END DO
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        z(i) = 0.
+        omg(i, 1) = 0.
+        dp_deltomg(i, 1) = -(gfl(i)*cstar(i))/(sigmaw(i)*(1-sigmaw(i)))
+      END IF
+    END DO
+
+    DO k = 2, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=ktop(i)) THEN
+          dz(i) = -(ph(i,k)-ph(i,k-1))/(rho(i,k-1)*RG)
+          z(i) = z(i) + dz(i)
+          dp_deltomg(i, k) = dp_deltomg(i, 1)
+          omg(i, k) = dp_deltomg(i, 1)*z(i)
+        END IF
+      END DO
+    END DO
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        dztop(i) = -(ptop(i)-ph(i,ktop(i)))/(rho(i,ktop(i))*RG)
+        ztop(i) = z(i) + dztop(i)
+        omgtop(i) = dp_deltomg(i, 1)*ztop(i)
+      END IF
+    END DO
+
+    IF (prt_level>=10) THEN
+      PRINT *, 'wake-4.2, omg(igout,k) ', (k,omg(igout,k), k=1,klev)
+      PRINT *, 'wake-4.2, omgtop(igout), ptop(igout), ktop(igout) ', &
+                          omgtop(igout), ptop(igout), ktop(igout)
+    ENDIF
+
+    ! -----------------
+    ! From m/s to Pa/s
+    ! -----------------
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        omgtop(i) = -rho(i, ktop(i))*RG*omgtop(i)
+        dp_deltomg(i, 1) = omgtop(i)/(ptop(i)-ph(i,1))
+      END IF
+    END DO
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=ktop(i)) THEN
+          omg(i, k) = -rho(i, k)*RG*omg(i, k)
+          dp_deltomg(i, k) = dp_deltomg(i, 1)
+        END IF
+      END DO
+    END DO
+
+    ! raccordement lineaire de omg de ptop a pupper
+
+    DO i = 1, klon
+      IF (wk_adv(i) .AND. kupper(i)>ktop(i)) THEN
+        IF ( iflag_wk_profile == 0 ) THEN
+           omg(i, kupper(i)+1) =-RG*amdwn(i, kupper(i)+1)/sigmaw(i) + &
+          RG*amup(i, kupper(i)+1)/(1.-sigmaw(i))
+        ELSE
+           omg(i, kupper(i)+1) = 0.
+        ENDIF
+        dp_deltomg(i, kupper(i)) = (omgtop(i)-omg(i,kupper(i)+1))/ &
+          (ptop(i)-pupper(i))
+      END IF
+    END DO
+
+    ! c      DO i=1,klon
+    ! c        print*,'Pente entre 0 et kupper (reference)'
+    ! c     $   	,omg(i,kupper(i)+1)/(pupper(i)-ph(i,1))
+    ! c        print*,'Pente entre ktop et kupper'
+    ! c     $  	,(omg(i,kupper(i)+1)-omgtop(i))/(pupper(i)-ptop(i))
+    ! c      ENDDO
+    ! c
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k>ktop(i) .AND. k<=kupper(i)) THEN
+          dp_deltomg(i, k) = dp_deltomg(i, kupper(i))
+          omg(i, k) = omgtop(i) + (ph(i,k)-ptop(i))*dp_deltomg(i, kupper(i))
+        END IF
+      END DO
+    END DO
+!!    print *,'omg(igout,k) ', (k,omg(igout,k),k=1,klev)
+    ! cc nrlmd
+    ! c      DO i=1,klon
+    ! c      print*,'deltaw_ktop,deltaw_conv',omgtop(i),omg(i,kupper(i)+1)
+    ! c      END DO
+    ! cc
+
+
+    ! --    Compute wake average vertical velocity omgbw
+
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          omgbw(i, k) = omgb(i, k) + (1.-sigmaw(i))*omg(i, k)
+        END IF
+      END DO
+    END DO
+    ! --    and its vertical gradient dp_omgbw
+
+    DO k = 1, klev-1
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          dp_omgbw(i, k) = (omgbw(i,k+1)-omgbw(i,k))/(ph(i,k+1)-ph(i,k))
+        END IF
+      END DO
+    END DO
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+          dp_omgbw(i, klev) = 0.
+      END IF
+    END DO
+
+    ! --    Upstream coefficients for omgb velocity
+    ! --    (alpha_up(k) is the coefficient of the value at level k)
+    ! --    (1-alpha_up(k) is the coefficient of the value at level k-1)
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          alpha_up(i, k) = 0.
+          IF (omgb(i,k)>0.) alpha_up(i, k) = 1.
+        END IF
+      END DO
+    END DO
+
+    ! Matrix expressing [The,deltatw] from  [Th1,Th2]
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        rre1(i) = 1. - sigmaw(i)
+        rre2(i) = sigmaw(i)
+      END IF
+    END DO
+    rrd1 = -1.
+    rrd2 = 1.
+
+    ! --    Get [Th1,Th2], dth and [q1,q2]
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=kupper(i)+1) THEN
+          dth(i, k) = deltatw(i, k)/ppi(i, k)
+! print *, 'VVVVwake k, the(i,k), dth(i,k), sigmaw(i) ', k, the(i,k), dth(i,k), sigmaw(i)
+          th1(i, k) = the(i, k) - sigmaw(i)*dth(i, k) ! undisturbed area
+          th2(i, k) = the(i, k) + (1.-sigmaw(i))*dth(i, k) ! wake
+          q1(i, k) = qe(i, k) - sigmaw(i)*deltaqw(i, k) ! undisturbed area
+          q2(i, k) = qe(i, k) + (1.-sigmaw(i))*deltaqw(i, k) ! wake
+        END IF
+      END DO
+    END DO
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        d_th1(i, 1) = 0.
+        d_th2(i, 1) = 0.
+        d_dth(i, 1) = 0.
+        d_q1(i, 1) = 0.
+        d_q2(i, 1) = 0.
+        d_dq(i, 1) = 0.
+      END IF
+    END DO
+
+    DO k = 2, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=kupper(i)+1) THEN
+          d_th1(i, k) = th1(i, k-1) - th1(i, k)
+          d_th2(i, k) = th2(i, k-1) - th2(i, k)
+          d_dth(i, k) = dth(i, k-1) - dth(i, k)
+          d_q1(i, k) = q1(i, k-1) - q1(i, k)
+          d_q2(i, k) = q2(i, k-1) - q2(i, k)
+          d_dq(i, k) = deltaqw(i, k-1) - deltaqw(i, k)
+        END IF
+      END DO
+    END DO
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        omgbdth(i, 1) = 0.
+        omgbdq(i, 1) = 0.
+      END IF
+    END DO
+
+    DO k = 2, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=kupper(i)+1) THEN !   loop on interfaces
+          omgbdth(i, k) = omgb(i, k)*(dth(i,k-1)-dth(i,k))
+          omgbdq(i, k) = omgb(i, k)*(deltaqw(i,k-1)-deltaqw(i,k))
+        END IF
+      END DO
+    END DO
+
+!!    IF (prt_level>=10) THEN
+    IF (prt_level>=10 .and. wk_adv(igout)) THEN
+      PRINT *, 'wake-4.3, th1(igout,k) ', (k,th1(igout,k), k=1,kupper(igout))
+      PRINT *, 'wake-4.3, th2(igout,k) ', (k,th2(igout,k), k=1,kupper(igout))
+      PRINT *, 'wake-4.3, dth(igout,k) ', (k,dth(igout,k), k=1,kupper(igout))
+      PRINT *, 'wake-4.3, omgbdth(igout,k) ', (k,omgbdth(igout,k), k=1,kupper(igout))
+    ENDIF
+
+    ! -----------------------------------------------------------------
+    DO k = 1, klev-1
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=kupper(i)-1) THEN
+          ! -----------------------------------------------------------------
+
+          ! Compute redistribution (advective) term
+
+          d_deltatw(i, k) = dtimesub/(ph(i,k)-ph(i,k+1))* &
+            (rrd1*omg(i,k)*sigmaw(i)*d_th1(i,k) - &
+             rrd2*omg(i,k+1)*(1.-sigmaw(i))*d_th2(i,k+1)- &
+             (1.-alpha_up(i,k))*omgbdth(i,k)- &
+             alpha_up(i,k+1)*omgbdth(i,k+1))*ppi(i, k)
+!           print*,'d_deltatw=', k, d_deltatw(i,k)
+
+          d_deltaqw(i, k) = dtimesub/(ph(i,k)-ph(i,k+1))* &
+            (rrd1*omg(i,k)*sigmaw(i)*d_q1(i,k)- &
+             rrd2*omg(i,k+1)*(1.-sigmaw(i))*d_q2(i,k+1)- &
+             (1.-alpha_up(i,k))*omgbdq(i,k)- &
+             alpha_up(i,k+1)*omgbdq(i,k+1))
+!           print*,'d_deltaqw=', k, d_deltaqw(i,k)
+
+          ! and increment large scale tendencies
+
+
+
+
+          ! C
+          ! -----------------------------------------------------------------
+          d_tenv(i, k) = dtimesub*((rre1(i)*omg(i,k)*sigmaw(i)*d_th1(i,k)- &
+                                  rre2(i)*omg(i,k+1)*(1.-sigmaw(i))*d_th2(i,k+1))/ &
+                                 (ph(i,k)-ph(i,k+1)) &
+                                 -sigmaw(i)*(1.-sigmaw(i))*dth(i,k)*(omg(i,k)-omg(i,k+1))/ &
+                                 (ph(i,k)-ph(i,k+1)) )*ppi(i, k)
+
+          d_qe(i, k) = dtimesub*((rre1(i)*omg(i,k)*sigmaw(i)*d_q1(i,k)- &
+                                  rre2(i)*omg(i,k+1)*(1.-sigmaw(i))*d_q2(i,k+1))/ &
+                                 (ph(i,k)-ph(i,k+1)) &
+                                 -sigmaw(i)*(1.-sigmaw(i))*deltaqw(i,k)*(omg(i,k)-omg(i,k+1))/ &
+                                 (ph(i,k)-ph(i,k+1)) )
+        ELSE IF (wk_adv(i) .AND. k==kupper(i)) THEN
+          d_tenv(i, k) = dtimesub*(rre1(i)*omg(i,k)*sigmaw(i)*d_th1(i,k)/(ph(i,k)-ph(i,k+1)))*ppi(i, k)
+
+          d_qe(i, k) = dtimesub*(rre1(i)*omg(i,k)*sigmaw(i)*d_q1(i,k)/(ph(i,k)-ph(i,k+1)))
+
+        END IF
+        ! cc
+      END DO
+    END DO
+    ! ------------------------------------------------------------------
+
+    IF (prt_level>=10) THEN
+      PRINT *, 'wake-4.3, d_deltatw(igout,k) ', (k,d_deltatw(igout,k), k=1,klev)
+      PRINT *, 'wake-4.3, d_deltaqw(igout,k) ', (k,d_deltaqw(igout,k), k=1,klev)
+    ENDIF
+
+    ! Increment state variables
+!jyg<
+    IF (iflag_wk_pop_dyn >= 1) THEN
+      DO k = 1, klev
+        DO i = 1, klon
+          IF (wk_adv(i) .AND. k<=kupper(i)) THEN
+            detr(i,k) = - d_sig_death(i) - d_sig_col(i)      
+            entr(i,k) = d_sig_gen(i)
+          ENDIF
+        ENDDO
+      ENDDO
+      ELSE  ! (iflag_wk_pop_dyn >= 1)
+      DO k = 1, klev
+        DO i = 1, klon
+          IF (wk_adv(i) .AND. k<=kupper(i)) THEN
+            detr(i, k) = 0.
+   
+            entr(i, k) = 0.
+          ENDIF
+        ENDDO
+      ENDDO
+    ENDIF  ! (iflag_wk_pop_dyn >= 1)
+
+    
+
+    DO k = 1, klev
+      DO i = 1, klon
+        ! cc nrlmd       IF( wk_adv(i) .AND. k .LE. kupper(i)-1) THEN
+        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
+          ! cc
+
+
+
+          ! Coefficient de repartition
+
+          crep(i, k) = crep_sol*(ph(i,kupper(i))-ph(i,k))/ &
+            (ph(i,kupper(i))-ph(i,1))
+          crep(i, k) = crep(i, k) + crep_upper*(ph(i,1)-ph(i,k))/ &
+            (p(i,1)-ph(i,kupper(i)))
+
+
+          ! Reintroduce compensating subsidence term.
+
+          ! dtKE(k)=(dtdwn(k)*Crep(k))/sigmaw
+          ! dtKE(k)=dtKE(k)-(dtdwn(k)*(1-Crep(k))+dta(k))
+          ! .                   /(1-sigmaw)
+          ! dqKE(k)=(dqdwn(k)*Crep(k))/sigmaw
+          ! dqKE(k)=dqKE(k)-(dqdwn(k)*(1-Crep(k))+dqa(k))
+          ! .                   /(1-sigmaw)
+
+          ! dtKE(k)=(dtdwn(k)*Crep(k)+(1-Crep(k))*dta(k))/sigmaw
+          ! dtKE(k)=dtKE(k)-(dtdwn(k)*(1-Crep(k))+dta(k)*Crep(k))
+          ! .                   /(1-sigmaw)
+          ! dqKE(k)=(dqdwn(k)*Crep(k)+(1-Crep(k))*dqa(k))/sigmaw
+          ! dqKE(k)=dqKE(k)-(dqdwn(k)*(1-Crep(k))+dqa(k)*Crep(k))
+          ! .                   /(1-sigmaw)
+
+          dtke(i, k) = (dtdwn(i,k)/sigmaw(i)-dta(i,k)/(1.-sigmaw(i)))
+          dqke(i, k) = (dqdwn(i,k)/sigmaw(i)-dqa(i,k)/(1.-sigmaw(i)))
+          ! print*,'dtKE= ',dtKE(i,k),' dqKE= ',dqKE(i,k)
+
+!
+
+          ! cc nrlmd          Prise en compte du taux de mortalite
+          ! cc               Definitions de entr, detr
+!jyg<
+!!            detr(i, k) = 0.
+!!   
+!!            entr(i, k) = detr(i, k) + gfl(i)*cstar(i) + &
+!!              sigmaw(i)*(1.-sigmaw(i))*dp_deltomg(i, k)
+!!
+            entr(i, k) = entr(i,k) + gfl(i)*cstar(i) + &
+                         sigmaw(i)*(1.-sigmaw(i))*dp_deltomg(i, k)   
+!>jyg
+            wkspread(i, k) = (entr(i,k)-detr(i,k))/sigmaw(i)
+
+          ! cc        wkspread(i,k) =
+          ! (1.-sigmaw(i))*dp_deltomg(i,k)+gfl(i)*Cstar(i)/
+          ! cc     $  sigmaw(i)
+
+
+          ! ajout d'un effet onde de gravite -Tgw(k)*deltatw(k) 03/02/06 YU
+          ! Jingmei
+
+          ! write(lunout,*)'wake.F ',i,k, dtimesub,d_deltat_gw(i,k),
+          ! &  Tgw(i,k),deltatw(i,k)
+          d_deltat_gw(i, k) = d_deltat_gw(i, k) - tgw(i, k)*deltatw(i, k)* &
+            dtimesub
+          ! write(lunout,*)'wake.F ',i,k, dtimesub,d_deltatw(i,k)
+          ff(i) = d_deltatw(i, k)/dtimesub
+
+          ! Sans GW
+
+          ! deltatw(k)=deltatw(k)+dtimesub*(ff+dtKE(k)-wkspread(k)*deltatw(k))
+
+          ! GW formule 1
+
+          ! deltatw(k) = deltatw(k)+dtimesub*
+          ! $         (ff+dtKE(k) - wkspread(k)*deltatw(k)-Tgw(k)*deltatw(k))
+
+          ! GW formule 2
+
+          IF (dtimesub*tgw(i,k)<1.E-10) THEN
+            d_deltatw(i, k) = dtimesub*(ff(i)+dtke(i,k) - & 
+               entr(i,k)*deltatw(i,k)/sigmaw(i) - &
+               (death_rate(i)*sigmaw(i)+detr(i,k))*deltatw(i,k)/(1.-sigmaw(i)) - & ! cc
+               tgw(i,k)*deltatw(i,k) )
+          ELSE
+            d_deltatw(i, k) = 1/tgw(i, k)*(1-exp(-dtimesub*tgw(i,k)))* &
+               (ff(i)+dtke(i,k) - &
+                entr(i,k)*deltatw(i,k)/sigmaw(i) - &
+                (death_rate(i)*sigmaw(i)+detr(i,k))*deltatw(i,k)/(1.-sigmaw(i)) - &
+                tgw(i,k)*deltatw(i,k) )
+          END IF
+
+          dth(i, k) = deltatw(i, k)/ppi(i, k)
+
+          gg(i) = d_deltaqw(i, k)/dtimesub
+
+          d_deltaqw(i, k) = dtimesub*(gg(i)+dqke(i,k) - & 
+            entr(i,k)*deltaqw(i,k)/sigmaw(i) - &
+            (death_rate(i)*sigmaw(i)+detr(i,k))*deltaqw(i,k)/(1.-sigmaw(i)))
+          ! cc
+
+          ! cc nrlmd
+          ! cc       d_deltatw2(i,k)=d_deltatw2(i,k)+d_deltatw(i,k)
+          ! cc       d_deltaqw2(i,k)=d_deltaqw2(i,k)+d_deltaqw(i,k)
+          ! cc
+        END IF
+      END DO
+    END DO
+
+
+    ! Scale tendencies so that water vapour remains positive in w and x.
+
+    CALL wake_vec_modulation(klon, klev, wk_adv, epsilon_loc, qe, d_qe, deltaqw, &
+      d_deltaqw, sigmaw, d_sigmaw, alpha)
+    !
+    ! Alpha_tot = Product of all the alpha's
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        alpha_tot(i) = alpha_tot(i)*alpha(i)    
+      END IF
+    END DO
+
+    ! cc nrlmd
+    ! c      print*,'alpha'
+    ! c      do i=1,klon
+    ! c         print*,alpha(i)
+    ! c      end do
+    ! cc
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
+          d_tenv(i, k) = alpha(i)*d_tenv(i, k)
+          d_qe(i, k) = alpha(i)*d_qe(i, k)
+          d_deltatw(i, k) = alpha(i)*d_deltatw(i, k)
+          d_deltaqw(i, k) = alpha(i)*d_deltaqw(i, k)
+          d_deltat_gw(i, k) = alpha(i)*d_deltat_gw(i, k)
+        END IF
+      END DO
+    END DO
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        d_sigmaw(i) = alpha(i)*d_sigmaw(i)
+      END IF
+    END DO
+
+    ! Update large scale variables and wake variables
+    ! IM 060208 manque DO i + remplace DO k=1,kupper(i)
+    ! IM 060208     DO k = 1,kupper(i)
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
+          dtls(i, k) = dtls(i, k) + d_tenv(i, k)
+          dqls(i, k) = dqls(i, k) + d_qe(i, k)
+          ! cc nrlmd
+          d_deltatw2(i, k) = d_deltatw2(i, k) + d_deltatw(i, k)
+          d_deltaqw2(i, k) = d_deltaqw2(i, k) + d_deltaqw(i, k)
+          ! cc
+        END IF
+      END DO
+    END DO
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
+          tenv(i, k) = tenv0(i, k) + dtls(i, k)
+          qe(i, k) = qe0(i, k) + dqls(i, k)
+          the(i, k) = tenv(i, k)/ppi(i, k)
+          deltatw(i, k) = deltatw(i, k) + d_deltatw(i, k)
+          deltaqw(i, k) = deltaqw(i, k) + d_deltaqw(i, k)
+          dth(i, k) = deltatw(i, k)/ppi(i, k)
+          ! c      print*,'k,qx,qw',k,qe(i,k)-sigmaw(i)*deltaqw(i,k)
+          ! c     $        ,qe(i,k)+(1-sigmaw(i))*deltaqw(i,k)
+        END IF
+      END DO
+    END DO
+!
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        sigmaw(i) = sigmaw(i) + d_sigmaw(i)
+        d_sigmaw2(i) = d_sigmaw2(i) + d_sigmaw(i)
+!  print *,'XXXX4 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
+      END IF
+    END DO
+!jyg<
+    IF (iflag_wk_pop_dyn >= 1) THEN
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! sigmaw !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!  Cumulatives
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          d_sig_gen2(i)   = d_sig_gen2(i)   + d_sig_gen(i)
+          d_sig_death2(i) = d_sig_death2(i) + d_sig_death(i)
+          d_sig_col2(i)   = d_sig_col2(i)   + d_sig_col(i)
+          d_sig_spread2(i)= d_sig_spread2(i)+ d_sig_spread(i)
+          d_sig_bnd2(i)   = d_sig_bnd2(i)   + d_sig_bnd(i)
+        END IF
+      END DO
+!  Bounds
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          sigmaw_targ = max(sigmaw(i),sigmad)
+          d_sig_bnd2(i) = d_sig_bnd2(i) + sigmaw_targ - sigmaw(i)
+          d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
+!  print *,'XXXX5 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
+          sigmaw(i) = sigmaw_targ
+        END IF
+      END DO
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! wdens  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!  Cumulatives
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          wdens(i) = wdens(i) + d_wdens(i)
+          d_wdens2(i) = d_wdens2(i) + d_wdens(i)
+          d_dens_gen2(i)   = d_dens_gen2(i)   + d_dens_gen(i)
+          d_dens_death2(i) = d_dens_death2(i) + d_dens_death(i)
+          d_dens_col2(i)   = d_dens_col2(i)   + d_dens_col(i)
+          d_dens_bnd2(i)   = d_dens_bnd2(i)   + d_dens_bnd(i)
+        END IF
+      END DO
+!  Bounds
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          wdens_targ = max(wdens(i),wdensmin)
+          d_dens_bnd2(i) = d_dens_bnd2(i) + wdens_targ - wdens(i)
+          d_wdens2(i) = d_wdens2(i) + wdens_targ - wdens(i)
+          wdens(i) = wdens_targ
+        END IF
+      END DO
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! awdens !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!  Cumulatives
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          awdens(i) = awdens(i) + d_awdens(i)
+          d_awdens2(i) = d_awdens2(i) + d_awdens(i)
+        END IF
+      END DO
+!  Bounds
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          wdens_targ = min( max(awdens(i),0.), wdens(i) )
+          d_awdens2(i) = d_awdens2(i) + wdens_targ - awdens(i)
+          awdens(i) = wdens_targ
+        END IF
+      END DO
+!
+      IF (iflag_wk_pop_dyn == 2) THEN
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! awdens again for iflag_wk_pop_dyn = 2!!!!!!
+!  Cumulatives
+          DO i = 1, klon
+             IF (wk_adv(i)) THEN
+                 d_adens_death2(i)   = d_adens_death2(i)   + d_adens_death(i)
+                 d_adens_icol2(i)   = d_adens_icol2(i)   + d_adens_icol(i)
+                 d_adens_acol2(i)   = d_adens_acol2(i)   + d_adens_acol(i)
+                 d_adens_bnd2(i)   = d_adens_bnd2(i)   + d_adens_bnd(i)          
+             END IF
+          END DO
+!  Bounds
+          DO i = 1, klon
+             IF (wk_adv(i)) THEN
+                 wdens_targ = min( max(awdens(i),0.), wdens(i) )
+                 d_adens_bnd2(i) = d_adens_bnd2(i) + wdens_targ - awdens(i)
+             END IF
+          END DO
+      ENDIF ! (iflag_wk_pop_dyn == 2)
+    ENDIF  ! (iflag_wk_pop_dyn >= 1)
+
+
+    ! Determine Ptop from buoyancy integral
+    ! ---------------------------------------
+
+    ! -     1/ Pressure of the level where dth changes sign.
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        ptop_provis(i) = ph(i, 1)
+      END IF
+    END DO
+
+    DO k = 2, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. ptop_provis(i)==ph(i,1) .AND. &
+            dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN
+          ptop_provis(i) = ((dth(i,k)+delta_t_min)*p(i,k-1) - &
+                            (dth(i,k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
+        END IF
+      END DO
+    END DO
+
+    ! -     2/ dth integral
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        sum_dth(i) = 0.
+        dthmin(i) = -delta_t_min
+        z(i) = 0.
+      END IF
+    END DO
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          dz(i) = -(amax1(ph(i,k+1),ptop_provis(i))-ph(i,k))/(rho(i,k)*RG)
+          IF (dz(i)>0) THEN
+            z(i) = z(i) + dz(i)
+            sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
+            dthmin(i) = amin1(dthmin(i), dth(i,k))
+          END IF
+        END IF
+      END DO
+    END DO
+
+    ! -     3/ height of triangle with area= sum_dth and base = dthmin
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        hw(i) = 2.*sum_dth(i)/amin1(dthmin(i), -0.5)
+        hw(i) = amax1(hwmin, hw(i))
+      END IF
+    END DO
+
+    ! -     4/ now, get Ptop
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        ktop(i) = 0
+        z(i) = 0.
+      END IF
+    END DO
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          dz(i) = amin1(-(ph(i,k+1)-ph(i,k))/(rho(i,k)*RG), hw(i)-z(i))
+          IF (dz(i)>0) THEN
+            z(i) = z(i) + dz(i)
+            ptop(i) = ph(i, k) - rho(i, k)*RG*dz(i)
+            ktop(i) = k
+          END IF
+        END IF
+      END DO
+    END DO
+
+    ! 4.5/Correct ktop and ptop
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        ptop_new(i) = ptop(i)
+      END IF
+    END DO
+
+    DO k = klev, 2, -1
+      DO i = 1, klon
+        ! IM v3JYG; IF (k .GE. ktop(i)
+        IF (wk_adv(i) .AND. k<=ktop(i) .AND. ptop_new(i)==ptop(i) .AND. &
+            dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN
+          ptop_new(i) = ((dth(i,k)+delta_t_min)*p(i,k-1) - &
+                         (dth(i,k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
+        END IF
+      END DO
+    END DO
+
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        ptop(i) = ptop_new(i)
+      END IF
+    END DO
+
+    DO k = klev, 1, -1
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN !!! nrlmd
+          IF (ph(i,k+1)<ptop(i)) ktop(i) = k
+        END IF
+      END DO
+    END DO
+
+    ! 5/ Set deltatw & deltaqw to 0 above kupper
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k>=kupper(i)) THEN
+          deltatw(i, k) = 0.
+          deltaqw(i, k) = 0.
+          d_deltatw2(i,k) = -deltatw0(i,k)
+          d_deltaqw2(i,k) = -deltaqw0(i,k)
+        END IF
+      END DO
+    END DO
+
+
+    ! -------------Cstar computation---------------------------------
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        sum_thu(i) = 0.
+        sum_tu(i) = 0.
+        sum_qu(i) = 0.
+        sum_thvu(i) = 0.
+        sum_dth(i) = 0.
+        sum_dq(i) = 0.
+        sum_rho(i) = 0.
+        sum_dtdwn(i) = 0.
+        sum_dqdwn(i) = 0.
+
+        av_thu(i) = 0.
+        av_tu(i) = 0.
+        av_qu(i) = 0.
+        av_thvu(i) = 0.
+        av_dth(i) = 0.
+        av_dq(i) = 0.
+        av_rho(i) = 0.
+        av_dtdwn(i) = 0.
+        av_dqdwn(i) = 0.
+      END IF
+    END DO
+
+    ! Integrals (and wake top level number)
+    ! --------------------------------------
+
+    ! Initialize sum_thvu to 1st level virt. pot. temp.
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        z(i) = 1.
+        dz(i) = 1.
+        sum_thvu(i) = thu(i, 1)*(1.+epsim1*qu(i,1))*dz(i)
+        sum_dth(i) = 0.
+      END IF
+    END DO
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN !!! nrlmd
+          dz(i) = -(max(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*RG)
+          IF (dz(i)>0) THEN
+            z(i) = z(i) + dz(i)
+            sum_thu(i) = sum_thu(i) + thu(i, k)*dz(i)
+            sum_tu(i) = sum_tu(i) + tu(i, k)*dz(i)
+            sum_qu(i) = sum_qu(i) + qu(i, k)*dz(i)
+            sum_thvu(i) = sum_thvu(i) + thu(i, k)*(1.+epsim1*qu(i,k))*dz(i)
+            sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
+            sum_dq(i) = sum_dq(i) + deltaqw(i, k)*dz(i)
+            sum_rho(i) = sum_rho(i) + rhow(i, k)*dz(i)
+            sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i, k)*dz(i)
+            sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i, k)*dz(i)
+          END IF
+        END IF
+      END DO
+    END DO
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        hw0(i) = z(i)
+      END IF
+    END DO
+
+
+    ! - WAPE and mean forcing computation
+    ! ---------------------------------------
+
+    ! ---------------------------------------
+
+    ! Means
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        av_thu(i) = sum_thu(i)/hw0(i)
+        av_tu(i) = sum_tu(i)/hw0(i)
+        av_qu(i) = sum_qu(i)/hw0(i)
+        av_thvu(i) = sum_thvu(i)/hw0(i)
+        av_dth(i) = sum_dth(i)/hw0(i)
+        av_dq(i) = sum_dq(i)/hw0(i)
+        av_rho(i) = sum_rho(i)/hw0(i)
+        av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
+        av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
+
+        wape(i) = -RG*hw0(i)*(av_dth(i)+epsim1*(av_thu(i)*av_dq(i) + &
+                              av_dth(i)*av_qu(i)+av_dth(i)*av_dq(i)))/av_thvu(i)
+      END IF
+    END DO
+
+    ! Filter out bad wakes
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN !!! nrlmd
+          IF (wape(i)<0.) THEN
+            deltatw(i, k) = 0.
+            deltaqw(i, k) = 0.
+            dth(i, k) = 0.
+            d_deltatw2(i,k) = -deltatw0(i,k)
+            d_deltaqw2(i,k) = -deltaqw0(i,k)
+          END IF
+        END IF
+      END DO
+    END DO
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        IF (wape(i)<0.) THEN
+          wape(i) = 0.
+          cstar(i) = 0.
+          hw(i) = hwmin
+!jyg<
+!!          sigmaw(i) = max(sigmad, sigd_con(i))
+          sigmaw_targ = max(sigmad, sigd_con(i))
+          d_sig_bnd2(i) = d_sig_bnd2(i) + sigmaw_targ - sigmaw(i)
+          d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
+!  print *,'XXXX6 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
+          sigmaw(i) = sigmaw_targ
+!>jyg
+          fip(i) = 0.
+          gwake(i) = .FALSE.
+        ELSE
+          cstar(i) = stark*sqrt(2.*wape(i))
+          gwake(i) = .TRUE.
+        END IF
+      END IF
+    END DO
+
+  END DO ! end sub-timestep loop
+
+  IF (prt_level>=10) THEN
+    PRINT *, 'wake-5, sigmaw(igout), cstar(igout), wape(igout), ptop(igout) ', &
+                      sigmaw(igout), cstar(igout), wape(igout), ptop(igout)
+  ENDIF
+
+
+  ! ----------------------------------------------------------
+  ! Determine wake final state; recompute wape, cstar, ktop;
+  ! filter out bad wakes.
+  ! ----------------------------------------------------------
+
+  ! 2.1 - Undisturbed area and Wake integrals
+  ! ---------------------------------------------------------
+
+  DO i = 1, klon
+    ! cc nrlmd       if (wk_adv(i)) then !!! nrlmd
+    IF (ok_qx_qw(i)) THEN
+      ! cc
+      z(i) = 0.
+      sum_thu(i) = 0.
+      sum_tu(i) = 0.
+      sum_qu(i) = 0.
+      sum_thvu(i) = 0.
+      sum_dth(i) = 0.
+      sum_half_dth(i) = 0.
+      sum_dq(i) = 0.
+      sum_rho(i) = 0.
+      sum_dtdwn(i) = 0.
+      sum_dqdwn(i) = 0.
+
+      av_thu(i) = 0.
+      av_tu(i) = 0.
+      av_qu(i) = 0.
+      av_thvu(i) = 0.
+      av_dth(i) = 0.
+      av_dq(i) = 0.
+      av_rho(i) = 0.
+      av_dtdwn(i) = 0.
+      av_dqdwn(i) = 0.
+
+      dthmin(i) = -delta_t_min
+    END IF
+  END DO
+  ! Potential temperatures and humidity
+  ! ----------------------------------------------------------
+
+  DO k = 1, klev
+    DO i = 1, klon
+      ! cc nrlmd       IF ( wk_adv(i)) THEN
+      IF (ok_qx_qw(i)) THEN
+        ! cc
+        rho(i, k) = p(i, k)/(RD*tenv(i,k))
+        IF (k==1) THEN
+          rhoh(i, k) = ph(i, k)/(RD*tenv(i,k))
+          zhh(i, k) = 0
+        ELSE
+          rhoh(i, k) = ph(i, k)*2./(RD*(tenv(i,k)+tenv(i,k-1)))
+          zhh(i, k) = (ph(i,k)-ph(i,k-1))/(-rhoh(i,k)*RG) + zhh(i, k-1)
+        END IF
+        the(i, k) = tenv(i, k)/ppi(i, k)
+        thu(i, k) = (tenv(i,k)-deltatw(i,k)*sigmaw(i))/ppi(i, k)
+        tu(i, k) = tenv(i, k) - deltatw(i, k)*sigmaw(i)
+        qu(i, k) = qe(i, k) - deltaqw(i, k)*sigmaw(i)
+        rhow(i, k) = p(i, k)/(RD*(tenv(i,k)+deltatw(i,k)))
+        dth(i, k) = deltatw(i, k)/ppi(i, k)
+      END IF
+    END DO
+  END DO
+
+  ! Integrals (and wake top level number)
+  ! -----------------------------------------------------------
+
+  ! Initialize sum_thvu to 1st level virt. pot. temp.
+
+  DO i = 1, klon
+    ! cc nrlmd       IF ( wk_adv(i)) THEN
+    IF (ok_qx_qw(i)) THEN
+      ! cc
+      z(i) = 1.
+      dz(i) = 1.
+      dz_half(i) = 1.
+      sum_thvu(i) = thu(i, 1)*(1.+epsim1*qu(i,1))*dz(i)
+      sum_dth(i) = 0.
+    END IF
+  END DO
+
+  DO k = 1, klev
+    DO i = 1, klon
+      ! cc nrlmd       IF ( wk_adv(i)) THEN
+      IF (ok_qx_qw(i)) THEN
+        ! cc
+        dz(i) = -(amax1(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*RG)
+        dz_half(i) = -(amax1(ph(i,k+1),0.5*(ptop(i)+ph(i,1)))-ph(i,k))/(rho(i,k)*RG)
+        IF (dz(i)>0) THEN
+          z(i) = z(i) + dz(i)
+          sum_thu(i) = sum_thu(i) + thu(i, k)*dz(i)
+          sum_tu(i) = sum_tu(i) + tu(i, k)*dz(i)
+          sum_qu(i) = sum_qu(i) + qu(i, k)*dz(i)
+          sum_thvu(i) = sum_thvu(i) + thu(i, k)*(1.+epsim1*qu(i,k))*dz(i)
+          sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
+          sum_dq(i) = sum_dq(i) + deltaqw(i, k)*dz(i)
+          sum_rho(i) = sum_rho(i) + rhow(i, k)*dz(i)
+          sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i, k)*dz(i)
+          sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i, k)*dz(i)
+!
+          dthmin(i) = min(dthmin(i), dth(i,k))
+        END IF
+        IF (dz_half(i)>0) THEN
+          sum_half_dth(i) = sum_half_dth(i) + dth(i, k)*dz_half(i)
+        END IF
+      END IF
+    END DO
+  END DO
+
+  DO i = 1, klon
+    ! cc nrlmd       IF ( wk_adv(i)) THEN
+    IF (ok_qx_qw(i)) THEN
+      ! cc
+      hw0(i) = z(i)
+    END IF
+  END DO
+
+  ! - WAPE and mean forcing computation
+  ! -------------------------------------------------------------
+
+  ! Means
+
+  DO i = 1, klon
+    ! cc nrlmd       IF ( wk_adv(i)) THEN
+    IF (ok_qx_qw(i)) THEN
+      ! cc
+      av_thu(i) = sum_thu(i)/hw0(i)
+      av_tu(i) = sum_tu(i)/hw0(i)
+      av_qu(i) = sum_qu(i)/hw0(i)
+      av_thvu(i) = sum_thvu(i)/hw0(i)
+      av_dth(i) = sum_dth(i)/hw0(i)
+      av_dq(i) = sum_dq(i)/hw0(i)
+      av_rho(i) = sum_rho(i)/hw0(i)
+      av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
+      av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
+
+      wape2(i) = -RG*hw0(i)*(av_dth(i)+epsim1*(av_thu(i)*av_dq(i) + &
+                             av_dth(i)*av_qu(i)+av_dth(i)*av_dq(i)))/av_thvu(i)
+    END IF
+  END DO
+
+
+
+  ! Prognostic variable update
+  ! ------------------------------------------------------------
+
+  ! Filter out bad wakes
+
+  IF (iflag_wk_check_trgl>=1) THEN
+    ! Check triangular shape of dth profile
+    DO i = 1, klon
+      IF (ok_qx_qw(i)) THEN
+        !! print *,'wake, hw0(i), dthmin(i) ', hw0(i), dthmin(i)
+        !! print *,'wake, 2.*sum_dth(i)/(hw0(i)*dthmin(i)) ', &
+        !!                2.*sum_dth(i)/(hw0(i)*dthmin(i))
+        !! print *,'wake, sum_half_dth(i), sum_dth(i) ', &
+        !!                sum_half_dth(i), sum_dth(i)
+        IF ((hw0(i) < 1.) .or. (dthmin(i) >= -delta_t_min) ) THEN
+          wape2(i) = -1.
+          !! print *,'wake, rej 1'
+        ELSE IF (iflag_wk_check_trgl==1.AND.abs(2.*sum_dth(i)/(hw0(i)*dthmin(i)) - 1.) > 0.5) THEN
+          wape2(i) = -1.
+          !! print *,'wake, rej 2'
+        ELSE IF (abs(sum_half_dth(i)) < 0.5*abs(sum_dth(i)) ) THEN
+          wape2(i) = -1.
+          !! print *,'wake, rej 3'
+        END IF
+      END IF
+    END DO
+  END IF
+
+
+  DO k = 1, klev
+    DO i = 1, klon
+      ! cc nrlmd        IF ( wk_adv(i) .AND. wape2(i) .LT. 0.) THEN
+      IF (ok_qx_qw(i) .AND. wape2(i)<0.) THEN
+        ! cc
+        deltatw(i, k) = 0.
+        deltaqw(i, k) = 0.
+        dth(i, k) = 0.
+        d_deltatw2(i,k) = -deltatw0(i,k)
+        d_deltaqw2(i,k) = -deltaqw0(i,k)
+      END IF
+    END DO
+  END DO
+
+
+  DO i = 1, klon
+    ! cc nrlmd       IF ( wk_adv(i)) THEN
+    IF (ok_qx_qw(i)) THEN
+      ! cc
+      IF (wape2(i)<0.) THEN
+        wape2(i) = 0.
+        cstar2(i) = 0.
+        hw(i) = hwmin
+!jyg<
+!!      sigmaw(i) = amax1(sigmad, sigd_con(i))
+      sigmaw_targ = max(sigmad, sigd_con(i))
+      d_sig_bnd2(i) = d_sig_bnd2(i) + sigmaw_targ - sigmaw(i)
+      d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
+!  print *,'XXXX7 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
+      sigmaw(i) = sigmaw_targ
+!>jyg
+        fip(i) = 0.
+        gwake(i) = .FALSE.
+      ELSE
+        IF (prt_level>=10) PRINT *, 'wape2>0'
+        cstar2(i) = stark*sqrt(2.*wape2(i))
+        gwake(i) = .TRUE.
+      END IF
+    END IF
+  END DO
+
+  DO i = 1, klon
+    ! cc nrlmd       IF ( wk_adv(i)) THEN
+    IF (ok_qx_qw(i)) THEN
+      ! cc
+      ktopw(i) = ktop(i)
+    END IF
+  END DO
+
+  DO i = 1, klon
+    ! cc nrlmd       IF ( wk_adv(i)) THEN
+    IF (ok_qx_qw(i)) THEN
+      ! cc
+      IF (ktopw(i)>0 .AND. gwake(i)) THEN
+
+        ! jyg1     Utilisation d'un h_efficace constant ( ~ feeding layer)
+        ! cc       heff = 600.
+        ! Utilisation de la hauteur hw
+        ! c       heff = 0.7*hw
+        heff(i) = hw(i)
+
+        fip(i) = 0.5*rho(i, ktopw(i))*cstar2(i)**3*heff(i)*2* &
+          sqrt(sigmaw(i)*wdens(i)*3.14)
+        fip(i) = alpk*fip(i)
+        ! jyg2
+      ELSE
+        fip(i) = 0.
+      END IF
+    END IF
+  END DO
+
+  ! Limitation de sigmaw
+
+  ! cc nrlmd
+  ! DO i=1,klon
+  ! IF (OK_qx_qw(i)) THEN
+  ! IF (sigmaw(i).GE.sigmaw_max) sigmaw(i)=sigmaw_max
+  ! ENDIF
+  ! ENDDO
+  ! cc
+
+  !jyg<
+  IF (iflag_wk_pop_dyn >= 1) THEN
+    DO i = 1, klon
+      kill_wake(i) = ((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
+          .NOT. ok_qx_qw(i) .OR. (wdens(i) < 2.*wdensmin)
+    ENDDO
+  ELSE  ! (iflag_wk_pop_dyn >= 1)
+    DO i = 1, klon
+      kill_wake(i) = ((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
+          .NOT. ok_qx_qw(i)
+    ENDDO
+  ENDIF  ! (iflag_wk_pop_dyn >= 1)
+  !>jyg
+
+  DO k = 1, klev
+    DO i = 1, klon
+!!jyg      IF (((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
+!!jyg          .NOT. ok_qx_qw(i)) THEN
+      IF (kill_wake(i)) THEN
+        ! cc
+        dtls(i, k) = 0.
+        dqls(i, k) = 0.
+        deltatw(i, k) = 0.
+        deltaqw(i, k) = 0.
+        d_deltatw2(i,k) = -deltatw0(i,k)
+        d_deltaqw2(i,k) = -deltaqw0(i,k)
+      END IF  ! (kill_wake(i))
+    END DO
+  END DO
+
+  DO i = 1, klon
+!!jyg    IF (((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
+!!jyg        .NOT. ok_qx_qw(i)) THEN
+      IF (kill_wake(i)) THEN
+      ktopw(i) = 0
+      wape(i) = 0.
+      cstar(i) = 0.
+!!jyg   Outside subroutine "Wake" hw, wdens and sigmaw are zero when there are no wakes
+!!      hw(i) = hwmin                       !jyg
+!!      sigmaw(i) = sigmad                  !jyg
+      hw(i) = 0.                            !jyg
+      fip(i) = 0.
+!!      sigmaw(i) = 0.                        !jyg
+      sigmaw_targ = 0.
+      d_sig_bnd2(i) = d_sig_bnd2(i) + sigmaw_targ - sigmaw(i)
+!!      d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
+      d_sigmaw2(i) = sigmaw_targ - sigmaw_in(i)      ! _in = correction jyg 20220124
+!  print *,'XXXX8 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
+      sigmaw(i) = sigmaw_targ
+      IF (iflag_wk_pop_dyn >= 1) THEN
+!!        awdens(i) = 0.
+!!        wdens(i) = 0.
+        wdens_targ = 0.
+        d_dens_bnd2(i) = d_dens_bnd2(i) + wdens_targ - wdens(i)
+!!        d_wdens2(i) = wdens_targ - wdens(i)
+        d_wdens2(i) = wdens_targ - wdens_in(i)      ! jyg 20220916
+        wdens(i) = wdens_targ
+        wdens_targ = 0.
+!!jyg: bug fix : the d_adens_bnd2 computation must be before the update of awdens.
+        IF (iflag_wk_pop_dyn == 2) THEN
+            d_adens_bnd2(i) = d_adens_bnd2(i) + wdens_targ - awdens(i)
+        ENDIF ! (iflag_wk_pop_dyn == 2)
+!!        d_awdens2(i) = wdens_targ - awdens(i)
+        d_awdens2(i) = wdens_targ - awdens_in(i)    ! jyg 20220916
+        awdens(i) = wdens_targ
+!!        IF (iflag_wk_pop_dyn == 2) THEN
+!!            d_adens_bnd2(i) = d_adens_bnd2(i) + wdens_targ - awdens(i)
+!!        ENDIF ! (iflag_wk_pop_dyn == 2)
+      ENDIF  ! (iflag_wk_pop_dyn >= 1)
+    ELSE  ! (kill_wake(i))
+      wape(i) = wape2(i)
+      cstar(i) = cstar2(i)
+    END IF  ! (kill_wake(i))
+    ! c        print*,'wape wape2 ktopw OK_qx_qw =',
+    ! c     $          wape(i),wape2(i),ktopw(i),OK_qx_qw(i)
+  END DO
+
+  IF (prt_level>=10) THEN
+    PRINT *, 'wake-6, wape wape2 ktopw OK_qx_qw =', &
+                      wape(igout),wape2(igout),ktopw(igout),OK_qx_qw(igout)
+  ENDIF
+
+
+  ! -----------------------------------------------------------------
+  ! Get back to tendencies per second
+
+  DO k = 1, klev
+    DO i = 1, klon
+
+      ! cc nrlmd        IF ( wk_adv(i) .AND. k .LE. kupper(i)) THEN
+!jyg<
+!!      IF (ok_qx_qw(i) .AND. k<=kupper(i)) THEN
+      IF (ok_qx_qw(i)) THEN
+!>jyg
+        ! cc
+        dtls(i, k) = dtls(i, k)/dtime
+        dqls(i, k) = dqls(i, k)/dtime
+        d_deltatw2(i, k) = d_deltatw2(i, k)/dtime
+        d_deltaqw2(i, k) = d_deltaqw2(i, k)/dtime
+        d_deltat_gw(i, k) = d_deltat_gw(i, k)/dtime
+        ! c      print*,'k,dqls,omg,entr,detr',k,dqls(i,k),omg(i,k),entr(i,k)
+        ! c     $         ,death_rate(i)*sigmaw(i)
+      END IF
+    END DO
+  END DO
+!jyg<
+  IF (iflag_wk_pop_dyn >= 1) THEN
+  DO i = 1, klon
+      IF (ok_qx_qw(i)) THEN
+    d_sig_gen2(i) = d_sig_gen2(i)/dtime
+    d_sig_death2(i) = d_sig_death2(i)/dtime
+    d_sig_col2(i) = d_sig_col2(i)/dtime
+    d_sig_spread2(i) = d_sig_spread2(i)/dtime
+    d_sig_bnd2(i) = d_sig_bnd2(i)/dtime
+    d_sigmaw2(i) = d_sigmaw2(i)/dtime
+!  print *,'XXXX9 d_sigmaw2(i), sigmaw(i), dtime ', d_sigmaw2(i), sigmaw(i), dtime
+!
+    d_dens_gen2(i) = d_dens_gen2(i)/dtime
+    d_dens_death2(i) = d_dens_death2(i)/dtime
+    d_dens_col2(i) = d_dens_col2(i)/dtime
+    d_dens_bnd2(i) = d_dens_bnd2(i)/dtime
+    d_awdens2(i) = d_awdens2(i)/dtime
+    d_wdens2(i) = d_wdens2(i)/dtime
+      ENDIF
+  ENDDO
+  IF (iflag_wk_pop_dyn == 2) THEN
+    DO i = 1, klon
+      IF (ok_qx_qw(i)) THEN
+    d_adens_death2(i) = d_adens_death2(i)/dtime
+    d_adens_icol2(i) = d_adens_icol2(i)/dtime
+    d_adens_acol2(i) = d_adens_acol2(i)/dtime
+    d_adens_bnd2(i) = d_adens_bnd2(i)/dtime
+      ENDIF
+    ENDDO
+   ENDIF ! (iflag_wk_pop_dyn == 2)  
+  ENDIF  ! (iflag_wk_pop_dyn >= 1)
+ 
+!>jyg
+
+ RETURN
+END SUBROUTINE wake
+
+SUBROUTINE wake_vec_modulation(nlon, nl, wk_adv, epsilon_loc, qe, d_qe, deltaqw, &
+    d_deltaqw, sigmaw, d_sigmaw, alpha)
+  ! ------------------------------------------------------
+  ! Dtermination du coefficient alpha tel que les tendances
+  ! corriges alpha*d_G, pour toutes les grandeurs G, correspondent
+  ! a une humidite positive dans la zone (x) et dans la zone (w).
+  ! ------------------------------------------------------
+  IMPLICIT NONE
+
+  ! Input
+  REAL qe(nlon, nl), d_qe(nlon, nl)
+  REAL deltaqw(nlon, nl), d_deltaqw(nlon, nl)
+  REAL sigmaw(nlon), d_sigmaw(nlon)
+  LOGICAL wk_adv(nlon)
+  INTEGER nl, nlon
+  ! Output
+  REAL alpha(nlon)
+  ! Internal variables
+  REAL zeta(nlon, nl)
+  REAL alpha1(nlon)
+  REAL x, a, b, c, discrim
+  REAL epsilon_loc
+  INTEGER i,k
+
+  DO k = 1, nl
+    DO i = 1, nlon
+      IF (wk_adv(i)) THEN
+        IF ((deltaqw(i,k)+d_deltaqw(i,k))>=0.) THEN
+          zeta(i, k) = 0.
+        ELSE
+          zeta(i, k) = 1.
+        END IF
+      END IF
+    END DO
+    DO i = 1, nlon
+      IF (wk_adv(i)) THEN
+        x = qe(i, k) + (zeta(i,k)-sigmaw(i))*deltaqw(i, k) + d_qe(i, k) + &
+          (zeta(i,k)-sigmaw(i))*d_deltaqw(i, k) - d_sigmaw(i) * &
+          (deltaqw(i,k)+d_deltaqw(i,k))
+        a = -d_sigmaw(i)*d_deltaqw(i, k)
+        b = d_qe(i, k) + (zeta(i,k)-sigmaw(i))*d_deltaqw(i, k) - &
+          deltaqw(i, k)*d_sigmaw(i)
+        c = qe(i, k) + (zeta(i,k)-sigmaw(i))*deltaqw(i, k) + epsilon_loc
+        discrim = b*b - 4.*a*c
+        ! print*, 'x, a, b, c, discrim', x, a, b, c, discrim
+        IF (a+b>=0.) THEN !! Condition suffisante pour la positivite de ovap
+          alpha1(i) = 1.
+        ELSE
+          IF (x>=0.) THEN
+            alpha1(i) = 1.
+          ELSE
+            IF (a>0.) THEN
+              alpha1(i) = 0.9*min( (2.*c)/(-b+sqrt(discrim)),  &
+                                   (-b+sqrt(discrim))/(2.*a) )
+            ELSE IF (a==0.) THEN
+              alpha1(i) = 0.9*(-c/b)
+            ELSE
+              ! print*,'a,b,c discrim',a,b,c discrim
+              alpha1(i) = 0.9*max( (2.*c)/(-b+sqrt(discrim)),  &
+                                   (-b+sqrt(discrim))/(2.*a))
+            END IF
+          END IF
+        END IF
+        alpha(i) = min(alpha(i), alpha1(i))
+      END IF
+    END DO
+  END DO
+
+  RETURN
+END SUBROUTINE wake_vec_modulation
+
+
+
+SUBROUTINE pkupper (klon, klev, ptop, ph, pupper, kupper)
+
+USE lmdz_wake_ini , ONLY : wk_pupper
+IMPLICIT NONE
+
+INTEGER,  INTENT(IN)                              :: klon,klev
+REAL,     INTENT(IN),   DIMENSION (klon,klev+1)   :: ph
+REAL,     INTENT(IN),   DIMENSION (klon)          :: ptop
+REAL,     INTENT(OUT),  DIMENSION (klon)          :: pupper
+INTEGER,  INTENT(OUT),  DIMENSION (klon)          :: kupper
+INTEGER                                           :: i,k
+
+
+ kupper = 0
+ 
+IF (wk_pupper<1.) THEN
+ ! Choose an integration bound well above wake top
+  ! -----------------------------------------------------------------
+
+  ! Pupper = 50000.  ! melting level
+  ! Pupper = 60000.
+  ! Pupper = 80000.  ! essais pour case_e
+  DO i = 1, klon
+  !  pupper(i) = 0.6*ph(i, 1)
+    pupper(i) = wk_pupper*ph(i, 1)
+    pupper(i) = max(pupper(i), 45000.)
+    ! cc        Pupper(i) = 60000.
+  END DO
+
+ELSE
+  
+  DO i=1, klon
+     ! pupper(i) = wk_pupper*ptop(i)+(1.-wk_pupper)*ph(i, 1) 
+     pupper(i) = min( wk_pupper*ptop(i)+(1.-wk_pupper)*ph(i, 1) , ptop(i)-5000.) 
+  END DO
+END IF
+ 
+  ! -5/ Determination de kupper
+
+  DO k = klev, 1, -1
+    DO i = 1, klon
+      IF (ph(i,k+1)<pupper(i)) kupper(i) = k
+    END DO
+  END DO
+
+  ! On evite kupper = 1 et kupper = klev
+  DO i = 1, klon
+    kupper(i) = max(kupper(i), 2)
+    kupper(i) = min(kupper(i), klev-1)
+  END DO 
+    RETURN
+END SUBROUTINE pkupper
+
+
+SUBROUTINE wake_popdyn_1(klon, klev, dtime, cstar, tau_wk_inv, wgen, wdens, awdens, sigmaw, &
+                  dtimesub, gfl, rad_wk, f_shear, drdt_pos, &
+                  d_awdens, d_wdens, d_sigmaw, &
+                  iflag_wk_act, wk_adv, cin, wape, &
+                  drdt, &
+                  d_dens_gen, d_dens_death, d_dens_col, d_dens_bnd, &
+                  d_sig_gen, d_sig_death, d_sig_col, d_sig_spread, d_sig_bnd, &
+                  d_wdens_targ, d_sigmaw_targ)
+                
+
+  USE lmdz_wake_ini , ONLY : wake_ini
+  USE lmdz_wake_ini , ONLY : prt_level,RG
+  USE lmdz_wake_ini , ONLY : stark, wdens_ref
+  USE lmdz_wake_ini , ONLY : tau_cv, rzero, aa0
+  USE lmdz_wake_ini , ONLY : iflag_wk_pop_dyn, wdensmin
+  USE lmdz_wake_ini , ONLY : sigmad, cstart, sigmaw_max
+  
+IMPLICIT NONE
+
+  INTEGER, INTENT(IN)                                   :: klon,klev
+  LOGICAL, DIMENSION (klon),        INTENT(IN)          :: wk_adv
+  REAL,                             INTENT(IN)          :: dtime
+  REAL,                             INTENT(IN)          :: dtimesub
+  REAL, DIMENSION (klon),           INTENT(IN)          :: wgen
+  REAL, DIMENSION (klon),           INTENT(IN)          :: wdens
+  REAL, DIMENSION (klon),           INTENT(IN)          :: awdens
+  REAL, DIMENSION (klon),           INTENT(IN)          :: sigmaw
+  REAL, DIMENSION (klon),           INTENT(IN)          :: gfl, cstar
+  REAL, DIMENSION (klon),           INTENT(IN)          :: cin, wape
+  REAL, DIMENSION (klon),           INTENT(IN)          :: rad_wk
+  REAL, DIMENSION (klon),           INTENT(IN)          :: f_shear
+  INTEGER,                          INTENT(IN)          :: iflag_wk_act
+
+  
+  !
+ 
+  ! Tendencies of state variables (2 is appended to the names of fields which are the cumul of fields 
+  !                                 computed at each sub-timestep; e.g. d_wdens2 is the cumul of d_wdens)
+  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_sigmaw, d_awdens, d_wdens
+  REAL, DIMENSION (klon),           INTENT(OUT)         :: drdt
+  ! Some components of the tendencies of state variables  
+  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_sig_gen, d_sig_death, d_sig_col, d_sig_bnd
+  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_sig_spread
+  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_dens_gen, d_dens_death, d_dens_col, d_dens_bnd
+  REAL,                             INTENT(OUT)         :: d_wdens_targ, d_sigmaw_targ
+ 
+  
+  REAL                                                  :: delta_t_min
+  INTEGER                                               :: nsub
+  INTEGER                                               :: i, k
+  REAL                                                  :: wdens0
+  ! IM 080208
+  LOGICAL, DIMENSION (klon)                             :: gwake
+  
+   ! Variables liees a la dynamique de population
+  REAL, DIMENSION(klon)                                 :: act
+  REAL, DIMENSION(klon)                                 :: tau_wk_inv
+  REAL, DIMENSION(klon)                                 :: wape1_act, wape2_act
+  LOGICAL, DIMENSION (klon)                             :: kill_wake
+  REAL                                                  :: drdt_pos
+  REAL                                                  :: tau_wk_inv_min
+  
+     
+
+      IF (iflag_wk_act == 0) THEN
+        act(:) = 0.
+      ELSEIF (iflag_wk_act == 1) THEN
+        act(:) = 1.
+      ELSEIF (iflag_wk_act ==2) THEN
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          wape1_act(i) = abs(cin(i))
+          wape2_act(i) = 2.*wape1_act(i) + 1.
+          act(i) = min(1., max(0., (wape(i)-wape1_act(i)) / (wape2_act(i)-wape1_act(i)) ))
+        ENDIF  ! (wk_adv(i))
+      ENDDO
+      ENDIF  ! (iflag_wk_act ==2)
+
+
+      DO i = 1, klon
+       ! print*, 'XXX wk_adv(i)', wk_adv(i)
+        IF (wk_adv(i)) THEN
+!!          tau_wk(i) = max(rad_wk(i)/(3.*cstar(i))*((cstar(i)/cstart)**1.5 - 1), 100.)
+          tau_wk_inv(i) = max( (3.*cstar(i))/(rad_wk(i)*((cstar(i)/cstart)**1.5 - 1)), 0.)
+          tau_wk_inv_min = min(tau_wk_inv(i), 1./dtimesub)
+          drdt(i) = (cstar(i) - wgen(i)*(sigmaw(i)/wdens(i)-aa0)/gfl(i)) / &
+                    (1 + 2*f_shear(i)*(2.*sigmaw(i)-aa0*wdens(i)) - 2.*sigmaw(i))
+!!                    (1 - 2*sigmaw(i)*(1.-f_shear(i)))
+          drdt_pos=max(drdt(i),0.)
+
+!!          d_wdens(i) = ( wgen(i)*(1.+2.*(sigmaw(i)-sigmad)) &
+!!                     - wdens(i)*tau_wk_inv_min &
+!!                     - 2.*gfl(i)*wdens(i)*Cstar(i) )*dtimesub
+!jyg+mlt<
+          d_awdens(i) = ( wgen(i) - (1./tau_cv)*(awdens(i) - act(i)*wdens(i)) )*dtimesub
+          d_dens_gen(i) = wgen(i)
+          d_dens_death(i) = - (wdens(i)-awdens(i))*tau_wk_inv_min 
+          d_dens_col(i) =  -2.*wdens(i)*gfl(i)*drdt_pos 
+          d_dens_gen(i) =  d_dens_gen(i)*dtimesub
+          d_dens_death(i) = d_dens_death(i)*dtimesub
+          d_dens_col(i) =  d_dens_col(i)*dtimesub 
+
+          d_wdens(i) = d_dens_gen(i)+d_dens_death(i)+d_dens_col(i)
+!!          d_wdens(i) = ( wgen(i) - (wdens(i)-awdens(i))*tau_wk_inv_min -  &
+!!                         2.*wdens(i)*gfl(i)*drdt_pos )*dtimesub
+!>jyg+mlt
+!
+!jyg<
+          d_wdens_targ = max(d_wdens(i), wdensmin-wdens(i))
+!!          d_dens_bnd(i) = d_dens_bnd(i) + d_wdens_targ - d_wdens(i)
+          d_dens_bnd(i) = d_wdens_targ - d_wdens(i)
+          d_wdens(i) = d_wdens_targ
+!!          d_wdens(i) = max(d_wdens(i), wdensmin-wdens(i))
+!>jyg
+
+!jyg+mlt<
+!!          d_sigmaw(i) = ( (1.-2*f_shear(i)*sigmaw(i))*(gfl(i)*Cstar(i)+wgen(i)*sigmad/wdens(i)) &
+!!                      + 2.*f_shear(i)*wgen(i)*sigmaw(i)**2/wdens(i) &
+!!                      - sigmaw(i)*tau_wk_inv_min )*dtimesub
+          d_sig_gen(i) = wgen(i)*aa0
+!!          print*, 'XXX sigmaw(i), awdens(i), wdens(i), tau_wk_inv_min', &
+!!                  sigmaw(i), awdens(i), wdens(i), tau_wk_inv_min
+          d_sig_death(i) = - sigmaw(i)*(1.-awdens(i)/wdens(i))*tau_wk_inv_min
+!!        
+          
+          d_sig_col(i) = - 2*f_shear(i)*sigmaw(i)*gfl(i)*drdt_pos
+          d_sig_col(i) = - 2*f_shear(i)*(2.*sigmaw(i)-wdens(i)*aa0)*gfl(i)*drdt_pos
+          d_sig_spread(i) = gfl(i)*cstar(i)
+          d_sig_gen(i) =  d_sig_gen(i)*dtimesub
+          d_sig_death(i) = d_sig_death(i)*dtimesub
+          d_sig_col(i) =  d_sig_col(i)*dtimesub 
+          d_sig_spread(i) =  d_sig_spread(i)*dtimesub 
+          d_sigmaw(i) =  d_sig_gen(i) + d_sig_death(i) + d_sig_col(i) + d_sig_spread(i)
+!>jyg+mlt
+!
+!jyg<
+          d_sigmaw_targ = max(d_sigmaw(i), sigmad-sigmaw(i))
+!!          d_sig_bnd(i) = d_sig_bnd(i) + d_sigmaw_targ - d_sigmaw(i)
+!!          d_sig_bnd_provis(i) = d_sigmaw_targ - d_sigmaw(i)
+          d_sig_bnd(i) = d_sigmaw_targ - d_sigmaw(i)
+          d_sigmaw(i) = d_sigmaw_targ
+!!          d_sigmaw(i) = max(d_sigmaw(i), sigmad-sigmaw(i))
+!>jyg
+        ENDIF
+      ENDDO
+
+      IF (prt_level >= 10) THEN
+        print *,'wake, cstar(1), cstar(1)/cstart, rad_wk(1), tau_wk_inv(1), drdt(1) ', &
+                       cstar(1), cstar(1)/cstart, rad_wk(1), tau_wk_inv(1), drdt(1)
+        print *,'wake, wdens(1), awdens(1), act(1), d_awdens(1) ', &
+                       wdens(1), awdens(1), act(1), d_awdens(1)
+        print *,'wake, wgen, -(wdens-awdens)*tau_wk_inv, -2.*wdens*gfl*drdt_pos, d_wdens ', &
+                       wgen(1), -(wdens(1)-awdens(1))*tau_wk_inv(1), -2.*wdens(1)*gfl(1)*drdt_pos, d_wdens(1)
+        print *,'wake, d_sig_gen(1), d_sig_death(1), d_sig_col(1), d_sigmaw(1) ', &
+                       d_sig_gen(1), d_sig_death(1), d_sig_col(1), d_sigmaw(1)
+      ENDIF
+    
+    RETURN 
+    END SUBROUTINE wake_popdyn_1
+    
+    SUBROUTINE wake_popdyn_2 ( klon, klev, wk_adv, dtimesub, wgen, &
+                             sigmaw, wdens, awdens, &   !! states variables
+                             gfl, cstar, cin, wape, rad_wk, &
+                             d_sigmaw, d_wdens, d_awdens, &  !! tendences 
+                             cont_fact, &
+                             d_sig_gen, d_sig_death, d_sig_col, d_sig_spread, d_sig_bnd, &
+                             d_dens_gen, d_dens_death, d_dens_col, d_dens_bnd, &
+                             d_adens_death, d_adens_icol, d_adens_acol, d_adens_bnd )
+                             
+                                             
+
+  USE lmdz_wake_ini , ONLY : wake_ini
+  USE lmdz_wake_ini , ONLY : prt_level,RG
+  USE lmdz_wake_ini , ONLY : stark, wdens_ref
+  USE lmdz_wake_ini , ONLY : tau_cv, rzero, aa0
+  USE lmdz_wake_ini , ONLY : iflag_wk_pop_dyn, wdensmin
+  USE lmdz_wake_ini , ONLY : sigmad, cstart, sigmaw_max
+  
+IMPLICIT NONE
+
+  INTEGER, INTENT(IN)                                   :: klon,klev
+  LOGICAL, DIMENSION (klon),        INTENT(IN)          :: wk_adv
+  REAL,                             INTENT(IN)          :: dtimesub
+  REAL, DIMENSION (klon),           INTENT(IN)          :: wgen      !! B = birth rate of wakes
+  REAL, DIMENSION (klon),           INTENT(INOUT)       :: sigmaw    !! sigma = fractional area of wakes 
+  REAL, DIMENSION (klon),           INTENT(INOUT)       :: wdens     !! D = number of wakes per unit area 
+  REAL, DIMENSION (klon),           INTENT(INOUT)       :: awdens    !! A = number of active wakes per unit area
+  REAL, DIMENSION (klon),           INTENT(IN)          :: gfl       !! Lg = gust front lenght per unit area
+  REAL, DIMENSION (klon),           INTENT(IN)          :: cstar     !! C* = spreading velocity of wakes
+  REAL, DIMENSION (klon),           INTENT(IN)          :: cin, wape  ! RM : A Faire disparaitre
+  REAL, DIMENSION (klon),           INTENT(IN)          :: rad_wk    !! r = wake radius
+
+!  
+  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_sigmaw, d_wdens, d_awdens
+  REAL, DIMENSION (klon),           INTENT(OUT)         :: cont_fact  !! RM facteur de contact = 2 pi * rad * C*
+  ! Some components of the tendencies of state variables  
+  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_sig_gen, d_sig_death, d_sig_col, d_sig_spread, d_sig_bnd
+  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_dens_gen, d_dens_death, d_dens_col, d_dens_bnd
+  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_adens_death, d_adens_icol, d_adens_acol, d_adens_bnd
+
+
+!! internal variables
+  
+  INTEGER                                               :: i, k
+  REAL, DIMENSION (klon)                                :: tau_wk_inv      !! tau = life time of wakes
+  REAL                                                  :: tau_wk_inv_min
+  REAL, DIMENSION (klon)                                :: tau_prime       !! tau_prime = life time of actives wakes
+  REAL                                                  :: d_wdens_targ, d_sigmaw_targ
+  
+
+!! Equations
+!! dD/dt = B - (D-A)/tau - f D^2
+!! dA/dt = B - A/tau_prime + f (D-A)^2 - f A^2
+!! dsigma/dt = B a0 - sigma/D (D-A)/tau + Lg C* - f (D-A)^2 (sigma/D-a0)
+!!
+!! f = 2 (B (a0-sigma/D) + Lg C*) / (2 (D-A)^2 (2 sigma/D-a0) + D (1-2 sigma))
+
+
+      DO i = 1, klon
+       ! print*, 'XXX wk_adv(i)', wk_adv(i)
+        IF (wk_adv(i)) THEN
+!!          tau_wk(i) = max(rad_wk(i)/(3.*cstar(i))*((cstar(i)/cstart)**1.5 - 1), 100.)
+          tau_wk_inv(i) = max( (3.*cstar(i))/(rad_wk(i)*((cstar(i)/cstart)**1.5 - 1)), 0.)
+          tau_wk_inv_min = min(tau_wk_inv(i), 1./dtimesub)
+          tau_prime(i) = tau_cv
+!!          cont_fact(i) = 2.*(wgen(i)*(aa0-sigmaw(i)/wdens(i)) + gfl(i)*cstar(i)) / &
+!!                             (2.*(wdens(i)-awdens(i))**2*(2.*sigmaw(i)/wdens(i) - aa0) + wdens(i)*(1.-2.*sigmaw(i)))
+!!          cont_fact(i) = 2.*3.14*rad_wk(i)*cstar(i)     ! bug
+!!          cont_fact(i) = 4.*3.14*rad_wk(i)*cstar(i)
+          cont_fact(i) = 2.*gfl(i)*cstar(i)/wdens(i)
+
+          d_sig_gen(i) = wgen(i)*aa0
+          d_sig_death(i) = - sigmaw(i)*(1.-awdens(i)/wdens(i))*tau_wk_inv_min
+          d_sig_col(i) = - cont_fact(i)*(wdens(i)-awdens(i))**2*(2.*sigmaw(i)/wdens(i)-aa0)
+          d_sig_spread(i) = gfl(i)*cstar(i)
+!
+          d_sig_gen(i) =  d_sig_gen(i)*dtimesub
+          d_sig_death(i) = d_sig_death(i)*dtimesub
+          d_sig_col(i) =  d_sig_col(i)*dtimesub 
+          d_sig_spread(i) =  d_sig_spread(i)*dtimesub 
+          d_sigmaw(i) =  d_sig_gen(i) + d_sig_death(i) + d_sig_col(i) + d_sig_spread(i)
+
+         
+          d_sigmaw_targ = max(d_sigmaw(i), sigmad-sigmaw(i))
+!!          d_sig_bnd(i) = d_sig_bnd(i) + d_sigmaw_targ - d_sigmaw(i)
+!!          d_sig_bnd_provis(i) = d_sigmaw_targ - d_sigmaw(i)
+          d_sig_bnd(i) = d_sigmaw_targ - d_sigmaw(i)
+          d_sigmaw(i) = d_sigmaw_targ
+!!          d_sigmaw(i) = max(d_sigmaw(i), sigmad-sigmaw(i))
+         
+         
+          d_dens_gen(i) = wgen(i)
+          d_dens_death(i) = - (wdens(i)-awdens(i))*tau_wk_inv_min 
+          d_dens_col(i) =  - cont_fact(i)*wdens(i)**2
+! 
+          d_dens_gen(i) =  d_dens_gen(i)*dtimesub
+          d_dens_death(i) = d_dens_death(i)*dtimesub
+          d_dens_col(i) =  d_dens_col(i)*dtimesub 
+          d_wdens(i) = d_dens_gen(i) + d_dens_death(i) + d_dens_col(i)
+
+
+          d_adens_death(i) = -awdens(i)/tau_prime(i)
+          d_adens_icol(i) = cont_fact(i)*(wdens(i)-awdens(i))**2
+          d_adens_acol(i) = - cont_fact(i)*awdens(i)**2
+!
+          d_adens_death(i) =  d_adens_death(i)*dtimesub
+          d_adens_icol(i) =   d_adens_icol(i)*dtimesub
+          d_adens_acol(i) =   d_adens_acol(i)*dtimesub
+          d_awdens(i) =   d_dens_gen(i) + d_adens_death(i) + d_adens_icol(i) + d_adens_acol(i)     
+            
+!!
+          d_wdens_targ = max(d_wdens(i), wdensmin-wdens(i))
+!!          d_dens_bnd(i) = d_dens_bnd(i) + d_wdens_targ - d_wdens(i)
+          d_dens_bnd(i) = d_wdens_targ - d_wdens(i)
+          d_wdens(i) = d_wdens_targ
+          
+          d_wdens_targ = min(max(d_awdens(i),-awdens(i)), wdens(i)-awdens(i))
+!!          d_dens_bnd(i) = d_dens_bnd(i) + d_wdens_targ - d_wdens(i)
+          d_adens_bnd(i) = d_wdens_targ - d_awdens(i)
+          d_awdens(i) = d_wdens_targ
+
+
+
+        ENDIF
+      ENDDO
+
+      IF (prt_level >= 10) THEN
+        print *,'wake, cstar(1), cstar(1)/cstart, rad_wk(1), tau_wk_inv(1), cont_fact(1) ', &
+                       cstar(1), cstar(1)/cstart, rad_wk(1), tau_wk_inv(1), cont_fact(1)
+        print *,'wake, wdens(1), awdens(1), d_awdens(1) ', &
+                       wdens(1), awdens(1), d_awdens(1)
+        print *,'wake, d_sig_gen(1), d_sig_death(1), d_sig_col(1), d_sigmaw(1) ', &
+                       d_sig_gen(1), d_sig_death(1), d_sig_col(1), d_sigmaw(1)
+      ENDIF
+sigmaw=sigmaw+d_sigmaw
+wdens=wdens+d_wdens
+awdens=awdens+d_awdens
+
+    RETURN 
+    END SUBROUTINE wake_popdyn_2  
+  
+END MODULE lmdz_wake
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_wake_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_wake_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lmdz_wake_ini.F90	(revision 4727)
@@ -0,0 +1,225 @@
+MODULE lmdz_wake_ini
+IMPLICIT NONE 
+
+
+  ! ============================================================================
+
+
+  ! But : Decrire le comportement des poches froides apparaissant dans les
+  ! grands systemes convectifs, et fournir l'energie disponible pour
+  ! le declenchement de nouvelles colonnes convectives.
+
+  ! State variables : 
+  ! deltatw    : temperature difference between wake and off-wake regions
+  ! deltaqw    : specific humidity difference between wake and off-wake regions
+  ! sigmaw     : fractional area covered by wakes.
+  ! wdens      : number of wakes per unit area
+
+  ! -------------------------------------------------------------------------
+  ! Declaration de variables
+  ! -------------------------------------------------------------------------
+
+  ! Variables a fixer
+!jyg<
+!!  REAL, SAVE                                            :: stark, wdens_ref, coefgw, alpk
+  INTEGER, SAVE, PROTECTED                                         :: prt_level
+  REAL, SAVE, PROTECTED, DIMENSION(2)                              :: wdens_ref
+  REAL, SAVE, PROTECTED                                            :: stark, coefgw, alpk, wk_pupper
+!>jyg
+  REAL, SAVE, PROTECTED                                            :: crep_upper, crep_sol  
+  !$OMP THREADPRIVATE(stark, wdens_ref, coefgw, alpk, wk_pupper, crep_upper, crep_sol)
+
+  REAL, SAVE, PROTECTED                                            :: tau_cv
+  !$OMP THREADPRIVATE(tau_cv)
+  REAL, SAVE, PROTECTED                                            :: rzero, aa0 ! minimal wake radius and area
+  !$OMP THREADPRIVATE(rzero, aa0)
+
+  LOGICAL, SAVE, PROTECTED                                         :: ok_bug_gfl
+  !$OMP THREADPRIVATE(ok_bug_gfl)
+  LOGICAL, SAVE, PROTECTED                                         :: flag_wk_check_trgl
+  !$OMP THREADPRIVATE(flag_wk_check_trgl)
+  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_act
+  !$OMP THREADPRIVATE(iflag_wk_act)
+
+  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_check_trgl
+  !$OMP THREADPRIVATE(iflag_wk_check_trgl)
+  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_pop_dyn
+  !$OMP THREADPRIVATE(iflag_wk_pop_dyn)
+
+  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_profile
+  !$OMP THREADPRIVATE(iflag_wk_profile)
+
+  REAL, SAVE, PROTECTED                                            :: wdensmin
+  !$OMP THREADPRIVATE(wdensmin)
+  REAL, SAVE, PROTECTED                                            :: sigmad, hwmin, wapecut, cstart
+  !$OMP THREADPRIVATE(sigmad, hwmin, wapecut, cstart)
+  REAL, SAVE, PROTECTED                                            :: sigmaw_max
+  !$OMP THREADPRIVATE(sigmaw_max)  
+  REAL, SAVE, PROTECTED                                            :: dens_rate
+  !$OMP THREADPRIVATE(dens_rate)
+  REAL, SAVE, PROTECTED                                            :: epsilon_loc
+  !$OMP THREADPRIVATE(epsilon_loc)
+  REAL, SAVE, PROTECTED                                            :: epsim1,RG,RD
+  !$OMP THREADPRIVATE(epsim1,RG,RD)
+
+
+
+CONTAINS
+
+  ! =========================================================================
+  SUBROUTINE wake_ini(rg_in,rd_in,rv_in,prt_lev)
+  ! =========================================================================
+
+  ! **************************************************************
+  ! *
+  ! WAKE                                                        *
+  ! retour a un Pupper fixe                                *
+  ! *
+  ! written by   :  GRANDPEIX Jean-Yves   09/03/2000            *
+  ! modified by :   ROEHRIG Romain        01/29/2007            *
+  ! **************************************************************
+
+  ! -------------------------------------------------------------------------
+  ! Initialisations
+  ! -------------------------------------------------------------------------
+
+  USE ioipsl_getin_p_mod, ONLY : getin_p
+  real eps
+  integer, intent(in) :: prt_lev
+  real, intent(in) :: rg_in,rd_in,rv_in
+
+  prt_level=prt_lev
+  epsilon_loc=1.E-15
+  wapecut=1. ! previously 5.
+  ! Essais d'initialisation avec sigmaw = 0.02 et hw = 10.
+  sigmad=0.02
+  hwmin=10.
+!!  DATA wdensmin/1.e-12/
+  wdensmin=1.e-14
+  ! cc nrlmd
+  sigmaw_max=0.4
+  dens_rate=0.1
+
+  eps = rd_in/rv_in
+  epsim1 = 1.0/eps - 1.0
+  RG=rg_in
+  RD=rd_in
+
+
+  ! cc
+  ! Longueur de maille (en m)
+  ! -------------------------------------------------------------------------
+
+  ! ALON = 3.e5
+  ! alon = 1.E6
+
+  ! Configuration de coefgw,stark,wdens (22/02/06 by YU Jingmei)
+
+  ! coefgw : Coefficient pour les ondes de gravite
+  ! stark : Coefficient k dans Cstar=k*sqrt(2*WAPE)
+  ! wdens : Densite surfacique de poche froide
+  ! -------------------------------------------------------------------------
+
+  ! cc nrlmd      coefgw=10
+  ! coefgw=1
+  ! wdens0 = 1.0/(alon**2)
+  ! cc nrlmd      wdens = 1.0/(alon**2)
+  ! cc nrlmd      stark = 0.50
+  ! CRtest
+  ! cc nrlmd      alpk=0.1
+  ! alpk = 1.0
+  ! alpk = 0.5
+  ! alpk = 0.05
+
+
+
+  crep_upper = 0.9
+  crep_sol = 1.0
+
+  ! Flag concerning the bug in gfl computation
+  ok_bug_gfl = .True.
+  call getin_p('ok_bug_gfl', ok_bug_gfl)
+
+  ! Get wapecut from parameter file
+  wapecut = 1.
+
+print*,'wapecut',wapecut
+  CALL getin_p('wapecut', wapecut)
+print*,'wapecut',wapecut
+
+  ! cc nrlmd Lecture du fichier wake_param.data
+
+
+  ! cc nrlmd Lecture du fichier wake_param.data
+  stark=0.33
+  CALL getin_p('stark',stark)
+  cstart = stark*sqrt(2.*wapecut)
+
+  alpk=0.25
+  CALL getin_p('alpk',alpk)
+  
+  wk_pupper=0.6
+  CALL getin_p('wk_pupper',wk_pupper)
+
+
+!jyg<
+!!  wdens_ref=8.E-12
+!!  CALL getin_p('wdens_ref',wdens_ref)
+  wdens_ref(1)=8.E-12
+  wdens_ref(2)=8.E-12
+  CALL getin_p('wdens_ref_o',wdens_ref(1))    !wake number per unit area ; ocean
+  CALL getin_p('wdens_ref_l',wdens_ref(2))    !wake number per unit area ; land
+!>jyg
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!  Population dynamics parameters    !!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!------------------------------------------------------------------------ 
+
+  iflag_wk_pop_dyn = 0
+  CALL getin_p('iflag_wk_pop_dyn',iflag_wk_pop_dyn) ! switch between wdens prescribed 
+                                                    ! and wdens prognostic
+  iflag_wk_act = 0
+  CALL getin_p('iflag_wk_act',iflag_wk_act) ! 0: act(:)=0.
+                                            ! 1: act(:)=1.
+                                            ! 2: act(:)=f(Wape)
+
+  iflag_wk_profile = 0
+  CALL getin_p('iflag_wk_profile',iflag_wk_profile) ! switch between wdens prescribed 
+                                                    ! and wdens prognostic
+  rzero = 5000.
+  CALL getin_p('rzero_wk', rzero)
+  aa0 = 3.14*rzero*rzero
+!
+  tau_cv = 4000.
+  CALL getin_p('tau_cv', tau_cv)
+
+!------------------------------------------------------------------------ 
+
+  coefgw=4.
+  CALL getin_p('coefgw',coefgw)
+
+  WRITE(*,*) 'stark=', stark
+  WRITE(*,*) 'alpk=', alpk
+  WRITE(*,*) 'wk_pupper=', wk_pupper
+!jyg<
+!!  WRITE(*,*) 'wdens_ref=', wdens_ref
+  WRITE(*,*) 'wdens_ref_o=', wdens_ref(1)
+  WRITE(*,*) 'wdens_ref_l=', wdens_ref(2)
+!>jyg
+  WRITE(*,*) 'iflag_wk_pop_dyn=',iflag_wk_pop_dyn
+  WRITE(*,*) 'iflag_wk_act',iflag_wk_act
+  WRITE(*,*) 'coefgw=', coefgw 
+
+  flag_wk_check_trgl=.false.
+  CALL getin_p('flag_wk_check_trgl ', flag_wk_check_trgl)
+  WRITE(*,*) 'flag_wk_check_trgl=', flag_wk_check_trgl
+  WRITE(*,*) 'flag_wk_check_trgl OBSOLETE. Utilisr iflag_wk_check_trgl plutot'
+  iflag_wk_check_trgl=0 ; IF (flag_wk_check_trgl) iflag_wk_check_trgl=1
+  CALL getin_p('iflag_wk_check_trgl ', iflag_wk_check_trgl)
+  WRITE(*,*) 'iflag_wk_check_trgl=', iflag_wk_check_trgl
+
+ RETURN
+
+END SUBROUTINE wake_ini
+
+END MODULE lmdz_wake_ini
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lsc_scav.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lsc_scav.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lsc_scav.F90	(revision 4727)
@@ -1,11 +1,8 @@
 !$Id $
 
-SUBROUTINE lsc_scav(pdtime,it,iflag_lscav,  &
-!jyg<
-                    aerosol,  &
-!>jyg
+SUBROUTINE lsc_scav(pdtime,it,iflag_lscav, aerosol,  &
                     oliq,flxr,flxs,rneb,beta_fisrt,  &
-                    beta_v1,pplay,paprs,t,tr_seri,d_tr_insc,          &
-                    d_tr_bcscav,d_tr_evap,qPrls) 
+                    beta_v1,pplay,paprs,t,tr_seri,   & 
+                    d_tr_insc,d_tr_bcscav,d_tr_evap,qPrls) 
   USE ioipsl
   USE dimphy
@@ -27,8 +24,8 @@
   include "YOECUMF.h" 
 
+! inputs
   REAL,INTENT(IN)                        :: pdtime ! time step (s)
   INTEGER,INTENT(IN)                     :: it     ! tracer number
-  INTEGER,INTENT(IN)                     :: iflag_lscav ! LS scavenging param:
-!                                             3=Reddy_Boucher2004, 4=3+RPilon.
+  INTEGER,INTENT(IN)                     :: iflag_lscav ! LS scavenging param: 3=Reddy_Boucher2004, 4=3+RPilon.
   REAL,DIMENSION(klon,klev+1),INTENT(IN) :: flxr     ! flux precipitant de pluie
   REAL,DIMENSION(klon,klev+1),INTENT(IN) :: flxs     ! flux precipitant de neige
@@ -51,7 +48,6 @@
   REAL,DIMENSION(klon,klev) :: dxbc       ! tendance temporaire de traceur bc
 
-
 !  variables locales      
- LOGICAL,SAVE :: debut=.true.
+ LOGICAL,SAVE :: debut=.TRUE.
 !$OMP THREADPRIVATE(debut)
 !
@@ -90,20 +86,8 @@
 !$OMP THREADPRIVATE(alpha_r, alpha_s, R_r, R_s)
   REAL           :: pr, ps, ice, water
-  real :: conserv
-!
-!!!!!!!!!!!!!!!!!!!! choix lessivage !!!!!!!!!!!!!!!!!!!!!!!!
-!!  logical,save  :: inscav_fisrt
-!!! $OMP THREADPRIVATE(inscav_first)
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!  REAL :: conserv
+!
+!
   IF (debut) THEN
-!
-!  inscav_fisrt=.true.
-!  call getin('inscav_fisrt',inscav_fisrt)
-!  if(inscav_fisrt) then 
-!   print*,'beta from fisrtilp.F90, beta = (z_cond - z_oliq)/z_cond, inscav_fisrt=',inscav_fisrt
-!  else
-!   print*,'beta from Reddy and Bocuher 2004 (original version), inscav_fisrt=',inscav_fisrt
-!  endif
 !
       alpha_r=0.001        !  coefficient d'impaction pour la pluie
@@ -113,6 +97,7 @@
       frac_fine_scav=0.7
       frac_coar_scav=0.7
-!     frac_aer=0.5 ~ droplet size shrinks by evap
+!     Droplet size shrinks by evap
       frac_aer=0.5
+      debut=.FALSE.
 !
       OPEN(99,file='lsc_scav_param.data',status='old', &
@@ -125,7 +110,7 @@
       READ(99,*,end=9998)  frac_coar_scav
       READ(99,*,end=9998)  frac_aer
-9998  Continue
+9998  CONTINUE
       CLOSE(99)
-9999  Continue
+9999  CONTINUE
 
    print*,'alpha_r',alpha_r
@@ -136,5 +121,4 @@
    print*,'frac_coar_scav',frac_coar_scav
    print*,'frac_aer ev',frac_aer
-
 !
   ENDIF !(debut)
@@ -158,14 +142,6 @@
   ENDDO
 
-  DO k=1,klev
-    DO i=1, klon
-     d_tr_insc(i,k,it)=0.
-     d_tr_bcscav(i,k,it)=0.
-     d_tr_evap(i,k,it)=0.
-    ENDDO
-  ENDDO
-
 !  pressure and size of the layer
-  DO k=klev-1, 1, -1
+  DO k=klev, 1, -1
    DO i=1, klon 
      zrho(i,k)=pplay(i,k)/t(i,k)/RD   
@@ -176,25 +152,21 @@
 
 !jyg<
-!!    IF (it.gt.1) THEN                               !  aerosol   
 !! Temporary correction: all non-aerosol tracers are dealt with in the same way.
 !! Should be updated once it has been decided how gases should be dealt with.
-    IF (aerosol(it)) THEN
-!>jyg
+  IF (aerosol(it)) THEN
       frac_ev=frac_aer
-    ELSE                                                !  gas
+  ELSE                                                !  gas
       frac_ev=frac_gas
-    ENDIF
-
+  ENDIF
+!
 !jyg<
-!!    IF (it.gt.1) THEN                               !  aerosol   
-    IF (aerosol(it)) THEN
-!>jyg
-     DO k=1, klev
+  IF (aerosol(it)) THEN ! aerosol
+    DO k=1, klev
       DO i=1, klon 
        scav(i,k)=frac_fine_scav
       ENDDO 
-     ENDDO
-    ELSE                  ! gas
-     DO k=1, klev
+    ENDDO
+  ELSE                  ! gas
+    DO k=1, klev
       DO i=1, klon 
        henry_t=henry*exp(-kk*(1./298.-1./t(i,k)))    !  mol/l/atm
@@ -202,42 +174,37 @@
        scav(i,k)=f_a/(1.+f_a)
       ENDDO 
-     ENDDO
-    ENDIF
-
-   DO k=klev-1, 1, -1
+    ENDDO
+  ENDIF
+
+  DO k=klev-1, 1, -1
     DO i=1, klon 
 !  incloud scavenging
-!   if(inscav_fisrt) then 
-   if (iflag_lscav .eq. 4) then
-      beta=beta_fisrt(i,k)*rneb(i,k)
-   else
-      beta=flxr(i,k)-flxr(i,k+1)+flxs(i,k)-flxs(i,k+1)
-!      beta=beta/zdz(i,k)/oliq/zrho(i,k)
-      beta=beta/zmass(i,k)/oliq
-      beta=MAX(0.,beta)
-   endif ! (iflag_lscav .eq. 4)
-   beta_v1(i,k)=beta    !! for output
+      IF (iflag_lscav .EQ. 4) THEN
+        beta=beta_fisrt(i,k)*rneb(i,k)
+      ELSE
+        beta=flxr(i,k)-flxr(i,k+1)+flxs(i,k)-flxs(i,k+1)
+        beta=beta/zmass(i,k)/oliq
+        beta=MAX(0.,beta)
+      ENDIF ! (iflag_lscav .eq. 4)
+      beta_v1(i,k)=beta    !! for output
 !
       dxin=tr_seri(i,k,it)*(exp(-scav(i,k)*beta*pdtime)-1.)
-!      his_dh(i)=his_dh(i)-dxin*zrho(i,k)*zdz(i,k)/pdtime !  kg/m2/s
       his_dh(i)=his_dh(i)-dxin*zmass(i,k)/pdtime !  kg/m2/s
-      d_tr_insc(i,k,it)=dxin
+      d_tr_insc(i,k,it)=dxin                     !  kg/kg/timestep
 
 !  below-cloud impaction
 !jyg<
-!!    IF (it.eq.1) THEN
-    IF (.NOT.aerosol(it)) THEN
-!>jyg
-      d_tr_bcscav(i,k,it)=0.
-    ELSE
-     pr=0.5*(flxr(i,k)+flxr(i,k+1))
-     ps=0.5*(flxs(i,k)+flxs(i,k+1))
-     water=pr*alpha_r/R_r/rho_water
-     ice=ps*alpha_s/R_s/rho_ice
-     dxbc(i,k)=-3./4.*tr_seri(i,k,it)*pdtime*(water+ice)
-!   add tracers from below cloud scav in his_dh
-     his_dh(i)=his_dh(i)-dxbc(i,k)*zmass(i,k)/pdtime !  kg/m2/s
-     d_tr_bcscav(i,k,it)=dxbc(i,k)
-    ENDIF
+      IF (.NOT.aerosol(it)) THEN
+        d_tr_bcscav(i,k,it)=0.
+      ELSE
+        pr=0.5*(flxr(i,k)+flxr(i,k+1))
+        ps=0.5*(flxs(i,k)+flxs(i,k+1))
+        water=pr*alpha_r/R_r/rho_water
+        ice=ps*alpha_s/R_s/rho_ice
+        dxbc(i,k)=-3./4.*tr_seri(i,k,it)*pdtime*(water+ice)
+!      add tracers from below cloud scav in his_dh
+        his_dh(i)=his_dh(i)-dxbc(i,k)*zmass(i,k)/pdtime !  kg/m2/s
+        d_tr_bcscav(i,k,it)=dxbc(i,k)                   !  kg/kg/timestep
+      ENDIF
 
 !  reevaporation
@@ -245,47 +212,39 @@
       deltaP(i,k)=max(deltaP(i,k),0.)
 
-      if(flxr(i,k+1)+flxs(i,k+1).gt.1.e-16) then
-       beta_ev(i,k)=deltaP(i,k)/(flxr(i,k+1)+flxs(i,k+1))
-      else
-       beta_ev(i,k)=0.
-      endif
+      IF (flxr(i,k+1)+flxs(i,k+1).GT.1.e-16) THEn
+        beta_ev(i,k)=deltaP(i,k)/(flxr(i,k+1)+flxs(i,k+1))
+      ELSE
+        beta_ev(i,k)=0.
+      ENDIF
 
       beta_ev(i,k)=max(min(1.,beta_ev(i,k)),0.)
 
 !jyg
-      
-      if(abs(1-(1-frac_ev)*beta_ev(i,k)).gt.1.e-16) then
+      IF (ABS(1.-(1.-frac_ev)*beta_ev(i,k)).GT.1.e-16) THEN
 ! remove tracers from precipitation owing to release by evaporation in his_dh
-!      dxev=frac_ev*beta_ev(i,k)*his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k)) &
-      dxev=frac_ev*beta_ev(i,k)*his_dh(i) *pdtime/(zmass(i,k)) &
-                                      /(1 -(1-frac_ev)*beta_ev(i,k))
-       his_dh(i)=his_dh(i)*(1 - frac_ev*beta_ev(i,k) / (1 -(1-frac_ev)*beta_ev(i,k)))
-      else
-!       dxev=his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k))
-       dxev=his_dh(i) *pdtime/(zmass(i,k))
-       his_dh(i)=0.
-      endif
+        dxev=frac_ev*beta_ev(i,k)*his_dh(i)*pdtime/zmass(i,k)/(1.-(1.-frac_ev)*beta_ev(i,k))
+        his_dh(i)=his_dh(i)*(1.-frac_ev*beta_ev(i,k)/(1.-(1.-frac_ev)*beta_ev(i,k)))
+      ELSE
+        dxev=his_dh(i)*pdtime/zmass(i,k)
+        his_dh(i)=0.
+      ENDIF
+!
 !      print*,  k, 'beta_ev',beta_ev
 ! remove tracers from precipitation owing to release by evaporation in his_dh
-!!      dxev=frac_ev*deltaP(i,k)*pdtime * his_dh(i) /(zrho(i,k)*zdz(i,k))
+!      dxev=frac_ev*deltaP(i,k)*pdtime * his_dh(i) /(zrho(i,k)*zdz(i,k))
 !rplmd
-!!      dxev=frac_ev*deltaP(i,k)*his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k)) &
-!!                                      /max(flxr(i,k)+flxs(i,k),1.e-16)
-
-
-      d_tr_evap(i,k,it)=dxev
-!!     tendency is further added in phytrac x = x + dx
-    ENDDO !!  do i
-   ENDDO  !! do k
-
-!jyg (20130114)
-   DO i = 1,klon
+!      dxev=frac_ev*deltaP(i,k)*his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k))/max(flxr(i,k)+flxs(i,k),1.e-16)
+
+      d_tr_evap(i,k,it)=dxev       !  kg/kg/timestep
+!
+    ENDDO
+  ENDDO
+!
+  DO i = 1,klon
      qPrls(i,it) = his_dh(i)/max(flxr(i,1)+flxs(i,1),1.e-16)
-   ENDDO
-!jyg end
-
-
+  ENDDO
+!
 ! test de conservation
-      conserv=0.
+!      conserv=0.
 !      DO k= klev,1,-1
 !        DO i=1, klon
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/lscp_ini_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lscp_ini_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,90 +1,0 @@
-module lscp_ini_mod
-
-implicit none
-
-  ! PARAMETERS for lscp:
-  !--------------------
-  
-  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 :: 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
-  !$OMP THREADPRIVATE(iflag_evap_prec)
-
-  REAL t_coup                                   ! temperature threshold which determines the phase 
-  PARAMETER (t_coup=234.0)                      ! for which the saturation vapor pressure is calculated
-
-  REAL DDT0                                     ! iteration parameter 
-  PARAMETER (DDT0=.01)
-
-  REAL ztfondue                                 ! parameter to calculate melting fraction of precipitation
-  PARAMETER (ztfondue=278.15)
-
-  REAL, SAVE    :: rain_int_min=0.001           ! Minimum local rain intensity [mm/s] before the decrease in associated precipitation fraction 
-  !$OMP THREADPRIVATE(rain_int_min)
-
-  REAL, SAVE :: a_tr_sca(4)                     ! Variables for tracers temporary: alpha parameter for scavenging, 4 possible scavenging processes
-  !$OMP THREADPRIVATE(a_tr_sca)
-  
-  INTEGER, SAVE ::  iflag_mpc_bl=0              ! flag to activate boundary layer mixed phase cloud param
-  !$OMP THREADPRIVATE(iflag_mpc_bl)
-  
-  LOGICAL, SAVE :: ok_radocond_snow=.false.       ! take into account the mass of ice precip in the cloud ice content seen by radiation
-  !$OMP THREADPRIVATE(ok_radocond_snow)
-
-  LOGICAL, SAVE :: ok_debug_autoconversion=.true.   ! removes a bug in the autoconversion process
-  !$OMP THREADPRIVATE(ok_debug_autoconversion)
-
-
-CONTAINS
-
-SUBROUTINE lscp_ini(dtime,ok_ice_sursat)
-
-
-   USE ioipsl_getin_p_mod, ONLY : getin_p
-   USE print_control_mod, ONLY: prt_level, lunout
-   USE ice_sursat_mod, ONLY: ice_sursat_init
-
-   REAL, INTENT(IN)      :: dtime
-   LOGICAL, INTENT(IN)   :: ok_ice_sursat  
-
-    CALL getin_p('ninter',ninter)
-    CALL getin_p('iflag_evap_prec',iflag_evap_prec)
-    CALL getin_p('seuil_neb',seuil_neb)
-    CALL getin_p('rain_int_min',rain_int_min) 
-    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
-    WRITE(lunout,*) 'lscp, iflag_evap_prec:', iflag_evap_prec
-    WRITE(lunout,*) 'lscp, seuil_neb:', seuil_neb
-    WRITE(lunout,*) 'lscp, rain_int_min:', rain_int_min
-    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
-
-    ! check for precipitation sub-time steps
-    IF (ABS(dtime/REAL(ninter)-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
-
-
-    !AA Temporary initialisation
-    a_tr_sca(1) = -0.5
-    a_tr_sca(2) = -0.5
-    a_tr_sca(3) = -0.5
-    a_tr_sca(4) = -0.5
-    
-    IF (ok_ice_sursat) CALL ice_sursat_init()
-
-
-
-end subroutine lscp_ini
-
-end module lscp_ini_mod
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/lscp_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lscp_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,1276 +1,0 @@
-MODULE lscp_mod
-
-IMPLICIT NONE
-
-CONTAINS
-
-!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-SUBROUTINE lscp(klon,klev,dtime,missing_val,            &
-     paprs,pplay,t,q,ptconv,ratqs,                      &
-     d_t, d_q, d_ql, d_qi, rneb, rneblsvol, rneb_seri,  &
-     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,     &
-     qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss,   &
-     Tcontr, qcontr, qcontr2, fcontrN, fcontrP)
-
-!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-! Authors: Z.X. Li (LMD), J-L Dufresne (LMD), C. Rio (LMD), J-Y Grandpeix (LMD)
-!          A. JAM (LMD), J-B Madeleine (LMD), E. Vignon (LMD), L. Touzze-Peiffert (LMD)
-!--------------------------------------------------------------------------------
-! Date: 01/2021
-!--------------------------------------------------------------------------------
-! Aim: Large Scale Clouds and Precipitation (LSCP)
-!
-! This code is a new version of the fisrtilp.F90 routine, which is itself a 
-! merge of 'first' (superrsaturation physics, P. LeVan K. Laval)
-! and 'ilp' (il pleut, L. Li)
-!
-! Compared to the original fisrtilp code, lscp
-! -> assumes thermcep = .TRUE. all the time (fisrtilp inconsistent when .FALSE.)
-! -> consider always precipitation thermalisation (fl_cor_ebil>0)
-! -> option iflag_fisrtilp_qsat<0 no longer possible (qsat does not evolve with T) 
-! -> option "oldbug" by JYG has been removed
-! -> iflag_t_glace >0 always
-! -> the 'all or nothing' cloud approach is no longer available (cpartiel=T always)
-! -> rectangular distribution from L. Li no longer available
-! -> We always account for the Wegener-Findeisen-Bergeron process (iflag_bergeron = 2 in fisrt) 
-!--------------------------------------------------------------------------------
-! References: 
-!
-! - Bony, S., & Emanuel, K. A. 2001, JAS, doi: 10.1175/1520-0469(2001)058<3158:APOTCA>2.0.CO;2
-! - Hourdin et al. 2013, Clim Dyn, doi:10.1007/s00382-012-1343-y
-! - Jam et al. 2013, Boundary-Layer Meteorol, doi:10.1007/s10546-012-9789-3
-! - Jouhaud, et al. 2018. JAMES, doi:10.1029/2018MS001379
-! - Madeleine et al. 2020, JAMES, doi:10.1029/2020MS002046
-! - Touzze-Peifert Ludo, PhD thesis, p117-124
-! -------------------------------------------------------------------------------
-! Code structure:
-!
-! P0>     Thermalization of the precipitation coming from the overlying layer
-! P1>     Evaporation of the precipitation (falling from the k+1 level)
-! P2>     Cloud formation (at the k level) 
-! P2.A.1> With the PDFs, calculation of cloud properties using the inital
-!         values of T and Q
-! P2.A.2> Coupling between condensed water and temperature
-! P2.A.3> Calculation of final quantities associated with cloud formation
-! P2.B>   Release of Latent heat after cloud formation
-! P3>     Autoconversion to precipitation (k-level)
-! P4>     Wet scavenging
-!------------------------------------------------------------------------------
-! Some preliminary comments (JBM) :
-!
-! The cloud water that the radiation scheme sees is not the same that the cloud
-! water used in the physics and the dynamics 
-! 
-! During the autoconversion to precipitation (P3 step), radocond (cloud water used
-! by the radiation scheme) is calculated as an average of the water that remains
-! in the cloud during the precipitation and not the water remaining at the end
-! of the time step. The latter is used in the rest of the physics and advected
-! by the dynamics. 
-!
-! In summary:
-!
-! Radiation:
-! xflwc(newmicro)+xfiwc(newmicro) =
-!   radocond=lwcon(nc)+iwcon(nc)
-!
-! Notetheless, be aware of:
-!
-! radocond .NE. ocond(nc)
-! i.e.:
-! lwcon(nc)+iwcon(nc) .NE. ocond(nc)
-! but oliq+(ocond-oliq) .EQ. ocond
-! (which is not trivial)
-!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!
-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 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
-
-
-IMPLICIT NONE
-
-!===============================================================================
-! VARIABLES DECLARATION
-!===============================================================================
-
-include "YOMCST.h"
-include "YOETHF.h"
-include "fisrtilp.h"
-include "nuage.h" 
-
-! INPUT VARIABLES:
-!-----------------
-
-  INTEGER,                         INTENT(IN)   :: klon,klev       ! number of horizontal grid points and vertical levels
-  REAL,                            INTENT(IN)   :: dtime           ! time step [s]
-  REAL,                            INTENT(IN)   :: missing_val     ! missing value for output
-
-  REAL, DIMENSION(klon,klev+1),    INTENT(IN)   :: paprs           ! inter-layer pressure [Pa]
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: pplay           ! mid-layer pressure [Pa]
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: t               ! temperature (K)
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: q               ! total specific humidity (= vapor phase) [kg/kg] 
-  INTEGER,                         INTENT(IN)   :: iflag_cld_th    ! flag that determines the distribution of convective clouds
-  INTEGER,                         INTENT(IN)   :: iflag_ice_thermo! flag to activate the ice thermodynamics
-                                                                   ! CR: if iflag_ice_thermo=2, only convection is active
-  LOGICAL,                         INTENT(IN)   :: ok_ice_sursat   ! flag to determine if ice sursaturation is activated
-
-  LOGICAL, DIMENSION(klon,klev),   INTENT(IN)   :: ptconv          ! grid points where deep convection scheme is active
-
-
-  !Inputs associated with thermal plumes
-
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: ztv             ! virtual potential temperature [K]
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: zqta            ! specific humidity within thermals [kg/kg]
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: fraca           ! fraction of thermals within the mesh [-]
-  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):: ratqs            ! function of pressure that sets the large-scale
-  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: beta             ! conversion rate of condensed water
-
-
-  ! Input sursaturation en glace
-  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: rneb_seri        ! fraction nuageuse en memoire
-  
-  ! OUTPUT variables
-  !-----------------
-
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_t              ! temperature increment [K]
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_q              ! specific humidity increment [kg/kg]
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_ql             ! liquid water increment [kg/kg]
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_qi             ! cloud ice mass increment [kg/kg]
-  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)  :: 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
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rhcl             ! clear-sky relative humidity [-]
-  REAL, DIMENSION(klon),           INTENT(OUT)  :: rain             ! surface large-scale rainfall [kg/s/m2] 
-  REAL, DIMENSION(klon),           INTENT(OUT)  :: snow             ! surface large-scale snowfall [kg/s/m2]
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qsatl            ! saturation specific humidity wrt liquid [kg/kg]
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qsats            ! saturation specific humidity wrt ice [kg/kg]  
-  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]
-
-  ! fraction of aerosol scavenging through impaction and nucleation (for on-line)
-  
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_impa        ! scavenging fraction due tu impaction [-]
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_nucl        ! scavenging fraction due tu nucleation [-]
-  
-  ! for supersaturation and contrails parameterisation
-  
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qclr             ! specific total water content in clear sky region [kg/kg]
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qcld             ! specific total water content in cloudy region [kg/kg]
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qss              ! specific total water content in supersat region [kg/kg]
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qvc              ! specific vapor content in clouds [kg/kg] 
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rnebclr          ! mesh fraction of clear sky [-]   
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rnebss           ! mesh fraction of ISSR [-]  
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: gamma_ss         ! coefficient governing the ice nucleation RHi threshold [-]      
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: Tcontr           ! threshold temperature for contrail formation [K]
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qcontr           ! threshold humidity for contrail formation [kg/kg]
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qcontr2          ! // (2nd expression more consistent with LMDZ expression of q)          
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: fcontrN          ! fraction of grid favourable to non-persistent contrails
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: fcontrP          ! fraction of grid favourable to persistent contrails
-  
-
-  ! LOCAL VARIABLES:
-  !----------------
-
-  REAL qsl(klon), qsi(klon)
-  REAL zct, zcl
-  REAL ctot(klon,klev)
-  REAL ctot_vol(klon,klev)
-  REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5
-  REAL zdqsdT_raw(klon)
-  REAL gammasat(klon),dgammasatdt(klon)                ! coefficient to make cold condensation at the correct RH and derivative wrt T
-  REAL Tbef(klon),qlbef(klon),DT(klon),num,denom
-  REAL cste
-  REAL zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
-  REAL Zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon)
-  REAL erf
-  REAL qcloud(klon), icefrac_mpc(klon,klev), qincloud_mpc(klon)
-  REAL zrfl(klon), zrfln(klon), zqev, zqevt 
-  REAL zifl(klon), zifln(klon), ziflprev(klon),zqev0,zqevi, zqevti
-  REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon)
-  REAL zoliql(klon), zoliqi(klon)
-  REAL zt(klon)
-  REAL zdz(klon),zrho(klon,klev),iwc(klon)
-  REAL zchau,zfroi,zfice(klon),zneb(klon),znebprecip(klon)
-  REAL zmelt,zrain,zsnow,zprecip
-  REAL dzfice(klon)
-  REAL zsolid
-  REAL qtot(klon), qzero(klon)
-  REAL dqsl(klon),dqsi(klon)
-  REAL smallestreal
-  !  Variables for Bergeron process
-  REAL zcp, coef1, DeltaT, Deltaq, Deltaqprecl
-  REAL zqpreci(klon), zqprecl(klon)
-  ! Variables precipitation energy conservation
-  REAL zmqc(klon)
-  REAL zalpha_tr
-  REAL zfrac_lessi
-  REAL zprec_cond(klon)
-  REAL zmair(klon), zcpair, zcpeau
-  REAL zlh_solid(klon), zm_solid         ! for liquid -> solid conversion
-  REAL zrflclr(klon), zrflcld(klon)
-  REAL d_zrfl_clr_cld(klon), d_zifl_clr_cld(klon)
-  REAL d_zrfl_cld_clr(klon), d_zifl_cld_clr(klon) 
-  REAL ziflclr(klon), ziflcld(klon)
-  REAL znebprecipclr(klon), znebprecipcld(klon)
-  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 qlmpc, qimpc, rnebmpc
-  REAL radocondi(klon,klev), radocondl(klon,klev)
-
-  INTEGER i, k, n, kk
-  INTEGER n_i(klon), iter
-  INTEGER ncoreczq
-  INTEGER mpc_bl_points(klon,klev)
-
-  LOGICAL lognormale(klon)
-  LOGICAL keepgoing(klon)
-  LOGICAL,SAVE :: appel1er
-  !$OMP THREADPRIVATE(appel1er)
-
-  CHARACTER (len = 20) :: modname = 'lscp'
-  CHARACTER (len = 80) :: abort_message
-  
-  DATA appel1er /.TRUE./
-
-!===============================================================================
-! INITIALISATION
-!===============================================================================
-
-! 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
-    abort_message = 'lscp cannot be used with iflag_fisrtilp<0'
-    CALL abort_physic(modname,abort_message,1)
-ENDIF
-
-! Few initialisations
-
-znebprecip(:)=0.0
-ctot_vol(1:klon,1:klev)=0.0
-rneblsvol(1:klon,1:klev)=0.0
-smallestreal=1.e-9
-znebprecipclr(:)=0.0
-znebprecipcld(:)=0.0
-mpc_bl_points(:,:)=0
-
-IF (prt_level>9) WRITE(lunout,*) 'NUAGES4 A. JAM'
-
-! AA for 'safety' reasons
-zalpha_tr   = 0.
-zfrac_lessi = 0.
-beta(:,:)= 0.
-
-! Initialisation of variables:
-
-prfl(:,:) = 0.0
-psfl(:,:) = 0.0
-d_t(:,:) = 0.0
-d_q(:,:) = 0.0
-d_ql(:,:) = 0.0
-d_qi(:,:) = 0.0
-rneb(:,:) = 0.0
-radocond(:,:) = 0.0
-radicefrac(:,:) = 0.0
-frac_nucl(:,:) = 1.0 
-frac_impa(:,:) = 1.0 
-rain(:) = 0.0
-snow(:) = 0.0
-zoliq(:)=0.0
-zfice(:)=0.0
-dzfice(:)=0.0
-zqprecl(:)=0.0
-zqpreci(:)=0.0
-zrfl(:) = 0.0
-zifl(:) = 0.0
-ziflprev(:)=0.0
-zneb(:) = seuil_neb
-zrflclr(:) = 0.0
-ziflclr(:) = 0.0
-zrflcld(:) = 0.0
-ziflcld(:) = 0.0
-tot_zneb(:) = 0.0
-tot_znebn(:) = 0.0
-d_tot_zneb(:) = 0.0
-qzero(:) = 0.0
-
-!--ice supersaturation
-gamma_ss(:,:) = 1.0
-qss(:,:) = 0.0
-rnebss(:,:) = 0.0
-Tcontr(:,:) = missing_val
-qcontr(:,:) = missing_val
-qcontr2(:,:) = missing_val
-fcontrN(:,:) = 0.0
-fcontrP(:,:) = 0.0
-
-!c_iso: variable initialisation for iso 
-
-
-!===============================================================================
-!              BEGINNING OF VERTICAL LOOP FROM TOP TO BOTTOM
-!===============================================================================
-
-ncoreczq=0
-
-DO k = klev, 1, -1
-
-    ! Initialisation temperature and specific humidity
-    DO i = 1, klon
-        zt(i)=t(i,k)
-        zq(i)=q(i,k)
-        !c_iso init of iso
-    ENDDO
-    
-    ! --------------------------------------------------------------------
-    ! P0> Thermalization of precipitation falling from the overlying layer
-    ! --------------------------------------------------------------------
-    ! Computes air temperature variation due to enthalpy transported by
-    ! precipitation. Precipitation is then thermalized with the air in the
-    ! layer. 
-    ! The precipitation should remain thermalized throughout the different
-    ! thermodynamical transformations. 
-    ! The corresponding water mass should
-    ! be added when calculating the layer's enthalpy change with 
-    ! temperature
-    ! See lmdzpedia page todoan
-    ! todoan: check consistency with ice phase
-    ! todoan: understand why several steps
-    ! ---------------------------------------------------------------------
-    
-    IF (k.LE.klev-1) THEN 
-
-        DO i = 1, klon
- 
-            zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
-            ! no condensed water so cp=cp(vapor+dry air)
-            ! RVTMP2=rcpv/rcpd-1
-            zcpair=RCPD*(1.0+RVTMP2*zq(i)) 
-            zcpeau=RCPD*RVTMP2
-
-            ! zmqc: precipitation mass that has to be thermalized with 
-            ! layer's air so that precipitation at the ground has the
-            ! same temperature as the lowermost layer
-            zmqc(i) = (zrfl(i)+zifl(i))*dtime/zmair(i)
-            ! t(i,k+1)+d_t(i,k+1): new temperature of the overlying layer
-            zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zmqc(i)*zcpeau + zcpair*zt(i) ) &
-             / (zcpair + zmqc(i)*zcpeau)
-
-        ENDDO
- 
-    ELSE
- 
-        DO i = 1, klon 
-            zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG 
-            zmqc(i) = 0.
-        ENDDO
- 
-    ENDIF
-
-    ! --------------------------------------------------------------------
-    ! P1> Precipitation evaporation/sublimation
-    ! --------------------------------------------------------------------
-    ! A part of the precipitation coming from above is evaporated/sublimated.
-    ! --------------------------------------------------------------------
-
-    IF (iflag_evap_prec.GE.1) THEN 
-
-        ! Calculation of saturation specific humidity
-        ! depending on temperature:
-        CALL calc_qsat_ecmwf(klon,zt(:),qzero(:),pplay(:,k),RTT,0,.false.,zqs(:),zdqs(:))
-        ! wrt liquid water
-        CALL calc_qsat_ecmwf(klon,zt(:),qzero(:),pplay(:,k),RTT,1,.false.,qsl(:),dqsl(:))
-        ! wrt ice
-        CALL calc_qsat_ecmwf(klon,zt(:),qzero(:),pplay(:,k),RTT,2,.false.,qsi(:),dqsi(:))
-
-        DO i = 1, klon
-
-            ! if precipitation
-            IF (zrfl(i)+zifl(i).GT.0.) THEN
-
-            ! 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
-                    zrfl(i) = zrflclr(i)
-                    zifl(i) = ziflclr(i)
-                ENDIF
-
-                IF (iflag_evap_prec.EQ.1) THEN
-                    znebprecip(i)=zneb(i)
-                ELSE
-                    znebprecip(i)=MAX(zneb(i),znebprecip(i))
-                ENDIF
-
-                IF (iflag_evap_prec.EQ.4) THEN
-                ! Max evaporation not to saturate the whole mesh
-                    zqev0 = MAX(0.0, zqs(i)-zq(i))
-                ELSE
-                ! Max evap not to saturate the fraction below the cloud
-                    zqev0 = MAX(0.0, (zqs(i)-zq(i))*znebprecip(i))
-                ENDIF
-
-                ! Evaporation of liquid precipitation coming from above
-                ! 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)
-
-                IF (iflag_evap_prec.EQ.3) THEN
-                    zqevt = znebprecip(i)*coef_eva*(1.0-zq(i)/qsl(i)) &
-                    *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
-                     zqevt = znebprecipclr(i)*coef_eva*(1.0-zq(i)/qsl(i)) &
-                    *SQRT(zrfl(i)/max(1.e-8,znebprecipclr(i))) &
-                    *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-                ELSE
-                    zqevt = 1.*coef_eva*(1.0-zq(i)/qsl(i))*SQRT(zrfl(i)) &
-                    *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-                ENDIF
-
-                zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) &
-                    *RG*dtime/(paprs(i,k)-paprs(i,k+1)) 
-
-                ! sublimation of the solid precipitation coming from above
-                IF (iflag_evap_prec.EQ.3) THEN
-                    zqevti = znebprecip(i)*coef_eva_i*(1.0-zq(i)/qsi(i)) &
-                    *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
-                     zqevti = znebprecipclr(i)*coef_eva_i*(1.0-zq(i)/qsi(i)) &
-                    *SQRT(zifl(i)/max(1.e-8,znebprecipclr(i))) &
-                    *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-                ELSE
-                    zqevti = 1.*coef_eva_i*(1.0-zq(i)/qsi(i))*SQRT(zifl(i)) &
-                    *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-                ENDIF
-
-                zqevti = MAX(0.0,MIN(zqevti,zifl(i))) &
-                *RG*dtime/(paprs(i,k)-paprs(i,k+1))
-
-                ! A. JAM
-                ! Evaporation limit: we ensure that the layer's fraction below
-                ! the cloud or the whole mesh (depending on iflag_evap_prec)
-                ! does not reach saturation. In this case, we 
-                ! redistribute zqev0 conserving the ratio liquid/ice 
-
-                ! todoan: check the consistency of this formula
-                IF (zqevt+zqevti.GT.zqev0) THEN
-                    zqev=zqev0*zqevt/(zqevt+zqevti)
-                    zqevi=zqev0*zqevti/(zqevt+zqevti)
-                ELSE
-                    zqev=zqevt
-                    zqevi=zqevti
-                ENDIF
-
-
-                ! New solid and liquid precipitation fluxes after evap and sublimation
-                zrfln(i) = Max(0.,zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1))  &
-                         /RG/dtime)
-                zifln(i) = Max(0.,zifl(i) - zqevi*(paprs(i,k)-paprs(i,k+1)) &
-                         /RG/dtime)
-
-
-                ! vapor, temperature, precip fluxes update
-                zq(i) = zq(i) - (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
-                * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-                zmqc(i) = zmqc(i) + (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
-                * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-                zt(i) = zt(i) + (zrfln(i)-zrfl(i))        &
-                * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime    &
-                * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i))) &
-                + (zifln(i)-zifl(i))                      &
-                * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime    &
-                * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
-
-                ! New values of liquid and solid precipitation 
-                zrfl(i) = zrfln(i)
-                zifl(i) = zifln(i)
-
-                ! c_iso here call_reevap that updates isotopic zrfl, zifl (in inout)
-                !                         due to evap + sublim                                     
-                                           
-
-                IF (iflag_evap_prec.EQ.4) THEN
-                    zrflclr(i) = zrfl(i)
-                    ziflclr(i) = zifl(i)
-                    IF(zrflclr(i) + ziflclr(i).LE.0) THEN
-                        znebprecipclr(i) = 0.0
-                    ENDIF
-                    zrfl(i) = zrflclr(i) + zrflcld(i)
-                    zifl(i) = ziflclr(i) + ziflcld(i)
-                ENDIF
-
-                ! c_iso duplicate for isotopes or loop on isotopes
-
-                ! Melting:
-                zmelt = ((zt(i)-RTT)/(ztfondue-RTT)) ! JYG
-                ! precip fraction that is melted
-                zmelt = MIN(MAX(zmelt,0.),1.)
-
-                ! update of rainfall and snowfall due to melting
-                IF (iflag_evap_prec.EQ.4) THEN
-                    zrflclr(i)=zrflclr(i)+zmelt*ziflclr(i)
-                    zrflcld(i)=zrflcld(i)+zmelt*ziflcld(i)
-                    zrfl(i)=zrflclr(i)+zrflcld(i)
-
-                    ziflclr(i)=ziflclr(i)*(1.-zmelt)
-                    ziflcld(i)=ziflcld(i)*(1.-zmelt)
-                    zifl(i)=ziflclr(i)+ziflcld(i)
-
-                ELSE
-                    zrfl(i)=zrfl(i)+zmelt*zifl(i)
-
-                    zifl(i)=zifl(i)*(1.-zmelt)
-                ENDIF
-
-
-                ! c_iso: melting of isotopic precipi with zmelt (no fractionation)
-
-                ! Latent heat of melting with precipitation thermalization
-                zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
-                *RLMLT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
-                
-
-            ELSE
-                ! if no precip, we reinitialize the cloud fraction used for the precip to 0 
-                znebprecip(i)=0.
-
-            ENDIF ! (zrfl(i)+zifl(i).GT.0.)
-
-        ENDDO
-
-    ENDIF ! (iflag_evap_prec>=1)
-
-    ! --------------------------------------------------------------------
-    ! End precip evaporation
-    ! --------------------------------------------------------------------
-    
-    ! Calculation of qsat, L/Cp*dqsat/dT and ncoreczq counter
-    !-------------------------------------------------------
-
-     qtot(:)=zq(:)+zmqc(:)
-     CALL calc_qsat_ecmwf(klon,zt(:),qtot(:),pplay(:,k),RTT,0,.false.,zqs(:),zdqs(:))
-     DO i = 1, klon
-            zdelta = MAX(0.,SIGN(1.,RTT-zt(i)))
-            zdqsdT_raw(i) = zdqs(i)*RCPD*(1.0+RVTMP2*zq(i)) / (RLVTT*(1.-zdelta) + RLSTT*zdelta)
-            IF (zq(i) .LT. 1.e-15) THEN
-                ncoreczq=ncoreczq+1
-                zq(i)=1.e-15
-            ENDIF
-            ! c_iso: do something similar for isotopes
-
-     ENDDO
-    
-    ! --------------------------------------------------------------------
-    ! P2> Cloud formation
-    !---------------------------------------------------------------------
-    !
-    ! Unlike fisrtilp, we always assume a 'fractional cloud' approach 
-    ! i.e. clouds occupy only a fraction of the mesh (the subgrid distribution
-    ! is prescribed and depends on large scale variables and boundary layer
-    ! properties)
-    ! The decrease in condensed part due tu latent heating is taken into
-    ! account
-    ! -------------------------------------------------------------------
-
-        ! P2.1> With the PDFs (log-normal, bigaussian) 
-        ! cloud properties calculation with the initial values of t and q
-        ! ----------------------------------------------------------------
-
-        ! initialise gammasat and qincloud_mpc
-        gammasat(:)=1.
-        qincloud_mpc(:)=0.
-
-        IF (iflag_cld_th.GE.5) THEN
-
-             IF (iflag_mpc_bl .LT. 1) THEN 
-
-                IF (iflag_cloudth_vert.LE.2) THEN
-
-                    CALL cloudth(klon,klev,k,ztv,                  &
-                         zq,zqta,fraca,                            &
-                         qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
-                         ratqs,zqs,t)
-
-                ELSEIF (iflag_cloudth_vert.GE.3 .AND. iflag_cloudth_vert.LE.5) THEN
-
-                    CALL cloudth_v3(klon,klev,k,ztv,                        &
-                         zq,zqta,fraca,                                     &
-                         qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
-                         ratqs,zqs,t)
-
-                !Jean Jouhaud's version, Decembre 2018 
-                !-------------------------------------
-
-                ELSEIF (iflag_cloudth_vert.EQ.6) THEN
-
-                    CALL cloudth_v6(klon,klev,k,ztv,                        &
-                         zq,zqta,fraca,                                     &
-                         qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
-                         ratqs,zqs,t)
-
-                ENDIF
-
-         ELSE 
-                ! cloudth_v3 + cold microphysical considerations 
-                ! + stationary mixed-phase cloud model
-
-                    CALL cloudth_mpc(klon,klev,k,iflag_mpc_bl,mpc_bl_points, &
-                         t,ztv,zq,zqta,fraca, zpspsk,                      &
-                         paprs,pplay,ztla,zthl,ratqs,zqs,psfl,             &
-                         qcloud,qincloud_mpc,icefrac_mpc,ctot,ctot_vol)
-
-         ENDIF ! iflag_mpc_bl
-
-                DO i=1,klon
-                    rneb(i,k)=ctot(i,k)
-                    rneblsvol(i,k)=ctot_vol(i,k)
-                    zqn(i)=qcloud(i)
-                ENDDO
-
-        ENDIF
-
-        IF (iflag_cld_th .LE. 4) THEN
-            
-                ! lognormal 
-            lognormale = .TRUE.
-
-        ELSEIF (iflag_cld_th .GE. 6) THEN
-            
-                ! lognormal distribution when no thermals 
-            lognormale = fraca(:,k) < 1e-10
-
-        ELSE
-                ! When iflag_cld_th=5, we always assume
-                ! bi-gaussian distribution
-            lognormale = .FALSE.
-        
-        ENDIF
-
-        DT(:) = 0.
-        n_i(:)=0
-        Tbef(:)=zt(:)
-        qlbef(:)=0.
-
-        ! Treatment of non-boundary layer clouds (lognormale)
-        ! condensation with qsat(T) variation (adaptation)
-        ! Iterative resolution to converge towards qsat
-        ! with update of temperature, ice fraction and qsat at 
-        ! each iteration
-
-        ! todoan -> sensitivity to iflag_fisrtilp_qsat
-        DO iter=1,iflag_fisrtilp_qsat+1
-
-                DO i=1,klon
-
-                    ! keepgoing = .true. while convergence is not satisfied
-                    keepgoing(i)=ABS(DT(i)).GT.DDT0
-
-                    IF ((keepgoing(i) .OR. (n_i(i) .EQ. 0)) .AND. lognormale(i)) THEN
-
-                        ! if not convergence:
-
-                        ! P2.2.1> cloud fraction and condensed water mass calculation
-                        ! Calculated variables: 
-                        ! rneb : cloud fraction
-                        ! zqn : total water within the cloud
-                        ! zcond: mean condensed water within the mesh
-                        ! rhcl: clear-sky relative humidity
-                        !---------------------------------------------------------------
-
-                        ! new temperature that only serves in the iteration process:
-                        Tbef(i)=Tbef(i)+DT(i)
-
-                        ! Rneb, qzn and zcond for lognormal PDFs
-                        qtot(i)=zq(i)+zmqc(i)
-
-                      ENDIF
-
-                  ENDDO
-
-                  ! Calculation of saturation specific humidity and ice fraction
-                  CALL calc_qsat_ecmwf(klon,Tbef(:),qtot(:),pplay(:,k),RTT,0,.false.,zqs(:),zdqs(:))
-                  CALL calc_gammasat(klon,Tbef(:),qtot(:),pplay(:,k),gammasat(:),dgammasatdt(:))
-                  ! 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(:))
-
-                  DO i=1,klon !todoan : check if loop in i is needed
-
-                      IF ((keepgoing(i) .OR. (n_i(i) .EQ. 0)) .AND. lognormale(i)) THEN
-
-                        zpdf_sig(i)=ratqs(i,k)*zq(i)
-                        zpdf_k(i)=-sqrt(log(1.+(zpdf_sig(i)/zq(i))**2))
-                        zpdf_delta(i)=log(zq(i)/(gammasat(i)*zqs(i)))
-                        zpdf_a(i)=zpdf_delta(i)/(zpdf_k(i)*sqrt(2.))
-                        zpdf_b(i)=zpdf_k(i)/(2.*sqrt(2.))
-                        zpdf_e1(i)=zpdf_a(i)-zpdf_b(i)
-                        zpdf_e1(i)=sign(min(ABS(zpdf_e1(i)),5.),zpdf_e1(i))
-                        zpdf_e1(i)=1.-erf(zpdf_e1(i))
-                        zpdf_e2(i)=zpdf_a(i)+zpdf_b(i)
-                        zpdf_e2(i)=sign(min(ABS(zpdf_e2(i)),5.),zpdf_e2(i))
-                        zpdf_e2(i)=1.-erf(zpdf_e2(i))
-
-                        IF ((.NOT.ok_ice_sursat).OR.(Tbef(i).GT.t_glace_min)) THEN
-
-                          IF (zpdf_e1(i).LT.1.e-10) THEN
-                              rneb(i,k)=0.
-                              zqn(i)=gammasat(i)*zqs(i)
-                          ELSE
-                              rneb(i,k)=0.5*zpdf_e1(i)
-                              zqn(i)=zq(i)*zpdf_e2(i)/zpdf_e1(i)
-                          ENDIF
-
-                          rnebss(i,k)=0.0   !--added by OB (needed because of the convergence loop on time)
-                          fcontrN(i,k)=0.0  !--idem
-                          fcontrP(i,k)=0.0  !--idem
-                          qss(i,k)=0.0      !--idem
-
-                       ELSE ! in case of ice supersaturation by Audran
-
-                        !------------------------------------
-                        ! ICE SUPERSATURATION
-                        !------------------------------------
-
-                        CALL ice_sursat(pplay(i,k), paprs(i,k)-paprs(i,k+1), dtime, i, k, t(i,k), zq(i), &
-                             gamma_ss(i,k), zqs(i), Tbef(i), rneb_seri(i,k), ratqs(i,k),                 &
-                             rneb(i,k), zqn(i), rnebss(i,k), qss(i,k),                                   & 
-                             Tcontr(i,k), qcontr(i,k), qcontr2(i,k), fcontrN(i,k), fcontrP(i,k) )
-
-                        ENDIF ! ((flag_ice_sursat.eq.0).or.(Tbef(i).gt.t_glace_min))
-
-                        ! If vertical heterogeneity, change fraction by volume as well
-                        IF (iflag_cloudth_vert.GE.3) THEN
-                            ctot_vol(i,k)=rneb(i,k)
-                            rneblsvol(i,k)=ctot_vol(i,k)
-                        ENDIF
-
-
-                       ! P2.2.2> Approximative calculation of temperature variation DT 
-                       !           due to condensation.
-                       ! Calculated variables: 
-                       ! dT : temperature change due to condensation
-                       !---------------------------------------------------------------
-
-                
-                        IF (zfice(i).LT.1) THEN
-                            cste=RLVTT
-                        ELSE
-                            cste=RLSTT
-                        ENDIF
-
-                        qlbef(i)=max(0.,zqn(i)-zqs(i))
-                        num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT &
-                              +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
-                        denom = 1.+rneb(i,k)*((1-zfice(i))*RLVTT+zfice(i)*RLSTT)/cste*zdqs(i) &
-                              -(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*rneb(i,k)      &
-                              *qlbef(i)*dzfice(i)
-                        ! here we update a provisory temperature variable that only serves in the iteration
-                        ! process
-                        DT(i)=num/denom
-                        n_i(i)=n_i(i)+1
-
-                    ENDIF ! end keepgoing
-
-                ENDDO     ! end loop on i
-
-        ENDDO         ! iter=1,iflag_fisrtilp_qsat+1
-
-        ! P2.3> Final quantities calculation 
-        ! Calculated variables: 
-        !   rneb : cloud fraction
-        !   zcond: mean condensed water in the mesh
-        !   zqn  : mean water vapor in the mesh
-        !   zt   : temperature
-        !   rhcl : clear-sky relative humidity
-        ! ----------------------------------------------------------------
-
-        ! 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
-                zcond(i) = MAX(0.0,qincloud_mpc(i))*rneb(i,k)
-                ! following line is very strange and probably wrong
-                rhcl(i,k)= (zqs(i)+zq(i))/2./zqs(i)
-                ! water vapor update and partition function if thermals
-                zq(i) = zq(i) - zcond(i)        
-                zfice(i)=icefrac_mpc(i,k)
-
-            ELSE
-
-                ! Checks on rneb, rhcl and zqn
-                IF (rneb(i,k) .LE. 0.0) THEN
-                    zqn(i) = 0.0
-                    rneb(i,k) = 0.0
-                    zcond(i) = 0.0
-                    rhcl(i,k)=zq(i)/zqs(i)
-                ELSE IF (rneb(i,k) .GE. 1.0) THEN
-                    zqn(i) = zq(i)
-                    rneb(i,k) = 1.0
-                    zcond(i) = MAX(0.0,zqn(i)-gammasat(i)*zqs(i))
-                    rhcl(i,k)=1.0
-                ELSE
-                    zcond(i) = MAX(0.0,zqn(i)-gammasat(i)*zqs(i))*rneb(i,k)
-                    ! following line is very strange and probably wrong:
-                    rhcl(i,k)=(zqs(i)+zq(i))/2./zqs(i)
-                ENDIF
-
-                ! water vapor update 
-                zq(i) = zq(i) - zcond(i)
-
-            ENDIF
-
-            ! c_iso : routine that computes in-cloud supersaturation
-            ! c_iso condensation of isotopes (zcond, zsursat, zfice, zq in input) 
-
-            ! temperature update due to phase change
-            zt(i) = zt(i) + (1.-zfice(i))*zcond(i) & 
-            &     * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i))) &
-                  +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
-        ENDDO
-
-        ! If vertical heterogeneity, change volume fraction 
-        IF (iflag_cloudth_vert .GE. 3) THEN
-          ctot_vol(1:klon,k)=min(max(ctot_vol(1:klon,k),0.),1.)
-          rneblsvol(1:klon,k)=ctot_vol(1:klon,k)
-        ENDIF
-
-    ! ----------------------------------------------------------------
-    ! P3> Precipitation formation 
-    ! ----------------------------------------------------------------
-
-    ! LTP:
-    IF (iflag_evap_prec==4) THEN
-
-        !Partitionning between precipitation coming from clouds and that coming from CS
-
-        !0) Calculate tot_zneb, total cloud fraction above the cloud
-        !assuming a maximum-random overlap (voir Jakob and Klein, 2000)
-        
-        DO i=1, klon
-                tot_znebn(i) = 1. - (1.-tot_zneb(i))*(1 - max(rneb(i,k),zneb(i))) &
-                        /(1.-min(zneb(i),1.-smallestreal))
-                d_tot_zneb(i) = tot_znebn(i) - tot_zneb(i)
-                tot_zneb(i) = tot_znebn(i)
-
-
-                !1) Cloudy to clear air
-                d_znebprecip_cld_clr(i) = znebprecipcld(i) - min(rneb(i,k),znebprecipcld(i)) 
-                IF (znebprecipcld(i) .GT. 0.) THEN
-                        d_zrfl_cld_clr(i) = d_znebprecip_cld_clr(i)/znebprecipcld(i)*zrflcld(i) 
-                        d_zifl_cld_clr(i) = d_znebprecip_cld_clr(i)/znebprecipcld(i)*ziflcld(i) 
-                ELSE 
-                        d_zrfl_cld_clr(i) = 0. 
-                        d_zifl_cld_clr(i) = 0. 
-                ENDIF
-
-                !2) Clear to cloudy air
-                d_znebprecip_clr_cld(i) = max(0., min(znebprecipclr(i), rneb(i,k) - d_tot_zneb(i) - zneb(i)))
-                IF (znebprecipclr(i) .GT. 0) THEN
-                        d_zrfl_clr_cld(i) = d_znebprecip_clr_cld(i)/znebprecipclr(i)*zrflclr(i) 
-                        d_zifl_clr_cld(i) = d_znebprecip_clr_cld(i)/znebprecipclr(i)*ziflclr(i)
-                ELSE
-                        d_zrfl_clr_cld(i) = 0. 
-                        d_zifl_clr_cld(i) = 0. 
-                ENDIF 
-
-                !Update variables
-                znebprecipcld(i) = znebprecipcld(i) + d_znebprecip_clr_cld(i) - d_znebprecip_cld_clr(i)
-                znebprecipclr(i) = znebprecipclr(i) + d_znebprecip_cld_clr(i) - d_znebprecip_clr_cld(i) 
-                zrflcld(i) = zrflcld(i) + d_zrfl_clr_cld(i) - d_zrfl_cld_clr(i) 
-                ziflcld(i) = ziflcld(i) + d_zifl_clr_cld(i) - d_zifl_cld_clr(i)
-                zrflclr(i) = zrflclr(i) + d_zrfl_cld_clr(i) - d_zrfl_clr_cld(i)
-                ziflclr(i) = ziflclr(i) + d_zifl_cld_clr(i) - d_zifl_clr_cld(i)
-
-                ! c_iso  do the same thing for isotopes precip
-        ENDDO
-    ENDIF
-
-    ! Initialisation of zoliq and radocond variables
-
-    DO i = 1, klon
-            zoliq(i) = zcond(i)
-            zoliqi(i)= zoliq(i)*zfice(i)
-            zoliql(i)= zoliq(i)*(1.-zfice(i))
-            ! c_iso : initialisation of zoliq* also for isotopes
-            zrho(i,k)  = pplay(i,k) / zt(i) / RD
-            zdz(i)   = (paprs(i,k)-paprs(i,k+1)) / (zrho(i,k)*RG)
-            iwc(i)   = 0. 
-            zneb(i)  = MAX(rneb(i,k),seuil_neb)
-            radocond(i,k) = zoliq(i)/REAL(ninter+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)
-    ENDDO
-
-    ! Autoconversion
-    ! -------------------------------------------------------------------------------
-     
-    DO n = 1, ninter
-
-        DO i=1,klon
-            IF (rneb(i,k).GT.0.0) THEN
-                iwc(i) = zrho(i,k) * zoliqi(i) / zneb(i) ! in-cloud ice condensate content
-            ENDIF
-        ENDDO
-
-        CALL fallice_velocity(klon,iwc(:),zt(:),zrho(:,k),pplay(:,k),ptconv(:,k),velo(:,k))
-
-        DO i = 1, klon
-
-            IF (rneb(i,k).GT.0.0) THEN
-
-                ! Initialization of zrain, zsnow and zprecip:
-                zrain=0.
-                zsnow=0.
-                zprecip=0.
-                ! c_iso same init for isotopes. Externalisation?
-
-                IF (zneb(i).EQ.seuil_neb) THEN
-                    zprecip = 0.0
-                    zsnow = 0.0
-                    zrain= 0.0
-                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)
-                    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)
-                    ENDIF
-
-                    ! if vertical heterogeneity is taken into account, we use
-                    ! the "true" volume fraction instead of a modified 
-                    ! 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) * 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
-                    ! the "true" volume fraction instead of a modified 
-                    ! 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))
-                    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)
-                    ENDIF
-
-                    ENDIF ! ok_debug_autoconversion
-
-                    zrain   = MIN(MAX(zchau,0.0),zoliql(i))
-                    zsnow   = MIN(MAX(zfroi,0.0),zoliqi(i)) 
-                    zprecip = MAX(zrain + zsnow,0.0)
-
-                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)
-
-                ! 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)
-
-            ENDIF ! rneb >0
-
-        ENDDO  ! i = 1,klon
-
-    ENDDO      ! n = 1,niter
-
-    ! Precipitation flux calculation
-
-    DO i = 1, klon
-            
-            IF (iflag_evap_prec.EQ.4) THEN
-                ziflprev(i)=ziflcld(i)
-            ELSE
-                ziflprev(i)=zifl(i)*zneb(i)
-            ENDIF
-
-            IF (rneb(i,k) .GT. 0.0) THEN
-
-               ! CR&JYG: We account for the Wegener-Findeisen-Bergeron process in the precipitation flux:
-               ! If T<0C, liquid precip are converted into ice, which leads to an increase in
-               ! temperature DeltaT. The effect of DeltaT on condensates and precipitation is roughly
-               ! taken into account through a linearization of the equations and by approximating
-               ! the liquid precipitation process with a "threshold" process. We assume that
-               ! condensates are not modified during this operation. Liquid precipitation is
-               ! removed (in the limit DeltaT<273.15-T). Solid precipitation increases.
-               ! Water vapor increases as well
-               ! Note that compared to fisrtilp, we always assume iflag_bergeron=2
-
-                    zqpreci(i)=(zcond(i)-zoliq(i))*zfice(i)
-                    zqprecl(i)=(zcond(i)-zoliq(i))*(1.-zfice(i))
-                    zcp=RCPD*(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
-                    coef1 = rneb(i,k)*RLSTT/zcp*zdqsdT_raw(i)
-                    ! Computation of DT if all the liquid precip freezes
-                    DeltaT = RLMLT*zqprecl(i) / (zcp*(1.+coef1))
-                    ! T should not exceed the freezing point
-                    ! that is Delta > RTT-zt(i)
-                    DeltaT = max( min( RTT-zt(i), DeltaT) , 0. )
-                    zt(i)  = zt(i) + DeltaT
-                    ! water vaporization due to temp. increase
-                    Deltaq = rneb(i,k)*zdqsdT_raw(i)*DeltaT
-                    ! we add this vaporized water to the total vapor and we remove it from the precip
-                    zq(i) = zq(i) +  Deltaq
-                    ! The three "max" lines herebelow protect from rounding errors
-                    zcond(i) = max( zcond(i)- Deltaq, 0. )
-                    ! liquid precipitation converted to ice precip 
-                    Deltaqprecl = -zcp/RLMLT*(1.+coef1)*DeltaT
-                    zqprecl(i) = max( zqprecl(i) + Deltaqprecl, 0. )
-                    ! iced water budget
-                    zqpreci(i) = max (zqpreci(i) - Deltaqprecl - Deltaq, 0.)
-
-                    ! c_iso : mv here condensation of isotopes + redispatchage en precip 
-
-                IF (iflag_evap_prec.EQ.4) THEN
-                    zrflcld(i) = zrflcld(i)+zqprecl(i) &
-                    *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
-                    ziflcld(i) = ziflcld(i)+ zqpreci(i) &
-                        *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
-                    znebprecipcld(i) = rneb(i,k)
-                    zrfl(i) = zrflcld(i) + zrflclr(i)
-                    zifl(i) = ziflcld(i) + ziflclr(i)
-                ELSE
-                    zrfl(i) = zrfl(i)+ zqprecl(i)        &
-                    *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
-                    zifl(i) = zifl(i)+ zqpreci(i)        &
-                   *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
-                ENDIF
-                ! c_iso : same for isotopes
- 
-           ENDIF ! rneb>0
-
-   ENDDO
-
-    ! 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
-
-        DO i=1,klon
-
-            IF ((zrflclr(i) + ziflclr(i)) .GT. 0. ) THEN
-                znebprecipclr(i) = min(znebprecipclr(i),max(zrflclr(i)/ &
-                (MAX(znebprecipclr(i),seuil_neb)*rain_int_min), ziflclr(i)/(MAX(znebprecipclr(i),seuil_neb)*rain_int_min)))
-            ELSE
-                znebprecipclr(i)=0.0
-            ENDIF
-
-            IF ((zrflcld(i) + ziflcld(i)) .GT. 0.) THEN
-                znebprecipcld(i) = min(znebprecipcld(i), max(zrflcld(i)/ &
-                (MAX(znebprecipcld(i),seuil_neb)*rain_int_min), ziflcld(i)/(MAX(znebprecipcld(i),seuil_neb)*rain_int_min)))
-            ELSE
-                znebprecipcld(i)=0.0
-            ENDIF
-
-        ENDDO
-
-    ENDIF
-
-    ! End of precipitation formation
-    ! --------------------------------
-
-    ! Outputs:
-    ! Precipitation fluxes at layer interfaces
-    ! and temperature and water species tendencies
-    DO i = 1, klon
-        psfl(i,k)=zifl(i) 
-        prfl(i,k)=zrfl(i)
-        d_ql(i,k) = (1-zfice(i))*zoliq(i)
-        d_qi(i,k) = zfice(i)*zoliq(i)
-        d_q(i,k) = zq(i) - q(i,k)
-        ! c_iso: same for isotopes
-        d_t(i,k) = zt(i) - t(i,k)
-    ENDDO
-
-    ! Calculation of the concentration of condensates seen by the radiation scheme
-    ! for liquid phase, we take radocondl
-    ! for ice phase, we take radocondi if we neglect snowfall, otherwise (ok_radocond_snow=true) 
-    ! we recaulate radocondi to account for contributions from the precipitation flux
-
-    IF ((ok_radocond_snow) .AND. (k .LT. klev)) THEN
-        ! for the solid phase (crystals + snowflakes)
-        ! we recalculate radocondi by summing
-        ! the ice content calculated in the mesh
-        ! + the contribution of the non-evaporated snowfall 
-        ! from the overlying layer
-        DO i=1,klon
-           IF (ziflprev(i) .NE. 0.0) THEN
-              radocondi(i,k)=zoliq(i)*zfice(i)+zqpreci(i)+ziflprev(i)/zrho(i,k+1)/velo(i,k+1)
-           ELSE
-              radocondi(i,k)=zoliq(i)*zfice(i)+zqpreci(i)
-           ENDIF
-           radocond(i,k)=radocondl(i,k)+radocondi(i,k)
-        ENDDO
-    ENDIF
-
-    ! caculate the percentage of ice in "radocond" so cloud+precip seen by the radiation scheme
-    DO i=1,klon
-        IF (radocond(i,k) .GT. 0.) THEN
-            radicefrac(i,k)=MIN(MAX(radocondi(i,k)/radocond(i,k),0.),1.)
-        ENDIF
-    ENDDO
-
-    ! ----------------------------------------------------------------
-    ! P4> Wet scavenging
-    ! ----------------------------------------------------------------
-
-    !Scavenging through nucleation in the layer
-
-    DO i = 1,klon
-        
-        IF(zcond(i).GT.zoliq(i)+1.e-10) THEN
-            beta(i,k) = (zcond(i)-zoliq(i))/zcond(i)/dtime
-        ELSE
-            beta(i,k) = 0.
-        ENDIF
-
-        zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0)*(paprs(i,k)-paprs(i,k+1))/RG
-
-        IF (rneb(i,k).GT.0.0.AND.zprec_cond(i).GT.0.) THEN
-
-            IF (t(i,k) .GE. t_glace_min) THEN
-                zalpha_tr = a_tr_sca(3)
-            ELSE
-                zalpha_tr = a_tr_sca(4)
-            ENDIF
-
-            zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
-            frac_nucl(i,k)= 1.-zneb(i)*zfrac_lessi 
-
-            ! Nucleation with a factor of -1 instead of -0.5
-            zfrac_lessi = 1. - EXP(-zprec_cond(i)/zneb(i))
-
-        ENDIF
-
-    ENDDO
-
-    ! Scavenging through impaction in the underlying layer
-
-    DO kk = k-1, 1, -1
-
-        DO i = 1, klon
-
-            IF (rneb(i,k).GT.0.0.AND.zprec_cond(i).GT.0.) THEN
-
-                IF (t(i,kk) .GE. t_glace_min) THEN
-                    zalpha_tr = a_tr_sca(1)
-                ELSE
-                    zalpha_tr = a_tr_sca(2)
-                ENDIF
-
-              zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
-              frac_impa(i,kk)= 1.-zneb(i)*zfrac_lessi
-
-            ENDIF
-
-        ENDDO
-
-    ENDDO
-
-    !--save some variables for ice supersaturation
-    !
-    DO i = 1, klon
-        ! for memory 
-        rneb_seri(i,k) = rneb(i,k)
-
-        ! for diagnostics
-        rnebclr(i,k) = 1.0 - rneb(i,k) - rnebss(i,k)
-
-        qvc(i,k) = zqs(i) * rneb(i,k)
-        qclr(i,k) = MAX(1.e-10,zq(i) - qvc(i,k) - qss(i,k))  !--added by OB because of pathologic cases with the lognormal
-        qcld(i,k) = qvc(i,k) + zcond(i)
-   ENDDO
-   !q_sat
-   CALL calc_qsat_ecmwf(klon,Tbef(:),qzero(:),pplay(:,k),RTT,1,.false.,qsatl(:,k),zdqs(:))
-   CALL calc_qsat_ecmwf(klon,Tbef(:),qzero(:),pplay(:,k),RTT,2,.false.,qsats(:,k),zdqs(:))
-
-ENDDO
-
-!======================================================================
-!                      END OF VERTICAL LOOP
-!======================================================================
-
-  ! Rain or snow at the surface (depending on the first layer temperature)
-  DO i = 1, klon
-      snow(i) = zifl(i)
-      rain(i) = zrfl(i)
-      ! c_iso final output
-  ENDDO
-
-  IF (ncoreczq>0) THEN
-      WRITE(lunout,*)'WARNING : ZQ in LSCP ',ncoreczq,' val < 1.e-15.'
-  ENDIF
-
-END SUBROUTINE lscp
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-END MODULE lscp_mod
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/lscp_tools_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/lscp_tools_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,356 +1,0 @@
-MODULE LSCP_TOOLS_MOD
-
-    IMPLICIT NONE
-
-CONTAINS
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-SUBROUTINE FALLICE_VELOCITY(klon,iwc,temp,rho,pres,ptconv,velo)
-
-    ! Ref:
-    ! Stubenrauch, C. J., Bonazzola, M.,
-    ! Protopapadaki, S. E., & Musat, I. (2019).
-    ! New cloud system metrics to assess bulk
-    ! ice cloud schemes in a GCM. Journal of
-    ! Advances in Modeling Earth Systems, 11,
-    ! 3212–3234. https://doi.org/10.1029/2019MS001642
-    
-    
-    IMPLICIT NONE
-
-    INCLUDE "nuage.h"
-    INCLUDE "fisrtilp.h"
-
-    INTEGER, INTENT(IN) :: klon
-    REAL, INTENT(IN), DIMENSION(klon) :: iwc       ! specific ice water content [kg/m3]
-    REAL, INTENT(IN), DIMENSION(klon) :: temp      ! temperature [K]
-    REAL, INTENT(IN), DIMENSION(klon) :: rho       ! dry air density [kg/m3]
-    REAL, INTENT(IN), DIMENSION(klon) :: pres      ! air pressure [Pa]
-    LOGICAL, INTENT(IN), DIMENSION(klon) :: ptconv    ! convective point  [-]
-
-    REAL, INTENT(OUT), DIMENSION(klon) :: velo    ! fallspeed velocity of crystals [m/s]
-
-
-    INTEGER i
-    REAL logvm,iwcg,tempc,phpa,cvel,dvel,fallv_tun
-    REAL m2ice, m2snow, vmice, vmsnow
-    REAL aice, bice, asnow, bsnow
-    
-
-    DO i=1,klon
-
-        IF (ptconv(i)) THEN
-            fallv_tun=ffallv_con
-        ELSE
-            fallv_tun=ffallv_lsc
-        ENDIF
-
-        tempc=temp(i)-273.15 ! celcius temp
-        iwcg=MAX(iwc(i)*1000.,1E-3) ! iwc in g/m3. We set a minimum value to prevent from division by 0
-        phpa=pres(i)/100.    ! pressure in hPa
-
-    IF (iflag_vice .EQ. 1) THEN
-        ! so-called 'empirical parameterization' in Stubenrauch et al. 2019
-        if (tempc .GE. -60.0) then
-
-            logvm= -0.0000414122*tempc*tempc*log(iwcg)-0.00538922*tempc*log(iwcg) &
-                    -0.0516344*log(iwcg)+0.00216078*tempc + 1.9714    
-            velo(i)=exp(logvm)
-        else
-            velo(i)=65.0*(iwcg**0.2)*(150./phpa)**0.15
-        endif
-        
-        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
-        ! so called  PSDM empirical coherent bulk ice scheme in Stubenrauch et al. 2019
-        aice=0.587
-        bice=2.45
-        asnow=0.0444
-        bsnow=2.1
-        
-        m2ice=((iwcg*0.001/aice)/(exp(13.6-bice*7.76+0.479*bice**2)* & 
-                exp((-0.0361+bice*0.0151+0.00149*bice**2)*tempc)))   &
-                **(1./(0.807+bice*0.00581+0.0457*bice**2))
-
-        vmice=100.*1042.4*exp(13.6-(bice+1)*7.76+0.479*(bice+1.)**2)*exp((-0.0361+ &
-                 (bice+1.)*0.0151+0.00149*(bice+1.)**2)*tempc) &
-                 *(m2ice**(0.807+(bice+1.)*0.00581+0.0457*(bice+1.)**2))/(iwcg*0.001/aice)
-
-       
-        vmice=vmice*((1000./phpa)**0.2)
-      
-        m2snow=((iwcg*0.001/asnow)/(exp(13.6-bsnow*7.76+0.479*bsnow**2)* &
-               exp((-0.0361+bsnow*0.0151+0.00149*bsnow**2)*tempc)))         &
-               **(1./(0.807+bsnow*0.00581+0.0457*bsnow**2))
-
-
-        vmsnow=100.*14.3*exp(13.6-(bsnow+.416)*7.76+0.479*(bsnow+.416)**2)&
-                  *exp((-0.0361+(bsnow+.416)*0.0151+0.00149*(bsnow+.416)**2)*tempc)&
-                  *(m2snow**(0.807+(bsnow+.416)*0.00581+0.0457*(bsnow+.416)**2))/(iwcg*0.001/asnow)
-
-        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)
-    ENDIF
-    ENDDO
-
-END SUBROUTINE FALLICE_VELOCITY
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-SUBROUTINE ICEFRAC_LSCP(klon, temp, sig, icefrac, dicefracdT)
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  
-  ! Compute the ice fraction 1-xliq (see e.g.
-  ! Doutriaux-Boucher & Quaas 2004, section 2.2.)
-  ! as a function of temperature
-  ! see also Fig 3 of Madeleine et al. 2020, JAMES
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-
-    USE print_control_mod, ONLY: lunout, prt_level
-
-    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(OUT), DIMENSION(klon)  :: icefrac
-    REAL, INTENT(OUT), DIMENSION(klon)  :: dicefracdT
-
-
-    INTEGER i
-    REAL    sig0,www,tmin_tmp,liqfrac_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
-    ENDIF
-
-
-! calculation of icefrac and dicefrac/dT
-
-    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
-            icefrac(i) = (1.0-liqfrac_tmp)**exposant_glace
-            IF (icefrac(i) .GT.0.) THEN
-                 dicefracdT(i)= exposant_glace * (icefrac(i)**(exposant_glace-1.)) &
-                           / (t_glace_min - t_glace_max)
-            ENDIF
-
-            IF ((icefrac(i).EQ.0).OR.(icefrac(i).EQ.1)) THEN
-                 dicefracdT(i)=0.
-            ENDIF
-
-    ENDIF
-    
-    ENDDO
-
-
-    RETURN
-
-END SUBROUTINE ICEFRAC_LSCP
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-
-
-SUBROUTINE CALC_QSAT_ECMWF(klon,temp,qtot,pressure,tref,phase,flagth,qs,dqs)
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-    ! Calculate qsat following ECMWF method
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-
-    IMPLICIT NONE
-
-    include "YOMCST.h"
-    include "YOETHF.h"
-    include "FCTTRE.h"
-
-    INTEGER, INTENT(IN) :: klon  ! number of horizontal grid points
-    REAL, INTENT(IN), DIMENSION(klon) :: temp     ! temperature in K
-    REAL, INTENT(IN), DIMENSION(klon) :: qtot     ! total specific water in kg/kg
-    REAL, INTENT(IN), DIMENSION(klon) :: pressure ! pressure in Pa
-    REAL, INTENT(IN)                  :: tref     ! reference temperature in K
-    LOGICAL, INTENT(IN) :: flagth     ! flag for qsat calculation for thermals
-    INTEGER, INTENT(IN) :: phase 
-    ! phase: 0=depend on temperature sign (temp>tref -> liquid, temp<tref, solid)
-    !        1=liquid
-    !        2=solid
-
-    REAL, INTENT(OUT), DIMENSION(klon) :: qs      ! saturation specific humidity [kg/kg]
-    REAL, INTENT(OUT), DIMENSION(klon) :: dqs     ! derivation of saturation specific humidity wrt T
-
-    REAL delta, cor, cvm5
-    INTEGER i
-
-    DO i=1,klon
-
-    IF (phase .EQ. 1) THEN
-        delta=0.
-    ELSEIF (phase .EQ. 2) THEN
-        delta=1.
-    ELSE
-        delta=MAX(0.,SIGN(1.,tref-temp(i)))
-    ENDIF
-
-    IF (flagth) THEN
-    cvm5=R5LES*(1.-delta) + R5IES*delta
-    ELSE
-    cvm5 = R5LES*RLVTT*(1.-delta) + R5IES*RLSTT*delta
-    cvm5 = cvm5 /RCPD/(1.0+RVTMP2*(qtot(i)))
-    ENDIF
-
-    qs(i)= R2ES*FOEEW(temp(i),delta)/pressure(i)
-    qs(i)=MIN(0.5,qs(i))
-    cor=1./(1.-RETV*qs(i))
-    qs(i)=qs(i)*cor
-    dqs(i)= FOEDE(temp(i),delta,cvm5,qs(i),cor)
-
-    END DO
-
-END SUBROUTINE CALC_QSAT_ECMWF
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-SUBROUTINE CALC_GAMMASAT(klon,temp,qtot,pressure,gammasat,dgammasatdt)
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-    ! programme that calculates the gammasat parameter that determines the
-    ! homogeneous condensation thresholds for cold (<0oC) clouds
-    ! condensation at q>gammasat*qsat
-    ! Etienne Vignon, March 2021
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-
-    IMPLICIT NONE
-
-    include "YOMCST.h"
-    include "YOETHF.h"
-    include "FCTTRE.h"
-    include "nuage.h" 
-
-    INTEGER, INTENT(IN) :: klon                       ! number of horizontal grid points
-    REAL, INTENT(IN), DIMENSION(klon) :: temp         ! temperature in K
-    REAL, INTENT(IN), DIMENSION(klon) :: qtot         ! total specific water in kg/kg
-
-    REAL, INTENT(IN), DIMENSION(klon) :: pressure     ! pressure in Pa
-
-    REAL, INTENT(OUT), DIMENSION(klon) :: gammasat    ! coefficient to multiply qsat with to calculate saturation
-    REAL, INTENT(OUT), DIMENSION(klon) :: dgammasatdt ! derivative of gammasat wrt temperature
-
-    REAL, DIMENSION(klon) ::  qsi,qsl,dqsl,dqsi
-    REAL  fcirrus, fac
-    REAL, PARAMETER :: acirrus=2.349
-    REAL, PARAMETER :: bcirrus=259.0
-
-    INTEGER i
-    
-        CALL CALC_QSAT_ECMWF(klon,temp,qtot,pressure,RTT,1,.false.,qsl,dqsl)
-        CALL CALC_QSAT_ECMWF(klon,temp,qtot,pressure,RTT,2,.false.,qsi,dqsi)
-
-    DO i=1,klon
-
-        IF (temp(i) .GE. RTT) THEN
-            ! warm clouds: condensation at saturation wrt liquid
-            gammasat(i)=1.
-            dgammasatdt(i)=0.
-
-        ELSEIF ((temp(i) .LT. RTT) .AND. (temp(i) .GT. t_glace_min)) THEN
-            
-            IF (iflag_gammasat .GE. 2) THEN          
-               gammasat(i)=qsl(i)/qsi(i)
-               dgammasatdt(i)=(dqsl(i)*qsi(i)-dqsi(i)*qsl(i))/qsi(i)/qsi(i)
-            ELSE
-               gammasat(i)=1.
-               dgammasatdt(i)=0.
-            ENDIF
-
-        ELSE
-
-            IF (iflag_gammasat .GE.1) THEN
-            ! homogeneous freezing of aerosols, according to
-            ! Koop, 2000 and Karcher 2008, QJRMS
-            ! 'Cirrus regime'
-               fcirrus=acirrus-temp(i)/bcirrus
-               IF (fcirrus .LT. qsl(i)/qsi(i)) THEN
-                  gammasat(i)=qsl(i)/qsi(i)
-                  dgammasatdt(i)=(dqsl(i)*qsi(i)-dqsi(i)*qsl(i))/qsi(i)/qsi(i)
-               ELSE
-                  gammasat(i)=fcirrus
-                  dgammasatdt(i)=-1.0/bcirrus
-               ENDIF
-           
-            ELSE
-
-               gammasat(i)=1.
-               dgammasatdt(i)=0.
-
-            ENDIF
-
-        ENDIF
-   
-    END DO
-
-
-END SUBROUTINE CALC_GAMMASAT
-
-
-!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-END MODULE LSCP_TOOLS_MOD
-
-
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/methox.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/methox.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/methox.F90	(revision 4727)
@@ -65,5 +65,5 @@
 IMPLICIT NONE
 
-#include "YOMCST.h"
+INCLUDE "YOMCST.h"
 
 INTEGER,INTENT(IN)    :: KLON 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/mod_surf_para.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/mod_surf_para.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/mod_surf_para.F90	(revision 4727)
@@ -50,7 +50,6 @@
   SUBROUTINE Init_surf_para(knon)
   USE mod_phys_lmdz_para
-#ifdef CPP_MPI
-  INCLUDE 'mpif.h'
-#endif
+  USE lmdz_mpi
+
     INTEGER :: knon
     INTEGER :: i,ierr
@@ -88,8 +87,6 @@
       
       IF (is_using_mpi) THEN
-#ifdef CPP_MPI
         CALL MPI_ALLGather(knon_mpi,1,MPI_INTEGER,knon_mpi_para,1,MPI_INTEGER,COMM_LMDZ_PHY,ierr)
         CALL MPI_ALLGather(knon_omp_para,omp_size,MPI_INTEGER,knon_glo_para,omp_size,MPI_INTEGER,COMM_LMDZ_PHY,ierr)
-#endif
       ELSE
         knon_mpi_para(:)=knon_mpi
@@ -169,7 +166,6 @@
   SUBROUTINE gather_surf_mpi_i(FieldIn,FieldOut)
   USE mod_phys_lmdz_para
-#ifdef CPP_MPI
-  INCLUDE 'mpif.h'
-#endif
+  USE lmdz_mpi
+
     INTEGER :: FieldIn(:)
     INTEGER :: FieldOut(:)
@@ -177,9 +173,7 @@
     
     IF (is_using_mpi) THEN
-#ifdef CPP_MPI
       CALL MPI_Gatherv(FieldIn,knon_mpi,MPI_INTEGER,                                &
                        FieldOut,knon_mpi_para,knon_mpi_begin_para(:)-1,MPI_INTEGER, &
                        mpi_master,COMM_LMDZ_PHY,ierr)
-#endif
     ELSE
       FieldOut(:)=FieldIn(:)
@@ -224,7 +218,6 @@
   SUBROUTINE gather_surf_mpi_r(FieldIn,FieldOut)
   USE mod_phys_lmdz_para
-#ifdef CPP_MPI
-  INCLUDE 'mpif.h'
-#endif
+  USE lmdz_mpi
+
     REAL :: FieldIn(:)
     REAL :: FieldOut(:)
@@ -232,9 +225,7 @@
     
     IF (is_using_mpi) THEN
-#ifdef CPP_MPI
       CALL MPI_Gatherv(FieldIn,knon_mpi,MPI_REAL_LMDZ,                                 &
                        FieldOut,knon_mpi_para,knon_mpi_begin_para(:)-1,MPI_REAL_LMDZ,  &
                        mpi_master,COMM_LMDZ_PHY,ierr)            
-#endif
     ELSE
       FieldOut(:)=FieldIn(:)
@@ -277,7 +268,6 @@
   SUBROUTINE scatter_surf_mpi_i(FieldIn,FieldOut)
   USE mod_phys_lmdz_para
-#ifdef CPP_MPI
-  INCLUDE 'mpif.h'
-#endif
+  USE lmdz_mpi
+
     INTEGER :: FieldIn(:)
     INTEGER :: FieldOut(:)
@@ -285,9 +275,7 @@
     
     IF (is_using_mpi) THEN
-#ifdef CPP_MPI
       CALL MPI_Scatterv(FieldIn,knon_mpi_para,knon_mpi_begin_para(:)-1,MPI_INTEGER,   &
                         FieldOut,knon_mpi,MPI_INTEGER,                                &
                         mpi_master,COMM_LMDZ_PHY,ierr)
-#endif
     ELSE
       FieldOut(:)=FieldIn(:)
@@ -329,7 +317,6 @@
   SUBROUTINE scatter_surf_mpi_r(FieldIn,FieldOut)
   USE mod_phys_lmdz_para
-#ifdef CPP_MPI
-  INCLUDE 'mpif.h'
-#endif
+  USE lmdz_mpi
+
     REAL :: FieldIn(:)
     REAL :: FieldOut(:)
@@ -337,9 +324,7 @@
     
     IF (is_using_mpi) THEN
-#ifdef CPP_MPI
       CALL MPI_Scatterv(FieldIn,knon_mpi_para,knon_mpi_begin_para(:)-1,MPI_INTEGER,   &
                         FieldOut,knon_mpi,MPI_INTEGER,                                &
                         mpi_master,COMM_LMDZ_PHY,ierr)
-#endif
     ELSE
       FieldOut(:)=FieldIn(:)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/modd_csts.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/modd_csts.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/modd_csts.F90	(revision 4727)
@@ -0,0 +1,91 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
+!SFX_LIC for details. version 1.
+!     ###############
+      MODULE MODD_CSTS      
+!     ###############
+!
+!!****  *MODD_CSTS* - declaration of Physic constants 
+!!
+!!    PURPOSE
+!!    -------
+!       The purpose of this declarative module is to declare  the 
+!     Physics constants.    
+!
+!!
+!!**  IMPLICIT ARGUMENTS
+!!    ------------------
+!!      None 
+!!
+!!    REFERENCE
+!!    ---------
+!!          
+!!    AUTHOR
+!!    ------
+!!      V. Ducrocq   *Meteo France*
+!!
+!!    MODIFICATIONS
+!!    -------------
+!!      Original    16/05/94  
+!!      J. Stein    02/01/95  add xrholw                    
+!!      J.-P. Pinty 13/12/95  add XALPI,XBETAI,XGAMI
+!!      J. Stein    25/07/97  add XTH00                    
+!!      V. Masson   05/10/98  add XRHOLI
+!!      C. Mari     31/10/00  add NDAYSEC
+!!      J. Escobar     06/13  add XSURF_TIMY XSURF_TIMY_12 XSURF_EPSILON for REAL*4
+!-------------------------------------------------------------------------------
+!
+!*       0.   DECLARATIONS
+!             ------------
+!
+IMPLICIT NONE 
+REAL,SAVE :: XPI                ! Pi
+!
+REAL,SAVE :: XDAY,XSIYEA,XSIDAY ! day duration, sideral year duration,
+                                ! sideral day duration
+!
+REAL,SAVE :: XKARMAN            ! von karman constant
+REAL,SAVE :: XLIGHTSPEED        ! light speed
+REAL,SAVE :: XPLANCK            ! Planck constant
+REAL,SAVE :: XBOLTZ             ! Boltzman constant 
+REAL,SAVE :: XAVOGADRO          ! Avogadro number
+!
+REAL,SAVE :: XRADIUS,XOMEGA     ! Earth radius, earth rotation
+REAL,SAVE :: XG                 ! Gravity constant
+!
+REAL,SAVE :: XP00               ! Reference pressure
+!
+REAL,SAVE :: XSTEFAN,XI0        ! Stefan-Boltzman constant, solar constant
+!
+REAL,SAVE :: XMD,XMV            ! Molar mass of dry air and molar mass of vapor
+REAL,SAVE :: XRD,XRV            ! Gaz constant for dry air, gaz constant for vapor
+REAL,SAVE :: XCPD,XCPV          ! Cpd (dry air), Cpv (vapor)
+REAL,SAVE :: XRHOLW             ! Volumic mass of liquid water
+REAL,SAVE :: XCL,XCI            ! Cl (liquid), Ci (ice)
+REAL,SAVE :: XTT                ! Triple point temperature
+REAL,SAVE :: XTTSI              ! Temperature of ice fusion over salty sea
+REAL,SAVE :: XTTS               ! Equivalent temperature of ice fusion over a mixed of sea and sea-ice
+REAL,SAVE :: XICEC              ! Threshold fraction over which the tile is considered as only covered with ice
+REAL,SAVE :: XLVTT              ! Vaporization heat constant
+REAL,SAVE :: XLSTT              ! Sublimation heat constant
+REAL,SAVE :: XLMTT              ! Melting heat constant
+REAL,SAVE :: XESTT              ! Saturation vapor pressure  at triple point
+                                ! temperature  
+REAL,SAVE :: XALPW,XBETAW,XGAMW ! Constants for saturation vapor 
+                                !  pressure  function 
+REAL,SAVE :: XALPI,XBETAI,XGAMI ! Constants for saturation vapor
+                                !  pressure  function over solid ice
+REAL, SAVE        :: XTH00      ! reference value  for the potential
+                                ! temperature
+REAL,SAVE :: XRHOLI             ! Volumic mass of ice
+REAL,SAVE :: XCONDI             ! thermal conductivity of ice (W m-1 K-1)
+!
+INTEGER, SAVE :: NDAYSEC        ! Number of seconds in a day
+!
+REAL,SAVE     :: XSURF_TINY          ! minimum real on this machine
+REAL,SAVE     :: XSURF_TINY_12       ! sqrt(minimum real on this machine)
+REAL,SAVE     :: XSURF_EPSILON       ! minimum space with 1.0
+!
+END MODULE MODD_CSTS
+
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/moy_undefSTD.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/moy_undefSTD.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/moy_undefSTD.F90	(revision 4727)
@@ -8,14 +8,10 @@
   USE phys_state_var_mod
 #endif
-#ifdef CPP_XIOS
-  USE wxios, ONLY: missing_val
-#endif
+  USE wxios, ONLY: missing_val_xios => missing_val, using_xios
  
   USE phys_cal_mod, ONLY: mth_len
   IMPLICIT NONE
   include "clesphys.h"
-#ifndef CPP_XIOS 
   REAL :: missing_val
-#endif
 
   ! ====================================================================
@@ -59,7 +55,9 @@
 
 ! missing_val = nf90_fill_real
-#ifndef CPP_XIOS
-      missing_val=missing_val_nf90
-#endif
+  IF (using_xios) THEN
+    missing_val = missing_val_xios
+  ELSE
+    missing_val=missing_val_nf90
+  ENDIF
 
   DO n = 1, nout
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/newmicro.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/newmicro.F90	(revision 4726)
+++ 	(revision )
@@ -1,770 +1,0 @@
-! $Id$
-
-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, &
-    reliq_pi, reice_pi)
-
-  USE dimphy
-  USE phys_local_var_mod, ONLY: scdnc, cldncl, reffclwtop, lcc, reffclws, &
-      reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  & 
-      zfice, dNovrN, ptconv
-  USE phys_state_var_mod, ONLY: rnebcon, clwcon
-  USE icefrac_lsc_mod ! computes ice fraction (JBM 3/14)
-  USE ioipsl_getin_p_mod, ONLY : getin_p
-  USE print_control_mod, ONLY: lunout
-  USE lscp_tools_mod, only: icefrac_lscp
-
-
-
-  IMPLICIT NONE
-  ! ======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930910
-  ! O.   Boucher (LMD/CNRS) mise a jour en 201212
-  ! I. Musat (LMD/CNRS) : prise en compte de la meme hypothese de recouvrement
-  !                       pour les nuages que pour le rayonnement rrtm via
-  !                       le parametre novlp de radopt.h : 20160721
-  ! Objet: Calculer epaisseur optique et emmissivite des nuages
-  ! ======================================================================
-  ! Arguments:
-  ! ok_cdnc-input-L-flag pour calculer les rayons a partir des aerosols
-
-  ! t-------input-R-temperature
-  ! pqlwp---input-R-eau liquide nuageuse dans l'atmosphere dans la maille (kg/kg)
-  ! picefra--input-R-fraction de glace dans les nuages
-  ! pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1)
-  ! mass_solu_aero-----input-R-total mass concentration for all soluble
-  ! aerosols[ug/m^3]
-  ! mass_solu_aero_pi--input-R-ditto, pre-industrial value
-
-  ! bl95_b0-input-R-a PARAMETER, may be varied for tests (s-sea, l-land)
-  ! bl95_b1-input-R-a PARAMETER, may be varied for tests (    -"-      )
-  ! latitude_deg-input latitude in degrees
-
-  ! re------output-R-Cloud droplet effective radius multiplied by fl [um]
-  ! fl------output-R-Denominator to re, introduced to avoid problems in
-  ! the averaging of the output. fl is the fraction of liquid
-  ! water clouds within a grid cell
-
-  ! pcltau--output-R-epaisseur optique des nuages
-  ! pclemi--output-R-emissivite des nuages (0 a 1)
-  ! pcldtaupi-output-R-pre-industrial value of cloud optical thickness,
-
-  ! pcl-output-R-2D low-level cloud cover
-  ! pcm-output-R-2D mid-level cloud cover
-  ! pch-output-R-2D high-level cloud cover
-  ! pct-output-R-2D total cloud cover
-  ! ======================================================================
-
-  include "YOMCST.h"
-  include "nuage.h"
-  include "radepsi.h"
-  include "radopt.h"
-  include "clesphys.h"
-
-  ! choix de l'hypothese de recouvrement nuageuse via radopt.h (IM, 19.07.2016)
-  ! !novlp=1: max-random
-  ! !novlp=2: maximum
-  ! !novlp=3: random
-! LOGICAL random, maximum_random, maximum
-! PARAMETER (random=.FALSE., maximum_random=.TRUE., maximum=.FALSE.)
-
-  LOGICAL, SAVE :: first = .TRUE.
-  !$OMP THREADPRIVATE(FIRST)
-  INTEGER flag_max
-
-  ! threshold PARAMETERs
-  REAL thres_tau, thres_neb
-  PARAMETER (thres_tau=0.3, thres_neb=0.001)
-
-  REAL phase3d(klon, klev)
-  REAL tcc(klon), ftmp(klon), lcc_integrat(klon), height(klon)
-
-  REAL paprs(klon, klev+1)
-  REAL pplay(klon, klev)
-  REAL t(klon, klev)
-  REAL pclc(klon, klev)
-  REAL pqlwp(klon, klev), picefra(klon,klev)
-  REAL pcltau(klon, klev)
-  REAL pclemi(klon, klev)
-  REAL pcldtaupi(klon, klev)
-  REAL latitude_deg(klon)
-
-  REAL pct(klon)
-  REAL pcl(klon)
-  REAL pcm(klon)
-  REAL pch(klon)
-  REAL pctlwp(klon)
-
-  LOGICAL lo
-
-  ! !Abderr modif JL mail du 19.01.2011 18:31
-  ! REAL cetahb, cetamb
-  ! PARAMETER (cetahb = 0.45, cetamb = 0.80)
-  ! Remplacer
-  ! cetahb*paprs(i,1) par  prmhc
-  ! cetamb*paprs(i,1) par  prlmc
-  REAL prmhc ! Pressure between medium and high level cloud in Pa
-  REAL prlmc ! Pressure between low and medium level cloud in Pa
-  PARAMETER (prmhc=440.*100., prlmc=680.*100.)
-
-  INTEGER i, k
-  REAL xflwp(klon), xfiwp(klon)
-  REAL xflwc(klon, klev), xfiwc(klon, klev)
-
-  REAL radius
-
-  REAL coef_froi, coef_chau
-  PARAMETER (coef_chau=0.13, coef_froi=0.09)
-
-  REAL seuil_neb
-  PARAMETER (seuil_neb=0.001)
-
-! JBM (3/14) nexpo is replaced by exposant_glace
-! INTEGER nexpo ! exponentiel pour glace/eau
-! PARAMETER (nexpo=6)
-! PARAMETER (nexpo=1)
-! if iflag_t_glace=0, the old values are used:
-  REAL, PARAMETER :: t_glace_min_old = 258.
-  REAL, PARAMETER :: t_glace_max_old = 273.13
-
-  REAL rel, tc, rei, iwc, dei, deimin, deimax
-  REAL k_ice0, k_ice, df
-  PARAMETER (k_ice0=0.005) ! units=m2/g
-  PARAMETER (df=1.66) ! diffusivity factor
-
-  ! jq for the aerosol indirect effect
-  ! jq introduced by Johannes Quaas (quaas@lmd.jussieu.fr), 27/11/2003
-  ! jq
-  REAL mass_solu_aero(klon, klev) ! total mass concentration for all soluble aerosols [ug m-3]
-  REAL mass_solu_aero_pi(klon, klev) ! - " - (pre-industrial value)
-  REAL cdnc(klon, klev) ! cloud droplet number concentration [m-3]
-  REAL re(klon, klev) ! cloud droplet effective radius [um]
-  REAL cdnc_pi(klon, klev) ! cloud droplet number concentration [m-3] (pi value)
-  REAL re_pi(klon, klev) ! cloud droplet effective radius [um] (pi value)
-
-  REAL fl(klon, klev) ! xliq * rneb (denominator to re; fraction of liquid water clouds
-  ! within the grid cell)
-
-  INTEGER flag_aerosol
-  LOGICAL ok_cdnc
-  REAL bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula
-
-  ! jq-end
-  ! IM cf. CR:parametres supplementaires
-  REAL dzfice(klon,klev)
-  REAL zclear(klon)
-  REAL zcloud(klon)
-  REAL zcloudh(klon)
-  REAL zcloudm(klon)
-  REAL zcloudl(klon)
-  REAL rhodz(klon, klev) !--rho*dz pour la couche
-  REAL zrho(klon, klev) !--rho pour la couche
-  REAL dh(klon, klev) !--dz pour la couche
-  REAL rad_chaud(klon, klev) !--rayon pour les nuages chauds
-  REAL rad_chaud_pi(klon, klev) !--rayon pour les nuages chauds pre-industriels
-  REAL zflwp_var, zfiwp_var
-  REAL d_rei_dt
-
-  ! Abderrahmane oct 2009
-  REAL reliq(klon, klev), reice(klon, klev)
-  REAL reliq_pi(klon, klev), reice_pi(klon, klev)
-
-  REAL,SAVE :: cdnc_min=-1.
-  REAL,SAVE :: cdnc_min_m3
-  !$OMP THREADPRIVATE(cdnc_min,cdnc_min_m3)
-  REAL,SAVE :: cdnc_max=-1.
-  REAL,SAVE :: cdnc_max_m3
-  !$OMP THREADPRIVATE(cdnc_max,cdnc_max_m3)
-
-  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-  ! FH : 2011/05/24
-
-  ! rei = ( rei_max - rei_min ) * T(°C) / 81.4 + rei_max
-  ! to be used for a temperature in celcius T(°C) < 0
-  ! rei=rei_min for T(°C) < -81.4
-
-  ! Calcul de la pente de la relation entre rayon effective des cristaux
-  ! et la température.
-  ! Pour retrouver les résultats numériques de la version d'origine,
-  ! on impose 0.71 quand on est proche de 0.71
-
-  if (first) THEN
-      call getin_p('cdnc_min',cdnc_min)
-      cdnc_min_m3=cdnc_min*1.E6
-      IF (cdnc_min_m3<0.) cdnc_min_m3=20.E6 ! astuce pour retrocompatibilite
-      write(lunout,*)'cdnc_min=', cdnc_min_m3/1.E6
-      call getin_p('cdnc_max',cdnc_max)
-      cdnc_max_m3=cdnc_max*1.E6
-      IF (cdnc_max_m3<0.) cdnc_max_m3=1000.E6 ! astuce pour retrocompatibilite
-      write(lunout,*)'cdnc_max=', cdnc_max_m3/1.E6
-  ENDIF
-
-  d_rei_dt = (rei_max-rei_min)/81.4
-  IF (abs(d_rei_dt-0.71)<1.E-4) d_rei_dt = 0.71
-  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  ! Calculer l'epaisseur optique et l'emmissivite des nuages
-  ! IM inversion des DO
-
-  xflwp = 0.D0
-  xfiwp = 0.D0
-  xflwc = 0.D0
-  xfiwc = 0.D0
-
-  reliq = 0.
-  reice = 0.
-  reliq_pi = 0.
-  reice_pi = 0.
-
-  IF (iflag_t_glace.EQ.0) THEN
-    DO k = 1, klev
-      DO i = 1, klon
-        ! -layer calculation
-        rhodz(i, k) = (paprs(i,k)-paprs(i,k+1))/rg ! kg/m2
-        zrho(i, k) = pplay(i, k)/t(i, k)/rd ! kg/m3
-        dh(i, k) = rhodz(i, k)/zrho(i, k) ! m
-        ! -Fraction of ice in cloud using a linear transition
-        zfice(i, k) = 1.0 - (t(i,k)-t_glace_min_old)/(t_glace_max_old-t_glace_min_old)
-        zfice(i, k) = min(max(zfice(i,k),0.0), 1.0)
-        ! -IM Total Liquid/Ice water content
-        xflwc(i, k) = (1.-zfice(i,k))*pqlwp(i, k)
-        xfiwc(i, k) = zfice(i, k)*pqlwp(i, k)
-      ENDDO
-    ENDDO
-  ELSE ! of IF (iflag_t_glace.EQ.0)
-    DO k = 1, klev
-
-! JBM: icefrac_lsc is now contained icefrac_lsc_mod
-!       zfice(i, k) = icefrac_lsc(t(i,k), t_glace_min, &
-!                                 t_glace_max, exposant_glace)
-
-      IF (ok_new_lscp) THEN
-          CALL icefrac_lscp(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:,k),dzfice(:,k))
-      ELSE
-          CALL icefrac_lsc(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:,k))
-      ENDIF
-
-      DO i = 1, klon
-        
-        IF ((.NOT. ptconv(i,k)) .AND. ok_new_lscp .AND. ok_icefra_lscp) THEN
-        ! EV: take the ice fraction directly from the lscp code
-        ! consistent only for non convective grid points
-        ! critical for mixed phase clouds
-            zfice(i,k)=picefra(i,k)
-        ENDIF
-
-        ! -layer calculation
-        rhodz(i, k) = (paprs(i,k)-paprs(i,k+1))/rg ! kg/m2
-        zrho(i, k) = pplay(i, k)/t(i, k)/rd ! kg/m3
-        dh(i, k) = rhodz(i, k)/zrho(i, k) ! m
-        ! -IM Total Liquid/Ice water content
-        xflwc(i, k) = (1.-zfice(i,k))*pqlwp(i, k)
-        xfiwc(i, k) = zfice(i, k)*pqlwp(i, k)
-      ENDDO
-    ENDDO
-  ENDIF
-
-  IF (ok_cdnc) THEN
-
-    ! --we compute cloud properties as a function of the aerosol load
-
-    DO k = 1, klev
-      DO i = 1, klon
-        ! Formula "D" of Boucher and Lohmann, Tellus, 1995
-        ! Cloud droplet number concentration (CDNC) is restricted
-        ! to be within [20, 1000 cm^3]
-
-        ! --pre-industrial case
-        cdnc_pi(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero_pi(i,k), &
-          1.E-4))/log(10.))*1.E6 !-m-3
-        cdnc_pi(i, k) = min(cdnc_max_m3, max(cdnc_min_m3,cdnc_pi(i,k)))
-
-      ENDDO
-    ENDDO
-
-    !--flag_aerosol=7 => MACv2SP climatology 
-    !--in this case there is an enhancement factor
-    IF (flag_aerosol .EQ. 7) THEN 
-
-      !--present-day
-      DO k = 1, klev
-        DO i = 1, klon
-          cdnc(i, k) = cdnc_pi(i,k)*dNovrN(i)
-        ENDDO
-      ENDDO
-
-    !--standard case
-    ELSE
-
-      DO k = 1, klev
-        DO i = 1, klon
-
-          ! Formula "D" of Boucher and Lohmann, Tellus, 1995
-          ! Cloud droplet number concentration (CDNC) is restricted
-          ! to be within [20, 1000 cm^3]
-
-          ! --present-day case
-          cdnc(i, k) = 10.**(bl95_b0+bl95_b1*log(max(mass_solu_aero(i,k), &
-            1.E-4))/log(10.))*1.E6 !-m-3
-          cdnc(i, k) = min(cdnc_max_m3, max(cdnc_min_m3,cdnc(i,k)))
-
-        ENDDO
-      ENDDO
-
-    ENDIF !--flag_aerosol
-
-    !--computing cloud droplet size
-    DO k = 1, klev
-      DO i = 1, klon
-
-        ! --present-day case
-        rad_chaud(i, k) = 1.1*((pqlwp(i,k)*pplay(i, &
-          k)/(rd*t(i,k)))/(4./3*rpi*1000.*cdnc(i,k)))**(1./3.)
-        rad_chaud(i, k) = max(rad_chaud(i,k)*1.E6, 5.)
-
-        ! --pre-industrial case
-        rad_chaud_pi(i, k) = 1.1*((pqlwp(i,k)*pplay(i, &
-          k)/(rd*t(i,k)))/(4./3.*rpi*1000.*cdnc_pi(i,k)))**(1./3.)
-        rad_chaud_pi(i, k) = max(rad_chaud_pi(i,k)*1.E6, 5.)
-
-        ! --pre-industrial case
-        ! --liquid/ice cloud water paths:
-        IF (pclc(i,k)<=seuil_neb) THEN
-
-          pcldtaupi(i, k) = 0.0
-
-        ELSE
-
-          zflwp_var = 1000.*(1.-zfice(i,k))*pqlwp(i, k)/pclc(i, k)* &
-            rhodz(i, k)
-          zfiwp_var = 1000.*zfice(i, k)*pqlwp(i, k)/pclc(i, k)*rhodz(i, k)
-          ! Calculation of ice cloud effective radius in micron
-          IF (iflag_rei .EQ. 1) THEN
-            ! when we account for precipitation in the radiation scheme,
-            ! It is recommended to use the rei formula from Sun and Rikkus 1999 with a revision
-            ! from Sun 2001 (as in the IFS model)
-            iwc=zfice(i, k)*pqlwp(i, k)/pclc(i,k)*zrho(i,k)*1000. !in cloud ice water content in g/m3
-            dei=(1.2351+0.0105*(t(i,k)-273.15))*(45.8966*(iwc**0.2214) + &
-               & 0.7957*(iwc**0.2535)*(t(i,k)-83.15))
-            !deimax=155.0
-            !deimin=20.+40*cos(abs(latitude_deg(i))/180.*RPI)
-            !Etienne: deimax and deimin controled by rei_max and rei_min in physiq.def
-            deimax=rei_max*2.0
-            deimin=2.0*rei_min+40*cos(abs(latitude_deg(i))/180.*RPI) 
-            dei=min(dei,deimax)
-            dei=max(dei,deimin)
-            rei=3.*sqrt(3.)/8.*dei
-           ELSE
-            ! Default
-            ! for ice clouds: as a function of the ambiant temperature
-            ! [formula used by Iacobellis and Somerville (2000), with an
-            ! asymptotical value of 3.5 microns at T<-81.4 C added to be
-            ! consistent with observations of Heymsfield et al. 1986]:
-            ! 2011/05/24 : rei_min = 3.5 becomes a free PARAMETER as well as
-            ! rei_max=61.29
-            tc = t(i, k) - 273.15
-            rei = d_rei_dt*tc + rei_max
-            IF (tc<=-81.4) rei = rei_min
-           ENDIF
-
-          ! -- cloud optical thickness :
-          ! [for liquid clouds, traditional formula,
-          ! for ice clouds, Ebert & Curry (1992)]
-
-          IF (zfiwp_var==0. .OR. rei<=0.) rei = 1.
-          pcldtaupi(i, k) = 3.0/2.0*zflwp_var/rad_chaud_pi(i, k) + &
-            zfiwp_var*(3.448E-03+2.431/rei)
-
-        ENDIF
-
-      ENDDO
-    ENDDO
-
-  ELSE !--not ok_cdnc
-
-    ! -prescribed cloud droplet radius
-
-    DO k = 1, min(3, klev)
-      DO i = 1, klon
-        rad_chaud(i, k) = rad_chau2
-        rad_chaud_pi(i, k) = rad_chau2
-      ENDDO
-    ENDDO
-    DO k = min(3, klev) + 1, klev
-      DO i = 1, klon
-        rad_chaud(i, k) = rad_chau1
-        rad_chaud_pi(i, k) = rad_chau1
-      ENDDO
-    ENDDO
-
-  ENDIF !--ok_cdnc
-
-  ! --computation of cloud optical depth and emissivity
-  ! --in the general case
-
-  DO k = 1, klev
-    DO i = 1, klon
-
-      IF (pclc(i,k)<=seuil_neb) THEN
-
-        ! effective cloud droplet radius (microns) for liquid water clouds:
-        ! For output diagnostics cloud droplet effective radius [um]
-        ! we multiply here with f * xl (fraction of liquid water
-        ! clouds in the grid cell) to avoid problems in the averaging of the
-        ! output.
-        ! In the output of IOIPSL, derive the REAL cloud droplet
-        ! effective radius as re/fl
-
-        fl(i, k) = seuil_neb*(1.-zfice(i,k))
-        re(i, k) = rad_chaud(i, k)*fl(i, k)
-        rel = 0.
-        rei = 0.
-        pclc(i, k) = 0.0
-        pcltau(i, k) = 0.0
-        pclemi(i, k) = 0.0
-
-      ELSE
-
-        ! -- liquid/ice cloud water paths:
-
-        zflwp_var = 1000.*(1.-zfice(i,k))*pqlwp(i, k)/pclc(i, k)*rhodz(i, k)
-        zfiwp_var = 1000.*zfice(i, k)*pqlwp(i, k)/pclc(i, k)*rhodz(i, k)
-
-        ! effective cloud droplet radius (microns) for liquid water clouds:
-        ! For output diagnostics cloud droplet effective radius [um]
-        ! we multiply here with f * xl (fraction of liquid water
-        ! clouds in the grid cell) to avoid problems in the averaging of the
-        ! output.
-        ! In the output of IOIPSL, derive the REAL cloud droplet
-        ! effective radius as re/fl
-
-        fl(i, k) = pclc(i, k)*(1.-zfice(i,k))
-        re(i, k) = rad_chaud(i, k)*fl(i, k)
-
-        rel = rad_chaud(i, k)
-
-        ! Calculation of ice cloud effective radius in micron
-
-
-        IF (iflag_rei .GT. 0) THEN
-
-            ! when we account for precipitation in the radiation scheme,
-            ! we use the rei formula from Sun and Rikkus 1999 with a revision
-            ! from Sun 2001 (as in the IFS model)
-            iwc=zfice(i, k)*pqlwp(i, k)/pclc(i,k)*zrho(i,k)*1000. !in cloud ice water content in g/m3
-            dei=(1.2351+0.0105*(t(i,k)-273.15))*(45.8966*(iwc**0.2214) + &
-               &0.7957*(iwc**0.2535)*(t(i,k)-83.15))
-            !deimax=155.0
-            !deimin=20.+40*cos(abs(latitude_deg(i))/180.*RPI)
-            !Etienne: deimax and deimin controled by rei_max and rei_min in physiq.def
-            deimax=rei_max*2.0
-            deimin=2.0*rei_min+40*cos(abs(latitude_deg(i))/180.*RPI) 
-            dei=min(dei,deimax)
-            dei=max(dei,deimin)
-            rei=3.*sqrt(3.)/8.*dei
-       
-        ELSE
-            ! Default
-            ! for ice clouds: as a function of the ambiant temperature
-            ! [formula used by Iacobellis and Somerville (2000), with an
-            ! asymptotical value of 3.5 microns at T<-81.4 C added to be
-            ! consistent with observations of Heymsfield et al. 1986]:
-            ! 2011/05/24 : rei_min = 3.5 becomes a free PARAMETER as well as
-            ! rei_max=61.29
-            tc = t(i, k) - 273.15
-            rei = d_rei_dt*tc + rei_max
-            IF (tc<=-81.4) rei = rei_min
-        ENDIF
-        ! -- cloud optical thickness :
-        ! [for liquid clouds, traditional formula,
-        ! for ice clouds, Ebert & Curry (1992)]
-
-        IF (zflwp_var==0.) rel = 1.
-        IF (zfiwp_var==0. .OR. rei<=0.) rei = 1.
-        pcltau(i, k) = 3.0/2.0*(zflwp_var/rel) + zfiwp_var*(3.448E-03+2.431/ &
-          rei)
-
-        ! -- cloud infrared emissivity:
-        ! [the broadband infrared absorption coefficient is PARAMETERized
-        ! as a function of the effective cld droplet radius]
-        ! Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):
-
-        k_ice = k_ice0 + 1.0/rei
-
-        pclemi(i, k) = 1.0 - exp(-coef_chau*zflwp_var-df*k_ice*zfiwp_var)
-
-      ENDIF
-
-      reice(i, k) = rei
-
-      xflwp(i) = xflwp(i) + xflwc(i, k)*rhodz(i, k)
-      xfiwp(i) = xfiwp(i) + xfiwc(i, k)*rhodz(i, k)
-
-    ENDDO
-  ENDDO
-
-  ! --if cloud droplet radius is fixed, then pcldtaupi=pcltau
-
-  IF (.NOT. ok_cdnc) THEN
-    DO k = 1, klev
-      DO i = 1, klon
-        pcldtaupi(i, k) = pcltau(i, k)
-        reice_pi(i, k) = reice(i, k)
-      ENDDO
-    ENDDO
-  ENDIF
-
-  DO k = 1, klev
-    DO i = 1, klon
-      reliq(i, k) = rad_chaud(i, k)
-      reliq_pi(i, k) = rad_chaud_pi(i, k)
-      reice_pi(i, k) = reice(i, k)
-    ENDDO
-  ENDDO
-
-  ! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
-  ! IM cf. CR:test: calcul prenant ou non en compte le recouvrement
-  ! initialisations
-
-  DO i = 1, klon
-    zclear(i) = 1.
-    zcloud(i) = 0.
-    zcloudh(i) = 0.
-    zcloudm(i) = 0.
-    zcloudl(i) = 0.
-    pch(i) = 1.0
-    pcm(i) = 1.0
-    pcl(i) = 1.0
-    pctlwp(i) = 0.0
-  ENDDO
-
-  ! --calculation of liquid water path
-
-  DO k = klev, 1, -1
-    DO i = 1, klon
-      pctlwp(i) = pctlwp(i) + pqlwp(i, k)*rhodz(i, k)
-    ENDDO
-  ENDDO
-
-  ! --calculation of cloud properties with cloud overlap
-
-  IF (novlp==1) THEN
-    DO k = klev, 1, -1
-      DO i = 1, klon
-        zclear(i) = zclear(i)*(1.-max(pclc(i,k),zcloud(i)))/(1.-min(real( &
-          zcloud(i),kind=8),1.-zepsec))
-        pct(i) = 1. - zclear(i)
-        IF (paprs(i,k)<prmhc) THEN
-          pch(i) = pch(i)*(1.-max(pclc(i,k),zcloudh(i)))/(1.-min(real(zcloudh &
-            (i),kind=8),1.-zepsec))
-          zcloudh(i) = pclc(i, k)
-        ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
-          pcm(i) = pcm(i)*(1.-max(pclc(i,k),zcloudm(i)))/(1.-min(real(zcloudm &
-            (i),kind=8),1.-zepsec))
-          zcloudm(i) = pclc(i, k)
-        ELSE IF (paprs(i,k)>=prlmc) THEN
-          pcl(i) = pcl(i)*(1.-max(pclc(i,k),zcloudl(i)))/(1.-min(real(zcloudl &
-            (i),kind=8),1.-zepsec))
-          zcloudl(i) = pclc(i, k)
-        ENDIF
-        zcloud(i) = pclc(i, k)
-      ENDDO
-    ENDDO
-  ELSE IF (novlp==2) THEN
-    DO k = klev, 1, -1
-      DO i = 1, klon
-        zcloud(i) = max(pclc(i,k), zcloud(i))
-        pct(i) = zcloud(i)
-        IF (paprs(i,k)<prmhc) THEN
-          pch(i) = min(pclc(i,k), pch(i))
-        ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
-          pcm(i) = min(pclc(i,k), pcm(i))
-        ELSE IF (paprs(i,k)>=prlmc) THEN
-          pcl(i) = min(pclc(i,k), pcl(i))
-        ENDIF
-      ENDDO
-    ENDDO
-  ELSE IF (novlp==3) THEN
-    DO k = klev, 1, -1
-      DO i = 1, klon
-        zclear(i) = zclear(i)*(1.-pclc(i,k))
-        pct(i) = 1 - zclear(i)
-        IF (paprs(i,k)<prmhc) THEN
-          pch(i) = pch(i)*(1.0-pclc(i,k))
-        ELSE IF (paprs(i,k)>=prmhc .AND. paprs(i,k)<prlmc) THEN
-          pcm(i) = pcm(i)*(1.0-pclc(i,k))
-        ELSE IF (paprs(i,k)>=prlmc) THEN
-          pcl(i) = pcl(i)*(1.0-pclc(i,k))
-        ENDIF
-      ENDDO
-    ENDDO
-  ENDIF
-
-  DO i = 1, klon
-    pch(i) = 1. - pch(i)
-    pcm(i) = 1. - pcm(i)
-    pcl(i) = 1. - pcl(i)
-  ENDDO
-
-  ! ========================================================
-  ! DIAGNOSTICS CALCULATION FOR CMIP5 PROTOCOL
-  ! ========================================================
-  ! change by Nicolas Yan (LSCE)
-  ! Cloud Droplet Number Concentration (CDNC) : 3D variable
-  ! Fractionnal cover by liquid water cloud (LCC3D) : 3D variable
-  ! Cloud Droplet Number Concentration at top of cloud (CLDNCL) : 2D variable
-  ! Droplet effective radius at top of cloud (REFFCLWTOP) : 2D variable
-  ! Fractionnal cover by liquid water at top of clouds (LCC) : 2D variable
-
-  IF (ok_cdnc) THEN
-
-    DO k = 1, klev
-      DO i = 1, klon
-        phase3d(i, k) = 1 - zfice(i, k)
-        IF (pclc(i,k)<=seuil_neb) THEN
-          lcc3d(i, k) = seuil_neb*phase3d(i, k)
-        ELSE
-          lcc3d(i, k) = pclc(i, k)*phase3d(i, k)
-        ENDIF
-        scdnc(i, k) = lcc3d(i, k)*cdnc(i, k) ! m-3
-      ENDDO
-    ENDDO
-
-    DO i = 1, klon
-      lcc(i) = 0.
-      reffclwtop(i) = 0.
-      cldncl(i) = 0.
-      IF (novlp.EQ.3 .OR. novlp.EQ.1) tcc(i) = 1.
-      IF (novlp.EQ.2) tcc(i) = 0.
-    ENDDO
-
-    DO i = 1, klon
-      DO k = klev - 1, 1, -1 !From TOA down
-
-          ! Test, if the cloud optical depth exceeds the necessary
-          ! threshold:
-
-        IF (pcltau(i,k)>thres_tau .AND. pclc(i,k)>thres_neb) THEN
-
-          IF (novlp.EQ.2) THEN
-            IF (first) THEN
-              WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM'
-              first = .FALSE.
-            ENDIF
-            flag_max = -1.
-            ftmp(i) = max(tcc(i), pclc(i,k))
-          ENDIF
-
-          IF (novlp.EQ.3) THEN
-            IF (first) THEN
-              WRITE (*, *) 'Hypothese de recouvrement: RANDOM'
-              first = .FALSE.
-            ENDIF
-            flag_max = 1.
-            ftmp(i) = tcc(i)*(1-pclc(i,k))
-          ENDIF
-
-          IF (novlp.EQ.1) THEN
-            IF (first) THEN
-              WRITE (*, *) 'Hypothese de recouvrement: MAXIMUM_ &
-                &                                             &
-                &                                          RANDOM'
-              first = .FALSE.
-            ENDIF
-            flag_max = 1.
-            ftmp(i) = tcc(i)*(1.-max(pclc(i,k),pclc(i,k+1)))/(1.-min(pclc(i, &
-              k+1),1.-thres_neb))
-          ENDIF
-          ! Effective radius of cloud droplet at top of cloud (m)
-          reffclwtop(i) = reffclwtop(i) + rad_chaud(i, k)*1.0E-06*phase3d(i, &
-            k)*(tcc(i)-ftmp(i))*flag_max
-          ! CDNC at top of cloud (m-3)
-          cldncl(i) = cldncl(i) + cdnc(i, k)*phase3d(i, k)*(tcc(i)-ftmp(i))* &
-            flag_max
-          ! Liquid Cloud Content at top of cloud
-          lcc(i) = lcc(i) + phase3d(i, k)*(tcc(i)-ftmp(i))*flag_max
-          ! Total Cloud Content at top of cloud
-          tcc(i) = ftmp(i)
-
-        ENDIF ! is there a visible, not-too-small cloud?
-      ENDDO ! loop over k
-
-      IF (novlp.EQ.3 .OR. novlp.EQ.1) tcc(i) = 1. - tcc(i)
-
-    ENDDO ! loop over i
-
-    ! ! Convective and Stratiform Cloud Droplet Effective Radius (REFFCLWC
-    ! REFFCLWS)
-    DO i = 1, klon
-      DO k = 1, klev
-        ! Weight to be used for outputs: eau_liquide*couverture nuageuse
-        lcc3dcon(i, k) = rnebcon(i, k)*phase3d(i, k)*clwcon(i, k) ! eau liquide convective
-        lcc3dstra(i, k) = pclc(i, k)*pqlwp(i, k)*phase3d(i, k)
-        lcc3dstra(i, k) = lcc3dstra(i, k) - lcc3dcon(i, k) ! eau liquide stratiforme
-        lcc3dstra(i, k) = max(lcc3dstra(i,k), 0.0)
-        !FC pour la glace (CAUSES)
-        icc3dcon(i, k) = rnebcon(i, k)*(1-phase3d(i, k))*clwcon(i, k) !  glace convective
-        icc3dstra(i, k)= pclc(i, k)*pqlwp(i, k)*(1-phase3d(i, k))
-        icc3dstra(i, k) = icc3dstra(i, k) - icc3dcon(i, k) ! glace stratiforme
-        icc3dstra(i, k) = max( icc3dstra(i, k), 0.0)
-        !FC (CAUSES)
-
-        ! Compute cloud droplet radius as above in meter
-        radius = 1.1*((pqlwp(i,k)*pplay(i,k)/(rd*t(i,k)))/(4./3*rpi*1000.* &
-          cdnc(i,k)))**(1./3.)
-        radius = max(radius, 5.E-6)
-        ! Convective Cloud Droplet Effective Radius (REFFCLWC) : variable 3D
-        reffclwc(i, k) = radius
-        reffclwc(i, k) = reffclwc(i, k)*lcc3dcon(i, k)
-        ! Stratiform Cloud Droplet Effective Radius (REFFCLWS) : variable 3D
-        reffclws(i, k) = radius
-        reffclws(i, k) = reffclws(i, k)*lcc3dstra(i, k)
-      ENDDO !klev
-    ENDDO !klon
-
-    ! Column Integrated Cloud Droplet Number (CLDNVI) : variable 2D
-
-    DO i = 1, klon
-      cldnvi(i) = 0.
-      lcc_integrat(i) = 0.
-      height(i) = 0.
-      DO k = 1, klev
-        cldnvi(i) = cldnvi(i) + cdnc(i, k)*lcc3d(i, k)*dh(i, k)
-        lcc_integrat(i) = lcc_integrat(i) + lcc3d(i, k)*dh(i, k)
-        height(i) = height(i) + dh(i, k)
-      ENDDO ! klev
-      lcc_integrat(i) = lcc_integrat(i)/height(i)
-      IF (lcc_integrat(i)<=1.0E-03) THEN
-        cldnvi(i) = cldnvi(i)*lcc(i)/seuil_neb
-      ELSE
-        cldnvi(i) = cldnvi(i)*lcc(i)/lcc_integrat(i)
-      ENDIF
-    ENDDO ! klon
-
-    DO i = 1, klon
-      DO k = 1, klev
-        IF (scdnc(i,k)<=0.0) scdnc(i, k) = 0.0
-        IF (reffclws(i,k)<=0.0) reffclws(i, k) = 0.0
-        IF (reffclwc(i,k)<=0.0) reffclwc(i, k) = 0.0
-        IF (lcc3d(i,k)<=0.0) lcc3d(i, k) = 0.0
-        IF (lcc3dcon(i,k)<=0.0) lcc3dcon(i, k) = 0.0
-        IF (lcc3dstra(i,k)<=0.0) lcc3dstra(i, k) = 0.0
-!FC (CAUSES)
-        IF (icc3dcon(i,k)<=0.0) icc3dcon(i, k) = 0.0
-        IF (icc3dstra(i,k)<=0.0) icc3dstra(i, k) = 0.0
-!FC (CAUSES)
-      ENDDO
-      IF (reffclwtop(i)<=0.0) reffclwtop(i) = 0.0
-      IF (cldncl(i)<=0.0) cldncl(i) = 0.0
-      IF (cldnvi(i)<=0.0) cldnvi(i) = 0.0
-      IF (lcc(i)<=0.0) lcc(i) = 0.0
-    ENDDO
-
-  ENDIF !ok_cdnc
-
-  first=.false. !to be sure
-
-  RETURN
-
-END SUBROUTINE newmicro
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/nuage.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/nuage.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/nuage.F90	(revision 4727)
@@ -2,9 +2,10 @@
 
 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, &
-    cldtaupi, re, fl)
+    pct, pctlwp, ok_aie, mass_solu_aero, mass_solu_aero_pi, bl95_b0, bl95_b1, distcltop, &
+    temp_cltop, cldtaupi, re, fl)
   USE dimphy
-  USE lscp_tools_mod, only: icefrac_lscp
+  USE lmdz_lscp_tools, only: icefrac_lscp
   USE icefrac_lsc_mod ! computes ice fraction (JBM 3/14)
+  USE lmdz_lscp_ini, only : iflag_t_glace
   USE phys_local_var_mod, ONLY: ptconv
   IMPLICIT NONE
@@ -49,5 +50,6 @@
 
   REAL pct(klon), pctlwp(klon), pch(klon), pcl(klon), pcm(klon)
-
+  REAL distcltop(klon,klev)
+  REAL temp_cltop(klon,klev)
   LOGICAL lo
 
@@ -112,5 +114,5 @@
 !                           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),temp_cltop(:,k),zfice(:),dzfice(:))
         ELSE
             CALL icefrac_lsc(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:))
@@ -118,12 +120,14 @@
         ENDIF
 
-        IF ((.NOT. ptconv(i,k)) .AND. ok_new_lscp .AND. ok_icefra_lscp) THEN
-        ! EV: take the ice fraction directly from the lscp code
-        ! consistent only for non convective grid points
-        ! critical for mixed phase clouds
-            DO i=1,klon
-            zfice(i)=picefra(i,k)
-            ENDDO
+    IF (ok_new_lscp .AND. ok_icefra_lscp) THEN
+    ! EV: take the ice fraction directly from the lscp code
+    ! consistent only for non convective grid points
+    ! critical for mixed phase clouds
+        DO i=1,klon
+        IF (.NOT. ptconv(i,k)) THEN
+           zfice(i)=picefra(i,k)
         ENDIF
+        ENDDO
+    ENDIF 
 
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/nuage.h
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/nuage.h	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/nuage.h	(revision 4727)
@@ -2,25 +2,14 @@
 ! $Id$
 !
-      REAL rad_froid, rad_chau1, rad_chau2, t_glace_max, t_glace_min
-      REAL exposant_glace
-      REAL rei_min,rei_max
+      REAL rad_froid, rad_chau1, rad_chau2
       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, iflag_ratqs
       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,                 &
      &                  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_rei    
+     &                  tmax_fonte_cv,iflag_ratqs,                      &
+     &                  iflag_cld_cv,                                   &
+     &                  ok_icefra_lscp                                 
 !$OMP THREADPRIVATE(/nuagecom/)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/oasis.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/oasis.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/oasis.F90	(revision 4727)
@@ -24,7 +24,4 @@
   USE mod_prism_get_proto
   USE mod_prism_put_proto
-#endif
-#ifdef CPP_CPLOCNINCA
-  USE incaoasis, ONLY : inforcv
 #endif
 #endif
@@ -77,14 +74,13 @@
   INTEGER, PARAMETER :: idr_curenz = 7
   INTEGER, PARAMETER :: idr_oceco2 = 8
-
+  ! bulk salinity of the surface layer of the ocean, in ppt
   INTEGER, PARAMETER :: idr_sss = 9
-  ! bulk salinity of the surface layer of the ocean, in ppt
-
-  INTEGER, PARAMETER :: maxrecv    = 9  ! Maximum number of fields to receive
-  
-#ifdef CPP_CPLOCNINCA
-  INTEGER, PARAMETER :: idr_ocedms = 1
-  INTEGER, PARAMETER :: maxrcv = 1
-#endif
+  INTEGER, PARAMETER :: idr_ocedms = 10
+
+  INTEGER, PARAMETER :: maxrecv      = 10     ! Maximum number of fields to receive
+  INTEGER, PARAMETER :: maxrecv_phys = 9      ! Maximum number of fields to receive in physiq (without fields received in INCA model )
+                                              ! will be changed in next version - INCA fields will be received in LMDZ (like for ORCHIDEE fields)
+                                              ! and then send by routine in INCA model 
+  
 
   TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information
@@ -117,8 +113,7 @@
     USE surface_data, ONLY : version_ocean
     USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
-#ifdef CPP_XIOS
     USE wxios, ONLY : wxios_context_init 
-    USE xios  
-#endif
+    USE chemistry_cycle_mod, ONLY : dms_cycle_cpl
+    USE lmdz_xios  
     USE print_control_mod, ONLY: lunout
     USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat
@@ -141,4 +136,5 @@
     CHARACTER (len = 80)               :: abort_message 
     LOGICAL, SAVE                      :: cpl_current_omp
+    INTEGER, DIMENSION(klon_mpi)       :: ind_cell_glo_mpi
 
 !*    1. Initializations
@@ -175,4 +171,9 @@
     cpl_current = cpl_current_omp
     WRITE(lunout,*) 'Couple ocean currents, cpl_current = ',cpl_current 
+
+!************************************************************************************
+! Gather global index to be used for oasis decomposition
+!************************************************************************************
+    CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
 
 !************************************************************************************
@@ -261,7 +262,8 @@
        inforecv(idr_oceco2)%action = .TRUE. ; inforecv(idr_oceco2)%name = 'SICO2FLX'
    ENDIF
-#ifdef CPP_CPLOCNINCA
-       inforcv(idr_ocedms)%action = .TRUE. ; inforcv(idr_ocedms)%name = 'SIDMSFLX'
-#endif
+   IF (dms_cycle_cpl) THEN 
+      inforecv(idr_ocedms)%action = .TRUE. ; inforecv(idr_ocedms)%name = 'SIDMSFLX'
+   ENDIF
+ 
 
 !************************************************************************************
@@ -291,5 +293,5 @@
 
       DO jf=1, klon_mpi_para_nb(mpi_rank)
-        ig_paral(2+jf) = ind_cell_glo(jf)
+        ig_paral(2+jf) = ind_cell_glo_mpi(jf)
       ENDDO
 
@@ -349,19 +351,9 @@
     END DO
 
-! Now, if also coupling CPL with INCA, initialize here fields to be exchanged.
-#ifdef CPP_CPLOCNINCA
-    DO jf=1,maxrcv 
-       IF (inforcv(jf)%action) THEN
-          CALL prism_def_var_proto(inforcv(jf)%nid, inforcv(jf)%name, il_part_id, &
-               il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, &
-               ierror)
-          IF (ierror .NE. PRISM_Ok) THEN
-             WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',&
-                  inforcv(jf)%name
-             abort_message=' Problem in call to prism_def_var_proto for fields to receive'
-             CALL abort_physic(modname,abort_message,1)
-          ENDIF
-       ENDIF
-    END DO
+
+#ifdef INCA
+    IF (dms_cycle_cpl) THEN
+       CALL init_inca_oasis(inforecv(idr_ocedms))
+    ENDIF
 #endif
  
@@ -387,7 +379,7 @@
 ! End definition
 !************************************************************************************
-#ifdef CPP_XIOS
-    CALL xios_oasis_enddef()
-#endif
+
+    IF (using_xios) CALL xios_oasis_enddef()
+
     CALL prism_enddef_proto(ierror)
     IF (ierror .NE. PRISM_Ok) THEN
@@ -398,8 +390,4 @@
     ENDIF
 
-#ifdef CPP_XIOS
-!    CALL wxios_context_init()
-#endif
-
 !$OMP END MASTER
     
@@ -424,5 +412,5 @@
 ! Output arguments
 !************************************************************************************
-    REAL, DIMENSION(nbp_lon, jj_nb,maxrecv), INTENT(OUT) :: tab_get
+    REAL, DIMENSION(nbp_lon, jj_nb,maxrecv_phys), INTENT(OUT) :: tab_get
 
 ! Local variables
@@ -446,5 +434,5 @@
     ENDIF
     
-    DO i = 1, maxrecv
+    DO i = 1, maxrecv_phys
       IF (inforecv(i)%action .AND. inforecv(i)%nid .NE. -1) THEN
           field(:) = -99999.
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ocean_forced_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ocean_forced_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ocean_forced_mod.F90	(revision 4727)
@@ -167,5 +167,5 @@
   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, &
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/output_physiqex_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/output_physiqex_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/output_physiqex_mod.F90	(revision 4727)
@@ -0,0 +1,87 @@
+MODULE output_physiqex_mod
+
+
+
+CONTAINS 
+
+SUBROUTINE output_physiqex(debut,zjulian,pdtphys,presnivs,paprs,u,v,t,qx,cf,zqr,zqs,zqg,ptke,theta)
+
+      USE dimphy, only : klon,klev
+      USE iophy, only : histbeg_phy,histwrite_phy
+      USE ioipsl, only : histvert,histdef,histend,histsync
+      USE mod_phys_lmdz_para, only : jj_nb
+      USE ioipsl_getin_p_mod, ONLY : getin_p
+      USE mod_grid_phy_lmdz, ONLY: nbp_lon,nbp_lat
+      USE iophy, ONLY : init_iophy_new
+      USE geometry_mod, ONLY: latitude_deg, longitude_deg
+      USE infotrac_phy, only : nqtot
+
+
+
+implicit none
+logical, intent(in) :: debut
+real, intent(in) :: pdtphys,zjulian
+real,intent(in) :: presnivs(klev) ! pseudo-pressure (Pa) of mid-layers
+real,intent(in) :: u(klon,klev) ! eastward zonal wind (m/s)
+real,intent(in) :: v(klon,klev) ! northward meridional wind (m/s)
+real,intent(in) :: t(klon,klev) ! temperature (K)
+real,intent(in) :: theta(klon,klev) ! temperature (K)
+real,intent(in) :: paprs(klon,klev+1) ! interlayer pressure (Pa)
+real,intent(in) :: qx(klon,klev,nqtot) !tracers
+real,intent(in) :: cf(klon,klev) !cloud fraction
+real,intent(in) :: zqr(klon,klev) !rain specifiq content
+real,intent(in) :: zqs(klon,klev) !snow specifiq content
+real,intent(in) :: zqg(klon,klev) !graupel specifiq content
+real,intent(in) :: ptke(klon,klev) !tke
+
+real :: t_ops ! frequency of the IOIPSL operations (eg average over...)
+real :: t_wrt ! frequency of the IOIPSL outputs
+integer :: zvertid ! vertical coordinate ID
+real :: dtime
+
+integer,save :: iwrite_phys=1 ! output every iwrite_phys physics step
+!$OMP THREADPRIVATE(iwrite_phys)
+integer :: nhori ! horizontal coordinate ID
+integer,save :: nid_hist ! output file ID
+!$OMP THREADPRIVATE(nid_hist)
+integer, save :: itau=0
+!$OMP THREADPRIVATE(itau)
+
+integer, save :: ioex=1
+
+
+print*,'nnnnnnn ',nid_hist,debut,itau
+
+if(debut)then
+
+   call getin_p("iwrite_phys",iwrite_phys)
+
+   !$OMP MASTER
+   CALL iophys_ini(pdtphys)
+   !$OMP END MASTER
+   !$OMP BARRIER
+
+endif
+
+
+itau=itau+1
+
+if (modulo(itau,iwrite_phys)==0) then
+     call iophys_ecrit('temp',klev,'Temperature','K',t)
+     call iophys_ecrit('u',klev,'zonal wind','m/s',u)
+     call iophys_ecrit('v',klev,'meridinal wind','m/s',v)
+     call iophys_ecrit('ps',1,'Surface pressure','Pa',paprs(:,1))
+     call iophys_ecrit('qv',klev,'Water vapor specifiq content', 'kg/kg', qx(:,:,1))
+     call iophys_ecrit('qc',klev,'Cloud liquid water specifiq content', 'kg/kg', qx(:,:,2))
+     call iophys_ecrit('qi',klev,'Cloud solid water specifiq content', 'kg/kg', qx(:,:,3))
+     call iophys_ecrit('CF',klev,'Cloud fraction', '0-1', cf)
+     call iophys_ecrit('qr',klev,'Rain specifiq content', 'kg/kg', zqr)
+     call iophys_ecrit('qs',klev,'Snow specifiq content', 'kg/kg', zqs)
+     call iophys_ecrit('qg',klev,'Graupel specifiq content', 'kg/kg', zqg)
+     call iophys_ecrit('TKE',klev,'TKE', 'm2/s2', ptke)
+     call iophys_ecrit('theta',klev,'Temperature potentielle', 'K', theta)
+endif
+
+
+END SUBROUTINE output_physiqex
+END MODULE output_physiqex_mod
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/pbl_surface_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/pbl_surface_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/pbl_surface_mod.F90	(revision 4727)
@@ -21,7 +21,8 @@
   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 lmdz_call_atke,      ONLY : call_atke
   USE ioipsl_getin_p_mod,  ONLY : getin_p
   USE cdrag_mod
@@ -184,7 +185,7 @@
        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,8 +199,8 @@
        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,5 +225,5 @@
        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,5 +231,5 @@
 !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,9 +318,7 @@
          dser, dt_ds, zsig, zmea
     use phys_output_var_mod, only: tkt, tks, taur, sss
-#ifdef CPP_XIOS
-    USE wxios, ONLY: missing_val
-#else
-    use netcdf, only: missing_val => nf90_fill_real
-#endif
+    use lmdz_blowing_snow_ini, only : zeta_bs
+    USE wxios, ONLY: missing_val_xios => missing_val, using_xios
+    USE netcdf, only: missing_val_netcdf => nf90_fill_real
 
      
@@ -349,6 +348,7 @@
     REAL, DIMENSION(klon),        INTENT(IN)        :: rugoro  ! rugosity length
     REAL, DIMENSION(klon),        INTENT(IN)        :: rmu0    ! cosine of solar zenith angle
-    REAL, DIMENSION(klon),        INTENT(IN)        :: rain_f  ! rain fall
+    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,4 +356,5 @@
     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,4 +421,5 @@
                                                                   ! (=> 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,4 +438,6 @@
     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,5 +499,5 @@
     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,6 +521,9 @@
     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,16 +570,18 @@
     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,4 +610,5 @@
     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,12 +619,12 @@
     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,4 +688,5 @@
     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,4 +694,5 @@
     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,4 +787,5 @@
     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,4 +875,5 @@
     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)
@@ -882,8 +896,13 @@
     ! compression of delta_sst, delta_sal, ds_ns, dt_ns, dter, dser,
     ! dt_ds, tkt, tks, taur, sss on ocean points
-
+    REAL :: missing_val
 !****************************************************************************************
 ! End of declarations
 !****************************************************************************************
+      IF (using_xios) THEN
+        missing_val=missing_val_xios
+      ELSE
+        missing_val=missing_val_netcdf
+      ENDIF
 
       IF (prt_level >=10) print *,' -> pbl_surface, itap ',itap
@@ -977,13 +996,14 @@
  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,11 +1025,13 @@
  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,12 +1070,13 @@
     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
-    ysollw = 0.0  ; yz0m = 0.0 ; yz0h = 0.0    ; yu1 = 0.0    
-    yv1 = 0.0     ; ypaprs = 0.0     ; ypplay = 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     ; 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,4 +1093,5 @@
     ycldt = 0.0      ; yrmu0 = 0.0
     ! Martin
+    y_d_qbs(:,:)=0.0
 
 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
@@ -1366,8 +1390,8 @@
 !   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,4 +1419,5 @@
           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,4 +1431,5 @@
           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,5 +1445,6 @@
 !!! 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,4 +1485,5 @@
              yt(j,k) = t(i,k)
              yq(j,k) = q(i,k)
+             yqbs(j,k)=qbs(i,k)
           ENDDO
         ENDDO
@@ -1570,7 +1598,7 @@
         ENDDO
         CALL cdrag(knon, nsrf, &
-            speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1),&
+            speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1), s_pblh, &
             yts, yqsurf, yz0m, yz0h, yri0, 0, &
-            ycdragm, ycdragh, zri1, pref )
+            ycdragm, ycdragh, zri1, pref, rain_f, zxtsol, ypplay(:,1))
 
 ! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
@@ -1587,5 +1615,5 @@
      ENDIF
 
-        IF (prt_level >=10) print *,'clcdrag -> ycdragh ', ycdragh
+        IF (prt_level >=10) print *,'cdrag -> ycdragh ', ycdragh(1:knon)
        ELSE  !(iflag_split .eq.0)
 
@@ -1604,7 +1632,7 @@
 
             CALL cdrag(knon, nsrf, &
-            speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),&
+            speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),s_pblh_x,&
             yts_x, yqsurf_x, yz0m, yz0h, yri0, 0, &
-            ycdragm_x, ycdragh_x, zri1_x, pref_x )
+            ycdragm_x, ycdragh_x, zri1_x, pref_x, rain_f, zxtsol, ypplay(:,1) )
 
 ! --- special Dice. JYG+MPL 25112013
@@ -1631,9 +1659,10 @@
         ENDDO
         CALL cdrag(knon, nsrf, &
-            speed_w, yt_w(:,1), yq_w(:,1), zgeo1_w, ypaprs(:,1),&
+            speed_w, yt_w(:,1), yq_w(:,1), zgeo1_w, ypaprs(:,1),s_pblh_w,&
             yts_w, yqsurf_w, yz0m, yz0h, yri0, 0, &
-            ycdragm_w, ycdragh_w, zri1_w, pref_w )
-!
-        zgeo1(:) = wake_s(:)*zgeo1_w(:) + (1.-wake_s(:))*zgeo1_x(:)
+            ycdragm_w, ycdragh_w, zri1_w, pref_w, rain_f, zxtsol, ypplay(:,1) )
+!
+!!!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,19 +1690,19 @@
 !!! 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,yq, &
              ypplay,ypaprs,ytke,ycoefm, ycoefh)
 
@@ -1698,5 +1727,5 @@
        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,13 +1734,13 @@
       
       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,5 +1748,5 @@
         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,yq_x, &
              ypplay,ypaprs,ytke_x,ycoefm_x, ycoefh_x)
 
@@ -1742,21 +1771,21 @@
         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,yq_w, &
              ypplay,ypaprs,ytke_w,ycoefm_w, ycoefh_w)
 
@@ -1781,5 +1810,5 @@
 
 
-        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,4 +1909,22 @@
        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,12 +2046,14 @@
 !!!
        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
@@ -2037,5 +2086,5 @@
                yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
                yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
-               yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
+               yt2m, yq2m, yt10m, yq10m, yu10m, yustar, ypblh, rain_f, zxtsol)
           ENDIF
           
@@ -2057,5 +2106,5 @@
                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,5 +2112,5 @@
                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,12 +2155,12 @@
                   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,5 +2196,5 @@
                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,17 +2207,17 @@
                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,6 +2269,6 @@
 
        IF (evap0>=0.) THEN
-          yevap(:)=evap0
-          yevap(:)=RLVTT*evap0
+          yevap(1:knon)=evap0
+          yevap(1:knon)=RLVTT*evap0
        ENDIF
 
@@ -2277,4 +2326,11 @@
           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,5 +2477,5 @@
        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,4 +2639,14 @@
 !
        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,12 +2762,20 @@
 !!!
 
-!      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,9 +2948,19 @@
        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
 
@@ -2988,5 +3072,5 @@
        IF (iflag_split .eq.0) THEN
         IF (iflag_new_t2mq2m==1) THEN
-         CALL stdlevvarn(klon, knon, nsrf, zxli, &
+           CALL stdlevvarn(klon, knon, nsrf, zxli, &
             uzon, vmer, tair1, qair1, zgeo1, &
             tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
@@ -2997,5 +3081,5 @@
             uzon, vmer, tair1, qair1, zgeo1, &
             tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
-            yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
+            yt2m, yq2m, yt10m, yq10m, yu10m, yustar, ypblh, rain_f, zxtsol)
         ENDIF
        ELSE  !(iflag_split .eq.0)
@@ -3015,9 +3099,9 @@
             uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
             tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
-            yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x)
+            yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x, ypblh_x, rain_f, zxtsol)
         CALL stdlevvar(klon, knon, nsrf, zxli, &
             uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
             tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
-            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w)
+            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w, ypblh_w, rain_f, zxtsol)
         ENDIF
 !!!
@@ -3124,5 +3208,5 @@
        IF (prt_level >=10) THEN
          print *, 'T2m, q2m, RH2m ', &
-          t2m, q2m, rh2m
+          t2m(1:knon,:), q2m(1:knon,:), rh2m(1:knon)
        ENDIF
 
@@ -3137,15 +3221,15 @@
             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,15 +3240,15 @@
             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,7 +3279,7 @@
         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,7 +3299,7 @@
         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,7 +3318,7 @@
         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,4 +3411,20 @@
        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
+
 !!!
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phyaqua_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phyaqua_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phyaqua_mod.F90	(revision 4727)
@@ -360,4 +360,5 @@
     ql_ancien   = 0.
     qs_ancien   = 0.
+    qbs_ancien  = 0.
     u_ancien    = 0.
     v_ancien    = 0.
@@ -365,4 +366,5 @@
     prlw_ancien = 0.
     prsw_ancien = 0.  
+    prbsw_ancien= 0.
 
     ale_wake    = 0.
@@ -512,7 +514,5 @@
     USE mod_phys_lmdz_para, ONLY: is_omp_master, klon_mpi
     USE mod_phys_lmdz_transfert_para, ONLY: gather_omp
-#ifdef CPP_XIOS
-    USE xios
-#endif
+    USE lmdz_xios
     IMPLICIT NONE
 
@@ -534,31 +534,31 @@
       ! on the whole physics grid
  
-#ifdef CPP_XIOS
-    PRINT *, 'writelim: Ecriture du fichier limit'
-
-    CALL gather_omp(phy_foce, phy_mpi)
-    IF (is_omp_master) CALL xios_send_field('foce_limout',phy_mpi)
-
-    CALL gather_omp(phy_fsic, phy_mpi)
-    IF (is_omp_master) CALL xios_send_field('fsic_limout',phy_mpi)
+    IF (using_xios) THEN
+      PRINT *, 'writelim: Ecriture du fichier limit'
+
+      CALL gather_omp(phy_foce, phy_mpi)
+      IF (is_omp_master) CALL xios_send_field('foce_limout',phy_mpi)
+
+      CALL gather_omp(phy_fsic, phy_mpi)
+      IF (is_omp_master) CALL xios_send_field('fsic_limout',phy_mpi)
       
-    CALL gather_omp(phy_fter, phy_mpi)
-    IF (is_omp_master) CALL xios_send_field('fter_limout',phy_mpi)
+      CALL gather_omp(phy_fter, phy_mpi)
+      IF (is_omp_master) CALL xios_send_field('fter_limout',phy_mpi)
       
-    CALL gather_omp(phy_flic, phy_mpi)
-    IF (is_omp_master) CALL xios_send_field('flic_limout',phy_mpi)
-
-    CALL gather_omp(phy_sst, phy_mpi)
-    IF (is_omp_master) CALL xios_send_field('sst_limout',phy_mpi)
-
-    CALL gather_omp(phy_bil, phy_mpi)
-    IF (is_omp_master) CALL xios_send_field('bils_limout',phy_mpi)
-
-    CALL gather_omp(phy_alb, phy_mpi)
-    IF (is_omp_master) CALL xios_send_field('alb_limout',phy_mpi)
-
-    CALL gather_omp(phy_rug, phy_mpi)
-    IF (is_omp_master) CALL xios_send_field('rug_limout',phy_mpi)
-#endif
+      CALL gather_omp(phy_flic, phy_mpi)
+      IF (is_omp_master) CALL xios_send_field('flic_limout',phy_mpi)
+
+      CALL gather_omp(phy_sst, phy_mpi)
+      IF (is_omp_master) CALL xios_send_field('sst_limout',phy_mpi)
+
+      CALL gather_omp(phy_bil, phy_mpi)
+      IF (is_omp_master) CALL xios_send_field('bils_limout',phy_mpi)
+
+      CALL gather_omp(phy_alb, phy_mpi)
+      IF (is_omp_master) CALL xios_send_field('alb_limout',phy_mpi)
+
+      CALL gather_omp(phy_rug, phy_mpi)
+      IF (is_omp_master) CALL xios_send_field('rug_limout',phy_mpi)
+    ENDIF
   END SUBROUTINE writelim_unstruct
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phyetat0_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phyetat0_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phyetat0_mod.F90	(revision 4727)
@@ -20,7 +20,7 @@
        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, &
@@ -28,5 +28,5 @@
        zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, u10m, v10m, treedrg, &
        ale_wake, ale_bl_stat, ds_ns, dt_ns, delta_sst, delta_sal, dter, dser, &
-       dt_ds, ratqs_inter
+       dt_ds, ratqs_inter_
 !FC
   USE geometry_mod,     ONLY: longitude_deg, latitude_deg
@@ -39,9 +39,6 @@
   USE ocean_slab_mod,   ONLY: nslay, tslab, seaice, tice, ocean_slab_init
   USE time_phylmdz_mod, ONLY: init_iteration, pdtphys, itau_phy
-#ifdef CPP_XIOS
-  USE wxios, ONLY: missing_val
-#else
-  use netcdf, only: missing_val => nf90_fill_real
-#endif
+  USE wxios, ONLY: missing_val_xios => missing_val, using_xios
+  use netcdf, only: missing_val_netcdf => nf90_fill_real
   use config_ocean_skin_m, only: activate_ocean_skin
 
@@ -92,5 +89,12 @@
   REAL :: lon_startphy(klon), lat_startphy(klon)
   CHARACTER(LEN=maxlen) :: tname, t(2)
-
+  REAL :: missing_val
+
+  IF (using_xios) THEN
+    missing_val=missing_val_xios
+  ELSE
+    missing_val=missing_val_netcdf
+  ENDIF
+  
   ! FH1D
   !     real iolat(jjm+1)
@@ -300,4 +304,9 @@
 
 !===================================================================
+! Lecture dans le cas iflag_pbl_surface =1
+!===================================================================
+
+   if ( iflag_physiq <= 1 ) then
+!===================================================================
   ! Lecture des temperatures du sol profond:
 !===================================================================
@@ -327,5 +336,9 @@
   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,4 +387,6 @@
   ENDIF
 
+  endif ! iflag_physiq <= 1
+
   ! Lecture de l'age de la neige:
   found=phyetat0_srf(agesno,"AGESNO","SNOW AGE",0.001)
@@ -388,4 +403,13 @@
   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,4 +425,11 @@
        (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
 
@@ -464,5 +495,5 @@
 
 ! fisrtilp/Clouds 0.002 could be ratqsbas. But can stay like this as well
-  found=phyetat0_get(ratqs_inter,"RATQS_INTER","Relative width of the lsc sugrid scale water",0.002)
+  found=phyetat0_get(ratqs_inter_,"RATQS_INTER","Relative width of the lsc sugrid scale water",0.002)
 
 !===========================================
@@ -591,5 +622,7 @@
   ! 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
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phyredem.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phyredem.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phyredem.F90	(revision 4727)
@@ -15,9 +15,9 @@
                                 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,    &
@@ -30,5 +30,5 @@
                                 du_gwd_rando, du_gwd_front, u10m, v10m, &
                                 treedrg, solswfdiff, delta_sal, ds_ns, dt_ns, &
-                                delta_sst, ratqs_inter, dter, dser, dt_ds
+                                delta_sst, ratqs_inter_, dter, dser, dt_ds
 
   USE geometry_mod, ONLY : longitude_deg, latitude_deg
@@ -76,5 +76,7 @@
   ! 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
@@ -244,4 +246,10 @@
     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)
 
@@ -326,5 +334,5 @@
 
     ! fisrtilp/clouds
-    CALL put_field(pass,"RATQS_INTER","Relative width of the lsc sugrid scale water",ratqs_inter)
+    CALL put_field(pass,"RATQS_INTER","Relative width of the lsc sugrid scale water",ratqs_inter_)
 
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_local_var_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_local_var_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_local_var_mod.F90	(revision 4727)
@@ -14,4 +14,6 @@
       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,8 +30,8 @@
       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,6 +73,6 @@
       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,4 +82,6 @@
       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(:,:)
@@ -141,26 +145,4 @@
       REAL, SAVE, ALLOCATABLE :: toplwad0_aero(:), sollwad0_aero(:)     ! diag
       !$OMP THREADPRIVATE(toplwad0_aero,sollwad0_aero)
-
-!AI 08 2023 ajout pour Ecrad
-      REAL,ALLOCATABLE,SAVE :: topswad_aero_s2(:), solswad_aero_s2(:)
-!$OMP THREADPRIVATE(topswad_aero_s2, solswad_aero_s2)
-      REAL,ALLOCATABLE,SAVE :: topswai_aero_s2(:), solswai_aero_s2(:)
-!$OMP THREADPRIVATE(topswai_aero_s2, solswai_aero_s2)
-      REAL,ALLOCATABLE,SAVE :: topswad0_aero_s2(:), solswad0_aero_s2(:)
-!$OMP THREADPRIVATE(topswad0_aero_s2, solswad0_aero_s2)
-      REAL,ALLOCATABLE,SAVE :: topsw_aero_s2(:,:), topsw0_aero_s2(:,:)
-!$OMP THREADPRIVATE(topsw_aero_s2, topsw0_aero_s2)
-      REAL,ALLOCATABLE,SAVE :: solsw_aero_s2(:,:), solsw0_aero_s2(:,:)
-!$OMP THREADPRIVATE(solsw_aero_s2, solsw0_aero_s2)
-      REAL,ALLOCATABLE,SAVE :: topswcf_aero_s2(:,:), solswcf_aero_s2(:,:)
-!$OMP THREADPRIVATE(topswcf_aero_s2, solswcf_aero_s2)
-! additional LW variables CK
-      REAL,ALLOCATABLE,SAVE :: toplwad_aero_s2(:), sollwad_aero_s2(:)
-!$OMP THREADPRIVATE(toplwad_aero_s2, sollwad_aero_s2)
-      REAL,ALLOCATABLE,SAVE :: toplwai_aero_s2(:), sollwai_aero_s2(:)
-!$OMP THREADPRIVATE(toplwai_aero_s2, sollwai_aero_s2)
-      REAL,ALLOCATABLE,SAVE :: toplwad0_aero_s2(:), sollwad0_aero_s2(:)
-!$OMP THREADPRIVATE(toplwad0_aero_s2, sollwad0_aero_s2)
-      
 ! Special RRTM
       REAL, SAVE, ALLOCATABLE :: ZLWFT0_i(:,:),  ZSWFT0_i(:,:)      ! diag
@@ -179,30 +161,6 @@
       REAL, SAVE, ALLOCATABLE :: tau3d_aero(:,:,:,:) 
       !$OMP THREADPRIVATE(tau3d_aero) 
-      REAL, SAVE, ALLOCATABLE :: scdnc(:,:)
-      !$OMP THREADPRIVATE(scdnc)
       REAL, SAVE, ALLOCATABLE :: dNovrN(:) 
       !$OMP THREADPRIVATE(dNovrN) 
-      REAL, SAVE, ALLOCATABLE :: cldncl(:)
-      !$OMP THREADPRIVATE(cldncl)
-      REAL, SAVE, ALLOCATABLE :: reffclwtop(:)
-      !$OMP THREADPRIVATE(reffclwtop)
-      REAL, SAVE, ALLOCATABLE :: lcc(:)
-      !$OMP THREADPRIVATE(lcc)
-      REAL, SAVE, ALLOCATABLE :: reffclws(:,:)
-      !$OMP THREADPRIVATE(reffclws)
-      REAL, SAVE, ALLOCATABLE :: reffclwc(:,:)
-      !$OMP THREADPRIVATE(reffclwc)
-      REAL, SAVE, ALLOCATABLE :: cldnvi(:) 
-      !$OMP THREADPRIVATE(cldnvi)
-      REAL, SAVE, ALLOCATABLE :: lcc3d(:,:)
-      !$OMP THREADPRIVATE(lcc3d)
-      REAL, SAVE, ALLOCATABLE :: lcc3dcon(:,:)
-      !$OMP THREADPRIVATE(lcc3dcon)
-      REAL, SAVE, ALLOCATABLE :: lcc3dstra(:,:)
-      !$OMP THREADPRIVATE(lcc3dstra)
-      REAL, SAVE, ALLOCATABLE :: icc3dcon(:,:)
-      !$OMP THREADPRIVATE(icc3dcon)
-      REAL, SAVE, ALLOCATABLE :: icc3dstra(:,:)
-      !$OMP THREADPRIVATE(icc3dstra)
       REAL, SAVE, ALLOCATABLE :: zfice(:,:)
       !$OMP THREADPRIVATE(zfice)
@@ -290,4 +248,25 @@
 !$OMP THREADPRIVATE(toplwad0_aerop, sollwad0_aerop)
 
+!AI 08 2023 ajout pour Ecrad
+      REAL,ALLOCATABLE,SAVE :: topswad_aero_s2(:), solswad_aero_s2(:)
+!$OMP THREADPRIVATE(topswad_aero_s2, solswad_aero_s2)
+      REAL,ALLOCATABLE,SAVE :: topswai_aero_s2(:), solswai_aero_s2(:)
+!$OMP THREADPRIVATE(topswai_aero_s2, solswai_aero_s2)
+      REAL,ALLOCATABLE,SAVE :: topswad0_aero_s2(:), solswad0_aero_s2(:)
+!$OMP THREADPRIVATE(topswad0_aero_s2, solswad0_aero_s2)
+      REAL,ALLOCATABLE,SAVE :: topsw_aero_s2(:,:), topsw0_aero_s2(:,:)
+!$OMP THREADPRIVATE(topsw_aero_s2, topsw0_aero_s2)
+      REAL,ALLOCATABLE,SAVE :: solsw_aero_s2(:,:), solsw0_aero_s2(:,:)
+!$OMP THREADPRIVATE(solsw_aero_s2, solsw0_aero_s2)
+      REAL,ALLOCATABLE,SAVE :: topswcf_aero_s2(:,:), solswcf_aero_s2(:,:)
+!$OMP THREADPRIVATE(topswcf_aero_s2, solswcf_aero_s2)
+! additional LW variables CK
+      REAL,ALLOCATABLE,SAVE :: toplwad_aero_s2(:), sollwad_aero_s2(:)
+!$OMP THREADPRIVATE(toplwad_aero_s2, sollwad_aero_s2)
+      REAL,ALLOCATABLE,SAVE :: toplwai_aero_s2(:), sollwai_aero_s2(:)
+!$OMP THREADPRIVATE(toplwai_aero_s2, sollwai_aero_s2)
+      REAL,ALLOCATABLE,SAVE :: toplwad0_aero_s2(:), sollwad0_aero_s2(:)
+!$OMP THREADPRIVATE(toplwad0_aero_s2, sollwad0_aero_s2)
+
 !Ajout de celles n??cessaires au phys_output_write_mod
       REAL, SAVE, ALLOCATABLE :: tal1(:), pal1(:), pab1(:), pab2(:)
@@ -298,4 +277,8 @@
 !$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
@@ -334,6 +317,6 @@
       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)
@@ -352,4 +335,6 @@
       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)
@@ -473,6 +458,6 @@
       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)
@@ -492,4 +477,6 @@
       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
@@ -545,8 +532,15 @@
       REAL, SAVE, ALLOCATABLE :: fcontrP(:,:)
       !$OMP THREADPRIVATE(fcontrP)
+      REAL, SAVE, ALLOCATABLE :: distcltop(:,:)
+      !$OMP THREADPRIVATE(distcltop)
+      REAL, SAVE, ALLOCATABLE :: temp_cltop(:,:)
+      !$OMP THREADPRIVATE(temp_cltop)
+
 
 #ifdef CPP_StratAer
 !
 ! variables for stratospheric aerosol
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: d_q_emiss
+!$OMP THREADPRIVATE(d_q_emiss)
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: R2SO4
 !$OMP THREADPRIVATE(R2SO4)
@@ -563,4 +557,8 @@
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: SO2_lifetime
 !$OMP THREADPRIVATE(SO2_lifetime)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: H2SO4_lifetime
+!$OMP THREADPRIVATE(H2SO4_lifetime)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: O3_clim
+!$OMP THREADPRIVATE(O3_clim)
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: alpha_bin
 !$OMP THREADPRIVATE(alpha_bin)
@@ -630,5 +628,5 @@
 
 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))
@@ -638,6 +636,6 @@
       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
@@ -662,5 +660,6 @@
       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))
@@ -703,17 +702,5 @@
       ALLOCATE(drytausum_aero(klon,naero_tot))
       ALLOCATE(tau3d_aero(klon,klev,nwave,naero_tot)) 
-      ALLOCATE(scdnc(klon, klev))
       ALLOCATE(dNovrN(klon))
-      ALLOCATE(cldncl(klon))
-      ALLOCATE(reffclwtop(klon))
-      ALLOCATE(lcc(klon))
-      ALLOCATE(reffclws(klon, klev))
-      ALLOCATE(reffclwc(klon, klev))
-      ALLOCATE(cldnvi(klon))
-      ALLOCATE(lcc3d(klon, klev))
-      ALLOCATE(lcc3dcon(klon, klev))
-      ALLOCATE(lcc3dstra(klon, klev))
-      ALLOCATE(icc3dcon(klon, klev))
-      ALLOCATE(icc3dstra(klon, klev))
       ALLOCATE(zfice(klon, klev))
       ALLOCATE(od443aer(klon))
@@ -763,4 +750,9 @@
       ALLOCATE(topswcf_aerop(klon,naero_grp), solswcf_aerop(klon,naero_grp))
 
+! additional LW variables CK
+      ALLOCATE(toplwad_aerop(klon), sollwad_aerop(klon))
+      ALLOCATE(toplwai_aerop(klon), sollwai_aerop(klon))
+      ALLOCATE(toplwad0_aerop(klon), sollwad0_aerop(klon))
+
 !AI Ajout Ecrad (3Deffect)
       ALLOCATE(topswad_aero_s2(klon), solswad_aero_s2(klon))
@@ -775,8 +767,4 @@
       ALLOCATE(toplwad0_aero_s2(klon), sollwad0_aero_s2(klon))
 
-! additional LW variables CK
-      ALLOCATE(toplwad_aerop(klon), sollwad_aerop(klon))
-      ALLOCATE(toplwai_aerop(klon), sollwai_aerop(klon))
-      ALLOCATE(toplwad0_aerop(klon), sollwad0_aerop(klon))
 
 ! FH Ajout de celles necessaires au phys_output_write_mod
@@ -803,6 +791,6 @@
       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))
@@ -819,4 +807,6 @@
       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))
@@ -875,4 +865,6 @@
       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
@@ -895,4 +887,5 @@
       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))
 
@@ -908,4 +901,8 @@
       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))
+      ALLOCATE(temp_cltop(klon,klev))
 
 
@@ -930,4 +927,5 @@
 
 #ifdef CPP_StratAer
+      ALLOCATE (d_q_emiss(klon,klev))
       ALLOCATE (R2SO4(klon,klev))
       ALLOCATE (DENSO4(klon,klev))
@@ -943,4 +941,6 @@
       ALLOCATE (OCS_lifetime(klon,klev))
       ALLOCATE (SO2_lifetime(klon,klev))
+      ALLOCATE (H2SO4_lifetime(klon,klev))
+      ALLOCATE (O3_clim(klon,klev))
       ALLOCATE (alpha_bin(nbands_sw_rrtm+nbands_lw_rrtm+nwave,nbtr))
       ALLOCATE (piz_bin(nbands_sw_rrtm+nbands_lw_rrtm+nwave,nbtr))
@@ -976,5 +976,5 @@
 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)
@@ -983,6 +983,6 @@
       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
@@ -1007,4 +1007,6 @@
       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)
@@ -1029,17 +1031,5 @@
       DEALLOCATE(drytausum_aero) 
       DEALLOCATE(tau3d_aero) 
-      DEALLOCATE(scdnc)
       DEALLOCATE(dNovrN)
-      DEALLOCATE(cldncl)
-      DEALLOCATE(reffclwtop)
-      DEALLOCATE(lcc)
-      DEALLOCATE(reffclws)
-      DEALLOCATE(reffclwc)
-      DEALLOCATE(cldnvi)
-      DEALLOCATE(lcc3d)
-      DEALLOCATE(lcc3dcon)
-      DEALLOCATE(lcc3dstra)
-      DEALLOCATE(icc3dcon)
-      DEALLOCATE(icc3dstra)
       DEALLOCATE(zfice)
       DEALLOCATE(od443aer)
@@ -1090,4 +1080,10 @@
       DEALLOCATE(solsw_aerop, solsw0_aerop)
       DEALLOCATE(topswcf_aerop, solswcf_aerop)
+!AI Aerosols
+      DEALLOCATE(m_allaer)
+!CK LW diagnostics
+      DEALLOCATE(toplwad_aerop, sollwad_aerop)
+      DEALLOCATE(toplwai_aerop, sollwai_aerop)
+      DEALLOCATE(toplwad0_aerop, sollwad0_aerop)
 
 !AI Ajout pour Ecrad (3Deffect)
@@ -1101,12 +1097,5 @@
       DEALLOCATE(toplwad_aero_s2, sollwad_aero_s2)
       DEALLOCATE(toplwai_aero_s2, sollwai_aero_s2)
-      DEALLOCATE(toplwad0_aero_s2, sollwad0_aero_s2)
-      
-!AI Aerosols
-      DEALLOCATE(m_allaer)
-!CK LW diagnostics
-      DEALLOCATE(toplwad_aerop, sollwad_aerop)
-      DEALLOCATE(toplwai_aerop, sollwai_aerop)
-      DEALLOCATE(toplwad0_aerop, sollwad0_aerop)
+      DEALLOCATE(toplwad0_aero_s2, sollwad0_aero_s2)      
 
 ! FH Ajout de celles necessaires au phys_output_write_mod
@@ -1130,6 +1119,6 @@
       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)
 !
@@ -1144,4 +1133,5 @@
       DEALLOCATE(zxfqcalving, zxfluxlat)
       DEALLOCATE(zxrunofflic)
+      DEALLOCATE(zxustartlic, zxrhoslic)
       DEALLOCATE(zxtsol, snow_lsc, zxfqfonte, zxqsurf)
       DEALLOCATE(rain_lsc)
@@ -1176,4 +1166,6 @@
       DEALLOCATE(alp_bl_stat, n2, s2)
       DEALLOCATE(proba_notrig, random_notrig)
+!FC
+      DEALLOCATE(zxfluxq,zxfluxt)
 
       DEALLOCATE(dnwd0)
@@ -1212,5 +1204,5 @@
 
 
-      DEALLOCATE(prfl, psfl, fraca, Vprecip)
+      DEALLOCATE(prfl, psfl, bsfl, fraca, Vprecip)
       DEALLOCATE(zw2)
 
@@ -1225,6 +1217,8 @@
       DEALLOCATE(beta_prec)
       DEALLOCATE(rneb)
+      DEALLOCATE(pfraclr,pfracld)
       DEALLOCATE (zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic)
-
+      DEALLOCATE(distcltop)
+      DEALLOCATE(temp_cltop)
       DEALLOCATE (p_tropopause)
       DEALLOCATE (z_tropopause)
@@ -1244,4 +1238,5 @@
 #ifdef CPP_StratAer
 ! variables for strat. aerosol CK
+      DEALLOCATE (d_q_emiss)
       DEALLOCATE (R2SO4)
       DEALLOCATE (DENSO4)
@@ -1251,4 +1246,6 @@
       DEALLOCATE (SO2_lifetime)
       DEALLOCATE (OCS_lifetime)
+      DEALLOCATE (H2SO4_lifetime)
+      DEALLOCATE (O3_clim)
       DEALLOCATE (alpha_bin)
       DEALLOCATE (piz_bin)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_ctrlout_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_ctrlout_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_ctrlout_mod.F90	(revision 4727)
@@ -378,7 +378,14 @@
   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) /))
@@ -604,4 +611,5 @@
 #endif
 
+
   TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_taux_srf = (/           &
       ctrl_out((/ 1, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'taux_ter',             &
@@ -817,4 +825,6 @@
   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) /))
@@ -1506,4 +1516,6 @@
   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) /))
@@ -1536,4 +1548,8 @@
   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) /))
@@ -1568,4 +1584,8 @@
   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) /))
@@ -1576,4 +1596,6 @@
   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) /))
@@ -1604,4 +1626,9 @@
   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) /))
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -1673,4 +1700,8 @@
   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) /))
@@ -1747,4 +1778,12 @@
   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
@@ -2101,5 +2140,5 @@
 
 #ifdef CPP_Dust
-#include "Dust/spla_output_dat.h"
+      INCLUDE 'spla_output_dat.h'
 #endif
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_mod.F90	(revision 4727)
@@ -47,8 +47,6 @@
     USE vertical_layers_mod, ONLY: ap,bp,preff,presnivs, aps, bps, pseudoalt, presinter
     USE time_phylmdz_mod, ONLY: day_ini, itau_phy, start_time, annee_ref, day_ref
-#ifdef CPP_XIOS
     ! ug Pour les sorties XIOS
     USE wxios
-#endif
 
     IMPLICIT NONE
@@ -129,5 +127,4 @@
     REAL, DIMENSION(klev+1)   :: lev_index
                 
-#ifdef CPP_XIOS
     ! ug Variables utilis\'ees pour r\'ecup\'erer le calendrier pour xios
     INTEGER :: x_an, x_mois, x_jour
@@ -135,5 +132,5 @@
     INTEGER :: ini_an, ini_mois, ini_jour
     REAL :: ini_heure
-#endif
+
     INTEGER                         :: ISW
     REAL, DIMENSION(NSW)            :: wl1_sun, wl2_sun !wavelength bounds (in um) for SW
@@ -290,12 +287,12 @@
      ENDIF
 
-#ifdef CPP_XIOS
-    ! ug R\'eglage du calendrier xios
-    !Temps julian => an, mois, jour, heure
-    CALL ju2ymds(zjulian, x_an, x_mois, x_jour, x_heure)
-    CALL ju2ymds(zjulian_start, ini_an, ini_mois, ini_jour, ini_heure)
-    CALL wxios_set_cal(dtime, calend, x_an, x_mois, x_jour, x_heure, ini_an, &
-                       ini_mois, ini_jour, ini_heure )
-#endif
+    IF (using_xios) THEN
+      ! ug R\'eglage du calendrier xios
+      !Temps julian => an, mois, jour, heure
+      CALL ju2ymds(zjulian, x_an, x_mois, x_jour, x_heure)
+      CALL ju2ymds(zjulian_start, ini_an, ini_mois, ini_jour, ini_heure)
+      CALL wxios_set_cal(dtime, calend, x_an, x_mois, x_jour, x_heure, ini_an, &
+                         ini_mois, ini_jour, ini_heure )
+    ENDIF
 
 !!!!!!!!!!!!!!!!!!!!!!! Boucle sur les fichiers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -330,64 +327,64 @@
 
 
-#ifdef CPP_XIOS
-!!! Ouverture de chaque fichier XIOS !!!!!!!!!!!
-    IF (.not. ok_all_xml) THEN
+    IF (using_xios) THEN 
+      !!! Ouverture de chaque fichier XIOS !!!!!!!!!!!
+      IF (.not. ok_all_xml) THEN
+        IF (prt_level >= 10) THEN
+         print*,'phys_output_open: call wxios_add_file with phys_out_filenames(iff)=',trim(phys_out_filenames(iff))    
+        ENDIF
+        CALL wxios_add_file(phys_out_filenames(iff),chtimestep(iff),lev_files(iff))  
+      ENDIF
+
+      !!! Declaration des axes verticaux de chaque fichier:
       IF (prt_level >= 10) THEN
-        print*,'phys_output_open: call wxios_add_file with phys_out_filenames(iff)=',trim(phys_out_filenames(iff))    
+        print*,'phys_output_open: Declare vertical axes for each file'
       ENDIF
-      CALL wxios_add_file(phys_out_filenames(iff),chtimestep(iff),lev_files(iff))  
-    ENDIF
-
-!!! Declaration des axes verticaux de chaque fichier:
-    IF (prt_level >= 10) THEN
-      print*,'phys_output_open: Declare vertical axes for each file'
-    ENDIF
-
-   IF (iff.LE.6.OR.iff.EQ.10) THEN
-    CALL wxios_add_vaxis("presnivs", &
-            levmax(iff) - levmin(iff) + 1, presnivs(levmin(iff):levmax(iff)))
-    CALL wxios_add_vaxis("presinter", &
-            klev + 1, presinter(1:klev+1))
-    CALL wxios_add_vaxis("Ahyb", &
-            levmax(iff) - levmin(iff) + 1, aps(levmin(iff):levmax(iff)), positif='down', &
-            bnds=Ahyb_bounds(levmin(iff):levmax(iff),:))
-    CALL wxios_add_vaxis("Bhyb", &
-            levmax(iff) - levmin(iff) + 1, bps(levmin(iff):levmax(iff)), positif='down', &
-            bnds=Bhyb_bounds(levmin(iff):levmax(iff),:))
-    CALL wxios_add_vaxis("klev", levmax(iff) - levmin(iff) + 1, &
-                          lev_index(levmin(iff):levmax(iff)))
-    CALL wxios_add_vaxis("klevp1", klev+1, &
-                          lev_index(1:klev+1))
-    CALL wxios_add_vaxis("bnds", 2, (/1.,2./))
-
-    CALL wxios_add_vaxis("Alt", &
-            levmax(iff) - levmin(iff) + 1, pseudoalt)
-
-    ! wl1_sun/wl2_sun: minimum/maximum bound of wavelength (in um)
-    SELECT CASE(NSW)
-      CASE(6)
-        wl1_sun(1:6) = [0.180, 0.250, 0.440, 0.690, 1.190, 2.380]
-        wl2_sun(1:6) = [0.250, 0.440, 0.690, 1.190, 2.380, 4.000]
-      CASE(2)
-        wl1_sun(1:2) = [0.250, 0.690]
-        wl2_sun(1:2) = [0.690, 4.000]
-    END SELECT
-
-    DO ISW=1, NSW
-     wn1_sun(ISW)=1.e+6/wl1_sun(ISW) 
-     wn2_sun(ISW)=1.e+6/wl2_sun(ISW) 
-     spbnds_sun(ISW,1)=wn2_sun(ISW)
-     spbnds_sun(ISW,2)=wn1_sun(ISW)
-     spectband(ISW)=(wn1_sun(ISW)+wn2_sun(ISW))/2
-    ENDDO
+
+      IF (iff.LE.6.OR.iff.EQ.10) THEN
+        CALL wxios_add_vaxis("presnivs", &
+              levmax(iff) - levmin(iff) + 1, presnivs(levmin(iff):levmax(iff)))
+        CALL wxios_add_vaxis("presinter", &
+              klev + 1, presinter(1:klev+1))
+        CALL wxios_add_vaxis("Ahyb", &
+              levmax(iff) - levmin(iff) + 1, aps(levmin(iff):levmax(iff)), positif='down', &
+              bnds=Ahyb_bounds(levmin(iff):levmax(iff),:))
+        CALL wxios_add_vaxis("Bhyb", &
+              levmax(iff) - levmin(iff) + 1, bps(levmin(iff):levmax(iff)), positif='down', &
+              bnds=Bhyb_bounds(levmin(iff):levmax(iff),:))
+        CALL wxios_add_vaxis("klev", levmax(iff) - levmin(iff) + 1, &
+                              lev_index(levmin(iff):levmax(iff)))
+        CALL wxios_add_vaxis("klevp1", klev+1, &
+                              lev_index(1:klev+1))
+        CALL wxios_add_vaxis("bnds", 2, (/1.,2./))
+  
+        CALL wxios_add_vaxis("Alt", &
+                levmax(iff) - levmin(iff) + 1, pseudoalt)
+
+        ! wl1_sun/wl2_sun: minimum/maximum bound of wavelength (in um)
+        SELECT CASE(NSW)
+          CASE(6)
+            wl1_sun(1:6) = [0.180, 0.250, 0.440, 0.690, 1.190, 2.380]
+            wl2_sun(1:6) = [0.250, 0.440, 0.690, 1.190, 2.380, 4.000]
+          CASE(2)
+            wl1_sun(1:2) = [0.250, 0.690]
+            wl2_sun(1:2) = [0.690, 4.000]
+        END SELECT
+
+        DO ISW=1, NSW
+          wn1_sun(ISW)=1.e+6/wl1_sun(ISW) 
+          wn2_sun(ISW)=1.e+6/wl2_sun(ISW) 
+          spbnds_sun(ISW,1)=wn2_sun(ISW)
+          spbnds_sun(ISW,2)=wn1_sun(ISW)
+          spectband(ISW)=(wn1_sun(ISW)+wn2_sun(ISW))/2
+        ENDDO
 !
 !!! ajout axe vertical spectband : solar band number
-    CALL wxios_add_vaxis("spectband", NSW, spectband, positif='down')
-   ELSE
-    ! NMC files
-    CALL wxios_add_vaxis("plev", &
-            levmax(iff) - levmin(iff) + 1, rlevSTD(levmin(iff):levmax(iff)))
-   ENDIF
-#endif 
+        CALL wxios_add_vaxis("spectband", NSW, spectband, positif='down')
+      ELSE
+        ! NMC files
+        CALL wxios_add_vaxis("plev", &
+                levmax(iff) - levmin(iff) + 1, rlevSTD(levmin(iff):levmax(iff)))
+      ENDIF
+    ENDIF !using_xios 
 
         IF (clef_files(iff)) THEN
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_var_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_var_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_var_mod.F90	(revision 4727)
@@ -30,5 +30,6 @@
   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,8 +37,9 @@
   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 
@@ -65,5 +67,31 @@
   !$OMP THREADPRIVATE(map_emis_Cb,map_pcld_Cb,map_tcld_Cb,map_emis_ThCi)
   REAL, SAVE, ALLOCATABLE :: map_emis_Anv(:),map_pcld_Anv(:),map_tcld_Anv(:)
-  !$OMP THREADPRIVATE(map_pcld_ThCi,map_tcld_ThCi,map_emis_Anv,map_pcld_Anv,map_tcld_Anv)              
+  !$OMP THREADPRIVATE(map_pcld_ThCi,map_tcld_ThCi,map_emis_Anv,map_pcld_Anv,map_tcld_Anv)
+
+  ! variables deplacees de phys_local_var_mod
+  REAL, SAVE, ALLOCATABLE :: scdnc(:,:)
+  !$OMP THREADPRIVATE(scdnc)
+  REAL, SAVE, ALLOCATABLE :: cldncl(:)
+  !$OMP THREADPRIVATE(cldncl)
+  REAL, SAVE, ALLOCATABLE :: reffclwtop(:)
+  !$OMP THREADPRIVATE(reffclwtop)
+  REAL, SAVE, ALLOCATABLE :: lcc(:)
+  !$OMP THREADPRIVATE(lcc)
+  REAL, SAVE, ALLOCATABLE :: reffclws(:,:)
+  !$OMP THREADPRIVATE(reffclws)
+  REAL, SAVE, ALLOCATABLE :: reffclwc(:,:)
+  !$OMP THREADPRIVATE(reffclwc)
+  REAL, SAVE, ALLOCATABLE :: cldnvi(:) 
+  !$OMP THREADPRIVATE(cldnvi)
+  REAL, SAVE, ALLOCATABLE :: lcc3d(:,:)
+  !$OMP THREADPRIVATE(lcc3d)
+  REAL, SAVE, ALLOCATABLE :: lcc3dcon(:,:)
+  !$OMP THREADPRIVATE(lcc3dcon)
+  REAL, SAVE, ALLOCATABLE :: lcc3dstra(:,:)
+  !$OMP THREADPRIVATE(lcc3dstra)
+  REAL, SAVE, ALLOCATABLE :: icc3dcon(:,:)
+  !$OMP THREADPRIVATE(icc3dcon)
+  REAL, SAVE, ALLOCATABLE :: icc3dstra(:,:)
+  !$OMP THREADPRIVATE(icc3dstra)  
    
 
@@ -173,8 +201,8 @@
 
     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
@@ -211,4 +239,18 @@
          sss(klon))
 
+! Sorties de lmdz_cloud_optics_pro
+    ALLOCATE(scdnc(klon, klev))
+    ALLOCATE(cldncl(klon))
+    ALLOCATE(reffclwtop(klon))
+    ALLOCATE(lcc(klon))
+    ALLOCATE(reffclws(klon, klev))
+    ALLOCATE(reffclwc(klon, klev))
+    ALLOCATE(cldnvi(klon))
+    ALLOCATE(lcc3d(klon, klev))
+    ALLOCATE(lcc3dcon(klon, klev))
+    ALLOCATE(lcc3dstra(klon, klev))
+    ALLOCATE(icc3dcon(klon, klev))
+    ALLOCATE(icc3dstra(klon, klev))
+
   END SUBROUTINE phys_output_var_init
 
@@ -223,6 +265,6 @@
     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
@@ -249,4 +291,17 @@
   !   endif
 
+    DEALLOCATE(scdnc)
+    DEALLOCATE(cldncl)
+    DEALLOCATE(reffclwtop)
+    DEALLOCATE(lcc)
+    DEALLOCATE(reffclws)
+    DEALLOCATE(reffclwc)
+    DEALLOCATE(cldnvi)
+    DEALLOCATE(lcc3d)
+    DEALLOCATE(lcc3dcon)
+    DEALLOCATE(lcc3dstra)
+    DEALLOCATE(icc3dcon)
+    DEALLOCATE(icc3dstra)
+
   END SUBROUTINE phys_output_var_end
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_write_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_write_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_output_write_mod.F90	(revision 4727)
@@ -17,7 +17,7 @@
   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)
+       d_u, d_t, qx, d_qx, zmasse, flag_aerosol, flag_aerosol_strat, ok_cdnc, t, u1, v1)
 
     ! This subroutine does the actual writing of diagnostics that were
@@ -31,4 +31,5 @@
     USE time_phylmdz_mod, ONLY: day_step_phy, start_time, itau_phy
     USE vertical_layers_mod, ONLY : ap, bp, aps, bps
+    USE phystokenc_mod, ONLY: offline
     USE phys_output_ctrlout_mod, ONLY: o_phis, o_aire, is_ter, is_lic, is_oce, &
          o_longitude, o_latitude, &
@@ -47,5 +48,6 @@
          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,5 +83,5 @@
          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,5 +108,5 @@
          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,14 +136,15 @@
          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,4 +154,5 @@
          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,4 +208,5 @@
          o_dxtajs,o_dxtvdf,o_dxtthe, o_dxtch4, &
          o_dxtprod_nucl,o_dxtcosmo,o_dxtdecroiss, &
+         o_xtevap_srf, &
 #endif
 ! Tropopause
@@ -219,5 +224,13 @@
          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_ECRAD
+    USE phys_output_ctrlout_mod, ONLY:  &
+         o_soll0_s2,o_soll_s2,o_sols0_s2,o_sols_s2, &
+         o_topl0_s2,o_topl_s2,o_tops0_s2,o_tops_s2   
+#endif
 
 #ifdef CPP_StratAer
@@ -236,10 +249,4 @@
 #endif
 
-#ifdef CPP_ECRAD
-    USE phys_output_ctrlout_mod, ONLY:  &
-         o_soll0_s2,o_soll_s2,o_sols0_s2,o_sols_s2, &
-         o_topl0_s2,o_topl_s2,o_tops0_s2,o_tops_s2
-#endif
-
     USE ice_sursat_mod, ONLY: flight_m, flight_h2o
     
@@ -247,7 +254,7 @@
     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, &
@@ -275,8 +282,8 @@
          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
-
+         
 ! AI 08 2023 pour ECRAD 3Deffect
 #ifdef CPP_ECRAD
@@ -286,6 +293,8 @@
 #endif
 
+
     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, &
@@ -301,5 +310,5 @@
          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, &
@@ -321,5 +330,5 @@
          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, &
@@ -333,13 +342,13 @@
          toplwad_aero, toplwad0_aero, sollwad_aero, &
          sollwad0_aero, toplwai_aero, sollwai_aero, &
-         scdnc, cldncl, reffclws, reffclwc, cldnvi, stratomask,&
-         lcc, lcc3d, lcc3dcon, lcc3dstra, &
-         icc3dcon, icc3dstra, zfice, reffclwtop, &
+         stratomask,&
+         zfice, &
          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, &
@@ -349,4 +358,5 @@
          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, &
@@ -363,5 +373,11 @@
 #endif
          ep, epmax_diag, &  ! epmax_cape
-         p_tropopause, t_tropopause, z_tropopause
+         p_tropopause, t_tropopause, z_tropopause, &
+         zxfluxt,zxfluxq, &
+! offline 
+         da, mp, phi, wght_cvfd
+    USE phys_output_var_mod, ONLY: scdnc, cldncl, reffclwtop, lcc, reffclws, &
+         reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra
+    
 
 #ifdef CPP_StratAer 
@@ -419,11 +435,7 @@
     USE netcdf, ONLY: nf90_fill_real
     USE print_control_mod, ONLY: prt_level,lunout
-
-
-#ifdef CPP_XIOS
     ! ug Pour les sorties XIOS
-    USE xios
-    USE wxios, ONLY: wxios_closedef, missing_val, wxios_set_context
-#endif
+    USE lmdz_xios
+    USE wxios, ONLY: wxios_closedef, missing_val_xios=>missing_val, wxios_set_context
     USE phys_cal_mod, ONLY : mth_len
 
@@ -444,5 +456,5 @@
 
     ! 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
@@ -460,4 +472,7 @@
     INTEGER :: flag_aerosol 
     LOGICAL :: ok_cdnc
+    REAL, DIMENSION(klon,klev) :: t   ! output for phystoken - offline flux 
+    REAL, DIMENSION(klon) :: u1, v1   ! output for phystoken - offline flux
+    
     REAL, DIMENSION(3) :: freq_moyNMC
 
@@ -480,16 +495,13 @@
 !$OMP THREADPRIVATE(kmax_100m)
     REAL :: x
-#ifndef CPP_XIOS
     REAL :: missing_val
-#endif
     REAL, PARAMETER :: un_jour=86400.
+    CHARACTER(len=12) :: nvar    
     INTEGER :: ISW, itr, ixt, it
     CHARACTER*1 ch1
     CHARACTER(LEN=maxlen) :: varname, dn
-
-#ifdef CPP_XIOS
-    TYPE(xios_fieldgroup) :: group_handle
-    TYPE(xios_field) :: child
-#endif
+    REAL, DIMENSION(klon,klev) :: coefh_stok 
+    
+    
 #ifdef CPP_StratAer 
     LOGICAL, PARAMETER :: debug_strataer=.FALSE.
@@ -510,11 +522,11 @@
  !   ENDIF
 
-#ifdef CPP_XIOS
-    CALL wxios_set_context
-#endif
-
-#ifndef CPP_XIOS
-    missing_val=missing_val_nf90
-#endif
+    IF (using_xios) CALL wxios_set_context
+
+    IF (using_xios) THEN
+      missing_val=missing_val_xios
+    ELSE
+      missing_val=missing_val_nf90
+    ENDIF
 
     IF (.NOT.vars_defined) THEN
@@ -547,99 +559,21 @@
     END DO
 
-#ifdef CPP_XIOS
-#ifdef CPP_StratAer
-!$OMP MASTER
-   IF (.NOT.vars_defined) THEN
-          !On ajoute les variables 3D traceurs par l interface fortran 
-          CALL xios_get_handle("fields_strataer_trac_3D", group_handle)
-          ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
-          DO iq = 1, nqtot
-            IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
-            dn = 'd'//TRIM(tracers(iq)%name)//'_'
-            WRITE (lunout,*) 'XIOS var=', nqo, iq, nqtot, tracers(iq)%name
-
-            unt = "kg kg-1"
-            varname=trim(tracers(iq)%name)
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-
-            unt = "kg kg-1 s-1"
-            varname=TRIM(dn)//'vdf'
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-            varname=TRIM(dn)//'the'
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-            varname=TRIM(dn)//'con'
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-            varname=TRIM(dn)//'lessi_impa'
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-            varname=TRIM(dn)//'lessi_nucl'
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-            varname=TRIM(dn)//'insc'
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-            varname=TRIM(dn)//'bcscav'
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-            varname=TRIM(dn)//'evapls'
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-            varname=TRIM(dn)//'ls'
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-            varname=TRIM(dn)//'trsp'
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-            varname=TRIM(dn)//'sscav'
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-            varname=TRIM(dn)//'sat'
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-            varname=TRIM(dn)//'uscav'
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-          END DO
-          !On ajoute les variables 2D traceurs par l interface fortran 
-          CALL xios_get_handle("fields_strataer_trac_2D", group_handle)
-          ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
-          DO iq = 1, nqtot
-            IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
-
-            unt = "kg m-2"
-            varname='cum'//trim(tracers(iq)%name)
-            WRITE (lunout,*) 'XIOS var=', iq, nqtot, varname
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-
-            unt = "kg m-2 s-1"
-            varname='cumd'//trim(tracers(iq)%name)//'_dry'
-            CALL xios_add_child(group_handle, child, varname)
-            CALL xios_set_attr(child, name=varname, unit=unt)
-          ENDDO
-    ENDIF
-!$OMP END MASTER
-#endif
-#endif
 
     ! ug la boucle qui suit ne sert qu'une fois, pour l'initialisation, sinon il n'y a toujours qu'un seul passage:
     DO iinit=1, iinitend
 !      print *,'IFF iinit=', iinit, iinitend 
-#ifdef CPP_XIOS
-       !$OMP MASTER
-       IF (vars_defined) THEN
-          IF (prt_level >= 10) then
-             write(lunout,*)"phys_output_write: call xios_update_calendar, itau_w=",itau_w
-          ENDIF
-!          CALL xios_update_calendar(itau_w)
-          CALL xios_update_calendar(itap)
-       ENDIF
-       !$OMP END MASTER
-       !$OMP BARRIER
-#endif
+       IF (using_xios) THEN
+         !$OMP MASTER
+         IF (vars_defined) THEN
+            IF (prt_level >= 10) then
+               write(lunout,*)"phys_output_write: call xios_update_calendar, itau_w=",itau_w
+            ENDIF
+!            CALL xios_update_calendar(itau_w)
+            CALL xios_update_calendar(itap)
+         ENDIF
+         !$OMP END MASTER
+         !$OMP BARRIER
+       ENDIF
+
        ! On procède à l'écriture ou à la définition des nombreuses variables:
 !!! Champs 1D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -664,38 +598,39 @@
        CALL histwrite_phy(o_contfracOR, pctsrf(:,is_ter))
 !
-#ifdef CPP_XIOS
-       CALL histwrite_phy("R_ecc",R_ecc)
-       CALL histwrite_phy("R_peri",R_peri)
-       CALL histwrite_phy("R_incl",R_incl)
-       CALL histwrite_phy("solaire",solaire)
-       CALL histwrite_phy(o_Ahyb, ap)
-       CALL histwrite_phy(o_Bhyb, bp)
-       CALL histwrite_phy(o_Ahyb_bounds, Ahyb_bounds)
-       CALL histwrite_phy(o_Bhyb_bounds, Bhyb_bounds)
-       CALL histwrite_phy(o_Ahyb_mid, aps)
-       CALL histwrite_phy(o_Bhyb_mid, bps)
-       CALL histwrite_phy(o_Ahyb_mid_bounds, Ahyb_mid_bounds)
-       CALL histwrite_phy(o_Bhyb_mid_bounds, Bhyb_mid_bounds)
-       CALL histwrite_phy(o_longitude, longitude_deg)
-       CALL histwrite_phy(o_latitude, latitude_deg)
+       IF (using_xios) THEN
+
+         CALL histwrite_phy("R_ecc",R_ecc)
+         CALL histwrite_phy("R_peri",R_peri)
+         CALL histwrite_phy("R_incl",R_incl)
+         CALL histwrite_phy("solaire",solaire)
+         CALL histwrite_phy(o_Ahyb, ap)
+         CALL histwrite_phy(o_Bhyb, bp)
+         CALL histwrite_phy(o_Ahyb_bounds, Ahyb_bounds)
+         CALL histwrite_phy(o_Bhyb_bounds, Bhyb_bounds)
+         CALL histwrite_phy(o_Ahyb_mid, aps)
+         CALL histwrite_phy(o_Bhyb_mid, bps)
+         CALL histwrite_phy(o_Ahyb_mid_bounds, Ahyb_mid_bounds)
+         CALL histwrite_phy(o_Bhyb_mid_bounds, Bhyb_mid_bounds)
+         CALL histwrite_phy(o_longitude, longitude_deg)
+         CALL histwrite_phy(o_latitude, latitude_deg)
 !
 #ifdef CPP_RRTM
-      IF (iflag_rrtm.EQ.1) THEN
-        DO ISW=1, NSW
-          WRITE(ch1,'(i1)') ISW
-!         zx_tmp_0d=RSUN(ISW)
-!         CALL histwrite_phy("rsun"//ch1,zx_tmp_0d)
-          CALL histwrite_phy("rsun"//ch1,RSUN(ISW))
-        ENDDO
-      ENDIF
+        IF (iflag_rrtm.EQ.1) THEN
+          DO ISW=1, NSW
+            WRITE(ch1,'(i1)') ISW
+  !         zx_tmp_0d=RSUN(ISW)
+  !         CALL histwrite_phy("rsun"//ch1,zx_tmp_0d)
+            CALL histwrite_phy("rsun"//ch1,RSUN(ISW))
+          ENDDO
+        ENDIF
 #endif
 !
-       CALL histwrite_phy("co2_ppm",co2_ppm)
-       CALL histwrite_phy("CH4_ppb",CH4_ppb)
-       CALL histwrite_phy("N2O_ppb",N2O_ppb)
-       CALL histwrite_phy("CFC11_ppt",CFC11_ppt)
-       CALL histwrite_phy("CFC12_ppt",CFC12_ppt)
+        CALL histwrite_phy("co2_ppm",co2_ppm)
+        CALL histwrite_phy("CH4_ppb",CH4_ppb)
+        CALL histwrite_phy("N2O_ppb",N2O_ppb)
+        CALL histwrite_phy("CFC11_ppt",CFC11_ppt)
+        CALL histwrite_phy("CFC12_ppt",CFC12_ppt)
 !
-#endif
+      ENDIF !using_xios
 
 !!! Champs 2D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -900,12 +835,18 @@
 
        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:
@@ -933,4 +874,11 @@
        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
          zx_tmp_fi2d = topsw*swradcorr
@@ -946,4 +894,41 @@
        CALL histwrite_phy(o_topl0, toplw0)
 
+! offline 
+       IF (using_xios) THEN
+         IF (offline) THEN
+
+            coefh_stok(:,1)      = cdragh(:)
+            coefh_stok(:,2:klev) = coefh(:,2:klev, is_ave)
+          
+            CALL histwrite_phy('upwd_stok', upwd)
+            CALL histwrite_phy('t_stok', t)
+            CALL histwrite_phy('fm_th_stok', fm_therm(:,1:klev))
+            CALL histwrite_phy('en_th_stok', entr_therm)
+            CALL histwrite_phy('da_stok',da )
+            CALL histwrite_phy('mp_stok',mp )
+            CALL histwrite_phy('dnwd_stok', dnwd)
+            CALL histwrite_phy('wght_stok', wght_cvfd)
+            CALL histwrite_phy('coefh_stok', coefh_stok)
+            CALL histwrite_phy('yu1_stok', u1) 
+            CALL histwrite_phy('yv1_stok', v1)
+
+            DO k=1,klev
+               IF (k<10) THEN
+                  WRITE(nvar,'(i1)') k
+               ELSE IF (k<100) THEN
+                  WRITE(nvar,'(i2)') k
+               ELSE
+                  WRITE(nvar,'(i3)') k
+               END IF
+               nvar='phi_lev'//trim(nvar)
+               CALL histwrite_phy(nvar,phi(:,:,k))
+            END DO
+          
+         ENDIF
+       ENDIF
+
+
+
+       
        IF (vars_defined) THEN
           zx_tmp_fi2d(:) = swup(:,klevp1)*swradcorr(:)
@@ -1146,15 +1131,4 @@
        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
@@ -1322,4 +1296,7 @@
        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)
@@ -1353,54 +1330,56 @@
 
 #ifdef CPP_IOIPSL
-#ifndef CPP_XIOS
-  IF (.NOT.ok_all_xml) THEN
-       ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX:
-       ! Champs interpolles sur des niveaux de pression
-       DO iff=1, nfiles
-          ll=0
-          DO k=1, nlevSTD
-             bb2=clevSTD(k) 
-             IF (bb2.EQ."850".OR.bb2.EQ."700".OR. &
+       IF (.NOT. using_xios) THEN
+         IF (.NOT.ok_all_xml) THEN
+           ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX:
+           ! Champs interpolles sur des niveaux de pression
+            DO iff=1, nfiles
+              ll=0
+              DO k=1, nlevSTD
+                bb2=clevSTD(k) 
+                  IF (bb2.EQ."850".OR.bb2.EQ."700".OR. &
+                       bb2.EQ."500".OR.bb2.EQ."200".OR. &
+                       bb2.EQ."100".OR. &
+                       bb2.EQ."50".OR.bb2.EQ."10") THEN
+
+                      ! a refaire correctement !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+                      ll=ll+1
+                      CALL histwrite_phy(o_uSTDlevs(ll),uwriteSTD(:,k,iff), iff)
+                      CALL histwrite_phy(o_vSTDlevs(ll),vwriteSTD(:,k,iff), iff)
+                      CALL histwrite_phy(o_wSTDlevs(ll),wwriteSTD(:,k,iff), iff)
+                      CALL histwrite_phy(o_zSTDlevs(ll),phiwriteSTD(:,k,iff), iff)
+                      CALL histwrite_phy(o_qSTDlevs(ll),qwriteSTD(:,k,iff), iff)
+                      CALL histwrite_phy(o_tSTDlevs(ll),twriteSTD(:,k,iff), iff)
+
+                  ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR.
+              ENDDO
+            ENDDO
+         ENDIF
+       ENDIF
+#endif
+
+       IF (using_xios) THEN
+         IF (ok_all_xml) THEN
+           !XIOS  CALL xios_get_field_attr("u850",default_value=missing_val)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+            ll=0
+            DO k=1, nlevSTD
+              bb2=clevSTD(k) 
+              IF (bb2.EQ."850".OR.bb2.EQ."700".OR. &
                   bb2.EQ."500".OR.bb2.EQ."200".OR. &
                   bb2.EQ."100".OR. &
                   bb2.EQ."50".OR.bb2.EQ."10") THEN
-
-                ! a refaire correctement !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-                ll=ll+1
-                CALL histwrite_phy(o_uSTDlevs(ll),uwriteSTD(:,k,iff), iff)
-                CALL histwrite_phy(o_vSTDlevs(ll),vwriteSTD(:,k,iff), iff)
-                CALL histwrite_phy(o_wSTDlevs(ll),wwriteSTD(:,k,iff), iff)
-                CALL histwrite_phy(o_zSTDlevs(ll),phiwriteSTD(:,k,iff), iff)
-                CALL histwrite_phy(o_qSTDlevs(ll),qwriteSTD(:,k,iff), iff)
-                CALL histwrite_phy(o_tSTDlevs(ll),twriteSTD(:,k,iff), iff)
-
-             ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR.
-          ENDDO
-       ENDDO
-  ENDIF
-#endif
-#endif
-#ifdef CPP_XIOS
-  IF (ok_all_xml) THEN
-!XIOS  CALL xios_get_field_attr("u850",default_value=missing_val)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-          ll=0
-          DO k=1, nlevSTD
-             bb2=clevSTD(k) 
-             IF (bb2.EQ."850".OR.bb2.EQ."700".OR. &
-                bb2.EQ."500".OR.bb2.EQ."200".OR. &
-                bb2.EQ."100".OR. &
-                bb2.EQ."50".OR.bb2.EQ."10") THEN
-                ll=ll+1
-                CALL histwrite_phy(o_uSTDlevs(ll),ulevSTD(:,k))
-                CALL histwrite_phy(o_vSTDlevs(ll),vlevSTD(:,k))
-                CALL histwrite_phy(o_wSTDlevs(ll),wlevSTD(:,k))
-                CALL histwrite_phy(o_zSTDlevs(ll),philevSTD(:,k))
-                CALL histwrite_phy(o_qSTDlevs(ll),qlevSTD(:,k))
-                CALL histwrite_phy(o_tSTDlevs(ll),tlevSTD(:,k))
-             ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR.
-          ENDDO
-  ENDIF
-#endif
+                  ll=ll+1
+                  CALL histwrite_phy(o_uSTDlevs(ll),ulevSTD(:,k))
+                  CALL histwrite_phy(o_vSTDlevs(ll),vlevSTD(:,k))
+                  CALL histwrite_phy(o_wSTDlevs(ll),wlevSTD(:,k))
+                  CALL histwrite_phy(o_zSTDlevs(ll),philevSTD(:,k))
+                  CALL histwrite_phy(o_qSTDlevs(ll),qlevSTD(:,k))
+                  CALL histwrite_phy(o_tSTDlevs(ll),tlevSTD(:,k))
+              ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR.
+            ENDDO
+         ENDIF
+       ENDIF
+
        IF (vars_defined) THEN
           DO i=1, klon
@@ -1567,4 +1546,9 @@
        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
@@ -1824,4 +1808,8 @@
        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
@@ -1838,18 +1826,22 @@
        CALL histwrite_phy(o_zfull,zx_tmp_fi3d)
 
-#ifdef CPP_XIOS
+       IF (ok_bs) THEN
+          CALL histwrite_phy(o_qbs, qbs_seri)
+       ENDIF
+
+       IF (using_xios) THEN
 !solbnd begin
 #ifdef CPP_RRTM
-      IF (iflag_rrtm.EQ.1) THEN
-       IF (vars_defined) THEN
-        DO ISW=1, NSW
-          zx_tmp_fi3dsp(:,ISW) = swdn(:,klevp1)*swradcorr(:)*RSUN(ISW)
-        ENDDO
-        CALL histwrite_phy(o_solbnd, zx_tmp_fi3dsp)
-       ENDIF
-      ENDIF
+         IF (iflag_rrtm.EQ.1) THEN
+           IF (vars_defined) THEN
+             DO ISW=1, NSW
+               zx_tmp_fi3dsp(:,ISW) = swdn(:,klevp1)*swradcorr(:)*RSUN(ISW)
+             ENDDO
+             CALL histwrite_phy(o_solbnd, zx_tmp_fi3dsp)
+           ENDIF
+         ENDIF
 #endif
 !solbnd end
-#endif
+       ENDIF
 #endif
 
@@ -1887,4 +1879,9 @@
           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
 
@@ -1949,4 +1946,16 @@
        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
 
@@ -1999,4 +2008,9 @@
 
        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)
@@ -2143,4 +2157,15 @@
        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
           ! Pour l instant 0 a y reflichir pour les thermiques
@@ -2395,50 +2420,50 @@
 !!!!!!!!!!!! Sorties niveaux de pression NMC !!!!!!!!!!!!!!!!!!!!
 #ifdef CPP_IOIPSL
-#ifndef CPP_XIOS
-  IF (.NOT.ok_all_xml) THEN 
-       ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX:
-       ! Champs interpolles sur des niveaux de pression
-       DO iff=7, nfiles-1 !--OB: here we deal with files 7,8,9
-
-          CALL histwrite_phy(o_tnondef,tnondef(:,:,iff-6),iff)
-          CALL histwrite_phy(o_ta,twriteSTD(:,:,iff-6),iff)
-          CALL histwrite_phy(o_zg,phiwriteSTD(:,:,iff-6),iff)
-          CALL histwrite_phy(o_hus,qwriteSTD(:,:,iff-6),iff)
-          CALL histwrite_phy(o_hur,rhwriteSTD(:,:,iff-6),iff)
-          CALL histwrite_phy(o_ua,uwriteSTD(:,:,iff-6),iff)
-          CALL histwrite_phy(o_va,vwriteSTD(:,:,iff-6),iff)
-          CALL histwrite_phy(o_wap,wwriteSTD(:,:,iff-6),iff)
-          IF (vars_defined) THEN
-             DO k=1, nlevSTD
-                DO i=1, klon
-                   IF (tnondef(i,k,iff-6).NE.missing_val) THEN
-                      IF (freq_outNMC(iff-6).LT.0) THEN
-                         freq_moyNMC(iff-6)=(mth_len*un_jour)/freq_calNMC(iff-6)
-                      ELSE
-                         freq_moyNMC(iff-6)=freq_outNMC(iff-6)/freq_calNMC(iff-6)
-                      ENDIF
-                      zx_tmp_fi3d_STD(i,k) = (100.*tnondef(i,k,iff-6))/freq_moyNMC(iff-6)
-                   ELSE
-                      zx_tmp_fi3d_STD(i,k) = missing_val
-                   ENDIF
-                ENDDO
-             ENDDO
-          ENDIF
-          CALL histwrite_phy(o_psbg,zx_tmp_fi3d_STD,iff)
-          IF (vars_defined) THEN
-             DO k=1, nlevSTD
-                DO i=1, klon
-                   IF (O3sumSTD(i,k,iff-6).NE.missing_val) THEN
-                      zx_tmp_fi3d_STD(i,k) = O3sumSTD(i,k,iff-6) * 1.e+9
-                   ELSE
-                      zx_tmp_fi3d_STD(i,k) = missing_val
-                   ENDIF
-                ENDDO
-             ENDDO !k=1, nlevSTD
-          ENDIF
-          CALL histwrite_phy(o_tro3,zx_tmp_fi3d_STD,iff)
-          IF (read_climoz == 2) THEN
+       IF (.NOT. using_xios) THEN
+         IF (.NOT.ok_all_xml) THEN 
+           ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX:
+           ! Champs interpolles sur des niveaux de pression
+           DO iff=7, nfiles-1 !--OB: here we deal with files 7,8,9
+
+             CALL histwrite_phy(o_tnondef,tnondef(:,:,iff-6),iff)
+             CALL histwrite_phy(o_ta,twriteSTD(:,:,iff-6),iff)
+             CALL histwrite_phy(o_zg,phiwriteSTD(:,:,iff-6),iff)
+             CALL histwrite_phy(o_hus,qwriteSTD(:,:,iff-6),iff)
+             CALL histwrite_phy(o_hur,rhwriteSTD(:,:,iff-6),iff)
+             CALL histwrite_phy(o_ua,uwriteSTD(:,:,iff-6),iff)
+             CALL histwrite_phy(o_va,vwriteSTD(:,:,iff-6),iff)
+             CALL histwrite_phy(o_wap,wwriteSTD(:,:,iff-6),iff)
              IF (vars_defined) THEN
-                DO k=1, nlevSTD
+               DO k=1, nlevSTD
+                  DO i=1, klon
+                     IF (tnondef(i,k,iff-6).NE.missing_val) THEN
+                       IF (freq_outNMC(iff-6).LT.0) THEN
+                          freq_moyNMC(iff-6)=(mth_len*un_jour)/freq_calNMC(iff-6)
+                       ELSE
+                          freq_moyNMC(iff-6)=freq_outNMC(iff-6)/freq_calNMC(iff-6)
+                       ENDIF
+                       zx_tmp_fi3d_STD(i,k) = (100.*tnondef(i,k,iff-6))/freq_moyNMC(iff-6)
+                     ELSE
+                       zx_tmp_fi3d_STD(i,k) = missing_val
+                     ENDIF
+                  ENDDO
+               ENDDO
+             ENDIF
+             CALL histwrite_phy(o_psbg,zx_tmp_fi3d_STD,iff)
+             IF (vars_defined) THEN
+               DO k=1, nlevSTD
+                  DO i=1, klon
+                    IF (O3sumSTD(i,k,iff-6).NE.missing_val) THEN
+                       zx_tmp_fi3d_STD(i,k) = O3sumSTD(i,k,iff-6) * 1.e+9
+                    ELSE
+                       zx_tmp_fi3d_STD(i,k) = missing_val
+                    ENDIF
+                  ENDDO
+               ENDDO !k=1, nlevSTD
+             ENDIF
+             CALL histwrite_phy(o_tro3,zx_tmp_fi3d_STD,iff)
+             IF (read_climoz == 2) THEN
+               IF (vars_defined) THEN
+                 DO k=1, nlevSTD
                    DO i=1, klon
                       IF (O3daysumSTD(i,k,iff-6).NE.missing_val) THEN
@@ -2448,24 +2473,25 @@
                       ENDIF
                    ENDDO
-                ENDDO !k=1, nlevSTD
+                 ENDDO !k=1, nlevSTD
+               ENDIF
+               CALL histwrite_phy(o_tro3_daylight,zx_tmp_fi3d_STD,iff)
              ENDIF
-             CALL histwrite_phy(o_tro3_daylight,zx_tmp_fi3d_STD,iff)
-          endif
-          CALL histwrite_phy(o_uxv,uvsumSTD(:,:,iff-6),iff)
-          CALL histwrite_phy(o_vxq,vqsumSTD(:,:,iff-6),iff)
-          CALL histwrite_phy(o_vxT,vTsumSTD(:,:,iff-6),iff)
-          CALL histwrite_phy(o_wxq,wqsumSTD(:,:,iff-6),iff)
-          CALL histwrite_phy(o_vxphi,vphisumSTD(:,:,iff-6),iff)
-          CALL histwrite_phy(o_wxT,wTsumSTD(:,:,iff-6),iff)
-          CALL histwrite_phy(o_uxu,u2sumSTD(:,:,iff-6),iff)
-          CALL histwrite_phy(o_vxv,v2sumSTD(:,:,iff-6),iff)
-          CALL histwrite_phy(o_TxT,T2sumSTD(:,:,iff-6),iff)
-       ENDDO !nfiles
-  ENDIF
+             CALL histwrite_phy(o_uxv,uvsumSTD(:,:,iff-6),iff)
+             CALL histwrite_phy(o_vxq,vqsumSTD(:,:,iff-6),iff)
+             CALL histwrite_phy(o_vxT,vTsumSTD(:,:,iff-6),iff)
+             CALL histwrite_phy(o_wxq,wqsumSTD(:,:,iff-6),iff)
+             CALL histwrite_phy(o_vxphi,vphisumSTD(:,:,iff-6),iff)
+             CALL histwrite_phy(o_wxT,wTsumSTD(:,:,iff-6),iff)
+             CALL histwrite_phy(o_uxu,u2sumSTD(:,:,iff-6),iff)
+             CALL histwrite_phy(o_vxv,v2sumSTD(:,:,iff-6),iff)
+             CALL histwrite_phy(o_TxT,T2sumSTD(:,:,iff-6),iff)
+           ENDDO !nfiles
+         ENDIF
+       ENDIF !.NOT. using_xios
 #endif
-#endif
-#ifdef CPP_XIOS
-  IF (ok_all_xml) THEN 
-!      DO iff=7, nfiles
+
+       IF (using_xios) THEN
+         IF (ok_all_xml) THEN 
+    !      DO iff=7, nfiles
 
 !         CALL histwrite_phy(o_tnondef,tnondef(:,:,3))
@@ -2530,6 +2556,6 @@
           CALL histwrite_phy(o_TxT,T2STD(:,:))
 !      ENDDO !nfiles
-  ENDIF
-#endif
+    ENDIF
+  ENDIF !using_xios
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        IF (iflag_phytrac == 1 ) then
@@ -2655,4 +2681,9 @@
         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)
@@ -2709,8 +2740,7 @@
           ENDDO !  iff
 #endif
-#ifdef CPP_XIOS
           !On finalise l'initialisation:
-          CALL wxios_closedef()
-#endif
+          IF (using_xios) CALL wxios_closedef()
+
           !$OMP END MASTER
           !$OMP BARRIER
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_state_var_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_state_var_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phys_state_var_mod.F90	(revision 4727)
@@ -54,6 +54,6 @@
 
 
-      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,8 +82,8 @@
       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(:,:,:)
@@ -102,6 +102,6 @@
       REAL, ALLOCATABLE, SAVE :: rneb_ancien(:,:)
 !$OMP THREADPRIVATE(rneb_ancien)
-      REAL, ALLOCATABLE, SAVE :: qtc_cv(:,:),sigt_cv(:,:)
-!$OMP THREADPRIVATE(qtc_cv,sigt_cv)
+      REAL, ALLOCATABLE, SAVE :: qtc_cv(:,:),sigt_cv(:,:),detrain_cv(:,:),fm_cv(:,:)
+!$OMP THREADPRIVATE(qtc_cv,sigt_cv,detrain_cv,fm_cv)
       REAL, ALLOCATABLE, SAVE :: ratqs(:,:)
 !$OMP THREADPRIVATE(ratqs)
@@ -229,6 +229,6 @@
 !$OMP THREADPRIVATE(ftd)
 ! fqd : convective moistening due to unsaturated downdraughts
-      REAL,ALLOCATABLE,SAVE :: fqd(:,:)     
-!$OMP THREADPRIVATE(fqd)
+      REAL,ALLOCATABLE,SAVE :: fqd(:,:),fqcomp(:,:)     
+!$OMP THREADPRIVATE(fqd,fqcomp)
 #ifdef ISO
       REAL, ALLOCATABLE, SAVE :: fxtd(:,:,:)
@@ -313,4 +313,6 @@
       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)
@@ -475,6 +477,6 @@
 !$OMP THREADPRIVATE(ale_bl_trig)
 
-      REAL,SAVE,ALLOCATABLE :: ratqs_inter(:,:)
-!$OMP THREADPRIVATE(ratqs_inter)
+      REAL,SAVE,ALLOCATABLE :: ratqs_inter_(:,:)
+!$OMP THREADPRIVATE(ratqs_inter_)
 
 #ifdef ISO
@@ -570,4 +572,5 @@
       ALLOCATE(rain_fall(klon))
       ALLOCATE(snow_fall(klon))
+      ALLOCATE(bs_fall(klon))
       ALLOCATE(solsw(klon), solswfdiff(klon), sollw(klon))
       sollw=0.0
@@ -579,6 +582,6 @@
       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 >>>
@@ -587,5 +590,5 @@
       ALLOCATE(clwcon(klon,klev),rnebcon(klon,klev))
       ALLOCATE(rneb_ancien(klon,klev))
-      ALLOCATE(qtc_cv(klon,klev),sigt_cv(klon,klev))
+      ALLOCATE(qtc_cv(klon,klev),sigt_cv(klon,klev),detrain_cv(klon,klev),fm_cv(klon,klev))
       ALLOCATE(ratqs(klon,klev))
       ALLOCATE(pbl_tke(klon,klev+1,nbsrf+1))
@@ -658,5 +661,5 @@
       ALLOCATE(sigd(klon))
       ALLOCATE(cin(klon), ALE(klon), ALP(klon))
-      ALLOCATE(ftd(klon,klev), fqd(klon,klev))
+      ALLOCATE(ftd(klon,klev), fqd(klon,klev),fqcomp(klon,klev))
       ALLOCATE(Ale_bl(klon))
       ALLOCATE(ale_wake(klon))
@@ -678,4 +681,5 @@
       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))
@@ -766,5 +770,5 @@
 
       ALLOCATE(ale_bl_trig(klon))
-      ALLOCATE(ratqs_inter(klon,klev))
+      ALLOCATE(ratqs_inter_(klon,klev))
       IF (ok_gwd_rando) THEN
         ALLOCATE(du_gwd_rando(klon, klev))
@@ -800,11 +804,11 @@
 !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(qtc_cv,sigt_cv)
+      DEALLOCATE(qs_ancien, ql_ancien, qbs_ancien, rneb_ancien)
+      DEALLOCATE(prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien)
+      DEALLOCATE(qtc_cv,sigt_cv,detrain_cv,fm_cv)
       DEALLOCATE(u_ancien, v_ancien)
       DEALLOCATE(tr_ancien)                           !RomP
@@ -854,5 +858,5 @@
       DEALLOCATE(wd, sigd)
       DEALLOCATE(cin, ALE, ALP)
-      DEALLOCATE(ftd, fqd)
+      DEALLOCATE(ftd, fqd, fqcomp)
       DEALLOCATE(Ale_bl, Alp_bl)
       DEALLOCATE(ale_wake)
@@ -872,4 +876,5 @@
       DEALLOCATE(pfrac_1nucl)
       DEALLOCATE(total_rain, nday_rain)
+      DEALLOCATE(ndayrain_mth)
       DEALLOCATE(paire_ter)
       DEALLOCATE(albsol1, albsol2)
@@ -902,5 +907,5 @@
       DEALLOCATE(swdnc0_s2, swdn0_s2, swdn_s2)
       DEALLOCATE(swupc0_s2, swup0_s2, swup_s2)
-      
+
 !IM ajout variables CFMIP2/CMIP5
       DEALLOCATE(heatp, coolp)
@@ -933,5 +938,5 @@
       if (.not. ok_hines .and. ok_gwd_rando) DEALLOCATE(du_gwd_front)
       DEALLOCATE(ale_bl_trig)
-      DEALLOCATE(ratqs_inter)
+      DEALLOCATE(ratqs_inter_)
 
       if (activate_ocean_skin >= 1) then
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/physiq_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/physiq_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/physiq_mod.F90	(revision 4727)
@@ -76,13 +76,21 @@
     USE vampir
     USE write_field_phy
-#ifdef CPP_XIOS
     USE wxios, ONLY: g_ctx, wxios_set_context
-#endif
-    USE lscp_mod, ONLY : lscp
-    USE wake_ini_mod, ONLY : wake_ini
+    USE lmdz_lscp, ONLY : lscp
+    USE lmdz_call_cloud_optics_prop, ONLY : call_cloud_optics_prop
+    USE lmdz_lscp_old, ONLY : fisrtilp
+    USE lmdz_call_blowing_snow, ONLY : call_blowing_snow_sublim_sedim
+    USE lmdz_wake_ini, ONLY : wake_ini
     USE yamada_ini_mod, ONLY : yamada_ini
-    USE atke_turbulence_ini_mod, ONLY : atke_ini
-    USE thermcell_ini_mod, ONLY : thermcell_ini
-    USE lscp_ini_mod, ONLY : lscp_ini
+    USE lmdz_atke_turbulence_ini, ONLY : atke_ini
+    USE lmdz_thermcell_ini, ONLY : thermcell_ini, iflag_thermals_tenv
+    USE lmdz_thermcell_dtke, ONLY : thermcell_dtke
+    USE lmdz_blowing_snow_ini, ONLY : blowing_snow_ini , qbst_bs 
+    USE lmdz_lscp_ini, ONLY : lscp_ini
+    USE lmdz_ratqs_main, ONLY : ratqs_main
+    USE lmdz_ratqs_ini, ONLY : ratqs_ini
+    USE lmdz_cloud_optics_prop_ini, ONLY : cloud_optics_prop_ini
+    USE phys_output_var_mod, ONLY :      cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
+
 
     !USE cmp_seri_mod
@@ -110,4 +118,6 @@
     USE chem_rep, ONLY: Init_chem_rep_xjour, d_q_rep, d_ql_rep, d_qi_rep, &
                         ptrop, ttrop, ztrop, gravit, itroprep, Z1, Z2, fac, B
+    USE strataer_local_var_mod
+    USE strataer_emiss_mod, ONLY: strataer_emiss_init
 #endif
 #if defined INCA || defined REPROBUS
@@ -124,14 +134,15 @@
 
 #ifdef CPP_StratAer
-    USE strataer_mod, ONLY: strataer_init
+    USE phys_local_var_mod, ONLY: d_q_emiss
+    USE strataer_local_var_mod
+    USE strataer_nuc_mod, ONLY: strataer_nuc_init
+    USE strataer_emiss_mod, ONLY: strataer_emiss_init
 #endif
 
-
-#ifdef CPP_XIOS
-    USE xios, ONLY: xios_update_calendar, xios_context_finalize
-    USE xios, ONLY: xios_get_field_attr, xios_field_is_active, xios_context
-    USE xios, ONLY: xios_set_current_context
-    USE wxios, ONLY: missing_val, missing_val_omp
-#endif
+    USE lmdz_xios, ONLY: xios_update_calendar, xios_context_finalize
+    USE lmdz_xios, ONLY: xios_get_field_attr, xios_field_is_active, xios_context
+    USE lmdz_xios, ONLY: xios_set_current_context
+    USE wxios, ONLY: missing_val, using_xios
+
 #ifndef CPP_XIOS
     USE paramLMDZ_phy_mod
@@ -141,12 +152,14 @@
 !!!!!!!!!!!!!!!!!!  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, &        
        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,8 +178,10 @@
        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, &
@@ -191,4 +206,15 @@
        toplwai_aero,sollwai_aero,   &
        toplwad0_aero,sollwad0_aero, &
+       !pour Ecrad
+       topswad_aero_s2, solswad_aero_s2,   &
+       topswai_aero_s2, solswai_aero_s2,   &
+       topswad0_aero_s2, solswad0_aero_s2, &
+       topsw_aero_s2, topsw0_aero_s2,      &
+       solsw_aero_s2, solsw0_aero_s2,      &
+       topswcf_aero_s2, solswcf_aero_s2,   &
+       !LW diagnostics
+       toplwad_aero_s2, sollwad_aero_s2,   &
+       toplwai_aero_s2, sollwai_aero_s2,   &
+       toplwad0_aero_s2, sollwad0_aero_s2, &
        !
        topsw_aero,solsw_aero,       &
@@ -209,5 +235,4 @@
        toplwai_aerop, sollwai_aerop,   &
        toplwad0_aerop, sollwad0_aerop, &
-!
        !pour Ecrad
        topswad_aero_s2, solswad_aero_s2,   &
@@ -221,5 +246,5 @@
        toplwai_aero_s2, sollwai_aero_s2,   &
        toplwad0_aero_s2, sollwad0_aero_s2, &
-!
+       !
        ptstar, pt0, slp, &
        !
@@ -228,6 +253,6 @@
        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,                   &
@@ -302,4 +327,6 @@
        !
        rneblsvol, &
+       pfraclr,pfracld, &
+       distcltop,temp_cltop, &
        zqsatl, zqsats, &
        qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, &
@@ -317,5 +344,5 @@
        fsolsw, wfbils, wfbilo,  &
        wfevap, wfrain, wfsnow,  &  
-       prfl, psfl, fraca, Vprecip,  &
+       prfl, psfl,bsfl, fraca, Vprecip,  &
        zw2,  &
        !
@@ -329,6 +356,12 @@
        beta_prec,  &
        rneb,  &
-       zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic
-       !
+       zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic, &
+       zxfluxt,zxfluxq 
+       !
+       USE phys_local_var_mod, ONLY: zfice, dNovrN, ptconv
+       USE phys_output_var_mod, ONLY: scdnc, cldncl, reffclwtop, lcc, reffclws, &
+       reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra
+       USE output_physiqex_mod, ONLY: output_physiqex
+
 
     IMPLICIT NONE
@@ -457,7 +490,7 @@
     SAVE seuil_inversion
     !$OMP THREADPRIVATE(seuil_inversion)
-    INTEGER iflag_ratqs
-    SAVE iflag_ratqs
-    !$OMP THREADPRIVATE(iflag_ratqs)
+    
+    
+    
     real facteur
 
@@ -473,7 +506,7 @@
     !======================================================================
     !
-    ! 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)
     !
     !
@@ -517,7 +550,4 @@
     REAL dtadd(klon,klev)
 
-#ifndef CPP_XIOS
-    REAL, SAVE :: missing_val=nf90_fill_real
-#endif
 !!   Variables moved to phys_local_var_mod
 !!    ! Variables pour le transport convectif
@@ -540,4 +570,5 @@
     !
     !
+    include "radepsi.h"
     include "radopt.h"
     !
@@ -810,12 +841,5 @@
     EXTERNAL ajsec     ! ajustement sec
     EXTERNAL conlmd    ! convection (schema LMD)
-    !KE43
     EXTERNAL conema3  ! convect4.3
-    EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
-    !AA 
-    ! JBM (3/14) fisrtilp_tr not loaded
-    ! EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
-    !                          ! stockage des coefficients necessaires au
-    !                          ! lessivage OFF-LINE et ON-LINE
     EXTERNAL hgardfou  ! verifier les temperatures
     EXTERNAL nuage     ! calculer les proprietes radiatives
@@ -846,7 +870,9 @@
     !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)
@@ -932,5 +958,5 @@
     !
     ! 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
@@ -956,4 +982,9 @@
     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)
 
     !
@@ -1073,5 +1104,6 @@
     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
@@ -1133,7 +1165,7 @@
     !     climatology and the daylight climatology
     INTEGER,SAVE :: ncid_climoz                ! NetCDF file identifier
-    REAL, allocatable, SAVE :: press_cen_climoz(:) ! Pressure levels
-    REAL, allocatable, SAVE :: press_edg_climoz(:) ! Edges of pressure intervals
-    REAL, allocatable, SAVE :: time_climoz(:)      ! Time vector
+    REAL, ALLOCATABLE, SAVE :: press_cen_climoz(:) ! Pressure levels
+    REAL, ALLOCATABLE, SAVE :: press_edg_climoz(:) ! Edges of pressure intervals
+    REAL, ALLOCATABLE, SAVE :: time_climoz(:)      ! Time vector
     CHARACTER(LEN=13), PARAMETER :: vars_climoz(2) &
                                   = ["tro3         ","tro3_daylight"]
@@ -1148,5 +1180,4 @@
     !IM 100106 BEG : pouvoir sortir les ctes de la physique
     include "conema3.h"
-    include "fisrtilp.h"
     include "nuage.h"
     include "compbl.h"
@@ -1156,4 +1187,8 @@
     ! Declarations pour Simulateur COSP
     !============================================================
+    ! AI 10-22
+#ifdef CPP_COSP
+    include "ini_COSP.h"
+#endif
     real :: mr_ozone(klon,klev), phicosp(klon,klev)
 
@@ -1224,5 +1259,32 @@
     REAL qql1(klon),qql2(klon),corrqql
 
+    REAL, dimension(klon,klev) :: t_env,q_env
+
+    REAL, dimension(klon) :: pr_et
+    REAL, dimension(klon) :: w_et, jlr_g_c, jlr_g_s
+
     REAL pi
+    INTEGER ieru
+
+    !======================================================================!
+    ! 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.)
@@ -1240,11 +1302,13 @@
     CALL update_time(pdtphys)
     phys_tstep=NINT(pdtphys)
-#ifdef CPP_XIOS
-! switch to XIOS LMDZ physics context 
-    IF (.NOT. debut .AND. is_omp_master) THEN
-       CALL wxios_set_context()
-       CALL xios_update_calendar(itap+1)
-    ENDIF
-#endif
+    IF (.NOT. using_xios) missing_val=nf90_fill_real
+
+    IF (using_xios) THEN
+      ! switch to XIOS LMDZ physics context 
+      IF (.NOT. debut .AND. is_omp_master) THEN
+        CALL wxios_set_context()
+        CALL xios_update_calendar(itap+1)
+      ENDIF
+    ENDIF
 
     !======================================================================
@@ -1252,5 +1316,5 @@
     ! 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
@@ -1283,6 +1347,7 @@
        isol = strIdx(tracers(:)%name, addPhase('H2O', 's'))
        irneb= strIdx(tracers(:)%name, addPhase('H2O', 'r'))
-       CALL init_etat0_limit_unstruct
-       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
+       ibs  = strIdx(tracers(:)%name, addPhase('H2O', 'b'))
+!       CALL init_etat0_limit_unstruct
+!       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
        !CR:nvelles variables convection/poches froides
 
@@ -1299,5 +1364,5 @@
             solarlong0,seuil_inversion, &
             fact_cldcon, facttemps,ok_newmicro,iflag_radia, &
-            iflag_cld_th,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
+            iflag_cld_th,ratqsbas,ratqshaut,tau_ratqs, &
             ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan, flag_volc_surfstrat, aerosol_couple, &
             chemistry_couple, flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
@@ -1307,4 +1372,6 @@
             read_climoz, &
             alp_offset)
+       CALL init_etat0_limit_unstruct
+       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
        CALL phys_state_var_init(read_climoz)
        CALL phys_output_var_init
@@ -1312,6 +1379,13 @@
           CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
 
+#ifdef REPROBUS
+       CALL strataer_init
+       CALL strataer_emiss_init
+#endif
+
 #ifdef CPP_StratAer
        CALL strataer_init
+       CALL strataer_nuc_init
+       CALL strataer_emiss_init
 #endif
 
@@ -1332,5 +1406,5 @@
        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.'
@@ -1350,4 +1424,13 @@
           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
@@ -1412,4 +1495,5 @@
        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)
@@ -1448,10 +1532,10 @@
        CALL infocfields_init
 
-!AI 08 2023       
+       !AI 08 2023
 #ifdef CPP_ECRAD
        ok_3Deffect=.false.
        CALL getin_p('ok_3Deffect',ok_3Deffect)
        namelist_ecrad_file='namelist_ecrad'
-#endif            
+#endif
 
     ENDIF
@@ -1494,4 +1578,5 @@
           piz_aero(:,:,:,:) = 0.
           cg_aero(:,:,:,:) = 0.
+          d_q_ch4(:,:) = 0.
 
           config_inca='none' ! default
@@ -1505,4 +1590,5 @@
        piz_aero(:,:,:,:) = 1.
        cg_aero(:,:,:,:)  = 0.
+       d_q_ch4(:,:) = 0.
 
        IF (aerosol_couple .AND. (config_inca /= "aero" &
@@ -1688,14 +1774,15 @@
 
 !       CALL create_climoz(read_climoz)
-      IF (.NOT. create_etat0_limit) CALL init_aero_fromfile(flag_aerosol)  !! initialise aero from file for XIOS interpolation (unstructured_grid)
+      IF (.NOT. create_etat0_limit) CALL init_aero_fromfile(flag_aerosol, aerosol_couple)  !! initialise aero from file for XIOS interpolation (unstructured_grid)
       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, &
@@ -1710,14 +1797,7 @@
                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, &
@@ -1732,14 +1812,7 @@
                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, &
@@ -1754,6 +1827,6 @@
                pmflxr(:,1:klev),pmflxs(:,1:klev), &
                mr_ozone,cldtau, cldemi)
-       ENDIF
 #endif
+      ENDIF 
 
        !
@@ -1768,10 +1841,32 @@
        CALL wake_ini(rg,rd,rv,prt_level)
        CALL yamada_ini(klon,lunout,prt_level)
-       CALL atke_ini(prt_level, lunout, RG, RD, RPI, RCPD)
+       CALL atke_ini(prt_level, lunout, RG, RD, RPI, RCPD, RV)
        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 ratqs_ini(klon,klev,iflag_thermals,lunout,nbsrf,is_lic,is_ter,RG,RV,RD,RCPD,RLSTT,RLVTT,RTT)
+       CALL lscp_ini(pdtphys,lunout,prt_level,ok_ice_sursat,iflag_ratqs,fl_cor_ebil,RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT,RD,RG)
+       CALL blowing_snow_ini(prt_level,lunout, &
+                             RCPD, RLSTT, RLVTT, RLMLT, &
+                             RVTMP2, RTT,RD,RG)
+       ! Test de coherence sur oc_cdnc utilisé uniquement par cloud_optics_prop
+       IF (ok_newmicro) then
+          IF (iflag_rrtm.EQ.1) THEN
+#ifdef CPP_RRTM
+             IF (ok_cdnc.AND.NRADLP.NE.3) THEN
+             abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 ' &
+                  // 'pour ok_cdnc' 
+             CALL abort_physic(modname,abort_message,1)
+             ENDIF
+#else
+
+             abort_message='You should compile with -rrtm if running with '//'iflag_rrtm=1'
+             CALL abort_physic(modname,abort_message,1)
+#endif
+          ENDIF
+       ENDIF   
+       CALL cloud_optics_prop_ini(klon, prt_level, lunout, flag_aerosol, &
+                                  & ok_cdnc, bl95_b0, &
+                                  & bl95_b1, latitude_deg, rpi, rg, rd, &
+                                  & zepsec, novlp, iflag_ice_thermo, ok_new_lscp)
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -1799,14 +1894,15 @@
        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,           &
-                              flag_aerosol, flag_aerosol_strat, ok_cdnc)
+                              flag_aerosol, flag_aerosol_strat, ok_cdnc, t, u1, v1)
 #endif
 
 
-#ifdef CPP_XIOS
-       IF (is_omp_master) CALL xios_update_calendar(1)
-#endif
+       IF (using_xios) THEN
+         IF (is_omp_master) CALL xios_update_calendar(1)
+       ENDIF
+       
        IF(read_climoz>=1 .AND. create_etat0_limit) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
        CALL create_etat0_limit_unstruct
@@ -1987,63 +2083,57 @@
        !=============================================================
 
-#ifdef CPP_XIOS
-       ! Get "missing_val" value from XML files (from temperature variable)
-       !$OMP MASTER
-       CALL xios_get_field_attr("temp",default_value=missing_val_omp)
-       !$OMP END MASTER
-       !$OMP BARRIER
-       missing_val=missing_val_omp
-#endif
-
-#ifdef CPP_XIOS 
-! Need to put this initialisation after phyetat0 as in the coupled model the XIOS context is only
-! initialised at that moment
-       ! Get "missing_val" value from XML files (from temperature variable)
-       !$OMP MASTER
-       CALL xios_get_field_attr("temp",default_value=missing_val_omp)
-       !$OMP END MASTER
-       !$OMP BARRIER
-       missing_val=missing_val_omp
+       IF (using_xios) THEN    
+         ! Get "missing_val" value from XML files (from temperature variable)
+         IF (is_omp_master) CALL xios_get_field_attr("temp",default_value=missing_val)
+         CALL bcast_omp(missing_val)
+       ENDIF
+
+       IF (using_xios) THEN    
+         ! Need to put this initialisation after phyetat0 as in the coupled model the XIOS context is only
+         ! initialised at that moment
+         ! Get "missing_val" value from XML files (from temperature variable)
+         IF (is_omp_master) CALL xios_get_field_attr("temp",default_value=missing_val)
+         CALL bcast_omp(missing_val)
        ! 
        ! Now we activate some double radiation call flags only if some
        ! diagnostics are requested, otherwise there is no point in doing this
-       IF (is_master) THEN
-         !--setting up swaero_diag to TRUE in XIOS case 
-         IF (xios_field_is_active("topswad").OR.xios_field_is_active("topswad0").OR. & 
-            xios_field_is_active("solswad").OR.xios_field_is_active("solswad0").OR. & 
-            xios_field_is_active("topswai").OR.xios_field_is_active("solswai").OR.  & 
-              (iflag_rrtm==1.AND.(xios_field_is_active("toplwad").OR.xios_field_is_active("toplwad0").OR. & 
-                                  xios_field_is_active("sollwad").OR.xios_field_is_active("sollwad0"))))  & 
-            !!!--for now these fields are not in the XML files so they are omitted 
-            !!!  xios_field_is_active("toplwai").OR.xios_field_is_active("sollwai") !))) & 
-            swaero_diag=.TRUE. 
+         IF (is_master) THEN
+           !--setting up swaero_diag to TRUE in XIOS case 
+           IF (xios_field_is_active("topswad").OR.xios_field_is_active("topswad0").OR. & 
+              xios_field_is_active("solswad").OR.xios_field_is_active("solswad0").OR. & 
+              xios_field_is_active("topswai").OR.xios_field_is_active("solswai").OR.  & 
+                (iflag_rrtm==1.AND.(xios_field_is_active("toplwad").OR.xios_field_is_active("toplwad0").OR. & 
+                                    xios_field_is_active("sollwad").OR.xios_field_is_active("sollwad0"))))  & 
+              !!!--for now these fields are not in the XML files so they are omitted 
+              !!!  xios_field_is_active("toplwai").OR.xios_field_is_active("sollwai") !))) & 
+              swaero_diag=.TRUE. 
  
-         !--setting up swaerofree_diag to TRUE in XIOS case 
-         IF (xios_field_is_active("SWdnSFCcleanclr").OR.xios_field_is_active("SWupSFCcleanclr").OR. &
-            xios_field_is_active("SWupTOAcleanclr").OR.xios_field_is_active("rsucsaf").OR.   &
-            xios_field_is_active("rsdcsaf") .OR. xios_field_is_active("LWdnSFCcleanclr").OR. &
-            xios_field_is_active("LWupTOAcleanclr")) &
-            swaerofree_diag=.TRUE. 
+           !--setting up swaerofree_diag to TRUE in XIOS case 
+           IF (xios_field_is_active("SWdnSFCcleanclr").OR.xios_field_is_active("SWupSFCcleanclr").OR. &
+              xios_field_is_active("SWupTOAcleanclr").OR.xios_field_is_active("rsucsaf").OR.   &
+              xios_field_is_active("rsdcsaf") .OR. xios_field_is_active("LWdnSFCcleanclr").OR. &
+              xios_field_is_active("LWupTOAcleanclr")) &
+              swaerofree_diag=.TRUE. 
  
-         !--setting up dryaod_diag to TRUE in XIOS case 
-         DO naero = 1, naero_tot-1
-          IF (xios_field_is_active("dryod550_"//name_aero_tau(naero))) dryaod_diag=.TRUE. 
-         ENDDO
-         !
-         !--setting up ok_4xCO2atm to TRUE in XIOS case 
-         IF (xios_field_is_active("rsut4co2").OR.xios_field_is_active("rlut4co2").OR. & 
-            xios_field_is_active("rsutcs4co2").OR.xios_field_is_active("rlutcs4co2").OR. &
-            xios_field_is_active("rsu4co2").OR.xios_field_is_active("rsucs4co2").OR. &
-            xios_field_is_active("rsd4co2").OR.xios_field_is_active("rsdcs4co2").OR. &
-            xios_field_is_active("rlu4co2").OR.xios_field_is_active("rlucs4co2").OR. &
-            xios_field_is_active("rld4co2").OR.xios_field_is_active("rldcs4co2")) &
-            ok_4xCO2atm=.TRUE. 
-       ENDIF
-       !$OMP BARRIER
-       CALL bcast(swaero_diag)
-       CALL bcast(swaerofree_diag)
-       CALL bcast(dryaod_diag)
-       CALL bcast(ok_4xCO2atm)
-#endif 
+           !--setting up dryaod_diag to TRUE in XIOS case 
+           DO naero = 1, naero_tot-1
+             IF (xios_field_is_active("dryod550_"//name_aero_tau(naero))) dryaod_diag=.TRUE. 
+           ENDDO
+           !
+          !--setting up ok_4xCO2atm to TRUE in XIOS case 
+           IF (xios_field_is_active("rsut4co2").OR.xios_field_is_active("rlut4co2").OR. & 
+              xios_field_is_active("rsutcs4co2").OR.xios_field_is_active("rlutcs4co2").OR. &
+              xios_field_is_active("rsu4co2").OR.xios_field_is_active("rsucs4co2").OR. &
+              xios_field_is_active("rsd4co2").OR.xios_field_is_active("rsdcs4co2").OR. &
+              xios_field_is_active("rlu4co2").OR.xios_field_is_active("rlucs4co2").OR. &
+              xios_field_is_active("rld4co2").OR.xios_field_is_active("rldcs4co2")) &
+              ok_4xCO2atm=.TRUE. 
+           ENDIF
+           !$OMP BARRIER
+           CALL bcast(swaero_diag)
+           CALL bcast(swaerofree_diag)
+           CALL bcast(dryaod_diag)
+           CALL bcast(ok_4xCO2atm)
+         ENDIF !using_xios
        !
        CALL printflag( tabcntr0,radpas,ok_journe, &
@@ -2270,4 +2360,5 @@
     dql0(:,:)=0.
     dqi0(:,:)=0.
+    dqbs0(:,:)=0.
     dsig0(:) = 0.
     ddens0(:) = 0.
@@ -2322,4 +2413,5 @@
           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
@@ -2329,8 +2421,16 @@
              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
@@ -2341,5 +2441,5 @@
     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
@@ -2397,4 +2497,5 @@
        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
@@ -2403,4 +2504,6 @@
        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
@@ -2418,8 +2521,10 @@
        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
@@ -2537,5 +2642,5 @@
 
      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)
@@ -2662,4 +2767,22 @@
     ! Calcul de l'humidite de saturation au niveau du sol
 
+! Tests Fredho, instensibilite au pas de temps -------------------------------
+! A detruire en 2024 une fois les tests documentes et les choix faits        !
+! Conservation des variables avant l'appel à l a diffusion pour les tehrmic  !
+    if (iflag_thermals_tenv / 10 == 1 ) then                                 !
+        do k=1,klev                                                          !
+           do i=1,klon                                                       !
+              t_env(i,k)=t_seri(i,k)                                         !
+              q_env(i,k)=q_seri(i,k)                                         !
+           enddo                                                             !
+        enddo                                                                !
+    else if (iflag_thermals_tenv / 10 == 2 ) then                            !
+        do k=1,klev                                                          !
+           do i=1,klon                                                       !
+              t_env(i,k)=t_seri(i,k)                                         !
+           enddo                                                             !
+        enddo                                                                !
+    endif                                                                    !
+! Tests Fredho, instensibilite au pas de temps -------------------------------
 
 
@@ -2686,4 +2809,15 @@
        ELSE IF (iflag_gusts==2) THEN
           gustiness(1:klon)=f_gust_bl*ale_bl_stat(1:klon)+f_gust_wk*ale_wake(1:klon)
+       !!!! modif olivier torres
+       ELSE IF (iflag_gusts==3) THEN
+          w_et=wstar(1,3)
+          jlr_g_s=(0.65*w_et)**2
+          pr_et=rain_con*8640
+          jlr_g_c = (((19.8*(pr_et(1:klon)**2))/(1.5+pr_et(1:klon)+pr_et(1:klon)**2))**(0.4))**2
+          gustiness(1:klon)=jlr_g_c+jlr_g_s
+!!       write(*,*) "rain ",pr_et
+!!       write(*,*) "jlr_g_c",jlr_g_c
+!!       write(*,*) "wstar",wstar(1,3)
+!!       write(*,*) "jlr_g_s",jlr_g_s
           ! ELSE IF (iflag_gusts==2) THEN
           !    do i = 1, klon
@@ -2702,7 +2836,7 @@
             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, &
@@ -2715,9 +2849,9 @@
                                 !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<
@@ -2745,5 +2879,5 @@
             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, &
@@ -2770,12 +2904,13 @@
        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)
+
        !--------------------------------------------------------------------
 
@@ -2828,4 +2963,24 @@
 
     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
@@ -2998,8 +3153,8 @@
                 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)
@@ -3058,5 +3213,5 @@
                ALE,ALP, &
                sig1,w01, &
-               d_t_con,d_q_con,d_u_con,d_v_con,d_tr, &
+               d_t_con,d_q_con,fqcomp,d_u_con,d_v_con,d_tr, &
                rain_con, snow_con, ibas_con, itop_con, sigd, &
                ema_cbmf,plcl,plfc,wbeff,convoccur,upwd,dnwd,dnwd0, &
@@ -3069,5 +3224,5 @@
                ftd,fqd,lalim_conv,wght_th, &
                ev, ep,epmlmMm,eplaMm, &
-               wdtrainA, wdtrainS, wdtrainM,wght_cvfd,qtc_cv,sigt_cv, &
+               wdtrainA, wdtrainS, wdtrainM,wght_cvfd,qtc_cv,sigt_cv,detrain_cv, &
                tau_cld_cv,coefw_cld_cv,epmax_diag)
 
@@ -3081,4 +3236,5 @@
           clwcon0=qcondc
           pmfu(:,:)=upwd(:,:)+dnwd(:,:)
+          fm_cv(:,:)=upwd(:,:)+dnwd(:,:)+dnwd0(:,:)
           !
           !jyg<
@@ -3252,5 +3408,5 @@
 !!
 !!
-    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)
@@ -3383,5 +3539,5 @@
        !-----------------------------------------------------------------------
        ! 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)
@@ -3441,4 +3597,14 @@
        !  ====
        IF (prt_level>9) WRITE(lunout,*)'pas de convection seche'
+       WRITE(lunout,*) 'WARNING : running without dry convection. Somme intermediate variables are not properly defined in physiq_mod.F90'
+       ! Reprendre proprement les initialisation ci dessouds si on veut vraiment utiliser l'option (FH)
+          fraca(:,:)=0.
+          fm_therm(:,:)=0.
+          ztv(:,:)=t_seri(:,:)
+          zqasc(:,:)=q_seri(:,:)
+          ztla(:,:)=0.
+          zthl(:,:)=0.
+          zpspsk(:,:)=(pplay(:,:)/100000.)**RKAPPA
+
 
 
@@ -3463,7 +3629,33 @@
 
        IF (iflag_thermals>=1) THEN
+
+! Tests Fredho, instensibilite au pas de temps -------------------------------
+! A detruire en 2024 une fois les tests documentes et les choix faits        !
+          if (iflag_thermals_tenv /10 == 0 ) then                            !
+            do k=1,klev                                                      !
+               do i=1,klon                                                   !
+                  t_env(i,k)=t_seri(i,k)                                     !
+                  q_env(i,k)=q_seri(i,k)                                     !
+               enddo                                                         !
+            enddo                                                            !
+          else if (iflag_thermals_tenv / 10 == 2 ) then                      !
+            do k=1,klev                                                      !
+               do i=1,klon                                                   !
+                  q_env(i,k)=q_seri(i,k)                                     !
+               enddo                                                         !
+            enddo                                                            !
+          else if (iflag_thermals_tenv / 10 == 3 ) then                      !
+            do k=1,klev                                                      !
+               do i=1,klon                                                   !
+                  t_env(i,k)=t(i,k)                                          !
+                  q_env(i,k)=qx(i,k,1)                                       !
+               enddo                                                         !
+            enddo                                                            !
+          endif                                                              !
+! Tests Fredho, instensibilite au pas de temps ------------------------------
+
           !jyg<
 !!       IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
-       IF (mod(iflag_pbl_split/10,10) .GE. 1) THEN
+          IF (mod(iflag_pbl_split/10,10) .GE. 1) THEN
              !  Appel des thermiques avec les profils exterieurs aux poches
              DO k=1,klev
@@ -3471,4 +3663,6 @@
                    t_therm(i,k) = t_seri(i,k) - wake_s(i)*wake_deltat(i,k)
                    q_therm(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k)
+                   t_env(i,k)   = t_env(i,k) - wake_s(i)*wake_deltat(i,k)
+                   q_env(i,k)   = q_env(i,k) - wake_s(i)*wake_deltaq(i,k)
                    u_therm(i,k) = u_seri(i,k)
                    v_therm(i,k) = v_seri(i,k)
@@ -3490,5 +3684,5 @@
                ,pplay,paprs,pphi,weak_inversion &
                         ! ,u_seri,v_seri,t_seri,q_seri,zqsat,debut & !jyg
-               ,u_therm,v_therm,t_therm,q_therm,zqsat,debut &  !jyg
+               ,u_therm,v_therm,t_therm,q_therm,t_env,q_env,zqsat,debut &  !jyg
                ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs &
                ,fm_therm,entr_therm,detr_therm &
@@ -3541,5 +3735,5 @@
           !
           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)
           !
@@ -3603,5 +3797,5 @@
           !--------------------------------------------------------------------
           ! 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)
@@ -3631,12 +3825,15 @@
     ENDDO
 
-    CALL  calcratqs(klon,klev,prt_level,lunout,        &
+    CALL ratqs_main(klon,klev,nbsrf,prt_level,lunout,        &
          iflag_ratqs,iflag_con,iflag_cld_th,pdtphys,  &
          ratqsbas,ratqshaut,ratqsp0, ratqsdp, &
+         pctsrf,s_pblh,zstd, &
          tau_ratqs,fact_cldcon,wake_s, wake_deltaq,   &
          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, &
-         ratqs,ratqsc,ratqs_inter)
+         paprs,pplay,t_seri,q_seri, &
+         qtc_cv, sigt_cv,detrain_cv,fm_cv,fqd,fqcomp,sigd,zqsat, &
+         omega,pbl_tke(:,:,is_ave),tke_dissip_ave,l_mix_ave,wprime_ave, &
+         t2m,q2m,fm_therm,entr_therm,detr_therm,cell_area, &
+         ratqs,ratqsc,ratqs_inter_)
 
     !
@@ -3661,17 +3858,20 @@
          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, temp_cltop, &
          qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, &
-         Tcontr, qcontr, qcontr2, fcontrN, fcontrP )
+         Tcontr, qcontr, qcontr2, fcontrN, fcontrP , &
+         cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
 
     ELSE
 
-    CALL fisrtilp(phys_tstep,paprs,pplay, &
+    CALL fisrtilp(klon,klev,phys_tstep,paprs,pplay, &
          t_seri, q_seri,ptconv,ratqs, &
-         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, radocond, &
+         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, radocond, &
          rain_lsc, snow_lsc, &
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &
@@ -3679,5 +3879,6 @@
          prfl, psfl, rhcl,  &
          zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
-         iflag_ice_thermo)
+         iflag_ice_thermo, &
+         cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
 
     ENDIF
@@ -3692,5 +3893,5 @@
 !    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)
@@ -3715,12 +3916,40 @@
     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)
@@ -4190,35 +4419,15 @@
        ENDIF
 
-       IF (ok_newmicro) then
-! AI          IF (iflag_rrtm.NE.0) THEN 
-          IF (iflag_rrtm.EQ.1) THEN
-#ifdef CPP_RRTM
-             IF (ok_cdnc.AND.NRADLP.NE.3) THEN
-             abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 ' &
-                  // 'pour ok_cdnc' 
-             CALL abort_physic(modname,abort_message,1)
-             ENDIF
-#else
-
-             abort_message='You should compile with -rrtm if running with '//'iflag_rrtm=1'
-             CALL abort_physic(modname,abort_message,1)
-#endif
-          ENDIF
-          CALL newmicro (flag_aerosol, ok_cdnc, bl95_b0, bl95_b1, &
+       !Rajout appel a interface calcul proprietes optiques des nuages
+       CALL call_cloud_optics_prop(klon, klev, ok_newmicro, &
                paprs, pplay, t_seri, radocond, picefra, cldfra, &
                cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, &
-               flwp, fiwp, flwc, fiwc, &
+               flwp, fiwp, flwc, fiwc, ok_aie, &
                mass_solu_aero, mass_solu_aero_pi, &
-               cldtaupi, latitude_deg, re, fl, ref_liq, ref_ice, &
-               ref_liq_pi, ref_ice_pi)
-       ELSE
-          CALL nuage (paprs, pplay, &
-               t_seri, radocond, picefra, cldfra, cldtau, cldemi, &
-               cldh, cldl, cldm, cldt, cldq, &
-               ok_aie, &
-               mass_solu_aero, mass_solu_aero_pi, &
-               bl95_b0, bl95_b1, &
-               cldtaupi, re, fl)
-       ENDIF
+               cldtaupi, distcltop, temp_cltop, re, fl, ref_liq, ref_ice, &
+               ref_liq_pi, ref_ice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, &
+               reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  & 
+               zfice, dNovrN, ptconv, rnebcon, clwcon)
+
        !
        !IM betaCRF
@@ -4405,16 +4614,16 @@
           cool = cool + betalwoff * (cool0 - cool)
  
-#ifndef CPP_XIOS
-          !
-          !IM 2eme calcul radiatif pour le cas perturbe ou au moins un
-          !IM des taux doit etre different du taux actuel
-          !IM Par defaut on a les taux perturbes egaux aux taux actuels
-          !
-          IF (RCO2_per.NE.RCO2_act.OR. &
-              RCH4_per.NE.RCH4_act.OR. &
-              RN2O_per.NE.RN2O_act.OR. &
-              RCFC11_per.NE.RCFC11_act.OR. &
-              RCFC12_per.NE.RCFC12_act) ok_4xCO2atm =.TRUE. 
-#endif
+          IF (.NOT. using_xios) THEN
+            !
+            !IM 2eme calcul radiatif pour le cas perturbe ou au moins un
+            !IM des taux doit etre different du taux actuel
+            !IM Par defaut on a les taux perturbes egaux aux taux actuels
+            !
+            IF (RCO2_per.NE.RCO2_act.OR. &
+                RCH4_per.NE.RCH4_act.OR. &
+                RN2O_per.NE.RN2O_act.OR. &
+                RCFC11_per.NE.RCFC11_act.OR. &
+                RCFC12_per.NE.RCFC12_act) ok_4xCO2atm =.TRUE. 
+          ENDIF
    ! 
           IF (ok_4xCO2atm) THEN
@@ -4472,6 +4681,9 @@
 ! A.I aout 2023
 ! Effet 3D des nuages Ecrad
+! a passer : nom du ficher namelist et cles ok_3Deffect
+! a declarer comme iflag_rrtm et a lire dans physiq.def
 #ifdef CPP_ECRAD
           IF (ok_3Deffect) then
+!                print*,'ok_3Deffect = ',ok_3Deffect  
                 namelist_ecrad_file='namelist_ecrad_s2'
                 CALL radlwsw &
@@ -4488,4 +4700,5 @@
                      zqsat, flwc, fiwc, &
                      ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
+! A modifier              
                      heat_s2,heat0_s2,cool_s2,cool0_s2,albpla_s2, &
                      heat_volc,cool_volc, &
@@ -4508,8 +4721,8 @@
                      ZLWFT0_i, ZFLDN0, ZFLUP0, &
                      ZSWFT0_i, ZFSDN0, ZFSUP0)
-                namelist_ecrad_file='namelist_ecrad'
+             namelist_ecrad_file='namelist_ecrad'
           ENDIF ! ok_3Deffect
-#endif                  
-          
+#endif
+
        ENDIF ! aerosol_couple
        itaprad = 0
@@ -4566,7 +4779,7 @@
     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)
 
@@ -4643,5 +4856,5 @@
        !-----------------------------------------------------------------------
        ! 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)
@@ -4694,5 +4907,5 @@
 
        ! 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)
@@ -4719,5 +4932,5 @@
        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
@@ -4737,5 +4950,5 @@
        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)
@@ -4746,5 +4959,5 @@
             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)
@@ -4795,8 +5008,14 @@
     !DC Calcul de la tendance due au methane
     IF (ok_qch4) THEN
+!      d_q_ch4: H2O source in ppmv/sec
+#ifdef CPP_StratAer
+       CALL stratH2O_methox(debut,paprs,d_q_ch4)
+#else
+!      ecmwf routine METHOX
        CALL METHOX(1,klon,klon,klev,q_seri,d_q_ch4,pplay)
+#endif
        ! 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
@@ -4804,4 +5023,48 @@
     !
     !
+#ifdef CPP_StratAer
+    IF (ok_qemiss) THEN
+       flh2o=1
+       IF(flag_verbose_strataer) THEN
+          print *,'IN physiq_mod: ok_qemiss =yes (',ok_qemiss,'), flh2o=',flh2o
+          print *,'IN physiq_mod: flag_emit=',flag_emit,', nErupt=',nErupt
+          print *,'IN physiq_mod: nAerErupt=',nAerErupt
+       ENDIF
+       
+       SELECT CASE(flag_emit)
+       CASE(1) ! emission volc H2O dans LMDZ
+          DO ieru=1, nErupt
+             IF (year_cur==year_emit_vol(ieru).AND.&
+                  mth_cur==mth_emit_vol(ieru).AND.&
+                  day_cur>=day_emit_vol(ieru).AND.&
+                  day_cur<(day_emit_vol(ieru)+injdur)) THEN
+                
+                IF(flag_verbose_strataer) print *,'IN physiq_mod: date=',year_cur,mth_cur,day_cur
+                ! initialisation tendance q emission
+                d_q_emiss(:,:)=0.
+                ! daily injection mass emission - NL
+                m_H2O_emiss_vol_daily = m_H2O_emiss_vol(ieru)/(REAL(injdur)&
+                     *REAL(ponde_lonlat_vol(ieru)))
+                !
+                CALL STRATEMIT(pdtphys,pdtphys,latitude_deg,longitude_deg,t_seri,&
+                    pplay,paprs,tr_seri,&
+                    m_H2O_emiss_vol_daily,&
+                    xlat_min_vol(ieru),xlat_max_vol(ieru),&
+                    xlon_min_vol(ieru),xlon_max_vol(ieru),&
+                    altemiss_vol(ieru),sigma_alt_vol(ieru),1,1.,&
+                    nAerErupt+1,0)
+                
+                IF(flag_verbose_strataer) print *,'IN physiq_mod: min max d_q_emiss=',&
+                     minval(d_q_emiss),maxval(d_q_emiss)
+                
+                CALL add_phys_tend(du0, dv0, dt0, d_q_emiss, dql0, dqi0, dqbs0, paprs, &
+                     'q_emiss',abortphy,flag_inhib_tend,itap,0)
+                IF (abortphy==1) Print*,'ERROR ABORT TEND EMISS'
+             ENDIF
+          ENDDO
+          flh2o=0
+       END SELECT ! emission scenario (flag_emit)
+    ENDIF
+#endif
 
 !===============================================================
@@ -5103,5 +5366,5 @@
 
      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'
@@ -5180,11 +5443,14 @@
     !   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
     !
@@ -5245,7 +5511,12 @@
           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
@@ -5275,4 +5546,18 @@
       qql2(:)=qql2(:)+(q_seri(:,k)+ql_seri(:,k)+qs_seri(:,k))*zmasse(:,k)
     ENDDO
+
+#ifdef CPP_StratAer
+    IF (ok_qemiss) THEN
+       DO k = 1, klev
+          qql1(:) = qql1(:)+d_q_emiss(:,k)*zmasse(:,k)
+       ENDDO
+    ENDIF
+#endif
+    IF (ok_qch4) THEN
+       DO k = 1, klev
+          qql1(:) = qql1(:)+d_q_ch4_dtime(:,k)*zmasse(:,k)
+       ENDDO
+    ENDIF
+    
     DO i = 1, klon
       !--compute ratio of what q+ql should be with conservation to what it is
@@ -5294,8 +5579,10 @@
     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(:,:,:)
@@ -5422,15 +5709,19 @@
     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,           &
-         flag_aerosol, flag_aerosol_strat, ok_cdnc)
+         flag_aerosol, flag_aerosol_strat, ok_cdnc,t, u1, v1)
 #endif
 
 #ifndef CPP_XIOS
-    CALL write_paramLMDZ_phy(itap,nid_ctesGCM,ok_sync)
+      CALL write_paramLMDZ_phy(itap,nid_ctesGCM,ok_sync)
 #endif
 
 #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
 
     !====================================================================
@@ -5453,4 +5744,5 @@
     ! Disabling calls to the prt_alerte function
     alert_first_call = .FALSE.
+
     
     IF (lafin) THEN
@@ -5470,16 +5762,16 @@
        
        ENDIF
-#ifdef CPP_XIOS
-       IF (is_omp_master) CALL xios_context_finalize
+
+       IF (using_xios) THEN
+         IF (is_omp_master) CALL xios_context_finalize
 
 #ifdef INCA
-       if (type_trac == 'inca') then 
-          IF (is_omp_master .and. grid_type==unstructured) THEN 
-             CALL finalize_inca
-          ENDIF
-       endif
+         if (type_trac == 'inca') then 
+            IF (is_omp_master .and. grid_type==unstructured) THEN 
+               CALL finalize_inca
+            ENDIF
+         endif
 #endif
-
-#endif
+       ENDIF 
        WRITE(lunout,*) ' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
     ENDIF
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/physiqex_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/physiqex_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/physiqex_mod.F90	(revision 4727)
@@ -0,0 +1,141 @@
+! $Id: physiq.F 1565 2011-08-31 12:53:29Z jghattas $
+MODULE physiqex_mod
+
+IMPLICIT NONE
+
+CONTAINS
+
+      SUBROUTINE 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)
+
+      USE dimphy, only : klon,klev
+      USE infotrac_phy, only : nqtot
+      USE geometry_mod, only : latitude
+!      USE comcstphy, only : rg
+      USE ioipsl, only : ymds2ju
+      USE phys_state_var_mod, only : phys_state_var_init
+      USE phyetat0_mod, only: phyetat0
+      USE output_physiqex_mod, ONLY: output_physiqex
+
+      IMPLICIT none
+!
+! Routine argument:
+!
+
+      integer,intent(in) :: nlon ! number of atmospheric colums
+      integer,intent(in) :: nlev ! number of vertical levels (should be =klev)
+      logical,intent(in) :: debut ! signals first call to physics
+      logical,intent(in) :: lafin ! signals last call to physics
+      real,intent(in) :: pdtphys ! physics time step (s)
+      real,intent(in) :: paprs(klon,klev+1) ! interlayer pressure (Pa)
+      real,intent(in) :: pplay(klon,klev) ! mid-layer pressure (Pa)
+      real,intent(in) :: pphi(klon,klev) ! geopotential at mid-layer
+      real,intent(in) :: pphis(klon) ! surface geopotential
+      real,intent(in) :: presnivs(klev) ! pseudo-pressure (Pa) of mid-layers
+      real,intent(in) :: u(klon,klev) ! eastward zonal wind (m/s)
+      real,intent(in) :: v(klon,klev) ! northward meridional wind (m/s)
+      real,intent(in) :: rot(klon,klev) ! northward meridional wind (m/s)
+      real,intent(in) :: t(klon,klev) ! temperature (K)
+      real,intent(in) :: qx(klon,klev,nqtot) ! tracers (.../kg_air)
+      real,intent(in) :: flxmass_w(klon,klev) ! vertical mass flux
+      real,intent(out) :: d_u(klon,klev) ! physics tendency on u (m/s/s)
+      real,intent(out) :: d_v(klon,klev) ! physics tendency on v (m/s/s)
+      real,intent(out) :: d_t(klon,klev) ! physics tendency on t (K/s)
+      real,intent(out) :: d_qx(klon,klev,nqtot) ! physics tendency on tracers
+      real,intent(out) :: d_ps(klon) ! physics tendency on surface pressure
+
+!    include "clesphys.h"
+    INTEGER        length
+    PARAMETER    ( length = 100 )
+    REAL tabcntr0( length       )
+    INTEGER, PARAMETER :: longcles=20
+    REAL, SAVE :: clesphy0(longcles)
+    !$OMP THREADPRIVATE(clesphy0)
+
+
+real :: temp_newton(klon,klev)
+integer :: k
+logical, save :: first=.true.
+!$OMP THREADPRIVATE(first)
+
+real,save :: rg=9.81
+!$OMP THREADPRIVATE(rg)
+
+! For I/Os
+integer :: itau0
+real :: zjulian
+
+
+!------------------------------------------------------------
+! Initialisations de la physique au premier pas de temps
+!------------------------------------------------------------
+
+print*,'Debut physiqex',debut
+! initializations
+if (debut) then ! Things to do only for the first call to physics 
+print*,'Debut physiqex IN'
+
+! load initial conditions for physics (including the grid)
+  call phys_state_var_init(1) ! some initializations, required before calling phyetat0
+  call phyetat0("startphy.nc", clesphy0, tabcntr0)
+
+! Initialize outputs:
+  itau0=0
+  ! compute zjulian for annee0=1979 and month=1 dayref=1 and hour=0.0
+  !CALL ymds2ju(annee0, month, dayref, hour, zjulian)
+  call ymds2ju(1979, 1, 1, 0.0, zjulian)
+
+#ifndef CPP_IOIPSL_NO_OUTPUT
+  ! Initialize IOIPSL output file
+#endif
+
+endif ! of if (debut)
+
+!------------------------------------------------------------
+! Initialisations a chaque pas de temps
+!------------------------------------------------------------
+
+
+! set all tendencies to zero
+d_u(1:klon,1:klev)=0.
+d_v(1:klon,1:klev)=0.
+d_t(1:klon,1:klev)=0.
+d_qx(1:klon,1:klev,1:nqtot)=0.
+d_ps(1:klon)=0.
+
+!------------------------------------------------------------
+! Calculs
+!------------------------------------------------------------
+
+! compute tendencies to return to the dynamics:
+! "friction" on the first layer
+d_u(1:klon,1)=-u(1:klon,1)/86400.
+d_v(1:klon,1)=-v(1:klon,1)/86400.
+! newtonian relaxation towards temp_newton()
+do k=1,klev
+  temp_newton(1:klon,k)=280.+cos(latitude(1:klon))*40.-pphi(1:klon,k)/rg*6.e-3
+  d_t(1:klon,k)=(temp_newton(1:klon,k)-t(1:klon,k))/1.e5
+enddo
+
+
+!------------------------------------------------------------
+! Entrees sorties
+!------------------------------------------------------------
+
+
+call output_physiqex(debut,zjulian,pdtphys,presnivs,paprs,u,v,t,qx,0.*t,0.*t,0.*t,0.*t,0.*t,0.*t)
+
+
+! if lastcall, then it is time to write "restartphy.nc" file
+if (lafin) then
+  call phyredem("restartphy.nc")
+endif
+
+
+end subroutine physiqex
+
+END MODULE physiqex_mod
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phytrac_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phytrac_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/phytrac_mod.F90	(revision 4727)
@@ -42,7 +42,7 @@
   REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_lessi_impa ! Td du lessivage par impaction
   REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_lessi_nucl ! Td du lessivage par nucleation
-  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE      :: qPrls      !jyg: concentration tra dans pluie LS a la surf.
-  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE      :: d_tr_dry ! Td depot sec/traceur (1st layer),ALLOCATABLE,SAVE  jyg
-  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE      :: flux_tr_dry ! depot sec/traceur (surface),ALLOCATABLE,SAVE    jyg
+  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE   :: qPrls      !jyg: concentration tra dans pluie LS a la surf.
+  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE   :: d_tr_dry ! Td depot sec/traceur (1st layer),ALLOCATABLE,SAVE  jyg
+  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE   :: flux_tr_dry ! depot sec/traceur (surface),ALLOCATABLE,SAVE    jyg
 
 !$OMP THREADPRIVATE(qPa,qMel,qTrdi,dtrcvMA,d_tr_th,d_tr_lessi_impa,d_tr_lessi_nucl)
@@ -51,26 +51,25 @@
 !$OMP THREADPRIVATE(d_tr_cl,d_tr_dry,flux_tr_dry,d_tr_dec,d_tr_cv)
 
-
 CONTAINS
 
   SUBROUTINE phytrac_init()
+
     USE dimphy
     USE infotrac_phy, ONLY: nbtr, type_trac
     USE tracco2i_mod, ONLY: tracco2i_init
+    
     IMPLICIT NONE
 
-       ALLOCATE(d_tr_cl(klon,klev,nbtr),d_tr_dry(klon,nbtr))
-       ALLOCATE(flux_tr_dry(klon,nbtr),d_tr_dec(klon,klev,nbtr),d_tr_cv(klon,klev,nbtr))
-       ALLOCATE(d_tr_insc(klon,klev,nbtr),d_tr_bcscav(klon,klev,nbtr))
-       ALLOCATE(d_tr_evapls(klon,klev,nbtr),d_tr_ls(klon,klev,nbtr))
-       ALLOCATE(qPrls(klon,nbtr),d_tr_trsp(klon,klev,nbtr))
-       ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr))
-       ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr),qDi(klon,klev,nbtr))
-       ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr))
-       ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr))
-       ALLOCATE(d_tr_th(klon,klev,nbtr))
-       ALLOCATE(d_tr_lessi_impa(klon,klev,nbtr),d_tr_lessi_nucl(klon,klev,nbtr))
-
-
+    ALLOCATE(d_tr_cl(klon,klev,nbtr),d_tr_dry(klon,nbtr))
+    ALLOCATE(flux_tr_dry(klon,nbtr),d_tr_dec(klon,klev,nbtr),d_tr_cv(klon,klev,nbtr))
+    ALLOCATE(d_tr_insc(klon,klev,nbtr),d_tr_bcscav(klon,klev,nbtr))
+    ALLOCATE(d_tr_evapls(klon,klev,nbtr),d_tr_ls(klon,klev,nbtr))
+    ALLOCATE(qPrls(klon,nbtr),d_tr_trsp(klon,klev,nbtr))
+    ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr))
+    ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr),qDi(klon,klev,nbtr))
+    ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr))
+    ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr))
+    ALLOCATE(d_tr_th(klon,klev,nbtr))
+    ALLOCATE(d_tr_lessi_impa(klon,klev,nbtr),d_tr_lessi_nucl(klon,klev,nbtr))
 
     !===============================================================================
@@ -79,5 +78,5 @@
     !===============================================================================
     !   -- CO2 interactif --
-    IF(ANY(type_trac == ['co2i','inco'])) CALL tracco2i_init()
+    IF (ANY(type_trac == ['co2i','inco'])) CALL tracco2i_init()
 
        !   -- type_trac == 'co2i' ! PC 
@@ -136,4 +135,5 @@
     USE print_control_mod, ONLY: lunout
     USE aero_mod, ONLY : naero_grp
+    USE lmdz_thermcell_dq, ONLY : thermcell_dq
 
     USE tracco2i_mod
@@ -147,4 +147,5 @@
     USE phys_local_var_mod, ONLY: budg_dep_dry_part,  budg_dep_wet_part
     USE infotrac_phy, ONLY: nbtr_sulgas, id_OCS_strat, id_SO2_strat, id_H2SO4_strat
+    USE strataer_nuc_mod, ONLY : tracstrataer_init
     USE aerophys
 #endif
@@ -242,5 +243,4 @@
     REAL,DIMENSION(klon,klev),INTENT(IN)      :: clw
     ! RomP <<<
-
     !
     REAL,DIMENSION(klon,klev),INTENT(IN)     :: mp
@@ -251,5 +251,5 @@
     !----------
     REAL,DIMENSION(klon,klev+1),INTENT(IN)   :: fm_therm
-    REAL,DIMENSION(klon,klev),INTENT(IN)     :: entr_therm
+    REAL,DIMENSION(klon,klev),INTENT(INOUT)     :: entr_therm
     !
     !Couche limite:
@@ -374,6 +374,6 @@
           zrho(i,k)=0.
           zdz(i,k)=0.
-       END DO
-    END DO
+       ENDDO
+    ENDDO
 
     DO it=1, nbtr
@@ -401,7 +401,7 @@
              zmfdam(i,k,it)=0.
              zmfphi2(i,k,it)=0.
-          END DO
-       END DO
-    END DO
+          ENDDO
+       ENDDO
+    ENDDO
 
     DO it=1, nbtr
@@ -409,12 +409,12 @@
           d_tr_dry(i,it)=0.
           flux_tr_dry(i,it)=0.
-       END DO
-    END DO
+       ENDDO
+    ENDDO
 
     DO k = 1, klev
        DO i = 1, klon
           delp(i,k) = paprs(i,k)-paprs(i,k+1)
-       END DO
-    END DO
+       ENDDO
+    ENDDO
 
     IF (debutphy) THEN
@@ -491,10 +491,10 @@
 
        ! Initialize module for specific tracers
-       IF(type_trac == 'inca') THEN
+       IF (type_trac == 'inca') THEN
           source(:,:)=init_source(:,:)
           CALL tracinca_init(aerosol,lessivage)
-       ELSE IF(type_trac == 'repr') THEN
+       ELSE IF (type_trac == 'repr') THEN
           source(:,:)=0.
-       ELSE IF(type_trac == 'co2i') THEN
+       ELSE IF (type_trac == 'co2i') THEN
           source(:,:)=0.
           lessivage  = .FALSE.
@@ -504,5 +504,5 @@
           iflag_vdf_trac= 1
           iflag_con_trac= 1
-       ELSE IF(type_trac == 'inco') THEN
+       ELSE IF (type_trac == 'inco') THEN
           source(:,1:nqCO2) = 0.                          ! from CO2i ModThL
           source(:,nqCO2+1:nbtr)=init_source(:,:)         ! from INCA ModThL
@@ -514,17 +514,11 @@
           iflag_con_trac = 1                              ! From CO2i
 #ifdef CPP_StratAer
-       ELSE IF(type_trac == 'coag') THEN
+       ELSE IF (type_trac == 'coag') THEN
           source(:,:)=0.
-          DO it= 1, nbtr_sulgas
-            aerosol(it)=.FALSE.
-            IF (it==id_H2SO4_strat) aerosol(it)=.TRUE.
-          ENDDO
-          DO it= nbtr_sulgas+1, nbtr
-            aerosol(it)=.TRUE.
-          ENDDO
+          CALL tracstrataer_init(aerosol,lessivage)       ! init aerosols and lessivage param
 #endif
-       ELSE IF(type_trac == 'lmdz') THEN
+       ELSE IF (type_trac == 'lmdz') THEN
           CALL traclmdz_init(pctsrf,xlat,xlon,ftsol,tr_seri,t_seri,pplay,sh,pdtphys,aerosol,lessivage)
-       END IF
+       ENDIF
 
        !
@@ -539,7 +533,7 @@
           !
           DO it=1, nbtr
-             IF(type_trac == 'repr') THEN
+             IF (type_trac == 'repr') THEN
                  flag_cvltr(it)=.FALSE.
-             ELSE IF(type_trac == 'inca') THEN
+             ELSE IF (type_trac == 'inca') THEN
 !                IF ((it.EQ.id_Rn222) .OR. ((it.GE.id_SO2) .AND. (it.LE.id_NH3)) ) THEN 
 !                   !--gas-phase species
@@ -565,11 +559,11 @@
                 !--for now we do not scavenge in cvltr
                 flag_cvltr(it)=.FALSE.
-             ELSE IF(type_trac == 'co2i') THEN
+             ELSE IF (type_trac == 'co2i') THEN
                 !--co2 tracers are not scavenged
                 flag_cvltr(it)=.FALSE.
-             ELSE IF(type_trac == 'inco') THEN     ! Add ThL
+             ELSE IF (type_trac == 'inco') THEN     ! Add ThL
                 flag_cvltr(it)=.FALSE.
 #ifdef CPP_StratAer
-             ELSE IF(type_trac == 'coag') THEN
+             ELSE IF (type_trac == 'coag') THEN
                 IF (convscav.and.aerosol(it)) THEN
                    flag_cvltr(it)=.TRUE.
@@ -581,5 +575,5 @@
                 ENDIF
 #endif
-             ELSE IF(type_trac == 'lmdz') THEN
+             ELSE IF (type_trac == 'lmdz') THEN
                 IF (convscav.and.aerosol(it)) THEN
                    flag_cvltr(it)=.TRUE.
@@ -590,5 +584,5 @@
                    flag_cvltr(it)=.FALSE.
                 ENDIF
-             END IF
+             ENDIF
           ENDDO
           !
@@ -623,6 +617,6 @@
        DO i=1,klon
           zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/rg
-       END DO
-    END DO
+       ENDDO
+    ENDDO
     !
     IF (id_be .GT. 0) THEN
@@ -630,6 +624,6 @@
           DO i=1,klon
              sourceBE(i,k)=srcbe(i,k)       !RomP  -> pour sortie histrac
-          END DO
-       END DO
+          ENDDO
+       ENDDO
     ENDIF
 
@@ -638,10 +632,10 @@
     !      
     !===============================================================================
-    IF(type_trac == 'inca') THEN
+    IF (type_trac == 'inca') THEN
        !    -- CHIMIE INCA  config_inca = aero or chem --
        ! Appel fait en fin de phytrac pour avoir les emissions modifiees par 
        ! la couche limite et la convection avant le calcul de la chimie 
 
-    ELSE IF(type_trac == 'repr') THEN
+    ELSE IF (type_trac == 'repr') THEN
        !   -- CHIMIE REPROBUS --
        CALL tracreprobus(pdtphys, gmtime, debutphy, julien, &
@@ -650,5 +644,5 @@
             tr_seri)
 
-    ELSE IF(type_trac == 'co2i') THEN
+    ELSE IF (type_trac == 'co2i') THEN
        !   -- CO2 interactif --
        !   -- source is updated with FF and BB emissions 
@@ -659,5 +653,5 @@
             xlat, xlon, pphis, pphi, &
             t_seri, pplay, paprs, tr_seri, source)
-    ELSE IF(type_trac == 'inco') THEN      ! Add ThL
+    ELSE IF (type_trac == 'inco') THEN      ! Add ThL
        CALL tracco2i(pdtphys, debutphy, &
             xlat, xlon, pphis, pphi, &
@@ -665,5 +659,5 @@
 
 #ifdef CPP_StratAer
-    ELSE IF(type_trac == 'coag') THEN
+    ELSE IF (type_trac == 'coag') THEN
        !   --STRATOSPHERIC AER IN THE STRAT --
        CALL traccoag(pdtphys, gmtime, debutphy, julien, &
@@ -672,5 +666,5 @@
             tr_seri)
 #endif
-    ELSE IF(type_trac == 'lmdz') THEN
+    ELSE IF (type_trac == 'lmdz') THEN
        !    -- Traitement des traceurs avec traclmdz
        CALL traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
@@ -678,5 +672,5 @@
             rh, pphi, ustar, wstar, ale_bl, ale_wake,  u10m, v10m, &
             tr_seri, source, d_tr_cl,d_tr_dec, zmasse)               !RomP
-    END IF
+    ENDIF
     !======================================================================
     !       -- Calcul de l'effet de la convection --
@@ -738,10 +732,10 @@
              DO i = 1, klon        
                 tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it)
-             END DO
-          END DO
+             ENDDO
+          ENDDO
 
           CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'convection it = '//TRIM(int2str(it)))
 
-       END DO ! nbtr
+       ENDDO ! nbtr
 
 #ifdef CPP_StratAer
@@ -795,7 +789,7 @@
 !             tr_seri(i,k,it)=MIN(tr_seri(i,k,it),1.e10)
 !#endif
-          END DO
-       END DO
-    END DO
+          ENDDO
+       ENDDO
+    ENDDO
 
     IF (iflag_thermals.GT.0.AND.iflag_the_trac>0) THEN   
@@ -811,8 +805,8 @@
                 d_tr_th(i,k,it)=pdtphys*d_tr_th(i,k,it)
                 tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr_th(i,k,it),0.)
-             END DO
-          END DO
-
-       END DO ! it
+             ENDDO
+          ENDDO
+
+       ENDDO ! it
 
     ENDIF ! Thermiques
@@ -854,5 +848,5 @@
        DO it=1, nbtr
           !
-          IF( pbl_flg(it) /= 0 ) THEN
+          IF (pbl_flg(it) /= 0) THEN
              !
              CALL cltrac(pdtphys, coefh,t_seri,       &
@@ -929,10 +923,6 @@
              ! Liu (2001) proposed to use 1.5e-3 kg/kg
 
-!jyg<
-!!             CALL lsc_scav(pdtphys,it,iflag_lscav,ql_incl,prfl,psfl,rneb,beta_fisrt,  &
              CALL lsc_scav(pdtphys,it,iflag_lscav,aerosol,ql_incl,prfl,psfl,rneb,beta_fisrt,  &
-!>jyg
-                  beta_v1,pplay,paprs,t_seri,tr_seri,d_tr_insc,   &
-                  d_tr_bcscav,d_tr_evapls,qPrls)
+                           beta_v1,pplay,paprs,t_seri,tr_seri,d_tr_insc,d_tr_bcscav,d_tr_evapls,qPrls)
 
              !large scale scavenging tendency
@@ -946,5 +936,5 @@
              ENDIF
 
-          END DO  !tr
+          ENDDO  !tr
 
 #ifdef CPP_StratAer
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/plevel.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/plevel.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/plevel.F90	(revision 4727)
@@ -12,7 +12,5 @@
   USE phys_state_var_mod, ONLY: missing_val_nf90 
 #endif
-#ifdef CPP_XIOS
-  USE wxios, ONLY: missing_val
-#endif
+  USE wxios, ONLY: missing_val_xios => missing_val, using_xios
   IMPLICIT NONE
 
@@ -60,13 +58,12 @@
 
 ! REAL missing_val
-#ifndef CPP_XIOS
   REAL :: missing_val
-#endif
 
 ! missing_val = nf90_fill_real
-
-#ifndef CPP_XIOS
-      missing_val=missing_val_nf90
-#endif
+  IF (using_xios) THEN
+    missing_val = missing_val_xios
+  ELSE
+    missing_val=missing_val_nf90
+  ENDIF
 
   IF (first) THEN
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/plevel_new.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/plevel_new.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/plevel_new.F90	(revision 4727)
@@ -13,7 +13,5 @@
   USE phys_state_var_mod, ONLY: missing_val_nf90
 #endif
-#ifdef CPP_XIOS
-  USE wxios, ONLY: missing_val
-#endif
+  USE wxios, ONLY: missing_val_xios=>missing_val, using_xios
 
   IMPLICIT NONE
@@ -62,14 +60,11 @@
   INTEGER i, k
 
-! REAL missing_val
-#ifndef CPP_XIOS
   REAL :: missing_val
-#endif
 
-! missing_val = nf90_fill_real
-
-#ifndef CPP_XIOS
-      missing_val=missing_val_nf90
-#endif
+  IF (using_xios) THEN
+    missing_val=missing_val_xios
+  ELSE
+    missing_val=missing_val_nf90
+  ENDIF
 
   IF (first) THEN
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/qsat_seawater.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/qsat_seawater.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/qsat_seawater.F90	(revision 4727)
@@ -0,0 +1,119 @@
+!-------------------------------------------------------------------------------
+!
+!     ######################################
+REAL      FUNCTION QSAT_SEAWATER(PT,PP) 
+!     ######################################
+!
+!!****  *QSATW * - function to compute saturation vapor humidity from
+!!                 temperature
+!!
+!!    PURPOSE
+!!    -------
+!       The purpose of this function is to compute the saturation vapor 
+!     pressure from temperature over saline seawater
+!      
+!
+!!**  METHOD
+!!    ------
+!!       Given temperature T (PT), the saturation vapor pressure es(T)
+!!    (FOES(PT)) is computed by integration of the Clapeyron equation
+!!    from the triple point temperature Tt (XTT) and the saturation vapor 
+!!    pressure of the triple point es(Tt) (XESTT), i.e  
+!!    The reduction due to salinity is compute with the factor 0.98 (reduction of 2%)
+!!     
+!!         es(T)= 0.98*EXP( alphaw - betaw /T - gammaw Log(T) )
+!!  
+!!     with :
+!!       alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt) 
+!!       betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!!       gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!!      Then, the specific humidity at saturation is deduced.
+!!  
+!!
+!!    EXTERNAL
+!!    --------
+!!      NONE
+!!
+!!    IMPLICIT ARGUMENTS
+!!    ------------------
+!!      Module MODD_CST : comtains physical constants
+!!        XALPW   : Constant for saturation vapor pressure function
+!!        XBETAW  : Constant for saturation vapor pressure function
+!!        XGAMW   : Constant for saturation vapor pressure function  
+!!      
+!!    REFERENCE
+!!    ---------
+!!      Book2 of documentation of Meso-NH 
+!!      Zeng, X., Zhao, M., and Dickinson, R. E., 1998 : Intercomparaison of bulk
+!!      aerodynamic algorithm for the computation of sea surface fluxes using
+!!      TOGA COARE and TAO data. Journal of Climate, vol 11, n°10, pp 2628--2644
+!!
+!!
+!!    AUTHOR
+!!    ------
+!!      C. Lebeaupin    * Meteo France *
+!!
+!!    MODIFICATIONS
+!!    -------------
+!!      Original    6/04/2005 
+!-------------------------------------------------------------------------------
+!
+!*       0.    DECLARATIONS
+!              ------------
+!
+USE MODD_CSTS
+USE dimphy
+USE indice_sol_mod
+!
+IMPLICIT NONE
+!
+!*       0.1   Declarations of arguments and results
+!
+!
+
+REAL, DIMENSION(klon), INTENT(IN)                :: PT     ! Temperature
+                                                        ! (Kelvin)
+REAL, DIMENSION(klon), INTENT(IN)                :: PP     ! Pressure
+                                                        ! (Pa)
+REAL, DIMENSION(SIZE(PT))                        :: PQSAT  ! saturation vapor 
+                                                        ! specific humidity
+                                                        ! with respect to
+                                                        ! water (kg/kg)
+
+!
+!*       0.2   Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT))                   :: ZFOES  ! saturation vapor 
+                                                        ! pressure
+                                                        ! (Pascal) 
+!
+REAL, DIMENSION(SIZE(PT))                   :: ZWORK1
+REAL                                        :: ZWORK2
+!REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+!IF (LHOOK) CALL DR_HOOK('MODE_THERMOS:QSATSEAW_1D',0,ZHOOK_HANDLE)
+!
+!ZFOES  = 1 !PSAT(PT(:))
+!ZFOES  = 0.98*ZFOES
+!ZFOES(:) = ZFOES(:)*1013.25E+02             !convert from atm to Pa
+ZFOES = 0.98*EXP( XALPW - XBETAW/PT - XGAMW*LOG(PT)  )
+! vapor pressure reduction of 2% over saline seawater could have a significant 
+! impact on the computation of surface latent heat flux under strong wind 
+! conditions (Zeng et al, 1998). 
+!
+ZWORK1 = ZFOES/PP
+ZWORK2    = XRD/XRV
+!
+!*       2.    COMPUTE SATURATION HUMIDITY
+!              ---------------------------
+!
+PQSAT = ZWORK2*ZWORK1 / (1.+(ZWORK2-1.)*ZWORK1)
+!
+!IF (LHOOK) CALL DR_HOOK('MODE_THERMOS:QSATSEAW_1D',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END FUNCTION QSAT_SEAWATER
+!
+!-------------------------------------------------------------------------------
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/qsat_seawater2.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/qsat_seawater2.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/qsat_seawater2.F90	(revision 4727)
@@ -0,0 +1,104 @@
+!-------------------------------------------------------------------------------
+!
+!     ######################################
+REAL      FUNCTION QSAT_SEAWATER2(PT,PP,PSSS) 
+!     ######################################
+!
+!!****  *QSATW * - function to compute saturation vapor humidity from
+!!                 temperature
+!!
+!!    PURPOSE
+!!    -------
+!       The purpose of this function is to compute the saturation vapor 
+!     pressure from temperature over saline seawater
+!      
+!
+!!**  METHOD
+!!    ------
+!!       Given temperature T (PT) and salinity S (PSSS), the saturation vapor 
+!!    pressure es(T,S) (FOES(PT,PSSS)) is computed following Weiss and Price
+!!    (1980).
+!!
+!!      Then, the specific humidity at saturation is deduced.
+!!  
+!!
+!!    EXTERNAL
+!!    --------
+!!      NONE
+!!
+!!    IMPLICIT ARGUMENTS
+!!    ------------------
+!!      Module MODD_CST : contains physical constants
+!!      
+!!    REFERENCE
+!!    ---------
+!!      Weiss, R.F., and Price, B.A., 1980 : Nitrous oxide solubility in water
+!!      and seawater. Marine Chemistry, n°8, pp 347-359.
+!!
+!!
+!!    AUTHOR
+!!    ------
+!!      S. Belamari     * Meteo France *
+!!
+!!    MODIFICATIONS
+!!    -------------
+!!      Original    19/03/2014 
+!-------------------------------------------------------------------------------
+!
+!*       0.    DECLARATIONS
+!              ------------
+!
+USE MODD_CSTS, ONLY : XRD, XRV
+USE dimphy
+USE indice_sol_mod
+!
+IMPLICIT NONE
+!
+!*       0.1   Declarations of arguments and results
+!
+!
+REAL, DIMENSION(klon), INTENT(IN)                :: PT     ! Temperature
+                                                        ! (Kelvin)
+REAL, DIMENSION(klon), INTENT(IN)                :: PP     ! Pressure
+                                                        ! (Pascal)
+REAL, DIMENSION(klon), INTENT(IN)                :: PSSS   ! Salinity
+                                                        ! (g/kg)
+REAL, DIMENSION(SIZE(PT))                   :: PQSATA  ! saturation vapor
+                                                        ! specific humidity
+                                                        ! with respect to
+                                                        ! water (kg/kg)
+!
+!*       0.2   Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT))                   :: ZFOES  ! saturation vapor
+                                                        ! pressure
+                                                        ! (Pascal)
+!
+REAL, DIMENSION(SIZE(PT))                   :: ZWORK1
+REAL                                        :: ZWORK2
+!REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+!IF (LHOOK) CALL DR_HOOK('MODE_THERMOS:QSATSEAW2_1D',0,ZHOOK_HANDLE)
+!
+!*       1.    COMPUTE SATURATION VAPOR PRESSURE
+!              ---------------------------------
+!
+ZFOES(:) = EXP( 24.4543 -67.4509*(100.0/PT(:)) -4.8489*LOG(PT(:)/100.0)   &
+                -5.44E-04*(PSSS(:)/1.00472) ) !see Sharqawy et al (2010) Eq32 p368
+ZFOES(:) = ZFOES(:)*1013.25E+02             !convert from atm to Pa
+!
+ZWORK1(:) = ZFOES(:)/PP(:)
+ZWORK2    = XRD/XRV
+!
+!*       2.    COMPUTE SATURATION SPECIFIC HUMIDITY
+!              ------------------------------------
+!
+PQSATA(:) = ZWORK2*ZWORK1(:) / (1.0+(ZWORK2-1.0)*ZWORK1(:))
+!
+!IF (LHOOK) CALL DR_HOOK('MODE_THERMOS:QSATSEAW2_1D',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END FUNCTION QSAT_SEAWATER2
+!
+!-------------------------------------------------------------------------------
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/qsatseaw_1D.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/qsatseaw_1D.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/qsatseaw_1D.F90	(revision 4727)
@@ -0,0 +1,113 @@
+!-------------------------------------------------------------------------------
+!
+!     ######################################
+REAL       FUNCTION QSATSEAW_1D(PT,PP) 
+!     ######################################
+!
+!!****  *QSATW * - function to compute saturation vapor humidity from
+!!                 temperature
+!!
+!!    PURPOSE
+!!    -------
+!       The purpose of this function is to compute the saturation vapor 
+!     pressure from temperature over saline seawater
+!      
+!
+!!**  METHOD
+!!    ------
+!!       Given temperature T (PT), the saturation vapor pressure es(T)
+!!    (FOES(PT)) is computed by integration of the Clapeyron equation
+!!    from the triple point temperature Tt (XTT) and the saturation vapor 
+!!    pressure of the triple point es(Tt) (XESTT), i.e  
+!!    The reduction due to salinity is compute with the factor 0.98 (reduction of 2%)
+!!     
+!!         es(T)= 0.98*EXP( alphaw - betaw /T - gammaw Log(T) )
+!!  
+!!     with :
+!!       alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt) 
+!!       betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!!       gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!!      Then, the specific humidity at saturation is deduced.
+!!  
+!!
+!!    EXTERNAL
+!!    --------
+!!      NONE
+!!
+!!    IMPLICIT ARGUMENTS
+!!    ------------------
+!!      Module MODD_CST : comtains physical constants
+!!        XALPW   : Constant for saturation vapor pressure function
+!!        XBETAW  : Constant for saturation vapor pressure function
+!!        XGAMW   : Constant for saturation vapor pressure function  
+!!      
+!!    REFERENCE
+!!    ---------
+!!      Book2 of documentation of Meso-NH 
+!!      Zeng, X., Zhao, M., and Dickinson, R. E., 1998 : Intercomparaison of bulk
+!!      aerodynamic algorithm for the computation of sea surface fluxes using
+!!      TOGA COARE and TAO data. Journal of Climate, vol 11, n�10, pp 2628--2644
+!!
+!!
+!!    AUTHOR
+!!    ------
+!!      C. Lebeaupin    * Meteo France *
+!!
+!!    MODIFICATIONS
+!!    -------------
+!!      Original    6/04/2005 
+!-------------------------------------------------------------------------------
+!
+!*       0.    DECLARATIONS
+!              ------------
+!
+USE MODD_CSTS
+USE dimphy
+USE indice_sol_mod
+
+IMPLICIT NONE
+
+!*       0.1   Declarations of arguments and results
+!
+!
+REAL, DIMENSION(klon), INTENT(IN)                :: PT     ! Temperature
+                                                        ! (Kelvin)
+REAL, DIMENSION(klon), INTENT(IN)                :: PP     ! Pressure
+                                                        ! (Pa)
+REAL, DIMENSION(SIZE(PT))                        :: PQSAT  ! saturation vapor 
+                                                        ! specific humidity
+                                                        ! with respect to
+                                                        ! water (kg/kg)
+!
+!*       0.2   Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT))                   :: ZFOES  ! saturation vapor 
+                                                        ! pressure
+                                                        ! (Pascal) 
+!
+INTEGER                         :: JJ   ! loop index
+!REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+!IF (LHOOK) CALL DR_HOOK('MODE_THERMOS:QSATSEAW_1D',0,ZHOOK_HANDLE)
+!DO JJ = 1, SIZE(PT)
+!*       1.    COMPUTE SATURATION VAPOR PRESSURE
+!              ---------------------------------
+!
+ZFOES = 0.98*EXP( XALPW - XBETAW/PT - XGAMW*LOG(PT)  )
+! vapor pressure reduction of 2% over saline seawater could have a significant 
+! impact on the computation of surface latent heat flux under strong wind 
+! conditions (Zeng et al, 1998). 
+!
+!*       2.    COMPUTE SATURATION HUMIDITY
+!              ---------------------------
+!
+PQSAT = XRD/XRV*ZFOES/PP /(1.+(XRD/XRV-1.)*ZFOES/PP)  
+!
+!ENDDO
+!IF (LHOOK) CALL DR_HOOK('MODE_THERMOS:QSATSEAW_1D',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END FUNCTION QSATSEAW_1D
+!------------------------------------
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/readaerosol_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/readaerosol_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/readaerosol_mod.F90	(revision 4727)
@@ -173,14 +173,14 @@
 
 
-  SUBROUTINE init_aero_fromfile(flag_aerosol)
+SUBROUTINE init_aero_fromfile(flag_aerosol, aerosol_couple)
   USE netcdf
   USE mod_phys_lmdz_para
   USE mod_grid_phy_lmdz, ONLY: grid_type, unstructured
-#ifdef CPP_XIOS
-  USE xios
-#endif
+  USE lmdz_xios
   IMPLICIT NONE
+
   INTEGER, INTENT(IN) :: flag_aerosol
-#ifdef CPP_XIOS
+  LOGICAL, INTENT(IN) :: aerosol_couple
+  
   REAL,ALLOCATABLE :: lat_src(:)
   REAL,ALLOCATABLE :: lon_src(:)
@@ -191,55 +191,56 @@
   REAL :: null_array(0)
 
-  IF (flag_aerosol>0 .AND. grid_type==unstructured) THEN
+  IF (using_xios) THEN
+    IF (flag_aerosol>0 .AND. grid_type==unstructured .AND. (.NOT. aerosol_couple) ) THEN
   
-    IF (is_omp_root) THEN
+      IF (is_omp_root) THEN
   
-      IF (is_mpi_root) THEN
+        IF (is_mpi_root) THEN
     
-        IF (nf90_open(TRIM(file_aerosol), NF90_NOWRITE, ncid) /= NF90_NOERR) THEN
-          CALL check_err( nf90_open(TRIM(file_so4), NF90_NOWRITE, ncid), "pb open "//trim(file_so4) )
+          IF (nf90_open(TRIM(file_aerosol), NF90_NOWRITE, ncid) /= NF90_NOERR) THEN
+            CALL check_err( nf90_open(TRIM(file_so4), NF90_NOWRITE, ncid), "pb open "//trim(file_so4) )
+          ENDIF
+
+          ! Read and test longitudes
+          CALL check_err( nf90_inq_dimid(ncid, "lon", dimID),"pb inq dim lon") 
+          CALL check_err( nf90_inquire_dimension(ncid, dimID, len = nbp_lon_src),"pb inq dim lon")
+          CALL check_err( nf90_inq_varid(ncid, 'lon', varid),"pb inq lon" )
+          ALLOCATE(lon_src(nbp_lon_src))
+          CALL check_err( nf90_get_var(ncid, varid, lon_src(:)),"pb get lon" )
+
+          ! Read and test latitudes
+          CALL check_err( nf90_inq_dimid(ncid, "lat", dimID),"pb inq dim lat") 
+          CALL check_err( nf90_inquire_dimension(ncid, dimID, len = nbp_lat_src),"pb inq dim lat")
+          CALL check_err( nf90_inq_varid(ncid, 'lat', varid),"pb inq lat" )
+          ALLOCATE(lat_src(nbp_lat_src))
+          CALL check_err( nf90_get_var(ncid, varid, lat_src(:)),"pb get lat" )
+          IF (nf90_inq_dimid(ncid, 'lev', dimid) /= NF90_NOERR) THEN
+            IF (nf90_inq_dimid(ncid, 'presnivs', dimid)/= NF90_NOERR) THEN
+               CALL check_err(nf90_inq_dimid(ncid, 'PRESNIVS', dimid),'dimension lev,PRESNIVS or presnivs not in file')
+            ENDIF
+          ENDIF
+          CALL check_err( nf90_inquire_dimension(ncid, dimid, len = klev_src),"pb inq dim for PRESNIVS or lev" )
+          CALL check_err( nf90_close(ncid),"pb in close" )   
         ENDIF
 
-        ! Read and test longitudes
-        CALL check_err( nf90_inq_dimid(ncid, "lon", dimID),"pb inq dim lon") 
-        CALL check_err( nf90_inquire_dimension(ncid, dimID, len = nbp_lon_src),"pb inq dim lon")
-        CALL check_err( nf90_inq_varid(ncid, 'lon', varid),"pb inq lon" )
-        ALLOCATE(lon_src(nbp_lon_src))
-        CALL check_err( nf90_get_var(ncid, varid, lon_src(:)),"pb get lon" )
-
-        ! Read and test latitudes
-        CALL check_err( nf90_inq_dimid(ncid, "lat", dimID),"pb inq dim lat") 
-        CALL check_err( nf90_inquire_dimension(ncid, dimID, len = nbp_lat_src),"pb inq dim lat")
-        CALL check_err( nf90_inq_varid(ncid, 'lat', varid),"pb inq lat" )
-        ALLOCATE(lat_src(nbp_lat_src))
-        CALL check_err( nf90_get_var(ncid, varid, lat_src(:)),"pb get lat" )
-        IF (nf90_inq_dimid(ncid, 'lev', dimid) /= NF90_NOERR) THEN
-          IF (nf90_inq_dimid(ncid, 'presnivs', dimid)/= NF90_NOERR) THEN
-             CALL check_err(nf90_inq_dimid(ncid, 'PRESNIVS', dimid),'dimension lev,PRESNIVS or presnivs not in file')
-          ENDIF
+        CALL bcast_mpi(nbp_lat_src)
+        CALL bcast_mpi(nbp_lon_src)
+        CALL bcast_mpi(klev_src)
+
+        IF (is_mpi_root ) THEN
+          CALL xios_set_domain_attr("domain_aerosol",nj_glo=nbp_lat_src, nj=nbp_lat_src, jbegin=0, latvalue_1d=lat_src)
+          CALL xios_set_domain_attr("domain_aerosol",ni_glo=nbp_lon_src, ni=nbp_lon_src, ibegin=0, lonvalue_1d=lon_src)
+        ELSE
+          CALL xios_set_domain_attr("domain_aerosol",nj_glo=nbp_lat_src, nj=0, jbegin=0, latvalue_1d=null_array )
+          CALL xios_set_domain_attr("domain_aerosol",ni_glo=nbp_lon_src, ni=0, ibegin=0, lonvalue_1d=null_array)
         ENDIF
-        CALL check_err( nf90_inquire_dimension(ncid, dimid, len = klev_src),"pb inq dim for PRESNIVS or lev" )
-        CALL check_err( nf90_close(ncid),"pb in close" )   
+        CALL xios_set_axis_attr("axis_aerosol",n_glo=klev_src)
+        CALL xios_set_fieldgroup_attr("aerosols", enabled=.TRUE.)
+  
       ENDIF
-
-      CALL bcast_mpi(nbp_lat_src)
-      CALL bcast_mpi(nbp_lon_src)
-      CALL bcast_mpi(klev_src)
-
-      IF (is_mpi_root ) THEN
-        CALL xios_set_domain_attr("domain_aerosol",nj_glo=nbp_lat_src, nj=nbp_lat_src, jbegin=0, latvalue_1d=lat_src)
-        CALL xios_set_domain_attr("domain_aerosol",ni_glo=nbp_lon_src, ni=nbp_lon_src, ibegin=0, lonvalue_1d=lon_src)
-      ELSE
-        CALL xios_set_domain_attr("domain_aerosol",nj_glo=nbp_lat_src, nj=0, jbegin=0, latvalue_1d=null_array )
-        CALL xios_set_domain_attr("domain_aerosol",ni_glo=nbp_lon_src, ni=0, ibegin=0, lonvalue_1d=null_array)
-      ENDIF
-      CALL xios_set_axis_attr("axis_aerosol",n_glo=klev_src)
-      CALL xios_set_fieldgroup_attr("aerosols", enabled=.TRUE.)
-  
-    ENDIF
     
-  ENDIF    
-#endif 
-  END SUBROUTINE init_aero_fromfile
+    ENDIF    
+  ENDIF !using_xios 
+END SUBROUTINE init_aero_fromfile
 
 
@@ -271,7 +272,5 @@
     USE iophy, ONLY : io_lon, io_lat
     USE print_control_mod, ONLY: lunout
-#ifdef CPP_XIOS
-    USE xios
-#endif
+    USE lmdz_xios
     IMPLICIT NONE
       
@@ -685,5 +684,4 @@
 
     IF (grid_type==unstructured) THEN
-#ifdef CPP_XIOS
       IF (is_omp_master) THEN
         CALL xios_send_field(TRIM(varname)//"_in",varyear)
@@ -702,5 +700,4 @@
       CALL scatter_omp(psurf_interp,psurf_out)
       first=.FALSE.
-#endif
     ELSE
       ! Scatter global field to local domain at local process
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/readaerosolstrato.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/readaerosolstrato.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/readaerosolstrato.F90	(revision 4727)
@@ -16,7 +16,5 @@
     USE dimphy
     USE print_control_mod, ONLY: prt_level,lunout
-#ifdef CPP_XIOS
-    USE xios
-#endif
+    USE lmdz_xios
     implicit none
 
@@ -148,5 +146,4 @@
 
     IF (grid_type==unstructured) THEN
-#ifdef CPP_XIOS
       IF (is_omp_master) THEN
         CALL xios_send_field("taustrat_in",tauaerstrat_mois)
@@ -157,5 +154,4 @@
       ENDIF
       CALL scatter_omp(tau_aer_strat_mpi,tau_aer_strat)
-#endif
     ELSE  
 !--scatter on all proc
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/readaerosolstrato_m.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/readaerosolstrato_m.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/readaerosolstrato_m.F90	(revision 4727)
@@ -23,11 +23,10 @@
 
 
-  SUBROUTINE init_readaerosolstrato1
-#ifdef CPP_XIOS
+SUBROUTINE init_readaerosolstrato1
   USE netcdf
   USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, & 
                       nf95_inq_varid, nf95_open
   USE mod_phys_lmdz_para
-  USE xios
+  USE lmdz_xios
 !  USE YOERAD, ONLY : NLW
   IMPLICIT NONE
@@ -38,4 +37,5 @@
   INTEGER :: ncid_in, varid
   
+  IF (using_xios) THEN
     IF (is_omp_master) THEN  
       IF (is_mpi_root) THEN
@@ -63,14 +63,13 @@
     ENDIF
     
-#endif
-  END SUBROUTINE init_readaerosolstrato1
+  ENDIF
+END SUBROUTINE init_readaerosolstrato1
   
-  SUBROUTINE init_readaerosolstrato2
-#ifdef CPP_XIOS
+SUBROUTINE init_readaerosolstrato2
   USE netcdf
   USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, & 
                       nf95_inq_varid, nf95_open
   USE mod_phys_lmdz_para
-  USE xios
+  USE lmdz_xios
 !  USE YOERAD, ONLY : NLW
   IMPLICIT NONE
@@ -80,5 +79,6 @@
   REAL    :: null_array(0)
   INTEGER :: ncid_in, varid
-
+  
+  IF (using_xios) THEN
     IF (is_omp_master) THEN    
       IF (is_mpi_root) THEN
@@ -131,6 +131,6 @@
 
     ENDIF
-#endif    
-  END SUBROUTINE init_readaerosolstrato2
+  ENDIF    
+END SUBROUTINE init_readaerosolstrato2
   
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/regr_horiz_time_climoz_m.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/regr_horiz_time_climoz_m.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/regr_horiz_time_climoz_m.F90	(revision 4727)
@@ -66,7 +66,5 @@
   USE regular_lonlat_mod, ONLY: boundslon_reg, boundslat_reg, south, west, east
   USE slopes_m,           ONLY: slopes
-#ifdef CPP_XIOS
-  USE xios
-#endif
+  USE lmdz_xios
   USE mod_phys_lmdz_para, ONLY: is_mpi_root, is_master, is_omp_master, gather, gather_mpi, bcast_mpi, klon_mpi
   USE geometry_mod, ONLY : latitude_deg, ind_cell_glo
@@ -240,5 +238,4 @@
       CALL bcast_mpi(ntim_ou)
 
-#ifdef CPP_XIOS    
       IF (is_mpi_root) THEN
         CALL xios_set_domain_attr("domain_climoz",nj_glo=nlat_in, nj=nlat_in, jbegin=0, latvalue_1d=lat_in/deg2rad)
@@ -262,5 +259,4 @@
       CALL  xios_set_field_attr("tro3_out", enabled=.TRUE.)
       CALL  xios_set_field_attr("tro3_out", enabled=.TRUE.)
-#endif
       
       IF (first) THEN
@@ -415,5 +411,4 @@
     !=============================================================================
      IF (grid_type==unstructured) THEN
-#ifdef CPP_XIOS
        nlat_ou=klon_mpi
        
@@ -428,5 +423,4 @@
        CALL xios_send_field("tro3_in",o3_in3bis(:,:,:,:,:))
        CALL xios_recv_field("tro3_out",o3_regr_lonlat(1,:,:,:,:))
-#endif
      ELSE
           
@@ -462,10 +456,8 @@
      nlat_ou=nbp_lat
      IF (grid_type==unstructured) THEN
-#ifdef CPP_XIOS
        CALL xios_send_field('o3_out',o3_out3)
        ndims=3 
        ALLOCATE(o3_out3_glo(nlat_ou, nlev_in, ntim_ou, read_climoz))
        CALL gather_mpi(o3_out3(1,:,:,:,:), o3_out3_glo)
-#endif
      ENDIF
 
@@ -508,5 +500,4 @@
    
      IF (grid_type==unstructured) THEN
-#ifdef CPP_XIOS
        nlat_ou=klon_mpi
 
@@ -522,5 +513,4 @@
        IF(.NOT.lprev) o3_regr_lat(:,:, 0, :) = o3_regr_lat(:,:,12,:)
        IF(.NOT.lnext) o3_regr_lat(:,:,13, :) = o3_regr_lat(:,:, 1,:)
-#endif       
      
      ELSE 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/rrtm/readaerosolstrato1_rrtm.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/rrtm/readaerosolstrato1_rrtm.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/rrtm/readaerosolstrato1_rrtm.F90	(revision 4727)
@@ -18,7 +18,5 @@
     USE YOERAD, ONLY : NLW
     USE YOMCST
-#ifdef CPP_XIOS
-    USE xios
-#endif
+    USE lmdz_xios
 
     IMPLICIT NONE
@@ -167,5 +165,4 @@
     
     IF (grid_type==unstructured) THEN
-#ifdef CPP_XIOS
       IF (is_omp_master) THEN
         ALLOCATE(tauaerstrat_mpi(klon_mpi,klev))
@@ -176,5 +173,4 @@
       ENDIF
       CALL scatter_omp(tauaerstrat_mpi,tau_aer_strat)
-#endif
     ELSE  
       CALL scatter(tauaerstrat_mois_glo,tau_aer_strat)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90	(revision 4727)
@@ -19,7 +19,5 @@
     USE YOERAD, ONLY : NLW
     USE YOMCST
-#ifdef CPP_XIOS
-    USE xios
-#endif
+    USE lmdz_xios
 
     IMPLICIT NONE
@@ -282,6 +280,4 @@
 
       IF (grid_type==unstructured) THEN
-
-#ifdef CPP_XIOS
 
         IF (is_omp_master) THEN
@@ -310,5 +306,4 @@
         CALL scatter_omp(cgaerstrat_mpi,cg_aer_strat)
         CALL scatter_omp(taulwaerstrat_mpi,taulw_aer_strat)
-#endif
       ELSE  
         
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/screenc_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/screenc_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/screenc_mod.F90	(revision 4727)
@@ -18,5 +18,5 @@
                          ts, qsurf, z0m, z0h, psol, &
                          ustar, testar, qstar, okri, ri1, &
-                         pref, delu, delte, delq)
+                         pref, delu, delte, delq, s_pblh, prain, tsol, pat1)
       IMPLICIT NONE
 !-----------------------------------------------------------------------
@@ -60,6 +60,13 @@
       REAL, dimension(klon), intent(in) :: speed, temp, q_zref
       REAL, intent(in) :: zref
-      REAL, dimension(klon), intent(in) :: ts, qsurf, z0m, z0h, psol
-      REAL, dimension(klon), intent(in) :: ustar, testar, qstar, ri1         
+      REAL, dimension(klon), intent(IN) :: ts
+      REAL, dimension(klon), intent(in) :: qsurf, psol
+      REAL, dimension(klon), intent(inout):: z0m, z0h
+      REAL, dimension(klon), intent(in) :: ustar, testar, qstar, ri1   
+
+      REAL, dimension(klon), intent(inout) :: s_pblh    
+      REAL, dimension(klon), intent(in) :: prain    
+      REAL, dimension(klon), intent(in) :: tsol    
+      REAL, DIMENSION(klon), INTENT(IN)    :: pat1 !pression premier lev      
 !
       REAL, dimension(klon), intent(out) :: pref, delu, delte, delq 
@@ -88,7 +95,7 @@
       CALL cdrag (knon, nsrf, &
                     speed, temp, q_zref, gref, &
-                    psol, ts, qsurf, z0m, z0h, &
+                    psol, s_pblh, ts, qsurf, z0m, z0h, &
                     zri_zero,0,                &
-                    cdram, cdrah, zri1, pref)
+                    cdram, cdrah, zri1, pref, prain, tsol, pat1)
       DO i = 1, knon
         IF(ok_prescr_ust) THEN
@@ -114,5 +121,5 @@
                          cdrm, cdrh,  okri, &
                          ri1, iri1, &
-                         pref, delm, delh, zri1)
+                         pref, delm, delh, zri1, s_pblh, prain, tsol, pat1)
       IMPLICIT NONE
 !-----------------------------------------------------------------------
@@ -156,6 +163,11 @@
       REAL, dimension(klon), intent(in) :: speed, temp, q_zref
       REAL, intent(in) :: zref
-      REAL, dimension(klon), intent(in) :: ts, qsurf, z0m, z0h, psol
+      REAL, dimension(klon), intent(in) :: ts, qsurf, psol
+      REAL, dimension(klon), intent(inout) :: z0m, z0h
       REAL, dimension(klon), intent(in) :: cdrm, cdrh, ri1         
+      REAL, dimension(klon), intent(inout) :: s_pblh    
+      REAL, dimension(klon), intent(in) :: prain    
+      REAL, dimension(klon), intent(in) :: tsol    
+      REAL, DIMENSION(klon), INTENT(IN) :: pat1 !pression premier lev      
       INTEGER, INTENT(IN)  :: iri1 ! Richardson de la 1ere couche
 !
@@ -180,7 +192,7 @@
       CALL cdrag(knon, nsrf, &
                     speed, temp, q_zref, gref, &
-                    psol, ts, qsurf, z0m, z0h, &
+                    psol, s_pblh, ts, qsurf, z0m, z0h, &
                     ri1, iri1, &
-                    cdram, cdrah, zri1, pref)
+                    cdram, cdrah, zri1, pref, prain, tsol, pat1)
       DO i = 1, knon
         delm(i) = sqrt(cdrm(i))/sqrt(cdram(i))
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/stdlevvar_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/stdlevvar_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/stdlevvar_mod.F90	(revision 4727)
@@ -19,5 +19,5 @@
                            u1, v1, t1, q1, z1, &
                            ts1, qsurf, z0m, z0h, psol, pat1, &
-                           t_2m, q_2m, t_10m, q_10m, u_10m, ustar)
+                           t_2m, q_2m, t_10m, q_10m, u_10m, ustar, s_pblh, prain, tsol)
       IMPLICIT NONE
 !-------------------------------------------------------------------------
@@ -61,9 +61,13 @@
       LOGICAL, intent(in) :: zxli
       REAL, dimension(klon), intent(in) :: u1, v1, t1, q1, z1, ts1
-      REAL, dimension(klon), intent(in) :: qsurf, z0m, z0h
+      REAL, dimension(klon), intent(in) :: qsurf
+      REAL, dimension(klon), intent(inout) :: z0m, z0h
       REAL, dimension(klon), intent(in) :: psol, pat1
 !
       REAL, dimension(klon), intent(out) :: t_2m, q_2m, ustar
       REAL, dimension(klon), intent(out) :: u_10m, t_10m, q_10m
+      REAL, DIMENSION(klon), INTENT(INOUT) :: s_pblh
+      REAL, DIMENSION(klon), INTENT(IN) :: prain
+      REAL, DIMENSION(klon), INTENT(IN) :: tsol
 !-------------------------------------------------------------------------
       include "flux_arp.h"
@@ -120,7 +124,7 @@
       CALL cdrag(knon, nsrf, &
  &                   speed, t1, q1, z1, &
- &                   psol, ts1, qsurf, z0m, z0h, &
+ &                   psol, s_pblh, ts1, qsurf, z0m, z0h, &
  &                   zri_zero, 0, &
- &                   cdram, cdrah, zri1, pref)
+ &                   cdram, cdrah, zri1, pref, prain, tsol, pat1)
 
 ! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
@@ -178,5 +182,5 @@
  &                   ts1, qsurf, z0m, z0h, psol, &           
  &                   ustar, testar, qstar, okri, ri1, &
- &                   pref, delu, delte, delq) 
+ &                   pref, delu, delte, delq, s_pblh ,prain, tsol, pat1) 
 !
         DO i = 1, knon
@@ -280,5 +284,5 @@
  &                   ts1, qsurf, z0m, z0h, psol, &
  &                   ustar, testar, qstar, okri, ri1, &
- &                   pref, delu, delte, delq)
+ &                   pref, delu, delte, delq, s_pblh ,prain, tsol, pat1)
 !
         DO i = 1, knon
@@ -357,6 +361,7 @@
       INTEGER, intent(in) :: klon, knon, nsrf
       LOGICAL, intent(in) :: zxli
-      REAL, dimension(klon), intent(in) :: u1, v1, t1, q1, z1, ts1
-      REAL, dimension(klon), intent(in) :: qsurf, z0m, z0h
+      REAL, dimension(klon), intent(in) :: u1, v1, t1, q1, ts1, z1
+      REAL, dimension(klon), intent(inout) :: z0m, z0h
+      REAL, dimension(klon), intent(in) :: qsurf
       REAL, dimension(klon), intent(in) :: psol, pat1
 !
@@ -371,4 +376,7 @@
       REAL, dimension(klon) :: cdmn2m, cdhn2m, fm2m, fh2m
       REAL, dimension(klon) :: ri2m_new
+      REAL, DIMENSION(klon) :: s_pblh
+      REAL, DIMENSION(klon) :: prain
+      REAL, DIMENSION(klon) :: tsol
 !-------------------------------------------------------------------------
       include "flux_arp.h"
@@ -444,7 +452,7 @@
       CALL cdrag(knon, nsrf, &
  &                   speed, t1, q1, z1, &
- &                   psol, ts1, qsurf, z0m, z0h, &
+ &                   psol, s_pblh, ts1, qsurf, z0m, z0h, &
  &                   zri_zero, 0, &
- &                   cdram, cdrah, zri1, pref)
+ &                   cdram, cdrah, zri1, pref, prain, tsol, pat1)
 
 !
@@ -468,5 +476,6 @@
  &                   cdram, cdrah,  okri, &
  &                   ri1, 1, &
- &                   pref_new, delm_new, delh_new, ri2m)
+ &                   pref_new, delm_new, delh_new, ri2m, &
+ &                   s_pblh, prain, tsol, pat1      )
 !
        DO i = 1, knon
@@ -535,5 +544,6 @@
  &                   cdram, cdrah,  okri, &
  &                   ri1, 0, &
- &                   pref, delm, delh, ri2m)
+ &                   pref, delm, delh, ri2m, &
+ &                   s_pblh, prain, tsol, pat1      )
 !
         DO i = 1, knon
@@ -614,5 +624,6 @@
  &                   cdram, cdrah,  okri, &
  &                   ri1, 1, &
- &                   pref_new, delm_new, delh_new, ri10m)
+ &                   pref_new, delm_new, delh_new, ri10m, &
+ &                   s_pblh, prain, tsol, pat1      )
 !
        DO i = 1, knon
@@ -671,5 +682,6 @@
  &                   cdram, cdrah,  okri, &
  &                   ri1, 0, &
- &                   pref, delm, delh, ri10m)
+ &                   pref, delm, delh, ri10m, &
+ &                   s_pblh, prain, tsol, pat1      )
 !
         DO i = 1, knon
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_mod.F90	(revision 4727)
@@ -11,5 +11,5 @@
        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,5 +17,5 @@
        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,5 +81,5 @@
     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,5 +109,5 @@
 !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,4 +125,5 @@
     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,4 +131,16 @@
     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,7 +178,7 @@
             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,5 +197,5 @@
 !****************************************************************************************
        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,5 +205,10 @@
         z0h(1:knon)=z0m(1:knon) ! En attendant mieux
 
+
     ENDIF ! ok_veget
+
+        ! blowing snow not treated yet over land
+        fluxbs(:)=0.
+
 
 !****************************************************************************************
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_mod.F90	(revision 4727)
@@ -632,5 +632,5 @@
     fluxsens(1:knon) = -1. * fluxsens(1:knon)
     fluxlat(1:knon)  = -1. * fluxlat(1:knon)
-    
+   
 !  evap     = -1. * evap
 
@@ -701,9 +701,6 @@
   SUBROUTINE Get_orchidee_communicator(orch_comm, orch_mpi_size, orch_mpi_rank, orch_omp_size,orch_omp_rank)
   USE  mod_surf_para
+  USE lmdz_mpi
       
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
     INTEGER,INTENT(OUT) :: orch_comm
     INTEGER,INTENT(OUT) :: orch_mpi_size
@@ -725,9 +722,7 @@
       ENDIF
     
-#ifdef CPP_MPI    
       CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
       CALL MPI_COMM_SIZE(orch_comm,orch_mpi_size,ierr)
       CALL MPI_COMM_RANK(orch_comm,orch_mpi_rank,ierr)
-#endif
     
     ENDIF
@@ -753,8 +748,5 @@
     USE mod_surf_para    
     USE indice_sol_mod
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
+    USE lmdz_mpi
 
 ! Input arguments
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_nofrein_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_nofrein_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_nofrein_mod.F90	(revision 4727)
@@ -527,9 +527,6 @@
   SUBROUTINE Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
   USE  mod_surf_para
+  USE lmdz_mpi
       
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
     INTEGER,INTENT(OUT) :: orch_comm
     INTEGER,INTENT(OUT) :: orch_omp_size
@@ -550,7 +547,5 @@
       ENDIF
     
-#ifdef CPP_MPI    
       CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
-#endif
     
     ENDIF
@@ -577,8 +572,5 @@
     USE mod_surf_para    
     USE indice_sol_mod
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
+    USE lmdz_mpi
 
 ! Input arguments
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_nolic_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_nolic_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_nolic_mod.F90	(revision 4727)
@@ -689,10 +689,7 @@
 
   SUBROUTINE Get_orchidee_communicator(orch_comm, orch_mpi_size, orch_mpi_rank, orch_omp_size,orch_omp_rank)
+  USE lmdz_mpi
   USE  mod_surf_para
       
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
     INTEGER,INTENT(OUT) :: orch_comm
     INTEGER,INTENT(OUT) :: orch_mpi_size
@@ -714,9 +711,7 @@
       ENDIF
     
-#ifdef CPP_MPI    
       CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
       CALL MPI_COMM_SIZE(orch_comm,orch_mpi_size,ierr)
       CALL MPI_COMM_RANK(orch_comm,orch_mpi_rank,ierr)
-#endif
     
     ENDIF
@@ -742,8 +737,5 @@
     USE mod_surf_para    
     USE indice_sol_mod
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
+    USE lmdz_mpi
 
 ! Input arguments
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90	(revision 4727)
@@ -421,40 +421,39 @@
        IF (knon /=0) THEN
           CALL Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
-
-#ifndef CPP_MPI
-          ! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
-          CALL intersurf_main (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, &
-               lrestart_read, lrestart_write, lalo, &
-               contfrac, neighbours, resolution, date0, &
-               zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
-               cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
-               precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
-               evap, fluxsens, fluxlat, coastalflow, riverflow, &
-               tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
-               lon_scat, lat_scat, q2m, t2m &
+          
+          IF (.NOT. using_mpi) THEN
+            ! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
+            CALL intersurf_main (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, &
+                 lrestart_read, lrestart_write, lalo, &
+                 contfrac, neighbours, resolution, date0, &
+                 zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
+                 cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
+                 precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
+                 evap, fluxsens, fluxlat, coastalflow, riverflow, &
+                 tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
+                 lon_scat, lat_scat, q2m, t2m &
 #ifdef ORCH_NEW
-               , nb_fields_cpl, fields_cpl)
+                 , nb_fields_cpl, fields_cpl)
 #else
-               )
+                 )
 #endif
 
-#else          
-          ! Interface for ORCHIDEE version 1.9 or later(1.9.2, 1.9.3, 1.9.4, 1.9.5) compiled in parallel mode(with preprocessing flag CPP_MPI)
-          CALL intersurf_main (itime+itau_phy-1, nbp_lon, nbp_lat, offset, knon, ktindex, & 
-               orch_comm, dtime, lrestart_read, lrestart_write, lalo, &
-               contfrac, neighbours, resolution, date0, &
-               zlev,  u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
-               cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
-               precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown(1:knon), ps(1:knon), &
-               evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
-               tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
-               lon_scat, lat_scat, q2m, t2m &
+          ELSE          
+            ! Interface for ORCHIDEE version 1.9 or later(1.9.2, 1.9.3, 1.9.4, 1.9.5) compiled in parallel mode(with preprocessing flag CPP_MPI)
+            CALL intersurf_main (itime+itau_phy-1, nbp_lon, nbp_lat, offset, knon, ktindex, & 
+                 orch_comm, dtime, lrestart_read, lrestart_write, lalo, &
+                 contfrac, neighbours, resolution, date0, &
+                 zlev,  u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
+                 cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
+                 precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown(1:knon), ps(1:knon), &
+                 evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
+                 tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
+                 lon_scat, lat_scat, q2m, t2m &
 #ifdef ORCH_NEW
-               , nb_fields_cpl, fields_cpl(1:knon,:))
+                 , nb_fields_cpl, fields_cpl(1:knon,:))
 #else
-               )
+                 )
 #endif
-#endif
-          
+          ENDIF
        ENDIF
 
@@ -467,37 +466,37 @@
 
     IF (knon /=0) THEN
-#ifndef CPP_MPI
-       ! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
-       CALL intersurf_main (itime+itau_phy, nbp_lon, nbp_lat, knon, ktindex, dtime, &
-            lrestart_read, lrestart_write, lalo, &
-            contfrac, neighbours, resolution, date0, &
-            zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
-            cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
-            precip_rain, precip_snow, lwdown, swnet, swdown_vrai, ps, &
-            evap, fluxsens, fluxlat, coastalflow, riverflow, &
-            tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
-            lon_scat, lat_scat, q2m, t2m &
+       IF (.NOT. using_mpi) THEN
+         ! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
+         CALL intersurf_main (itime+itau_phy, nbp_lon, nbp_lat, knon, ktindex, dtime, &
+              lrestart_read, lrestart_write, lalo, &
+              contfrac, neighbours, resolution, date0, &
+              zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
+              cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
+              precip_rain, precip_snow, lwdown, swnet, swdown_vrai, ps, &
+              evap, fluxsens, fluxlat, coastalflow, riverflow, &
+              tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
+              lon_scat, lat_scat, q2m, t2m &
 #ifdef ORCH_NEW
-            , nb_fields_cpl, fields_cpl)
+              , nb_fields_cpl, fields_cpl)
 #else
-            )
+              )
 #endif
+       ELSE
+         ! Interface for ORCHIDEE version 1.9 or later compiled in parallel mode(with preprocessing flag CPP_MPI)
+         CALL intersurf_main (itime+itau_phy, nbp_lon, nbp_lat,offset, knon, ktindex, & 
+              orch_comm,dtime, lrestart_read, lrestart_write, lalo, &
+              contfrac, neighbours, resolution, date0, &
+              zlev,  u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
+              cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
+              precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
+              evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
+              tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
+              lon_scat, lat_scat, q2m, t2m &
+#ifdef ORCH_NEW
+              , nb_fields_cpl, fields_cpl(1:knon,:))
 #else
-       ! Interface for ORCHIDEE version 1.9 or later compiled in parallel mode(with preprocessing flag CPP_MPI)
-       CALL intersurf_main (itime+itau_phy, nbp_lon, nbp_lat,offset, knon, ktindex, & 
-            orch_comm,dtime, lrestart_read, lrestart_write, lalo, &
-            contfrac, neighbours, resolution, date0, &
-            zlev,  u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
-            cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
-            precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
-            evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
-            tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
-            lon_scat, lat_scat, q2m, t2m &
-#ifdef ORCH_NEW
-            , nb_fields_cpl, fields_cpl(1:knon,:))
-#else
-            )
+              )
 #endif
-#endif
+       ENDIF
     ENDIF
 
@@ -545,9 +544,5 @@
     
     USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
+    USE lmdz_mpi
 
 ! Input arguments
@@ -564,7 +559,5 @@
 ! Local varables
 !****************************************************************************************
-#ifdef CPP_MPI
     INTEGER, DIMENSION(MPI_STATUS_SIZE)   :: status
-#endif
 
     INTEGER                               :: MyLastPoint
@@ -580,8 +573,6 @@
     
     IF (is_parallel) THEN
-#ifdef CPP_MPI    
        CALL MPI_COMM_SIZE(orch_comm,mpi_size_orch,ierr)
        CALL MPI_COMM_RANK(orch_comm,mpi_rank_orch,ierr)
-#endif
     ELSE
        mpi_rank_orch=0
@@ -591,13 +582,9 @@
     IF (is_parallel) THEN
        IF (mpi_rank_orch /= 0) THEN
-#ifdef CPP_MPI
           CALL MPI_RECV(LastPoint,1,MPI_INTEGER,mpi_rank_orch-1,1234,orch_comm,status,ierr)
-#endif
        ENDIF
        
        IF (mpi_rank_orch /= mpi_size_orch-1) THEN
-#ifdef CPP_MPI
           CALL MPI_SEND(MyLastPoint,1,MPI_INTEGER,mpi_rank_orch+1,1234,orch_comm,ierr)  
-#endif
        ENDIF
     ENDIF
@@ -617,9 +604,5 @@
 ! 
   SUBROUTINE Get_orchidee_communicator(knon,orch_comm)
-    
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
+  USE lmdz_mpi
 
     INTEGER,INTENT(IN)  :: knon
@@ -638,7 +621,5 @@
     ENDIF
     
-#ifdef CPP_MPI    
     CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
-#endif
     
   END SUBROUTINE Get_orchidee_communicator
@@ -650,8 +631,5 @@
     USE indice_sol_mod
     USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
+    USE lmdz_mpi
 
 ! Input arguments
@@ -688,9 +666,5 @@
        knon_nb(:)=knon
     ELSE  
-       
-#ifdef CPP_MPI  
        CALL MPI_GATHER(knon,1,MPI_INTEGER,knon_nb,1,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
-#endif
-       
     ENDIF
     
@@ -714,10 +688,6 @@
        ktindex_g(:)=ktindex_p(:)
     ELSE
-       
-#ifdef CPP_MPI  
        CALL MPI_GATHERV(ktindex_p,knon,MPI_INTEGER,ktindex_g,knon_nb,&
             displs,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
-#endif
-       
     ENDIF
     
@@ -776,5 +746,4 @@
           neighbours(:,i)=neighbours_g(:,i)
        ELSE
-#ifdef CPP_MPI
           IF (knon > 0) THEN
              ! knon>0, scattter global field neighbours_g from master process to local process
@@ -784,5 +753,4 @@
              CALL MPI_SCATTERV(neighbours_g(:,i),knon_nb,displs,MPI_INTEGER,var_tmp,knon,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr) 
           END IF
-#endif
        ENDIF
     ENDDO
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_nounstruct_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_nounstruct_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_nounstruct_mod.F90	(revision 4727)
@@ -525,9 +525,6 @@
   SUBROUTINE Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
   USE  mod_surf_para
+  USE lmdz_mpi
       
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
     INTEGER,INTENT(OUT) :: orch_comm
     INTEGER,INTENT(OUT) :: orch_omp_size
@@ -548,7 +545,5 @@
       ENDIF
     
-#ifdef CPP_MPI    
       CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
-#endif
     
     ENDIF
@@ -575,8 +570,5 @@
     USE mod_surf_para    
     USE indice_sol_mod
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
+    USE lmdz_mpi
 
 ! Input arguments
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_noz0h_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_noz0h_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_land_orchidee_noz0h_mod.F90	(revision 4727)
@@ -525,9 +525,6 @@
   SUBROUTINE Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
   USE  mod_surf_para
+  USE lmdz_mpi
       
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
-
     INTEGER,INTENT(OUT) :: orch_comm
     INTEGER,INTENT(OUT) :: orch_omp_size
@@ -548,7 +545,5 @@
       ENDIF
     
-#ifdef CPP_MPI    
       CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
-#endif
     
     ENDIF
@@ -575,8 +570,5 @@
     USE mod_surf_para    
     USE indice_sol_mod
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif    
+    USE lmdz_mpi
 
 ! Input arguments
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_landice_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_landice_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_landice_mod.F90	(revision 4727)
@@ -12,10 +12,11 @@
        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,8 +31,9 @@
     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 lmdz_blowing_snow_ini, ONLY : zeta_bs, pbst_bs, prt_bs, iflag_saltation_bs
 
 #ifdef CPP_INLANDSIS
@@ -56,11 +58,12 @@
     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,4 +97,5 @@
 !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,5 +138,12 @@
 
     REAL,DIMENSION(klon) :: alb1,alb2
+    REAL,DIMENSION(klon) :: precip_totsnow, evap_totsnow
     REAL, DIMENSION (klon,6) :: alb6
+    REAL                   :: rho0, rhoice, ustart0,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, hsalt, snowini
+    REAL                   :: maxerosion ! in kg/s   
+
 ! End definition
 !****************************************************************************************
@@ -165,5 +176,5 @@
     alb2(:) = 999999.
     alb1(:) = 999999.
-    
+    fluxbs(:)=0.  
     runoff(:) = 0.
 !****************************************************************************************
@@ -173,4 +184,6 @@
     radsol(:) = 0.0
     radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
+
+!****************************************************************************************
 
 !****************************************************************************************
@@ -264,5 +277,4 @@
 
 
-
     ELSE 
 
@@ -314,12 +326,4 @@
          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,10 +331,12 @@
 !
 !****************************************************************************************
+ 
     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,4 +360,113 @@
     !z0m = SQRT(z0m**2+rugoro**2)
 
+
+
+  ! Simple blowing snow param
+  if (ok_bs) then
+       ustart0 = 0.211
+       rhoice = 920.0
+       rho0 = 300.0
+       rhomax=450.0
+       rhohard=450.0
+       tau_dens0=86400.0*10.  ! 10 days by default, in s
+       tau_densmin=21600.0    ! 1/4 days according to in situ obs by C. Amory during blowing snow + 
+                              ! Marshall et al. 1999 (snow densification during rain)
+
+       ! computation of threshold friction velocity
+       ! which depends on surface snow density
+       do j = 1, knon
+           ! estimation of snow density
+           ! snow density increases with snow age and
+           ! increases even faster in case of sedimentation of blowing snow or rain
+           tau_dens=max(tau_densmin, tau_dens0*exp(-abs(precip_bs(j))/pbst_bs - & 
+                    abs(precip_rain(j))/prt_bs)*exp(-max(tsurf(j)-272.0,0.)))
+           rhos(j)=rho0+(rhohard-rho0)*(1.-exp(-agesno(j)*86400.0/tau_dens))
+           ! blowing snow flux formula used in MAR
+           ws1(j)=(u1(j)**2+v1(j)**2)**0.5
+           ustar(j)=(cdragm(j)*(u1(j)**2+v1(j)**2))**0.5
+           ustart(j)=ustart0*exp(max(rhoice/rho0-rhoice/rhos(j),0.))*exp(max(0.,rhos(j)-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 j =1, knon
+               rhod=p1lay(j)/RD/temp_air(j)
+               nunu=max(ustar(j)/ustart(j),1.e-3)
+               fluxsalt=rhod/RG*(ustar(j)**3)*(1.-nunu**(-2)) * &
+                        (aa+bb*nunu**(-2)+cc*nunu**(-1))  
+               csalt=fluxsalt/(2.8*ustart(j))
+               hsalt(j)=0.08436*ustar(j)**1.27
+               qsalt(j)=1./rhod*csalt*lambdasalt*RG/(max(ustar(j)**2,1E-6)) &
+                       * exp(-lambdasalt*RG*hsalt(j)/max(ustar(j)**2,1E-6))
+               qsalt(j)=max(qsalt(j),0.)
+          enddo
+
+
+       else
+       ! default formulation from MAR model (Amory et al. 2021, Gallee et al. 2001)        
+          do j=1, knon
+              esalt=1./(3.25*max(ustar(j),0.001))
+              hsalt(j)=0.08436*ustar(j)**1.27
+              qsalt(j)=(max(ustar(j)**2-ustart(j)**2,0.))/(RG*hsalt(j))*esalt
+              !ep=qsalt*cdragm(j)*sqrt(u1(j)**2+v1(j)**2)
+          enddo
+       endif
+
+        ! calculation of erosion (flux positive towards the surface here) 
+        ! consistent with implicit resolution of turbulent mixing equation
+       do j=1, knon
+              i = knindex(j)
+              rhod=p1lay(j)/RD/temp_air(j)
+              ! Nemoto and Nishimura 2004 show that steady-state saltation is achieved within an interval of about 10s
+              ! we thus prevent snowerosion (snow particle transfer from the saltation layer to the first model level)
+              ! to exceed (in intensity) integrated over 10s to exceed the total mass of snow particle in the saltation layer
+              ! (rho*qsalt*hsalt)
+              maxerosion=hsalt(j)*qsalt(j)*rhod/10.
+              fluxbs(j)=rhod*ws1(j)*cdragm(j)*(AcoefQBS(j)-qsalt(j)) &
+                       / (1.-rhod*ws1(j)*cdragm(j)*BcoefQBS(j)*dtime)
+              !fluxbs(j)= rhod*ws1(j)*cdragm(j)*(qbs1(j)-qsalt(j))
+              fluxbs(j)=max(-maxerosion,fluxbs(j))
+
+              ! for outputs
+
+              zxustartlic(i) = ustart(j)
+              zxrhoslic(i) = rhos(j)
+       enddo
+
+  endif
+
+
+
+!****************************************************************************************
+! Calculate 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,6 +493,4 @@
     runoff(1:knon)=run_off_lic(1:knon)/dtime
 
-  
-!****************************************************************************************
        snow_o=0.
        zfra_o = 0.
@@ -420,6 +533,4 @@
 !albedo SB <<<
 
-  
-  
 
   END SUBROUTINE surf_landice
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_ocean_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_ocean_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/surf_ocean_mod.F90	(revision 4727)
@@ -13,5 +13,5 @@
        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,5 +60,5 @@
     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,4 +144,5 @@
     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,4 +161,15 @@
     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,5 +200,5 @@
             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,5 +212,5 @@
        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,5 +223,5 @@
        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,5 +338,5 @@
        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), &
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/sw_aeroAR4.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/sw_aeroAR4.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/sw_aeroAR4.F90	(revision 4727)
@@ -26,6 +26,6 @@
   IMPLICIT NONE
 
-#include "YOMCST.h"
-#include "clesphys.h"
+  INCLUDE "YOMCST.h"
+  INCLUDE "clesphys.h"
   !
   !     ------------------------------------------------------------------
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/tend_to_tke.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/tend_to_tke.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/tend_to_tke.F90	(revision 4727)
@@ -38,5 +38,5 @@
 
 IMPLICIT NONE
-#include "YOMCST.h"
+INCLUDE "YOMCST.h"
 
 ! Declarations
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell.F90	(revision 4726)
+++ 	(revision )
@@ -1,1168 +1,0 @@
-
-! $Id$
-
-SUBROUTINE calcul_sec(ngrid, nlay, ptimestep, pplay, pplev, pphi, zlev, pu, &
-    pv, pt, po, zmax, wmax, zw2, lmix & ! s
-                                        ! ,pu_therm,pv_therm
-    , r_aspect, l_mix, w2di, tho)
-
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-
-  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
-
-  ! le thermique est supposé homogène et dissipé par mélange avec
-  ! son environnement. la longueur l_mix contrôle l'efficacité du
-  ! mélange
-
-  ! Le calcul du transport des différentes espèces se fait en prenant
-  ! en compte:
-  ! 1. un flux de masse montant
-  ! 2. un flux de masse descendant
-  ! 3. un entrainement
-  ! 4. un detrainement
-
-  ! =======================================================================
-
-  ! -----------------------------------------------------------------------
-  ! declarations:
-  ! -------------
-
-  include "YOMCST.h"
-
-  ! arguments:
-  ! ----------
-
-  INTEGER ngrid, nlay, w2di
-  REAL tho
-  REAL ptimestep, l_mix, r_aspect
-  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
-  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
-  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
-  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
-  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
-  REAL pphi(ngrid, nlay)
-
-  INTEGER idetr
-  SAVE idetr
-  DATA idetr/3/
-  !$OMP THREADPRIVATE(idetr)
-  ! local:
-  ! ------
-
-  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
-  REAL zsortie1d(klon)
-  ! CR: on remplace lmax(klon,klev+1)
-  INTEGER lmax(klon), lmin(klon), lentr(klon)
-  REAL linter(klon)
-  REAL zmix(klon), fracazmix(klon)
-  ! RC
-  REAL zmax(klon), zw, zw2(klon, klev+1), ztva(klon, klev)
-
-  REAL zlev(klon, klev+1), zlay(klon, klev)
-  REAL zh(klon, klev), zdhadj(klon, klev)
-  REAL ztv(klon, klev)
-  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
-  REAL wh(klon, klev+1)
-  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
-  REAL zla(klon, klev+1)
-  REAL zwa(klon, klev+1)
-  REAL zld(klon, klev+1)
-  ! real zwd(klon,klev+1)
-  REAL zsortie(klon, klev)
-  REAL zva(klon, klev)
-  REAL zua(klon, klev)
-  REAL zoa(klon, klev)
-
-  REAL zha(klon, klev)
-  REAL wa_moy(klon, klev+1)
-  REAL fraca(klon, klev+1)
-  REAL fracc(klon, klev+1)
-  REAL zf, zf2
-  REAL thetath2(klon, klev), wth2(klon, klev)
-  ! common/comtherm/thetath2,wth2
-
-  REAL count_time
-  ! integer isplit,nsplit
-  INTEGER isplit, nsplit, ialt
-  PARAMETER (nsplit=10)
-  DATA isplit/0/
-  SAVE isplit
-  !$OMP THREADPRIVATE(isplit)
-
-  LOGICAL sorties
-  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
-  REAL zpspsk(klon, klev)
-
-  ! real wmax(klon,klev),wmaxa(klon)
-  REAL wmax(klon), wmaxa(klon)
-  REAL wa(klon, klev, klev+1)
-  REAL wd(klon, klev+1)
-  REAL larg_part(klon, klev, klev+1)
-  REAL fracd(klon, klev+1)
-  REAL xxx(klon, klev+1)
-  REAL larg_cons(klon, klev+1)
-  REAL larg_detr(klon, klev+1)
-  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
-  REAL pu_therm(klon, klev), pv_therm(klon, klev)
-  REAL fm(klon, klev+1), entr(klon, klev)
-  REAL fmc(klon, klev+1)
-
-  ! CR:nouvelles variables
-  REAL f_star(klon, klev+1), entr_star(klon, klev)
-  REAL entr_star_tot(klon), entr_star2(klon)
-  REAL zalim(klon)
-  INTEGER lalim(klon)
-  REAL norme(klon)
-  REAL f(klon), f0(klon)
-  REAL zlevinter(klon)
-  LOGICAL therm
-  LOGICAL first
-  DATA first/.FALSE./
-  SAVE first
-  !$OMP THREADPRIVATE(first)
-  ! RC
-
-  CHARACTER *2 str2
-  CHARACTER *10 str10
-
-  CHARACTER (LEN=20) :: modname = 'calcul_sec'
-  CHARACTER (LEN=80) :: abort_message
-
-
-  ! LOGICAL vtest(klon),down
-
-  EXTERNAL scopy
-
-  INTEGER ncorrec
-  SAVE ncorrec
-  DATA ncorrec/0/
-  !$OMP THREADPRIVATE(ncorrec)
-
-
-  ! -----------------------------------------------------------------------
-  ! initialisation:
-  ! ---------------
-
-  sorties = .TRUE.
-  IF (ngrid/=klon) THEN
-    PRINT *
-    PRINT *, 'STOP dans convadj'
-    PRINT *, 'ngrid    =', ngrid
-    PRINT *, 'klon  =', klon
-  END IF
-
-  ! -----------------------------------------------------------------------
-  ! incrementation eventuelle de tendances precedentes:
-  ! ---------------------------------------------------
-
-  ! print*,'0 OK convect8'
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
-      zh(ig, l) = pt(ig, l)/zpspsk(ig, l)
-      zu(ig, l) = pu(ig, l)
-      zv(ig, l) = pv(ig, l)
-      zo(ig, l) = po(ig, l)
-      ztv(ig, l) = zh(ig, l)*(1.+0.61*zo(ig,l))
-    END DO
-  END DO
-
-  ! print*,'1 OK convect8'
-  ! --------------------
-
-
-  ! + + + + + + + + + + +
-
-
-  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
-  ! wh,wt,wo ...
-
-  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
-
-
-  ! --------------------   zlev(1)
-  ! \\\\\\\\\\\\\\\\\\\\
-
-
-
-  ! -----------------------------------------------------------------------
-  ! Calcul des altitudes des couches
-  ! -----------------------------------------------------------------------
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zlev(ig, 1) = 0.
-    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
-  END DO
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zlay(ig, l) = pphi(ig, l)/rg
-    END DO
-  END DO
-
-  ! print*,'2 OK convect8'
-  ! -----------------------------------------------------------------------
-  ! Calcul des densites
-  ! -----------------------------------------------------------------------
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*zh(ig,l))
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
-    END DO
-  END DO
-
-  DO k = 1, nlay
-    DO l = 1, nlay + 1
-      DO ig = 1, ngrid
-        wa(ig, k, l) = 0.
-      END DO
-    END DO
-  END DO
-
-  ! print*,'3 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calcul de w2, quarre de w a partir de la cape
-  ! a partir de w2, on calcule wa, vitesse de l'ascendance
-
-  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
-  ! w2 est stoke dans wa
-
-  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
-  ! independants par couches que pour calculer l'entrainement
-  ! a la base et la hauteur max de l'ascendance.
-
-  ! Indicages:
-  ! l'ascendance provenant du niveau k traverse l'interface l avec
-  ! une vitesse wa(k,l).
-
-  ! --------------------
-
-  ! + + + + + + + + + +
-
-  ! wa(k,l)   ----       --------------------    l
-  ! /\
-  ! /||\       + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||
-  ! ||        + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||__
-  ! |___      + + + + + + + + + +     k
-
-  ! --------------------
-
-
-
-  ! ------------------------------------------------------------------
-
-  ! CR: ponderation entrainement des couches instables
-  ! def des entr_star tels que entr=f*entr_star
-  DO l = 1, klev
-    DO ig = 1, ngrid
-      entr_star(ig, l) = 0.
-    END DO
-  END DO
-  ! determination de la longueur de la couche d entrainement
-  DO ig = 1, ngrid
-    lentr(ig) = 1
-  END DO
-
-  ! on ne considere que les premieres couches instables
-  therm = .FALSE.
-  DO k = nlay - 2, 1, -1
-    DO ig = 1, ngrid
-      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<=ztv(ig,k+2)) THEN
-        lentr(ig) = k + 1
-        therm = .TRUE.
-      END IF
-    END DO
-  END DO
-  ! limitation de la valeur du lentr
-  ! do ig=1,ngrid
-  ! lentr(ig)=min(5,lentr(ig))
-  ! enddo
-  ! determination du lmin: couche d ou provient le thermique
-  DO ig = 1, ngrid
-    lmin(ig) = 1
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, 2, -1
-      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
-        lmin(ig) = l - 1
-      END IF
-    END DO
-  END DO
-  ! initialisations
-  DO ig = 1, ngrid
-    zalim(ig) = 0.
-    norme(ig) = 0.
-    lalim(ig) = 1
-  END DO
-  DO k = 1, klev - 1
-    DO ig = 1, ngrid
-      zalim(ig) = zalim(ig) + zlev(ig, k)*max(0., (ztv(ig,k)-ztv(ig, &
-        k+1))/(zlev(ig,k+1)-zlev(ig,k)))
-      ! s         *(zlev(ig,k+1)-zlev(ig,k))
-      norme(ig) = norme(ig) + max(0., (ztv(ig,k)-ztv(ig,k+1))/(zlev(ig, &
-        k+1)-zlev(ig,k)))
-      ! s          *(zlev(ig,k+1)-zlev(ig,k))
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    IF (norme(ig)>1.E-10) THEN
-      zalim(ig) = max(10.*zalim(ig)/norme(ig), zlev(ig,2))
-      ! zalim(ig)=min(zalim(ig),zlev(ig,lentr(ig)))
-    END IF
-  END DO
-  ! détermination du lalim correspondant
-  DO k = 1, klev - 1
-    DO ig = 1, ngrid
-      IF ((zalim(ig)>zlev(ig,k)) .AND. (zalim(ig)<=zlev(ig,k+1))) THEN
-        lalim(ig) = k
-      END IF
-    END DO
-  END DO
-
-  ! definition de l'entrainement des couches
-  DO l = 1, klev - 1
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<lentr(ig)) THEN
-        entr_star(ig, l) = max((ztv(ig,l)-ztv(ig,l+1)), 0.) & ! s
-                                                              ! *(zlev(ig,l+1)-zlev(ig,l))
-          *sqrt(zlev(ig,l+1))
-        ! autre def
-        ! entr_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
-        ! s                         /zlev(ig,lentr(ig)+2)))**(3./2.)
-      END IF
-    END DO
-  END DO
-  ! nouveau test
-  ! if (therm) then
-  DO l = 1, klev - 1
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<=lalim(ig) .AND. &
-          zalim(ig)>1.E-10) THEN
-        ! if (l.le.lentr(ig)) then
-        ! entr_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
-        ! s                         /zalim(ig)))**(3./2.)
-        ! write(10,*)zlev(ig,l),entr_star(ig,l)
-      END IF
-    END DO
-  END DO
-  ! endif
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>5) THEN
-      DO l = 1, klev
-        entr_star(ig, l) = 0.
-      END DO
-    END IF
-  END DO
-  ! calcul de l entrainement total
-  DO ig = 1, ngrid
-    entr_star_tot(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    DO k = 1, klev
-      entr_star_tot(ig) = entr_star_tot(ig) + entr_star(ig, k)
-    END DO
-  END DO
-  ! Calcul entrainement normalise
-  DO ig = 1, ngrid
-    IF (entr_star_tot(ig)>1.E-10) THEN
-      ! do l=1,lentr(ig)
-      DO l = 1, klev
-        ! def possibles pour entr_star: zdthetadz, dthetadz, zdtheta
-        entr_star(ig, l) = entr_star(ig, l)/entr_star_tot(ig)
-      END DO
-    END IF
-  END DO
-
-  ! print*,'fin calcul entr_star'
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      ztva(ig, k) = ztv(ig, k)
-    END DO
-  END DO
-  ! RC
-  ! print*,'7 OK convect8'
-  DO k = 1, klev + 1
-    DO ig = 1, ngrid
-      zw2(ig, k) = 0.
-      fmc(ig, k) = 0.
-      ! CR
-      f_star(ig, k) = 0.
-      ! RC
-      larg_cons(ig, k) = 0.
-      larg_detr(ig, k) = 0.
-      wa_moy(ig, k) = 0.
-    END DO
-  END DO
-
-  ! print*,'8 OK convect8'
-  DO ig = 1, ngrid
-    linter(ig) = 1.
-    lmaxa(ig) = 1
-    lmix(ig) = 1
-    wmaxa(ig) = 0.
-  END DO
-
-  ! CR:
-  DO l = 1, nlay - 2
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. entr_star(ig,l)>1.E-10 .AND. &
-          zw2(ig,l)<1E-10) THEN
-        f_star(ig, l+1) = entr_star(ig, l)
-        ! test:calcul de dteta
-        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
-          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
-        larg_detr(ig, l) = 0.
-      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+entr_star(ig, &
-          l)>1.E-10)) THEN
-        f_star(ig, l+1) = f_star(ig, l) + entr_star(ig, l)
-        ztva(ig, l) = (f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)*ztv(ig,l))/ &
-          f_star(ig, l+1)
-        zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/f_star(ig,l+1))**2 + &
-          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
-      END IF
-      ! determination de zmax continu par interpolation lineaire
-      IF (zw2(ig,l+1)<0.) THEN
-        ! test
-        IF (abs(zw2(ig,l+1)-zw2(ig,l))<1E-10) THEN
-          ! print*,'pb linter'
-        END IF
-        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
-          ig,l))
-        zw2(ig, l+1) = 0.
-        lmaxa(ig) = l
-      ELSE
-        IF (zw2(ig,l+1)<0.) THEN
-          ! print*,'pb1 zw2<0'
-        END IF
-        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
-      END IF
-      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
-        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
-        lmix(ig) = l + 1
-        wmaxa(ig) = wa_moy(ig, l+1)
-      END IF
-    END DO
-  END DO
-  ! print*,'fin calcul zw2'
-
-  ! Calcul de la couche correspondant a la hauteur du thermique
-  DO ig = 1, ngrid
-    lmax(ig) = lentr(ig)
-    ! lmax(ig)=lalim(ig)
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, lentr(ig) + 1, -1
-      ! do l=nlay,lalim(ig)+1,-1
-      IF (zw2(ig,l)<=1.E-10) THEN
-        lmax(ig) = l - 1
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>5) THEN
-      lmax(ig) = 1
-      lmin(ig) = 1
-      lentr(ig) = 1
-      lalim(ig) = 1
-    END IF
-  END DO
-
-  ! Determination de zw2 max
-  DO ig = 1, ngrid
-    wmax(ig) = 0.
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig)) THEN
-        IF (zw2(ig,l)<0.) THEN
-          ! print*,'pb2 zw2<0'
-        END IF
-        zw2(ig, l) = sqrt(zw2(ig,l))
-        wmax(ig) = max(wmax(ig), zw2(ig,l))
-      ELSE
-        zw2(ig, l) = 0.
-      END IF
-    END DO
-  END DO
-
-  ! Longueur caracteristique correspondant a la hauteur des thermiques.
-  DO ig = 1, ngrid
-    zmax(ig) = 0.
-    zlevinter(ig) = zlev(ig, 1)
-  END DO
-  DO ig = 1, ngrid
-    ! calcul de zlevinter
-    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
-      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,lmin(ig)))
-  END DO
-  DO ig = 1, ngrid
-    ! write(8,*)zmax(ig),lmax(ig),lentr(ig),lmin(ig)
-  END DO
-  ! on stope après les calculs de zmax et wmax
-  RETURN
-
-  ! print*,'avant fermeture'
-  ! Fermeture,determination de f
-  ! Attention! entrainement normalisé ou pas?
-  DO ig = 1, ngrid
-    entr_star2(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    IF (entr_star_tot(ig)<1.E-10) THEN
-      f(ig) = 0.
-    ELSE
-      DO k = lmin(ig), lentr(ig)
-        ! do k=lmin(ig),lalim(ig)
-        entr_star2(ig) = entr_star2(ig) + entr_star(ig, k)**2/(rho(ig,k)*( &
-          zlev(ig,k+1)-zlev(ig,k)))
-      END DO
-      ! Nouvelle fermeture
-      f(ig) = wmax(ig)/(max(500.,zmax(ig))*r_aspect*entr_star2(ig))
-      ! s            *entr_star_tot(ig)
-      ! test
-      ! if (first) then
-      f(ig) = f(ig) + (f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)*wmax(ig))
-      ! endif
-    END IF
-    f0(ig) = f(ig)
-    ! first=.true.
-  END DO
-  ! print*,'apres fermeture'
-  ! on stoppe après la fermeture
-  RETURN
-  ! Calcul de l'entrainement
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      entr(ig, k) = f(ig)*entr_star(ig, k)
-    END DO
-  END DO
-  ! on stoppe après le calcul de entr
-  ! RETURN
-  ! CR:test pour entrainer moins que la masse
-  ! do ig=1,ngrid
-  ! do l=1,lentr(ig)
-  ! if ((entr(ig,l)*ptimestep).gt.(0.9*masse(ig,l))) then
-  ! entr(ig,l+1)=entr(ig,l+1)+entr(ig,l)
-  ! s                       -0.9*masse(ig,l)/ptimestep
-  ! entr(ig,l)=0.9*masse(ig,l)/ptimestep
-  ! endif
-  ! enddo
-  ! enddo
-  ! CR: fin test
-  ! Calcul des flux
-  DO ig = 1, ngrid
-    DO l = 1, lmax(ig) - 1
-      fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
-    END DO
-  END DO
-
-  ! RC
-
-
-  ! print*,'9 OK convect8'
-  ! print*,'WA1 ',wa_moy
-
-  ! determination de l'indice du debut de la mixed layer ou w decroit
-
-  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
-  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
-  ! d'une couche est égale à la hauteur de la couche alimentante.
-  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
-  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        zw = max(wa_moy(ig,l), 1.E-10)
-        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) then
-        ! cette option est finalement en dur.
-        IF ((l_mix*zlev(ig,l))<0.) THEN
-          ! print*,'pb l_mix*zlev<0'
-        END IF
-        ! CR: test: nouvelle def de lambda
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        IF (zw2(ig,l)>1.E-10) THEN
-          larg_detr(ig, l) = sqrt((l_mix/zw2(ig,l))*zlev(ig,l))
-        ELSE
-          larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        END IF
-        ! RC
-        ! else if (idetr.eq.1) then
-        ! larg_detr(ig,l)=larg_cons(ig,l)
-        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *wa_moy(ig,l)
-        ! endif
-      END IF
-    END DO
-  END DO
-
-  ! print*,'10 OK convect8'
-  ! print*,'WA2 ',wa_moy
-  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
-  ! compte de l'epluchage du thermique.
-
-  ! CR def de  zmix continu (profil parabolique des vitesses)
-  DO ig = 1, ngrid
-    IF (lmix(ig)>1.) THEN
-      ! test
-      IF (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))- &
-          (zlev(ig,lmix(ig)))))>1E-10) THEN
-
-        zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)) &
-          )**2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
-          lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
-          (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
-      ELSE
-        zmix(ig) = zlev(ig, lmix(ig))
-        ! print*,'pb zmix'
-      END IF
-    ELSE
-      zmix(ig) = 0.
-    END IF
-    ! test
-    IF ((zmax(ig)-zmix(ig))<0.) THEN
-      zmix(ig) = 0.99*zmax(ig)
-      ! print*,'pb zmix>zmax'
-    END IF
-  END DO
-
-  ! calcul du nouveau lmix correspondant
-  DO ig = 1, ngrid
-    DO l = 1, klev
-      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
-        lmix(ig) = l
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
-        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
-        ! test
-        fraca(ig, l) = max(fraca(ig,l), 0.)
-        fraca(ig, l) = min(fraca(ig,l), 0.5)
-        fracd(ig, l) = 1. - fraca(ig, l)
-        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-      ELSE
-        ! wa_moy(ig,l)=0.
-        fraca(ig, l) = 0.
-        fracc(ig, l) = 0.
-        fracd(ig, l) = 1.
-      END IF
-    END DO
-  END DO
-  ! CR: calcul de fracazmix
-  DO ig = 1, ngrid
-    fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
-      (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
-      fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca(ig &
-      ,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        IF (l>lmix(ig)) THEN
-          ! test
-          IF (zmax(ig)-zmix(ig)<1.E-10) THEN
-            ! print*,'pb xxx'
-            xxx(ig, l) = (lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
-          ELSE
-            xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
-          END IF
-          IF (idetr==0) THEN
-            fraca(ig, l) = fracazmix(ig)
-          ELSE IF (idetr==1) THEN
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
-          ELSE IF (idetr==2) THEN
-            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
-          ELSE
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
-          END IF
-          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
-          fraca(ig, l) = max(fraca(ig,l), 0.)
-          fraca(ig, l) = min(fraca(ig,l), 0.5)
-          fracd(ig, l) = 1. - fraca(ig, l)
-          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! print*,'fin calcul fraca'
-  ! print*,'11 OK convect8'
-  ! print*,'Ea3 ',wa_moy
-  ! ------------------------------------------------------------------
-  ! Calcul de fracd, wd
-  ! somme wa - wd = 0
-  ! ------------------------------------------------------------------
-
-
-  DO ig = 1, ngrid
-    fm(ig, 1) = 0.
-    fm(ig, nlay+1) = 0.
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
-      ! CR:test
-      IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
-        fm(ig, l) = fm(ig, l-1)
-        ! write(1,*)'ajustement fm, l',l
-      END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
-      ! RC
-    END DO
-    DO ig = 1, ngrid
-      IF (fracd(ig,l)<0.1) THEN
-        abort_message = 'fracd trop petit'
-        CALL abort_physic(modname, abort_message, 1)
-
-      ELSE
-        ! vitesse descendante "diagnostique"
-        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
-    END DO
-  END DO
-
-  ! print*,'12 OK convect8'
-  ! print*,'WA4 ',wa_moy
-  ! c------------------------------------------------------------------
-  ! calcul du transport vertical
-  ! ------------------------------------------------------------------
-
-  GO TO 4444
-  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
-  DO l = 2, nlay - 1
-    DO ig = 1, ngrid
-      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
-          ig,l+1)) THEN
-        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
-        ! s         ,fm(ig,l+1)*ptimestep
-        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
-        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
-        ! s         ,entr(ig,l)*ptimestep
-        ! s         ,'   M=',masse(ig,l)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
-        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
-        ! s         ,'   FM=',fm(ig,l)
-      END IF
-      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
-        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
-        ! s         ,'   M=',masse(ig,l)
-        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
-        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
-        ! print*,'zlev(ig,l+1),zlev(ig,l)'
-        ! s                ,zlev(ig,l+1),zlev(ig,l)
-        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
-        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
-      END IF
-      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
-        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
-        ! s         ,'   E=',entr(ig,l)
-      END IF
-    END DO
-  END DO
-
-4444 CONTINUE
-
-  ! CR:redefinition du entr
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      detr(ig, l) = fm(ig, l) + entr(ig, l) - fm(ig, l+1)
-      IF (detr(ig,l)<0.) THEN
-        ! entr(ig,l)=entr(ig,l)-detr(ig,l)
-        fm(ig, l+1) = fm(ig, l) + entr(ig, l)
-        detr(ig, l) = 0.
-        ! print*,'WARNING !!! detrainement negatif ',ig,l
-      END IF
-    END DO
-  END DO
-  ! RC
-  IF (w2di==1) THEN
-    fm0 = fm0 + ptimestep*(fm-fm0)/tho
-    entr0 = entr0 + ptimestep*(entr-entr0)/tho
-  ELSE
-    fm0 = fm
-    entr0 = entr
-  END IF
-
-  IF (1==1) THEN
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zh, zdhadj, &
-      zha)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zo, pdoadj, &
-      zoa)
-  ELSE
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
-      zdhadj, zha)
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
-      pdoadj, zoa)
-  END IF
-
-  IF (1==0) THEN
-    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
-      zu, zv, pduadj, pdvadj, zua, zva)
-  ELSE
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
-      zua)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
-      zva)
-  END IF
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
-      zf2 = zf/(1.-zf)
-      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
-      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
-    END DO
-  END DO
-
-
-
-  ! print*,'13 OK convect8'
-  ! print*,'WA5 ',wa_moy
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      pdtadj(ig, l) = zdhadj(ig, l)*zpspsk(ig, l)
-    END DO
-  END DO
-
-
-  ! do l=1,nlay
-  ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
-  ! enddo
-  ! enddo
-
-  ! print*,'14 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calculs pour les sorties
-  ! ------------------------------------------------------------------
-
-  IF (sorties) THEN
-    DO l = 1, nlay
-      DO ig = 1, ngrid
-        zla(ig, l) = (1.-fracd(ig,l))*zmax(ig)
-        zld(ig, l) = fracd(ig, l)*zmax(ig)
-        IF (1.-fracd(ig,l)>1.E-10) zwa(ig, l) = wd(ig, l)*fracd(ig, l)/ &
-          (1.-fracd(ig,l))
-      END DO
-    END DO
-
-    ! deja fait
-    ! do l=1,nlay
-    ! do ig=1,ngrid
-    ! detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
-    ! if (detr(ig,l).lt.0.) then
-    ! entr(ig,l)=entr(ig,l)-detr(ig,l)
-    ! detr(ig,l)=0.
-    ! print*,'WARNING !!! detrainement negatif ',ig,l
-    ! endif
-    ! enddo
-    ! enddo
-
-    ! print*,'15 OK convect8'
-
-    isplit = isplit + 1
-
-
-    ! #define und
-    GO TO 123
-#ifdef und
-    CALL writeg1d(1, nlay, wd, 'wd      ', 'wd      ')
-    CALL writeg1d(1, nlay, zwa, 'wa      ', 'wa      ')
-    CALL writeg1d(1, nlay, fracd, 'fracd      ', 'fracd      ')
-    CALL writeg1d(1, nlay, fraca, 'fraca      ', 'fraca      ')
-    CALL writeg1d(1, nlay, wa_moy, 'wam         ', 'wam         ')
-    CALL writeg1d(1, nlay, zla, 'la      ', 'la      ')
-    CALL writeg1d(1, nlay, zld, 'ld      ', 'ld      ')
-    CALL writeg1d(1, nlay, pt, 'pt      ', 'pt      ')
-    CALL writeg1d(1, nlay, zh, 'zh      ', 'zh      ')
-    CALL writeg1d(1, nlay, zha, 'zha      ', 'zha      ')
-    CALL writeg1d(1, nlay, zu, 'zu      ', 'zu      ')
-    CALL writeg1d(1, nlay, zv, 'zv      ', 'zv      ')
-    CALL writeg1d(1, nlay, zo, 'zo      ', 'zo      ')
-    CALL writeg1d(1, nlay, wh, 'wh      ', 'wh      ')
-    CALL writeg1d(1, nlay, wu, 'wu      ', 'wu      ')
-    CALL writeg1d(1, nlay, wv, 'wv      ', 'wv      ')
-    CALL writeg1d(1, nlay, wo, 'w15uo     ', 'wXo     ')
-    CALL writeg1d(1, nlay, zdhadj, 'zdhadj      ', 'zdhadj      ')
-    CALL writeg1d(1, nlay, pduadj, 'pduadj      ', 'pduadj      ')
-    CALL writeg1d(1, nlay, pdvadj, 'pdvadj      ', 'pdvadj      ')
-    CALL writeg1d(1, nlay, pdoadj, 'pdoadj      ', 'pdoadj      ')
-    CALL writeg1d(1, nlay, entr, 'entr        ', 'entr        ')
-    CALL writeg1d(1, nlay, detr, 'detr        ', 'detr        ')
-    CALL writeg1d(1, nlay, fm, 'fm          ', 'fm          ')
-
-    CALL writeg1d(1, nlay, pdtadj, 'pdtadj    ', 'pdtadj    ')
-    CALL writeg1d(1, nlay, pplay, 'pplay     ', 'pplay     ')
-    CALL writeg1d(1, nlay, pplev, 'pplev     ', 'pplev     ')
-
-    ! recalcul des flux en diagnostique...
-    ! print*,'PAS DE TEMPS ',ptimestep
-    CALL dt2f(pplev, pplay, pt, pdtadj, wh)
-    CALL writeg1d(1, nlay, wh, 'wh2     ', 'wh2     ')
-#endif
-123 CONTINUE
-
-  END IF
-
-  ! if(wa_moy(1,4).gt.1.e-10) stop
-
-  ! print*,'19 OK convect8'
-  RETURN
-END SUBROUTINE calcul_sec
-
-SUBROUTINE fermeture_seche(ngrid, nlay, pplay, pplev, pphi, zlev, rhobarz, &
-    f0, zpspsk, alim_star, zh, zo, lentr, lmin, nu_min, nu_max, r_aspect, &
-    zmax, wmax)
-
-  USE dimphy
-  IMPLICIT NONE
-
-  include "YOMCST.h"
-
-  INTEGER ngrid, nlay
-  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
-  REAL pphi(ngrid, nlay)
-  REAL zlev(klon, klev+1)
-  REAL alim_star(klon, klev)
-  REAL f0(klon)
-  INTEGER lentr(klon)
-  INTEGER lmin(klon)
-  REAL zmax(klon)
-  REAL wmax(klon)
-  REAL nu_min
-  REAL nu_max
-  REAL r_aspect
-  REAL rhobarz(klon, klev+1)
-  REAL zh(klon, klev)
-  REAL zo(klon, klev)
-  REAL zpspsk(klon, klev)
-
-  INTEGER ig, l
-
-  REAL f_star(klon, klev+1)
-  REAL detr_star(klon, klev)
-  REAL entr_star(klon, klev)
-  REAL zw2(klon, klev+1)
-  REAL linter(klon)
-  INTEGER lmix(klon)
-  INTEGER lmax(klon)
-  REAL zlevinter(klon)
-  REAL wa_moy(klon, klev+1)
-  REAL wmaxa(klon)
-  REAL ztv(klon, klev)
-  REAL ztva(klon, klev)
-  REAL nu(klon, klev)
-  ! real zmax0_sec(klon)
-  ! save zmax0_sec
-  REAL, SAVE, ALLOCATABLE :: zmax0_sec(:)
-  !$OMP THREADPRIVATE(zmax0_sec)
-  LOGICAL, SAVE :: first = .TRUE.
-  !$OMP THREADPRIVATE(first)
-
-  IF (first) THEN
-    ALLOCATE (zmax0_sec(klon))
-    first = .FALSE.
-  END IF
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ztv(ig, l) = zh(ig, l)/zpspsk(ig, l)
-      ztv(ig, l) = ztv(ig, l)*(1.+retv*zo(ig,l))
-    END DO
-  END DO
-  DO l = 1, nlay - 2
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. alim_star(ig,l)>1.E-10 .AND. &
-          zw2(ig,l)<1E-10) THEN
-        f_star(ig, l+1) = alim_star(ig, l)
-        ! test:calcul de dteta
-        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
-          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
-      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+alim_star(ig, &
-          l))>1.E-10) THEN
-        ! estimation du detrainement a partir de la geometrie du pas
-        ! precedent
-        ! tests sur la definition du detr
-        nu(ig, l) = (nu_min+nu_max)/2.*(1.-(nu_max-nu_min)/(nu_max+nu_min)* &
-          tanh((((ztva(ig,l-1)-ztv(ig,l))/ztv(ig,l))/0.0005)))
-
-        detr_star(ig, l) = rhobarz(ig, l)*sqrt(zw2(ig,l))/ &
-          (r_aspect*zmax0_sec(ig))* & ! s
-                                      ! /(r_aspect*zmax0(ig))*
-          (sqrt(nu(ig,l)*zlev(ig,l+1)/sqrt(zw2(ig,l)))-sqrt(nu(ig,l)*zlev(ig, &
-          l)/sqrt(zw2(ig,l))))
-        detr_star(ig, l) = detr_star(ig, l)/f0(ig)
-        IF ((detr_star(ig,l))>f_star(ig,l)) THEN
-          detr_star(ig, l) = f_star(ig, l)
-        END IF
-        entr_star(ig, l) = 0.9*detr_star(ig, l)
-        IF ((l<lentr(ig))) THEN
-          entr_star(ig, l) = 0.
-          ! detr_star(ig,l)=0.
-        END IF
-        ! print*,'ok detr_star'
-        ! prise en compte du detrainement dans le calcul du flux
-        f_star(ig, l+1) = f_star(ig, l) + alim_star(ig, l) + &
-          entr_star(ig, l) - detr_star(ig, l)
-        ! test sur le signe de f_star
-        IF ((f_star(ig,l+1)+detr_star(ig,l))>1.E-10) THEN
-          ! AM on melange Tl et qt du thermique
-          ztva(ig, l) = (f_star(ig,l)*ztva(ig,l-1)+(entr_star(ig, &
-            l)+alim_star(ig,l))*ztv(ig,l))/(f_star(ig,l+1)+detr_star(ig,l))
-          zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/(f_star(ig, &
-            l+1)+detr_star(ig,l)))**2 + 2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, &
-            l)*(zlev(ig,l+1)-zlev(ig,l))
-        END IF
-      END IF
-
-      IF (zw2(ig,l+1)<0.) THEN
-        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
-          ig,l))
-        zw2(ig, l+1) = 0.
-        ! print*,'linter=',linter(ig)
-      ELSE
-        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
-      END IF
-      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
-        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
-        lmix(ig) = l + 1
-        wmaxa(ig) = wa_moy(ig, l+1)
-      END IF
-    END DO
-  END DO
-  ! print*,'fin calcul zw2'
-
-  ! Calcul de la couche correspondant a la hauteur du thermique
-  DO ig = 1, ngrid
-    lmax(ig) = lentr(ig)
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, lentr(ig) + 1, -1
-      IF (zw2(ig,l)<=1.E-10) THEN
-        lmax(ig) = l - 1
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>1) THEN
-      lmax(ig) = 1
-      lmin(ig) = 1
-      lentr(ig) = 1
-    END IF
-  END DO
-
-  ! Determination de zw2 max
-  DO ig = 1, ngrid
-    wmax(ig) = 0.
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig)) THEN
-        IF (zw2(ig,l)<0.) THEN
-          ! print*,'pb2 zw2<0'
-        END IF
-        zw2(ig, l) = sqrt(zw2(ig,l))
-        wmax(ig) = max(wmax(ig), zw2(ig,l))
-      ELSE
-        zw2(ig, l) = 0.
-      END IF
-    END DO
-  END DO
-
-  ! Longueur caracteristique correspondant a la hauteur des thermiques.
-  DO ig = 1, ngrid
-    zmax(ig) = 0.
-    zlevinter(ig) = zlev(ig, 1)
-  END DO
-  DO ig = 1, ngrid
-    ! calcul de zlevinter
-    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
-      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-    ! pour le cas ou on prend tjs lmin=1
-    ! zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
-    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,1))
-    zmax0_sec(ig) = zmax(ig)
-  END DO
-
-  RETURN
-END SUBROUTINE fermeture_seche
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_alim.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_alim.F90	(revision 4726)
+++ 	(revision )
@@ -1,123 +1,0 @@
-!
-! $Id: thermcell_plume.F90 2311 2015-06-25 07:45:24Z emillour $
-!
-      SUBROUTINE thermcell_alim(flag,ngrid,klev,ztv,d_temp,zlev,alim_star,lalim)
-IMPLICIT NONE
-
-!--------------------------------------------------------------------------
-! FH : 2015/11/06
-! thermcell_alim: calcule la distribution verticale de l'alimentation 
-! laterale a la base des panaches thermiques
-!--------------------------------------------------------------------------
-
-      INTEGER, INTENT(IN) :: ngrid,klev
-      REAL, INTENT(IN) :: ztv(ngrid,klev)
-      REAL, INTENT(IN) :: d_temp(ngrid)
-      REAL, INTENT(IN) :: zlev(ngrid,klev+1)
-      REAL, INTENT(OUT) :: alim_star(ngrid,klev)
-      INTEGER, INTENT(OUT) :: lalim(ngrid)
-      INTEGER, INTENT(IN) :: flag
-
-      REAL :: alim_star_tot(ngrid),zi(ngrid),zh(ngrid)
-      REAL :: zlay(ngrid,klev)
-      REAL ztv_parcel
-
-      INTEGER ig,l
-
-      REAL h,z,falim
-      falim(h,z)=0.2*((z-h)**5+h**5)
-
-
-!===================================================================
-
-   lalim(:)=1
-   alim_star_tot(:)=0.
-
-!-------------------------------------------------------------------------
-! Definition de l'alimentation
-!-------------------------------------------------------------------------
-   IF (flag==0) THEN ! CMIP5 version
-      do l=1,klev-1
-         do ig=1,ngrid
-            if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) then
-               alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
-     &                       *sqrt(zlev(ig,l+1)) 
-               lalim(ig)=l+1
-               alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
-            endif
-         enddo
-      enddo
-      do l=1,klev
-         do ig=1,ngrid 
-            if (alim_star_tot(ig) > 1.e-10 ) then
-               alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
-            endif
-         enddo
-      enddo
-      alim_star_tot(:)=1.
-
-!-------------------------------------------------------------------------
-! Nouvelle definition avec possibilite d'introduire un DT en surface
-! On suppose que la forme du profile d'alimentation scale avec la hauteur
-! d'inversion calculée avec une particule partant de la premieere couche
-
-! Fonction  f(z) = z ( h - z ) , avec h = zi/3
-! On utilise l'integralle
-! Int_0^z f(z') dz' = z^2 ( h/2 - z/3 ) = falim(h,z)
-! Pour calculer l'alimentation des couches
-!-------------------------------------------------------------------------
-   ELSE
-! Computing inversion height zi and zh=zi/3.
-      zi(:)=0.
-! Il faut recalculer zlay qui n'est pas dispo dans thermcell_plume
-! A changer eventuellement.
-      do l=1,klev
-         zlay(:,l)=0.5*(zlev(:,l)+zlev(:,l+1))
-      enddo
-
-      do l=klev-1,1,-1
-         do ig=1,ngrid
-            ztv_parcel=ztv(ig,1)+d_temp(ig)
-            if (ztv_parcel<ztv(ig,l+1)) lalim(ig)=l
-         enddo
-      enddo
-
-      do ig=1,ngrid
-         l=lalim(ig)
-         IF (l==1) THEN
-            zi(ig)=0.
-         ELSE
-            ztv_parcel=ztv(ig,1)+d_temp(ig)
-            zi(ig)=zlay(ig,l)+(zlay(ig,l+1)-zlay(ig,l))/(ztv(ig,l+1)-ztv(ig,l))*(ztv_parcel-ztv(ig,l))
-         ENDIF
-      enddo
-
-      zh(:)=zi(:)/2.
-      alim_star_tot(:)=0.
-      alim_star(:,:)=0.
-      lalim(:)=0
-      do l=1,klev-1
-         do ig=1,ngrid
-            IF (zh(ig)==0.) THEN
-               alim_star(ig,l)=0.
-               lalim(ig)=1
-            ELSE IF (zlev(ig,l+1)<=zh(ig)) THEN
-               alim_star(ig,l)=(falim(zh(ig),zlev(ig,l+1))-falim(zh(ig),zlev(ig,l)))/falim(zh(ig),zh(ig))
-               lalim(ig)=l
-            ELSE IF (zlev(ig,l)<=zh(ig)) THEN
-               alim_star(ig,l)=(falim(zh(ig),zh(ig))-falim(zh(ig),zlev(ig,l)))/falim(zh(ig),zh(ig))
-               lalim(ig)=l
-            ELSE
-               alim_star(ig,l)=0.
-            ENDIF
-         ENDDO
-         alim_star_tot(:)=alim_star_tot(:)+alim_star(:,l)
-      ENDDO
-      IF (ngrid==1) print*,'NEW ALIM CALCUL DE ZI ',alim_star_tot,lalim,zi,zh
-      alim_star_tot(:)=1.
-
-   ENDIF
-
-
-RETURN
-END
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_alp.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_alp.F90	(revision 4726)
+++ 	(revision )
@@ -1,400 +1,0 @@
-! $Id: thermcell_main.F90 2351 2015-08-25 15:14:59Z emillour $
-!
-      SUBROUTINE thermcell_alp(ngrid,nlay,ptimestep  &                         ! in
-     &                  ,pplay,pplev  &                                        ! in
-     &                  ,fm0,entr0,lmax  &                                     ! in
-     &                  ,pbl_tke,pctsrf,omega,airephy &                        ! in
-     &                  ,zw2,fraca &                                           ! in
-     &                  ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &  ! in
-!
-     &                  ,ale_bl,alp_bl,lalim_conv,wght_th &                    ! out
-     &                  ,zlcl,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &   ! out
-     &                  ,n2,s2,ale_bl_stat &                                   ! out
-     &                  ,therm_tke_max,env_tke_max &                           ! out
-     &                  ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &          ! out
-     &                  ,alp_bl_conv,alp_bl_stat &                             ! out
-     &)
-
-      USE indice_sol_mod
-      IMPLICIT NONE
-
-!=======================================================================
-!
-!   Auteurs: Catherine Rio
-!   Modifications :
-!   Nicolas Rochetin et Jean-Yves Grandpeix
-!         pour la fermeture stochastique. 2012
-!   Frédéric Hourdin :
-!         netoyage informatique. 2022
-!   
-!=======================================================================
-!-----------------------------------------------------------------------
-!   declarations:
-!   -------------
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-#include "alpale.h"
-
-!   arguments:
-!   ----------
-
-!------Entrees
-      integer, intent(in) :: ngrid,nlay
-      real, intent(in) :: ptimestep
-      real, intent(in) :: pplay(ngrid,nlay),pplev(ngrid,nlay+1)
-      integer, intent(in), dimension(ngrid) ::lmax,lalim
-      real, intent(in), dimension(ngrid) :: zmax
-      real, intent(in), dimension(ngrid,nlay+1) :: zw2
-      real, intent(in), dimension(ngrid,nlay+1) :: fraca
-      real, intent(in), dimension(ngrid,nlay) :: wth3
-      real, intent(in), dimension(ngrid,nlay) :: rhobarz
-      real, intent(in), dimension(ngrid) :: wmax_sec
-      real, intent(in), dimension(ngrid,nlay) :: entr0
-      real, intent(in), dimension(ngrid,nlay+1) :: fm0,fm
-      real, intent(in), dimension(ngrid) :: pcon
-      real, intent(in), dimension(ngrid,nlay) :: alim_star
-      real, intent(in), dimension(ngrid,nlay+1,nbsrf) :: pbl_tke
-      real, intent(in), dimension(ngrid,nbsrf) :: pctsrf
-      real, intent(in), dimension(ngrid,nlay) :: omega
-      real, intent(in), dimension(ngrid) :: airephy
-!------Sorties
-      real, intent(out), dimension(ngrid) :: ale_bl,alp_bl
-      real, intent(out), dimension(ngrid,nlay) :: wght_th
-      integer, intent(out), dimension(ngrid) :: lalim_conv
-      real, intent(out), dimension(ngrid) :: zlcl,fraca0,w0,w_conv
-      real, intent(out), dimension(ngrid) :: therm_tke_max0,env_tke_max0,n2,s2,ale_bl_stat
-      real, intent(out), dimension(ngrid,nlay) :: therm_tke_max,env_tke_max
-      real, intent(out), dimension(ngrid) :: alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke
-      real, intent(out), dimension(ngrid) :: alp_bl_conv,alp_bl_stat
-
-!=============================================================================================
-!------Local
-!=============================================================================================
-
-      REAL susqr2pi, reuler
-      INTEGER ig,k,l
-      integer nsrf
-      real rhobarz0(ngrid)                    ! Densité au LCL
-      logical ok_lcl(ngrid)                   ! Existence du LCL des thermiques
-      integer klcl(ngrid)                     ! Niveau du LCL
-      real interp(ngrid)                      ! Coef d'interpolation pour le LCL
-!--Triggering
-      real, parameter :: su_cst=4e4              ! Surface unite: celle d'un updraft élémentaire
-      real, parameter :: hcoef=1             ! Coefficient directeur pour le calcul de s2
-      real, parameter :: hmincoef=0.3        ! Coefficient directeur pour l'ordonnée à l'origine pour le calcul de s2 
-      real, parameter :: eps1=0.3            ! Fraction de surface occupée par la population 1 : eps1=n1*s1/(fraca0*Sd)
-      real, dimension(ngrid) :: hmin         ! Ordonnée à l'origine pour le calcul de s2
-      real, dimension(ngrid) :: zmax_moy     ! Hauteur moyenne des thermiques : zmax_moy = zlcl + 0.33 (zmax-zlcl)
-      real, parameter :: zmax_moy_coef=0.33
-      real, dimension(ngrid) :: depth        ! Epaisseur moyenne du cumulus
-      real, dimension(ngrid) ::  w_max                 ! Vitesse max statistique 
-      real, dimension(ngrid) ::  s_max(ngrid)
-!--Closure
-      real, dimension(ngrid,nlay) :: pbl_tke_max       ! Profil de TKE moyenne 
-      real, dimension(ngrid) :: pbl_tke_max0           ! TKE moyenne au LCL
-      real, dimension(ngrid,nlay) :: w_ls              ! Vitesse verticale grande échelle (m/s)
-      real, parameter :: coef_m=1.            ! On considère un rendement pour alp_bl_fluct_m
-      real, parameter :: coef_tke=1.          ! On considère un rendement pour alp_bl_fluct_tke
-      real :: zdp
-      real, dimension(ngrid) :: alp_int,dp_int
-      real, dimension(ngrid) :: fm_tot
-
-!------------------------------------------------------------
-!  Initialize output arrays related to stochastic triggering
-!------------------------------------------------------------
-  DO ig = 1,ngrid
-     zlcl(ig) = 0.
-     fraca0(ig) = 0.
-     w0(ig) = 0.
-     w_conv(ig) = 0.
-     therm_tke_max0(ig) = 0.
-     env_tke_max0(ig) = 0.
-     n2(ig) = 0.
-     s2(ig) = 0.
-     ale_bl_stat(ig) = 0.
-     alp_bl_det(ig) = 0.
-     alp_bl_fluct_m(ig) = 0.
-     alp_bl_fluct_tke(ig) = 0.
-     alp_bl_conv(ig) = 0.
-     alp_bl_stat(ig) = 0.
-  ENDDO
-  DO l = 1,nlay
-    DO ig = 1,ngrid
-     therm_tke_max(ig,l) = 0.
-     env_tke_max(ig,l) = 0.
-    ENDDO
-  ENDDO
-
-!------------Test sur le LCL des thermiques
-    do ig=1,ngrid
-      ok_lcl(ig)=.false.
-      if ( (pcon(ig) .gt. pplay(ig,nlay-1)) .and. (pcon(ig) .lt. pplay(ig,1)) ) ok_lcl(ig)=.true.
-    enddo
-
-!------------Localisation des niveaux entourant le LCL et du coef d'interpolation
-    do l=1,nlay-1
-      do ig=1,ngrid
-        if (ok_lcl(ig)) then 
-!ATTENTION,zw2 calcule en pplev
-!          if ((pplay(ig,l) .ge. pcon(ig)) .and. (pplay(ig,l+1) .le. pcon(ig))) then
-!          klcl(ig)=l
-!          interp(ig)=(pcon(ig)-pplay(ig,klcl(ig)))/(pplay(ig,klcl(ig)+1)-pplay(ig,klcl(ig)))
-!          endif
-          if ((pplev(ig,l) .ge. pcon(ig)) .and. (pplev(ig,l+1) .le. pcon(ig))) then
-          klcl(ig)=l
-          interp(ig)=(pcon(ig)-pplev(ig,klcl(ig)))/(pplev(ig,klcl(ig)+1)-pplev(ig,klcl(ig)))
-          endif
-        endif
-      enddo
-    enddo
-
-    do ig =1,ngrid
-!CR:REHABILITATION ZMAX CONTINU
-     if (ok_lcl(ig)) then 
-      rhobarz0(ig)=rhobarz(ig,klcl(ig))+(rhobarz(ig,klcl(ig)+1) &
- &               -rhobarz(ig,klcl(ig)))*interp(ig)
-      zlcl(ig)=(pplev(ig,1)-pcon(ig))/(rhobarz0(ig)*RG)
-      zlcl(ig)=min(zlcl(ig),zmax(ig))   ! Si zlcl > zmax alors on pose zlcl = zmax
-     else
-      rhobarz0(ig)=0.
-      zlcl(ig)=zmax(ig)
-     endif
-    enddo
-!!jyg fin
-
-!------------Calcul des propriétés du thermique au LCL 
-  IF ( (iflag_trig_bl.ge.1) .or. (iflag_clos_bl.ge.1) ) THEN 
-
-  !-----Initialisation de la TKE moyenne 
-   do l=1,nlay
-    do ig=1,ngrid
-     pbl_tke_max(ig,l)=0.
-    enddo
-   enddo
-
-!-----Calcul de la TKE moyenne 
-   do nsrf=1,nbsrf
-    do l=1,nlay
-     do ig=1,ngrid
-     pbl_tke_max(ig,l)=pctsrf(ig,nsrf)*pbl_tke(ig,l,nsrf)+pbl_tke_max(ig,l)
-     enddo
-    enddo
-   enddo
-
-!-----Initialisations des TKE dans et hors des thermiques 
-   do l=1,nlay
-    do ig=1,ngrid
-    therm_tke_max(ig,l)=pbl_tke_max(ig,l)
-    env_tke_max(ig,l)=pbl_tke_max(ig,l)
-    enddo
-   enddo
-
-!-----Calcul de la TKE transportée par les thermiques : therm_tke_max
-   call thermcell_tke_transport(ngrid,nlay,ptimestep,fm0,entr0,  &  ! in
-  &           rg,pplev,therm_tke_max)                               ! out
-!   print *,' thermcell_tke_transport -> '   !!jyg
-
-!-----Calcul des profils verticaux de TKE hors thermiques : env_tke_max, et de la vitesse verticale grande échelle : W_ls
-   do l=1,nlay
-    do ig=1,ngrid
-     pbl_tke_max(ig,l)=fraca(ig,l)*therm_tke_max(ig,l)+(1.-fraca(ig,l))*env_tke_max(ig,l)         !  Recalcul de TKE moyenne aprés transport de TKE_TH
-     env_tke_max(ig,l)=(pbl_tke_max(ig,l)-fraca(ig,l)*therm_tke_max(ig,l))/(1.-fraca(ig,l))       !  Recalcul de TKE dans  l'environnement aprés transport de TKE_TH
-     w_ls(ig,l)=-1.*omega(ig,l)/(RG*rhobarz(ig,l))                                                !  Vitesse verticale de grande échelle
-    enddo
-   enddo
-!    print *,' apres w_ls = '   !!jyg
-
-  do ig=1,ngrid
-   if (ok_lcl(ig)) then
-     fraca0(ig)=fraca(ig,klcl(ig))+(fraca(ig,klcl(ig)+1) &
- &             -fraca(ig,klcl(ig)))*interp(ig)
-     w0(ig)=zw2(ig,klcl(ig))+(zw2(ig,klcl(ig)+1) &
- &         -zw2(ig,klcl(ig)))*interp(ig)
-     w_conv(ig)=w_ls(ig,klcl(ig))+(w_ls(ig,klcl(ig)+1) &
- &             -w_ls(ig,klcl(ig)))*interp(ig)
-     therm_tke_max0(ig)=therm_tke_max(ig,klcl(ig)) &
- &                     +(therm_tke_max(ig,klcl(ig)+1)-therm_tke_max(ig,klcl(ig)))*interp(ig)
-     env_tke_max0(ig)=env_tke_max(ig,klcl(ig))+(env_tke_max(ig,klcl(ig)+1) &
- &                   -env_tke_max(ig,klcl(ig)))*interp(ig)
-     pbl_tke_max0(ig)=pbl_tke_max(ig,klcl(ig))+(pbl_tke_max(ig,klcl(ig)+1) &
- &                   -pbl_tke_max(ig,klcl(ig)))*interp(ig)
-     if (therm_tke_max0(ig).ge.20.) therm_tke_max0(ig)=20.
-     if (env_tke_max0(ig).ge.20.) env_tke_max0(ig)=20.
-     if (pbl_tke_max0(ig).ge.20.) pbl_tke_max0(ig)=20.
-   else 
-     fraca0(ig)=0.
-     w0(ig)=0.
-!!jyg le 27/04/2012
-!!     zlcl(ig)=0.
-!!
-   endif
-  enddo
-
-  ENDIF ! IF ( (iflag_trig_bl.ge.1) .or. (iflag_clos_bl.ge.1) )
-!  print *,'ENDIF  ( (iflag_trig_bl.ge.1) .or. (iflag_clos_bl.ge.1) ) '    !!jyg
-
-!------------Triggering------------------
-  IF (iflag_trig_bl.ge.1) THEN 
-
-!-----Initialisations
-   depth(:)=0.
-   n2(:)=0.
-   s2(:)=100. ! some low value, arbitrary
-   s_max(:)=0.
-
-!-----Epaisseur du nuage (depth) et détermination de la queue du spectre de panaches (n2,s2) et du panache le plus gros (s_max)
-   do ig=1,ngrid
-     zmax_moy(ig)=zlcl(ig)+zmax_moy_coef*(zmax(ig)-zlcl(ig))
-     depth(ig)=zmax_moy(ig)-zlcl(ig)
-     hmin(ig)=hmincoef*zlcl(ig)
-     if (depth(ig).ge.10.) then 
-       s2(ig)=(hcoef*depth(ig)+hmin(ig))**2
-       n2(ig)=(1.-eps1)*fraca0(ig)*airephy(ig)/s2(ig)
-!!
-!!jyg le 27/04/2012
-!!       s_max(ig)=s2(ig)*log(n2(ig))
-!!       if (n2(ig) .lt. 1) s_max(ig)=0.
-       s_max(ig)=s2(ig)*log(max(n2(ig),1.))
-!!fin jyg
-     else
-       n2(ig)=0.
-       s_max(ig)=0.
-     endif
-   enddo
-!   print *,'avant Calcul de Wmax '    !!jyg
-
-   susqr2pi=su_cst*sqrt(2.*Rpi)
-   reuler=exp(1.)
-   do ig=1,ngrid
-     if ( (depth(ig).ge.10.) .and. (s_max(ig).gt.susqr2pi*reuler) ) then
-      w_max(ig)=w0(ig)*(1.+sqrt(2.*log(s_max(ig)/susqr2pi)-log(2.*log(s_max(ig)/susqr2pi))))
-      ale_bl_stat(ig)=0.5*w_max(ig)**2
-     else
-      w_max(ig)=0.
-      ale_bl_stat(ig)=0.
-     endif
-   enddo
-
-  ENDIF ! iflag_trig_bl
-!  print *,'ENDIF  iflag_trig_bl'    !!jyg
-
-!------------Closure------------------
-
-  IF (iflag_clos_bl.ge.2) THEN 
-
-!-----Calcul de ALP_BL_STAT
-  do ig=1,ngrid
-  alp_bl_det(ig)=0.5*coef_m*rhobarz0(ig)*(w0(ig)**3)*fraca0(ig)*(1.-2.*fraca0(ig))/((1.-fraca0(ig))**2)
-  alp_bl_fluct_m(ig)=1.5*rhobarz0(ig)*fraca0(ig)*(w_conv(ig)+coef_m*w0(ig))* &
- &                   (w0(ig)**2)
-  alp_bl_fluct_tke(ig)=3.*coef_m*rhobarz0(ig)*w0(ig)*fraca0(ig)*(therm_tke_max0(ig)-env_tke_max0(ig)) &
- &                    +3.*rhobarz0(ig)*w_conv(ig)*pbl_tke_max0(ig)
-    if (iflag_clos_bl.ge.2) then 
-    alp_bl_conv(ig)=1.5*coef_m*rhobarz0(ig)*fraca0(ig)*(fraca0(ig)/(1.-fraca0(ig)))*w_conv(ig)* &
- &                   (w0(ig)**2)
-    else
-    alp_bl_conv(ig)=0.
-    endif
-  alp_bl_stat(ig)=alp_bl_det(ig)+alp_bl_fluct_m(ig)+alp_bl_fluct_tke(ig)+alp_bl_conv(ig)
-  enddo
-
-!-----Sécurité ALP infinie
-  do ig=1,ngrid
-   if (fraca0(ig).gt.0.98) alp_bl_stat(ig)=2.
-  enddo
-
-  ENDIF ! (iflag_clos_bl.ge.2)
-
-!!! fin nrlmd le 10/04/2012
-
-!      print*,'avant calcul ale et alp' 
-!calcul de ALE et ALP pour la convection
-      alp_bl(:)=0.
-      ale_bl(:)=0.
-!          print*,'ALE,ALP ,l,zw2(ig,l),ale_bl(ig),alp_bl(ig)'
-      do l=1,nlay
-      do ig=1,ngrid
-           alp_bl(ig)=max(alp_bl(ig),0.5*rhobarz(ig,l)*wth3(ig,l) )
-           ale_bl(ig)=max(ale_bl(ig),0.5*zw2(ig,l)**2)
-!          print*,'ALE,ALP',l,zw2(ig,l),ale_bl(ig),alp_bl(ig)
-      enddo
-      enddo
-
-! ale sec (max de wmax/2 sous la zone d'inhibition) dans
-! le cas iflag_trig_bl=3
-      IF (iflag_trig_bl==3) ale_bl(:)=0.5*wmax_sec(:)**2
-
-!test:calcul de la ponderation des couches pour KE
-!initialisations
-
-      fm_tot(:)=0.
-      wght_th(:,:)=1.
-      lalim_conv(:)=lalim(:)
-
-      do k=1,nlay
-         do ig=1,ngrid
-            if (k<=lalim_conv(ig)) fm_tot(ig)=fm_tot(ig)+fm(ig,k)
-         enddo
-      enddo
-
-! assez bizarre car, si on est dans la couche d'alim et que alim_star et
-! plus petit que 1.e-10, on prend wght_th=1.
-      do k=1,nlay
-         do ig=1,ngrid
-            if (k<=lalim_conv(ig).and.alim_star(ig,k)>1.e-10) then
-               wght_th(ig,k)=alim_star(ig,k)
-            endif
-         enddo
-      enddo
-
-!      print*,'apres wght_th'
-!test pour prolonger la convection
-      do ig=1,ngrid
-!v1d  if ((alim_star(ig,1).lt.1.e-10).and.(therm)) then
-      if ((alim_star(ig,1).lt.1.e-10)) then
-      lalim_conv(ig)=1
-      wght_th(ig,1)=1.
-!      print*,'lalim_conv ok',lalim_conv(ig),wght_th(ig,1)
-      endif
-      enddo
-
-!------------------------------------------------------------------------
-! Modif CR/FH 20110310 : alp integree sur la verticale.
-! Integrale verticale de ALP.
-! wth3 etant aux niveaux inter-couches, on utilise d play comme masse des
-! couches
-!------------------------------------------------------------------------
-
-      alp_int(:)=0.
-      dp_int(:)=0.
-      do l=2,nlay
-        do ig=1,ngrid
-           if(l.LE.lmax(ig)) THEN
-           zdp=pplay(ig,l-1)-pplay(ig,l)
-           alp_int(ig)=alp_int(ig)+0.5*rhobarz(ig,l)*wth3(ig,l)*zdp
-           dp_int(ig)=dp_int(ig)+zdp
-           endif
-        enddo
-      enddo
-
-      if (iflag_coupl>=3 .and. iflag_coupl<=5) then
-      do ig=1,ngrid
-!valeur integree de alp_bl * 0.5:
-        if (dp_int(ig)>0.) then
-        alp_bl(ig)=alp_int(ig)/dp_int(ig)
-        endif
-      enddo!
-      endif
-
-
-! Facteur multiplicatif sur alp_bl
-      alp_bl(:)=alp_bl_k*alp_bl(:)
-
-!------------------------------------------------------------------------
-
-
-
-      return
-      end
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_closure.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_closure.F90	(revision 4726)
+++ 	(revision )
@@ -1,71 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE thermcell_closure(ngrid,nlay,r_aspect,ptimestep,rho,  &
-     &   zlev,lalim,alim_star,zmax,wmax,f)
-
-!-------------------------------------------------------------------------
-!thermcell_closure: fermeture, determination de f
-!
-! Modification 7 septembre 2009
-! 1. On enleve alim_star_tot des arguments pour le recalculer et etre ainis
-! coherent avec l'integrale au numerateur.
-! 2. On ne garde qu'une version des couples wmax,zmax et wmax_sec,zmax_sec
-! l'idee etant que le choix se fasse a l'appel de thermcell_closure
-! 3. Vectorisation en mettant les boucles en l l'exterieur avec des if
-!-------------------------------------------------------------------------
-      IMPLICIT NONE
-
-! --- arguments ------------------------------------------
-integer, intent(in) :: ngrid,nlay
-real, intent(in) :: r_aspect,ptimestep
-real, intent(in), dimension(ngrid,nlay) :: alim_star,rho,zlev
-integer, intent(in), dimension(ngrid) :: lalim
-real, intent(in), dimension(ngrid) :: zmax,wmax
-
-real, intent(out), dimension(ngrid) :: f
-
-
-! --- local ------------------------------------------
-real, dimension(ngrid) :: zdenom,alim_star2,alim_star_tot
-INTEGER llmax
-INTEGER ig,k       
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!print*,'THERMCELL CLOSURE 26E'
-
-alim_star2(:)=0.
-alim_star_tot(:)=0.
-f(:)=0.
-
-! Indice vertical max (max de lalim) atteint par les thermiques sur le domaine
-llmax=1
-do ig=1,ngrid
-   if (lalim(ig)>llmax) llmax=lalim(ig)
-enddo
-
-
-! Calcul des integrales sur la verticale de alim_star et de
-!   alim_star^2/(rho dz)
-do k=1,llmax-1
-   do ig=1,ngrid
-      if (k<lalim(ig)) then
-         alim_star2(ig)=alim_star2(ig)+alim_star(ig,k)**2  &
-&                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
-         alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,k)
-      endif
-   enddo
-enddo
-
-
-do ig=1,ngrid
-   if (alim_star2(ig)>1.e-10) then
-      f(ig)=wmax(ig)*alim_star_tot(ig)/  &
-&     (max(500.,zmax(ig))*r_aspect*alim_star2(ig))
-   endif
-enddo
-
-
-
- RETURN
-      end
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_down.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_down.F90	(revision 4726)
+++ 	(revision )
@@ -1,300 +1,0 @@
-SUBROUTINE thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,eup,dup,edn,ddn,masse,trac,dtrac)
-
-USE thermcell_ini_mod, ONLY: iflag_thermals_down
-
-
-!-----------------------------------------------------------------
-! thermcell_updown_dq: computes the tendency of tracers associated
-! with the presence of convective up/down drafts
-! This routine that has been collectively written during the 
-! "ateliers downdrafts" in 2022/2023
-! Maelle, Frédéric, Catherine, Fleur, Florent, Etienne
-!------------------------------------------------------------------
-
-
-   IMPLICIT NONE
-
-! declarations
-!==============================================================
-
-! input/output
-
-   integer,intent(in)  :: ngrid ! number of horizontal grid points
-   integer, intent(in) :: nlay  ! number of vertical layers
-   real,intent(in) :: ptimestep ! time step of the physics [s]
-   real,intent(in), dimension(ngrid,nlay) :: eup ! entrainment to updrafts * dz [same unit as flux]
-   real,intent(in), dimension(ngrid,nlay) :: dup ! detrainment from updrafts * dz [same unit as flux]
-   real,intent(in), dimension(ngrid,nlay) :: edn ! entrainment to downdrafts * dz [same unit as flux]
-   real,intent(in), dimension(ngrid,nlay) :: ddn ! detrainment from downdrafts * dz [same unit as flux]
-   real,intent(in), dimension(ngrid,nlay) :: masse ! mass of layers = rho dz 
-   real,intent(in), dimension(ngrid,nlay) :: trac ! tracer 
-   integer, intent(in), dimension(ngrid) :: lmax ! max level index at which downdraft are present
-   real,intent(out),dimension(ngrid,nlay) ::dtrac ! tendance du traceur
-
-   
-! Local
-
-   real, dimension(ngrid,nlay+1) :: fup,fdn,fc,fthu,fthd,fthe,fthtot
-   real, dimension(ngrid,nlay) :: tracu,tracd,traci,tracold
-   real :: www, mstar_inv
-   integer ig,ilay
-   real, dimension(ngrid,nlay):: s1,s2,num !coefficients pour la resolution implicite
-   integer :: iflag_impl=1 ! 0 pour explicite, 1 pour implicite "classique", 2 pour implicite avec entrainement et detrainement
-   
-   fdn(:,:)=0.
-   fup(:,:)=0.
-   fc(:,:)=0.
-   fthu(:,:)=0.
-   fthd(:,:)=0.
-   fthe(:,:)=0.
-   fthtot(:,:)=0.
-   tracd(:,:)=0.
-   tracu(:,:)=0.
-   traci(:,:)=trac(:,:)
-   tracold(:,:)=trac(:,:)
-   s1(:,:)=0.
-   s2(:,:)=0.
-   num(:,:)=1.
-
-   if ( iflag_thermals_down < 10 ) then
-      call abort_physic("thermcell_updown_dq", &
-           'thermcell_down_dq = 0 or >= 10', 1)
-   else
-        iflag_impl=iflag_thermals_down-10
-   endif
-      
-
-   ! lmax : indice tel que fu(kmax+1)=0
-   ! Dans ce cas, pas besoin d'initialiser tracd(lmax) ( =trac(lmax) )
-   ! Boucle pour le downdraft
-   do ilay=nlay,1,-1
-      do ig=1,ngrid
-         !if ( lmax(ig) > nlay - 2 ) stop "les thermiques montent trop haut"
-         if (ilay.le.lmax(ig) .and. lmax(ig)>1 ) then
-            fdn(ig,ilay)=fdn(ig,ilay+1)+edn(ig,ilay)-ddn(ig,ilay)
-            if ( fdn(ig,ilay)+ddn(ig,ilay) > 0. ) then
-               www=fdn(ig,ilay+1)/ (fdn(ig,ilay)+ddn(ig,ilay))
-            else
-               www=0.
-            endif
-            tracd(ig,ilay)=www*tracd(ig,ilay+1) + (1.-www)*trac(ig,ilay)
-         endif
-      enddo 
-   enddo !Fin boucle sur l'updraft
-   fdn(:,1)=0.
-
-   !Boucle pour l'updraft
-   do ilay=1,nlay,1
-      do ig=1,ngrid
-         if (ilay.lt.lmax(ig) .and. lmax(ig)>1) then
-            fup(ig,ilay+1)=fup(ig,ilay)+eup(ig,ilay)-dup(ig,ilay)
-            if (fup(ig,ilay+1)+dup(ig,ilay) > 0.) then
-               www=fup(ig,ilay)/(fup(ig,ilay+1)+dup(ig,ilay))
-            else
-               www=0.
-            endif
-            if (ilay == 1 ) then
-               tracu(ig,ilay)=trac(ig,ilay)
-            else
-               tracu(ig,ilay)=www*tracu(ig,ilay-1)+(1.-www)*trac(ig,ilay)
-            endif
-         endif
-      enddo 
-      enddo !fin boucle sur le downdraft
-
-   ! Calcul des flux des traceurs dans les updraft et les downdrfat 
-   ! et du flux de masse compensateur
-   ! en ilay=1 et nlay+1, fthu=0 et fthd=0
-   fthu(:,1)=0.
-   fthu(:,nlay+1)=0.
-   fthd(:,1)=0.
-   fthd(:,nlay+1)=0.
-   fc(:,1)=0.
-   fc(:,nlay+1)=0.
-   do ilay=2,nlay,1 !boucle sur les interfaces
-     do ig=1,ngrid
-       fthu(ig,ilay)=fup(ig,ilay)*tracu(ig,ilay-1)
-       fthd(ig,ilay)=-fdn(ig,ilay)*tracd(ig,ilay)
-       fc(ig,ilay)=fup(ig,ilay)-fdn(ig,ilay)
-     enddo
-   enddo
-   
-
-   !Boucle pour calculer le flux du traceur flux updraft, flux downdraft, flux compensatoire
-   !Methode explicite : 
-   if(iflag_impl==0) then
-     do ilay=2,nlay,1
-       do ig=1,ngrid
-         !!!!ATTENTION HYPOTHESE de FLUX COMPENSATOIRE DESCENDANT ET DONC comme schema amont on va chercher trac au dessus!!!!!
-         !!!! tentative de prise en compte d'un flux compensatoire montant  !!!!
-         if (fup(ig,ilay)-fdn(ig,ilay) .lt. 0.) then
-            call abort_physic("thermcell_updown_dq", 'flux compensatoire '&
-                 // 'montant, cas non traite par thermcell_updown_dq', 1)
-            !fthe(ig,ilay)=(fup(ig,ilay)-fdn(ig,ilay))*trac(ig,ilay-1)
-         else
-            fthe(ig,ilay)=-(fup(ig,ilay)-fdn(ig,ilay))*trac(ig,ilay)
-         endif
-         !! si on voulait le prendre en compte on
-         !fthe(ig,ilay)=-(fup(ig,ilay)-fdn(ig,ilay))*trac(ig,ilay-1)
-         fthtot(ig,ilay)=fthu(ig,ilay)+fthd(ig,ilay)+fthe(ig,ilay)
-       enddo
-     enddo
-     !Boucle pour calculer trac
-     do ilay=1,nlay
-       do ig=1,ngrid
-         dtrac(ig,ilay)=(fthtot(ig,ilay)-fthtot(ig,ilay+1))/masse(ig,ilay)
-!         trac(ig,ilay)=trac(ig,ilay) + (fthtot(ig,ilay)-fthtot(ig,ilay+1))*(ptimestep/masse(ig,ilay))
-       enddo
-     enddo !fin du calculer de la tendance du traceur avec la methode explicite
-
-   !!! Reecriture du schéma explicite avec les notations du schéma implicite
-   else if(iflag_impl==-1) then
-     write(*,*) 'nouveau schéma explicite !!!'
-     !!! Calcul de s1
-     do ilay=1,nlay
-       do ig=1,ngrid
-         s1(ig,ilay)=fthu(ig,ilay)-fthu(ig,ilay+1)+fthd(ig,ilay)-fthd(ig,ilay+1)
-         s2(ig,ilay)=s1(ig,ilay)+fthe(ig,ilay)-fthe(ig,ilay+1)
-       enddo
-     enddo
-
-     do ilay=2,nlay,1
-       do ig=1,ngrid
-         if (fup(ig,ilay)-fdn(ig,ilay) .lt. 0.) then
-            call abort_physic("thermcell_updown_dq", 'flux compensatoire ' &
-                 // 'montant, cas non traite par thermcell_updown_dq', 1)
-         else
-            fthe(ig,ilay)=-(fup(ig,ilay)-fdn(ig,ilay))*trac(ig,ilay)
-         endif
-         fthtot(ig,ilay)=fthu(ig,ilay)+fthd(ig,ilay)+fthe(ig,ilay)
-       enddo
-     enddo
-     !Boucle pour calculer trac
-     do ilay=1,nlay
-       do ig=1,ngrid
-         ! dtrac(ig,ilay)=(fthtot(ig,ilay)-fthtot(ig,ilay+1))/masse(ig,ilay)
-         dtrac(ig,ilay)=(s1(ig,ilay)+fthe(ig,ilay)-fthe(ig,ilay+1))/masse(ig,ilay)
-!         trac(ig,ilay)=trac(ig,ilay) + (fthtot(ig,ilay)-fthtot(ig,ilay+1))*(ptimestep/masse(ig,ilay))
-!         trac(ig,ilay)=trac(ig,ilay) + (s1(ig,ilay)+fthe(ig,ilay)-fthe(ig,ilay+1))*(ptimestep/masse(ig,ilay))
-       enddo
-     enddo !fin du calculer de la tendance du traceur avec la methode explicite
-
-   else if (iflag_impl==1) then
-     do ilay=1,nlay
-       do ig=1,ngrid
-         s1(ig,ilay)=fthu(ig,ilay)-fthu(ig,ilay+1)+fthd(ig,ilay)-fthd(ig,ilay+1)
-       enddo
-     enddo
-     
-     !Boucle pour calculer traci = trac((t+dt)
-     do ilay=nlay-1,1,-1
-       do ig=1,ngrid
-         if((fup(ig,ilay)-fdn(ig,ilay)) .lt. 0) then
-            write(*,*) 'flux compensatoire montant, cas non traite par thermcell_updown_dq dans le cas d une resolution implicite, ilay : ', ilay
-            call abort_physic("thermcell_updown_dq", "", 1)
-         else
-           mstar_inv=ptimestep/masse(ig,ilay)
-           traci(ig,ilay)=((traci(ig,ilay+1)*fc(ig,ilay+1)+s1(ig,ilay))*mstar_inv+tracold(ig,ilay))/(1.+fc(ig,ilay)*mstar_inv)
-         endif
-       enddo
-     enddo
-     do ilay=1,nlay
-       do ig=1,ngrid
-         dtrac(ig,ilay)=(traci(ig,ilay)-tracold(ig,ilay))/ptimestep
-       enddo
-     enddo
-
-   else
-      call abort_physic("thermcell_updown_dq", &
-           'valeur de iflag_impl non prevue', 1)
-   endif
-
- RETURN
-   END
-
-!=========================================================================
-
-   SUBROUTINE thermcell_down(ngrid,nlay,po,pt,pu,pv,pplay,pplev,  &
-     &           lmax,fup,eup,dup,theta)
-
-!--------------------------------------------------------------
-!thermcell_down: calcul des propri??t??s du panache descendant.
-!--------------------------------------------------------------
-
-
-   USE thermcell_ini_mod, ONLY : prt_level,RLvCp,RKAPPA,RETV,fact_thermals_down
-   IMPLICIT NONE
-
-! arguments
-
-   integer,intent(in) :: ngrid,nlay
-   real,intent(in), dimension(ngrid,nlay) :: po,pt,pu,pv,pplay,eup,dup
-   real,intent(in), dimension(ngrid,nlay) :: theta
-   real,intent(in), dimension(ngrid,nlay+1) :: pplev,fup
-   integer, intent(in), dimension(ngrid) :: lmax
-
-
-   
-! Local
-
-   real, dimension(ngrid,nlay) :: edn,ddn,thetad
-   real, dimension(ngrid,nlay+1) :: fdn
-
-   integer ig,ilay
-   real dqsat_dT
-   logical mask(ngrid,nlay)
-
-   edn(:,:)=0.
-   ddn(:,:)=0.
-   fdn(:,:)=0.
-   thetad(:,:)=0.
-
-   ! lmax : indice tel que fu(kmax+1)=0
-   
-   ! Dans ce cas, pas besoin d'initialiser thetad(lmax) ( =theta(lmax) )
-
-! FH MODIFS APRES REUNIONS POUR COMMISSIONS
-! quelques erreurs de declaration
-! probleme si lmax=1 ce qui a l'air d'??tre le cas en d??but de simu. Devrait ??tre 0 ?
-! Remarques :
-! on pourrait ??crire la formule de thetad
-!    www=fdn(ig,ilay+1)/ (fdn(ig,ilay)+ddn(ig,ilay))
-!    thetad(ig,ilay)= www * thetad(ig,ilay+1) + (1.-www) * theta(ig,ilay) 
-! Elle a l'avantage de bien montr?? la conservation, l'id??e fondamentale dans le 
-!   transport qu'on ne fait que sommer des "sources" au travers d'un "propagateur"
-!   (Green)
-! Elle montre aussi beaucoup plus clairement pourquoi on n'a pas ?? se souccier (trop)
-!   de la possible nulit?? du d??nominateur
-
-
-   do ilay=nlay,1,-1
-      do ig=1,ngrid
-         if (ilay.le.lmax(ig).and.lmax(ig)>1) then
-            edn(ig,ilay)=fact_thermals_down*dup(ig,ilay)
-            ddn(ig,ilay)=fact_thermals_down*eup(ig,ilay)
-            fdn(ig,ilay)=fdn(ig,ilay+1)+edn(ig,ilay)-ddn(ig,ilay)
-            thetad(ig,ilay)=( fdn(ig,ilay+1)*thetad(ig,ilay+1) + edn(ig,ilay)*theta(ig,ilay) ) / (fdn(ig,ilay)+ddn(ig,ilay))
-         endif
-      enddo 
-   enddo
-
-   ! Suite du travail :
-   ! Ecrire la conservervation de theta_l dans le panache descendant
-   ! Eventuellement faire la transformation theta_l -> theta_v
-   ! Si l'air est sec (et qu'on oublie le c??t?? theta_v) on peut
-   ! se contenter de conserver theta.
-   !
-   ! Connaissant thetadn, on peut calculer la flotabilit??.
-   ! Connaissant la flotabilit??, on peut calculer w de proche en proche
-   ! On peut calculer le detrainement de facon ?? garder alpha*rho = cste
-   ! On en d??duit l'entrainement lat??ral
-   ! C'est le mod??le des mini-projets.
-
-!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-! Initialisations :
-!------------------
-
-
-!
- RETURN
-   END
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_dq.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_dq.F90	(revision 4726)
+++ 	(revision )
@@ -1,326 +1,0 @@
-      subroutine thermcell_dq(ngrid,nlay,impl,ptimestep,fm,entr,  &
-     &           masse,q,dq,qa,lev_out)
-      USE print_control_mod, ONLY: prt_level
-      implicit none
-
-!=======================================================================
-!
-!   Calcul du transport verticale dans la couche limite en presence
-!   de "thermiques" explicitement representes
-!   calcul du dq/dt une fois qu'on connait les ascendances
-!
-! Modif 2013/01/04 (FH hourdin@lmd.jussieu.fr)
-!  Introduction of an implicit computation of vertical advection in
-!  the environment of thermal plumes in thermcell_dq
-!  impl =     0 : explicit, 1 : implicit, -1 : old version
-!
-!=======================================================================
-
-! arguments
-      integer, intent(in) :: ngrid,nlay,impl
-      real, intent(in) :: ptimestep
-      real, intent(in), dimension(ngrid,nlay) :: masse
-      real, intent(inout), dimension(ngrid,nlay) :: entr,q
-      real, intent(in), dimension(ngrid,nlay+1) :: fm
-      real, intent(out), dimension(ngrid,nlay) :: dq,qa
-      integer, intent(in) :: lev_out                           ! niveau pour les print
-
-! Local
-      real, dimension(ngrid,nlay) :: detr,qold
-      real, dimension(ngrid,nlay+1) :: wqd,fqa
-      real zzm
-      integer ig,k
-      real cfl
-
-      integer niter,iter
-      CHARACTER (LEN=20) :: modname='thermcell_dq'
-      CHARACTER (LEN=80) :: abort_message
-
-
-! Old explicite scheme
-if (impl<=-1) then
-
-         call thermcell_dq_o(ngrid,nlay,impl,ptimestep,fm,entr,  &
-     &           masse,q,dq,qa,lev_out)
-
-else
-  
-
-! Calcul du critere CFL pour l'advection dans la subsidence
-      cfl = 0.
-      do k=1,nlay
-         do ig=1,ngrid
-            zzm=masse(ig,k)/ptimestep
-            cfl=max(cfl,fm(ig,k)/zzm)
-            if (entr(ig,k).gt.zzm) then
-               print*,'entr*dt>m,1',k,entr(ig,k)*ptimestep,masse(ig,k)
-               abort_message = 'entr dt > m, 1st'
-               CALL abort_physic (modname,abort_message,1)
-            endif
-         enddo
-      enddo
-
-      qold=q
-
-
-      if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0'
-
-!   calcul du detrainement
-      do k=1,nlay
-         do ig=1,ngrid
-            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
-!           print*,'Q2 DQ ',detr(ig,k),fm(ig,k),entr(ig,k)
-!test
-            if (detr(ig,k).lt.0.) then
-               entr(ig,k)=entr(ig,k)-detr(ig,k)
-               detr(ig,k)=0.
-!               print*,'detr2<0!!!','ig=',ig,'k=',k,'f=',fm(ig,k),
-!     s         'f+1=',fm(ig,k+1),'e=',entr(ig,k),'d=',detr(ig,k)
-            endif
-            if (fm(ig,k+1).lt.0.) then
-!               print*,'fm2<0!!!'
-            endif
-            if (entr(ig,k).lt.0.) then
-!               print*,'entr2<0!!!'
-            endif
-         enddo
-      enddo
-
-! Computation of tracer concentrations in the ascending plume
-      do ig=1,ngrid
-         qa(ig,1)=q(ig,1)
-      enddo
-
-      do k=2,nlay
-         do ig=1,ngrid
-            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
-     &         1.e-5*masse(ig,k)) then
-         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
-     &         /(fm(ig,k+1)+detr(ig,k))
-            else
-               qa(ig,k)=q(ig,k)
-            endif
-            if (qa(ig,k).lt.0.) then
-!               print*,'qa<0!!!'
-            endif
-            if (q(ig,k).lt.0.) then
-!               print*,'q<0!!!'
-            endif
-         enddo
-      enddo
-
-! Plume vertical flux
-      do k=2,nlay-1
-         fqa(:,k)=fm(:,k)*qa(:,k-1)
-      enddo
-      fqa(:,1)=0. ; fqa(:,nlay)=0.
-
-
-! Trace species evolution
-   if (impl==0) then
-      do k=1,nlay-1
-         q(:,k)=q(:,k)+(fqa(:,k)-fqa(:,k+1)-fm(:,k)*q(:,k)+fm(:,k+1)*q(:,k+1)) &
-     &               *ptimestep/masse(:,k)
-      enddo
-   else
-      do k=nlay-1,1,-1
-! FH debut de modif : le calcul ci dessous modifiait numériquement
-! la concentration quand le flux de masse etait nul car on divisait
-! puis multipliait par masse/ptimestep.
-!        q(:,k)=(masse(:,k)*q(:,k)/ptimestep+fqa(:,k)-fqa(:,k+1)+fm(:,k+1)*q(:,k+1)) &
-!    &               /(fm(:,k)+masse(:,k)/ptimestep)
-         q(:,k)=(q(:,k)+ptimestep/masse(:,k)*(fqa(:,k)-fqa(:,k+1)+fm(:,k+1)*q(:,k+1))) &
-      &               /(1.+fm(:,k)*ptimestep/masse(:,k))
-! FH fin de modif.
-      enddo
-   endif
-
-! Tendencies
-      do k=1,nlay
-         do ig=1,ngrid
-            dq(ig,k)=(q(ig,k)-qold(ig,k))/ptimestep
-            q(ig,k)=qold(ig,k)
-         enddo
-      enddo
-
-endif ! impl=-1
-RETURN
-end
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Obsolete version kept for convergence with Cmip5 NPv3.1 simulations
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      subroutine thermcell_dq_o(ngrid,nlay,impl,ptimestep,fm,entr,  &
-     &           masse,q,dq,qa,lev_out)
-      USE print_control_mod, ONLY: prt_level
-      implicit none
-
-!=======================================================================
-!
-!   Calcul du transport verticale dans la couche limite en presence
-!   de "thermiques" explicitement representes
-!   calcul du dq/dt une fois qu'on connait les ascendances
-!
-!=======================================================================
-
-      integer ngrid,nlay,impl
-
-      real ptimestep
-      real masse(ngrid,nlay),fm(ngrid,nlay+1)
-      real entr(ngrid,nlay)
-      real q(ngrid,nlay)
-      real dq(ngrid,nlay)
-      integer lev_out                           ! niveau pour les print
-
-      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
-
-      real zzm
-
-      integer ig,k
-      real cfl
-
-      real qold(ngrid,nlay)
-      real ztimestep
-      integer niter,iter
-      CHARACTER (LEN=20) :: modname='thermcell_dq'
-      CHARACTER (LEN=80) :: abort_message
-
-
-
-! Calcul du critere CFL pour l'advection dans la subsidence
-      cfl = 0.
-      do k=1,nlay
-         do ig=1,ngrid
-            zzm=masse(ig,k)/ptimestep
-            cfl=max(cfl,fm(ig,k)/zzm)
-            if (entr(ig,k).gt.zzm) then
-               print*,'entr*dt>m,2',k,entr(ig,k)*ptimestep,masse(ig,k)
-               abort_message = 'entr dt > m, 2nd'
-               CALL abort_physic (modname,abort_message,1)
-            endif
-         enddo
-      enddo
-
-!IM 090508     print*,'CFL CFL CFL CFL ',cfl
-
-#undef CFL
-#ifdef CFL
-! On subdivise le calcul en niter pas de temps.
-      niter=int(cfl)+1
-#else
-      niter=1
-#endif
-
-      ztimestep=ptimestep/niter
-      qold=q
-
-
-do iter=1,niter
-      if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0'
-
-!   calcul du detrainement
-      do k=1,nlay
-         do ig=1,ngrid
-            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
-!           print*,'Q2 DQ ',detr(ig,k),fm(ig,k),entr(ig,k)
-!test
-            if (detr(ig,k).lt.0.) then
-               entr(ig,k)=entr(ig,k)-detr(ig,k)
-               detr(ig,k)=0.
-!               print*,'detr2<0!!!','ig=',ig,'k=',k,'f=',fm(ig,k),
-!     s         'f+1=',fm(ig,k+1),'e=',entr(ig,k),'d=',detr(ig,k)
-            endif
-            if (fm(ig,k+1).lt.0.) then
-!               print*,'fm2<0!!!'
-            endif
-            if (entr(ig,k).lt.0.) then
-!               print*,'entr2<0!!!'
-            endif
-         enddo
-      enddo
-
-!   calcul de la valeur dans les ascendances
-      do ig=1,ngrid
-         qa(ig,1)=q(ig,1)
-      enddo
-
-      do k=2,nlay
-         do ig=1,ngrid
-            if ((fm(ig,k+1)+detr(ig,k))*ztimestep.gt.  &
-     &         1.e-5*masse(ig,k)) then
-         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
-     &         /(fm(ig,k+1)+detr(ig,k))
-            else
-               qa(ig,k)=q(ig,k)
-            endif
-            if (qa(ig,k).lt.0.) then
-!               print*,'qa<0!!!'
-            endif
-            if (q(ig,k).lt.0.) then
-!               print*,'q<0!!!'
-            endif
-         enddo
-      enddo
-
-! Calcul du flux subsident
-
-      do k=2,nlay
-         do ig=1,ngrid
-#undef centre
-#ifdef centre
-             wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
-#else
-
-#define plusqueun
-#ifdef plusqueun
-! Schema avec advection sur plus qu'une maille.
-            zzm=masse(ig,k)/ztimestep
-            if (fm(ig,k)>zzm) then
-               wqd(ig,k)=zzm*q(ig,k)+(fm(ig,k)-zzm)*q(ig,k+1)
-            else
-               wqd(ig,k)=fm(ig,k)*q(ig,k)
-            endif
-#else
-            wqd(ig,k)=fm(ig,k)*q(ig,k)
-#endif
-#endif
-
-            if (wqd(ig,k).lt.0.) then
-!               print*,'wqd<0!!!'
-            endif
-         enddo
-      enddo
-      do ig=1,ngrid
-         wqd(ig,1)=0.
-         wqd(ig,nlay+1)=0.
-      enddo
-     
-
-! Calcul des tendances
-      do k=1,nlay
-         do ig=1,ngrid
-            q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)  &
-     &               -wqd(ig,k)+wqd(ig,k+1))  &
-     &               *ztimestep/masse(ig,k)
-!            if (dq(ig,k).lt.0.) then
-!               print*,'dq<0!!!'
-!            endif
-         enddo
-      enddo
-
-
-enddo
-
-
-! Calcul des tendances
-      do k=1,nlay
-         do ig=1,ngrid
-            dq(ig,k)=(q(ig,k)-qold(ig,k))/ptimestep
-            q(ig,k)=qold(ig,k)
-         enddo
-      enddo
-
-      return
-      end
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_dry.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_dry.F90	(revision 4726)
+++ 	(revision )
@@ -1,165 +1,0 @@
-!
-! $Id$
-!
-       SUBROUTINE thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star,  &
-     &                            lalim,lmin,zmax,wmax)
-
-!--------------------------------------------------------------------------
-!thermcell_dry: calcul de zmax et wmax du thermique sec
-! Calcul de la vitesse maximum et de la hauteur maximum pour un panache
-! ascendant avec une fonction d'alimentation alim_star et sans changement 
-! de phase.
-! Le calcul pourrait etre sans doute simplifier.
-! La temperature potentielle virtuelle dans la panache ascendant est
-! la temperature potentielle virtuelle pondÃ©rÃ©e par alim_star.
-!--------------------------------------------------------------------------
-       USE thermcell_ini_mod, ONLY: prt_level, RG
-       IMPLICIT NONE
-
-       integer, intent(in) :: ngrid,nlay
-       real, intent(in), dimension(ngrid,nlay+1) :: zlev,pphi,ztv,alim_star
-       integer, intent(in), dimension(ngrid) :: lalim
-       real, intent(out), dimension(ngrid) :: zmax,wmax
-
-!variables locales
-       REAL zw2(ngrid,nlay+1)
-       REAL f_star(ngrid,nlay+1)
-       REAL ztva(ngrid,nlay+1)
-       REAL wmaxa(ngrid)
-       REAL wa_moy(ngrid,nlay+1)
-       REAL linter(ngrid),zlevinter(ngrid)
-       INTEGER lmix(ngrid),lmax(ngrid),lmin(ngrid)
-      CHARACTER (LEN=20) :: modname='thermcell_dry'
-      CHARACTER (LEN=80) :: abort_message
-       INTEGER l,ig
-
-!initialisations
-       do ig=1,ngrid
-          do l=1,nlay+1
-             zw2(ig,l)=0.
-             wa_moy(ig,l)=0.
-          enddo
-       enddo
-       do ig=1,ngrid
-          do l=1,nlay
-             ztva(ig,l)=ztv(ig,l)
-          enddo
-       enddo
-       do ig=1,ngrid
-          wmax(ig)=0.
-          wmaxa(ig)=0.
-       enddo
-!calcul de la vitesse a partir de la CAPE en melangeant thetav
-
-
-! Calcul des F^*, integrale verticale de E^*
-       f_star(:,1)=0.
-       do l=1,nlay
-          f_star(:,l+1)=f_star(:,l)+alim_star(:,l)
-       enddo
-
-! niveau (reel) auquel zw2 s'annule FH :n'etait pas initialise
-       linter(:)=0.
-
-! couche la plus haute concernee par le thermique. 
-       lmax(:)=1
-
-! Le niveau linter est une variable continue qui se trouve dans la couche
-! lmax
-
-       do l=1,nlay-2
-         do ig=1,ngrid
-            if (l.eq.lmin(ig).and.lalim(ig).gt.1) then
-
-!------------------------------------------------------------------------
-!  Calcul de la vitesse en haut de la premiere couche instable.
-!  Premiere couche du panache thermique
-!------------------------------------------------------------------------
-
-               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)  &
-     &                     *(zlev(ig,l+1)-zlev(ig,l))  &
-     &                     *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l))
-
-!------------------------------------------------------------------------
-! Tant que la vitesse en bas de la couche et la somme du flux de masse
-! et de l'entrainement (c'est a dire le flux de masse en haut) sont
-! positifs, on calcul
-! 1. le flux de masse en haut  f_star(ig,l+1)
-! 2. la temperature potentielle virtuelle dans la couche ztva(ig,l)
-! 3. la vitesse au carré en haut zw2(ig,l+1)
-!------------------------------------------------------------------------
-
-            else if (zw2(ig,l).ge.1e-10) then
-
-               ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+alim_star(ig,l)  &
-     &                    *ztv(ig,l))/f_star(ig,l+1)
-               zw2(ig,l+1)=zw2(ig,l)*(f_star(ig,l)/f_star(ig,l+1))**2+  &
-     &                     2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
-     &                     *(zlev(ig,l+1)-zlev(ig,l))
-            endif
-! determination de zmax continu par interpolation lineaire
-!------------------------------------------------------------------------
-
-            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
-!               stop'On tombe sur le cas particulier de thermcell_dry'
-!               print*,'On tombe sur le cas particulier de thermcell_dry'
-                zw2(ig,l+1)=0.
-                linter(ig)=l+1
-                lmax(ig)=l
-            endif
-
-            if (zw2(ig,l+1).lt.0.) then
-               linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
-     &           -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
-               zw2(ig,l+1)=0.
-               lmax(ig)=l
-!            endif
-!CR:zmax continu 06/05/12: calcul de linter quand le thermique est stoppe par le detrainement
-            elseif (f_star(ig,l+1).lt.0.) then
-               linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
-     &           -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
-               zw2(ig,l+1)=0.
-               lmax(ig)=l
-            endif
-!CRfin
-               wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))
-
-            if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
-!   lmix est le niveau de la couche ou w (wa_moy) est maximum
-               lmix(ig)=l+1
-               wmaxa(ig)=wa_moy(ig,l+1)
-            endif
-         enddo
-      enddo
-       if (prt_level.ge.1) print*,'fin calcul zw2'
-!
-! Determination de zw2 max
-      do ig=1,ngrid
-         wmax(ig)=0.
-      enddo
-
-      do l=1,nlay
-         do ig=1,ngrid
-            if (l.le.lmax(ig)) then
-                zw2(ig,l)=sqrt(zw2(ig,l))
-                wmax(ig)=max(wmax(ig),zw2(ig,l))
-            else
-                 zw2(ig,l)=0.
-            endif
-          enddo
-      enddo
-
-!   Longueur caracteristique correspondant a la hauteur des thermiques.
-      do  ig=1,ngrid
-         zmax(ig)=0.
-         zlevinter(ig)=zlev(ig,1)
-      enddo
-      do  ig=1,ngrid
-! calcul de zlevinter
-          zlevinter(ig)=zlev(ig,lmax(ig)) + &
-     &    (linter(ig)-lmax(ig))*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-           zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
-      enddo
-
- RETURN
-      END
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_dtke.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_dtke.F90	(revision 4726)
+++ 	(revision )
@@ -1,123 +1,0 @@
-      subroutine thermcell_dtke(ngrid,nlay,nsrf,ptimestep,fm0,entr0,  &
-     &           rg,pplev,tke)
-      USE print_control_mod, ONLY: prt_level
-      implicit none
-
-!=======================================================================
-!
-!   Calcul du transport verticale dans la couche limite en presence
-!   de "thermiques" explicitement representes
-!   calcul du dq/dt une fois qu'on connait les ascendances
-!
-!=======================================================================
-
-      integer ngrid,nlay,nsrf
-
-      real ptimestep
-      real masse0(ngrid,nlay),fm0(ngrid,nlay+1),pplev(ngrid,nlay+1)
-      real entr0(ngrid,nlay),rg
-      real tke(ngrid,nlay,nsrf)
-      real detr0(ngrid,nlay)
-
-
-      real masse(ngrid,nlay),fm(ngrid,nlay+1)
-      real entr(ngrid,nlay)
-      real q(ngrid,nlay)
-      integer lev_out                           ! niveau pour les print
-
-      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
-
-      real zzm
-
-      integer ig,k
-      integer isrf
-
-
-      lev_out=0
-
-
-      if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0'
-
-!   calcul du detrainement
-      do k=1,nlay
-         detr0(:,k)=fm0(:,k)-fm0(:,k+1)+entr0(:,k)
-         masse0(:,k)=(pplev(:,k)-pplev(:,k+1))/RG
-      enddo
-
-
-! Decalage vertical des entrainements et detrainements.
-      masse(:,1)=0.5*masse0(:,1)
-      entr(:,1)=0.5*entr0(:,1)
-      detr(:,1)=0.5*detr0(:,1)
-      fm(:,1)=0.
-      do k=1,nlay-1
-         masse(:,k+1)=0.5*(masse0(:,k)+masse0(:,k+1))
-         entr(:,k+1)=0.5*(entr0(:,k)+entr0(:,k+1))
-         detr(:,k+1)=0.5*(detr0(:,k)+detr0(:,k+1))
-         fm(:,k+1)=fm(:,k)+entr(:,k)-detr(:,k)
-      enddo
-      fm(:,nlay+1)=0.
-
-!   calcul de la valeur dans les ascendances
-      do ig=1,ngrid
-         qa(ig,1)=q(ig,1)
-      enddo
-
-
-
-do isrf=1,nsrf
-
-   q(:,:)=tke(:,:,isrf)
-
-    if (1==1) then
-      do k=2,nlay
-         do ig=1,ngrid
-            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
-     &         1.e-5*masse(ig,k)) then
-         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
-     &         /(fm(ig,k+1)+detr(ig,k))
-            else
-               qa(ig,k)=q(ig,k)
-            endif
-            if (qa(ig,k).lt.0.) then
-!               print*,'qa<0!!!'
-            endif
-            if (q(ig,k).lt.0.) then
-!               print*,'q<0!!!'
-            endif
-         enddo
-      enddo
-
-! Calcul du flux subsident
-
-      do k=2,nlay
-         do ig=1,ngrid
-            wqd(ig,k)=fm(ig,k)*q(ig,k)
-            if (wqd(ig,k).lt.0.) then
-!               print*,'wqd<0!!!'
-            endif
-         enddo
-      enddo
-      do ig=1,ngrid
-         wqd(ig,1)=0.
-         wqd(ig,nlay+1)=0.
-      enddo
-     
-
-! Calcul des tendances
-      do k=1,nlay
-         do ig=1,ngrid
-            q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)  &
-     &               -wqd(ig,k)+wqd(ig,k+1))  &
-     &               *ptimestep/masse(ig,k)
-         enddo
-      enddo
-
- endif
-
-   tke(:,:,isrf)=q(:,:)
-
-enddo
-
-      return
-      end
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_dv2.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_dv2.F90	(revision 4726)
+++ 	(revision )
@@ -1,193 +1,0 @@
-      subroutine thermcell_dv2(ngrid,nlay,ptimestep,fm,entr,masse  &
-     &    ,fraca,larga  &
-     &    ,u,v,du,dv,ua,va,lev_out)
-      USE print_control_mod, ONLY: prt_level,lunout
-      implicit none
-
-!=======================================================================
-!
-!   Calcul du transport verticale dans la couche limite en presence
-!   de "thermiques" explicitement representes
-!   calcul du dq/dt une fois qu'on connait les ascendances
-!
-! Vectorisation, FH : 2010/03/08
-!
-!=======================================================================
-
-
-      integer ngrid,nlay
-
-      real ptimestep
-      real masse(ngrid,nlay),fm(ngrid,nlay+1)
-      real fraca(ngrid,nlay+1)
-      real larga(ngrid)
-      real entr(ngrid,nlay)
-      real u(ngrid,nlay)
-      real ua(ngrid,nlay)
-      real du(ngrid,nlay)
-      real v(ngrid,nlay)
-      real va(ngrid,nlay)
-      real dv(ngrid,nlay)
-      integer lev_out                           ! niveau pour les print
-
-      real qa(ngrid,nlay),detr(ngrid,nlay),zf,zf2
-      real wvd(ngrid,nlay+1),wud(ngrid,nlay+1)
-      real gamma0(ngrid,nlay+1),gamma(ngrid,nlay+1)
-      real ue(ngrid,nlay),ve(ngrid,nlay)
-      LOGICAL ltherm(ngrid,nlay)
-      real dua(ngrid,nlay),dva(ngrid,nlay)
-      integer iter
-
-      integer ig,k,nlarga0
-
-!-------------------------------------------------------------------------
-
-!   calcul du detrainement
-!---------------------------
-
-!      print*,'THERMCELL DV2 OPTIMISE 3'
-
-      nlarga0=0.
-
-      do k=1,nlay
-         do ig=1,ngrid
-            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
-         enddo
-      enddo
-
-!   calcul de la valeur dans les ascendances
-      do ig=1,ngrid
-         ua(ig,1)=u(ig,1)
-         va(ig,1)=v(ig,1)
-         ue(ig,1)=u(ig,1)
-         ve(ig,1)=v(ig,1)
-      enddo
-
-      IF(prt_level>9)WRITE(lunout,*)                                    &
-     &      'WARNING on initialise gamma(1:ngrid,1)=0.'
-      gamma(1:ngrid,1)=0.
-      do k=2,nlay
-         do ig=1,ngrid
-            ltherm(ig,k)=(fm(ig,k+1)+detr(ig,k))*ptimestep > 1.e-5*masse(ig,k)
-            if(ltherm(ig,k).and.larga(ig)>0.) then
-               gamma0(ig,k)=masse(ig,k)  &
-     &         *sqrt( 0.5*(fraca(ig,k+1)+fraca(ig,k)) )  &
-     &         *0.5/larga(ig)  &
-     &         *1.
-            else
-               gamma0(ig,k)=0.
-            endif
-            if (ltherm(ig,k).and.larga(ig)<=0.) nlarga0=nlarga0+1
-         enddo
-      enddo
-
-      gamma(:,:)=0.
-
-      do k=2,nlay
-
-         do ig=1,ngrid
-            if (ltherm(ig,k)) then
-               dua(ig,k)=ua(ig,k-1)-u(ig,k-1)
-               dva(ig,k)=va(ig,k-1)-v(ig,k-1)
-            else
-               ua(ig,k)=u(ig,k)
-               va(ig,k)=v(ig,k)
-               ue(ig,k)=u(ig,k)
-               ve(ig,k)=v(ig,k)
-            endif
-         enddo
-
-
-! Debut des iterations
-!----------------------
-do iter=1,5
-         do ig=1,ngrid
-! Pour memoire : calcul prenant en compte la fraction reelle
-!              zf=0.5*(fraca(ig,k)+fraca(ig,k+1))
-!              zf2=1./(1.-zf)
-! Calcul avec fraction infiniement petite
-               zf=0.
-               zf2=1.
-
-!  la première fois on multiplie le coefficient de freinage
-!  par le module du vent dans la couche en dessous.
-!  Mais pourquoi donc ???
-               if (ltherm(ig,k)) then
-!   On choisit une relaxation lineaire.
-!                 gamma(ig,k)=gamma0(ig,k)
-!   On choisit une relaxation quadratique.
-                  gamma(ig,k)=gamma0(ig,k)*sqrt(dua(ig,k)**2+dva(ig,k)**2)
-                  ua(ig,k)=(fm(ig,k)*ua(ig,k-1)  &
-     &               +(zf2*entr(ig,k)+gamma(ig,k))*u(ig,k))  &
-     &               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2  &
-     &                 +gamma(ig,k))
-                  va(ig,k)=(fm(ig,k)*va(ig,k-1)  &
-     &               +(zf2*entr(ig,k)+gamma(ig,k))*v(ig,k))  &
-     &               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2  &
-     &                 +gamma(ig,k))
-!                 print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua(ig,k),dva(ig,k)
-                  dua(ig,k)=ua(ig,k)-u(ig,k)
-                  dva(ig,k)=va(ig,k)-v(ig,k)
-                  ue(ig,k)=(u(ig,k)-zf*ua(ig,k))*zf2
-                  ve(ig,k)=(v(ig,k)-zf*va(ig,k))*zf2
-               endif
-         enddo
-! Fin des iterations
-!--------------------
-enddo
-
-      enddo ! k=2,nlay
-
-
-! Calcul du flux vertical de moment dans l'environnement.
-!---------------------------------------------------------
-      do k=2,nlay
-         do ig=1,ngrid
-            wud(ig,k)=fm(ig,k)*ue(ig,k)
-            wvd(ig,k)=fm(ig,k)*ve(ig,k)
-         enddo
-      enddo
-      do ig=1,ngrid
-         wud(ig,1)=0.
-         wud(ig,nlay+1)=0.
-         wvd(ig,1)=0.
-         wvd(ig,nlay+1)=0.
-      enddo
-
-! calcul des tendances.
-!-----------------------
-      do k=1,nlay
-         do ig=1,ngrid
-            du(ig,k)=((detr(ig,k)+gamma(ig,k))*ua(ig,k)  &
-     &               -(entr(ig,k)+gamma(ig,k))*ue(ig,k)  &
-     &               -wud(ig,k)+wud(ig,k+1))  &
-     &               /masse(ig,k)
-            dv(ig,k)=((detr(ig,k)+gamma(ig,k))*va(ig,k)  &
-     &               -(entr(ig,k)+gamma(ig,k))*ve(ig,k)  &
-     &               -wvd(ig,k)+wvd(ig,k+1))  &
-     &               /masse(ig,k)
-         enddo
-      enddo
-
-
-! Sorties eventuelles.
-!----------------------
-
-   if(prt_level.GE.10) then
-      do k=1,nlay
-         do ig=1,ngrid
-           print*,'th_dv2 ig k gamma entr detr ua ue va ve wud wvd masse',ig,k,gamma(ig,k), &
-     &   entr(ig,k),detr(ig,k),ua(ig,k),ue(ig,k),va(ig,k),ve(ig,k),wud(ig,k),wvd(ig,k),wud(ig,k+1),wvd(ig,k+1), &
-     &   masse(ig,k)
-         enddo
-      enddo
-   endif
-!
-     if (nlarga0>0) then
-          print*,'WARNING !!!!!! DANS THERMCELL_DV2 '
-          print*,nlarga0,' points pour lesquels laraga=0. dans un thermique'
-          print*,'Il faudrait decortiquer ces points'
-     endif
-
-      return
-      end
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_env.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_env.F90	(revision 4726)
+++ 	(revision )
@@ -1,78 +1,0 @@
-   SUBROUTINE thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
-     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,pqsat,lev_out)
-
-!--------------------------------------------------------------
-!thermcell_env: calcule les caracteristiques de l environnement
-!necessaires au calcul des proprietes dans le thermique
-!--------------------------------------------------------------
-
-
-   USE thermcell_ini_mod, ONLY : prt_level,RLvCp,RKAPPA,RETV
-   IMPLICIT NONE
-
-! arguments
-
-   integer,intent(in) :: ngrid,nlay,lev_out
-   real,intent(in), dimension(ngrid,nlay) :: po,pt,pu,pv,pplay
-   real,intent(in), dimension(ngrid,nlay+1) :: pplev
-   real,intent(out), dimension(ngrid,nlay) :: zo,zl,zh,ztv,zthl
-   real,intent(out), dimension(ngrid,nlay) :: zpspsk,zu,zv,pqsat
-   
-! Local
-
-   integer ig,ll
-   real dqsat_dT
-   logical mask(ngrid,nlay)
-
-
-!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-! Initialisations :
-!------------------
-
-   mask(:,:)=.true.
-
-!
-! calcul des caracteristiques de l environnement
-   DO  ll=1,nlay
-     DO ig=1,ngrid
-        zo(ig,ll)=po(ig,ll)
-        zl(ig,ll)=0.
-        zh(ig,ll)=pt(ig,ll)
-     enddo
-   enddo
-
-! Condensation :
-!---------------
-! Calcul de l'humidite a saturation et de la condensation
-
-   call thermcell_qsat(ngrid*nlay,mask,pplev,pt,po,pqsat)
-   do ll=1,nlay
-      do ig=1,ngrid
-         zl(ig,ll) = max(0.,po(ig,ll)-pqsat(ig,ll))
-         zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)         !   T = Tl + Lv/Cp ql
-         zo(ig,ll) = po(ig,ll)-zl(ig,ll)
-      enddo
-   enddo
-
-!-----------------------------------------------------------------------
-   if (prt_level.ge.1) print*,'0 OK convect8'
-
-   do ll=1,nlay
-      do ig=1,ngrid
-          zpspsk(ig,ll)=(pplay(ig,ll)/100000.)**RKAPPA
-          zu(ig,ll)=pu(ig,ll)
-          zv(ig,ll)=pv(ig,ll)
-!attention zh est maintenant le profil de T et plus le profil de theta !
-! Quelle horreur ! A eviter.
-!   T-> Theta
-            ztv(ig,ll)=zh(ig,ll)/zpspsk(ig,ll)
-!Theta_v
-            ztv(ig,ll)=ztv(ig,ll)*(1.+RETV*(zo(ig,ll))-zl(ig,ll))
-!Thetal
-            zthl(ig,ll)=pt(ig,ll)/zpspsk(ig,ll)
-!            
-      enddo
-   enddo
- 
- RETURN
-   END
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_flux2.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_flux2.F90	(revision 4726)
+++ 	(revision )
@@ -1,511 +1,0 @@
-!
-! $Id$
-!
-      SUBROUTINE thermcell_flux2(ngrid,nlay,ptimestep,masse, &
-     &       lalim,lmax,alim_star,  &
-     &       entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr,  &
-     &       detr,zqla,lev_out,lunout1,igout)
-!IM 060508    &       detr,zqla,zmax,lev_out,lunout,igout)
-
-
-!---------------------------------------------------------------------------
-!thermcell_flux: deduction des flux
-!---------------------------------------------------------------------------
-
-      USE thermcell_ini_mod, ONLY : prt_level,iflag_thermals_optflux
-      IMPLICIT NONE
-      
-! arguments
-      INTEGER, intent(in) :: ngrid,nlay
-      REAL, intent(in) :: ptimestep
-      REAL, intent(in), dimension(ngrid,nlay) :: masse
-      INTEGER, intent(in), dimension(ngrid) :: lalim,lmax
-      REAL, intent(in), dimension(ngrid,nlay) :: alim_star,entr_star,detr_star
-      REAL, intent(in), dimension(ngrid) :: f
-      REAL, intent(in), dimension(ngrid,nlay) :: rhobarz
-      REAL, intent(in), dimension(ngrid,nlay+1) :: zw2,zlev
-! FH : laisser ca le temps de verifier qu'on a bien fait de commenter les
-!      lignes faisant apparaitre zqla, zmax ...
-!     REAL, intent(in), dimension(ngrid) :: zmax(ngrid)
-!     enlever aussi zqla
-      REAL, intent(in), dimension(ngrid,nlay) :: zqla  ! not used
-      integer, intent(in) :: lev_out, lunout1
-
-      REAL,intent(out), dimension(ngrid,nlay) :: entr,detr
-      REAL,intent(out), dimension(ngrid,nlay+1) :: fm
-
-! local
-      INTEGER ig,l
-      integer igout,lout
-      REAL zfm
-      integer ncorecfm1,ncorecfm2,ncorecfm3,ncorecalpha
-      integer ncorecfm4,ncorecfm5,ncorecfm6,ncorecfm7,ncorecfm8
-      
-
-      REAL f_old,ddd0,eee0,ddd,eee,zzz
-
-      REAL,SAVE :: fomass_max=0.5
-      REAL,SAVE :: alphamax=0.7
-!$OMP THREADPRIVATE(fomass_max,alphamax)
-
-      logical check_debug,labort_physic
-
-      character (len=20) :: modname='thermcell_flux2'
-      character (len=80) :: abort_message
-
-
-      ncorecfm1=0
-      ncorecfm2=0
-      ncorecfm3=0
-      ncorecfm4=0
-      ncorecfm5=0
-      ncorecfm6=0
-      ncorecfm7=0
-      ncorecfm8=0
-      ncorecalpha=0
-
-!initialisation
-      fm(:,:)=0.
-      
-      if (prt_level.ge.10) then
-         write(lunout1,*) 'Dans thermcell_flux 0'
-         write(lunout1,*) 'flux base ',f(igout)
-         write(lunout1,*) 'lmax ',lmax(igout)
-         write(lunout1,*) 'lalim ',lalim(igout)
-         write(lunout1,*) 'ig= ',igout
-         write(lunout1,*) ' l E*    A*     D*  '
-         write(lunout1,'(i4,3e15.5)') (l,entr_star(igout,l),alim_star(igout,l),detr_star(igout,l) &
-     &    ,l=1,lmax(igout))
-      endif
-
-
-!-------------------------------------------------------------------------
-! Verification de la nullite des entrainement et detrainement au dessus
-! de lmax(ig)
-! Active uniquement si check_debug=.true. ou prt_level>=10
-!-------------------------------------------------------------------------
-
-      check_debug=.false..or.prt_level>=10
-
-      if (check_debug) then
-      do l=1,nlay
-         do ig=1,ngrid
-            if (l.le.lmax(ig)) then
-               if (entr_star(ig,l).gt.1.) then
-                    print*,'WARNING thermcell_flux 1 ig,l,lmax(ig)',ig,l,lmax(ig)
-                    print*,'entr_star(ig,l)',entr_star(ig,l)
-                    print*,'alim_star(ig,l)',alim_star(ig,l)
-                    print*,'detr_star(ig,l)',detr_star(ig,l)
-               endif
-            else
-               if (abs(entr_star(ig,l))+abs(alim_star(ig,l))+abs(detr_star(ig,l)).gt.0.) then
-                    print*,'cas 1 : ig,l,lmax(ig)',ig,l,lmax(ig)
-                    print*,'entr_star(ig,l)',entr_star(ig,l)
-                    print*,'alim_star(ig,l)',alim_star(ig,l)
-                    print*,'detr_star(ig,l)',detr_star(ig,l)
-                    abort_message = ''
-                    labort_physic=.true.
-                    CALL abort_physic (modname,abort_message,1)
-               endif
-            endif
-         enddo
-      enddo
-      endif
-
-!-------------------------------------------------------------------------
-! Multiplication par le flux de masse issu de la femreture
-!-------------------------------------------------------------------------
-
-      do l=1,nlay
-         entr(:,l)=f(:)*(entr_star(:,l)+alim_star(:,l))
-         detr(:,l)=f(:)*detr_star(:,l)
-      enddo
-
-      if (prt_level.ge.10) then
-         write(lunout1,*) 'Dans thermcell_flux 1'
-         write(lunout1,*) 'flux base ',f(igout)
-         write(lunout1,*) 'lmax ',lmax(igout)
-         write(lunout1,*) 'lalim ',lalim(igout)
-         write(lunout1,*) 'ig= ',igout
-         write(lunout1,*) ' l   E    D     W2'
-         write(lunout1,'(i4,3e15.5)') (l,entr(igout,l),detr(igout,l) &
-     &    ,zw2(igout,l+1),l=1,lmax(igout))
-      endif
-
-      fm(:,1)=0.
-      do l=1,nlay
-         do ig=1,ngrid
-            if (l.lt.lmax(ig)) then
-               fm(ig,l+1)=fm(ig,l)+entr(ig,l)-detr(ig,l)
-            elseif(l.eq.lmax(ig)) then
-               fm(ig,l+1)=0.
-               detr(ig,l)=fm(ig,l)+entr(ig,l)
-            else
-               fm(ig,l+1)=0.
-            endif
-         enddo
-      enddo
-
-
-
-! Test provisoire : pour comprendre pourquoi on corrige plein de fois 
-! le cas fm6, on commence par regarder une premiere fois avant les
-! autres corrections.
-
-      do l=1,nlay
-         do ig=1,ngrid
-            if (detr(ig,l).gt.fm(ig,l)) then
-               ncorecfm8=ncorecfm8+1
-!              igout=ig
-            endif
-         enddo
-      enddo
-
-!      if (prt_level.ge.10) &
-!    &    call printflux(ngrid,nlay,lunout1,igout,f,lmax,lalim, &
-!    &    ptimestep,masse,entr,detr,fm,'2  ')
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! FH Version en cours de test;
-! par rapport a thermcell_flux, on fait une grande boucle sur "l"
-! et on modifie le flux avec tous les contr�les appliques d'affilee
-! pour la meme couche
-! Momentanement, on duplique le calcule du flux pour pouvoir comparer
-! les flux avant et apres modif
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      do l=1,nlay
-
-         do ig=1,ngrid
-            if (l.lt.lmax(ig)) then
-               fm(ig,l+1)=fm(ig,l)+entr(ig,l)-detr(ig,l)
-            elseif(l.eq.lmax(ig)) then
-               fm(ig,l+1)=0.
-               detr(ig,l)=fm(ig,l)+entr(ig,l)
-            else
-               fm(ig,l+1)=0.
-            endif
-         enddo
-
-
-!-------------------------------------------------------------------------
-! Verification de la positivite des flux de masse
-!-------------------------------------------------------------------------
-
-!     do l=1,nlay
-         do ig=1,ngrid
-            if (fm(ig,l+1).lt.0.) then
-!              print*,'fm1<0',l+1,lmax(ig),fm(ig,l+1)
-                ncorecfm1=ncorecfm1+1
-               fm(ig,l+1)=fm(ig,l)
-               detr(ig,l)=entr(ig,l)
-            endif
-         enddo
-!     enddo
-
-      if (prt_level.ge.10) &
-     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-!-------------------------------------------------------------------------
-!Test sur fraca croissant
-!-------------------------------------------------------------------------
-      if (iflag_thermals_optflux==0) then 
-!     do l=1,nlay
-         do ig=1,ngrid
-          if (l.ge.lalim(ig).and.l.le.lmax(ig) &
-     &    .and.(zw2(ig,l+1).gt.1.e-10).and.(zw2(ig,l).gt.1.e-10) ) then
-!  zzz est le flux en l+1 a frac constant
-             zzz=fm(ig,l)*rhobarz(ig,l+1)*zw2(ig,l+1)  &
-     &                          /(rhobarz(ig,l)*zw2(ig,l))
-             if (fm(ig,l+1).gt.zzz) then
-                detr(ig,l)=detr(ig,l)+fm(ig,l+1)-zzz
-                fm(ig,l+1)=zzz
-                ncorecfm4=ncorecfm4+1
-             endif
-          endif
-        enddo
-!     enddo
-      endif
-
-      if (prt_level.ge.10) &
-     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-
-!-------------------------------------------------------------------------
-!test sur flux de masse croissant
-!-------------------------------------------------------------------------
-      if (iflag_thermals_optflux==0) then
-!     do l=1,nlay
-         do ig=1,ngrid
-            if ((fm(ig,l+1).gt.fm(ig,l)).and.(l.gt.lalim(ig))) then
-              f_old=fm(ig,l+1)
-              fm(ig,l+1)=fm(ig,l)
-              detr(ig,l)=detr(ig,l)+f_old-fm(ig,l+1)
-               ncorecfm5=ncorecfm5+1
-            endif
-         enddo
-!     enddo
-      endif
-
-      if (prt_level.ge.10) &
-     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-!fin 1.eq.0
-!-------------------------------------------------------------------------
-!detr ne peut pas etre superieur a fm
-!-------------------------------------------------------------------------
-
-      if(1.eq.1) then
-
-!     do l=1,nlay
-
-
-
-         labort_physic=.false.
-         do ig=1,ngrid
-            if (entr(ig,l)<0.) then
-               labort_physic=.true.
-               igout=ig
-               lout=l
-            endif
-         enddo
-
-         if (labort_physic) then
-            print*,'N1 ig,l,entr',igout,lout,entr(igout,lout)
-            abort_message = 'entr negatif'
-            CALL abort_physic (modname,abort_message,1)
-         endif
-
-         do ig=1,ngrid
-            if (detr(ig,l).gt.fm(ig,l)) then
-               ncorecfm6=ncorecfm6+1
-               detr(ig,l)=fm(ig,l)
-               entr(ig,l)=fm(ig,l+1)
-
-! Dans le cas ou on est au dessus de la couche d'alimentation et que le
-! detrainement est plus fort que le flux de masse, on stope le thermique.
-!test:on commente
-!               if (l.gt.lalim(ig)) then
-!                  lmax(ig)=l
-!                  fm(ig,l+1)=0.
-!                  entr(ig,l)=0.
-!               else
-!                  ncorecfm7=ncorecfm7+1
-!               endif
-            endif
-
-            if(l.gt.lmax(ig)) then
-               detr(ig,l)=0.
-               fm(ig,l+1)=0.
-               entr(ig,l)=0.
-            endif
-         enddo
-
-         labort_physic=.false.
-         do ig=1,ngrid
-            if (entr(ig,l).lt.0.) then
-               labort_physic=.true.
-               igout=ig
-            endif
-         enddo
-         if (labort_physic) then
-            ig=igout
-            print*,'ig,l,lmax(ig)',ig,l,lmax(ig)
-            print*,'entr(ig,l)',entr(ig,l)
-            print*,'fm(ig,l)',fm(ig,l)
-            abort_message = 'probleme dans thermcell flux'
-            CALL abort_physic (modname,abort_message,1)
-         endif
-
-
-!     enddo
-      endif
-
-
-      if (prt_level.ge.10) &
-     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-!-------------------------------------------------------------------------
-!fm ne peut pas etre negatif
-!-------------------------------------------------------------------------
-
-!     do l=1,nlay
-         do ig=1,ngrid
-            if (fm(ig,l+1).lt.0.) then
-               detr(ig,l)=detr(ig,l)+fm(ig,l+1)
-               fm(ig,l+1)=0.
-               ncorecfm2=ncorecfm2+1
-            endif
-         enddo
-
-         labort_physic=.false.
-         do ig=1,ngrid
-            if (detr(ig,l).lt.0.) then
-               labort_physic=.true.
-               igout=ig
-            endif
-        enddo
-        if (labort_physic) then
-               ig=igout
-               print*,'cas 2 : ig,l,lmax(ig)',ig,l,lmax(ig)
-               print*,'detr(ig,l)',detr(ig,l)
-               print*,'fm(ig,l)',fm(ig,l)
-               abort_message = 'probleme dans thermcell flux'
-               CALL abort_physic (modname,abort_message,1)
-        endif
-!    enddo
-
-      if (prt_level.ge.10) &
-     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-!-----------------------------------------------------------------------
-!la fraction couverte ne peut pas etre superieure a 1            
-!-----------------------------------------------------------------------
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! FH Partie a revisiter.
-! Il semble qu'etaient codees ici deux optiques dans le cas
-! F/ (rho *w) > 1
-! soit limiter la hauteur du thermique en considerant que c'est 
-! la derniere chouche, soit limiter F a rho w.
-! Dans le second cas, il faut en fait limiter a un peu moins
-! que ca parce qu'on a des 1 / ( 1 -alpha) un peu plus loin
-! dans thermcell_main et qu'il semble de toutes facons deraisonable
-! d'avoir des fractions de 1..
-! Ci dessous, et dans l'etat actuel, le premier des  deux if est
-! sans doute inutile.
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!    do l=1,nlay
-        do ig=1,ngrid
-           if (zw2(ig,l+1).gt.1.e-10) then
-           zfm=rhobarz(ig,l+1)*zw2(ig,l+1)*alphamax
-           if ( fm(ig,l+1) .gt. zfm) then
-              f_old=fm(ig,l+1)
-              fm(ig,l+1)=zfm
-              detr(ig,l)=detr(ig,l)+f_old-fm(ig,l+1)
-!             lmax(ig)=l+1
-!             zmax(ig)=zlev(ig,lmax(ig))
-!             print*,'alpha>1',l+1,lmax(ig)
-              ncorecalpha=ncorecalpha+1
-           endif
-           endif
-        enddo
-!    enddo
-!
-
-
-      if (prt_level.ge.10) &
-     &   write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, &
-     &     entr(igout,l),detr(igout,l),fm(igout,l+1)
-
-! Fin de la grande boucle sur les niveaux verticaux
-      enddo
-
-!      if (prt_level.ge.10) &
-!    &    call printflux(ngrid,nlay,lunout1,igout,f,lmax,lalim, &
-!    &    ptimestep,masse,entr,detr,fm,'8  ')
-
-
-!-----------------------------------------------------------------------
-! On fait en sorte que la quantite totale d'air entraine dans le 
-! panache ne soit pas trop grande comparee a la masse de la maille
-!-----------------------------------------------------------------------
-
-      if (1.eq.1) then
-      labort_physic=.false.
-      do l=1,nlay-1
-         do ig=1,ngrid
-            eee0=entr(ig,l)
-            ddd0=detr(ig,l)
-            eee=entr(ig,l)-masse(ig,l)*fomass_max/ptimestep
-            ddd=detr(ig,l)-eee
-            if (eee.gt.0.) then
-                ncorecfm3=ncorecfm3+1
-                entr(ig,l)=entr(ig,l)-eee
-                if ( ddd.gt.0.) then
-!   l'entrainement est trop fort mais l'exces peut etre compense par une
-!   diminution du detrainement)
-                   detr(ig,l)=ddd
-                else
-!   l'entrainement est trop fort mais l'exces doit etre compense en partie
-!   par un entrainement plus fort dans la couche superieure
-                   if(l.eq.lmax(ig)) then
-                      detr(ig,l)=fm(ig,l)+entr(ig,l)
-                   else
-                      if(l.ge.lmax(ig).and.0.eq.1) then
-                         igout=ig
-                         lout=l
-                         labort_physic=.true.
-                      endif
-                      entr(ig,l+1)=entr(ig,l+1)-ddd
-                      detr(ig,l)=0.
-                      fm(ig,l+1)=fm(ig,l)+entr(ig,l)
-                      detr(ig,l)=0.
-                   endif
-                endif
-            endif
-         enddo
-      enddo
-      if (labort_physic) then
-                         ig=igout
-                         l=lout
-                         print*,'ig,l',ig,l
-                         print*,'eee0',eee0
-                         print*,'ddd0',ddd0
-                         print*,'eee',eee
-                         print*,'ddd',ddd
-                         print*,'entr',entr(ig,l)
-                         print*,'detr',detr(ig,l)
-                         print*,'masse',masse(ig,l)
-                         print*,'fomass_max',fomass_max
-                         print*,'masse(ig,l)*fomass_max/ptimestep',masse(ig,l)*fomass_max/ptimestep
-                         print*,'ptimestep',ptimestep
-                         print*,'lmax(ig)',lmax(ig)
-                         print*,'fm(ig,l+1)',fm(ig,l+1)
-                         print*,'fm(ig,l)',fm(ig,l)
-                         abort_message = 'probleme dans thermcell_flux'
-                         CALL abort_physic (modname,abort_message,1)
-      endif
-      endif
-!                  
-!              ddd=detr(ig)-entre
-!on s assure que tout s annule bien en zmax
-      do ig=1,ngrid
-         fm(ig,lmax(ig)+1)=0.
-         entr(ig,lmax(ig))=0.
-         detr(ig,lmax(ig))=fm(ig,lmax(ig))+entr(ig,lmax(ig))
-      enddo
-
-!-----------------------------------------------------------------------
-! Impression du nombre de bidouilles qui ont ete necessaires
-!-----------------------------------------------------------------------
-
-!IM 090508 beg
-!     if (ncorecfm1+ncorecfm2+ncorecfm3+ncorecfm4+ncorecfm5+ncorecalpha > 0 ) then
-!
-!         print*,'PB thermcell : on a du coriger ',ncorecfm1,'x fm1',&
-!   &     ncorecfm2,'x fm2',ncorecfm3,'x fm3 et', &
-!   &     ncorecfm4,'x fm4',ncorecfm5,'x fm5 et', &
-!   &     ncorecfm6,'x fm6', &
-!   &     ncorecfm7,'x fm7', &
-!   &     ncorecfm8,'x fm8', &
-!   &     ncorecalpha,'x alpha'
-!     endif
-!IM 090508 end
-
-!      if (prt_level.ge.10) &
-!    &    call printflux(ngrid,nlay,lunout1,igout,f,lmax,lalim, &
-!    &    ptimestep,masse,entr,detr,fm,'fin')
-
-
- RETURN
-      end
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_height.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_height.F90	(revision 4726)
+++ 	(revision )
@@ -1,159 +1,0 @@
-      SUBROUTINE thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,  &
-     &           zw2,zlev,lmax,zmax,zmax0,zmix,wmax)
-      IMPLICIT NONE
-
-!-----------------------------------------------------------------------------
-!thermcell_height: calcul des caracteristiques du thermique: zmax,wmax,zmix
-!-----------------------------------------------------------------------------
-
-! arguments
-
-! Entree
-      integer, intent(in) :: ngrid,nlay
-      real, intent(in), dimension(ngrid) :: linter
-      real, intent(in), dimension(ngrid,nlay+1) :: zlev
-! Sortie
-      real, intent(out), dimension(ngrid) :: wmax,zmax,zmax0,zmix
-      integer, intent(out), dimension(ngrid) :: lmax
-! Les deux
-     integer, intent(inout), dimension(ngrid) :: lmix,lalim,lmin
-     real, intent(inout), dimension(ngrid,nlay+1) :: zw2
-
-! local
-     real, dimension(ngrid) :: num,denom,zlevinter
-     integer ig,l
-
-!calcul de la hauteur max du thermique
-      do ig=1,ngrid
-         lmax(ig)=lalim(ig)
-      enddo
-      do ig=1,ngrid
-         do l=nlay,lalim(ig)+1,-1
-            if (zw2(ig,l).le.1.e-10) then
-               lmax(ig)=l-1
-            endif
-         enddo
-      enddo
-
-! On traite le cas particulier qu'il faudrait éviter ou le thermique
-! atteind le haut du modele ...
-      do ig=1,ngrid
-      if ( zw2(ig,nlay) > 1.e-10 ) then
-          print*,'WARNING !!!!! W2 thermiques non nul derniere couche '
-          lmax(ig)=nlay
-      endif
-      enddo
-
-! pas de thermique si couche 1 stable
-      do ig=1,ngrid
-         if (lmin(ig).gt.1) then
-             lmax(ig)=1
-             lmin(ig)=1
-             lalim(ig)=1
-         endif
-      enddo 
-!    
-! Determination de zw2 max
-      do ig=1,ngrid
-         wmax(ig)=0.
-      enddo
-
-      do l=1,nlay
-         do ig=1,ngrid
-            if (l.le.lmax(ig)) then
-                if (zw2(ig,l).lt.0.)then
-                  print*,'pb2 zw2<0'
-                endif
-                zw2(ig,l)=sqrt(zw2(ig,l))
-                wmax(ig)=max(wmax(ig),zw2(ig,l))
-            else
-                 zw2(ig,l)=0.
-            endif
-          enddo
-      enddo
-
-!   Longueur caracteristique correspondant a la hauteur des thermiques.
-      do  ig=1,ngrid
-         zmax(ig)=0.
-         zlevinter(ig)=zlev(ig,1)
-      enddo
-
-!     if (iflag_thermals_ed.ge.1) then
-      if (1==0) then
-!CR:date de quand le calcul du zmax continu etait buggue 
-         num(:)=0.
-         denom(:)=0.
-         do ig=1,ngrid
-          do l=1,nlay
-             num(ig)=num(ig)+zw2(ig,l)*zlev(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-             denom(ig)=denom(ig)+zw2(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-          enddo
-       enddo
-       do ig=1,ngrid
-       if (denom(ig).gt.1.e-10) then
-          zmax(ig)=2.*num(ig)/denom(ig)
-          zmax0(ig)=zmax(ig)
-       endif 
-       enddo
- 
-      else
-!CR:Calcul de zmax continu via le linter      
-      do  ig=1,ngrid
-! calcul de zlevinter
-          zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*  &
-     &    linter(ig)+zlev(ig,lmax(ig))-lmax(ig)*(zlev(ig,lmax(ig)+1)  &
-     &    -zlev(ig,lmax(ig)))
-!pour le cas ou on prend tjs lmin=1
-!       zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
-       zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,1))
-       zmax0(ig)=zmax(ig)
-      enddo
-
-
-      endif
-!endif iflag_thermals_ed
-!
-! def de  zmix continu (profil parabolique des vitesses)
-      do ig=1,ngrid
-           if (lmix(ig).gt.1) then
-! test 
-              if (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
-     &        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))  &
-     &        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))  &
-     &        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))).gt.1e-10)  &
-     &        then
-!             
-            zmix(ig)=((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
-     &        *((zlev(ig,lmix(ig)))**2-(zlev(ig,lmix(ig)+1))**2)  &
-     &        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))  &
-     &        *((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))  &
-     &        /(2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
-     &        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))  &
-     &        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))  &
-     &        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
-              else
-              zmix(ig)=zlev(ig,lmix(ig))
-              print*,'pb zmix'
-              endif
-          else 
-              zmix(ig)=0.
-          endif
-!test
-         if ((zmax(ig)-zmix(ig)).le.0.) then
-            zmix(ig)=0.9*zmax(ig)
-!            print*,'pb zmix>zmax'
-         endif
-      enddo
-!
-! calcul du nouveau lmix correspondant
-      do ig=1,ngrid
-         do l=1,nlay
-            if (zmix(ig).ge.zlev(ig,l).and.  &
-     &          zmix(ig).lt.zlev(ig,l+1)) then
-              lmix(ig)=l
-             endif
-          enddo
-      enddo
-!
- RETURN
-      end
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_ini_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_ini_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,113 +1,0 @@
-MODULE thermcell_ini_mod
-IMPLICIT NONE
-
-save
-
-   integer :: dvdq=1,dqimpl=-1,prt_level=0,lunout
-   real RG,RD,RCPD,RKAPPA,RLVTT,RLvCp,RETV
-   real           :: r_aspect_thermals,tau_thermals,fact_thermals_ed_dz
-   integer        :: iflag_thermals_ed,iflag_thermals_optflux,iflag_thermals_closure
-   integer        :: iflag_thermals_down
-   real           :: fact_thermals_down
-
-!$OMP THREADPRIVATE(dvdq,dqimpl,prt_level,lunout)
-!$OMP THREADPRIVATE(RG,RD,RCPD,RKAPPA,RLVTT,RLvCp)
-!$OMP THREADPRIVATE(r_aspect_thermals,tau_thermals,fact_thermals_ed_dz)
-!$OMP THREADPRIVATE(iflag_thermals_ed,iflag_thermals_optflux,iflag_thermals_closure)
-!$OMP THREADPRIVATE(iflag_thermals_down)
-!$OMP THREADPRIVATE(fact_thermals_down)
-
-
-   REAL, SAVE :: fact_epsilon=0.002
-   REAL, SAVE :: betalpha=0.9
-   REAL, SAVE :: afact=2./3.
-   REAL, SAVE :: fact_shell=1.
-   REAL,SAVE :: detr_min=1.e-5
-   REAL,SAVE :: entr_min=1.e-5
-   REAL,SAVE :: detr_q_coef=0.012
-   REAL,SAVE :: detr_q_power=0.5
-   REAL,SAVE :: mix0=0.
-   INTEGER,SAVE :: thermals_flag_alim=0
-
-!$OMP THREADPRIVATE(fact_epsilon, betalpha, afact, fact_shell)
-!$OMP THREADPRIVATE(detr_min, entr_min, detr_q_coef, detr_q_power)
-!$OMP THREADPRIVATE( mix0, thermals_flag_alim)
-
-
-CONTAINS
-
-SUBROUTINE thermcell_ini(iflag_thermals,prt_level_in,tau_thermals_in,lunout_in, &
-   &    RG_in,RD_in,RCPD_in,RKAPPA_in,RLVTT_in,RETV_in)
-
-   USE ioipsl_getin_p_mod, ONLY : getin_p
-
-integer, intent(in) :: iflag_thermals,prt_level_in,lunout_in
-real, intent(in) :: RG_in,RD_in,RCPD_in,RKAPPA_in,RLVTT_in,RETV_in,tau_thermals_in
-
-print*,'thermcell_ini'
-      if (iflag_thermals==15.or.iflag_thermals==16) then
-         dvdq=0
-         dqimpl=-1
-      else
-         dvdq=1
-         dqimpl=1
-      endif
-   prt_level=prt_level_in
-   RG=RG_in
-   RD=RD_in
-   RCPD=RCPD_in
-   RKAPPA=RKAPPA_in
-   RLVTT=RLVTT_in
-   RLvCp = RLVTT/RCPD
-   RETV=RETV_in
-   tau_thermals=tau_thermals_in
-   lunout=lunout_in
-
-
-!=====================================================================
-! a la fois les vieilles param et thermcell_main :
-!=====================================================================
-
-   r_aspect_thermals=2.
-   CALL getin_p('r_aspect_thermals',r_aspect_thermals)
-   
-   tau_thermals = 0.
-   CALL getin_p('tau_thermals',tau_thermals)
-   
-   fact_thermals_ed_dz = 0.1
-   CALL getin_p('fact_thermals_ed_dz',fact_thermals_ed_dz)
-   
-   fact_thermals_ed_dz = 0.1
-   CALL getin_p('fact_thermals_ed_dz',fact_thermals_ed_dz)
-   
-   iflag_thermals_ed = 0
-   CALL getin_p('iflag_thermals_ed',iflag_thermals_ed)
-   
-   iflag_thermals_optflux = 0
-   CALL getin_p('iflag_thermals_optflux',iflag_thermals_optflux)
-   
-   iflag_thermals_closure = 1
-   CALL getin_p('iflag_thermals_closure',iflag_thermals_closure)
-
-   iflag_thermals_down = 0
-   CALL getin_p('iflag_thermals_down',iflag_thermals_down)
-
-   fact_thermals_down = 0.5
-   CALL getin_p('fact_thermals_down',fact_thermals_down)
-
-     CALL getin_p('thermals_fact_epsilon',fact_epsilon)
-     CALL getin_p('thermals_betalpha',betalpha)
-     CALL getin_p('thermals_afact',afact)
-     CALL getin_p('thermals_fact_shell',fact_shell)
-     CALL getin_p('thermals_detr_min',detr_min)
-     CALL getin_p('thermals_entr_min',entr_min)
-     CALL getin_p('thermals_detr_q_coef',detr_q_coef)
-     CALL getin_p('thermals_detr_q_power',detr_q_power)
-     CALL getin_p('thermals_mix0',mix0)
-     CALL getin_p('thermals_flag_alim',thermals_flag_alim)
-
-
- RETURN
-
-END SUBROUTINE thermcell_ini
-END MODULE thermcell_ini_mod
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_main.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_main.F90	(revision 4726)
+++ 	(revision )
@@ -1,886 +1,0 @@
-! $Id$
-!
-      subroutine thermcell_main(itap,ngrid,nlay,ptimestep  &
-     &                  ,pplay,pplev,pphi,debut  &
-     &                  ,pu,pv,pt,po  &
-     &                  ,pduadj,pdvadj,pdtadj,pdoadj  &
-     &                  ,fm0,entr0,detr0,zqta,zqla,lmax  &
-     &                  ,ratqscth,ratqsdiff,zqsatth  &
-     &                  ,zmax0, f0,zw2,fraca,ztv &
-     &                  ,zpspsk,ztla,zthl,ztva &
-     &                  ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &
-#ifdef ISO         
-     &      ,xtpo,xtpdoadj &
-#endif         
-     &   )
-
-
-      USE thermcell_ini_mod, ONLY: thermcell_ini,dqimpl,dvdq,prt_level,lunout,prt_level
-      USE thermcell_ini_mod, ONLY: iflag_thermals_closure,iflag_thermals_ed,tau_thermals,r_aspect_thermals
-      USE thermcell_ini_mod, ONLY: iflag_thermals_down, fact_thermals_down
-      USE thermcell_ini_mod, ONLY: RD,RG
-
-#ifdef ISO
-  USE infotrac_phy, ONLY : ntiso
-#ifdef ISOVERIF
-  USE isotopes_mod, ONLY : iso_eau,iso_HDO
-  USE isotopes_verif_mod, ONLY: iso_verif_egalite, &
-        iso_verif_aberrant_encadre
-#endif
-#endif
-
-
-      IMPLICIT NONE
-
-!=======================================================================
-!   Auteurs: Frederic Hourdin, Catherine Rio, Anne Mathieu
-!   Version du 09.02.07
-!   Calcul du transport vertical dans la couche limite en presence
-!   de "thermiques" explicitement representes avec processus nuageux
-!
-!   Reecriture a partir d'un listing papier a Habas, le 14/02/00
-!
-!   le thermique est suppose homogene et dissipe par melange avec
-!   son environnement. la longueur l_mix controle l'efficacite du
-!   melange
-!
-!   Le calcul du transport des differentes especes se fait en prenant
-!   en compte:
-!     1. un flux de masse montant
-!     2. un flux de masse descendant
-!     3. un entrainement
-!     4. un detrainement
-!
-! Modif 2013/01/04 (FH hourdin@lmd.jussieu.fr)
-!    Introduction of an implicit computation of vertical advection in
-!    the environment of thermal plumes in thermcell_dq
-!    impl =     0 : explicit, 1 : implicit, -1 : old version
-!    controled by iflag_thermals =
-!       15, 16 run with impl=-1 : numerical convergence with NPv3
-!       17, 18 run with impl=1  : more stable
-!    15 and 17 correspond to the activation of the stratocumulus "bidouille"
-!
-! Using
-!    abort_physic 
-!    iso_verif_aberrant_encadre
-!    iso_verif_egalite
-!    test_ltherm
-!    thermcell_closure
-!    thermcell_dq
-!    thermcell_dry
-!    thermcell_dv2
-!    thermcell_env
-!    thermcell_flux2
-!    thermcell_height
-!    thermcell_plume
-!    thermcell_plume_5B
-!    thermcell_plume_6A
-!
-!=======================================================================
-
-
-!-----------------------------------------------------------------------
-!   declarations:
-!   -------------
-
-
-!   arguments:
-!   ----------
-      integer, intent(in) :: itap,ngrid,nlay
-      real, intent(in) ::  ptimestep
-      real, intent(in), dimension(ngrid,nlay)    :: pt,pu,pv,po,pplay,pphi,zpspsk
-      real, intent(in), dimension(ngrid,nlay+1)  :: pplev
-      integer, intent(out), dimension(ngrid) :: lmax
-      real, intent(out), dimension(ngrid,nlay)   :: pdtadj,pduadj,pdvadj,pdoadj,entr0,detr0
-      real, intent(out), dimension(ngrid,nlay)   :: ztla,zqla,zqta,zqsatth,zthl
-      real, intent(out), dimension(ngrid,nlay+1) :: fm0,zw2,fraca
-      real, intent(inout), dimension(ngrid) :: zmax0,f0
-      real, intent(out), dimension(ngrid,nlay) :: ztva,ztv
-      logical, intent(in) :: debut
-      real,intent(out), dimension(ngrid,nlay) :: ratqscth,ratqsdiff
-
-      real, intent(out), dimension(ngrid) :: pcon
-      real, intent(out), dimension(ngrid,nlay) :: rhobarz,wth3
-      real, intent(out), dimension(ngrid) :: wmax_sec
-      integer,intent(out), dimension(ngrid) :: lalim
-      real, intent(out), dimension(ngrid,nlay+1) :: fm
-      real, intent(out), dimension(ngrid,nlay) :: alim_star
-      real, intent(out), dimension(ngrid) :: zmax
-
-!   local:
-!   ------
-
-
-      integer,save :: igout=1
-!$OMP THREADPRIVATE(igout)
-      integer,save :: lunout1=6
-!$OMP THREADPRIVATE(lunout1)
-      integer,save :: lev_out=10
-!$OMP THREADPRIVATE(lev_out)
-
-      real lambda, zf,zf2,var,vardiff,CHI
-      integer ig,k,l,ierr,ll
-      logical sorties
-      real, dimension(ngrid) :: linter,zmix, zmax_sec
-      integer,dimension(ngrid) :: lmin,lmix,lmix_bis,nivcon
-      real, dimension(ngrid,nlay) :: ztva_est
-      real, dimension(ngrid,nlay) :: deltaz,zlay,zh,zdthladj,zu,zv,zo,zl,zva,zua,zoa
-      real, dimension(ngrid,nlay) :: zta,zha,q2,wq,wthl,wthv,thetath2,wth2
-      real, dimension(ngrid,nlay) :: rho,masse
-      real, dimension(ngrid,nlay+1) :: zw_est,zlev
-      real, dimension(ngrid) :: wmax,wmax_tmp
-      real, dimension(ngrid,nlay+1) :: f_star
-      real, dimension(ngrid,nlay) :: entr,detr,entr_star,detr_star,alim_star_clos
-      real, dimension(ngrid,nlay) :: zqsat,csc
-      real, dimension(ngrid) :: zcon,zcon2,alim_star_tot,f
-      real, dimension(ngrid,nlay) :: entrdn,detrdn
-
-      character (len=20) :: modname='thermcell_main'
-      character (len=80) :: abort_message
-
-
-#ifdef ISO
-      REAL xtpo(ntiso,ngrid,nlay),xtpdoadj(ntiso,ngrid,nlay)
-      REAL xtzo(ntiso,ngrid,nlay)
-      REAL xtpdoadj_tmp(ngrid,nlay)
-      REAL xtpo_tmp(ngrid,nlay)
-      REAL xtzo_tmp(ngrid,nlay)
-      integer ixt
-#endif
-
-!
-
-!-----------------------------------------------------------------------
-!   initialisation:
-!   ---------------
-!
-   fm=0. ; entr=0. ; detr=0.
-
-      if (prt_level.ge.1) print*,'thermcell_main V4'
-
-       sorties=.true.
-      IF(ngrid.NE.ngrid) THEN
-         PRINT*
-         PRINT*,'STOP dans convadj'
-         PRINT*,'ngrid    =',ngrid
-         PRINT*,'ngrid  =',ngrid
-      ENDIF
-!
-!     write(lunout,*)'WARNING thermcell_main f0=max(f0,1.e-2)'
-     do ig=1,ngrid
-         f0(ig)=max(f0(ig),1.e-2)
-         zmax0(ig)=max(zmax0(ig),40.)
-!IMmarche pas ?!       if (f0(ig)<1.e-2) f0(ig)=1.e-2
-     enddo
-
-      if (prt_level.ge.20) then
-       do ig=1,ngrid
-          print*,'th_main ig f0',ig,f0(ig)
-       enddo
-      endif
-!-----------------------------------------------------------------------
-! Calcul de T,q,ql a partir de Tl et qT dans l environnement
-!   --------------------------------------------------------------------
-!
-      CALL thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
-     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out)
-       
-      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_env'
-
-!------------------------------------------------------------------------
-!                       --------------------
-!
-!
-!                       + + + + + + + + + + +
-!
-!
-!  wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
-!  wh,wt,wo ...
-!
-!                       + + + + + + + + + + +  zh,zu,zv,zo,rho
-!
-!
-!                       --------------------   zlev(1)
-!                       \\\\\\\\\\\\\\\\\\\\
-!
-!
-
-!-----------------------------------------------------------------------
-!   Calcul des altitudes des couches
-!-----------------------------------------------------------------------
-
-      do l=2,nlay
-         zlev(:,l)=0.5*(pphi(:,l)+pphi(:,l-1))/RG
-      enddo
-      zlev(:,1)=0.
-      zlev(:,nlay+1)=(2.*pphi(:,nlay)-pphi(:,nlay-1))/RG
-      do l=1,nlay
-         zlay(:,l)=pphi(:,l)/RG
-      enddo
-      do l=1,nlay
-         deltaz(:,l)=zlev(:,l+1)-zlev(:,l)
-      enddo
-
-!-----------------------------------------------------------------------
-!   Calcul des densites et masses
-!-----------------------------------------------------------------------
-
-      rho(:,:)=pplay(:,:)/(zpspsk(:,:)*RD*ztv(:,:))
-      if (prt_level.ge.10) write(lunout,*) 'WARNING thermcell_main rhobarz(:,1)=rho(:,1)'
-      rhobarz(:,1)=rho(:,1)
-      do l=2,nlay
-         rhobarz(:,l)=0.5*(rho(:,l)+rho(:,l-1))
-      enddo
-      do l=1,nlay
-         masse(:,l)=(pplev(:,l)-pplev(:,l+1))/RG
-      enddo
-      if (prt_level.ge.1) print*,'thermcell_main apres initialisation'
-
-!------------------------------------------------------------------
-!
-!             /|\
-!    --------  |  F_k+1 -------   
-!                              ----> D_k
-!             /|\              <---- E_k , A_k
-!    --------  |  F_k --------- 
-!                              ----> D_k-1
-!                              <---- E_k-1 , A_k-1
-!
-!
-!
-!
-!
-!    ---------------------------
-!
-!    ----- F_lmax+1=0 ----------         \
-!            lmax     (zmax)              |
-!    ---------------------------          |
-!                                         |
-!    ---------------------------          |
-!                                         |
-!    ---------------------------          |
-!                                         |
-!    ---------------------------          |
-!                                         |
-!    ---------------------------          |
-!                                         |  E
-!    ---------------------------          |  D
-!                                         |
-!    ---------------------------          |
-!                                         |
-!    ---------------------------  \       |
-!            lalim                 |      |
-!    ---------------------------   |      |
-!                                  |      |
-!    ---------------------------   |      |
-!                                  | A    |
-!    ---------------------------   |      |
-!                                  |      |
-!    ---------------------------   |      |
-!    lmin  (=1 pour le moment)     |      |
-!    ----- F_lmin=0 ------------  /      /
-!
-!    ---------------------------
-!    //////////////////////////
-!
-!
-!=============================================================================
-!  Calculs initiaux ne faisant pas intervenir les changements de phase
-!=============================================================================
-
-!------------------------------------------------------------------
-!  1. alim_star est le profil vertical de l'alimentation a la base du
-!     panache thermique, calcule a partir de la flotabilite de l'air sec
-!  2. lmin et lalim sont les indices inferieurs et superieurs de alim_star
-!------------------------------------------------------------------
-!
-      entr_star=0. ; detr_star=0. ; alim_star=0. ; alim_star_tot=0.
-      lmin=1
-
-!-----------------------------------------------------------------------------
-!  3. wmax_sec et zmax_sec sont les vitesses et altitudes maximum d'un
-!     panache sec conservatif (e=d=0) alimente selon alim_star 
-!     Il s'agit d'un calcul de type CAPE
-!     zmax_sec est utilise pour determiner la geometrie du thermique.
-!------------------------------------------------------------------------------
-!---------------------------------------------------------------------------------
-!calcul du melange et des variables dans le thermique
-!--------------------------------------------------------------------------------
-!
-      if (prt_level.ge.1) print*,'avant thermcell_plume ',lev_out
-
-!=====================================================================
-! Old version of thermcell_plume in thermcell_plume_6A.F90
-! It includes both thermcell_plume_6A and thermcell_plume_5B corresponding
-! to the 5B and 6A versions used for CMIP5 and CMIP6.
-! The latest was previously named thermcellV1_plume.
-! The new thermcell_plume is a clean version (removing obsolete
-! options) of thermcell_plume_6A.
-! The 3 versions are controled by
-! flag_thermals_ed <= 9 thermcell_plume_6A
-!                  <= 19 thermcell_plume_5B
-!                  else thermcell_plume (default 20 for convergence with 6A)
-! Fredho
-!=====================================================================
-
-      if (iflag_thermals_ed<=9) then
-!         print*,'THERM NOUVELLE/NOUVELLE Arnaud'
-         CALL thermcell_plume_6A(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,&
-     &    zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
-     &    lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
-     &    ztla,zqla,zqta,zha,zw2,zw_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
-     &    ,lev_out,lunout1,igout)
-
-      elseif (iflag_thermals_ed<=19) then
-!        print*,'THERM RIO et al 2010, version d Arnaud'
-         CALL thermcell_plume_5B(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,&
-     &    zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
-     &    lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
-     &    ztla,zqla,zqta,zha,zw2,zw_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
-     &    ,lev_out,lunout1,igout)
-      else
-         CALL thermcell_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,&
-     &    zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
-     &    lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
-     &    ztla,zqla,zqta,zha,zw2,zw_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
-     &    ,lev_out,lunout1,igout)
-      endif
-
-      if (prt_level.ge.1) print*,'apres thermcell_plume ',lev_out
-
-      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ')
-      call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix  ')
-
-      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_plume'
-      if (prt_level.ge.10) then
-         write(lunout1,*) 'Dans thermcell_main 2'
-         write(lunout1,*) 'lmin ',lmin(igout)
-         write(lunout1,*) 'lalim ',lalim(igout)
-         write(lunout1,*) ' ig l alim_star entr_star detr_star f_star '
-         write(lunout1,'(i6,i4,4e15.5)') (igout,l,alim_star(igout,l),entr_star(igout,l),detr_star(igout,l) &
-     &    ,f_star(igout,l+1),l=1,nint(linter(igout))+5)
-      endif
-
-!-------------------------------------------------------------------------------
-! Calcul des caracteristiques du thermique:zmax,zmix,wmax
-!-------------------------------------------------------------------------------
-!
-      CALL thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,zw2,  &
-     &           zlev,lmax,zmax,zmax0,zmix,wmax)
-! Attention, w2 est transforme en sa racine carree dans cette routine
-! Le probleme vient du fait que linter et lmix sont souvent egaux a 1.
-      wmax_tmp=0.
-      do  l=1,nlay
-         wmax_tmp(:)=max(wmax_tmp(:),zw2(:,l))
-      enddo
-!     print*,"ZMAX ",lalim,lmin,linter,lmix,lmax,zmax,zmax0,zmix,wmax
-
-
-
-      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ')
-      call test_ltherm(ngrid,nlay,pplay,lmin ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin  ')
-      call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix  ')
-      call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax  ')
-
-      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_height'
-
-!-------------------------------------------------------------------------------
-! Fermeture,determination de f
-!-------------------------------------------------------------------------------
-!
-!
-      CALL thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star,  &
-    &                      lalim,lmin,zmax_sec,wmax_sec)
-
- 
-call test_ltherm(ngrid,nlay,pplay,lmin,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lmin  ')
-call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lalim ')
-
-      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_dry'
-      if (prt_level.ge.10) then
-         write(lunout1,*) 'Dans thermcell_main 1b'
-         write(lunout1,*) 'lmin ',lmin(igout)
-         write(lunout1,*) 'lalim ',lalim(igout)
-         write(lunout1,*) ' ig l alim_star entr_star detr_star f_star '
-         write(lunout1,'(i6,i4,e15.5)') (igout,l,alim_star(igout,l) &
-     &    ,l=1,lalim(igout)+4)
-      endif
-
-
-
-
-! Choix de la fonction d'alimentation utilisee pour la fermeture.
-! Apparemment sans importance
-      alim_star_clos(:,:)=alim_star(:,:)
-      alim_star_clos(:,:)=entr_star(:,:)+alim_star(:,:)
-!
-!CR Appel de la fermeture seche 
-      if (iflag_thermals_closure.eq.1) then
-
-     CALL thermcell_closure(ngrid,nlay,r_aspect_thermals,ptimestep,rho,  &
-    &   zlev,lalim,alim_star_clos,zmax_sec,wmax_sec,f)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Appel avec les zmax et wmax tenant compte de la condensation
-! Semble moins bien marcher
-     else if (iflag_thermals_closure.eq.2) then
-
-     CALL thermcell_closure(ngrid,nlay,r_aspect_thermals,ptimestep,rho,  &
-    &   zlev,lalim,alim_star,zmax,wmax,f)
-
-
-     endif
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      if(prt_level.ge.1)print*,'thermcell_closure apres thermcell_closure'
-
-      if (tau_thermals>1.) then
-         lambda=exp(-ptimestep/tau_thermals)
-         f0=(1.-lambda)*f+lambda*f0
-      else
-         f0=f
-      endif
-
-! Test valable seulement en 1D mais pas genant
-      if (.not. (f0(1).ge.0.) ) then
-              abort_message = '.not. (f0(1).ge.0.)'
-              CALL abort_physic (modname,abort_message,1)
-      endif
-
-!-------------------------------------------------------------------------------
-!deduction des flux
-
-      CALL thermcell_flux2(ngrid,nlay,ptimestep,masse, &
-     &       lalim,lmax,alim_star,  &
-     &       entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr,  &
-     &       detr,zqla,lev_out,lunout1,igout)
-
-!IM 060508    &       detr,zqla,zmax,lev_out,lunout,igout)
-
-      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_flux'
-      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ')
-      call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax  ')
-
-!------------------------------------------------------------------
-!   On ne prend pas directement les profils issus des calculs precedents
-!   mais on s'autorise genereusement une relaxation vers ceci avec
-!   une constante de temps tau_thermals (typiquement 1800s).
-!------------------------------------------------------------------
-
-      if (tau_thermals>1.) then
-         lambda=exp(-ptimestep/tau_thermals)
-         fm0=(1.-lambda)*fm+lambda*fm0
-         entr0=(1.-lambda)*entr+lambda*entr0
-         detr0=(1.-lambda)*detr+lambda*detr0
-      else
-         fm0=fm
-         entr0=entr
-         detr0=detr
-      endif
-
-!------------------------------------------------------------------
-! Calcul de la fraction de l'ascendance
-!------------------------------------------------------------------
-      do ig=1,ngrid
-         fraca(ig,1)=0.
-         fraca(ig,nlay+1)=0.
-      enddo
-      do l=2,nlay
-         do ig=1,ngrid
-            if (zw2(ig,l).gt.1.e-10) then
-            fraca(ig,l)=fm(ig,l)/(rhobarz(ig,l)*zw2(ig,l))
-            else
-            fraca(ig,l)=0.
-            endif
-         enddo
-      enddo
-     
-!c------------------------------------------------------------------
-!   calcul du transport vertical
-!------------------------------------------------------------------
-      IF (iflag_thermals_down .GT. 0) THEN
-        if (debut) print*,'WARNING !!! routine thermcell_down en cours de developpement'
-        entrdn=fact_thermals_down*detr0
-        detrdn=fact_thermals_down*entr0 
-        ! we want to transport potential temperature, total water and momentum
-        CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,zthl,zdthladj)
-        CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,po,pdoadj)
-        CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,zu,pduadj)
-        CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,zv,pdvadj)
-      ELSE
-      !--------------------------------------------------------------
-
-        call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse,  &
-        &                    zthl,zdthladj,zta,lev_out)
-        call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse,  &
-        &                   po,pdoadj,zoa,lev_out)
-
-#ifdef ISO
-        ! C Risi: on utilise directement la meme routine
-        do ixt=1,ntiso
-          do ll=1,nlay
-            DO ig=1,ngrid
-                xtpo_tmp(ig,ll)=xtpo(ixt,ig,ll)
-                xtzo_tmp(ig,ll)=xtzo(ixt,ig,ll)
-            enddo
-          enddo
-          call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse,  &
-     &                   xtpo_tmp,xtpdoadj_tmp,xtzo_tmp,lev_out)
-          do ll=1,nlay
-            DO ig=1,ngrid
-                xtpdoadj(ixt,ig,ll)=xtpdoadj_tmp(ig,ll)
-            enddo
-          enddo
-        enddo
-#endif
-
-#ifdef ISO      
-#ifdef ISOVERIF
-      DO  ll=1,nlay
-        DO ig=1,ngrid
-          if (iso_eau.gt.0) then
-              call iso_verif_egalite(xtpo(iso_eau,ig,ll), &
-     &          po(ig,ll),'thermcell_main 594')
-              call iso_verif_egalite(xtpdoadj(iso_eau,ig,ll), &
-     &          pdoadj(ig,ll),'thermcell_main 596')
-          endif
-          if (iso_HDO.gt.0) then
-              call iso_verif_aberrant_encadre(xtpo(iso_hdo,ig,ll) &
-     &           /po(ig,ll),'thermcell_main 610')
-          endif
-        enddo
-      enddo !DO  ll=1,nlay 
-      write(*,*) 'thermcell_main 600 tmp: apres thermcell_dq'
-#endif      
-#endif
-
-
-!------------------------------------------------------------------
-!  calcul du transport vertical du moment horizontal
-!------------------------------------------------------------------
-
-!IM 090508  
-      if (dvdq == 0 ) then
-
-! Calcul du transport de V tenant compte d'echange par gradient
-! de pression horizontal avec l'environnement
-
-         call thermcell_dv2(ngrid,nlay,ptimestep,fm0,entr0,masse  &
-!    &    ,fraca*dvdq,zmax &
-     &    ,fraca,zmax &
-     &    ,zu,zv,pduadj,pdvadj,zua,zva,lev_out)
-
-      else
-
-! calcul purement conservatif pour le transport de V
-         call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse  &
-     &    ,zu,pduadj,zua,lev_out)
-         call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse  &
-     &    ,zv,pdvadj,zva,lev_out)
-
-      endif
-    ENDIF
-
-!     print*,'13 OK convect8'
-      do l=1,nlay
-         do ig=1,ngrid
-           pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l)  
-         enddo
-      enddo
-
-      if (prt_level.ge.1) print*,'14 OK convect8'
-!------------------------------------------------------------------
-!   Calculs de diagnostiques pour les sorties
-!------------------------------------------------------------------
-!calcul de fraca pour les sorties
-      
-      if (sorties) then
-      if (prt_level.ge.1) print*,'14a OK convect8'
-! calcul du niveau de condensation
-! initialisation
-      do ig=1,ngrid
-         nivcon(ig)=0
-         zcon(ig)=0.
-      enddo 
-!nouveau calcul
-      do ig=1,ngrid
-      CHI=zh(ig,1)/(1669.0-122.0*zo(ig,1)/zqsat(ig,1)-zh(ig,1))
-      pcon(ig)=pplay(ig,1)*(zo(ig,1)/zqsat(ig,1))**CHI
-      enddo
-!IM   do k=1,nlay
-      do k=1,nlay-1
-         do ig=1,ngrid
-         if ((pcon(ig).le.pplay(ig,k))  &
-     &      .and.(pcon(ig).gt.pplay(ig,k+1))) then
-            zcon2(ig)=zlay(ig,k)-(pcon(ig)-pplay(ig,k))/(RG*rho(ig,k))/100.
-         endif
-         enddo
-      enddo
-!IM
-      ierr=0
-      do ig=1,ngrid
-        if (pcon(ig).le.pplay(ig,nlay)) then 
-           zcon2(ig)=zlay(ig,nlay)-(pcon(ig)-pplay(ig,nlay))/(RG*rho(ig,nlay))/100.
-           ierr=1
-        endif
-      enddo
-      if (ierr==1) then
-           abort_message = 'thermcellV0_main: les thermiques vont trop haut '
-           CALL abort_physic (modname,abort_message,1)
-      endif
-
-      if (prt_level.ge.1) print*,'14b OK convect8'
-      do k=nlay,1,-1
-         do ig=1,ngrid
-            if (zqla(ig,k).gt.1e-10) then
-               nivcon(ig)=k
-               zcon(ig)=zlev(ig,k)
-            endif
-         enddo
-      enddo
-      if (prt_level.ge.1) print*,'14c OK convect8'
-!calcul des moments
-!initialisation
-      do l=1,nlay
-         do ig=1,ngrid
-            q2(ig,l)=0.
-            wth2(ig,l)=0.
-            wth3(ig,l)=0.
-            ratqscth(ig,l)=0.
-            ratqsdiff(ig,l)=0.
-         enddo
-      enddo      
-      if (prt_level.ge.1) print*,'14d OK convect8'
-      if (prt_level.ge.10)write(lunout,*)                                &
-    &     'WARNING thermcell_main wth2=0. si zw2 > 1.e-10'
-      do l=1,nlay
-         do ig=1,ngrid
-            zf=fraca(ig,l)
-            zf2=zf/(1.-zf)
-!
-            thetath2(ig,l)=zf2*(ztla(ig,l)-zthl(ig,l))**2
-            if(zw2(ig,l).gt.1.e-10) then
-             wth2(ig,l)=zf2*(zw2(ig,l))**2
-            else
-             wth2(ig,l)=0.
-            endif
-            wth3(ig,l)=zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l))  &
-     &                *zw2(ig,l)*zw2(ig,l)*zw2(ig,l)
-            q2(ig,l)=zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2
-!test: on calcul q2/po=ratqsc
-            ratqscth(ig,l)=sqrt(max(q2(ig,l),1.e-6)/(po(ig,l)*1000.))
-         enddo
-      enddo
-!calcul des flux: q, thetal et thetav
-      do l=1,nlay
-         do ig=1,ngrid
-      wq(ig,l)=fraca(ig,l)*zw2(ig,l)*(zqta(ig,l)*1000.-po(ig,l)*1000.)
-      wthl(ig,l)=fraca(ig,l)*zw2(ig,l)*(ztla(ig,l)-zthl(ig,l))
-      wthv(ig,l)=fraca(ig,l)*zw2(ig,l)*(ztva(ig,l)-ztv(ig,l))
-         enddo
-      enddo
-
-!calcul du ratqscdiff
-      if (prt_level.ge.1) print*,'14e OK convect8'
-      var=0.
-      vardiff=0.
-      ratqsdiff(:,:)=0.
-
-      do l=1,nlay
-         do ig=1,ngrid
-            if (l<=lalim(ig)) then
-            var=var+alim_star(ig,l)*zqta(ig,l)*1000.
-            endif
-         enddo
-      enddo
-
-      if (prt_level.ge.1) print*,'14f OK convect8'
-
-      do l=1,nlay
-         do ig=1,ngrid
-            if (l<=lalim(ig)) then
-               zf=fraca(ig,l)
-               zf2=zf/(1.-zf)
-               vardiff=vardiff+alim_star(ig,l)*(zqta(ig,l)*1000.-var)**2
-            endif
-         enddo
-      enddo
-
-      if (prt_level.ge.1) print*,'14g OK convect8'
-         do l=1,nlay
-            do ig=1,ngrid
-               ratqsdiff(ig,l)=sqrt(vardiff)/(po(ig,l)*1000.)   
-            enddo
-         enddo 
-      endif
-
-      if (prt_level.ge.1) print*,'thermcell_main FIN  OK'
-
- RETURN
-      end subroutine thermcell_main
-
-!=============================================================================
-!/////////////////////////////////////////////////////////////////////////////
-!=============================================================================
-      subroutine test_ltherm(ngrid,nlay,pplay,long,ztv,po,ztva, &  ! in
-    &            zqla,f_star,zw2,comment)                          ! in
-!=============================================================================
-      USE thermcell_ini_mod, ONLY: prt_level
-      IMPLICIT NONE
-
-      integer i, k, ngrid,nlay
-      real, intent(in), dimension(ngrid,nlay) :: pplay,ztv,po,ztva,zqla
-      real, intent(in), dimension(ngrid,nlay) :: f_star,zw2
-      integer, intent(in), dimension(ngrid) :: long
-      real seuil
-      character*21 comment
-
-      seuil=0.25
-
-      if (prt_level.ge.1) THEN
-       print*,'WARNING !!! TEST ',comment
-      endif
-      return
-
-!  test sur la hauteur des thermiques ...
-         do i=1,ngrid
-!IMtemp           if (pplay(i,long(i)).lt.seuil*pplev(i,1)) then
-           if (prt_level.ge.10) then
-               print*,'WARNING ',comment,' au point ',i,' K= ',long(i)
-               print*,'  K  P(MB)  THV(K)     Qenv(g/kg)THVA        QLA(g/kg)   F*        W2'
-               do k=1,nlay
-                  write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*po(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k)
-               enddo
-           endif
-         enddo
-
-
-      return
-      end
-
-! nrlmd le 10/04/2012   Transport de la TKE par le thermique moyen pour la fermeture en ALP 
-!                       On transporte pbl_tke pour donner therm_tke
-!                       Copie conforme de la subroutine DTKE dans physiq.F ecrite par Frederic Hourdin
-
-!=======================================================================
-!///////////////////////////////////////////////////////////////////////
-!=======================================================================
-
-      subroutine thermcell_tke_transport( &
-     &     ngrid,nlay,ptimestep,fm0,entr0,rg,pplev,  &   ! in
-     &     therm_tke_max)                                ! out
-      USE thermcell_ini_mod, ONLY: prt_level
-      implicit none
-
-!=======================================================================
-!
-!   Calcul du transport verticale dans la couche limite en presence
-!   de "thermiques" explicitement representes
-!   calcul du dq/dt une fois qu'on connait les ascendances
-!
-!=======================================================================
-
-      integer ngrid,nlay
-
-      real, intent(in) :: ptimestep
-      real, intent(in), dimension(ngrid,nlay+1) :: fm0,pplev
-      real, intent(in), dimension(ngrid,nlay) :: entr0
-      real, intent(in) :: rg
-      real, intent(out), dimension(ngrid,nlay) :: therm_tke_max
-
-      real detr0(ngrid,nlay)
-      real masse0(ngrid,nlay)
-      real masse(ngrid,nlay),fm(ngrid,nlay+1)
-      real entr(ngrid,nlay)
-      real q(ngrid,nlay)
-      integer lev_out                           ! niveau pour les print
-
-      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
-      integer ig,k
-
-
-      lev_out=0
-
-
-      if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0'
-
-!   calcul du detrainement
-      do k=1,nlay
-         detr0(:,k)=fm0(:,k)-fm0(:,k+1)+entr0(:,k)
-         masse0(:,k)=(pplev(:,k)-pplev(:,k+1))/RG
-      enddo
-
-
-! Decalage vertical des entrainements et detrainements.
-      masse(:,1)=0.5*masse0(:,1)
-      entr(:,1)=0.5*entr0(:,1)
-      detr(:,1)=0.5*detr0(:,1)
-      fm(:,1)=0.
-      do k=1,nlay-1
-         masse(:,k+1)=0.5*(masse0(:,k)+masse0(:,k+1))
-         entr(:,k+1)=0.5*(entr0(:,k)+entr0(:,k+1))
-         detr(:,k+1)=0.5*(detr0(:,k)+detr0(:,k+1))
-         fm(:,k+1)=fm(:,k)+entr(:,k)-detr(:,k)
-      enddo
-      fm(:,nlay+1)=0.
-
-
-   q(:,:)=therm_tke_max(:,:)
-!!! nrlmd le 16/09/2010
-      do ig=1,ngrid
-         qa(ig,1)=q(ig,1)
-      enddo
-!!!
-
-    if (1==1) then
-      do k=2,nlay
-         do ig=1,ngrid
-            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
-     &         1.e-5*masse(ig,k)) then
-         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
-     &         /(fm(ig,k+1)+detr(ig,k))
-            else
-               qa(ig,k)=q(ig,k)
-            endif
-            if (qa(ig,k).lt.0.) then
-!               print*,'qa<0!!!'
-            endif
-            if (q(ig,k).lt.0.) then
-!               print*,'q<0!!!'
-            endif
-         enddo
-      enddo
-
-! Calcul du flux subsident
-
-      do k=2,nlay
-         do ig=1,ngrid
-            wqd(ig,k)=fm(ig,k)*q(ig,k)
-            if (wqd(ig,k).lt.0.) then
-!               print*,'wqd<0!!!'
-            endif
-         enddo
-      enddo
-      do ig=1,ngrid
-         wqd(ig,1)=0.
-         wqd(ig,nlay+1)=0.
-      enddo
-
-! Calcul des tendances
-      do k=1,nlay
-         do ig=1,ngrid
-            q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)  &
-     &               -wqd(ig,k)+wqd(ig,k+1))  &
-     &               *ptimestep/masse(ig,k)
-         enddo
-      enddo
-
- endif
-
-   therm_tke_max(:,:)=q(:,:)
-
-      return
-!!! fin nrlmd le 10/04/2012
-     end
-
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_old.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_old.F90	(revision 4726)
+++ 	(revision )
@@ -1,5341 +1,0 @@
-SUBROUTINE thermcell_2002(ngrid, nlay, ptimestep, iflag_thermals, pplay, &
-    pplev, pphi, pu, pv, pt, po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0, &
-    fraca, wa_moy, r_aspect, l_mix, w2di, tho)
-
-  USE dimphy
-  USE write_field_phy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-
-  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
-
-  ! le thermique est supposé homogène et dissipé par mélange avec
-  ! son environnement. la longueur l_mix contrôle l'efficacité du
-  ! mélange
-
-  ! Le calcul du transport des différentes espèces se fait en prenant
-  ! en compte:
-  ! 1. un flux de masse montant
-  ! 2. un flux de masse descendant
-  ! 3. un entrainement
-  ! 4. un detrainement
-
-  ! =======================================================================
-
-  ! -----------------------------------------------------------------------
-  ! declarations:
-  ! -------------
-
-  include "YOMCST.h"
-
-  ! arguments:
-  ! ----------
-
-  INTEGER ngrid, nlay, w2di, iflag_thermals
-  REAL tho
-  REAL ptimestep, l_mix, r_aspect
-  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
-  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
-  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
-  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
-  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
-  REAL pphi(ngrid, nlay)
-  REAL fraca(ngrid, nlay+1), zw2(ngrid, nlay+1)
-
-  INTEGER, SAVE :: idetr = 3, lev_out = 1
-  !$OMP THREADPRIVATE(idetr,lev_out)
-
-  ! local:
-  ! ------
-
-  INTEGER, SAVE :: dvdq = 0, flagdq = 0, dqimpl = 1
-  LOGICAL, SAVE :: debut = .TRUE.
-  !$OMP THREADPRIVATE(dvdq,flagdq,debut,dqimpl)
-
-  INTEGER ig, k, l, lmax(klon, klev+1), lmaxa(klon), lmix(klon)
-  REAL zmax(klon), zw, zz, ztva(klon, klev), zzz
-
-  REAL zlev(klon, klev+1), zlay(klon, klev)
-  REAL zh(klon, klev), zdhadj(klon, klev)
-  REAL ztv(klon, klev)
-  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
-  REAL wh(klon, klev+1)
-  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
-  REAL zla(klon, klev+1)
-  REAL zwa(klon, klev+1)
-  REAL zld(klon, klev+1)
-  REAL zwd(klon, klev+1)
-  REAL zsortie(klon, klev)
-  REAL zva(klon, klev)
-  REAL zua(klon, klev)
-  REAL zoa(klon, klev)
-
-  REAL zha(klon, klev)
-  REAL wa_moy(klon, klev+1)
-  REAL fracc(klon, klev+1)
-  REAL zf, zf2
-  REAL thetath2(klon, klev), wth2(klon, klev)
-  ! common/comtherm/thetath2,wth2
-
-  REAL count_time
-
-  LOGICAL sorties
-  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
-  REAL zpspsk(klon, klev)
-
-  REAL wmax(klon, klev), wmaxa(klon)
-
-  REAL wa(klon, klev, klev+1)
-  REAL wd(klon, klev+1)
-  REAL larg_part(klon, klev, klev+1)
-  REAL fracd(klon, klev+1)
-  REAL xxx(klon, klev+1)
-  REAL larg_cons(klon, klev+1)
-  REAL larg_detr(klon, klev+1)
-  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
-  REAL pu_therm(klon, klev), pv_therm(klon, klev)
-  REAL fm(klon, klev+1), entr(klon, klev)
-  REAL fmc(klon, klev+1)
-
-  CHARACTER (LEN=2) :: str2
-  CHARACTER (LEN=10) :: str10
-
-  CHARACTER (LEN=20) :: modname = 'thermcell2002'
-  CHARACTER (LEN=80) :: abort_message
-
-  LOGICAL vtest(klon), down
-
-  EXTERNAL scopy
-
-  INTEGER ncorrec, ll
-  SAVE ncorrec
-  DATA ncorrec/0/
-  !$OMP THREADPRIVATE(ncorrec)
-
-
-  ! -----------------------------------------------------------------------
-  ! initialisation:
-  ! ---------------
-
-  sorties = .TRUE.
-  IF (ngrid/=klon) THEN
-    PRINT *
-    PRINT *, 'STOP dans convadj'
-    PRINT *, 'ngrid    =', ngrid
-    PRINT *, 'klon  =', klon
-  END IF
-
-  ! -----------------------------------------------------------------------
-  ! incrementation eventuelle de tendances precedentes:
-  ! ---------------------------------------------------
-
-  ! print*,'0 OK convect8'
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
-      zh(ig, l) = pt(ig, l)/zpspsk(ig, l)
-      zu(ig, l) = pu(ig, l)
-      zv(ig, l) = pv(ig, l)
-      zo(ig, l) = po(ig, l)
-      ztv(ig, l) = zh(ig, l)*(1.+0.61*zo(ig,l))
-    END DO
-  END DO
-
-  ! print*,'1 OK convect8'
-  ! --------------------
-
-
-  ! + + + + + + + + + + +
-
-
-  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
-  ! wh,wt,wo ...
-
-  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
-
-
-  ! --------------------   zlev(1)
-  ! \\\\\\\\\\\\\\\\\\\\
-
-
-
-  ! -----------------------------------------------------------------------
-  ! Calcul des altitudes des couches
-  ! -----------------------------------------------------------------------
-
-  IF (debut) THEN
-    flagdq = (iflag_thermals-1000)/100
-    dvdq = (iflag_thermals-(1000+flagdq*100))/10
-    IF (flagdq==2) dqimpl = -1
-    IF (flagdq==3) dqimpl = 1
-    debut = .FALSE.
-  END IF
-  PRINT *, 'TH flag th ', iflag_thermals, flagdq, dvdq, dqimpl
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zlev(ig, 1) = 0.
-    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
-  END DO
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zlay(ig, l) = pphi(ig, l)/rg
-    END DO
-  END DO
-
-  ! print*,'2 OK convect8'
-  ! -----------------------------------------------------------------------
-  ! Calcul des densites
-  ! -----------------------------------------------------------------------
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*zh(ig,l))
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
-    END DO
-  END DO
-
-  DO k = 1, nlay
-    DO l = 1, nlay + 1
-      DO ig = 1, ngrid
-        wa(ig, k, l) = 0.
-      END DO
-    END DO
-  END DO
-
-  ! print*,'3 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calcul de w2, quarre de w a partir de la cape
-  ! a partir de w2, on calcule wa, vitesse de l'ascendance
-
-  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
-  ! w2 est stoke dans wa
-
-  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
-  ! independants par couches que pour calculer l'entrainement
-  ! a la base et la hauteur max de l'ascendance.
-
-  ! Indicages:
-  ! l'ascendance provenant du niveau k traverse l'interface l avec
-  ! une vitesse wa(k,l).
-
-  ! --------------------
-
-  ! + + + + + + + + + +
-
-  ! wa(k,l)   ----       --------------------    l
-  ! /\
-  ! /||\       + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||
-  ! ||        + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||__
-  ! |___      + + + + + + + + + +     k
-
-  ! --------------------
-
-
-
-  ! ------------------------------------------------------------------
-
-
-  DO k = 1, nlay - 1
-    DO ig = 1, ngrid
-      wa(ig, k, k) = 0.
-      wa(ig, k, k+1) = 2.*rg*(ztv(ig,k)-ztv(ig,k+1))/ztv(ig, k+1)* &
-        (zlev(ig,k+1)-zlev(ig,k))
-    END DO
-    DO l = k + 1, nlay - 1
-      DO ig = 1, ngrid
-        wa(ig, k, l+1) = wa(ig, k, l) + 2.*rg*(ztv(ig,k)-ztv(ig,l))/ztv(ig, l &
-          )*(zlev(ig,l+1)-zlev(ig,l))
-      END DO
-    END DO
-    DO ig = 1, ngrid
-      wa(ig, k, nlay+1) = 0.
-    END DO
-  END DO
-
-  ! print*,'4 OK convect8'
-  ! Calcul de la couche correspondant a la hauteur du thermique
-  DO k = 1, nlay - 1
-    DO ig = 1, ngrid
-      lmax(ig, k) = k
-    END DO
-    DO l = nlay, k + 1, -1
-      DO ig = 1, ngrid
-        IF (wa(ig,k,l)<=1.E-10) lmax(ig, k) = l - 1
-      END DO
-    END DO
-  END DO
-
-  ! print*,'5 OK convect8'
-  ! Calcule du w max du thermique
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      wmax(ig, k) = 0.
-    END DO
-  END DO
-
-  DO k = 1, nlay - 1
-    DO l = k, nlay
-      DO ig = 1, ngrid
-        IF (l<=lmax(ig,k)) THEN
-          wa(ig, k, l) = sqrt(wa(ig,k,l))
-          wmax(ig, k) = max(wmax(ig,k), wa(ig,k,l))
-        ELSE
-          wa(ig, k, l) = 0.
-        END IF
-      END DO
-    END DO
-  END DO
-
-  DO k = 1, nlay - 1
-    DO ig = 1, ngrid
-      pu_therm(ig, k) = sqrt(wmax(ig,k))
-      pv_therm(ig, k) = sqrt(wmax(ig,k))
-    END DO
-  END DO
-
-  ! print*,'6 OK convect8'
-  ! Longueur caracteristique correspondant a la hauteur des thermiques.
-  DO ig = 1, ngrid
-    zmax(ig) = 500.
-  END DO
-  ! print*,'LMAX LMAX LMAX '
-  DO k = 1, nlay - 1
-    DO ig = 1, ngrid
-      zmax(ig) = max(zmax(ig), zlev(ig,lmax(ig,k))-zlev(ig,k))
-    END DO
-    ! print*,k,lmax(1,k)
-  END DO
-  ! print*,'ZMAX ZMAX ZMAX ',zmax
-  ! call dump2d(iim,jjm-1,zmax(2:ngrid-1),'ZMAX      ')
-
-  ! print*,'OKl336'
-  ! Calcul de l'entrainement.
-  ! Le rapport d'aspect relie la largeur de l'ascendance a l'epaisseur
-  ! de la couche d'alimentation en partant du principe que la vitesse
-  ! maximum dans l'ascendance est la vitesse d'entrainement horizontale.
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      zzz = rho(ig, k)*wmax(ig, k)*(zlev(ig,k+1)-zlev(ig,k))/ &
-        (zmax(ig)*r_aspect)
-      IF (w2di==2) THEN
-        entr(ig, k) = entr(ig, k) + ptimestep*(zzz-entr(ig,k))/tho
-      ELSE
-        entr(ig, k) = zzz
-      END IF
-      ztva(ig, k) = ztv(ig, k)
-    END DO
-  END DO
-
-
-  ! print*,'7 OK convect8'
-  DO k = 1, klev + 1
-    DO ig = 1, ngrid
-      zw2(ig, k) = 0.
-      fmc(ig, k) = 0.
-      larg_cons(ig, k) = 0.
-      larg_detr(ig, k) = 0.
-      wa_moy(ig, k) = 0.
-    END DO
-  END DO
-
-  ! print*,'8 OK convect8'
-  DO ig = 1, ngrid
-    lmaxa(ig) = 1
-    lmix(ig) = 1
-    wmaxa(ig) = 0.
-  END DO
-
-
-  ! print*,'OKl372'
-  DO l = 1, nlay - 2
-    DO ig = 1, ngrid
-      ! if (zw2(ig,l).lt.1.e-10.and.ztv(ig,l).gt.ztv(ig,l+1)) then
-      ! print*,'COUCOU ',l,zw2(ig,l),ztv(ig,l),ztv(ig,l+1)
-      IF (zw2(ig,l)<1.E-10 .AND. ztv(ig,l)>ztv(ig,l+1) .AND. &
-          entr(ig,l)>1.E-10) THEN
-        ! print*,'COUCOU cas 1'
-        ! Initialisation de l'ascendance
-        ! lmix(ig)=1
-        ztva(ig, l) = ztv(ig, l)
-        fmc(ig, l) = 0.
-        fmc(ig, l+1) = entr(ig, l)
-        zw2(ig, l) = 0.
-        ! if (.not.ztv(ig,l+1).gt.150.) then
-        ! print*,'ig,l+1,ztv(ig,l+1)'
-        ! print*, ig,l+1,ztv(ig,l+1)
-        ! endif
-        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
-          (zlev(ig,l+1)-zlev(ig,l))
-        larg_detr(ig, l) = 0.
-      ELSE IF (zw2(ig,l)>=1.E-10 .AND. fmc(ig,l)+entr(ig,l)>1.E-10) THEN
-        ! Incrementation...
-        fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
-        ! if (.not.fmc(ig,l+1).gt.1.e-15) then
-        ! print*,'ig,l+1,fmc(ig,l+1)'
-        ! print*, ig,l+1,fmc(ig,l+1)
-        ! print*,'Fmc ',(fmc(ig,ll),ll=1,klev+1)
-        ! print*,'W2 ',(zw2(ig,ll),ll=1,klev+1)
-        ! print*,'Tv ',(ztv(ig,ll),ll=1,klev)
-        ! print*,'Entr ',(entr(ig,ll),ll=1,klev)
-        ! endif
-        ztva(ig, l) = (fmc(ig,l)*ztva(ig,l-1)+entr(ig,l)*ztv(ig,l))/ &
-          fmc(ig, l+1)
-        ! mise a jour de la vitesse ascendante (l'air entraine de la couche
-        ! consideree commence avec une vitesse nulle).
-        zw2(ig, l+1) = zw2(ig, l)*(fmc(ig,l)/fmc(ig,l+1))**2 + &
-          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
-      END IF
-      IF (zw2(ig,l+1)<0.) THEN
-        zw2(ig, l+1) = 0.
-        lmaxa(ig) = l
-      ELSE
-        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
-      END IF
-      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
-        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
-        lmix(ig) = l + 1
-        wmaxa(ig) = wa_moy(ig, l+1)
-      END IF
-      ! print*,'COUCOU cas 2 LMIX=',lmix(ig),wa_moy(ig,l+1),wmaxa(ig)
-    END DO
-  END DO
-
-  ! print*,'9 OK convect8'
-  ! print*,'WA1 ',wa_moy
-
-  ! determination de l'indice du debut de la mixed layer ou w decroit
-
-  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
-  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
-  ! d'une couche est égale à la hauteur de la couche alimentante.
-  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
-  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
-
-  ! print*,'OKl439'
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        zw = max(wa_moy(ig,l), 1.E-10)
-        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) then
-        ! cette option est finalement en dur.
-        larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        ! else if (idetr.eq.1) then
-        ! larg_detr(ig,l)=larg_cons(ig,l)
-        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *wa_moy(ig,l)
-        ! endif
-      END IF
-    END DO
-  END DO
-
-  ! print*,'10 OK convect8'
-  ! print*,'WA2 ',wa_moy
-  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
-  ! compte de l'epluchage du thermique.
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
-        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
-        IF (l>lmix(ig)) THEN
-          xxx(ig, l) = (lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
-          IF (idetr==0) THEN
-            fraca(ig, l) = fraca(ig, lmix(ig))
-          ELSE IF (idetr==1) THEN
-            fraca(ig, l) = fraca(ig, lmix(ig))*xxx(ig, l)
-          ELSE IF (idetr==2) THEN
-            fraca(ig, l) = fraca(ig, lmix(ig))*(1.-(1.-xxx(ig,l))**2)
-          ELSE
-            fraca(ig, l) = fraca(ig, lmix(ig))*xxx(ig, l)**2
-          END IF
-        END IF
-        ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
-        fraca(ig, l) = max(fraca(ig,l), 0.)
-        fraca(ig, l) = min(fraca(ig,l), 0.5)
-        fracd(ig, l) = 1. - fraca(ig, l)
-        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-      ELSE
-        ! wa_moy(ig,l)=0.
-        fraca(ig, l) = 0.
-        fracc(ig, l) = 0.
-        fracd(ig, l) = 1.
-      END IF
-    END DO
-  END DO
-
-  ! print*,'11 OK convect8'
-  ! print*,'Ea3 ',wa_moy
-  ! ------------------------------------------------------------------
-  ! Calcul de fracd, wd
-  ! somme wa - wd = 0
-  ! ------------------------------------------------------------------
-
-
-  DO ig = 1, ngrid
-    fm(ig, 1) = 0.
-    fm(ig, nlay+1) = 0.
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
-    END DO
-    DO ig = 1, ngrid
-      IF (fracd(ig,l)<0.1) THEN
-        abort_message = 'fracd trop petit'
-        CALL abort_physic(modname, abort_message, 1)
-      ELSE
-        ! vitesse descendante "diagnostique"
-        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
-    END DO
-  END DO
-
-  ! print*,'12 OK convect8'
-  ! print*,'WA4 ',wa_moy
-  ! c------------------------------------------------------------------
-  ! calcul du transport vertical
-  ! ------------------------------------------------------------------
-
-  GO TO 4444
-  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
-  DO l = 2, nlay - 1
-    DO ig = 1, ngrid
-      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
-          ig,l+1)) THEN
-        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
-        ! s         ,fm(ig,l+1)*ptimestep
-        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
-        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
-        ! s         ,entr(ig,l)*ptimestep
-        ! s         ,'   M=',masse(ig,l)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
-        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
-        ! s         ,'   FM=',fm(ig,l)
-      END IF
-      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
-        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
-        ! s         ,'   M=',masse(ig,l)
-        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
-        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
-        ! print*,'zlev(ig,l+1),zlev(ig,l)'
-        ! s                ,zlev(ig,l+1),zlev(ig,l)
-        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
-        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
-      END IF
-      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
-        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
-        ! s         ,'   E=',entr(ig,l)
-      END IF
-    END DO
-  END DO
-
-4444 CONTINUE
-  ! print*,'OK 444 '
-
-  IF (w2di==1) THEN
-    fm0 = fm0 + ptimestep*(fm-fm0)/tho
-    entr0 = entr0 + ptimestep*(entr-entr0)/tho
-  ELSE
-    fm0 = fm
-    entr0 = entr
-  END IF
-
-  IF (flagdq==0) THEN
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zh, zdhadj, &
-      zha)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zo, pdoadj, &
-      zoa)
-    PRINT *, 'THERMALS OPT 1'
-  ELSE IF (flagdq==1) THEN
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
-      zdhadj, zha)
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
-      pdoadj, zoa)
-    PRINT *, 'THERMALS OPT 2'
-  ELSE
-    CALL thermcell_dq(ngrid, nlay, dqimpl, ptimestep, fm0, entr0, masse, zh, &
-      zdhadj, zha, lev_out)
-    CALL thermcell_dq(ngrid, nlay, dqimpl, ptimestep, fm0, entr0, masse, zo, &
-      pdoadj, zoa, lev_out)
-    PRINT *, 'THERMALS OPT 3', dqimpl
-  END IF
-
-  PRINT *, 'TH VENT ', dvdq
-  IF (dvdq==0) THEN
-    ! print*,'TH VENT OK ',dvdq
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
-      zua)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
-      zva)
-  ELSE IF (dvdq==1) THEN
-    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
-      zu, zv, pduadj, pdvadj, zua, zva)
-  ELSE IF (dvdq==2) THEN
-    CALL thermcell_dv2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, &
-      zmax, zu, zv, pduadj, pdvadj, zua, zva, lev_out)
-  ELSE IF (dvdq==3) THEN
-    CALL thermcell_dq(ngrid, nlay, dqimpl, ptimestep, fm0, entr0, masse, zu, &
-      pduadj, zua, lev_out)
-    CALL thermcell_dq(ngrid, nlay, dqimpl, ptimestep, fm0, entr0, masse, zv, &
-      pdvadj, zva, lev_out)
-  END IF
-
-  ! CALL writefield_phy('duadj',pduadj,klev)
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
-      zf2 = zf/(1.-zf)
-      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
-      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
-    END DO
-  END DO
-
-
-
-  ! print*,'13 OK convect8'
-  ! print*,'WA5 ',wa_moy
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      pdtadj(ig, l) = zdhadj(ig, l)*zpspsk(ig, l)
-    END DO
-  END DO
-
-
-  ! do l=1,nlay
-  ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
-  ! enddo
-  ! enddo
-
-  ! print*,'14 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calculs pour les sorties
-  ! ------------------------------------------------------------------
-
-  IF (sorties) THEN
-    DO l = 1, nlay
-      DO ig = 1, ngrid
-        zla(ig, l) = (1.-fracd(ig,l))*zmax(ig)
-        zld(ig, l) = fracd(ig, l)*zmax(ig)
-        IF (1.-fracd(ig,l)>1.E-10) zwa(ig, l) = wd(ig, l)*fracd(ig, l)/ &
-          (1.-fracd(ig,l))
-      END DO
-    END DO
-
-    DO l = 1, nlay
-      DO ig = 1, ngrid
-        detr(ig, l) = fm(ig, l) + entr(ig, l) - fm(ig, l+1)
-        IF (detr(ig,l)<0.) THEN
-          entr(ig, l) = entr(ig, l) - detr(ig, l)
-          detr(ig, l) = 0.
-          ! print*,'WARNING !!! detrainement negatif ',ig,l
-        END IF
-      END DO
-    END DO
-  END IF
-
-  ! print*,'15 OK convect8'
-
-
-  ! if(wa_moy(1,4).gt.1.e-10) stop
-
-  ! print*,'19 OK convect8'
-  RETURN
-END SUBROUTINE thermcell_2002
-
-SUBROUTINE thermcell_cld(ngrid, nlay, ptimestep, pplay, pplev, pphi, zlev, &
-    debut, pu, pv, pt, po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0, zqla, &
-    lmax, zmax_sec, wmax_sec, zw_sec, lmix_sec, ratqscth, ratqsdiff & ! s
-                                                                      ! ,pu_therm,pv_therm
-    , r_aspect, l_mix, w2di, tho)
-
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-
-  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
-
-  ! le thermique est supposé homogène et dissipé par mélange avec
-  ! son environnement. la longueur l_mix contrôle l'efficacité du
-  ! mélange
-
-  ! Le calcul du transport des différentes espèces se fait en prenant
-  ! en compte:
-  ! 1. un flux de masse montant
-  ! 2. un flux de masse descendant
-  ! 3. un entrainement
-  ! 4. un detrainement
-
-  ! =======================================================================
-
-  ! -----------------------------------------------------------------------
-  ! declarations:
-  ! -------------
-
-  include "YOMCST.h"
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-  ! arguments:
-  ! ----------
-
-  INTEGER ngrid, nlay, w2di
-  REAL tho
-  REAL ptimestep, l_mix, r_aspect
-  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
-  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
-  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
-  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
-  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
-  REAL pphi(ngrid, nlay)
-
-  INTEGER idetr
-  SAVE idetr
-  DATA idetr/3/
-  !$OMP THREADPRIVATE(idetr)
-
-  ! local:
-  ! ------
-
-  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
-  REAL zsortie1d(klon)
-  ! CR: on remplace lmax(klon,klev+1)
-  INTEGER lmax(klon), lmin(klon), lentr(klon)
-  REAL linter(klon)
-  REAL zmix(klon), fracazmix(klon)
-  REAL alpha
-  SAVE alpha
-  DATA alpha/1./
-  !$OMP THREADPRIVATE(alpha)
-
-  ! RC
-  REAL zmax(klon), zw, zz, zw2(klon, klev+1), ztva(klon, klev), zzz
-  REAL zmax_sec(klon)
-  REAL zmax_sec2(klon)
-  REAL zw_sec(klon, klev+1)
-  INTEGER lmix_sec(klon)
-  REAL w_est(klon, klev+1)
-  ! on garde le zmax du pas de temps precedent
-  ! real zmax0(klon)
-  ! save zmax0
-  ! real zmix0(klon)
-  ! save zmix0
-  REAL, SAVE, ALLOCATABLE :: zmax0(:), zmix0(:)
-  !$OMP THREADPRIVATE(zmax0, zmix0)
-
-  REAL zlev(klon, klev+1), zlay(klon, klev)
-  REAL deltaz(klon, klev)
-  REAL zh(klon, klev), zdhadj(klon, klev)
-  REAL zthl(klon, klev), zdthladj(klon, klev)
-  REAL ztv(klon, klev)
-  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
-  REAL zl(klon, klev)
-  REAL wh(klon, klev+1)
-  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
-  REAL zla(klon, klev+1)
-  REAL zwa(klon, klev+1)
-  REAL zld(klon, klev+1)
-  REAL zwd(klon, klev+1)
-  REAL zsortie(klon, klev)
-  REAL zva(klon, klev)
-  REAL zua(klon, klev)
-  REAL zoa(klon, klev)
-
-  REAL zta(klon, klev)
-  REAL zha(klon, klev)
-  REAL wa_moy(klon, klev+1)
-  REAL fraca(klon, klev+1)
-  REAL fracc(klon, klev+1)
-  REAL zf, zf2
-  REAL thetath2(klon, klev), wth2(klon, klev), wth3(klon, klev)
-  REAL q2(klon, klev)
-  REAL dtheta(klon, klev)
-  ! common/comtherm/thetath2,wth2
-
-  REAL ratqscth(klon, klev)
-  REAL sum
-  REAL sumdiff
-  REAL ratqsdiff(klon, klev)
-  REAL count_time
-  INTEGER ialt
-
-  LOGICAL sorties
-  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
-  REAL zpspsk(klon, klev)
-
-  ! real wmax(klon,klev),wmaxa(klon)
-  REAL wmax(klon), wmaxa(klon)
-  REAL wmax_sec(klon)
-  REAL wmax_sec2(klon)
-  REAL wa(klon, klev, klev+1)
-  REAL wd(klon, klev+1)
-  REAL larg_part(klon, klev, klev+1)
-  REAL fracd(klon, klev+1)
-  REAL xxx(klon, klev+1)
-  REAL larg_cons(klon, klev+1)
-  REAL larg_detr(klon, klev+1)
-  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
-  REAL massetot(klon, klev)
-  REAL detr0(klon, klev)
-  REAL alim0(klon, klev)
-  REAL pu_therm(klon, klev), pv_therm(klon, klev)
-  REAL fm(klon, klev+1), entr(klon, klev)
-  REAL fmc(klon, klev+1)
-
-  REAL zcor, zdelta, zcvm5, qlbef
-  REAL tbef(klon), qsatbef(klon)
-  REAL dqsat_dt, dt, num, denom
-  REAL reps, rlvcp, ddt0
-  REAL ztla(klon, klev), zqla(klon, klev), zqta(klon, klev)
-  ! CR niveau de condensation
-  REAL nivcon(klon)
-  REAL zcon(klon)
-  REAL zqsat(klon, klev)
-  REAL zqsatth(klon, klev)
-  PARAMETER (ddt0=.01)
-
-
-  ! CR:nouvelles variables
-  REAL f_star(klon, klev+1), entr_star(klon, klev)
-  REAL detr_star(klon, klev)
-  REAL alim_star_tot(klon), alim_star2(klon)
-  REAL entr_star_tot(klon)
-  REAL detr_star_tot(klon)
-  REAL alim_star(klon, klev)
-  REAL alim(klon, klev)
-  REAL nu(klon, klev)
-  REAL nu_e(klon, klev)
-  REAL nu_min
-  REAL nu_max
-  REAL nu_r
-  REAL f(klon)
-  ! real f(klon), f0(klon)
-  ! save f0
-  REAL, SAVE, ALLOCATABLE :: f0(:)
-  !$OMP THREADPRIVATE(f0)
-
-  REAL f_old
-  REAL zlevinter(klon)
-  LOGICAL, SAVE :: first = .TRUE.
-  !$OMP THREADPRIVATE(first)
-  ! data first /.false./
-  ! save first
-  LOGICAL nuage
-  ! save nuage
-  LOGICAL boucle
-  LOGICAL therm
-  LOGICAL debut
-  LOGICAL rale
-  INTEGER test(klon)
-  INTEGER signe_zw2
-  ! RC
-
-  CHARACTER *2 str2
-  CHARACTER *10 str10
-
-  CHARACTER (LEN=20) :: modname = 'thermcell_cld'
-  CHARACTER (LEN=80) :: abort_message
-
-  LOGICAL vtest(klon), down
-  LOGICAL zsat(klon)
-
-  EXTERNAL scopy
-
-  INTEGER ncorrec, ll
-  SAVE ncorrec
-  DATA ncorrec/0/
-  !$OMP THREADPRIVATE(ncorrec)
-
-
-
-  ! -----------------------------------------------------------------------
-  ! initialisation:
-  ! ---------------
-
-  IF (first) THEN
-    ALLOCATE (zmix0(klon))
-    ALLOCATE (zmax0(klon))
-    ALLOCATE (f0(klon))
-    first = .FALSE.
-  END IF
-
-  sorties = .FALSE.
-  ! print*,'NOUVEAU DETR PLUIE '
-  IF (ngrid/=klon) THEN
-    PRINT *
-    PRINT *, 'STOP dans convadj'
-    PRINT *, 'ngrid    =', ngrid
-    PRINT *, 'klon  =', klon
-  END IF
-
-  ! Initialisation
-  rlvcp = rlvtt/rcpd
-  reps = rd/rv
-  ! initialisations de zqsat
-  DO ll = 1, nlay
-    DO ig = 1, ngrid
-      zqsat(ig, ll) = 0.
-      zqsatth(ig, ll) = 0.
-    END DO
-  END DO
-
-  ! on met le first a true pour le premier passage de la journée
-  DO ig = 1, klon
-    test(ig) = 0
-  END DO
-  IF (debut) THEN
-    DO ig = 1, klon
-      test(ig) = 1
-      f0(ig) = 0.
-      zmax0(ig) = 0.
-    END DO
-  END IF
-  DO ig = 1, klon
-    IF ((.NOT. debut) .AND. (f0(ig)<1.E-10)) THEN
-      test(ig) = 1
-    END IF
-  END DO
-  ! do ig=1,klon
-  ! print*,'test(ig)',test(ig),zmax0(ig)
-  ! enddo
-  nuage = .FALSE.
-  ! -----------------------------------------------------------------------
-  ! AM Calcul de T,q,ql a partir de Tl et qT
-  ! ---------------------------------------------------
-
-  ! Pr Tprec=Tl calcul de qsat
-  ! Si qsat>qT T=Tl, q=qT
-  ! Sinon DDT=(-Tprec+Tl+RLVCP (qT-qsat(T')) / (1+RLVCP dqsat/dt)
-  ! On cherche DDT < DDT0
-
-  ! defaut
-  DO ll = 1, nlay
-    DO ig = 1, ngrid
-      zo(ig, ll) = po(ig, ll)
-      zl(ig, ll) = 0.
-      zh(ig, ll) = pt(ig, ll)
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zsat(ig) = .FALSE.
-  END DO
-
-
-  DO ll = 1, nlay
-    ! les points insatures sont definitifs
-    DO ig = 1, ngrid
-      tbef(ig) = pt(ig, ll)
-      zdelta = max(0., sign(1.,rtt-tbef(ig)))
-      qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, ll)
-      qsatbef(ig) = min(0.5, qsatbef(ig))
-      zcor = 1./(1.-retv*qsatbef(ig))
-      qsatbef(ig) = qsatbef(ig)*zcor
-      zsat(ig) = (max(0.,po(ig,ll)-qsatbef(ig))>1.E-10)
-    END DO
-
-    DO ig = 1, ngrid
-      IF (zsat(ig) .AND. (1==1)) THEN
-        qlbef = max(0., po(ig,ll)-qsatbef(ig))
-        ! si sature: ql est surestime, d'ou la sous-relax
-        dt = 0.5*rlvcp*qlbef
-        ! write(18,*),'DT0=',DT
-        ! on pourra enchainer 2 ou 3 calculs sans Do while
-        DO WHILE (abs(dt)>ddt0)
-          ! il faut verifier si c,a conserve quand on repasse en insature ...
-          tbef(ig) = tbef(ig) + dt
-          zdelta = max(0., sign(1.,rtt-tbef(ig)))
-          qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, ll)
-          qsatbef(ig) = min(0.5, qsatbef(ig))
-          zcor = 1./(1.-retv*qsatbef(ig))
-          qsatbef(ig) = qsatbef(ig)*zcor
-          ! on veut le signe de qlbef
-          qlbef = po(ig, ll) - qsatbef(ig)
-          zdelta = max(0., sign(1.,rtt-tbef(ig)))
-          zcvm5 = r5les*(1.-zdelta) + r5ies*zdelta
-          zcor = 1./(1.-retv*qsatbef(ig))
-          dqsat_dt = foede(tbef(ig), zdelta, zcvm5, qsatbef(ig), zcor)
-          num = -tbef(ig) + pt(ig, ll) + rlvcp*qlbef
-          denom = 1. + rlvcp*dqsat_dt
-          IF (denom<1.E-10) THEN
-            PRINT *, 'pb denom'
-          END IF
-          dt = num/denom
-        END DO
-        ! on ecrit de maniere conservative (sat ou non)
-        zl(ig, ll) = max(0., qlbef)
-        ! T = Tl +Lv/Cp ql
-        zh(ig, ll) = pt(ig, ll) + rlvcp*zl(ig, ll)
-        zo(ig, ll) = po(ig, ll) - zl(ig, ll)
-      END IF
-      ! on ecrit zqsat
-      zqsat(ig, ll) = qsatbef(ig)
-    END DO
-  END DO
-  ! AM fin
-
-  ! -----------------------------------------------------------------------
-  ! incrementation eventuelle de tendances precedentes:
-  ! ---------------------------------------------------
-
-  ! print*,'0 OK convect8'
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zpspsk(ig, l) = (pplay(ig,l)/100000.)**rkappa
-      ! zpspsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**RKAPPA
-      ! zh(ig,l)=pt(ig,l)/zpspsk(ig,l)
-      zu(ig, l) = pu(ig, l)
-      zv(ig, l) = pv(ig, l)
-      ! zo(ig,l)=po(ig,l)
-      ! ztv(ig,l)=zh(ig,l)*(1.+0.61*zo(ig,l))
-      ! AM attention zh est maintenant le profil de T et plus le profil de
-      ! theta !
-
-      ! T-> Theta
-      ztv(ig, l) = zh(ig, l)/zpspsk(ig, l)
-      ! AM Theta_v
-      ztv(ig, l) = ztv(ig, l)*(1.+retv*(zo(ig,l))-zl(ig,l))
-      ! AM Thetal
-      zthl(ig, l) = pt(ig, l)/zpspsk(ig, l)
-
-    END DO
-  END DO
-
-  ! print*,'1 OK convect8'
-  ! --------------------
-
-
-  ! + + + + + + + + + + +
-
-
-  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
-  ! wh,wt,wo ...
-
-  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
-
-
-  ! --------------------   zlev(1)
-  ! \\\\\\\\\\\\\\\\\\\\
-
-
-
-  ! -----------------------------------------------------------------------
-  ! Calcul des altitudes des couches
-  ! -----------------------------------------------------------------------
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zlev(ig, 1) = 0.
-    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
-  END DO
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zlay(ig, l) = pphi(ig, l)/rg
-    END DO
-  END DO
-  ! calcul de deltaz
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      deltaz(ig, l) = zlev(ig, l+1) - zlev(ig, l)
-    END DO
-  END DO
-
-  ! print*,'2 OK convect8'
-  ! -----------------------------------------------------------------------
-  ! Calcul des densites
-  ! -----------------------------------------------------------------------
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! rho(ig,l)=pplay(ig,l)/(zpspsk(ig,l)*RD*zh(ig,l))
-      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*ztv(ig,l))
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
-    END DO
-  END DO
-
-  DO k = 1, nlay
-    DO l = 1, nlay + 1
-      DO ig = 1, ngrid
-        wa(ig, k, l) = 0.
-      END DO
-    END DO
-  END DO
-  ! Cr:ajout:calcul de la masse
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
-    END DO
-  END DO
-  ! print*,'3 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calcul de w2, quarre de w a partir de la cape
-  ! a partir de w2, on calcule wa, vitesse de l'ascendance
-
-  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
-  ! w2 est stoke dans wa
-
-  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
-  ! independants par couches que pour calculer l'entrainement
-  ! a la base et la hauteur max de l'ascendance.
-
-  ! Indicages:
-  ! l'ascendance provenant du niveau k traverse l'interface l avec
-  ! une vitesse wa(k,l).
-
-  ! --------------------
-
-  ! + + + + + + + + + +
-
-  ! wa(k,l)   ----       --------------------    l
-  ! /\
-  ! /||\       + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||
-  ! ||        + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||__
-  ! |___      + + + + + + + + + +     k
-
-  ! --------------------
-
-
-
-  ! ------------------------------------------------------------------
-
-  ! CR: ponderation entrainement des couches instables
-  ! def des alim_star tels que alim=f*alim_star
-  DO l = 1, klev
-    DO ig = 1, ngrid
-      alim_star(ig, l) = 0.
-      alim(ig, l) = 0.
-    END DO
-  END DO
-  ! determination de la longueur de la couche d entrainement
-  DO ig = 1, ngrid
-    lentr(ig) = 1
-  END DO
-
-  ! on ne considere que les premieres couches instables
-  therm = .FALSE.
-  DO k = nlay - 2, 1, -1
-    DO ig = 1, ngrid
-      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<=ztv(ig,k+2)) THEN
-        lentr(ig) = k + 1
-        therm = .TRUE.
-      END IF
-    END DO
-  END DO
-
-  ! determination du lmin: couche d ou provient le thermique
-  DO ig = 1, ngrid
-    lmin(ig) = 1
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, 2, -1
-      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
-        lmin(ig) = l - 1
-      END IF
-    END DO
-  END DO
-
-  ! definition de l'entrainement des couches
-  DO l = 1, klev - 1
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<lentr(ig)) THEN
-        ! def possibles pour alim_star: zdthetadz, dthetadz, zdtheta
-        alim_star(ig, l) = max((ztv(ig,l)-ztv(ig,l+1)), 0.) & ! s
-                                                              ! *(zlev(ig,l+1)-zlev(ig,l))
-          *sqrt(zlev(ig,l+1))
-        ! alim_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
-        ! s                         /zlev(ig,lentr(ig)+2)))**(3./2.)
-      END IF
-    END DO
-  END DO
-
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    ! if (lmin(ig).gt.1) then
-    ! CRnouveau test
-    IF (alim_star(ig,1)<1.E-10) THEN
-      DO l = 1, klev
-        alim_star(ig, l) = 0.
-      END DO
-    END IF
-  END DO
-  ! calcul de l entrainement total
-  DO ig = 1, ngrid
-    alim_star_tot(ig) = 0.
-    entr_star_tot(ig) = 0.
-    detr_star_tot(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    DO k = 1, klev
-      alim_star_tot(ig) = alim_star_tot(ig) + alim_star(ig, k)
-    END DO
-  END DO
-
-  ! Calcul entrainement normalise
-  DO ig = 1, ngrid
-    IF (alim_star_tot(ig)>1.E-10) THEN
-      ! do l=1,lentr(ig)
-      DO l = 1, klev
-        ! def possibles pour entr_star: zdthetadz, dthetadz, zdtheta
-        alim_star(ig, l) = alim_star(ig, l)/alim_star_tot(ig)
-      END DO
-    END IF
-  END DO
-
-  ! print*,'fin calcul alim_star'
-
-  ! AM:initialisations
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      ztva(ig, k) = ztv(ig, k)
-      ztla(ig, k) = zthl(ig, k)
-      zqla(ig, k) = 0.
-      zqta(ig, k) = po(ig, k)
-      zsat(ig) = .FALSE.
-    END DO
-  END DO
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      detr_star(ig, k) = 0.
-      entr_star(ig, k) = 0.
-      detr(ig, k) = 0.
-      entr(ig, k) = 0.
-    END DO
-  END DO
-  ! print*,'7 OK convect8'
-  DO k = 1, klev + 1
-    DO ig = 1, ngrid
-      zw2(ig, k) = 0.
-      fmc(ig, k) = 0.
-      ! CR
-      f_star(ig, k) = 0.
-      ! RC
-      larg_cons(ig, k) = 0.
-      larg_detr(ig, k) = 0.
-      wa_moy(ig, k) = 0.
-    END DO
-  END DO
-
-  ! n     print*,'8 OK convect8'
-  DO ig = 1, ngrid
-    linter(ig) = 1.
-    lmaxa(ig) = 1
-    lmix(ig) = 1
-    wmaxa(ig) = 0.
-  END DO
-
-  nu_min = l_mix
-  nu_max = 1000.
-  ! do ig=1,ngrid
-  ! nu_max=wmax_sec(ig)
-  ! enddo
-  DO ig = 1, ngrid
-    DO k = 1, klev
-      nu(ig, k) = 0.
-      nu_e(ig, k) = 0.
-    END DO
-  END DO
-  ! Calcul de l'excès de température du à la diffusion turbulente
-  DO ig = 1, ngrid
-    DO l = 1, klev
-      dtheta(ig, l) = 0.
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    DO l = 1, lentr(ig) - 1
-      dtheta(ig, l) = sqrt(10.*0.4*zlev(ig,l+1)**2*1.*((ztv(ig,l+1)- &
-        ztv(ig,l))/(zlev(ig,l+1)-zlev(ig,l)))**2)
-    END DO
-  END DO
-  ! do l=1,nlay-2
-  DO l = 1, klev - 1
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. alim_star(ig,l)>1.E-10 .AND. &
-          zw2(ig,l)<1E-10) THEN
-        ! AM
-        ! test:on rajoute un excès de T dans couche alim
-        ! ztla(ig,l)=zthl(ig,l)+dtheta(ig,l)
-        ztla(ig, l) = zthl(ig, l)
-        ! test: on rajoute un excès de q dans la couche alim
-        ! zqta(ig,l)=po(ig,l)+0.001
-        zqta(ig, l) = po(ig, l)
-        zqla(ig, l) = zl(ig, l)
-        ! AM
-        f_star(ig, l+1) = alim_star(ig, l)
-        ! test:calcul de dteta
-        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
-          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
-        w_est(ig, l+1) = zw2(ig, l+1)
-        larg_detr(ig, l) = 0.
-        ! print*,'coucou boucle 1'
-      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+alim_star(ig, &
-          l))>1.E-10) THEN
-        ! print*,'coucou boucle 2'
-        ! estimation du detrainement a partir de la geometrie du pas
-        ! precedent
-        IF ((test(ig)==1) .OR. ((.NOT. debut) .AND. (f0(ig)<1.E-10))) THEN
-          detr_star(ig, l) = 0.
-          entr_star(ig, l) = 0.
-          ! print*,'coucou test(ig)',test(ig),f0(ig),zmax0(ig)
-        ELSE
-          ! print*,'coucou debut detr'
-          ! tests sur la definition du detr
-          IF (zqla(ig,l-1)>1.E-10) THEN
-            nuage = .TRUE.
-          END IF
-
-          w_est(ig, l+1) = zw2(ig, l)*((f_star(ig,l))**2)/(f_star(ig,l)+ &
-            alim_star(ig,l))**2 + 2.*rg*(ztva(ig,l-1)-ztv(ig,l))/ztv(ig, l)*( &
-            zlev(ig,l+1)-zlev(ig,l))
-          IF (w_est(ig,l+1)<0.) THEN
-            w_est(ig, l+1) = zw2(ig, l)
-          END IF
-          IF (l>2) THEN
-            IF ((w_est(ig,l+1)>w_est(ig,l)) .AND. (zlev(ig, &
-                l+1)<zmax_sec(ig)) .AND. (zqla(ig,l-1)<1.E-10)) THEN
-              detr_star(ig, l) = max(0., (rhobarz(ig, &
-                l+1)*sqrt(w_est(ig,l+1))*sqrt(nu(ig,l)* &
-                zlev(ig,l+1))-rhobarz(ig,l)*sqrt(w_est(ig,l))*sqrt(nu(ig,l)* &
-                zlev(ig,l)))/(r_aspect*zmax_sec(ig)))
-            ELSE IF ((zlev(ig,l+1)<zmax_sec(ig)) .AND. (zqla(ig, &
-                l-1)<1.E-10)) THEN
-              detr_star(ig, l) = -f0(ig)*f_star(ig, lmix(ig))/(rhobarz(ig, &
-                lmix(ig))*wmaxa(ig))*(rhobarz(ig,l+1)*sqrt(w_est(ig, &
-                l+1))*((zmax_sec(ig)-zlev(ig,l+1))/((zmax_sec(ig)-zlev(ig, &
-                lmix(ig)))))**2.-rhobarz(ig,l)*sqrt(w_est(ig, &
-                l))*((zmax_sec(ig)-zlev(ig,l))/((zmax_sec(ig)-zlev(ig,lmix(ig &
-                )))))**2.)
-            ELSE
-              detr_star(ig, l) = 0.002*f0(ig)*f_star(ig, l)* &
-                (zlev(ig,l+1)-zlev(ig,l))
-
-            END IF
-          ELSE
-            detr_star(ig, l) = 0.
-          END IF
-
-          detr_star(ig, l) = detr_star(ig, l)/f0(ig)
-          IF (nuage) THEN
-            entr_star(ig, l) = 0.4*detr_star(ig, l)
-          ELSE
-            entr_star(ig, l) = 0.4*detr_star(ig, l)
-          END IF
-
-          IF ((detr_star(ig,l))>f_star(ig,l)) THEN
-            detr_star(ig, l) = f_star(ig, l)
-            ! entr_star(ig,l)=0.
-          END IF
-
-          IF ((l<lentr(ig))) THEN
-            entr_star(ig, l) = 0.
-            ! detr_star(ig,l)=0.
-          END IF
-
-          ! print*,'ok detr_star'
-        END IF
-        ! prise en compte du detrainement dans le calcul du flux
-        f_star(ig, l+1) = f_star(ig, l) + alim_star(ig, l) + &
-          entr_star(ig, l) - detr_star(ig, l)
-        ! test
-        ! if (f_star(ig,l+1).lt.0.) then
-        ! f_star(ig,l+1)=0.
-        ! entr_star(ig,l)=0.
-        ! detr_star(ig,l)=f_star(ig,l)+alim_star(ig,l)
-        ! endif
-        ! test sur le signe de f_star
-        IF (f_star(ig,l+1)>1.E-10) THEN
-          ! then
-          ! test
-          ! if (((f_star(ig,l+1)+detr_star(ig,l)).gt.1.e-10)) then
-          ! AM on melange Tl et qt du thermique
-          ! on rajoute un excès de T dans la couche alim
-          ! if (l.lt.lentr(ig)) then
-          ! ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+
-          ! s
-          ! (alim_star(ig,l)+entr_star(ig,l))*(zthl(ig,l)+dtheta(ig,l)))
-          ! s     /(f_star(ig,l+1)+detr_star(ig,l))
-          ! else
-          ztla(ig, l) = (f_star(ig,l)*ztla(ig,l-1)+(alim_star(ig, &
-            l)+entr_star(ig,l))*zthl(ig,l))/(f_star(ig,l+1)+detr_star(ig,l))
-          ! s                    /(f_star(ig,l+1))
-          ! endif
-          ! on rajoute un excès de q dans la couche alim
-          ! if (l.lt.lentr(ig)) then
-          ! zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+
-          ! s           (alim_star(ig,l)+entr_star(ig,l))*(po(ig,l)+0.001))
-          ! s                 /(f_star(ig,l+1)+detr_star(ig,l))
-          ! else
-          zqta(ig, l) = (f_star(ig,l)*zqta(ig,l-1)+(alim_star(ig, &
-            l)+entr_star(ig,l))*po(ig,l))/(f_star(ig,l+1)+detr_star(ig,l))
-          ! s                   /(f_star(ig,l+1))
-          ! endif
-          ! AM on en deduit thetav et ql du thermique
-          ! CR test
-          ! Tbef(ig)=ztla(ig,l)*zpspsk(ig,l)
-          tbef(ig) = ztla(ig, l)*zpspsk(ig, l)
-          zdelta = max(0., sign(1.,rtt-tbef(ig)))
-          qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, l)
-          qsatbef(ig) = min(0.5, qsatbef(ig))
-          zcor = 1./(1.-retv*qsatbef(ig))
-          qsatbef(ig) = qsatbef(ig)*zcor
-          zsat(ig) = (max(0.,zqta(ig,l)-qsatbef(ig))>1.E-10)
-
-          IF (zsat(ig) .AND. (1==1)) THEN
-            qlbef = max(0., zqta(ig,l)-qsatbef(ig))
-            dt = 0.5*rlvcp*qlbef
-            ! write(17,*)'DT0=',DT
-            DO WHILE (abs(dt)>ddt0)
-              ! print*,'aie'
-              tbef(ig) = tbef(ig) + dt
-              zdelta = max(0., sign(1.,rtt-tbef(ig)))
-              qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, l)
-              qsatbef(ig) = min(0.5, qsatbef(ig))
-              zcor = 1./(1.-retv*qsatbef(ig))
-              qsatbef(ig) = qsatbef(ig)*zcor
-              qlbef = zqta(ig, l) - qsatbef(ig)
-
-              zdelta = max(0., sign(1.,rtt-tbef(ig)))
-              zcvm5 = r5les*(1.-zdelta) + r5ies*zdelta
-              zcor = 1./(1.-retv*qsatbef(ig))
-              dqsat_dt = foede(tbef(ig), zdelta, zcvm5, qsatbef(ig), zcor)
-              num = -tbef(ig) + ztla(ig, l)*zpspsk(ig, l) + rlvcp*qlbef
-              denom = 1. + rlvcp*dqsat_dt
-              IF (denom<1.E-10) THEN
-                PRINT *, 'pb denom'
-              END IF
-              dt = num/denom
-              ! write(17,*)'DT=',DT
-            END DO
-            zqla(ig, l) = max(0., zqta(ig,l)-qsatbef(ig))
-            zqla(ig, l) = max(0., qlbef)
-            ! zqla(ig,l)=0.
-          END IF
-          ! zqla(ig,l) = max(0.,zqta(ig,l)-qsatbef(ig))
-
-          ! on ecrit de maniere conservative (sat ou non)
-          ! T = Tl +Lv/Cp ql
-          ! CR rq utilisation de humidite specifique ou rapport de melange?
-          ztva(ig, l) = ztla(ig, l)*zpspsk(ig, l) + rlvcp*zqla(ig, l)
-          ztva(ig, l) = ztva(ig, l)/zpspsk(ig, l)
-          ! on rajoute le calcul de zha pour diagnostiques (temp potentielle)
-          zha(ig, l) = ztva(ig, l)
-          ! if (l.lt.lentr(ig)) then
-          ! ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)
-          ! s              -zqla(ig,l))-zqla(ig,l)) + 0.1
-          ! else
-          ztva(ig, l) = ztva(ig, l)*(1.+retv*(zqta(ig,l)-zqla(ig, &
-            l))-zqla(ig,l))
-          ! endif
-          ! ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
-          ! s                 /(1.-retv*zqla(ig,l))
-          ! ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
-          ! ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)
-          ! s                 /(1.-retv*zqta(ig,l))
-          ! s              -zqla(ig,l)/(1.-retv*zqla(ig,l)))
-          ! s              -zqla(ig,l)/(1.-retv*zqla(ig,l)))
-          ! write(13,*)zqla(ig,l),zqla(ig,l)/(1.-retv*zqla(ig,l))
-          ! on ecrit zqsat
-          zqsatth(ig, l) = qsatbef(ig)
-          ! enddo
-          ! DO ig=1,ngrid
-          ! if (zw2(ig,l).ge.1.e-10.and.
-          ! s               f_star(ig,l)+entr_star(ig,l).gt.1.e-10) then
-          ! mise a jour de la vitesse ascendante (l'air entraine de la couche
-          ! consideree commence avec une vitesse nulle).
-
-          ! if (f_star(ig,l+1).gt.1.e-10) then
-          zw2(ig, l+1) = zw2(ig, l)* & ! s
-                                       ! ((f_star(ig,l)-detr_star(ig,l))**2)
-          ! s                  /f_star(ig,l+1)**2+
-            ((f_star(ig,l))**2)/(f_star(ig,l+1)+detr_star(ig,l))**2 + & ! s
-                                                                        ! /(f_star(ig,l+1))**2+
-            2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
-          ! s                   *(f_star(ig,l)/f_star(ig,l+1))**2
-
-        END IF
-      END IF
-
-      IF (zw2(ig,l+1)<0.) THEN
-        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
-          ig,l))
-        zw2(ig, l+1) = 0.
-        ! print*,'linter=',linter(ig)
-        ! else if ((zw2(ig,l+1).lt.1.e-10).and.(zw2(ig,l+1).ge.0.)) then
-        ! linter(ig)=l+1
-        ! print*,'linter=l',zw2(ig,l),zw2(ig,l+1)
-      ELSE
-        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
-        ! wa_moy(ig,l+1)=zw2(ig,l+1)
-      END IF
-      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
-        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
-        lmix(ig) = l + 1
-        wmaxa(ig) = wa_moy(ig, l+1)
-      END IF
-    END DO
-  END DO
-  PRINT *, 'fin calcul zw2'
-
-  ! Calcul de la couche correspondant a la hauteur du thermique
-  DO ig = 1, ngrid
-    lmax(ig) = lentr(ig)
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, lentr(ig) + 1, -1
-      IF (zw2(ig,l)<=1.E-10) THEN
-        lmax(ig) = l - 1
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>1) THEN
-      lmax(ig) = 1
-      lmin(ig) = 1
-      lentr(ig) = 1
-    END IF
-  END DO
-
-  ! Determination de zw2 max
-  DO ig = 1, ngrid
-    wmax(ig) = 0.
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig)) THEN
-        IF (zw2(ig,l)<0.) THEN
-          PRINT *, 'pb2 zw2<0'
-        END IF
-        zw2(ig, l) = sqrt(zw2(ig,l))
-        wmax(ig) = max(wmax(ig), zw2(ig,l))
-      ELSE
-        zw2(ig, l) = 0.
-      END IF
-    END DO
-  END DO
-
-  ! Longueur caracteristique correspondant a la hauteur des thermiques.
-  DO ig = 1, ngrid
-    zmax(ig) = 0.
-    zlevinter(ig) = zlev(ig, 1)
-  END DO
-  DO ig = 1, ngrid
-    ! calcul de zlevinter
-    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
-      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-    ! pour le cas ou on prend tjs lmin=1
-    ! zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
-    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,1))
-    zmax0(ig) = zmax(ig)
-    WRITE (11, *) 'ig,lmax,linter', ig, lmax(ig), linter(ig)
-    WRITE (12, *) 'ig,zlevinter,zmax', ig, zmax(ig), zlevinter(ig)
-  END DO
-
-  ! Calcul de zmax_sec et wmax_sec
-  CALL fermeture_seche(ngrid, nlay, pplay, pplev, pphi, zlev, rhobarz, f0, &
-    zpspsk, alim, zh, zo, lentr, lmin, nu_min, nu_max, r_aspect, zmax_sec2, &
-    wmax_sec2)
-
-  PRINT *, 'avant fermeture'
-  ! Fermeture,determination de f
-  ! en lmax f=d-e
-  DO ig = 1, ngrid
-    ! entr_star(ig,lmax(ig))=0.
-    ! f_star(ig,lmax(ig)+1)=0.
-    ! detr_star(ig,lmax(ig))=f_star(ig,lmax(ig))+entr_star(ig,lmax(ig))
-    ! s                       +alim_star(ig,lmax(ig))
-  END DO
-
-  DO ig = 1, ngrid
-    alim_star2(ig) = 0.
-  END DO
-  ! calcul de entr_star_tot
-  DO ig = 1, ngrid
-    DO k = 1, lmix(ig)
-      entr_star_tot(ig) = entr_star_tot(ig) & ! s
-                                              ! +entr_star(ig,k)
-        +alim_star(ig, k)
-      ! s                        -detr_star(ig,k)
-      detr_star_tot(ig) = detr_star_tot(ig) & ! s
-                                              ! +alim_star(ig,k)
-        -detr_star(ig, k) + entr_star(ig, k)
-    END DO
-  END DO
-
-  DO ig = 1, ngrid
-    IF (alim_star_tot(ig)<1.E-10) THEN
-      f(ig) = 0.
-    ELSE
-      ! do k=lmin(ig),lentr(ig)
-      DO k = 1, lentr(ig)
-        alim_star2(ig) = alim_star2(ig) + alim_star(ig, k)**2/(rho(ig,k)*( &
-          zlev(ig,k+1)-zlev(ig,k)))
-      END DO
-      IF ((zmax_sec(ig)>1.E-10) .AND. (1==1)) THEN
-        f(ig) = wmax_sec(ig)/(max(500.,zmax_sec(ig))*r_aspect*alim_star2(ig))
-        f(ig) = f(ig) + (f0(ig)-f(ig))*exp((-ptimestep/zmax_sec(ig))*wmax_sec &
-          (ig))
-      ELSE
-        f(ig) = wmax(ig)/(max(500.,zmax(ig))*r_aspect*alim_star2(ig))
-        f(ig) = f(ig) + (f0(ig)-f(ig))*exp((-ptimestep/zmax(ig))*wmax(ig))
-      END IF
-    END IF
-    f0(ig) = f(ig)
-  END DO
-  PRINT *, 'apres fermeture'
-  ! Calcul de l'entrainement
-  DO ig = 1, ngrid
-    DO k = 1, klev
-      alim(ig, k) = f(ig)*alim_star(ig, k)
-    END DO
-  END DO
-  ! CR:test pour entrainer moins que la masse
-  ! do ig=1,ngrid
-  ! do l=1,lentr(ig)
-  ! if ((alim(ig,l)*ptimestep).gt.(0.9*masse(ig,l))) then
-  ! alim(ig,l+1)=alim(ig,l+1)+alim(ig,l)
-  ! s                       -0.9*masse(ig,l)/ptimestep
-  ! alim(ig,l)=0.9*masse(ig,l)/ptimestep
-  ! endif
-  ! enddo
-  ! enddo
-  ! calcul du détrainement
-  DO ig = 1, klon
-    DO k = 1, klev
-      detr(ig, k) = f(ig)*detr_star(ig, k)
-      IF (detr(ig,k)<0.) THEN
-        ! print*,'detr1<0!!!'
-      END IF
-    END DO
-    DO k = 1, klev
-      entr(ig, k) = f(ig)*entr_star(ig, k)
-      IF (entr(ig,k)<0.) THEN
-        ! print*,'entr1<0!!!'
-      END IF
-    END DO
-  END DO
-
-  ! do ig=1,ngrid
-  ! do l=1,klev
-  ! if (((detr(ig,l)+entr(ig,l)+alim(ig,l))*ptimestep).gt.
-  ! s          (masse(ig,l))) then
-  ! print*,'d2+e2+a2>m2','ig=',ig,'l=',l,'lmax(ig)=',lmax(ig),'d+e+a='
-  ! s,(detr(ig,l)+entr(ig,l)+alim(ig,l))*ptimestep,'m=',masse(ig,l)
-  ! endif
-  ! enddo
-  ! enddo
-  ! Calcul des flux
-
-  DO ig = 1, ngrid
-    DO l = 1, lmax(ig)
-      ! do l=1,klev
-      ! fmc(ig,l+1)=f(ig)*f_star(ig,l+1)
-      fmc(ig, l+1) = fmc(ig, l) + alim(ig, l) + entr(ig, l) - detr(ig, l)
-      ! print*,'??!!','ig=',ig,'l=',l,'lmax=',lmax(ig),'lmix=',lmix(ig),
-      ! s  'e=',entr(ig,l),'d=',detr(ig,l),'a=',alim(ig,l),'f=',fmc(ig,l),
-      ! s  'f+1=',fmc(ig,l+1)
-      IF (fmc(ig,l+1)<0.) THEN
-        PRINT *, 'fmc1<0', l + 1, lmax(ig), fmc(ig, l+1)
-        fmc(ig, l+1) = fmc(ig, l)
-        detr(ig, l) = alim(ig, l) + entr(ig, l)
-        ! fmc(ig,l+1)=0.
-        ! print*,'fmc1<0',l+1,lmax(ig),fmc(ig,l+1)
-      END IF
-      ! if ((fmc(ig,l+1).gt.fmc(ig,l)).and.(l.gt.lentr(ig))) then
-      ! f_old=fmc(ig,l+1)
-      ! fmc(ig,l+1)=fmc(ig,l)
-      ! detr(ig,l)=detr(ig,l)+f_old-fmc(ig,l+1)
-      ! endif
-
-      ! if ((fmc(ig,l+1).gt.fmc(ig,l)).and.(l.gt.lentr(ig))) then
-      ! f_old=fmc(ig,l+1)
-      ! fmc(ig,l+1)=fmc(ig,l)
-      ! detr(ig,l)=detr(ig,l)+f_old-fmc(ig,l)
-      ! endif
-      ! rajout du test sur alpha croissant
-      ! if test
-      ! if (1.eq.0) then
-
-      IF (l==klev) THEN
-        PRINT *, 'THERMCELL PB ig=', ig, '   l=', l
-        abort_message = 'THERMCELL PB'
-        CALL abort_physic(modname, abort_message, 1)
-      END IF
-      ! if ((zw2(ig,l+1).gt.1.e-10).and.(zw2(ig,l).gt.1.e-10).and.
-      ! s     (l.ge.lentr(ig)).and.
-      IF ((zw2(ig,l+1)>1.E-10) .AND. (zw2(ig,l)>1.E-10) .AND. (l>=lentr(ig))) &
-          THEN
-        IF (((fmc(ig,l+1)/(rhobarz(ig,l+1)*zw2(ig,l+1)))>(fmc(ig,l)/ &
-            (rhobarz(ig,l)*zw2(ig,l))))) THEN
-          f_old = fmc(ig, l+1)
-          fmc(ig, l+1) = fmc(ig, l)*rhobarz(ig, l+1)*zw2(ig, l+1)/ &
-            (rhobarz(ig,l)*zw2(ig,l))
-          detr(ig, l) = detr(ig, l) + f_old - fmc(ig, l+1)
-          ! detr(ig,l)=(fmc(ig,l+1)-fmc(ig,l))/(0.4-1.)
-          ! entr(ig,l)=0.4*detr(ig,l)
-          ! entr(ig,l)=fmc(ig,l+1)-fmc(ig,l)+detr(ig,l)
-        END IF
-      END IF
-      IF ((fmc(ig,l+1)>fmc(ig,l)) .AND. (l>lentr(ig))) THEN
-        f_old = fmc(ig, l+1)
-        fmc(ig, l+1) = fmc(ig, l)
-        detr(ig, l) = detr(ig, l) + f_old - fmc(ig, l+1)
-      END IF
-      IF (detr(ig,l)>fmc(ig,l)) THEN
-        detr(ig, l) = fmc(ig, l)
-        entr(ig, l) = fmc(ig, l+1) - alim(ig, l)
-      END IF
-      IF (fmc(ig,l+1)<0.) THEN
-        detr(ig, l) = detr(ig, l) + fmc(ig, l+1)
-        fmc(ig, l+1) = 0.
-        PRINT *, 'fmc2<0', l + 1, lmax(ig)
-      END IF
-
-      ! test pour ne pas avoir f=0 et d=e/=0
-      ! if (fmc(ig,l+1).lt.1.e-10) then
-      ! detr(ig,l+1)=0.
-      ! entr(ig,l+1)=0.
-      ! zqla(ig,l+1)=0.
-      ! zw2(ig,l+1)=0.
-      ! lmax(ig)=l+1
-      ! zmax(ig)=zlev(ig,lmax(ig))
-      ! endif
-      IF (zw2(ig,l+1)>1.E-10) THEN
-        IF ((((fmc(ig,l+1))/(rhobarz(ig,l+1)*zw2(ig,l+1)))>1.)) THEN
-          f_old = fmc(ig, l+1)
-          fmc(ig, l+1) = rhobarz(ig, l+1)*zw2(ig, l+1)
-          zw2(ig, l+1) = 0.
-          zqla(ig, l+1) = 0.
-          detr(ig, l) = detr(ig, l) + f_old - fmc(ig, l+1)
-          lmax(ig) = l + 1
-          zmax(ig) = zlev(ig, lmax(ig))
-          PRINT *, 'alpha>1', l + 1, lmax(ig)
-        END IF
-      END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
-      ! endif test
-      ! endif
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    ! if (fmc(ig,lmax(ig)+1).ne.0.) then
-    fmc(ig, lmax(ig)+1) = 0.
-    entr(ig, lmax(ig)) = 0.
-    detr(ig, lmax(ig)) = fmc(ig, lmax(ig)) + entr(ig, lmax(ig)) + &
-      alim(ig, lmax(ig))
-    ! endif
-  END DO
-  ! test sur le signe de fmc
-  DO ig = 1, ngrid
-    DO l = 1, klev + 1
-      IF (fmc(ig,l)<0.) THEN
-        PRINT *, 'fm1<0!!!', 'ig=', ig, 'l=', l, 'a=', alim(ig, l-1), 'e=', &
-          entr(ig, l-1), 'f=', fmc(ig, l-1), 'd=', detr(ig, l-1), 'f+1=', &
-          fmc(ig, l)
-      END IF
-    END DO
-  END DO
-  ! test de verification
-  DO ig = 1, ngrid
-    DO l = 1, lmax(ig)
-      IF ((abs(fmc(ig,l+1)-fmc(ig,l)-alim(ig,l)-entr(ig,l)+ &
-          detr(ig,l)))>1.E-4) THEN
-        ! print*,'pbcm!!','ig=',ig,'l=',l,'lmax=',lmax(ig),'lmix=',lmix(ig),
-        ! s  'e=',entr(ig,l),'d=',detr(ig,l),'a=',alim(ig,l),'f=',fmc(ig,l),
-        ! s  'f+1=',fmc(ig,l+1)
-      END IF
-      IF (detr(ig,l)<0.) THEN
-        PRINT *, 'detrdemi<0!!!'
-      END IF
-    END DO
-  END DO
-
-  ! RC
-  ! CR def de  zmix continu (profil parabolique des vitesses)
-  DO ig = 1, ngrid
-    IF (lmix(ig)>1.) THEN
-      ! test
-      IF (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))- &
-          (zlev(ig,lmix(ig)))))>1E-10) THEN
-
-        zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)) &
-          )**2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
-          lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
-          (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
-      ELSE
-        zmix(ig) = zlev(ig, lmix(ig))
-        PRINT *, 'pb zmix'
-      END IF
-    ELSE
-      zmix(ig) = 0.
-    END IF
-    ! test
-    IF ((zmax(ig)-zmix(ig))<=0.) THEN
-      zmix(ig) = 0.9*zmax(ig)
-      ! print*,'pb zmix>zmax'
-    END IF
-  END DO
-  DO ig = 1, klon
-    zmix0(ig) = zmix(ig)
-  END DO
-
-  ! calcul du nouveau lmix correspondant
-  DO ig = 1, ngrid
-    DO l = 1, klev
-      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
-        lmix(ig) = l
-      END IF
-    END DO
-  END DO
-
-  ! ne devrait pas arriver!!!!!
-  DO ig = 1, ngrid
-    DO l = 1, klev
-      IF (detr(ig,l)>(fmc(ig,l)+alim(ig,l))+entr(ig,l)) THEN
-        PRINT *, 'detr2>fmc2!!!', 'ig=', ig, 'l=', l, 'd=', detr(ig, l), &
-          'f=', fmc(ig, l), 'lmax=', lmax(ig)
-        ! detr(ig,l)=fmc(ig,l)+alim(ig,l)+entr(ig,l)
-        ! entr(ig,l)=0.
-        ! fmc(ig,l+1)=0.
-        ! zw2(ig,l+1)=0.
-        ! zqla(ig,l+1)=0.
-        PRINT *, 'pb!fm=0 et f_star>0', l, lmax(ig)
-        ! lmax(ig)=l
-      END IF
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    DO l = lmax(ig) + 1, klev + 1
-      ! fmc(ig,l)=0.
-      ! detr(ig,l)=0.
-      ! entr(ig,l)=0.
-      ! zw2(ig,l)=0.
-      ! zqla(ig,l)=0.
-    END DO
-  END DO
-
-  ! Calcul du detrainement lors du premier passage
-  ! print*,'9 OK convect8'
-  ! print*,'WA1 ',wa_moy
-
-  ! determination de l'indice du debut de la mixed layer ou w decroit
-
-  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
-  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
-  ! d'une couche est égale à la hauteur de la couche alimentante.
-  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
-  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig) .AND. (test(ig)==1)) THEN
-        zw = max(wa_moy(ig,l), 1.E-10)
-        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig) .AND. (test(ig)==1)) THEN
-        ! if (idetr.eq.0) then
-        ! cette option est finalement en dur.
-        IF ((l_mix*zlev(ig,l))<0.) THEN
-          PRINT *, 'pb l_mix*zlev<0'
-        END IF
-        ! CR: test: nouvelle def de lambda
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        IF (zw2(ig,l)>1.E-10) THEN
-          larg_detr(ig, l) = sqrt((l_mix/zw2(ig,l))*zlev(ig,l))
-        ELSE
-          larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        END IF
-        ! else if (idetr.eq.1) then
-        ! larg_detr(ig,l)=larg_cons(ig,l)
-        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *wa_moy(ig,l)
-        ! endif
-      END IF
-    END DO
-  END DO
-
-  ! print*,'10 OK convect8'
-  ! print*,'WA2 ',wa_moy
-  ! cal1cul de la fraction de la maille concernée par l'ascendance en tenant
-  ! compte de l'epluchage du thermique.
-
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1. .AND. (test(ig)==1)) THEN
-        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
-        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
-        ! test
-        fraca(ig, l) = max(fraca(ig,l), 0.)
-        fraca(ig, l) = min(fraca(ig,l), 0.5)
-        fracd(ig, l) = 1. - fraca(ig, l)
-        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-      ELSE
-        ! wa_moy(ig,l)=0.
-        fraca(ig, l) = 0.
-        fracc(ig, l) = 0.
-        fracd(ig, l) = 1.
-      END IF
-    END DO
-  END DO
-  ! CR: calcul de fracazmix
-  DO ig = 1, ngrid
-    IF (test(ig)==1) THEN
-      fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
-        (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
-        fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca( &
-        ig,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
-    END IF
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1. .AND. (test(ig)==1)) THEN
-        IF (l>lmix(ig)) THEN
-          ! test
-          IF (zmax(ig)-zmix(ig)<1.E-10) THEN
-            ! print*,'pb xxx'
-            xxx(ig, l) = (lmax(ig)+1.-l)/(lmax(ig)+1.-lmix(ig))
-          ELSE
-            xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
-          END IF
-          IF (idetr==0) THEN
-            fraca(ig, l) = fracazmix(ig)
-          ELSE IF (idetr==1) THEN
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
-          ELSE IF (idetr==2) THEN
-            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
-          ELSE
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
-          END IF
-          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
-          fraca(ig, l) = max(fraca(ig,l), 0.)
-          fraca(ig, l) = min(fraca(ig,l), 0.5)
-          fracd(ig, l) = 1. - fraca(ig, l)
-          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  PRINT *, 'fin calcul fraca'
-  ! print*,'11 OK convect8'
-  ! print*,'Ea3 ',wa_moy
-  ! ------------------------------------------------------------------
-  ! Calcul de fracd, wd
-  ! somme wa - wd = 0
-  ! ------------------------------------------------------------------
-
-
-  DO ig = 1, ngrid
-    fm(ig, 1) = 0.
-    fm(ig, nlay+1) = 0.
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (test(ig)==1) THEN
-        fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
-        ! CR:test
-        IF (alim(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) &
-            THEN
-          fm(ig, l) = fm(ig, l-1)
-          ! write(1,*)'ajustement fm, l',l
-        END IF
-        ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
-        ! RC
-      END IF
-    END DO
-    DO ig = 1, ngrid
-      IF (fracd(ig,l)<0.1 .AND. (test(ig)==1)) THEN
-        abort_message = 'fracd trop petit'
-        CALL abort_physic(modname, abort_message, 1)
-      ELSE
-        ! vitesse descendante "diagnostique"
-        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay + 1
-    DO ig = 1, ngrid
-      IF (test(ig)==0) THEN
-        fm(ig, l) = fmc(ig, l)
-      END IF
-    END DO
-  END DO
-
-  ! fin du first
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
-    END DO
-  END DO
-
-  ! print*,'12 OK convect8'
-  ! print*,'WA4 ',wa_moy
-  ! c------------------------------------------------------------------
-  ! calcul du transport vertical
-  ! ------------------------------------------------------------------
-
-  GO TO 4444
-  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
-  DO l = 2, nlay - 1
-    DO ig = 1, ngrid
-      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
-          ig,l+1)) THEN
-        PRINT *, 'WARN!!! FM>M ig=', ig, ' l=', l, '  FM=', &
-          fm(ig, l+1)*ptimestep, '   M=', masse(ig, l), masse(ig, l+1)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF ((alim(ig,l)+entr(ig,l))*ptimestep>masse(ig,l)) THEN
-        PRINT *, 'WARN!!! E>M ig=', ig, ' l=', l, '  E==', &
-          (entr(ig,l)+alim(ig,l))*ptimestep, '   M=', masse(ig, l)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
-        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
-        ! s         ,'   FM=',fm(ig,l)
-      END IF
-      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
-        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
-        ! s         ,'   M=',masse(ig,l)
-        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
-        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
-        ! print*,'zlev(ig,l+1),zlev(ig,l)'
-        ! s                ,zlev(ig,l+1),zlev(ig,l)
-        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
-        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
-      END IF
-      IF (.NOT. alim(ig,l)>=0. .OR. .NOT. alim(ig,l)<=10.) THEN
-        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
-        ! s         ,'   E=',entr(ig,l)
-      END IF
-    END DO
-  END DO
-
-4444 CONTINUE
-
-  ! CR:redefinition du entr
-  ! CR:test:on ne change pas la def du entr mais la def du fm
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (test(ig)==1) THEN
-        detr(ig, l) = fm(ig, l) + alim(ig, l) - fm(ig, l+1)
-        IF (detr(ig,l)<0.) THEN
-          ! entr(ig,l)=entr(ig,l)-detr(ig,l)
-          fm(ig, l+1) = fm(ig, l) + alim(ig, l)
-          detr(ig, l) = 0.
-          ! write(11,*)'l,ig,entr',l,ig,entr(ig,l)
-          ! print*,'WARNING !!! detrainement negatif ',ig,l
-        END IF
-      END IF
-    END DO
-  END DO
-  ! RC
-
-  IF (w2di==1) THEN
-    fm0 = fm0 + ptimestep*(fm-fm0)/tho
-    entr0 = entr0 + ptimestep*(alim+entr-entr0)/tho
-  ELSE
-    fm0 = fm
-    entr0 = alim + entr
-    detr0 = detr
-    alim0 = alim
-    ! zoa=zqta
-    ! entr0=alim
-  END IF
-
-  IF (1==1) THEN
-    ! call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
-    ! .    ,zh,zdhadj,zha)
-    ! call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
-    ! .    ,zo,pdoadj,zoa)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zthl, &
-      zdthladj, zta)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, po, pdoadj, &
-      zoa)
-  ELSE
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
-      zdhadj, zha)
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
-      pdoadj, zoa)
-  END IF
-
-  IF (1==0) THEN
-    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
-      zu, zv, pduadj, pdvadj, zua, zva)
-  ELSE
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
-      zua)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
-      zva)
-  END IF
-
-  ! Calcul des moments
-  ! do l=1,nlay
-  ! do ig=1,ngrid
-  ! zf=0.5*(fracc(ig,l)+fracc(ig,l+1))
-  ! zf2=zf/(1.-zf)
-  ! thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l))**2
-  ! wth2(ig,l)=zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
-  ! enddo
-  ! enddo
-
-
-
-
-
-
-  ! print*,'13 OK convect8'
-  ! print*,'WA5 ',wa_moy
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! pdtadj(ig,l)=zdhadj(ig,l)*zpspsk(ig,l)
-      pdtadj(ig, l) = zdthladj(ig, l)*zpspsk(ig, l)
-    END DO
-  END DO
-
-
-  ! do l=1,nlay
-  ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
-  ! enddo
-  ! enddo
-
-  ! print*,'14 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calculs pour les sorties
-  ! ------------------------------------------------------------------
-  ! calcul de fraca pour les sorties
-  DO l = 2, klev
-    DO ig = 1, klon
-      IF (zw2(ig,l)>1.E-10) THEN
-        fraca(ig, l) = fm(ig, l)/(rhobarz(ig,l)*zw2(ig,l))
-      ELSE
-        fraca(ig, l) = 0.
-      END IF
-    END DO
-  END DO
-  IF (sorties) THEN
-    DO l = 1, nlay
-      DO ig = 1, ngrid
-        zla(ig, l) = (1.-fracd(ig,l))*zmax(ig)
-        zld(ig, l) = fracd(ig, l)*zmax(ig)
-        IF (1.-fracd(ig,l)>1.E-10) zwa(ig, l) = wd(ig, l)*fracd(ig, l)/ &
-          (1.-fracd(ig,l))
-      END DO
-    END DO
-    ! CR calcul du niveau de condensation
-    ! initialisation
-    DO ig = 1, ngrid
-      nivcon(ig) = 0.
-      zcon(ig) = 0.
-    END DO
-    DO k = nlay, 1, -1
-      DO ig = 1, ngrid
-        IF (zqla(ig,k)>1E-10) THEN
-          nivcon(ig) = k
-          zcon(ig) = zlev(ig, k)
-        END IF
-        ! if (zcon(ig).gt.1.e-10) then
-        ! nuage=.true.
-        ! else
-        ! nuage=.false.
-        ! endif
-      END DO
-    END DO
-
-    DO l = 1, nlay
-      DO ig = 1, ngrid
-        zf = fraca(ig, l)
-        zf2 = zf/(1.-zf)
-        thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l)/zpspsk(ig,l))**2
-        wth2(ig, l) = zf2*(zw2(ig,l))**2
-        ! print*,'wth2=',wth2(ig,l)
-        wth3(ig, l) = zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l))*zw2(ig, l)* &
-          zw2(ig, l)*zw2(ig, l)
-        q2(ig, l) = zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2
-        ! test: on calcul q2/po=ratqsc
-        ! if (nuage) then
-        ratqscth(ig, l) = sqrt(q2(ig,l))/(po(ig,l)*1000.)
-        ! else
-        ! ratqscth(ig,l)=0.
-        ! endif
-      END DO
-    END DO
-    ! calcul du ratqscdiff
-    sum = 0.
-    sumdiff = 0.
-    ratqsdiff(:, :) = 0.
-    DO ig = 1, ngrid
-      DO l = 1, lentr(ig)
-        sum = sum + alim_star(ig, l)*zqta(ig, l)*1000.
-      END DO
-    END DO
-    DO ig = 1, ngrid
-      DO l = 1, lentr(ig)
-        zf = fraca(ig, l)
-        zf2 = zf/(1.-zf)
-        sumdiff = sumdiff + alim_star(ig, l)*(zqta(ig,l)*1000.-sum)**2
-        ! ratqsdiff=ratqsdiff+alim_star(ig,l)*
-        ! s          (zqta(ig,l)*1000.-po(ig,l)*1000.)**2
-      END DO
-    END DO
-    DO l = 1, klev
-      DO ig = 1, ngrid
-        ratqsdiff(ig, l) = sqrt(sumdiff)/(po(ig,l)*1000.)
-        ! write(11,*)'ratqsdiff=',ratqsdiff(ig,l)
-      END DO
-    END DO
-
-  END IF
-
-  ! print*,'19 OK convect8'
-  RETURN
-END SUBROUTINE thermcell_cld
-
-SUBROUTINE thermcell_eau(ngrid, nlay, ptimestep, pplay, pplev, pphi, pu, pv, &
-    pt, po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0 & ! s
-                                                         ! ,pu_therm,pv_therm
-    , r_aspect, l_mix, w2di, tho)
-
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-
-  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
-
-  ! le thermique est supposé homogène et dissipé par mélange avec
-  ! son environnement. la longueur l_mix contrôle l'efficacité du
-  ! mélange
-
-  ! Le calcul du transport des différentes espèces se fait en prenant
-  ! en compte:
-  ! 1. un flux de masse montant
-  ! 2. un flux de masse descendant
-  ! 3. un entrainement
-  ! 4. un detrainement
-
-  ! =======================================================================
-
-  ! -----------------------------------------------------------------------
-  ! declarations:
-  ! -------------
-
-  include "YOMCST.h"
-  include "YOETHF.h"
-  include "FCTTRE.h"
-
-  ! arguments:
-  ! ----------
-
-  INTEGER ngrid, nlay, w2di
-  REAL tho
-  REAL ptimestep, l_mix, r_aspect
-  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
-  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
-  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
-  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
-  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
-  REAL pphi(ngrid, nlay)
-
-  INTEGER idetr
-  SAVE idetr
-  DATA idetr/3/
-  !$OMP THREADPRIVATE(idetr)
-
-  ! local:
-  ! ------
-
-  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
-  REAL zsortie1d(klon)
-  ! CR: on remplace lmax(klon,klev+1)
-  INTEGER lmax(klon), lmin(klon), lentr(klon)
-  REAL linter(klon)
-  REAL zmix(klon), fracazmix(klon)
-  ! RC
-  REAL zmax(klon), zw, zz, zw2(klon, klev+1), ztva(klon, klev), zzz
-
-  REAL zlev(klon, klev+1), zlay(klon, klev)
-  REAL zh(klon, klev), zdhadj(klon, klev)
-  REAL zthl(klon, klev), zdthladj(klon, klev)
-  REAL ztv(klon, klev)
-  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
-  REAL zl(klon, klev)
-  REAL wh(klon, klev+1)
-  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
-  REAL zla(klon, klev+1)
-  REAL zwa(klon, klev+1)
-  REAL zld(klon, klev+1)
-  REAL zwd(klon, klev+1)
-  REAL zsortie(klon, klev)
-  REAL zva(klon, klev)
-  REAL zua(klon, klev)
-  REAL zoa(klon, klev)
-
-  REAL zta(klon, klev)
-  REAL zha(klon, klev)
-  REAL wa_moy(klon, klev+1)
-  REAL fraca(klon, klev+1)
-  REAL fracc(klon, klev+1)
-  REAL zf, zf2
-  REAL thetath2(klon, klev), wth2(klon, klev)
-  ! common/comtherm/thetath2,wth2
-
-  REAL count_time
-  INTEGER ialt
-
-  LOGICAL sorties
-  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
-  REAL zpspsk(klon, klev)
-
-  ! real wmax(klon,klev),wmaxa(klon)
-  REAL wmax(klon), wmaxa(klon)
-  REAL wa(klon, klev, klev+1)
-  REAL wd(klon, klev+1)
-  REAL larg_part(klon, klev, klev+1)
-  REAL fracd(klon, klev+1)
-  REAL xxx(klon, klev+1)
-  REAL larg_cons(klon, klev+1)
-  REAL larg_detr(klon, klev+1)
-  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
-  REAL pu_therm(klon, klev), pv_therm(klon, klev)
-  REAL fm(klon, klev+1), entr(klon, klev)
-  REAL fmc(klon, klev+1)
-
-  REAL zcor, zdelta, zcvm5, qlbef
-  REAL tbef(klon), qsatbef(klon)
-  REAL dqsat_dt, dt, num, denom
-  REAL reps, rlvcp, ddt0
-  REAL ztla(klon, klev), zqla(klon, klev), zqta(klon, klev)
-
-  PARAMETER (ddt0=.01)
-
-  ! CR:nouvelles variables
-  REAL f_star(klon, klev+1), entr_star(klon, klev)
-  REAL entr_star_tot(klon), entr_star2(klon)
-  REAL f(klon), f0(klon)
-  REAL zlevinter(klon)
-  LOGICAL first
-  DATA first/.FALSE./
-  SAVE first
-  !$OMP THREADPRIVATE(first)
-
-  ! RC
-
-  CHARACTER *2 str2
-  CHARACTER *10 str10
-
-  CHARACTER (LEN=20) :: modname = 'thermcell_eau'
-  CHARACTER (LEN=80) :: abort_message
-
-  LOGICAL vtest(klon), down
-  LOGICAL zsat(klon)
-
-  EXTERNAL scopy
-
-  INTEGER ncorrec, ll
-  SAVE ncorrec
-  DATA ncorrec/0/
-  !$OMP THREADPRIVATE(ncorrec)
-
-
-
-  ! -----------------------------------------------------------------------
-  ! initialisation:
-  ! ---------------
-
-  sorties = .TRUE.
-  IF (ngrid/=klon) THEN
-    PRINT *
-    PRINT *, 'STOP dans convadj'
-    PRINT *, 'ngrid    =', ngrid
-    PRINT *, 'klon  =', klon
-  END IF
-
-  ! Initialisation
-  rlvcp = rlvtt/rcpd
-  reps = rd/rv
-
-  ! -----------------------------------------------------------------------
-  ! AM Calcul de T,q,ql a partir de Tl et qT
-  ! ---------------------------------------------------
-
-  ! Pr Tprec=Tl calcul de qsat
-  ! Si qsat>qT T=Tl, q=qT
-  ! Sinon DDT=(-Tprec+Tl+RLVCP (qT-qsat(T')) / (1+RLVCP dqsat/dt)
-  ! On cherche DDT < DDT0
-
-  ! defaut
-  DO ll = 1, nlay
-    DO ig = 1, ngrid
-      zo(ig, ll) = po(ig, ll)
-      zl(ig, ll) = 0.
-      zh(ig, ll) = pt(ig, ll)
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zsat(ig) = .FALSE.
-  END DO
-
-
-  DO ll = 1, nlay
-    ! les points insatures sont definitifs
-    DO ig = 1, ngrid
-      tbef(ig) = pt(ig, ll)
-      zdelta = max(0., sign(1.,rtt-tbef(ig)))
-      qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, ll)
-      qsatbef(ig) = min(0.5, qsatbef(ig))
-      zcor = 1./(1.-retv*qsatbef(ig))
-      qsatbef(ig) = qsatbef(ig)*zcor
-      zsat(ig) = (max(0.,po(ig,ll)-qsatbef(ig))>0.00001)
-    END DO
-
-    DO ig = 1, ngrid
-      IF (zsat(ig)) THEN
-        qlbef = max(0., po(ig,ll)-qsatbef(ig))
-        ! si sature: ql est surestime, d'ou la sous-relax
-        dt = 0.5*rlvcp*qlbef
-        ! on pourra enchainer 2 ou 3 calculs sans Do while
-        DO WHILE (dt>ddt0)
-          ! il faut verifier si c,a conserve quand on repasse en insature ...
-          tbef(ig) = tbef(ig) + dt
-          zdelta = max(0., sign(1.,rtt-tbef(ig)))
-          qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, ll)
-          qsatbef(ig) = min(0.5, qsatbef(ig))
-          zcor = 1./(1.-retv*qsatbef(ig))
-          qsatbef(ig) = qsatbef(ig)*zcor
-          ! on veut le signe de qlbef
-          qlbef = po(ig, ll) - qsatbef(ig)
-          ! dqsat_dT
-          zdelta = max(0., sign(1.,rtt-tbef(ig)))
-          zcvm5 = r5les*(1.-zdelta) + r5ies*zdelta
-          zcor = 1./(1.-retv*qsatbef(ig))
-          dqsat_dt = foede(tbef(ig), zdelta, zcvm5, qsatbef(ig), zcor)
-          num = -tbef(ig) + pt(ig, ll) + rlvcp*qlbef
-          denom = 1. + rlvcp*dqsat_dt
-          dt = num/denom
-        END DO
-        ! on ecrit de maniere conservative (sat ou non)
-        zl(ig, ll) = max(0., qlbef)
-        ! T = Tl +Lv/Cp ql
-        zh(ig, ll) = pt(ig, ll) + rlvcp*zl(ig, ll)
-        zo(ig, ll) = po(ig, ll) - zl(ig, ll)
-      END IF
-    END DO
-  END DO
-  ! AM fin
-
-  ! -----------------------------------------------------------------------
-  ! incrementation eventuelle de tendances precedentes:
-  ! ---------------------------------------------------
-
-  ! print*,'0 OK convect8'
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
-      ! zh(ig,l)=pt(ig,l)/zpspsk(ig,l)
-      zu(ig, l) = pu(ig, l)
-      zv(ig, l) = pv(ig, l)
-      ! zo(ig,l)=po(ig,l)
-      ! ztv(ig,l)=zh(ig,l)*(1.+0.61*zo(ig,l))
-      ! AM attention zh est maintenant le profil de T et plus le profil de
-      ! theta !
-
-      ! T-> Theta
-      ztv(ig, l) = zh(ig, l)/zpspsk(ig, l)
-      ! AM Theta_v
-      ztv(ig, l) = ztv(ig, l)*(1.+retv*(zo(ig,l))-zl(ig,l))
-      ! AM Thetal
-      zthl(ig, l) = pt(ig, l)/zpspsk(ig, l)
-
-    END DO
-  END DO
-
-  ! print*,'1 OK convect8'
-  ! --------------------
-
-
-  ! + + + + + + + + + + +
-
-
-  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
-  ! wh,wt,wo ...
-
-  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
-
-
-  ! --------------------   zlev(1)
-  ! \\\\\\\\\\\\\\\\\\\\
-
-
-
-  ! -----------------------------------------------------------------------
-  ! Calcul des altitudes des couches
-  ! -----------------------------------------------------------------------
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zlev(ig, 1) = 0.
-    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
-  END DO
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zlay(ig, l) = pphi(ig, l)/rg
-    END DO
-  END DO
-
-  ! print*,'2 OK convect8'
-  ! -----------------------------------------------------------------------
-  ! Calcul des densites
-  ! -----------------------------------------------------------------------
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! rho(ig,l)=pplay(ig,l)/(zpspsk(ig,l)*RD*zh(ig,l))
-      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*ztv(ig,l))
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
-    END DO
-  END DO
-
-  DO k = 1, nlay
-    DO l = 1, nlay + 1
-      DO ig = 1, ngrid
-        wa(ig, k, l) = 0.
-      END DO
-    END DO
-  END DO
-
-  ! print*,'3 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calcul de w2, quarre de w a partir de la cape
-  ! a partir de w2, on calcule wa, vitesse de l'ascendance
-
-  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
-  ! w2 est stoke dans wa
-
-  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
-  ! independants par couches que pour calculer l'entrainement
-  ! a la base et la hauteur max de l'ascendance.
-
-  ! Indicages:
-  ! l'ascendance provenant du niveau k traverse l'interface l avec
-  ! une vitesse wa(k,l).
-
-  ! --------------------
-
-  ! + + + + + + + + + +
-
-  ! wa(k,l)   ----       --------------------    l
-  ! /\
-  ! /||\       + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||
-  ! ||        + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||__
-  ! |___      + + + + + + + + + +     k
-
-  ! --------------------
-
-
-
-  ! ------------------------------------------------------------------
-
-  ! CR: ponderation entrainement des couches instables
-  ! def des entr_star tels que entr=f*entr_star
-  DO l = 1, klev
-    DO ig = 1, ngrid
-      entr_star(ig, l) = 0.
-    END DO
-  END DO
-  ! determination de la longueur de la couche d entrainement
-  DO ig = 1, ngrid
-    lentr(ig) = 1
-  END DO
-
-  ! on ne considere que les premieres couches instables
-  DO k = nlay - 1, 1, -1
-    DO ig = 1, ngrid
-      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<ztv(ig,k+2)) THEN
-        lentr(ig) = k
-      END IF
-    END DO
-  END DO
-
-  ! determination du lmin: couche d ou provient le thermique
-  DO ig = 1, ngrid
-    lmin(ig) = 1
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, 2, -1
-      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
-        lmin(ig) = l - 1
-      END IF
-    END DO
-  END DO
-
-  ! definition de l'entrainement des couches
-  DO l = 1, klev - 1
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<=lentr(ig)) THEN
-        entr_star(ig, l) = (ztv(ig,l)-ztv(ig,l+1))*(zlev(ig,l+1)-zlev(ig,l))
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>1) THEN
-      DO l = 1, klev
-        entr_star(ig, l) = 0.
-      END DO
-    END IF
-  END DO
-  ! calcul de l entrainement total
-  DO ig = 1, ngrid
-    entr_star_tot(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    DO k = 1, klev
-      entr_star_tot(ig) = entr_star_tot(ig) + entr_star(ig, k)
-    END DO
-  END DO
-
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      ztva(ig, k) = ztv(ig, k)
-    END DO
-  END DO
-  ! RC
-  ! AM:initialisations
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      ztva(ig, k) = ztv(ig, k)
-      ztla(ig, k) = zthl(ig, k)
-      zqla(ig, k) = 0.
-      zqta(ig, k) = po(ig, k)
-      zsat(ig) = .FALSE.
-    END DO
-  END DO
-
-  ! print*,'7 OK convect8'
-  DO k = 1, klev + 1
-    DO ig = 1, ngrid
-      zw2(ig, k) = 0.
-      fmc(ig, k) = 0.
-      ! CR
-      f_star(ig, k) = 0.
-      ! RC
-      larg_cons(ig, k) = 0.
-      larg_detr(ig, k) = 0.
-      wa_moy(ig, k) = 0.
-    END DO
-  END DO
-
-  ! print*,'8 OK convect8'
-  DO ig = 1, ngrid
-    linter(ig) = 1.
-    lmaxa(ig) = 1
-    lmix(ig) = 1
-    wmaxa(ig) = 0.
-  END DO
-
-  ! CR:
-  DO l = 1, nlay - 2
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. entr_star(ig,l)>1.E-10 .AND. &
-          zw2(ig,l)<1E-10) THEN
-        ! AM
-        ztla(ig, l) = zthl(ig, l)
-        zqta(ig, l) = po(ig, l)
-        zqla(ig, l) = zl(ig, l)
-        ! AM
-        f_star(ig, l+1) = entr_star(ig, l)
-        ! test:calcul de dteta
-        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
-          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
-        larg_detr(ig, l) = 0.
-      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+entr_star(ig, &
-          l)>1.E-10)) THEN
-        f_star(ig, l+1) = f_star(ig, l) + entr_star(ig, l)
-
-        ! AM on melange Tl et qt du thermique
-        ztla(ig, l) = (f_star(ig,l)*ztla(ig,l-1)+entr_star(ig,l)*zthl(ig,l))/ &
-          f_star(ig, l+1)
-        zqta(ig, l) = (f_star(ig,l)*zqta(ig,l-1)+entr_star(ig,l)*po(ig,l))/ &
-          f_star(ig, l+1)
-
-        ! ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)
-        ! s                    *ztv(ig,l))/f_star(ig,l+1)
-
-        ! AM on en deduit thetav et ql du thermique
-        tbef(ig) = ztla(ig, l)*zpspsk(ig, l)
-        zdelta = max(0., sign(1.,rtt-tbef(ig)))
-        qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, l)
-        qsatbef(ig) = min(0.5, qsatbef(ig))
-        zcor = 1./(1.-retv*qsatbef(ig))
-        qsatbef(ig) = qsatbef(ig)*zcor
-        zsat(ig) = (max(0.,zqta(ig,l)-qsatbef(ig))>0.00001)
-      END IF
-    END DO
-    DO ig = 1, ngrid
-      IF (zsat(ig)) THEN
-        qlbef = max(0., zqta(ig,l)-qsatbef(ig))
-        dt = 0.5*rlvcp*qlbef
-        DO WHILE (dt>ddt0)
-          tbef(ig) = tbef(ig) + dt
-          zdelta = max(0., sign(1.,rtt-tbef(ig)))
-          qsatbef(ig) = r2es*foeew(tbef(ig), zdelta)/pplev(ig, l)
-          qsatbef(ig) = min(0.5, qsatbef(ig))
-          zcor = 1./(1.-retv*qsatbef(ig))
-          qsatbef(ig) = qsatbef(ig)*zcor
-          qlbef = zqta(ig, l) - qsatbef(ig)
-
-          zdelta = max(0., sign(1.,rtt-tbef(ig)))
-          zcvm5 = r5les*(1.-zdelta) + r5ies*zdelta
-          zcor = 1./(1.-retv*qsatbef(ig))
-          dqsat_dt = foede(tbef(ig), zdelta, zcvm5, qsatbef(ig), zcor)
-          num = -tbef(ig) + ztla(ig, l)*zpspsk(ig, l) + rlvcp*qlbef
-          denom = 1. + rlvcp*dqsat_dt
-          dt = num/denom
-        END DO
-        zqla(ig, l) = max(0., zqta(ig,l)-qsatbef(ig))
-      END IF
-      ! on ecrit de maniere conservative (sat ou non)
-      ! T = Tl +Lv/Cp ql
-      ztva(ig, l) = ztla(ig, l)*zpspsk(ig, l) + rlvcp*zqla(ig, l)
-      ztva(ig, l) = ztva(ig, l)/zpspsk(ig, l)
-      ztva(ig, l) = ztva(ig, l)*(1.+retv*(zqta(ig,l)-zqla(ig,l))-zqla(ig,l))
-
-    END DO
-    DO ig = 1, ngrid
-      IF (zw2(ig,l)>=1.E-10 .AND. f_star(ig,l)+entr_star(ig,l)>1.E-10) THEN
-        ! mise a jour de la vitesse ascendante (l'air entraine de la couche
-        ! consideree commence avec une vitesse nulle).
-
-        zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/f_star(ig,l+1))**2 + &
-          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
-      END IF
-      ! determination de zmax continu par interpolation lineaire
-      IF (zw2(ig,l+1)<0.) THEN
-        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
-          ig,l))
-        zw2(ig, l+1) = 0.
-        lmaxa(ig) = l
-      ELSE
-        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
-      END IF
-      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
-        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
-        lmix(ig) = l + 1
-        wmaxa(ig) = wa_moy(ig, l+1)
-      END IF
-    END DO
-  END DO
-
-  ! Calcul de la couche correspondant a la hauteur du thermique
-  DO ig = 1, ngrid
-    lmax(ig) = lentr(ig)
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, lentr(ig) + 1, -1
-      IF (zw2(ig,l)<=1.E-10) THEN
-        lmax(ig) = l - 1
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>1) THEN
-      lmax(ig) = 1
-      lmin(ig) = 1
-    END IF
-  END DO
-
-  ! Determination de zw2 max
-  DO ig = 1, ngrid
-    wmax(ig) = 0.
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig)) THEN
-        zw2(ig, l) = sqrt(zw2(ig,l))
-        wmax(ig) = max(wmax(ig), zw2(ig,l))
-      ELSE
-        zw2(ig, l) = 0.
-      END IF
-    END DO
-  END DO
-
-  ! Longueur caracteristique correspondant a la hauteur des thermiques.
-  DO ig = 1, ngrid
-    zmax(ig) = 500.
-    zlevinter(ig) = zlev(ig, 1)
-  END DO
-  DO ig = 1, ngrid
-    ! calcul de zlevinter
-    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
-      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,lmin(ig)))
-  END DO
-
-  ! Fermeture,determination de f
-  DO ig = 1, ngrid
-    entr_star2(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    IF (entr_star_tot(ig)<1.E-10) THEN
-      f(ig) = 0.
-    ELSE
-      DO k = lmin(ig), lentr(ig)
-        entr_star2(ig) = entr_star2(ig) + entr_star(ig, k)**2/(rho(ig,k)*( &
-          zlev(ig,k+1)-zlev(ig,k)))
-      END DO
-      ! Nouvelle fermeture
-      f(ig) = wmax(ig)/(zmax(ig)*r_aspect*entr_star2(ig))*entr_star_tot(ig)
-      ! test
-      IF (first) THEN
-        f(ig) = f(ig) + (f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)*wmax(ig))
-      END IF
-    END IF
-    f0(ig) = f(ig)
-    first = .TRUE.
-  END DO
-
-  ! Calcul de l'entrainement
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      entr(ig, k) = f(ig)*entr_star(ig, k)
-    END DO
-  END DO
-  ! Calcul des flux
-  DO ig = 1, ngrid
-    DO l = 1, lmax(ig) - 1
-      fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
-    END DO
-  END DO
-
-  ! RC
-
-
-  ! print*,'9 OK convect8'
-  ! print*,'WA1 ',wa_moy
-
-  ! determination de l'indice du debut de la mixed layer ou w decroit
-
-  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
-  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
-  ! d'une couche est égale à la hauteur de la couche alimentante.
-  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
-  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        zw = max(wa_moy(ig,l), 1.E-10)
-        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) then
-        ! cette option est finalement en dur.
-        larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        ! else if (idetr.eq.1) then
-        ! larg_detr(ig,l)=larg_cons(ig,l)
-        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *wa_moy(ig,l)
-        ! endif
-      END IF
-    END DO
-  END DO
-
-  ! print*,'10 OK convect8'
-  ! print*,'WA2 ',wa_moy
-  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
-  ! compte de l'epluchage du thermique.
-
-  ! CR def de  zmix continu (profil parabolique des vitesses)
-  DO ig = 1, ngrid
-    IF (lmix(ig)>1.) THEN
-      zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig))) &
-        **2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
-        lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
-        (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-        (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))*((zlev( &
-        ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
-    ELSE
-      zmix(ig) = 0.
-    END IF
-  END DO
-
-  ! calcul du nouveau lmix correspondant
-  DO ig = 1, ngrid
-    DO l = 1, klev
-      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
-        lmix(ig) = l
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
-        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
-        ! test
-        fraca(ig, l) = max(fraca(ig,l), 0.)
-        fraca(ig, l) = min(fraca(ig,l), 0.5)
-        fracd(ig, l) = 1. - fraca(ig, l)
-        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-      ELSE
-        ! wa_moy(ig,l)=0.
-        fraca(ig, l) = 0.
-        fracc(ig, l) = 0.
-        fracd(ig, l) = 1.
-      END IF
-    END DO
-  END DO
-  ! CR: calcul de fracazmix
-  DO ig = 1, ngrid
-    fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
-      (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
-      fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca(ig &
-      ,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        IF (l>lmix(ig)) THEN
-          xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
-          IF (idetr==0) THEN
-            fraca(ig, l) = fracazmix(ig)
-          ELSE IF (idetr==1) THEN
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
-          ELSE IF (idetr==2) THEN
-            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
-          ELSE
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
-          END IF
-          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
-          fraca(ig, l) = max(fraca(ig,l), 0.)
-          fraca(ig, l) = min(fraca(ig,l), 0.5)
-          fracd(ig, l) = 1. - fraca(ig, l)
-          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! print*,'11 OK convect8'
-  ! print*,'Ea3 ',wa_moy
-  ! ------------------------------------------------------------------
-  ! Calcul de fracd, wd
-  ! somme wa - wd = 0
-  ! ------------------------------------------------------------------
-
-
-  DO ig = 1, ngrid
-    fm(ig, 1) = 0.
-    fm(ig, nlay+1) = 0.
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
-      ! CR:test
-      IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
-        fm(ig, l) = fm(ig, l-1)
-        ! write(1,*)'ajustement fm, l',l
-      END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
-      ! RC
-    END DO
-    DO ig = 1, ngrid
-      IF (fracd(ig,l)<0.1) THEN
-        abort_message = 'fracd trop petit'
-        CALL abort_physic(modname, abort_message, 1)
-      ELSE
-        ! vitesse descendante "diagnostique"
-        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
-    END DO
-  END DO
-
-  ! print*,'12 OK convect8'
-  ! print*,'WA4 ',wa_moy
-  ! c------------------------------------------------------------------
-  ! calcul du transport vertical
-  ! ------------------------------------------------------------------
-
-  GO TO 4444
-  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
-  DO l = 2, nlay - 1
-    DO ig = 1, ngrid
-      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
-          ig,l+1)) THEN
-        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
-        ! s         ,fm(ig,l+1)*ptimestep
-        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
-        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
-        ! s         ,entr(ig,l)*ptimestep
-        ! s         ,'   M=',masse(ig,l)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
-        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
-        ! s         ,'   FM=',fm(ig,l)
-      END IF
-      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
-        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
-        ! s         ,'   M=',masse(ig,l)
-        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
-        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
-        ! print*,'zlev(ig,l+1),zlev(ig,l)'
-        ! s                ,zlev(ig,l+1),zlev(ig,l)
-        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
-        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
-      END IF
-      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
-        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
-        ! s         ,'   E=',entr(ig,l)
-      END IF
-    END DO
-  END DO
-
-4444 CONTINUE
-
-  IF (w2di==1) THEN
-    fm0 = fm0 + ptimestep*(fm-fm0)/tho
-    entr0 = entr0 + ptimestep*(entr-entr0)/tho
-  ELSE
-    fm0 = fm
-    entr0 = entr
-  END IF
-
-  IF (1==1) THEN
-    ! call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
-    ! .    ,zh,zdhadj,zha)
-    ! call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
-    ! .    ,zo,pdoadj,zoa)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zthl, &
-      zdthladj, zta)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, po, pdoadj, &
-      zoa)
-  ELSE
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
-      zdhadj, zha)
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
-      pdoadj, zoa)
-  END IF
-
-  IF (1==0) THEN
-    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
-      zu, zv, pduadj, pdvadj, zua, zva)
-  ELSE
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
-      zua)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
-      zva)
-  END IF
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
-      zf2 = zf/(1.-zf)
-      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
-      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
-    END DO
-  END DO
-
-
-
-  ! print*,'13 OK convect8'
-  ! print*,'WA5 ',wa_moy
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! pdtadj(ig,l)=zdhadj(ig,l)*zpspsk(ig,l)
-      pdtadj(ig, l) = zdthladj(ig, l)*zpspsk(ig, l)
-    END DO
-  END DO
-
-
-  ! do l=1,nlay
-  ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
-  ! enddo
-  ! enddo
-
-  ! print*,'14 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calculs pour les sorties
-  ! ------------------------------------------------------------------
-
-  RETURN
-END SUBROUTINE thermcell_eau
-
-SUBROUTINE thermcell(ngrid, nlay, ptimestep, pplay, pplev, pphi, pu, pv, pt, &
-    po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0 & ! s
-                                                     ! ,pu_therm,pv_therm
-    , r_aspect, l_mix, w2di, tho)
-
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-
-  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
-
-  ! le thermique est supposé homogène et dissipé par mélange avec
-  ! son environnement. la longueur l_mix contrôle l'efficacité du
-  ! mélange
-
-  ! Le calcul du transport des différentes espèces se fait en prenant
-  ! en compte:
-  ! 1. un flux de masse montant
-  ! 2. un flux de masse descendant
-  ! 3. un entrainement
-  ! 4. un detrainement
-
-  ! =======================================================================
-
-  ! -----------------------------------------------------------------------
-  ! declarations:
-  ! -------------
-
-  include "YOMCST.h"
-
-  ! arguments:
-  ! ----------
-
-  INTEGER ngrid, nlay, w2di
-  REAL tho
-  REAL ptimestep, l_mix, r_aspect
-  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
-  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
-  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
-  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
-  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
-  REAL pphi(ngrid, nlay)
-
-  INTEGER idetr
-  SAVE idetr
-  DATA idetr/3/
-  !$OMP THREADPRIVATE(idetr)
-
-  ! local:
-  ! ------
-
-  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
-  REAL zsortie1d(klon)
-  ! CR: on remplace lmax(klon,klev+1)
-  INTEGER lmax(klon), lmin(klon), lentr(klon)
-  REAL linter(klon)
-  REAL zmix(klon), fracazmix(klon)
-  ! RC
-  REAL zmax(klon), zw, zz, zw2(klon, klev+1), ztva(klon, klev), zzz
-
-  REAL zlev(klon, klev+1), zlay(klon, klev)
-  REAL zh(klon, klev), zdhadj(klon, klev)
-  REAL ztv(klon, klev)
-  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
-  REAL wh(klon, klev+1)
-  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
-  REAL zla(klon, klev+1)
-  REAL zwa(klon, klev+1)
-  REAL zld(klon, klev+1)
-  REAL zwd(klon, klev+1)
-  REAL zsortie(klon, klev)
-  REAL zva(klon, klev)
-  REAL zua(klon, klev)
-  REAL zoa(klon, klev)
-
-  REAL zha(klon, klev)
-  REAL wa_moy(klon, klev+1)
-  REAL fraca(klon, klev+1)
-  REAL fracc(klon, klev+1)
-  REAL zf, zf2
-  REAL thetath2(klon, klev), wth2(klon, klev)
-  ! common/comtherm/thetath2,wth2
-
-  REAL count_time
-  INTEGER ialt
-
-  LOGICAL sorties
-  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
-  REAL zpspsk(klon, klev)
-
-  ! real wmax(klon,klev),wmaxa(klon)
-  REAL wmax(klon), wmaxa(klon)
-  REAL wa(klon, klev, klev+1)
-  REAL wd(klon, klev+1)
-  REAL larg_part(klon, klev, klev+1)
-  REAL fracd(klon, klev+1)
-  REAL xxx(klon, klev+1)
-  REAL larg_cons(klon, klev+1)
-  REAL larg_detr(klon, klev+1)
-  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
-  REAL pu_therm(klon, klev), pv_therm(klon, klev)
-  REAL fm(klon, klev+1), entr(klon, klev)
-  REAL fmc(klon, klev+1)
-
-  ! CR:nouvelles variables
-  REAL f_star(klon, klev+1), entr_star(klon, klev)
-  REAL entr_star_tot(klon), entr_star2(klon)
-  REAL f(klon), f0(klon)
-  REAL zlevinter(klon)
-  LOGICAL first
-  DATA first/.FALSE./
-  SAVE first
-  !$OMP THREADPRIVATE(first)
-  ! RC
-
-  CHARACTER *2 str2
-  CHARACTER *10 str10
-
-  CHARACTER (LEN=20) :: modname = 'thermcell'
-  CHARACTER (LEN=80) :: abort_message
-
-  LOGICAL vtest(klon), down
-
-  EXTERNAL scopy
-
-  INTEGER ncorrec, ll
-  SAVE ncorrec
-  DATA ncorrec/0/
-  !$OMP THREADPRIVATE(ncorrec)
-
-
-  ! -----------------------------------------------------------------------
-  ! initialisation:
-  ! ---------------
-
-  sorties = .TRUE.
-  IF (ngrid/=klon) THEN
-    PRINT *
-    PRINT *, 'STOP dans convadj'
-    PRINT *, 'ngrid    =', ngrid
-    PRINT *, 'klon  =', klon
-  END IF
-
-  ! -----------------------------------------------------------------------
-  ! incrementation eventuelle de tendances precedentes:
-  ! ---------------------------------------------------
-
-  ! print*,'0 OK convect8'
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
-      zh(ig, l) = pt(ig, l)/zpspsk(ig, l)
-      zu(ig, l) = pu(ig, l)
-      zv(ig, l) = pv(ig, l)
-      zo(ig, l) = po(ig, l)
-      ztv(ig, l) = zh(ig, l)*(1.+0.61*zo(ig,l))
-    END DO
-  END DO
-
-  ! print*,'1 OK convect8'
-  ! --------------------
-
-
-  ! + + + + + + + + + + +
-
-
-  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
-  ! wh,wt,wo ...
-
-  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
-
-
-  ! --------------------   zlev(1)
-  ! \\\\\\\\\\\\\\\\\\\\
-
-
-
-  ! -----------------------------------------------------------------------
-  ! Calcul des altitudes des couches
-  ! -----------------------------------------------------------------------
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zlev(ig, 1) = 0.
-    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
-  END DO
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zlay(ig, l) = pphi(ig, l)/rg
-    END DO
-  END DO
-
-  ! print*,'2 OK convect8'
-  ! -----------------------------------------------------------------------
-  ! Calcul des densites
-  ! -----------------------------------------------------------------------
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*zh(ig,l))
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
-    END DO
-  END DO
-
-  DO k = 1, nlay
-    DO l = 1, nlay + 1
-      DO ig = 1, ngrid
-        wa(ig, k, l) = 0.
-      END DO
-    END DO
-  END DO
-
-  ! print*,'3 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calcul de w2, quarre de w a partir de la cape
-  ! a partir de w2, on calcule wa, vitesse de l'ascendance
-
-  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
-  ! w2 est stoke dans wa
-
-  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
-  ! independants par couches que pour calculer l'entrainement
-  ! a la base et la hauteur max de l'ascendance.
-
-  ! Indicages:
-  ! l'ascendance provenant du niveau k traverse l'interface l avec
-  ! une vitesse wa(k,l).
-
-  ! --------------------
-
-  ! + + + + + + + + + +
-
-  ! wa(k,l)   ----       --------------------    l
-  ! /\
-  ! /||\       + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||
-  ! ||        + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||__
-  ! |___      + + + + + + + + + +     k
-
-  ! --------------------
-
-
-
-  ! ------------------------------------------------------------------
-
-  ! CR: ponderation entrainement des couches instables
-  ! def des entr_star tels que entr=f*entr_star
-  DO l = 1, klev
-    DO ig = 1, ngrid
-      entr_star(ig, l) = 0.
-    END DO
-  END DO
-  ! determination de la longueur de la couche d entrainement
-  DO ig = 1, ngrid
-    lentr(ig) = 1
-  END DO
-
-  ! on ne considere que les premieres couches instables
-  DO k = nlay - 2, 1, -1
-    DO ig = 1, ngrid
-      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<=ztv(ig,k+2)) THEN
-        lentr(ig) = k
-      END IF
-    END DO
-  END DO
-
-  ! determination du lmin: couche d ou provient le thermique
-  DO ig = 1, ngrid
-    lmin(ig) = 1
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, 2, -1
-      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
-        lmin(ig) = l - 1
-      END IF
-    END DO
-  END DO
-
-  ! definition de l'entrainement des couches
-  DO l = 1, klev - 1
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<=lentr(ig)) THEN
-        entr_star(ig, l) = (ztv(ig,l)-ztv(ig,l+1))*(zlev(ig,l+1)-zlev(ig,l))
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couches 1->5 stables
-  DO ig = 1, ngrid
-    IF (lmin(ig)>5) THEN
-      DO l = 1, klev
-        entr_star(ig, l) = 0.
-      END DO
-    END IF
-  END DO
-  ! calcul de l entrainement total
-  DO ig = 1, ngrid
-    entr_star_tot(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    DO k = 1, klev
-      entr_star_tot(ig) = entr_star_tot(ig) + entr_star(ig, k)
-    END DO
-  END DO
-
-  PRINT *, 'fin calcul entr_star'
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      ztva(ig, k) = ztv(ig, k)
-    END DO
-  END DO
-  ! RC
-  ! print*,'7 OK convect8'
-  DO k = 1, klev + 1
-    DO ig = 1, ngrid
-      zw2(ig, k) = 0.
-      fmc(ig, k) = 0.
-      ! CR
-      f_star(ig, k) = 0.
-      ! RC
-      larg_cons(ig, k) = 0.
-      larg_detr(ig, k) = 0.
-      wa_moy(ig, k) = 0.
-    END DO
-  END DO
-
-  ! print*,'8 OK convect8'
-  DO ig = 1, ngrid
-    linter(ig) = 1.
-    lmaxa(ig) = 1
-    lmix(ig) = 1
-    wmaxa(ig) = 0.
-  END DO
-
-  ! CR:
-  DO l = 1, nlay - 2
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. entr_star(ig,l)>1.E-10 .AND. &
-          zw2(ig,l)<1E-10) THEN
-        f_star(ig, l+1) = entr_star(ig, l)
-        ! test:calcul de dteta
-        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
-          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
-        larg_detr(ig, l) = 0.
-      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+entr_star(ig, &
-          l)>1.E-10)) THEN
-        f_star(ig, l+1) = f_star(ig, l) + entr_star(ig, l)
-        ztva(ig, l) = (f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)*ztv(ig,l))/ &
-          f_star(ig, l+1)
-        zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/f_star(ig,l+1))**2 + &
-          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
-      END IF
-      ! determination de zmax continu par interpolation lineaire
-      IF (zw2(ig,l+1)<0.) THEN
-        ! test
-        IF (abs(zw2(ig,l+1)-zw2(ig,l))<1E-10) THEN
-          PRINT *, 'pb linter'
-        END IF
-        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
-          ig,l))
-        zw2(ig, l+1) = 0.
-        lmaxa(ig) = l
-      ELSE
-        IF (zw2(ig,l+1)<0.) THEN
-          PRINT *, 'pb1 zw2<0'
-        END IF
-        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
-      END IF
-      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
-        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
-        lmix(ig) = l + 1
-        wmaxa(ig) = wa_moy(ig, l+1)
-      END IF
-    END DO
-  END DO
-  PRINT *, 'fin calcul zw2'
-
-  ! Calcul de la couche correspondant a la hauteur du thermique
-  DO ig = 1, ngrid
-    lmax(ig) = lentr(ig)
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, lentr(ig) + 1, -1
-      IF (zw2(ig,l)<=1.E-10) THEN
-        lmax(ig) = l - 1
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couches 1->5 stables
-  DO ig = 1, ngrid
-    IF (lmin(ig)>5) THEN
-      lmax(ig) = 1
-      lmin(ig) = 1
-    END IF
-  END DO
-
-  ! Determination de zw2 max
-  DO ig = 1, ngrid
-    wmax(ig) = 0.
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig)) THEN
-        IF (zw2(ig,l)<0.) THEN
-          PRINT *, 'pb2 zw2<0'
-        END IF
-        zw2(ig, l) = sqrt(zw2(ig,l))
-        wmax(ig) = max(wmax(ig), zw2(ig,l))
-      ELSE
-        zw2(ig, l) = 0.
-      END IF
-    END DO
-  END DO
-
-  ! Longueur caracteristique correspondant a la hauteur des thermiques.
-  DO ig = 1, ngrid
-    zmax(ig) = 0.
-    zlevinter(ig) = zlev(ig, 1)
-  END DO
-  DO ig = 1, ngrid
-    ! calcul de zlevinter
-    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
-      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,lmin(ig)))
-  END DO
-
-  PRINT *, 'avant fermeture'
-  ! Fermeture,determination de f
-  DO ig = 1, ngrid
-    entr_star2(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    IF (entr_star_tot(ig)<1.E-10) THEN
-      f(ig) = 0.
-    ELSE
-      DO k = lmin(ig), lentr(ig)
-        entr_star2(ig) = entr_star2(ig) + entr_star(ig, k)**2/(rho(ig,k)*( &
-          zlev(ig,k+1)-zlev(ig,k)))
-      END DO
-      ! Nouvelle fermeture
-      f(ig) = wmax(ig)/(max(500.,zmax(ig))*r_aspect*entr_star2(ig))* &
-        entr_star_tot(ig)
-      ! test
-      ! if (first) then
-      ! f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
-      ! s             *wmax(ig))
-      ! endif
-    END IF
-    ! f0(ig)=f(ig)
-    ! first=.true.
-  END DO
-  PRINT *, 'apres fermeture'
-
-  ! Calcul de l'entrainement
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      entr(ig, k) = f(ig)*entr_star(ig, k)
-    END DO
-  END DO
-  ! Calcul des flux
-  DO ig = 1, ngrid
-    DO l = 1, lmax(ig) - 1
-      fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
-    END DO
-  END DO
-
-  ! RC
-
-
-  ! print*,'9 OK convect8'
-  ! print*,'WA1 ',wa_moy
-
-  ! determination de l'indice du debut de la mixed layer ou w decroit
-
-  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
-  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
-  ! d'une couche est égale à la hauteur de la couche alimentante.
-  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
-  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        zw = max(wa_moy(ig,l), 1.E-10)
-        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) then
-        ! cette option est finalement en dur.
-        IF ((l_mix*zlev(ig,l))<0.) THEN
-          PRINT *, 'pb l_mix*zlev<0'
-        END IF
-        larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        ! else if (idetr.eq.1) then
-        ! larg_detr(ig,l)=larg_cons(ig,l)
-        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *wa_moy(ig,l)
-        ! endif
-      END IF
-    END DO
-  END DO
-
-  ! print*,'10 OK convect8'
-  ! print*,'WA2 ',wa_moy
-  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
-  ! compte de l'epluchage du thermique.
-
-  ! CR def de  zmix continu (profil parabolique des vitesses)
-  DO ig = 1, ngrid
-    IF (lmix(ig)>1.) THEN
-      ! test
-      IF (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))- &
-          (zlev(ig,lmix(ig)))))>1E-10) THEN
-
-        zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)) &
-          )**2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
-          lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
-          (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
-      ELSE
-        zmix(ig) = zlev(ig, lmix(ig))
-        PRINT *, 'pb zmix'
-      END IF
-    ELSE
-      zmix(ig) = 0.
-    END IF
-    ! test
-    IF ((zmax(ig)-zmix(ig))<0.) THEN
-      zmix(ig) = 0.99*zmax(ig)
-      ! print*,'pb zmix>zmax'
-    END IF
-  END DO
-
-  ! calcul du nouveau lmix correspondant
-  DO ig = 1, ngrid
-    DO l = 1, klev
-      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
-        lmix(ig) = l
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
-        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
-        ! test
-        fraca(ig, l) = max(fraca(ig,l), 0.)
-        fraca(ig, l) = min(fraca(ig,l), 0.5)
-        fracd(ig, l) = 1. - fraca(ig, l)
-        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-      ELSE
-        ! wa_moy(ig,l)=0.
-        fraca(ig, l) = 0.
-        fracc(ig, l) = 0.
-        fracd(ig, l) = 1.
-      END IF
-    END DO
-  END DO
-  ! CR: calcul de fracazmix
-  DO ig = 1, ngrid
-    fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
-      (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
-      fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca(ig &
-      ,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        IF (l>lmix(ig)) THEN
-          ! test
-          IF (zmax(ig)-zmix(ig)<1.E-10) THEN
-            ! print*,'pb xxx'
-            xxx(ig, l) = (lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
-          ELSE
-            xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
-          END IF
-          IF (idetr==0) THEN
-            fraca(ig, l) = fracazmix(ig)
-          ELSE IF (idetr==1) THEN
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
-          ELSE IF (idetr==2) THEN
-            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
-          ELSE
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
-          END IF
-          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
-          fraca(ig, l) = max(fraca(ig,l), 0.)
-          fraca(ig, l) = min(fraca(ig,l), 0.5)
-          fracd(ig, l) = 1. - fraca(ig, l)
-          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  PRINT *, 'fin calcul fraca'
-  ! print*,'11 OK convect8'
-  ! print*,'Ea3 ',wa_moy
-  ! ------------------------------------------------------------------
-  ! Calcul de fracd, wd
-  ! somme wa - wd = 0
-  ! ------------------------------------------------------------------
-
-
-  DO ig = 1, ngrid
-    fm(ig, 1) = 0.
-    fm(ig, nlay+1) = 0.
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
-      ! CR:test
-      IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
-        fm(ig, l) = fm(ig, l-1)
-        ! write(1,*)'ajustement fm, l',l
-      END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
-      ! RC
-    END DO
-    DO ig = 1, ngrid
-      IF (fracd(ig,l)<0.1) THEN
-        abort_message = 'fracd trop petit'
-        CALL abort_physic(modname, abort_message, 1)
-      ELSE
-        ! vitesse descendante "diagnostique"
-        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
-    END DO
-  END DO
-
-  ! print*,'12 OK convect8'
-  ! print*,'WA4 ',wa_moy
-  ! c------------------------------------------------------------------
-  ! calcul du transport vertical
-  ! ------------------------------------------------------------------
-
-  GO TO 4444
-  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
-  DO l = 2, nlay - 1
-    DO ig = 1, ngrid
-      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
-          ig,l+1)) THEN
-        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
-        ! s         ,fm(ig,l+1)*ptimestep
-        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
-        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
-        ! s         ,entr(ig,l)*ptimestep
-        ! s         ,'   M=',masse(ig,l)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
-        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
-        ! s         ,'   FM=',fm(ig,l)
-      END IF
-      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
-        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
-        ! s         ,'   M=',masse(ig,l)
-        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
-        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
-        ! print*,'zlev(ig,l+1),zlev(ig,l)'
-        ! s                ,zlev(ig,l+1),zlev(ig,l)
-        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
-        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
-      END IF
-      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
-        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
-        ! s         ,'   E=',entr(ig,l)
-      END IF
-    END DO
-  END DO
-
-4444 CONTINUE
-
-  ! CR:redefinition du entr
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      detr(ig, l) = fm(ig, l) + entr(ig, l) - fm(ig, l+1)
-      IF (detr(ig,l)<0.) THEN
-        entr(ig, l) = entr(ig, l) - detr(ig, l)
-        detr(ig, l) = 0.
-        ! print*,'WARNING !!! detrainement negatif ',ig,l
-      END IF
-    END DO
-  END DO
-  ! RC
-  IF (w2di==1) THEN
-    fm0 = fm0 + ptimestep*(fm-fm0)/tho
-    entr0 = entr0 + ptimestep*(entr-entr0)/tho
-  ELSE
-    fm0 = fm
-    entr0 = entr
-  END IF
-
-  IF (1==1) THEN
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zh, zdhadj, &
-      zha)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zo, pdoadj, &
-      zoa)
-  ELSE
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
-      zdhadj, zha)
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
-      pdoadj, zoa)
-  END IF
-
-  IF (1==0) THEN
-    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
-      zu, zv, pduadj, pdvadj, zua, zva)
-  ELSE
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
-      zua)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
-      zva)
-  END IF
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
-      zf2 = zf/(1.-zf)
-      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
-      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
-    END DO
-  END DO
-
-
-
-  ! print*,'13 OK convect8'
-  ! print*,'WA5 ',wa_moy
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      pdtadj(ig, l) = zdhadj(ig, l)*zpspsk(ig, l)
-    END DO
-  END DO
-
-
-  ! do l=1,nlay
-  ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
-  ! enddo
-  ! enddo
-
-  ! print*,'14 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calculs pour les sorties
-  ! ------------------------------------------------------------------
-
-  IF (sorties) THEN
-    DO l = 1, nlay
-      DO ig = 1, ngrid
-        zla(ig, l) = (1.-fracd(ig,l))*zmax(ig)
-        zld(ig, l) = fracd(ig, l)*zmax(ig)
-        IF (1.-fracd(ig,l)>1.E-10) zwa(ig, l) = wd(ig, l)*fracd(ig, l)/ &
-          (1.-fracd(ig,l))
-      END DO
-    END DO
-
-    ! deja fait
-    ! do l=1,nlay
-    ! do ig=1,ngrid
-    ! detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
-    ! if (detr(ig,l).lt.0.) then
-    ! entr(ig,l)=entr(ig,l)-detr(ig,l)
-    ! detr(ig,l)=0.
-    ! print*,'WARNING !!! detrainement negatif ',ig,l
-    ! endif
-    ! enddo
-    ! enddo
-
-    ! print*,'15 OK convect8'
-
-
-    ! #define und
-    GO TO 123
-#ifdef und
-    CALL writeg1d(1, nlay, wd, 'wd      ', 'wd      ')
-    CALL writeg1d(1, nlay, zwa, 'wa      ', 'wa      ')
-    CALL writeg1d(1, nlay, fracd, 'fracd      ', 'fracd      ')
-    CALL writeg1d(1, nlay, fraca, 'fraca      ', 'fraca      ')
-    CALL writeg1d(1, nlay, wa_moy, 'wam         ', 'wam         ')
-    CALL writeg1d(1, nlay, zla, 'la      ', 'la      ')
-    CALL writeg1d(1, nlay, zld, 'ld      ', 'ld      ')
-    CALL writeg1d(1, nlay, pt, 'pt      ', 'pt      ')
-    CALL writeg1d(1, nlay, zh, 'zh      ', 'zh      ')
-    CALL writeg1d(1, nlay, zha, 'zha      ', 'zha      ')
-    CALL writeg1d(1, nlay, zu, 'zu      ', 'zu      ')
-    CALL writeg1d(1, nlay, zv, 'zv      ', 'zv      ')
-    CALL writeg1d(1, nlay, zo, 'zo      ', 'zo      ')
-    CALL writeg1d(1, nlay, wh, 'wh      ', 'wh      ')
-    CALL writeg1d(1, nlay, wu, 'wu      ', 'wu      ')
-    CALL writeg1d(1, nlay, wv, 'wv      ', 'wv      ')
-    CALL writeg1d(1, nlay, wo, 'w15uo     ', 'wXo     ')
-    CALL writeg1d(1, nlay, zdhadj, 'zdhadj      ', 'zdhadj      ')
-    CALL writeg1d(1, nlay, pduadj, 'pduadj      ', 'pduadj      ')
-    CALL writeg1d(1, nlay, pdvadj, 'pdvadj      ', 'pdvadj      ')
-    CALL writeg1d(1, nlay, pdoadj, 'pdoadj      ', 'pdoadj      ')
-    CALL writeg1d(1, nlay, entr, 'entr        ', 'entr        ')
-    CALL writeg1d(1, nlay, detr, 'detr        ', 'detr        ')
-    CALL writeg1d(1, nlay, fm, 'fm          ', 'fm          ')
-
-    CALL writeg1d(1, nlay, pdtadj, 'pdtadj    ', 'pdtadj    ')
-    CALL writeg1d(1, nlay, pplay, 'pplay     ', 'pplay     ')
-    CALL writeg1d(1, nlay, pplev, 'pplev     ', 'pplev     ')
-
-    ! recalcul des flux en diagnostique...
-    ! print*,'PAS DE TEMPS ',ptimestep
-    CALL dt2f(pplev, pplay, pt, pdtadj, wh)
-    CALL writeg1d(1, nlay, wh, 'wh2     ', 'wh2     ')
-#endif
-123 CONTINUE
-
-  END IF
-
-  ! if(wa_moy(1,4).gt.1.e-10) stop
-
-  ! print*,'19 OK convect8'
-  RETURN
-END SUBROUTINE thermcell
-
-SUBROUTINE dqthermcell(ngrid, nlay, ptimestep, fm, entr, masse, q, dq, qa)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-  ! calcul du dq/dt une fois qu'on connait les ascendances
-
-  ! =======================================================================
-
-  INTEGER ngrid, nlay
-
-  REAL ptimestep
-  REAL masse(ngrid, nlay), fm(ngrid, nlay+1)
-  REAL entr(ngrid, nlay)
-  REAL q(ngrid, nlay)
-  REAL dq(ngrid, nlay)
-
-  REAL qa(klon, klev), detr(klon, klev), wqd(klon, klev+1)
-
-  INTEGER ig, k
-
-  ! calcul du detrainement
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      detr(ig, k) = fm(ig, k) - fm(ig, k+1) + entr(ig, k)
-      ! test
-      IF (detr(ig,k)<0.) THEN
-        entr(ig, k) = entr(ig, k) - detr(ig, k)
-        detr(ig, k) = 0.
-        ! print*,'detr2<0!!!','ig=',ig,'k=',k,'f=',fm(ig,k),
-        ! s         'f+1=',fm(ig,k+1),'e=',entr(ig,k),'d=',detr(ig,k)
-      END IF
-      IF (fm(ig,k+1)<0.) THEN
-        ! print*,'fm2<0!!!'
-      END IF
-      IF (entr(ig,k)<0.) THEN
-        ! print*,'entr2<0!!!'
-      END IF
-    END DO
-  END DO
-
-  ! calcul de la valeur dans les ascendances
-  DO ig = 1, ngrid
-    qa(ig, 1) = q(ig, 1)
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      IF ((fm(ig,k+1)+detr(ig,k))*ptimestep>1.E-5*masse(ig,k)) THEN
-        qa(ig, k) = (fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))/ &
-          (fm(ig,k+1)+detr(ig,k))
-      ELSE
-        qa(ig, k) = q(ig, k)
-      END IF
-      IF (qa(ig,k)<0.) THEN
-        ! print*,'qa<0!!!'
-      END IF
-      IF (q(ig,k)<0.) THEN
-        ! print*,'q<0!!!'
-      END IF
-    END DO
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      ! wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
-      wqd(ig, k) = fm(ig, k)*q(ig, k)
-      IF (wqd(ig,k)<0.) THEN
-        ! print*,'wqd<0!!!'
-      END IF
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    wqd(ig, 1) = 0.
-    wqd(ig, nlay+1) = 0.
-  END DO
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      dq(ig, k) = (detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)-wqd(ig,k)+wqd(ig,k+ &
-        1))/masse(ig, k)
-      ! if (dq(ig,k).lt.0.) then
-      ! print*,'dq<0!!!'
-      ! endif
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE dqthermcell
-SUBROUTINE dvthermcell(ngrid, nlay, ptimestep, fm, entr, masse, fraca, larga, &
-    u, v, du, dv, ua, va)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-  ! calcul du dq/dt une fois qu'on connait les ascendances
-
-  ! =======================================================================
-
-  INTEGER ngrid, nlay
-
-  REAL ptimestep
-  REAL masse(ngrid, nlay), fm(ngrid, nlay+1)
-  REAL fraca(ngrid, nlay+1)
-  REAL larga(ngrid)
-  REAL entr(ngrid, nlay)
-  REAL u(ngrid, nlay)
-  REAL ua(ngrid, nlay)
-  REAL du(ngrid, nlay)
-  REAL v(ngrid, nlay)
-  REAL va(ngrid, nlay)
-  REAL dv(ngrid, nlay)
-
-  REAL qa(klon, klev), detr(klon, klev)
-  REAL wvd(klon, klev+1), wud(klon, klev+1)
-  REAL gamma0, gamma(klon, klev+1)
-  REAL dua, dva
-  INTEGER iter
-
-  INTEGER ig, k
-
-  ! calcul du detrainement
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      detr(ig, k) = fm(ig, k) - fm(ig, k+1) + entr(ig, k)
-    END DO
-  END DO
-
-  ! calcul de la valeur dans les ascendances
-  DO ig = 1, ngrid
-    ua(ig, 1) = u(ig, 1)
-    va(ig, 1) = v(ig, 1)
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      IF ((fm(ig,k+1)+detr(ig,k))*ptimestep>1.E-5*masse(ig,k)) THEN
-        ! On itère sur la valeur du coeff de freinage.
-        ! gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
-        gamma0 = masse(ig, k)*sqrt(0.5*(fraca(ig,k+1)+fraca(ig, &
-          k)))*0.5/larga(ig)
-        ! gamma0=0.
-        ! la première fois on multiplie le coefficient de freinage
-        ! par le module du vent dans la couche en dessous.
-        dua = ua(ig, k-1) - u(ig, k-1)
-        dva = va(ig, k-1) - v(ig, k-1)
-        DO iter = 1, 5
-          gamma(ig, k) = gamma0*sqrt(dua**2+dva**2)
-          ua(ig, k) = (fm(ig,k)*ua(ig,k-1)+(entr(ig,k)+gamma(ig, &
-            k))*u(ig,k))/(fm(ig,k+1)+detr(ig,k)+gamma(ig,k))
-          va(ig, k) = (fm(ig,k)*va(ig,k-1)+(entr(ig,k)+gamma(ig, &
-            k))*v(ig,k))/(fm(ig,k+1)+detr(ig,k)+gamma(ig,k))
-          ! print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
-          dua = ua(ig, k) - u(ig, k)
-          dva = va(ig, k) - v(ig, k)
-        END DO
-      ELSE
-        ua(ig, k) = u(ig, k)
-        va(ig, k) = v(ig, k)
-        gamma(ig, k) = 0.
-      END IF
-    END DO
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      wud(ig, k) = fm(ig, k)*u(ig, k)
-      wvd(ig, k) = fm(ig, k)*v(ig, k)
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    wud(ig, 1) = 0.
-    wud(ig, nlay+1) = 0.
-    wvd(ig, 1) = 0.
-    wvd(ig, nlay+1) = 0.
-  END DO
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      du(ig, k) = ((detr(ig,k)+gamma(ig,k))*ua(ig,k)-(entr(ig,k)+gamma(ig, &
-        k))*u(ig,k)-wud(ig,k)+wud(ig,k+1))/masse(ig, k)
-      dv(ig, k) = ((detr(ig,k)+gamma(ig,k))*va(ig,k)-(entr(ig,k)+gamma(ig, &
-        k))*v(ig,k)-wvd(ig,k)+wvd(ig,k+1))/masse(ig, k)
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE dvthermcell
-SUBROUTINE dqthermcell2(ngrid, nlay, ptimestep, fm, entr, masse, frac, q, dq, &
-    qa)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-  ! calcul du dq/dt une fois qu'on connait les ascendances
-
-  ! =======================================================================
-
-  INTEGER ngrid, nlay
-
-  REAL ptimestep
-  REAL masse(ngrid, nlay), fm(ngrid, nlay+1)
-  REAL entr(ngrid, nlay), frac(ngrid, nlay)
-  REAL q(ngrid, nlay)
-  REAL dq(ngrid, nlay)
-
-  REAL qa(klon, klev), detr(klon, klev), wqd(klon, klev+1)
-  REAL qe(klon, klev), zf, zf2
-
-  INTEGER ig, k
-
-  ! calcul du detrainement
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      detr(ig, k) = fm(ig, k) - fm(ig, k+1) + entr(ig, k)
-    END DO
-  END DO
-
-  ! calcul de la valeur dans les ascendances
-  DO ig = 1, ngrid
-    qa(ig, 1) = q(ig, 1)
-    qe(ig, 1) = q(ig, 1)
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      IF ((fm(ig,k+1)+detr(ig,k))*ptimestep>1.E-5*masse(ig,k)) THEN
-        zf = 0.5*(frac(ig,k)+frac(ig,k+1))
-        zf2 = 1./(1.-zf)
-        qa(ig, k) = (fm(ig,k)*qa(ig,k-1)+zf2*entr(ig,k)*q(ig,k))/ &
-          (fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2)
-        qe(ig, k) = (q(ig,k)-zf*qa(ig,k))*zf2
-      ELSE
-        qa(ig, k) = q(ig, k)
-        qe(ig, k) = q(ig, k)
-      END IF
-    END DO
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      ! wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
-      wqd(ig, k) = fm(ig, k)*qe(ig, k)
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    wqd(ig, 1) = 0.
-    wqd(ig, nlay+1) = 0.
-  END DO
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      dq(ig, k) = (detr(ig,k)*qa(ig,k)-entr(ig,k)*qe(ig,k)-wqd(ig,k)+wqd(ig,k &
-        +1))/masse(ig, k)
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE dqthermcell2
-SUBROUTINE dvthermcell2(ngrid, nlay, ptimestep, fm, entr, masse, fraca, &
-    larga, u, v, du, dv, ua, va)
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-  ! calcul du dq/dt une fois qu'on connait les ascendances
-
-  ! =======================================================================
-
-  INTEGER ngrid, nlay
-
-  REAL ptimestep
-  REAL masse(ngrid, nlay), fm(ngrid, nlay+1)
-  REAL fraca(ngrid, nlay+1)
-  REAL larga(ngrid)
-  REAL entr(ngrid, nlay)
-  REAL u(ngrid, nlay)
-  REAL ua(ngrid, nlay)
-  REAL du(ngrid, nlay)
-  REAL v(ngrid, nlay)
-  REAL va(ngrid, nlay)
-  REAL dv(ngrid, nlay)
-
-  REAL qa(klon, klev), detr(klon, klev), zf, zf2
-  REAL wvd(klon, klev+1), wud(klon, klev+1)
-  REAL gamma0, gamma(klon, klev+1)
-  REAL ue(klon, klev), ve(klon, klev)
-  REAL dua, dva
-  INTEGER iter
-
-  INTEGER ig, k
-
-  ! calcul du detrainement
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      detr(ig, k) = fm(ig, k) - fm(ig, k+1) + entr(ig, k)
-    END DO
-  END DO
-
-  ! calcul de la valeur dans les ascendances
-  DO ig = 1, ngrid
-    ua(ig, 1) = u(ig, 1)
-    va(ig, 1) = v(ig, 1)
-    ue(ig, 1) = u(ig, 1)
-    ve(ig, 1) = v(ig, 1)
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      IF ((fm(ig,k+1)+detr(ig,k))*ptimestep>1.E-5*masse(ig,k)) THEN
-        ! On itère sur la valeur du coeff de freinage.
-        ! gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
-        gamma0 = masse(ig, k)*sqrt(0.5*(fraca(ig,k+1)+fraca(ig, &
-          k)))*0.5/larga(ig)*1.
-        ! s         *0.5
-        ! gamma0=0.
-        zf = 0.5*(fraca(ig,k)+fraca(ig,k+1))
-        zf = 0.
-        zf2 = 1./(1.-zf)
-        ! la première fois on multiplie le coefficient de freinage
-        ! par le module du vent dans la couche en dessous.
-        dua = ua(ig, k-1) - u(ig, k-1)
-        dva = va(ig, k-1) - v(ig, k-1)
-        DO iter = 1, 5
-          ! On choisit une relaxation lineaire.
-          gamma(ig, k) = gamma0
-          ! On choisit une relaxation quadratique.
-          gamma(ig, k) = gamma0*sqrt(dua**2+dva**2)
-          ua(ig, k) = (fm(ig,k)*ua(ig,k-1)+(zf2*entr(ig,k)+gamma(ig, &
-            k))*u(ig,k))/(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2+gamma(ig,k) &
-            )
-          va(ig, k) = (fm(ig,k)*va(ig,k-1)+(zf2*entr(ig,k)+gamma(ig, &
-            k))*v(ig,k))/(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2+gamma(ig,k) &
-            )
-          ! print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
-          dua = ua(ig, k) - u(ig, k)
-          dva = va(ig, k) - v(ig, k)
-          ue(ig, k) = (u(ig,k)-zf*ua(ig,k))*zf2
-          ve(ig, k) = (v(ig,k)-zf*va(ig,k))*zf2
-        END DO
-      ELSE
-        ua(ig, k) = u(ig, k)
-        va(ig, k) = v(ig, k)
-        ue(ig, k) = u(ig, k)
-        ve(ig, k) = v(ig, k)
-        gamma(ig, k) = 0.
-      END IF
-    END DO
-  END DO
-
-  DO k = 2, nlay
-    DO ig = 1, ngrid
-      wud(ig, k) = fm(ig, k)*ue(ig, k)
-      wvd(ig, k) = fm(ig, k)*ve(ig, k)
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    wud(ig, 1) = 0.
-    wud(ig, nlay+1) = 0.
-    wvd(ig, 1) = 0.
-    wvd(ig, nlay+1) = 0.
-  END DO
-
-  DO k = 1, nlay
-    DO ig = 1, ngrid
-      du(ig, k) = ((detr(ig,k)+gamma(ig,k))*ua(ig,k)-(entr(ig,k)+gamma(ig, &
-        k))*ue(ig,k)-wud(ig,k)+wud(ig,k+1))/masse(ig, k)
-      dv(ig, k) = ((detr(ig,k)+gamma(ig,k))*va(ig,k)-(entr(ig,k)+gamma(ig, &
-        k))*ve(ig,k)-wvd(ig,k)+wvd(ig,k+1))/masse(ig, k)
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE dvthermcell2
-SUBROUTINE thermcell_sec(ngrid, nlay, ptimestep, pplay, pplev, pphi, zlev, &
-    pu, pv, pt, po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0 & ! s
-                                                                 ! ,pu_therm,pv_therm
-    , r_aspect, l_mix, w2di, tho)
-
-  USE dimphy
-  IMPLICIT NONE
-
-  ! =======================================================================
-
-  ! Calcul du transport verticale dans la couche limite en presence
-  ! de "thermiques" explicitement representes
-
-  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
-
-  ! le thermique est supposé homogène et dissipé par mélange avec
-  ! son environnement. la longueur l_mix contrôle l'efficacité du
-  ! mélange
-
-  ! Le calcul du transport des différentes espèces se fait en prenant
-  ! en compte:
-  ! 1. un flux de masse montant
-  ! 2. un flux de masse descendant
-  ! 3. un entrainement
-  ! 4. un detrainement
-
-  ! =======================================================================
-
-  ! -----------------------------------------------------------------------
-  ! declarations:
-  ! -------------
-
-  include "YOMCST.h"
-
-  ! arguments:
-  ! ----------
-
-  INTEGER ngrid, nlay, w2di
-  REAL tho
-  REAL ptimestep, l_mix, r_aspect
-  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
-  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
-  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
-  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
-  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
-  REAL pphi(ngrid, nlay)
-
-  INTEGER idetr
-  SAVE idetr
-  DATA idetr/3/
-  !$OMP THREADPRIVATE(idetr)
-
-  ! local:
-  ! ------
-
-  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
-  REAL zsortie1d(klon)
-  ! CR: on remplace lmax(klon,klev+1)
-  INTEGER lmax(klon), lmin(klon), lentr(klon)
-  REAL linter(klon)
-  REAL zmix(klon), fracazmix(klon)
-  ! RC
-  REAL zmax(klon), zw, zz, zw2(klon, klev+1), ztva(klon, klev), zzz
-
-  REAL zlev(klon, klev+1), zlay(klon, klev)
-  REAL zh(klon, klev), zdhadj(klon, klev)
-  REAL ztv(klon, klev)
-  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
-  REAL wh(klon, klev+1)
-  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
-  REAL zla(klon, klev+1)
-  REAL zwa(klon, klev+1)
-  REAL zld(klon, klev+1)
-  REAL zwd(klon, klev+1)
-  REAL zsortie(klon, klev)
-  REAL zva(klon, klev)
-  REAL zua(klon, klev)
-  REAL zoa(klon, klev)
-
-  REAL zha(klon, klev)
-  REAL wa_moy(klon, klev+1)
-  REAL fraca(klon, klev+1)
-  REAL fracc(klon, klev+1)
-  REAL zf, zf2
-  REAL thetath2(klon, klev), wth2(klon, klev)
-  ! common/comtherm/thetath2,wth2
-
-  REAL count_time
-  INTEGER ialt
-
-  LOGICAL sorties
-  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
-  REAL zpspsk(klon, klev)
-
-  ! real wmax(klon,klev),wmaxa(klon)
-  REAL wmax(klon), wmaxa(klon)
-  REAL wa(klon, klev, klev+1)
-  REAL wd(klon, klev+1)
-  REAL larg_part(klon, klev, klev+1)
-  REAL fracd(klon, klev+1)
-  REAL xxx(klon, klev+1)
-  REAL larg_cons(klon, klev+1)
-  REAL larg_detr(klon, klev+1)
-  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
-  REAL pu_therm(klon, klev), pv_therm(klon, klev)
-  REAL fm(klon, klev+1), entr(klon, klev)
-  REAL fmc(klon, klev+1)
-
-  ! CR:nouvelles variables
-  REAL f_star(klon, klev+1), entr_star(klon, klev)
-  REAL entr_star_tot(klon), entr_star2(klon)
-  REAL f(klon), f0(klon)
-  REAL zlevinter(klon)
-  LOGICAL first
-  DATA first/.FALSE./
-  SAVE first
-  !$OMP THREADPRIVATE(first)
-  ! RC
-
-  CHARACTER *2 str2
-  CHARACTER *10 str10
-
-  CHARACTER (LEN=20) :: modname = 'thermcell_sec'
-  CHARACTER (LEN=80) :: abort_message
-
-  LOGICAL vtest(klon), down
-
-  EXTERNAL scopy
-
-  INTEGER ncorrec, ll
-  SAVE ncorrec
-  DATA ncorrec/0/
-  !$OMP THREADPRIVATE(ncorrec)
-
-
-  ! -----------------------------------------------------------------------
-  ! initialisation:
-  ! ---------------
-
-  sorties = .TRUE.
-  IF (ngrid/=klon) THEN
-    PRINT *
-    PRINT *, 'STOP dans convadj'
-    PRINT *, 'ngrid    =', ngrid
-    PRINT *, 'klon  =', klon
-  END IF
-
-  ! -----------------------------------------------------------------------
-  ! incrementation eventuelle de tendances precedentes:
-  ! ---------------------------------------------------
-
-  ! print*,'0 OK convect8'
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
-      zh(ig, l) = pt(ig, l)/zpspsk(ig, l)
-      zu(ig, l) = pu(ig, l)
-      zv(ig, l) = pv(ig, l)
-      zo(ig, l) = po(ig, l)
-      ztv(ig, l) = zh(ig, l)*(1.+0.61*zo(ig,l))
-    END DO
-  END DO
-
-  ! print*,'1 OK convect8'
-  ! --------------------
-
-
-  ! + + + + + + + + + + +
-
-
-  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
-  ! wh,wt,wo ...
-
-  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
-
-
-  ! --------------------   zlev(1)
-  ! \\\\\\\\\\\\\\\\\\\\
-
-
-
-  ! -----------------------------------------------------------------------
-  ! Calcul des altitudes des couches
-  ! -----------------------------------------------------------------------
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
-    END DO
-  END DO
-  DO ig = 1, ngrid
-    zlev(ig, 1) = 0.
-    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
-  END DO
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zlay(ig, l) = pphi(ig, l)/rg
-    END DO
-  END DO
-
-  ! print*,'2 OK convect8'
-  ! -----------------------------------------------------------------------
-  ! Calcul des densites
-  ! -----------------------------------------------------------------------
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*zh(ig,l))
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
-    END DO
-  END DO
-
-  DO k = 1, nlay
-    DO l = 1, nlay + 1
-      DO ig = 1, ngrid
-        wa(ig, k, l) = 0.
-      END DO
-    END DO
-  END DO
-
-  ! print*,'3 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calcul de w2, quarre de w a partir de la cape
-  ! a partir de w2, on calcule wa, vitesse de l'ascendance
-
-  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
-  ! w2 est stoke dans wa
-
-  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
-  ! independants par couches que pour calculer l'entrainement
-  ! a la base et la hauteur max de l'ascendance.
-
-  ! Indicages:
-  ! l'ascendance provenant du niveau k traverse l'interface l avec
-  ! une vitesse wa(k,l).
-
-  ! --------------------
-
-  ! + + + + + + + + + +
-
-  ! wa(k,l)   ----       --------------------    l
-  ! /\
-  ! /||\       + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||
-  ! ||        + + + + + + + + + +
-  ! ||
-  ! ||        --------------------
-  ! ||__
-  ! |___      + + + + + + + + + +     k
-
-  ! --------------------
-
-
-
-  ! ------------------------------------------------------------------
-
-  ! CR: ponderation entrainement des couches instables
-  ! def des entr_star tels que entr=f*entr_star
-  DO l = 1, klev
-    DO ig = 1, ngrid
-      entr_star(ig, l) = 0.
-    END DO
-  END DO
-  ! determination de la longueur de la couche d entrainement
-  DO ig = 1, ngrid
-    lentr(ig) = 1
-  END DO
-
-  ! on ne considere que les premieres couches instables
-  DO k = nlay - 2, 1, -1
-    DO ig = 1, ngrid
-      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<=ztv(ig,k+2)) THEN
-        lentr(ig) = k
-      END IF
-    END DO
-  END DO
-
-  ! determination du lmin: couche d ou provient le thermique
-  DO ig = 1, ngrid
-    lmin(ig) = 1
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, 2, -1
-      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
-        lmin(ig) = l - 1
-      END IF
-    END DO
-  END DO
-
-  ! definition de l'entrainement des couches
-  DO l = 1, klev - 1
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<=lentr(ig)) THEN
-        entr_star(ig, l) = (ztv(ig,l)-ztv(ig,l+1))** & ! s
-                                                       ! (zlev(ig,l+1)-zlev(ig,l))
-          sqrt(zlev(ig,l+1))
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>1) THEN
-      DO l = 1, klev
-        entr_star(ig, l) = 0.
-      END DO
-    END IF
-  END DO
-  ! calcul de l entrainement total
-  DO ig = 1, ngrid
-    entr_star_tot(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    DO k = 1, klev
-      entr_star_tot(ig) = entr_star_tot(ig) + entr_star(ig, k)
-    END DO
-  END DO
-
-  ! print*,'fin calcul entr_star'
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      ztva(ig, k) = ztv(ig, k)
-    END DO
-  END DO
-  ! RC
-  ! print*,'7 OK convect8'
-  DO k = 1, klev + 1
-    DO ig = 1, ngrid
-      zw2(ig, k) = 0.
-      fmc(ig, k) = 0.
-      ! CR
-      f_star(ig, k) = 0.
-      ! RC
-      larg_cons(ig, k) = 0.
-      larg_detr(ig, k) = 0.
-      wa_moy(ig, k) = 0.
-    END DO
-  END DO
-
-  ! print*,'8 OK convect8'
-  DO ig = 1, ngrid
-    linter(ig) = 1.
-    lmaxa(ig) = 1
-    lmix(ig) = 1
-    wmaxa(ig) = 0.
-  END DO
-
-  ! CR:
-  DO l = 1, nlay - 2
-    DO ig = 1, ngrid
-      IF (ztv(ig,l)>ztv(ig,l+1) .AND. entr_star(ig,l)>1.E-10 .AND. &
-          zw2(ig,l)<1E-10) THEN
-        f_star(ig, l+1) = entr_star(ig, l)
-        ! test:calcul de dteta
-        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
-          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
-        larg_detr(ig, l) = 0.
-      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+entr_star(ig, &
-          l)>1.E-10)) THEN
-        f_star(ig, l+1) = f_star(ig, l) + entr_star(ig, l)
-        ztva(ig, l) = (f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)*ztv(ig,l))/ &
-          f_star(ig, l+1)
-        zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/f_star(ig,l+1))**2 + &
-          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
-      END IF
-      ! determination de zmax continu par interpolation lineaire
-      IF (zw2(ig,l+1)<0.) THEN
-        ! test
-        IF (abs(zw2(ig,l+1)-zw2(ig,l))<1E-10) THEN
-          ! print*,'pb linter'
-        END IF
-        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
-          ig,l))
-        zw2(ig, l+1) = 0.
-        lmaxa(ig) = l
-      ELSE
-        IF (zw2(ig,l+1)<0.) THEN
-          ! print*,'pb1 zw2<0'
-        END IF
-        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
-      END IF
-      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
-        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
-        lmix(ig) = l + 1
-        wmaxa(ig) = wa_moy(ig, l+1)
-      END IF
-    END DO
-  END DO
-  ! print*,'fin calcul zw2'
-
-  ! Calcul de la couche correspondant a la hauteur du thermique
-  DO ig = 1, ngrid
-    lmax(ig) = lentr(ig)
-  END DO
-  DO ig = 1, ngrid
-    DO l = nlay, lentr(ig) + 1, -1
-      IF (zw2(ig,l)<=1.E-10) THEN
-        lmax(ig) = l - 1
-      END IF
-    END DO
-  END DO
-  ! pas de thermique si couche 1 stable
-  DO ig = 1, ngrid
-    IF (lmin(ig)>1) THEN
-      lmax(ig) = 1
-      lmin(ig) = 1
-    END IF
-  END DO
-
-  ! Determination de zw2 max
-  DO ig = 1, ngrid
-    wmax(ig) = 0.
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmax(ig)) THEN
-        IF (zw2(ig,l)<0.) THEN
-          ! print*,'pb2 zw2<0'
-        END IF
-        zw2(ig, l) = sqrt(zw2(ig,l))
-        wmax(ig) = max(wmax(ig), zw2(ig,l))
-      ELSE
-        zw2(ig, l) = 0.
-      END IF
-    END DO
-  END DO
-
-  ! Longueur caracteristique correspondant a la hauteur des thermiques.
-  DO ig = 1, ngrid
-    zmax(ig) = 0.
-    zlevinter(ig) = zlev(ig, 1)
-  END DO
-  DO ig = 1, ngrid
-    ! calcul de zlevinter
-    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
-      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
-    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,lmin(ig)))
-  END DO
-
-  ! print*,'avant fermeture'
-  ! Fermeture,determination de f
-  DO ig = 1, ngrid
-    entr_star2(ig) = 0.
-  END DO
-  DO ig = 1, ngrid
-    IF (entr_star_tot(ig)<1.E-10) THEN
-      f(ig) = 0.
-    ELSE
-      DO k = lmin(ig), lentr(ig)
-        entr_star2(ig) = entr_star2(ig) + entr_star(ig, k)**2/(rho(ig,k)*( &
-          zlev(ig,k+1)-zlev(ig,k)))
-      END DO
-      ! Nouvelle fermeture
-      f(ig) = wmax(ig)/(max(500.,zmax(ig))*r_aspect*entr_star2(ig))* &
-        entr_star_tot(ig)
-      ! test
-      ! if (first) then
-      ! f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
-      ! s             *wmax(ig))
-      ! endif
-    END IF
-    ! f0(ig)=f(ig)
-    ! first=.true.
-  END DO
-  ! print*,'apres fermeture'
-
-  ! Calcul de l'entrainement
-  DO k = 1, klev
-    DO ig = 1, ngrid
-      entr(ig, k) = f(ig)*entr_star(ig, k)
-    END DO
-  END DO
-  ! CR:test pour entrainer moins que la masse
-  DO ig = 1, ngrid
-    DO l = 1, lentr(ig)
-      IF ((entr(ig,l)*ptimestep)>(0.9*masse(ig,l))) THEN
-        entr(ig, l+1) = entr(ig, l+1) + entr(ig, l) - &
-          0.9*masse(ig, l)/ptimestep
-        entr(ig, l) = 0.9*masse(ig, l)/ptimestep
-      END IF
-    END DO
-  END DO
-  ! CR: fin test
-  ! Calcul des flux
-  DO ig = 1, ngrid
-    DO l = 1, lmax(ig) - 1
-      fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
-    END DO
-  END DO
-
-  ! RC
-
-
-  ! print*,'9 OK convect8'
-  ! print*,'WA1 ',wa_moy
-
-  ! determination de l'indice du debut de la mixed layer ou w decroit
-
-  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
-  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
-  ! d'une couche est égale à la hauteur de la couche alimentante.
-  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
-  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        zw = max(wa_moy(ig,l), 1.E-10)
-        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (l<=lmaxa(ig)) THEN
-        ! if (idetr.eq.0) then
-        ! cette option est finalement en dur.
-        IF ((l_mix*zlev(ig,l))<0.) THEN
-          ! print*,'pb l_mix*zlev<0'
-        END IF
-        ! CR: test: nouvelle def de lambda
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        IF (zw2(ig,l)>1.E-10) THEN
-          larg_detr(ig, l) = sqrt((l_mix/zw2(ig,l))*zlev(ig,l))
-        ELSE
-          larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
-        END IF
-        ! RC
-        ! else if (idetr.eq.1) then
-        ! larg_detr(ig,l)=larg_cons(ig,l)
-        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
-        ! else if (idetr.eq.2) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *sqrt(wa_moy(ig,l))
-        ! else if (idetr.eq.4) then
-        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
-        ! s            *wa_moy(ig,l)
-        ! endif
-      END IF
-    END DO
-  END DO
-
-  ! print*,'10 OK convect8'
-  ! print*,'WA2 ',wa_moy
-  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
-  ! compte de l'epluchage du thermique.
-
-  ! CR def de  zmix continu (profil parabolique des vitesses)
-  DO ig = 1, ngrid
-    IF (lmix(ig)>1.) THEN
-      ! test
-      IF (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))- &
-          (zlev(ig,lmix(ig)))))>1E-10) THEN
-
-        zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)) &
-          )**2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
-          lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
-          (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
-          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
-          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
-      ELSE
-        zmix(ig) = zlev(ig, lmix(ig))
-        ! print*,'pb zmix'
-      END IF
-    ELSE
-      zmix(ig) = 0.
-    END IF
-    ! test
-    IF ((zmax(ig)-zmix(ig))<0.) THEN
-      zmix(ig) = 0.99*zmax(ig)
-      ! print*,'pb zmix>zmax'
-    END IF
-  END DO
-
-  ! calcul du nouveau lmix correspondant
-  DO ig = 1, ngrid
-    DO l = 1, klev
-      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
-        lmix(ig) = l
-      END IF
-    END DO
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
-        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
-        ! test
-        fraca(ig, l) = max(fraca(ig,l), 0.)
-        fraca(ig, l) = min(fraca(ig,l), 0.5)
-        fracd(ig, l) = 1. - fraca(ig, l)
-        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-      ELSE
-        ! wa_moy(ig,l)=0.
-        fraca(ig, l) = 0.
-        fracc(ig, l) = 0.
-        fracd(ig, l) = 1.
-      END IF
-    END DO
-  END DO
-  ! CR: calcul de fracazmix
-  DO ig = 1, ngrid
-    fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
-      (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
-      fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca(ig &
-      ,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      IF (larg_cons(ig,l)>1.) THEN
-        IF (l>lmix(ig)) THEN
-          ! test
-          IF (zmax(ig)-zmix(ig)<1.E-10) THEN
-            ! print*,'pb xxx'
-            xxx(ig, l) = (lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
-          ELSE
-            xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
-          END IF
-          IF (idetr==0) THEN
-            fraca(ig, l) = fracazmix(ig)
-          ELSE IF (idetr==1) THEN
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
-          ELSE IF (idetr==2) THEN
-            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
-          ELSE
-            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
-          END IF
-          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
-          fraca(ig, l) = max(fraca(ig,l), 0.)
-          fraca(ig, l) = min(fraca(ig,l), 0.5)
-          fracd(ig, l) = 1. - fraca(ig, l)
-          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
-        END IF
-      END IF
-    END DO
-  END DO
-
-  ! print*,'fin calcul fraca'
-  ! print*,'11 OK convect8'
-  ! print*,'Ea3 ',wa_moy
-  ! ------------------------------------------------------------------
-  ! Calcul de fracd, wd
-  ! somme wa - wd = 0
-  ! ------------------------------------------------------------------
-
-
-  DO ig = 1, ngrid
-    fm(ig, 1) = 0.
-    fm(ig, nlay+1) = 0.
-  END DO
-
-  DO l = 2, nlay
-    DO ig = 1, ngrid
-      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
-      ! CR:test
-      IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
-        fm(ig, l) = fm(ig, l-1)
-        ! write(1,*)'ajustement fm, l',l
-      END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
-      ! RC
-    END DO
-    DO ig = 1, ngrid
-      IF (fracd(ig,l)<0.1) THEN
-        abort_message = 'fracd trop petit'
-        CALL abort_physic(modname, abort_message, 1)
-      ELSE
-        ! vitesse descendante "diagnostique"
-        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
-    END DO
-  END DO
-
-  ! print*,'12 OK convect8'
-  ! print*,'WA4 ',wa_moy
-  ! c------------------------------------------------------------------
-  ! calcul du transport vertical
-  ! ------------------------------------------------------------------
-
-  GO TO 4444
-  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
-  DO l = 2, nlay - 1
-    DO ig = 1, ngrid
-      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
-          ig,l+1)) THEN
-        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
-        ! s         ,fm(ig,l+1)*ptimestep
-        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
-        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
-        ! s         ,entr(ig,l)*ptimestep
-        ! s         ,'   M=',masse(ig,l)
-      END IF
-    END DO
-  END DO
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
-        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
-        ! s         ,'   FM=',fm(ig,l)
-      END IF
-      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
-        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
-        ! s         ,'   M=',masse(ig,l)
-        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
-        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
-        ! print*,'zlev(ig,l+1),zlev(ig,l)'
-        ! s                ,zlev(ig,l+1),zlev(ig,l)
-        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
-        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
-      END IF
-      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
-        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
-        ! s         ,'   E=',entr(ig,l)
-      END IF
-    END DO
-  END DO
-
-4444 CONTINUE
-
-  ! CR:redefinition du entr
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      detr(ig, l) = fm(ig, l) + entr(ig, l) - fm(ig, l+1)
-      IF (detr(ig,l)<0.) THEN
-        entr(ig, l) = entr(ig, l) - detr(ig, l)
-        detr(ig, l) = 0.
-        ! print*,'WARNING !!! detrainement negatif ',ig,l
-      END IF
-    END DO
-  END DO
-  ! RC
-  IF (w2di==1) THEN
-    fm0 = fm0 + ptimestep*(fm-fm0)/tho
-    entr0 = entr0 + ptimestep*(entr-entr0)/tho
-  ELSE
-    fm0 = fm
-    entr0 = entr
-  END IF
-
-  IF (1==1) THEN
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zh, zdhadj, &
-      zha)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zo, pdoadj, &
-      zoa)
-  ELSE
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
-      zdhadj, zha)
-    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
-      pdoadj, zoa)
-  END IF
-
-  IF (1==0) THEN
-    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
-      zu, zv, pduadj, pdvadj, zua, zva)
-  ELSE
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
-      zua)
-    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
-      zva)
-  END IF
-
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
-      zf2 = zf/(1.-zf)
-      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
-      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
-    END DO
-  END DO
-
-
-
-  ! print*,'13 OK convect8'
-  ! print*,'WA5 ',wa_moy
-  DO l = 1, nlay
-    DO ig = 1, ngrid
-      pdtadj(ig, l) = zdhadj(ig, l)*zpspsk(ig, l)
-    END DO
-  END DO
-
-
-  ! do l=1,nlay
-  ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdtadj=',pdtadj(ig,l)
-  ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
-  ! print*,'WARN!!! ig=',ig,'  l=',l
-  ! s         ,'   pdoadj=',pdoadj(ig,l)
-  ! endif
-  ! enddo
-  ! enddo
-
-  ! print*,'14 OK convect8'
-  ! ------------------------------------------------------------------
-  ! Calculs pour les sorties
-  ! ------------------------------------------------------------------
-
-  RETURN
-END SUBROUTINE thermcell_sec
-
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_plume.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_plume.F90	(revision 4726)
+++ 	(revision )
@@ -1,447 +1,0 @@
-!
-! $Id: thermcell_plume.F90 3074 2017-11-15 13:31:44Z fhourdin $
-!
-      SUBROUTINE thermcell_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
-     &           zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
-     &           lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
-     &           ztla,zqla,zqta,zha,zw2,w_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
-    &           ,lev_out,lunout1,igout)
-!     &           ,lev_out,lunout1,igout,zbuoy,zbuoyjam)
-!--------------------------------------------------------------------------
-! Auhtors : Catherine Rio, Frédéric Hourdin, Arnaud Jam
-!
-!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
-!   This versions starts from a cleaning of thermcell_plume_6A (2019/01/20)
-!   thermcell_plume_6A is activate for flag_thermas_ed < 10
-!   thermcell_plume_5B for flag_thermas_ed < 20
-!   thermcell_plume for flag_thermals_ed>= 20
-!   Various options are controled by the flag_thermals_ed parameter
-!   = 20 : equivalent to thermcell_plume_6A with flag_thermals_ed=8
-!   = 21 : the Jam strato-cumulus modif is not activated in detrainment
-!   = 29 : an other way to compute the modified buoyancy (to be tested)
-!--------------------------------------------------------------------------
-
-       USE thermcell_ini_mod, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
-       USE thermcell_ini_mod, ONLY: fact_epsilon, betalpha, afact, fact_shell
-       USE thermcell_ini_mod, ONLY: detr_min, entr_min, detr_q_coef, detr_q_power
-       USE thermcell_ini_mod, ONLY: mix0, thermals_flag_alim
-
-       IMPLICIT NONE
-
-      integer,intent(in) :: itap,lev_out,lunout1,igout,ngrid,nlay
-      real,intent(in) :: ptimestep
-      real,intent(in),dimension(ngrid,nlay) :: ztv
-      real,intent(in),dimension(ngrid,nlay) :: zthl
-      real,intent(in),dimension(ngrid,nlay) :: po
-      real,intent(in),dimension(ngrid,nlay) :: zl
-      real,intent(in),dimension(ngrid,nlay) :: rhobarz
-      real,intent(in),dimension(ngrid,nlay+1) :: zlev
-      real,intent(in),dimension(ngrid,nlay+1) :: pplev
-      real,intent(in),dimension(ngrid,nlay) :: pphi
-      real,intent(in),dimension(ngrid,nlay) :: zpspsk
-      real,intent(in),dimension(ngrid) :: f0
-
-      integer,intent(out) :: lalim(ngrid)
-      real,intent(out),dimension(ngrid,nlay) :: alim_star
-      real,intent(out),dimension(ngrid) :: alim_star_tot
-      real,intent(out),dimension(ngrid,nlay) :: detr_star
-      real,intent(out),dimension(ngrid,nlay) :: entr_star
-      real,intent(out),dimension(ngrid,nlay+1) :: f_star
-      real,intent(out),dimension(ngrid,nlay) :: csc
-      real,intent(out),dimension(ngrid,nlay) :: ztva
-      real,intent(out),dimension(ngrid,nlay) :: ztla
-      real,intent(out),dimension(ngrid,nlay) :: zqla
-      real,intent(out),dimension(ngrid,nlay) :: zqta
-      real,intent(out),dimension(ngrid,nlay) :: zha
-      real,intent(out),dimension(ngrid,nlay+1) :: zw2
-      real,intent(out),dimension(ngrid,nlay+1) :: w_est
-      real,intent(out),dimension(ngrid,nlay) :: ztva_est
-      real,intent(out),dimension(ngrid,nlay) :: zqsatth
-      integer,intent(out),dimension(ngrid) :: lmix(ngrid)
-      integer,intent(out),dimension(ngrid) :: lmix_bis(ngrid)
-      real,intent(out),dimension(ngrid) :: linter(ngrid)
-
-
-      REAL,dimension(ngrid,nlay+1) :: wa_moy
-      REAL,dimension(ngrid,nlay) :: entr,detr
-      REAL,dimension(ngrid,nlay) :: ztv_est
-      REAL,dimension(ngrid,nlay) :: zqla_est
-      REAL,dimension(ngrid,nlay) :: zta_est
-      REAL,dimension(ngrid) :: ztemp,zqsat
-      REAL zdw2,zdw2bis
-      REAL zw2modif
-      REAL zw2fact,zw2factbis
-      REAL,dimension(ngrid,nlay) :: zeps
-
-      REAL,dimension(ngrid) :: wmaxa
-
-      INTEGER ig,l,k,lt,it,lm,nbpb
-
-      real,dimension(ngrid,nlay) :: zbuoy,gamma,zdqt
-      real zdz,zalpha,zw2m
-      real,dimension(ngrid,nlay) :: zbuoyjam,zdqtjam
-      real zdz2,zdz3,lmel,entrbis,zdzbis
-      real,dimension(ngrid) :: d_temp
-      real ztv1,ztv2,factinv,zinv,zlmel
-      real zlmelup,zlmeldwn,zlt,zltdwn,zltup
-      real atv1,atv2,btv1,btv2
-      real ztv_est1,ztv_est2
-      real zcor,zdelta,zcvm5,qlbef
-      real zbetalpha, coefzlmel
-      real eps
-      logical Zsat
-      LOGICAL,dimension(ngrid) :: active,activetmp
-      REAL fact_gamma,fact_gamma2,fact_epsilon2
-
-
-      REAL,dimension(ngrid,nlay) :: c2
-
-      if (ngrid==1) print*,'THERMCELL PLUME MODIFIE 2014/07/11'
-      Zsat=.false.
-! Initialisation
-
-
-      zbetalpha=betalpha/(1.+betalpha)
-
-
-! Initialisations des variables r?elles
-if (1==1) then
-      ztva(:,:)=ztv(:,:)
-      ztva_est(:,:)=ztva(:,:)
-      ztv_est(:,:)=ztv(:,:)
-      ztla(:,:)=zthl(:,:)
-      zqta(:,:)=po(:,:)
-      zqla(:,:)=0.
-      zha(:,:) = ztva(:,:)
-else
-      ztva(:,:)=0.
-      ztv_est(:,:)=0.
-      ztva_est(:,:)=0.
-      ztla(:,:)=0.
-      zqta(:,:)=0.
-      zha(:,:) =0.
-endif
-
-      zqla_est(:,:)=0.
-      zqsatth(:,:)=0.
-      zqla(:,:)=0.
-      detr_star(:,:)=0.
-      entr_star(:,:)=0.
-      alim_star(:,:)=0.
-      alim_star_tot(:)=0.
-      csc(:,:)=0.
-      detr(:,:)=0.
-      entr(:,:)=0.
-      zw2(:,:)=0.
-      zbuoy(:,:)=0.
-      zbuoyjam(:,:)=0.
-      gamma(:,:)=0.
-      zeps(:,:)=0.
-      w_est(:,:)=0.
-      f_star(:,:)=0.
-      wa_moy(:,:)=0.
-      linter(:)=1.
-!     linter(:)=1.
-! Initialisation des variables entieres
-      lmix(:)=1
-      lmix_bis(:)=2
-      wmaxa(:)=0.
-
-
-!-------------------------------------------------------------------------
-! On ne considere comme actif que les colonnes dont les deux premieres
-! couches sont instables.
-!-------------------------------------------------------------------------
-
-      active(:)=ztv(:,1)>ztv(:,2)
-      d_temp(:)=0. ! Pour activer un contraste de temperature a la base
-                   ! du panache
-!  Cet appel pourrait être fait avant thermcell_plume dans thermcell_main
-      CALL thermcell_alim(thermals_flag_alim,ngrid,nlay,ztv,d_temp,zlev,alim_star,lalim)
-
-!------------------------------------------------------------------------------
-! Calcul dans la premiere couche
-! On decide dans cette version que le thermique n'est actif que si la premiere
-! couche est instable.
-! Pourrait etre change si on veut que le thermiques puisse se d??clencher
-! dans une couche l>1
-!------------------------------------------------------------------------------
-do ig=1,ngrid
-! Le panache va prendre au debut les caracteristiques de l'air contenu
-! dans cette couche.
-    if (active(ig)) then
-    ztla(ig,1)=zthl(ig,1) 
-    zqta(ig,1)=po(ig,1)
-    zqla(ig,1)=zl(ig,1)
-!cr: attention, prise en compte de f*(1)=1
-    f_star(ig,2)=alim_star(ig,1)
-    zw2(ig,2)=2.*RG*(ztv(ig,1)-ztv(ig,2))/ztv(ig,2)  &
-&                     *(zlev(ig,2)-zlev(ig,1))  &
-&                     *0.4*pphi(ig,1)/(pphi(ig,2)-pphi(ig,1))
-    w_est(ig,2)=zw2(ig,2)
-    endif
-enddo
-!
-
-!==============================================================================
-!boucle de calcul de la vitesse verticale dans le thermique
-!==============================================================================
-do l=2,nlay-1
-!==============================================================================
-
-
-! On decide si le thermique est encore actif ou non
-! AFaire : Il faut sans doute ajouter entr_star a alim_star dans ce test
-    do ig=1,ngrid
-       active(ig)=active(ig) &
-&                 .and. zw2(ig,l)>1.e-10 &
-&                 .and. f_star(ig,l)+alim_star(ig,l)>1.e-10
-    enddo
-
-
-
-!---------------------------------------------------------------------------
-! calcul des proprietes thermodynamiques et de la vitesse de la couche l
-! sans tenir compte du detrainement et de l'entrainement dans cette
-! couche
-! C'est a dire qu'on suppose 
-! ztla(l)=ztla(l-1) et zqta(l)=zqta(l-1)
-! Ici encore, on doit pouvoir ajouter entr_star (qui peut etre calculer
-! avant) a l'alimentation pour avoir un calcul plus propre
-!---------------------------------------------------------------------------
-
-   ztemp(:)=zpspsk(:,l)*ztla(:,l-1)
-   call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
-    do ig=1,ngrid 
-!       print*,'active',active(ig),ig,l
-        if(active(ig)) then 
-        zqla_est(ig,l)=max(0.,zqta(ig,l-1)-zqsat(ig))
-        ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l)
-        zta_est(ig,l)=ztva_est(ig,l)
-        ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l)
-        ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)  &
-     &      -zqla_est(ig,l))-zqla_est(ig,l))
- 
-
-!Modif AJAM
-
-        zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) 
-        zdz=zlev(ig,l+1)-zlev(ig,l)         
-        lmel=fact_thermals_ed_dz*zlev(ig,l)
-!        lmel=0.09*zlev(ig,l)
-        zlmel=zlev(ig,l)+lmel
-        zlmelup=zlmel+(zdz/2)
-        zlmeldwn=zlmel-(zdz/2)
-
-        lt=l+1
-        zlt=zlev(ig,lt)
-        zdz3=zlev(ig,lt+1)-zlt
-        zltdwn=zlt-zdz3/2
-        zltup=zlt+zdz3/2
-         
-!=========================================================================
-! 3. Calcul de la flotabilite modifie par melange avec l'air au dessus
-!=========================================================================
-
-!--------------------------------------------------
-        lt=l+1
-        zlt=zlev(ig,lt)
-        zdz2=zlev(ig,lt)-zlev(ig,l)
-
-        do while (lmel.gt.zdz2)
-           lt=lt+1
-           zlt=zlev(ig,lt)
-           zdz2=zlt-zlev(ig,l)
-        enddo
-        zdz3=zlev(ig,lt+1)-zlt
-        zltdwn=zlev(ig,lt)-zdz3/2
-        zlmelup=zlmel+(zdz/2)
-        coefzlmel=Min(1.,(zlmelup-zltdwn)/zdz)
-        zbuoyjam(ig,l)=1.*RG*(coefzlmel*(ztva_est(ig,l)- & 
-    &   ztv(ig,lt))/ztv(ig,lt)+(1.-coefzlmel)*(ztva_est(ig,l)- &
-    &   ztv(ig,lt-1))/ztv(ig,lt-1))+0.*zbuoy(ig,l)
-
-!------------------------------------------------
-!AJAM:nouveau calcul de w?  
-!------------------------------------------------
-        zdz=zlev(ig,l+1)-zlev(ig,l)
-        zdzbis=zlev(ig,l)-zlev(ig,l-1)
-        zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-        zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-        zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
-        zdw2=afact*zbuoy(ig,l)/fact_epsilon
-        zdw2bis=afact*zbuoy(ig,l-1)/fact_epsilon
-        lm=Max(1,l-2)
-        w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2)+zdw2)
-       endif
-    enddo
-
-
-!-------------------------------------------------
-!calcul des taux d'entrainement et de detrainement
-!-------------------------------------------------
-
-     do ig=1,ngrid
-        if (active(ig)) then
-
-!          zw2m=max(0.5*(w_est(ig,l)+w_est(ig,l+1)),0.1)
-          zw2m=w_est(ig,l+1)
-          zdz=zlev(ig,l+1)-zlev(ig,l)
-          zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-          zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l+1))/rhobarz(ig,l)
-          zdqt(ig,l)=max(zqta(ig,l-1)-po(ig,l),0.)/po(ig,l)
-
-!=========================================================================
-! 4. Calcul de l'entrainement et du detrainement
-!=========================================================================
-
-          detr_star(ig,l)=f_star(ig,l)*zdz             &
-    &     *( mix0 * 0.1 / (zalpha+0.001)               &
-    &     + MAX(detr_min, -afact*zbetalpha*zbuoyjam(ig,l)/zw2m   &
-    &     + detr_q_coef*(zdqt(ig,l)/zw2m)**detr_q_power))
-
-          if ( iflag_thermals_ed == 20 ) then
-             entr_star(ig,l)=f_star(ig,l)*zdz* (         &
-    &          mix0 * 0.1 / (zalpha+0.001)               &
-    &        + zbetalpha*MAX(entr_min,                   &
-    &        afact*zbuoyjam(ig,l)/zw2m - fact_epsilon))
-          else
-             entr_star(ig,l)=f_star(ig,l)*zdz* (         &
-    &          mix0 * 0.1 / (zalpha+0.001)               &
-    &        + zbetalpha*MAX(entr_min,                   &
-    &        afact*zbuoy(ig,l)/zw2m - fact_epsilon))
-          endif
-          
-! En dessous de lalim, on prend le max de alim_star et entr_star pour
-! alim_star et 0 sinon
-        if (l.lt.lalim(ig)) then
-          alim_star(ig,l)=max(alim_star(ig,l),entr_star(ig,l))
-          entr_star(ig,l)=0.
-        endif
-        f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)  &
-     &              -detr_star(ig,l)
-
-      endif
-   enddo
-
-
-!============================================================================
-! 5. calcul de la vitesse verticale en melangeant Tl et qt du thermique
-!===========================================================================
-
-   activetmp(:)=active(:) .and. f_star(:,l+1)>1.e-10
-   do ig=1,ngrid
-       if (activetmp(ig)) then 
-           Zsat=.false.
-           ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+  &
-     &            (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l))  &
-     &            /(f_star(ig,l+1)+detr_star(ig,l))
-           zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+  &
-     &            (alim_star(ig,l)+entr_star(ig,l))*po(ig,l))  &
-     &            /(f_star(ig,l+1)+detr_star(ig,l))
-
-        endif
-    enddo
-
-   ztemp(:)=zpspsk(:,l)*ztla(:,l)
-   call thermcell_qsat(ngrid,activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
-   do ig=1,ngrid
-      if (activetmp(ig)) then
-! on ecrit de maniere conservative (sat ou non)
-!          T = Tl +Lv/Cp ql
-           zqla(ig,l)=max(0.,zqta(ig,l)-zqsatth(ig,l))
-           ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
-           ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
-!on rajoute le calcul de zha pour diagnostiques (temp potentielle)
-           zha(ig,l) = ztva(ig,l)
-           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)  &
-     &              -zqla(ig,l))-zqla(ig,l))
-           zbuoy(ig,l)=RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
-           zdz=zlev(ig,l+1)-zlev(ig,l)
-           zdzbis=zlev(ig,l)-zlev(ig,l-1)
-           zeps(ig,l)=(entr_star(ig,l)+alim_star(ig,l))/(f_star(ig,l)*zdz)
-           zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-           zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
-           zdw2= afact*zbuoy(ig,l)/(fact_epsilon)
-           zdw2bis= afact*zbuoy(ig,l-1)/(fact_epsilon)
-           zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2)+zdw2)
-      endif
-   enddo
-
-   if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l
-!
-!===========================================================================
-! 6. initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max 
-!===========================================================================
-
-   nbpb=0
-   do ig=1,ngrid
-            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
-!               stop'On tombe sur le cas particulier de thermcell_dry'
-!               print*,'On tombe sur le cas particulier de thermcell_plume'
-                nbpb=nbpb+1
-                zw2(ig,l+1)=0.
-                linter(ig)=l+1
-            endif
-
-        if (zw2(ig,l+1).lt.0.) then 
-           linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
-     &               -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
-           zw2(ig,l+1)=0.
-!+CR:04/05/12:correction calcul linter pour calcul de zmax continu
-        elseif (f_star(ig,l+1).lt.0.) then
-           linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
-     &               -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
-           zw2(ig,l+1)=0.
-!fin CR:04/05/12
-        endif
-
-           wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) 
-
-        if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
-!   lmix est le niveau de la couche ou w (wa_moy) est maximum
-!on rajoute le calcul de lmix_bis
-            if (zqla(ig,l).lt.1.e-10) then
-               lmix_bis(ig)=l+1
-            endif
-            lmix(ig)=l+1
-            wmaxa(ig)=wa_moy(ig,l+1)
-        endif
-   enddo
-
-   if (nbpb>0) then
-   print*,'WARNING on tombe ',nbpb,' x sur un pb pour l=',l,' dans thermcell_plume'
-   endif
-
-!=========================================================================
-! FIN DE LA BOUCLE VERTICALE
-      enddo
-!=========================================================================
-
-!on recalcule alim_star_tot
-       do ig=1,ngrid
-          alim_star_tot(ig)=0.
-       enddo
-       do ig=1,ngrid
-          do l=1,lalim(ig)-1
-          alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
-          enddo
-       enddo
-       
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
-
-#undef wrgrads_thermcell
-#ifdef wrgrads_thermcell
-         call wrgradsfi(1,nlay,entr_star(igout,1:nlay),'esta      ','esta      ')
-         call wrgradsfi(1,nlay,detr_star(igout,1:nlay),'dsta      ','dsta      ')
-         call wrgradsfi(1,nlay,zbuoy(igout,1:nlay),'buoy      ','buoy      ')
-         call wrgradsfi(1,nlay,zdqt(igout,1:nlay),'dqt      ','dqt      ')
-         call wrgradsfi(1,nlay,w_est(igout,1:nlay),'w_est     ','w_est     ')
-         call wrgradsfi(1,nlay,w_est(igout,2:nlay+1),'w_es2     ','w_es2     ')
-         call wrgradsfi(1,nlay,zw2(igout,1:nlay),'zw2A      ','zw2A      ')
-#endif
-
-
- RETURN
-     end
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_plume_6A.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_plume_6A.F90	(revision 4726)
+++ 	(revision )
@@ -1,1110 +1,0 @@
-!
-! $Id$
-!
-      SUBROUTINE thermcell_plume_6A(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
-     &           zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
-     &           lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
-     &           ztla,zqla,zqta,zha,zw2,w_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
-    &           ,lev_out,lunout1,igout)
-!     &           ,lev_out,lunout1,igout,zbuoy,zbuoyjam)
-!--------------------------------------------------------------------------
-!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
-!--------------------------------------------------------------------------
-
-       USE thermcell_ini_mod, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
-       USE thermcell_ini_mod, ONLY: fact_epsilon, betalpha, afact, fact_shell
-       USE thermcell_ini_mod, ONLY: detr_min, entr_min, detr_q_coef, detr_q_power
-       USE thermcell_ini_mod, ONLY: mix0, thermals_flag_alim
-
-       IMPLICIT NONE
-
-      integer,intent(in) :: itap,lev_out,lunout1,igout,ngrid,nlay
-      real,intent(in) :: ptimestep
-      real,intent(in),dimension(ngrid,nlay) :: ztv
-      real,intent(in),dimension(ngrid,nlay) :: zthl
-      real,intent(in),dimension(ngrid,nlay) :: po
-      real,intent(in),dimension(ngrid,nlay) :: zl
-      real,intent(in),dimension(ngrid,nlay) :: rhobarz
-      real,intent(in),dimension(ngrid,nlay+1) :: zlev
-      real,intent(in),dimension(ngrid,nlay+1) :: pplev
-      real,intent(in),dimension(ngrid,nlay) :: pphi
-      real,intent(in),dimension(ngrid,nlay) :: zpspsk
-      real,intent(in),dimension(ngrid) :: f0
-
-      integer,intent(out) :: lalim(ngrid)
-      real,intent(out),dimension(ngrid,nlay) :: alim_star
-      real,intent(out),dimension(ngrid) :: alim_star_tot
-      real,intent(out),dimension(ngrid,nlay) :: detr_star
-      real,intent(out),dimension(ngrid,nlay) :: entr_star
-      real,intent(out),dimension(ngrid,nlay+1) :: f_star
-      real,intent(out),dimension(ngrid,nlay) :: csc
-      real,intent(out),dimension(ngrid,nlay) :: ztva
-      real,intent(out),dimension(ngrid,nlay) :: ztla
-      real,intent(out),dimension(ngrid,nlay) :: zqla
-      real,intent(out),dimension(ngrid,nlay) :: zqta
-      real,intent(out),dimension(ngrid,nlay) :: zha
-      real,intent(out),dimension(ngrid,nlay+1) :: zw2
-      real,intent(out),dimension(ngrid,nlay+1) :: w_est
-      real,intent(out),dimension(ngrid,nlay) :: ztva_est
-      real,intent(out),dimension(ngrid,nlay) :: zqsatth
-      integer,intent(out),dimension(ngrid) :: lmix
-      integer,intent(out),dimension(ngrid) :: lmix_bis
-      real,intent(out),dimension(ngrid) :: linter
-
-      REAL zdw2,zdw2bis
-      REAL zw2modif
-      REAL zw2fact,zw2factbis
-      REAL,dimension(ngrid,nlay) :: zeps
-
-      REAL, dimension(ngrid) ::    wmaxa(ngrid)
-
-      INTEGER ig,l,k,lt,it,lm
-      integer nbpb
-
-      real,dimension(ngrid,nlay) :: detr
-      real,dimension(ngrid,nlay) :: entr
-      real,dimension(ngrid,nlay+1) :: wa_moy
-      real,dimension(ngrid,nlay) :: ztv_est
-      real,dimension(ngrid) :: ztemp,zqsat
-      real,dimension(ngrid,nlay) :: zqla_est
-      real,dimension(ngrid,nlay) :: zta_est
-
-      real,dimension(ngrid,nlay) :: zbuoy,gamma,zdqt
-      real zdz,zalpha,zw2m
-      real,dimension(ngrid,nlay) :: zbuoyjam,zdqtjam
-      real zbuoybis,zdz2,zdz3,lmel,entrbis,zdzbis
-      real, dimension(ngrid) :: d_temp
-      real ztv1,ztv2,factinv,zinv,zlmel
-      real zlmelup,zlmeldwn,zlt,zltdwn,zltup
-      real atv1,atv2,btv1,btv2
-      real ztv_est1,ztv_est2
-      real zcor,zdelta,zcvm5,qlbef
-      real zbetalpha, coefzlmel
-      real eps
-      logical Zsat
-      LOGICAL,dimension(ngrid) :: active,activetmp
-      REAL fact_gamma,fact_gamma2,fact_epsilon2
-      REAL coefc
-      REAL,dimension(ngrid,nlay) :: c2
-
-      if (ngrid==1) print*,'THERMCELL PLUME MODIFIE 2014/07/11'
-      Zsat=.false.
-! Initialisation
-
-
-      zbetalpha=betalpha/(1.+betalpha)
-
-
-! Initialisations des variables r?elles
-if (1==1) then
-      ztva(:,:)=ztv(:,:)
-      ztva_est(:,:)=ztva(:,:)
-      ztv_est(:,:)=ztv(:,:)
-      ztla(:,:)=zthl(:,:)
-      zqta(:,:)=po(:,:)
-      zqla(:,:)=0.
-      zha(:,:) = ztva(:,:)
-else
-      ztva(:,:)=0.
-      ztv_est(:,:)=0.
-      ztva_est(:,:)=0.
-      ztla(:,:)=0.
-      zqta(:,:)=0.
-      zha(:,:) =0.
-endif
-
-      zqla_est(:,:)=0.
-      zqsatth(:,:)=0.
-      zqla(:,:)=0.
-      detr_star(:,:)=0.
-      entr_star(:,:)=0.
-      alim_star(:,:)=0.
-      alim_star_tot(:)=0.
-      csc(:,:)=0.
-      detr(:,:)=0.
-      entr(:,:)=0.
-      zw2(:,:)=0.
-      zbuoy(:,:)=0.
-      zbuoyjam(:,:)=0.
-      gamma(:,:)=0.
-      zeps(:,:)=0.
-      w_est(:,:)=0.
-      f_star(:,:)=0.
-      wa_moy(:,:)=0.
-      linter(:)=1.
-!     linter(:)=1.
-! Initialisation des variables entieres
-      lmix(:)=1
-      lmix_bis(:)=2
-      wmaxa(:)=0.
-
-! Initialisation a 0  en cas de sortie dans replay
-      zqsat(:)=0.
-      zta_est(:,:)=0.
-      zdqt(:,:)=0.
-      zdqtjam(:,:)=0.
-      c2(:,:)=0.
-
-
-!-------------------------------------------------------------------------
-! On ne considere comme actif que les colonnes dont les deux premieres
-! couches sont instables.
-!-------------------------------------------------------------------------
-
-      active(:)=ztv(:,1)>ztv(:,2)
-      d_temp(:)=0. ! Pour activer un contraste de temperature a la base
-                   ! du panache
-!  Cet appel pourrait être fait avant thermcell_plume dans thermcell_main
-      CALL thermcell_alim(thermals_flag_alim,ngrid,nlay,ztv,d_temp,zlev,alim_star,lalim)
-
-!------------------------------------------------------------------------------
-! Calcul dans la premiere couche
-! On decide dans cette version que le thermique n'est actif que si la premiere
-! couche est instable.
-! Pourrait etre change si on veut que le thermiques puisse se d??clencher
-! dans une couche l>1
-!------------------------------------------------------------------------------
-do ig=1,ngrid
-! Le panache va prendre au debut les caracteristiques de l'air contenu
-! dans cette couche.
-    if (active(ig)) then
-    ztla(ig,1)=zthl(ig,1) 
-    zqta(ig,1)=po(ig,1)
-    zqla(ig,1)=zl(ig,1)
-!cr: attention, prise en compte de f*(1)=1
-    f_star(ig,2)=alim_star(ig,1)
-    zw2(ig,2)=2.*RG*(ztv(ig,1)-ztv(ig,2))/ztv(ig,2)  &
-&                     *(zlev(ig,2)-zlev(ig,1))  &
-&                     *0.4*pphi(ig,1)/(pphi(ig,2)-pphi(ig,1))
-    w_est(ig,2)=zw2(ig,2)
-    endif
-enddo
-!
-
-!==============================================================================
-!boucle de calcul de la vitesse verticale dans le thermique
-!==============================================================================
-do l=2,nlay-1
-!==============================================================================
-
-
-! On decide si le thermique est encore actif ou non
-! AFaire : Il faut sans doute ajouter entr_star a alim_star dans ce test
-    do ig=1,ngrid
-       active(ig)=active(ig) &
-&                 .and. zw2(ig,l)>1.e-10 &
-&                 .and. f_star(ig,l)+alim_star(ig,l)>1.e-10
-    enddo
-
-
-
-!---------------------------------------------------------------------------
-! calcul des proprietes thermodynamiques et de la vitesse de la couche l
-! sans tenir compte du detrainement et de l'entrainement dans cette
-! couche
-! C'est a dire qu'on suppose 
-! ztla(l)=ztla(l-1) et zqta(l)=zqta(l-1)
-! Ici encore, on doit pouvoir ajouter entr_star (qui peut etre calculer
-! avant) a l'alimentation pour avoir un calcul plus propre
-!---------------------------------------------------------------------------
-
-   ztemp(:)=zpspsk(:,l)*ztla(:,l-1)
-   call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
-    do ig=1,ngrid 
-!       print*,'active',active(ig),ig,l
-        if(active(ig)) then 
-        zqla_est(ig,l)=max(0.,zqta(ig,l-1)-zqsat(ig))
-        ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l)
-        zta_est(ig,l)=ztva_est(ig,l)
-        ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l)
-        ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)  &
-     &      -zqla_est(ig,l))-zqla_est(ig,l))
- 
-
-!Modif AJAM
-
-        zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) 
-        zdz=zlev(ig,l+1)-zlev(ig,l)         
-        lmel=fact_thermals_ed_dz*zlev(ig,l)
-!        lmel=0.09*zlev(ig,l)
-        zlmel=zlev(ig,l)+lmel
-        zlmelup=zlmel+(zdz/2)
-        zlmeldwn=zlmel-(zdz/2)
-
-        lt=l+1
-        zlt=zlev(ig,lt)
-        zdz3=zlev(ig,lt+1)-zlt
-        zltdwn=zlt-zdz3/2
-        zltup=zlt+zdz3/2
-         
-!=========================================================================
-! 3. Calcul de la flotabilite modifie par melange avec l'air au dessus
-!=========================================================================
-
-!--------------------------------------------------
-        if (iflag_thermals_ed.lt.8) then
-!--------------------------------------------------
-!AJ052014: J'ai remplac?? la boucle do par un do while
-! afin de faire moins de calcul dans la boucle
-!--------------------------------------------------
-            do while (zlmelup.gt.zltup)
-               lt=lt+1
-               zlt=zlev(ig,lt)
-               zdz3=zlev(ig,lt+1)-zlt
-               zltdwn=zlt-zdz3/2
-               zltup=zlt+zdz3/2        
-            enddo
-!--------------------------------------------------
-!AJ052014: Si iflag_thermals_ed<8 (par ex 6), alors
-! on cherche o?? se trouve l'altitude d'inversion 
-! en calculant ztv1 (interpolation de la valeur de 
-! theta au niveau lt en utilisant les niveaux lt-1 et
-! lt-2) et ztv2 (interpolation avec les niveaux lt+1
-! et lt+2). Si theta r??ellement calcul??e au niveau lt
-! comprise entre ztv1 et ztv2, alors il y a inversion
-! et on calcule son altitude zinv en supposant que ztv(lt)
-! est une combinaison lineaire de ztv1 et ztv2.
-! Ensuite, on calcule la flottabilite en comparant 
-! la temperature de la couche l a celle de l'air situe 
-! l+lmel plus haut, ce qui necessite de savoir quel fraction 
-! de cet air est au-dessus ou en-dessous de l'inversion   
-!--------------------------------------------------
-            atv1=(ztv(ig,lt-1)-ztv(ig,lt-2))/(zlev(ig,lt-1)-zlev(ig,lt-2))
-            btv1=(ztv(ig,lt-2)*zlev(ig,lt-1)-ztv(ig,lt-1)*zlev(ig,lt-2)) &
-    &          /(zlev(ig,lt-1)-zlev(ig,lt-2))
-            atv2=(ztv(ig,lt+2)-ztv(ig,lt+1))/(zlev(ig,lt+2)-zlev(ig,lt+1))
-            btv2=(ztv(ig,lt+1)*zlev(ig,lt+2)-ztv(ig,lt+2)*zlev(ig,lt+1)) &
-    &          /(zlev(ig,lt+2)-zlev(ig,lt+1))
-
-             ztv1=atv1*zlt+btv1
-             ztv2=atv2*zlt+btv2
-
-             if (ztv(ig,lt).gt.ztv1.and.ztv(ig,lt).lt.ztv2) then  
-
-!--------------------------------------------------
-!AJ052014: D??calage de zinv qui est entre le haut
-!          et le bas de la couche lt
-!--------------------------------------------------
-                factinv=(ztv2-ztv(ig,lt))/(ztv2-ztv1)
-                zinv=zltdwn+zdz3*factinv
-
-          
-                if (zlmeldwn.ge.zinv) then
-                   ztv_est(ig,l)=atv2*zlmel+btv2
-                   zbuoyjam(ig,l)=fact_shell*RG*(ztva_est(ig,l)-ztv_est(ig,l))/ztv_est(ig,l) &
-    &                    +(1.-fact_shell)*zbuoy(ig,l)
-                elseif (zlmelup.ge.zinv) then
-                 ztv_est2=atv2*0.5*(zlmelup+zinv)+btv2
-                   ztv_est1=atv1*0.5*(zinv+zlmeldwn)+btv1
-                   ztv_est(ig,l)=((zlmelup-zinv)/zdz)*ztv_est2+((zinv-zlmeldwn)/zdz)*ztv_est1
-
-                   zbuoyjam(ig,l)=fact_shell*RG*(((zlmelup-zinv)/zdz)*(ztva_est(ig,l)- & 
-    &            ztv_est2)/ztv_est2+((zinv-zlmeldwn)/zdz)*(ztva_est(ig,l)- &
-    &            ztv_est1)/ztv_est1)+(1.-fact_shell)*zbuoy(ig,l)
-
-                else 
-                   ztv_est(ig,l)=atv1*zlmel+btv1
-                   zbuoyjam(ig,l)=fact_shell*RG*(ztva_est(ig,l)-ztv_est(ig,l))/ztv_est(ig,l) & 
-    &                           +(1.-fact_shell)*zbuoy(ig,l)
-                endif
-
-             else ! if (ztv(ig,lt).gt.ztv1.and.ztv(ig,lt).lt.ztv2) then
-
-                if (zlmeldwn.gt.zltdwn) then
-                   zbuoyjam(ig,l)=fact_shell*RG*((ztva_est(ig,l)- & 
-    &                ztv(ig,lt))/ztv(ig,lt))+(1.-fact_shell)*zbuoy(ig,l)
-                else
-                   zbuoyjam(ig,l)=fact_shell*RG*(((zlmelup-zltdwn)/zdz)*(ztva_est(ig,l)- & 
-    &                ztv(ig,lt))/ztv(ig,lt)+((zltdwn-zlmeldwn)/zdz)*(ztva_est(ig,l)- &
-    &                ztv(ig,lt-1))/ztv(ig,lt-1))+(1.-fact_shell)*zbuoy(ig,l)
-
-                endif
-
-!          zbuoyjam(ig,l)=fact_shell*RG*(((zlmelup-zltdwn)/zdz)*(ztva_est(ig,l)- & 
-!    &          ztv1)/ztv1+((zltdwn-zlmeldwn)/zdz)*(ztva_est(ig,l)- &
-!    &          ztv(ig,lt-1))/ztv(ig,lt-1))+(1.-fact_shell)*zbuoy(ig,l)
-!         zdqt(ig,l)=Max(0.,((lmel+zdz3-zdz2)/zdz3)*(zqta(ig,l-1)- & 
-!    &          po(ig,lt))/po(ig,lt)+((zdz2-lmel)/zdz3)*(zqta(ig,l-1)- &
-!     &          po(ig,lt-1))/po(ig,lt-1))
-          endif ! if (ztv(ig,lt).gt.ztv1.and.ztv(ig,lt).lt.ztv2) then
-
-        else  !   if (iflag_thermals_ed.lt.8) then
-           lt=l+1
-           zlt=zlev(ig,lt)
-           zdz2=zlev(ig,lt)-zlev(ig,l)
-
-           do while (lmel.gt.zdz2)
-             lt=lt+1
-             zlt=zlev(ig,lt)
-             zdz2=zlt-zlev(ig,l)
-           enddo
-           zdz3=zlev(ig,lt+1)-zlt
-           zltdwn=zlev(ig,lt)-zdz3/2
-           zlmelup=zlmel+(zdz/2)
-           coefzlmel=Min(1.,(zlmelup-zltdwn)/zdz)
-           zbuoyjam(ig,l)=1.*RG*(coefzlmel*(ztva_est(ig,l)- & 
-    &          ztv(ig,lt))/ztv(ig,lt)+(1.-coefzlmel)*(ztva_est(ig,l)- &
-    &          ztv(ig,lt-1))/ztv(ig,lt-1))+0.*zbuoy(ig,l)
-        endif !   if (iflag_thermals_ed.lt.8) then
-
-!------------------------------------------------
-!AJAM:nouveau calcul de w?  
-!------------------------------------------------
-              zdz=zlev(ig,l+1)-zlev(ig,l)
-              zdzbis=zlev(ig,l)-zlev(ig,l-1)
-              zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-
-              zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-              zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
-              zdw2=afact*zbuoy(ig,l)/fact_epsilon
-              zdw2bis=afact*zbuoy(ig,l-1)/fact_epsilon
-!              zdw2bis=0.5*(zdw2+zdw2bis)
-              lm=Max(1,l-2)
-!              zdw2=(afact/fact_epsilon)*((zdz/zdzbis)*zbuoy(ig,l) &
-!    &              +((zdzbis-zdz)/zdzbis)*zbuoy(ig,l-1)) 
-!              zdw2bis=(afact/fact_epsilon)*((zdz/zdzbis)*zbuoy(ig,l-1) &
-!    &              +((zdzbis-zdz)/zdzbis)*zbuoy(ig,l-1))
-!             w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2)+zdw2)
-!             w_est(ig,l+1)=(zdz/zdzbis)*Max(0.0001,exp(-zw2fact)* &
-!    &                     (w_est(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
-!    &                     Max(0.0001,exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2)
-!              w_est(ig,l+1)=Max(0.0001,(1-exp(-zw2fact))*zdw2+w_est(ig,l)*exp(-zw2fact))
-
-!--------------------------------------------------
-!AJ052014: J'ai remplac? w_est(ig,l) par zw2(ig,l)
-!--------------------------------------------------
-         if (iflag_thermals_ed==8) then
-! Ancienne version
-!             w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
-!    &                     (w_est(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
-!    &                     (exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2))
-
-            w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2)+zdw2)
-
-! Nouvelle version Arnaud
-         else
-!             w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
-!    &                     (w_est(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
-!    &                     (exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2))
-
-            w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2bis)+zdw2)
-
-!             w_est(ig,l+1)=Max(0.0001,(zdz/(zdzbis+zdz))*(exp(-zw2fact)* &
-!    &                     (w_est(ig,l)-zdw2bis)+zdw2)+(zdzbis/(zdzbis+zdz))* &
-!    &                     (exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2bis))
-
-
-
-!            w_est(ig,l+1)=Max(0.0001,(w_est(ig,l)+zdw2bis*zw2fact)*exp(-zw2fact))
-
-!             w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact)+ &
-!    &                      (zdzbis-zdz)/zdzbis*(zw2(ig,l-1)+zdw2bis*zw2factbis)*exp(-zw2factbis))
-
-!             w_est(ig,l+1)=Max(0.0001,exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2)
-
-         endif
-
-
-         if (iflag_thermals_ed<6) then
-             zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l+1))/rhobarz(ig,l)
-!              fact_epsilon=0.0005/(zalpha+0.025)**0.5
-!              fact_epsilon=Min(0.003,0.0004/(zalpha)**0.5)
-              fact_epsilon=0.0002/(zalpha+0.1)
-              zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-              zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
-              zdw2=afact*zbuoy(ig,l)/fact_epsilon
-              zdw2bis=afact*zbuoy(ig,l-1)/fact_epsilon
-!              w_est(ig,l+1)=Max(0.0001,(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact))
-
-!              w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
-!    &                     (zw2(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
-!    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2))
-
-            w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2bis)+zdw2)
-
-
-         endif
-!--------------------------------------------------
-!AJ052014: J'ai comment? ce if plus n?cessaire puisqu'
-!on fait max(0.0001,.....)
-!--------------------------------------------------         
-
-!             if (w_est(ig,l+1).lt.0.) then
-!               w_est(ig,l+1)=zw2(ig,l)
-!                w_est(ig,l+1)=0.0001
-!             endif
-
-       endif
-    enddo
-
-
-!-------------------------------------------------
-!calcul des taux d'entrainement et de detrainement
-!-------------------------------------------------
-
-     do ig=1,ngrid
-        if (active(ig)) then
-
-!          zw2m=max(0.5*(w_est(ig,l)+w_est(ig,l+1)),0.1)
-          zw2m=w_est(ig,l+1)
-!          zw2m=zw2(ig,l)
-          zdz=zlev(ig,l+1)-zlev(ig,l)
-          zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-!          zbuoybis=zbuoy(ig,l)+RG*0.1/300.
-          zbuoybis=zbuoy(ig,l)
-          zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l+1))/rhobarz(ig,l)
-          zdqt(ig,l)=max(zqta(ig,l-1)-po(ig,l),0.)/po(ig,l)
-
-          
-!          entr_star(ig,l)=f_star(ig,l)*zdz*zbetalpha*MAX(0.,  &
-!    &     afact*zbuoybis/zw2m - fact_epsilon )
-
-!          entr_star(ig,l)=MAX(0.,f_star(ig,l)*zdz*zbetalpha*  &
-!    &     afact*zbuoybis/zw2m - fact_epsilon )
-
-
-
-!          zbuoyjam(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-
-!=========================================================================
-! 4. Calcul de l'entrainement et du detrainement
-!=========================================================================
-
-!          entr_star(ig,l)=f_star(ig,l)*zdz*zbetalpha*MAX(0.,  &
-!    &     afact*zbuoyjam(ig,l)/zw2m - fact_epsilon ) 
-!          entrbis=entr_star(ig,l)
-
-          if (iflag_thermals_ed.lt.6) then
-          fact_epsilon=0.0002/(zalpha+0.1)
-          endif
-          
-
-
-          detr_star(ig,l)=f_star(ig,l)*zdz             &
-    &     *( mix0 * 0.1 / (zalpha+0.001)               &
-    &     + MAX(detr_min, -afact*zbetalpha*zbuoyjam(ig,l)/zw2m   &
-    &     + detr_q_coef*(zdqt(ig,l)/zw2m)**detr_q_power))
-
-!          detr_star(ig,l)=(zdz/zdzbis)*detr_star(ig,l)+ &
-!    &                          ((zdzbis-zdz)/zdzbis)*detr_star(ig,l-1)
-
-          zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-
-          entr_star(ig,l)=f_star(ig,l)*zdz* (         &
-    &       mix0 * 0.1 / (zalpha+0.001)               &
-    &     + zbetalpha*MAX(entr_min,                   &
-    &     afact*zbuoyjam(ig,l)/zw2m - fact_epsilon))
-
-
-!          entr_star(ig,l)=f_star(ig,l)*zdz* (         &
-!    &       mix0 * 0.1 / (zalpha+0.001)               &
-!    &     + MAX(entr_min,                   &
-!    &     zbetalpha*afact*zbuoyjam(ig,l)/zw2m - fact_epsilon +  & 
-!    &     detr_q_coef*(zdqt(ig,l)/zw2m)**detr_q_power))
-
-
-!          entr_star(ig,l)=(zdz/zdzbis)*entr_star(ig,l)+ &
-!    &                          ((zdzbis-zdz)/zdzbis)*entr_star(ig,l-1)
-
-!          entr_star(ig,l)=Max(0.,f_star(ig,l)*zdz*zbetalpha*  &     
-!    &     afact*zbuoy(ig,l)/zw2m &
-!    &     - 1.*fact_epsilon)
-
-          
-! En dessous de lalim, on prend le max de alim_star et entr_star pour
-! alim_star et 0 sinon
-        if (l.lt.lalim(ig)) then
-          alim_star(ig,l)=max(alim_star(ig,l),entr_star(ig,l))
-          entr_star(ig,l)=0.
-        endif
-!        if (l.lt.lalim(ig).and.alim_star(ig,l)>alim_star(ig,l-1)) then
-!          alim_star(ig,l)=entrbis
-!        endif
-
-!        print*,'alim0',zlev(ig,l),entr_star(ig,l),detr_star(ig,l),zw2m,zbuoy(ig,l),f_star(ig,l)
-! Calcul du flux montant normalise
-      f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)  &
-     &              -detr_star(ig,l)
-
-      endif
-   enddo
-
-
-!============================================================================
-! 5. calcul de la vitesse verticale en melangeant Tl et qt du thermique
-!===========================================================================
-
-   activetmp(:)=active(:) .and. f_star(:,l+1)>1.e-10
-   do ig=1,ngrid
-       if (activetmp(ig)) then 
-           Zsat=.false.
-           ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+  &
-     &            (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l))  &
-     &            /(f_star(ig,l+1)+detr_star(ig,l))
-           zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+  &
-     &            (alim_star(ig,l)+entr_star(ig,l))*po(ig,l))  &
-     &            /(f_star(ig,l+1)+detr_star(ig,l))
-
-        endif
-    enddo
-
-   ztemp(:)=zpspsk(:,l)*ztla(:,l)
-   call thermcell_qsat(ngrid,activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
-   do ig=1,ngrid
-      if (activetmp(ig)) then
-! on ecrit de maniere conservative (sat ou non)
-!          T = Tl +Lv/Cp ql
-           zqla(ig,l)=max(0.,zqta(ig,l)-zqsatth(ig,l))
-           ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
-           ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
-!on rajoute le calcul de zha pour diagnostiques (temp potentielle)
-           zha(ig,l) = ztva(ig,l)
-           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)  &
-     &              -zqla(ig,l))-zqla(ig,l))
-           zbuoy(ig,l)=RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
-           zdz=zlev(ig,l+1)-zlev(ig,l)
-           zdzbis=zlev(ig,l)-zlev(ig,l-1)
-           zeps(ig,l)=(entr_star(ig,l)+alim_star(ig,l))/(f_star(ig,l)*zdz)
-!!!!!!!          fact_epsilon=0.002
-            zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-            zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
-            zdw2= afact*zbuoy(ig,l)/(fact_epsilon)
-            zdw2bis= afact*zbuoy(ig,l-1)/(fact_epsilon)
-!              zdw2=(afact/fact_epsilon)*((zdz/zdzbis)*zbuoy(ig,l) &
-!    &              +((zdzbis-zdz)/zdzbis)*zbuoy(ig,l-1)) 
-!              lm=Max(1,l-2)
-!              zdw2bis=(afact/fact_epsilon)*((zdz/zdzbis)*zbuoy(ig,l-1) &
-!    &              +((zdzbis-zdz)/zdzbis)*zbuoy(ig,l-1))
-!            zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2bis)+zdw2)
-!            zw2(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact)+ &
-!     &                   (zdzbis-zdz)/zdzbis*(zw2(ig,l-1)+zdw2bis*zw2factbis)*exp(-zw2factbis))
-!            zw2(ig,l+1)=Max(0.0001,(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact))
-!            zw2(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
-!    &                     (zw2(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
-!    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2))
-            if (iflag_thermals_ed==8) then
-            zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2)+zdw2)
-            else
-            zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2bis)+zdw2)
-            endif
-!            zw2(ig,l+1)=Max(0.0001,(zdz/(zdz+zdzbis))*(exp(-zw2fact)* &
-!    &                     (zw2(ig,l)-zdw2)+zdw2bis)+(zdzbis/(zdz+zdzbis))* &
-!    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2bis))
-
-
-           if (iflag_thermals_ed.lt.6) then
-           zalpha=f0(ig)*f_star(ig,l)/sqrt(zw2(ig,l+1))/rhobarz(ig,l)
-!           fact_epsilon=0.0005/(zalpha+0.025)**0.5
-!           fact_epsilon=Min(0.003,0.0004/(zalpha)**0.5)
-           fact_epsilon=0.0002/(zalpha+0.1)**1
-            zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-            zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
-            zdw2= afact*zbuoy(ig,l)/(fact_epsilon)
-            zdw2bis= afact*zbuoy(ig,l-1)/(fact_epsilon)
-
-!            zw2(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
-!    &                     (zw2(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
-!    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2))
-!            zw2(ig,l+1)=Max(0.0001,(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact))
-            zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2bis)+zdw2)
-
-           endif
-
-
-      endif
-   enddo
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l
-!
-!===========================================================================
-! 6. initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max 
-!===========================================================================
-
-   nbpb=0
-   do ig=1,ngrid
-            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
-!               stop'On tombe sur le cas particulier de thermcell_dry'
-!               print*,'On tombe sur le cas particulier de thermcell_plume'
-                nbpb=nbpb+1
-                zw2(ig,l+1)=0.
-                linter(ig)=l+1
-            endif
-
-        if (zw2(ig,l+1).lt.0.) then 
-           linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
-     &               -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
-           zw2(ig,l+1)=0.
-!+CR:04/05/12:correction calcul linter pour calcul de zmax continu
-        elseif (f_star(ig,l+1).lt.0.) then
-           linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
-     &               -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
-           zw2(ig,l+1)=0.
-!fin CR:04/05/12
-        endif
-
-           wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) 
-
-        if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
-!   lmix est le niveau de la couche ou w (wa_moy) est maximum
-!on rajoute le calcul de lmix_bis
-            if (zqla(ig,l).lt.1.e-10) then
-               lmix_bis(ig)=l+1
-            endif
-            lmix(ig)=l+1
-            wmaxa(ig)=wa_moy(ig,l+1)
-        endif
-   enddo
-
-   if (nbpb>0) then
-   print*,'WARNING on tombe ',nbpb,' x sur un pb pour l=',l,' dans thermcell_plume'
-   endif
-
-!=========================================================================
-! FIN DE LA BOUCLE VERTICALE
-      enddo
-!=========================================================================
-
-!on recalcule alim_star_tot
-       do ig=1,ngrid
-          alim_star_tot(ig)=0.
-       enddo
-       do ig=1,ngrid
-          do l=1,lalim(ig)-1
-          alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
-          enddo
-       enddo
-       
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
-
-#undef wrgrads_thermcell
-#ifdef wrgrads_thermcell
-         call wrgradsfi(1,nlay,entr_star(igout,1:nlay),'esta      ','esta      ')
-         call wrgradsfi(1,nlay,detr_star(igout,1:nlay),'dsta      ','dsta      ')
-         call wrgradsfi(1,nlay,zbuoy(igout,1:nlay),'buoy      ','buoy      ')
-         call wrgradsfi(1,nlay,zdqt(igout,1:nlay),'dqt      ','dqt      ')
-         call wrgradsfi(1,nlay,w_est(igout,1:nlay),'w_est     ','w_est     ')
-         call wrgradsfi(1,nlay,w_est(igout,2:nlay+1),'w_es2     ','w_es2     ')
-         call wrgradsfi(1,nlay,zw2(igout,1:nlay),'zw2A      ','zw2A      ')
-#endif
-
-
- RETURN
-     end
-
-
-
-
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- SUBROUTINE thermcell_plume_5B(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
-&           zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
-&           lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
-&           ztla,zqla,zqta,zha,zw2,w_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
-&           ,lev_out,lunout1,igout)
-!&           ,lev_out,lunout1,igout,zbuoy,zbuoyjam)
-
-!--------------------------------------------------------------------------
-!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
-! Version conforme a l'article de Rio et al. 2010.
-! Code ecrit par Catherine Rio, Arnaud Jam et Frederic Hourdin
-!--------------------------------------------------------------------------
-
-      USE thermcell_ini_mod, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
-      IMPLICIT NONE
-
-      INTEGER itap
-      INTEGER lunout1,igout
-      INTEGER ngrid,nlay
-      REAL ptimestep
-      REAL ztv(ngrid,nlay)
-      REAL zthl(ngrid,nlay)
-      REAL po(ngrid,nlay)
-      REAL zl(ngrid,nlay)
-      REAL rhobarz(ngrid,nlay)
-      REAL zlev(ngrid,nlay+1)
-      REAL pplev(ngrid,nlay+1)
-      REAL pphi(ngrid,nlay)
-      REAL zpspsk(ngrid,nlay)
-      REAL alim_star(ngrid,nlay)
-      REAL f0(ngrid)
-      INTEGER lalim(ngrid)
-      integer lev_out                           ! niveau pour les print
-      integer nbpb
-    
-      real alim_star_tot(ngrid)
-
-      REAL ztva(ngrid,nlay)
-      REAL ztla(ngrid,nlay)
-      REAL zqla(ngrid,nlay)
-      REAL zqta(ngrid,nlay)
-      REAL zha(ngrid,nlay)
-
-      REAL detr_star(ngrid,nlay)
-      REAL coefc
-      REAL entr_star(ngrid,nlay)
-      REAL detr(ngrid,nlay)
-      REAL entr(ngrid,nlay)
-
-      REAL csc(ngrid,nlay)
-
-      REAL zw2(ngrid,nlay+1)
-      REAL w_est(ngrid,nlay+1)
-      REAL f_star(ngrid,nlay+1)
-      REAL wa_moy(ngrid,nlay+1)
-
-      REAL ztva_est(ngrid,nlay)
-      REAL zqla_est(ngrid,nlay)
-      REAL zqsatth(ngrid,nlay)
-      REAL zta_est(ngrid,nlay)
-      REAL zbuoyjam(ngrid,nlay)
-      REAL ztemp(ngrid),zqsat(ngrid)
-      REAL zdw2
-      REAL zw2modif
-      REAL zw2fact
-      REAL zeps(ngrid,nlay)
-
-      REAL linter(ngrid)
-      INTEGER lmix(ngrid)
-      INTEGER lmix_bis(ngrid)
-      REAL    wmaxa(ngrid)
-
-      INTEGER ig,l,k
-
-      real zdz,zbuoy(ngrid,nlay),zalpha,gamma(ngrid,nlay),zdqt(ngrid,nlay),zw2m
-      real zbuoybis
-      real zcor,zdelta,zcvm5,qlbef,zdz2
-      real betalpha,zbetalpha
-      real eps, afact
-      logical Zsat
-      LOGICAL active(ngrid),activetmp(ngrid)
-      REAL fact_gamma,fact_epsilon,fact_gamma2,fact_epsilon2
-      REAL c2(ngrid,nlay)
-      Zsat=.false.
-! Initialisation
-
-      fact_epsilon=0.002
-      betalpha=0.9 
-      afact=2./3.            
-
-      zbetalpha=betalpha/(1.+betalpha)
-
-
-! Initialisations des variables reeles
-if (1==1) then
-      ztva(:,:)=ztv(:,:)
-      ztva_est(:,:)=ztva(:,:)
-      ztla(:,:)=zthl(:,:)
-      zqta(:,:)=po(:,:)
-      zha(:,:) = ztva(:,:)
-else
-      ztva(:,:)=0.
-      ztva_est(:,:)=0.
-      ztla(:,:)=0.
-      zqta(:,:)=0.
-      zha(:,:) =0.
-endif
-
-      zqla_est(:,:)=0.
-      zqsatth(:,:)=0.
-      zqla(:,:)=0.
-      detr_star(:,:)=0.
-      entr_star(:,:)=0.
-      alim_star(:,:)=0.
-      alim_star_tot(:)=0.
-      csc(:,:)=0.
-      detr(:,:)=0.
-      entr(:,:)=0.
-      zw2(:,:)=0.
-      zbuoy(:,:)=0.
-      zbuoyjam(:,:)=0.
-      gamma(:,:)=0.
-      zeps(:,:)=0.
-      w_est(:,:)=0.
-      f_star(:,:)=0.
-      wa_moy(:,:)=0.
-      linter(:)=1.
-!     linter(:)=1.
-! Initialisation des variables entieres
-      lmix(:)=1
-      lmix_bis(:)=2
-      wmaxa(:)=0.
-      lalim(:)=1
-
-
-!-------------------------------------------------------------------------
-! On ne considere comme actif que les colonnes dont les deux premieres
-! couches sont instables.
-!-------------------------------------------------------------------------
-      active(:)=ztv(:,1)>ztv(:,2)
-
-!-------------------------------------------------------------------------
-! Definition de l'alimentation
-!-------------------------------------------------------------------------
-      do l=1,nlay-1
-         do ig=1,ngrid
-            if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) then
-               alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
-     &                       *sqrt(zlev(ig,l+1)) 
-               lalim(ig)=l+1
-               alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
-            endif
-         enddo
-      enddo
-      do l=1,nlay
-         do ig=1,ngrid 
-            if (alim_star_tot(ig) > 1.e-10 ) then
-               alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
-            endif
-         enddo
-      enddo
-      alim_star_tot(:)=1.
-
-
-
-!------------------------------------------------------------------------------
-! Calcul dans la premiere couche
-! On decide dans cette version que le thermique n'est actif que si la premiere
-! couche est instable.
-! Pourrait etre change si on veut que le thermiques puisse se d??clencher
-! dans une couche l>1
-!------------------------------------------------------------------------------
-do ig=1,ngrid
-! Le panache va prendre au debut les caracteristiques de l'air contenu
-! dans cette couche.
-    if (active(ig)) then
-    ztla(ig,1)=zthl(ig,1) 
-    zqta(ig,1)=po(ig,1)
-    zqla(ig,1)=zl(ig,1)
-!cr: attention, prise en compte de f*(1)=1
-    f_star(ig,2)=alim_star(ig,1)
-    zw2(ig,2)=2.*RG*(ztv(ig,1)-ztv(ig,2))/ztv(ig,2)  &
-&                     *(zlev(ig,2)-zlev(ig,1))  &
-&                     *0.4*pphi(ig,1)/(pphi(ig,2)-pphi(ig,1))
-    w_est(ig,2)=zw2(ig,2)
-    endif
-enddo
-!
-
-!==============================================================================
-!boucle de calcul de la vitesse verticale dans le thermique
-!==============================================================================
-do l=2,nlay-1
-!==============================================================================
-
-
-! On decide si le thermique est encore actif ou non
-! AFaire : Il faut sans doute ajouter entr_star a alim_star dans ce test
-    do ig=1,ngrid
-       active(ig)=active(ig) &
-&                 .and. zw2(ig,l)>1.e-10 &
-&                 .and. f_star(ig,l)+alim_star(ig,l)>1.e-10
-    enddo
-
-
-
-!---------------------------------------------------------------------------
-! calcul des proprietes thermodynamiques et de la vitesse de la couche l
-! sans tenir compte du detrainement et de l'entrainement dans cette
-! couche
-! C'est a dire qu'on suppose 
-! ztla(l)=ztla(l-1) et zqta(l)=zqta(l-1)
-! Ici encore, on doit pouvoir ajouter entr_star (qui peut etre calculer
-! avant) a l'alimentation pour avoir un calcul plus propre
-!---------------------------------------------------------------------------
-
-   ztemp(:)=zpspsk(:,l)*ztla(:,l-1)
-   call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
-
-    do ig=1,ngrid 
-!       print*,'active',active(ig),ig,l
-        if(active(ig)) then 
-        zqla_est(ig,l)=max(0.,zqta(ig,l-1)-zqsat(ig))
-        ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l)
-        zta_est(ig,l)=ztva_est(ig,l)
-        ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l)
-        ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)  &
-     &      -zqla_est(ig,l))-zqla_est(ig,l))
-
-!------------------------------------------------
-!AJAM:nouveau calcul de w?  
-!------------------------------------------------
-              zdz=zlev(ig,l+1)-zlev(ig,l)
-              zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-
-              zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-              zdw2=(afact)*zbuoy(ig,l)/(fact_epsilon)
-              w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2)+zdw2)
- 
-
-             if (w_est(ig,l+1).lt.0.) then
-                w_est(ig,l+1)=zw2(ig,l)
-             endif
-       endif
-    enddo
-
-
-!-------------------------------------------------
-!calcul des taux d'entrainement et de detrainement
-!-------------------------------------------------
-
-     do ig=1,ngrid
-        if (active(ig)) then
-
-          zw2m=max(0.5*(w_est(ig,l)+w_est(ig,l+1)),0.1)
-          zw2m=w_est(ig,l+1)
-          zdz=zlev(ig,l+1)-zlev(ig,l)
-          zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
-!          zbuoybis=zbuoy(ig,l)+RG*0.1/300.
-          zbuoybis=zbuoy(ig,l)
-          zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l+1))/rhobarz(ig,l)
-          zdqt(ig,l)=max(zqta(ig,l-1)-po(ig,l),0.)/po(ig,l)
-
-          
-          entr_star(ig,l)=f_star(ig,l)*zdz*  zbetalpha*MAX(0.,  &
-    &     afact*zbuoybis/zw2m - fact_epsilon )
-
-
-          detr_star(ig,l)=f_star(ig,l)*zdz                        &
-    &     *MAX(1.e-3, -afact*zbetalpha*zbuoy(ig,l)/zw2m          &
-    &     + 0.012*(zdqt(ig,l)/zw2m)**0.5 )
-          
-! En dessous de lalim, on prend le max de alim_star et entr_star pour
-! alim_star et 0 sinon
-        if (l.lt.lalim(ig)) then
-          alim_star(ig,l)=max(alim_star(ig,l),entr_star(ig,l))
-          entr_star(ig,l)=0.
-        endif
-
-! Calcul du flux montant normalise
-      f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)  &
-     &              -detr_star(ig,l)
-
-      endif
-   enddo
-
-
-!----------------------------------------------------------------------------
-!calcul de la vitesse verticale en melangeant Tl et qt du thermique
-!---------------------------------------------------------------------------
-   activetmp(:)=active(:) .and. f_star(:,l+1)>1.e-10
-   do ig=1,ngrid
-       if (activetmp(ig)) then 
-           Zsat=.false.
-           ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+  &
-     &            (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l))  &
-     &            /(f_star(ig,l+1)+detr_star(ig,l))
-           zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+  &
-     &            (alim_star(ig,l)+entr_star(ig,l))*po(ig,l))  &
-     &            /(f_star(ig,l+1)+detr_star(ig,l))
-
-        endif
-    enddo
-
-   ztemp(:)=zpspsk(:,l)*ztla(:,l)
-   call thermcell_qsat(ngrid,activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
-
-   do ig=1,ngrid
-      if (activetmp(ig)) then
-! on ecrit de maniere conservative (sat ou non)
-!          T = Tl +Lv/Cp ql
-           zqla(ig,l)=max(0.,zqta(ig,l)-zqsatth(ig,l))
-           ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
-           ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
-!on rajoute le calcul de zha pour diagnostiques (temp potentielle)
-           zha(ig,l) = ztva(ig,l)
-           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)  &
-     &              -zqla(ig,l))-zqla(ig,l))
-           zbuoy(ig,l)=RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
-           zdz=zlev(ig,l+1)-zlev(ig,l)
-           zeps(ig,l)=(entr_star(ig,l)+alim_star(ig,l))/(f_star(ig,l)*zdz)
-
-            zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
-            zdw2=afact*zbuoy(ig,l)/(fact_epsilon)
-            zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2)+zdw2) 
-      endif
-   enddo
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l
-!
-!---------------------------------------------------------------------------
-!initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max 
-!---------------------------------------------------------------------------
-
-   nbpb=0
-   do ig=1,ngrid
-            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
-!               stop'On tombe sur le cas particulier de thermcell_dry'
-!               print*,'On tombe sur le cas particulier de thermcell_plume'
-                nbpb=nbpb+1
-                zw2(ig,l+1)=0.
-                linter(ig)=l+1
-            endif
-
-        if (zw2(ig,l+1).lt.0.) then 
-           linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
-     &               -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
-           zw2(ig,l+1)=0.
-        elseif (f_star(ig,l+1).lt.0.) then
-           linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
-     &               -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
-!           print*,"linter plume", linter(ig)
-           zw2(ig,l+1)=0.
-        endif
-
-           wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) 
-
-        if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
-!   lmix est le niveau de la couche ou w (wa_moy) est maximum
-!on rajoute le calcul de lmix_bis
-            if (zqla(ig,l).lt.1.e-10) then
-               lmix_bis(ig)=l+1
-            endif
-            lmix(ig)=l+1
-            wmaxa(ig)=wa_moy(ig,l+1)
-        endif
-   enddo
-
-   if (nbpb>0) then
-   print*,'WARNING on tombe ',nbpb,' x sur un pb pour l=',l,' dans thermcell_plume'
-   endif
-
-!=========================================================================
-! FIN DE LA BOUCLE VERTICALE
-      enddo
-!=========================================================================
-
-!on recalcule alim_star_tot
-       do ig=1,ngrid
-          alim_star_tot(ig)=0.
-       enddo
-       do ig=1,ngrid
-          do l=1,lalim(ig)-1
-          alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
-          enddo
-       enddo
-       
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
-
-#undef wrgrads_thermcell
-#ifdef wrgrads_thermcell
-         call wrgradsfi(1,nlay,entr_star(igout,1:nlay),'esta      ','esta      ')
-         call wrgradsfi(1,nlay,detr_star(igout,1:nlay),'dsta      ','dsta      ')
-         call wrgradsfi(1,nlay,zbuoy(igout,1:nlay),'buoy      ','buoy      ')
-         call wrgradsfi(1,nlay,zdqt(igout,1:nlay),'dqt      ','dqt      ')
-         call wrgradsfi(1,nlay,w_est(igout,1:nlay),'w_est     ','w_est     ')
-         call wrgradsfi(1,nlay,w_est(igout,2:nlay+1),'w_es2     ','w_es2     ')
-         call wrgradsfi(1,nlay,zw2(igout,1:nlay),'zw2A      ','zw2A      ')
-#endif
-
-
-     return 
-     end
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_qsat.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/thermcell_qsat.F90	(revision 4726)
+++ 	(revision )
@@ -1,95 +1,0 @@
-subroutine thermcell_qsat(klon,active,pplev,ztemp,zqta,zqsat)
-implicit none
-
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-
-
-!====================================================================
-! DECLARATIONS
-!====================================================================
-
-! Arguments
-INTEGER klon
-REAL zpspsk(klon),pplev(klon)
-REAL ztemp(klon),zqta(klon),zqsat(klon)
-LOGICAL active(klon)
-
-! Variables locales
-INTEGER ig,iter
-REAL Tbef(klon),DT(klon)
-REAL tdelta,qsatbef,zcor,qlbef,zdelta,zcvm5,dqsat,num,denom,dqsat_dT
-logical Zsat
-REAL RLvCp
-
-REAL, SAVE :: DDT0=.01
-!$OMP THREADPRIVATE(DDT0)
-
-LOGICAL afaire(klon),tout_converge
-
-!====================================================================
-! INITIALISATIONS
-!====================================================================
-
-RLvCp = RLVTT/RCPD
-tout_converge=.false.
-afaire(:)=.false.
-DT(:)=0.
-
-
-!====================================================================
-! Routine a vectoriser en copiant active dans converge et en mettant
-! la boucle sur les iterations a l'exterieur est en mettant
-! converge= false des que la convergence est atteinte.
-!====================================================================
-
-do ig=1,klon
-   if (active(ig)) then
-               Tbef(ig)=ztemp(ig)
-               zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
-               qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig)
-               qsatbef=MIN(0.5,qsatbef)
-               zcor=1./(1.-retv*qsatbef)
-               qsatbef=qsatbef*zcor
-               qlbef=max(0.,zqta(ig)-qsatbef)
-               DT(ig) = 0.5*RLvCp*qlbef
-               zqsat(ig)=qsatbef
-     endif
-enddo
-
-! Traitement du cas ou il y a condensation mais faible
-! On ne condense pas mais on dit que le qsat est le qta
-do ig=1,klon
-   if (active(ig)) then
-      if (0.<abs(DT(ig)).and.abs(DT(ig))<=DDT0) then
-         zqsat(ig)=zqta(ig)
-      endif
-   endif
-enddo
-
-do iter=1,10
-    afaire(:)=abs(DT(:)).gt.DDT0
-    do ig=1,klon
-               if (afaire(ig)) then
-                 Tbef(ig)=Tbef(ig)+DT(ig)
-                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
-                 qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig)
-                 qsatbef=MIN(0.5,qsatbef)
-                 zcor=1./(1.-retv*qsatbef)
-                 qsatbef=qsatbef*zcor
-                 qlbef=zqta(ig)-qsatbef
-                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
-                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
-                 zcor=1./(1.-retv*qsatbef)
-                 dqsat_dT=FOEDE(Tbef(ig),zdelta,zcvm5,qsatbef,zcor)
-                 num=-Tbef(ig)+ztemp(ig)+RLvCp*qlbef
-                 denom=1.+RLvCp*dqsat_dT
-                 zqsat(ig) = qsatbef
-                 DT(ig)=num/denom
-               endif
-    enddo
-enddo
-
-return
-end
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/tracinca_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/tracinca_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/tracinca_mod.F90	(revision 4727)
@@ -30,9 +30,9 @@
 
     !--- COHERENCE TEST BETWEEN "type_trac" AND "config_inca"
-    IF(ANY(type_trac == ['inca','inco']) .AND. ALL(config_inca /= ['aero','aeNP','chem'])) CALL abort_gcm('tracinca_init', &
+    IF(ANY(type_trac == ['inca','inco']) .AND. ALL(config_inca /= ['aero','aeNP','chem'])) CALL abort_physic('tracinca_init', &
        'INCA enabled, but unknown config_inca = "'//TRIM(config_inca)//'". Please modify "run.def"', 1)
 
     !--- PROBLEM IF "config_inca" DIFFERS FROM "none" AND INCA HAS NOT BEEN ACTIVATED
-    IF(ALL(type_trac /= ['inca','inco'])  .AND.    config_inca /= 'none')                  CALL abort_gcm('tracinca_init', &
+    IF(ALL(type_trac /= ['inca','inco'])  .AND.    config_inca /= 'none')                  CALL abort_physic('tracinca_init', &
        'INCA disabled, but config_inca = "'//TRIM(config_inca)//'" should be "none". Please modify "run.def"', 1)
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/tracreprobus_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/tracreprobus_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/tracreprobus_mod.F90	(revision 4727)
@@ -94,4 +94,5 @@
             t_seri,  & !argument phytrac (meme nom)
             pplay,   & !argument phytrac (meme nom)
+            paprs,   &
             pphi,    & !argument phytrac (meme nom)
             pphis,   & !argument phytrac (meme nom)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/undefSTD.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/undefSTD.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/undefSTD.F90	(revision 4727)
@@ -8,13 +8,9 @@
   USE phys_state_var_mod
 #endif
-#ifdef CPP_XIOS
-  USE wxios, ONLY: missing_val
-#endif
+  USE wxios, ONLY: missing_val_xios => missing_val, using_xios
 
   IMPLICIT NONE
   include "clesphys.h"
-#ifndef CPP_XIOS 
   REAL :: missing_val
-#endif
 
   ! ====================================================================
@@ -37,5 +33,5 @@
   ! ====================================================================
 
-  ! ym#include "dimphy.h"
+  ! ymINCLUDE "dimphy.h"
   ! variables Input
 
@@ -59,7 +55,9 @@
 
 ! missing_val = nf90_fill_real
-#ifndef CPP_XIOS
+  IF (using_xios) THEN
+    missing_val=missing_val_xios
+  ELSE
       missing_val=missing_val_nf90
-#endif
+  ENDIF
 
   DO n = 1, nout
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ustarhb.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ustarhb.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ustarhb.F90	(revision 4727)
@@ -2,6 +2,5 @@
 ! $Header$
 
-SUBROUTINE ustarhb(knon, u, v, cd_m, ustar)
-  USE dimphy
+SUBROUTINE ustarhb(klon, klev, knon, u, v, cd_m, ustar)
   IMPLICIT NONE
   ! ======================================================================
@@ -18,23 +17,16 @@
   ! model. J. of Climate, vol. 6, 1825-1842.
   ! ======================================================================
-  include "YOMCST.h"
 
   ! Arguments:
 
-  INTEGER knon ! nombre de points a calculer
-  REAL u(klon, klev) ! vitesse U (m/s)
-  REAL v(klon, klev) ! vitesse V (m/s)
-  REAL cd_m(klon) ! coefficient de friction au sol pour vitesse
-  REAL ustar(klon)
+  INTEGER, INTENT(IN) :: klon, klev, knon ! nombre de points a calculer
+  REAL, DIMENSION(klon, klev), INTENT(IN) :: u,v ! vent horizontal (m/s)
+  REAL, DIMENSION(klon), INTENT(IN) :: cd_m ! coefficient de friction au sol pour vitesse
+  REAL, DIMENSION(klon), INTENT(OUT) :: ustar
 
-  INTEGER i, k
-  REAL zxt, zxq, zxu, zxv, zxmod, taux, tauy
-  REAL zx_alf1, zx_alf2 ! parametres pour extrapolation
-  LOGICAL unssrf(klon) ! unstb pbl w/lvls within srf pbl lyr
-  LOGICAL unsout(klon) ! unstb pbl w/lvls in outer pbl lyr
-  LOGICAL check(klon) ! True=>chk if Richardson no.>critcal
+  INTEGER :: i, k
+  REAL :: zxt, zxq, zxu, zxv, zxmod, taux, tauy
+  REAL :: zx_alf1, zx_alf2 ! parametres pour extrapolation
 
-  include "YOETHF.h"
-  include "FCTTRE.h"
   DO i = 1, knon
     zx_alf1 = 1.0
@@ -46,5 +38,4 @@
     tauy = zxv*zxmod*cd_m(i)
     ustar(i) = sqrt(taux**2+tauy**2)
-    ! print*,'Ust ',zxu,zxmod,taux,ustar(i)
   END DO
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/vdif_kcay.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/vdif_kcay.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/vdif_kcay.F90	(revision 4727)
@@ -2,7 +2,7 @@
 ! $Header$
 
-SUBROUTINE vdif_kcay(ngrid, dt, g, rconst, plev, temp, zlev, zlay, u, v, &
+SUBROUTINE vdif_kcay(klon,klev,ngrid,dt, g, rconst, plev, temp, zlev, zlay, u, v, &
     teta, cd, q2, q2diag, km, kn, ustar, l_mix)
-  USE dimphy
+
   IMPLICIT NONE
 
@@ -28,20 +28,26 @@
 
   ! .......................................................................
-  REAL dt, g, rconst
-  REAL plev(klon, klev+1), temp(klon, klev)
-  REAL ustar(klon), snstable
-  REAL zlev(klon, klev+1)
-  REAL zlay(klon, klev)
-  REAL u(klon, klev)
-  REAL v(klon, klev)
-  REAL teta(klon, klev)
-  REAL cd(klon)
-  REAL q2(klon, klev+1), q2s(klon, klev+1)
-  REAL q2diag(klon, klev+1)
-  REAL km(klon, klev+1)
-  REAL kn(klon, klev+1)
-  REAL sq(klon), sqz(klon), zz(klon, klev+1), zq, long0(klon)
-
-  INTEGER l_mix, iii
+  INTEGER, INTENT(IN) :: klon,klev,ngrid
+  REAL,INTENT(IN) :: dt, g, rconst
+  REAL,DIMENSION(klon,klev+1),INTENT(IN) :: plev
+  REAL,DIMENSION(klon,klev),INTENT(IN) :: temp
+  REAL,DIMENSION(klon),INTENT(IN) :: ustar
+  REAL,DIMENSION(klon,klev+1),INTENT(INOUT) :: zlev
+  REAL,DIMENSION(klon,klev),INTENT(IN) :: zlay
+  REAL,DIMENSION(klon,klev),INTENT(IN) :: u
+  REAL,DIMENSION(klon,klev),INTENT(IN) :: v
+  REAL,DIMENSION(klon,klev),INTENT(IN) :: teta
+  REAL,DIMENSION(klon),INTENT(IN) :: cd
+  REAL,DIMENSION(klon,klev+1),INTENT(INOUT) :: q2
+  REAL,DIMENSION(klon,klev+1),INTENT(OUT) :: q2diag
+  REAL,DIMENSION(klon,klev+1),INTENT(OUT) :: km
+  REAL,DIMENSION(klon,klev+1),INTENT(OUT) :: kn
+  INTEGER, INTENT(OUT) :: l_mix
+
+  REAL,DIMENSION(klon) :: sq, sqz, long0
+  REAL,DIMENSION(klon,klev+1) :: q2s,zz
+  REAL :: snstable,zq
+
+  INTEGER :: iii
   ! .......................................................................
 
@@ -56,8 +62,7 @@
 
   ! .......................................................................
-  INTEGER nlay, nlev, ngrid
-  REAL unsdz(klon, klev)
-  REAL unsdzdec(klon, klev+1)
-  REAL q(klon, klev+1)
+  INTEGER :: nlay, nlev
+  REAL, DIMENSION(klon,klev) :: unsdz
+  REAL, DIMENSION(klon, klev+1) :: unsdzdec,q
 
   ! .......................................................................
@@ -70,8 +75,8 @@
 
   ! .......................................................................
-  REAL kmpre(klon, klev+1)
-  REAL qcstat
-  REAL q2cstat
-  REAL sss, sssq
+  REAL, DIMENSION(klon, klev+1) :: kmpre
+  REAL :: qcstat
+  REAL :: q2cstat
+  REAL :: sss, sssq
   ! .......................................................................
 
@@ -79,5 +84,5 @@
 
   ! .......................................................................
-  REAL long(klon, klev+1)
+  REAL, DIMENSION(klon, klev+1) :: long
   ! .......................................................................
 
@@ -97,13 +102,10 @@
 
   ! .......................................................................
-  REAL kmq3
-  REAL kmcstat
-  REAL knq3
-  REAL mcstat
-  REAL m2cstat
-  REAL m(klon, klev+1)
-  REAL mpre(klon, klev+1)
-  REAL m2(klon, klev+1)
-  REAL n2(klon, klev+1)
+  REAL :: kmq3
+  REAL :: kmcstat
+  REAL :: knq3
+  REAL :: mcstat
+  REAL :: m2cstat
+  REAL, DIMENSION(klon, klev+1) :: m,mpre,m2,n2
   ! .......................................................................
 
@@ -121,15 +123,10 @@
 
   ! .......................................................................
-  REAL gn
-  REAL gnmin
-  REAL gnmax
-  LOGICAL gninf
-  LOGICAL gnsup
-  REAL gm
-  ! REAL ri(klon,klev+1)
-  REAL sn(klon, klev+1)
-  REAL snq2(klon, klev+1)
-  REAL sm(klon, klev+1)
-  REAL smq2(klon, klev+1)
+  REAL :: gn,gm
+  REAL :: gnmin
+  REAL :: gnmax
+  LOGICAL :: gninf
+  LOGICAL :: gnsup
+  REAL, DIMENSION(klon, klev+1) :: sn, snq2, sm, smq2
   ! .......................................................................
 
@@ -142,9 +139,9 @@
 
   ! .......................................................................
-  REAL kappa
-  REAL long00
-  REAL a1, a2, b1, b2, c1
-  REAL cn1, cn2
-  REAL cm1, cm2, cm3, cm4
+  REAL :: kappa
+  REAL :: long00
+  REAL :: a1, a2, b1, b2, c1
+  REAL :: cn1, cn2
+  REAL :: cm1, cm2, cm3, cm4
   ! .......................................................................
 
@@ -155,8 +152,8 @@
 
   ! .......................................................................
-  REAL termq
-  REAL termq3
-  REAL termqm2
-  REAL termq3m2
+  REAL :: termq
+  REAL :: termq3
+  REAL :: termqm2
+  REAL :: termq3m2
   ! .......................................................................
 
@@ -165,15 +162,15 @@
 
   ! .......................................................................
-  REAL q2min
-  REAL q2max
+  REAL :: q2min
+  REAL :: q2max
   ! .......................................................................
   ! knmin : borne inferieure de kn
   ! kmmin : borne inferieure de km
   ! .......................................................................
-  REAL knmin
-  REAL kmmin
-  ! .......................................................................
-  INTEGER ilay, ilev, igrid
-  REAL tmp1, tmp2
+  REAL :: knmin
+  REAL :: kmmin
+  ! .......................................................................
+  INTEGER :: ilay, ilev, igrid
+  REAL :: tmp1, tmp2
   ! .......................................................................
   PARAMETER (kappa=0.4E+0)
@@ -202,8 +199,8 @@
   PARAMETER (cm4=-9.E+0*a1*a2)
 
-  LOGICAL first
-  SAVE first
-  DATA first/.TRUE./
-  !$OMP THREADPRIVATE(first)
+  LOGICAL :: first
+!  SAVE first
+!  DATA first/.TRUE./
+!  !$OMP THREADPRIVATE(first)
   ! .......................................................................
   ! traitment des valeur de q2 en entree
@@ -214,12 +211,14 @@
   nlev = klev + 1
 
-  CALL yamada(ngrid, dt, g, rconst, plev, temp, zlev, zlay, u, v, teta, cd, &
-    q2diag, km, kn, ustar, l_mix)
-  IF (first .AND. 1==1) THEN
-    first = .FALSE.
-    q2 = q2diag
-  END IF
-
-  DO ilev = 1, nlev
+! Initialisation avec un schema d'equilibre
+! CALL yamada(ngrid, dt, g, rconst, plev, temp, zlev, zlay, u, v, teta, cd, &
+!   q2diag, km, kn, ustar, l_mix)
+! IF (first .AND. 1==1) THEN
+!   first = .FALSE.
+!   q2 = q2diag
+! END IF
+q2diag=0.
+
+  DO ilev = 2, nlay
     DO igrid = 1, ngrid
       q2(igrid, ilev) = amax1(q2(igrid,ilev), q2min)
@@ -360,6 +359,4 @@
       gninf = .FALSE.
       gnsup = .FALSE.
-      long(igrid, ilev) = long(igrid, ilev)
-      long(igrid, ilev) = long(igrid, ilev)
 
       IF (gn<gnmin) THEN
@@ -591,4 +588,7 @@
   IF (1==1) THEN
 
+    sss=0.
+    sssq=0.
+    ! WARNING : travail sur le point ig=1 ????
     DO ilev = 2, klev - 1
       sss = sss + plev(1, ilev-1) - plev(1, ilev+1)
@@ -624,5 +624,5 @@
 
 
-    DO ilev = 1, nlev
+    DO ilev = 2, klev-1
       DO igrid = 1, ngrid
         q2(igrid, ilev) = max(q2(igrid,ilev), q2min)
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/wake.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/wake.F90	(revision 4726)
+++ 	(revision )
@@ -1,2667 +1,0 @@
-
-! $Id$
-
-
-SUBROUTINE wake(klon,klev,znatsurf, p, ph, pi, dtime, &
-                tenv0, qe0, omgb, &
-                dtdwn, dqdwn, amdwn, amup, dta, dqa, wgen, &
-                sigd_con, Cin, &
-                deltatw, deltaqw, sigmaw, awdens, wdens, &                  ! state variables           
-                dth, hw, wape, fip, gfl, &
-                dtls, dqls, ktopw, omgbdth, dp_omgb, tu, qu, &
-                dtke, dqke, omg, dp_deltomg, wkspread, cstar, &
-                d_deltat_gw, &                                                      ! tendencies
-                d_deltatw2, d_deltaqw2, d_sigmaw2, d_awdens2, d_wdens2)             ! tendencies
-
-
-  ! **************************************************************
-  ! *
-  ! WAKE                                                        *
-  ! retour a un Pupper fixe                                *
-  ! *
-  ! written by   :  GRANDPEIX Jean-Yves   09/03/2000            *
-  ! modified by :   ROEHRIG Romain        01/29/2007            *
-  ! **************************************************************
-
-
-  USE wake_ini_mod , ONLY : wake_ini
-  USE wake_ini_mod , ONLY : prt_level,epsim1,RG,RD
-  USE wake_ini_mod , ONLY : stark, wdens_ref, coefgw, alpk, wk_pupper
-  USE wake_ini_mod , ONLY : crep_upper, crep_sol, tau_cv, rzero, aa0, flag_wk_check_trgl
-  USE wake_ini_mod , ONLY : iflag_wk_act, iflag_wk_check_trgl, iflag_wk_pop_dyn, wdensmin
-  USE wake_ini_mod , ONLY : sigmad, hwmin, wapecut, cstart, sigmaw_max, dens_rate, epsilon_loc
-  USE wake_ini_mod , ONLY : iflag_wk_profile
-
-
-  IMPLICIT NONE
-  ! ============================================================================
-
-
-  ! But : Decrire le comportement des poches froides apparaissant dans les
-  ! grands systemes convectifs, et fournir l'energie disponible pour
-  ! le declenchement de nouvelles colonnes convectives.
-
-  ! State variables : 
-  ! deltatw    : temperature difference between wake and off-wake regions
-  ! deltaqw    : specific humidity difference between wake and off-wake regions
-  ! sigmaw     : fractional area covered by wakes.
-  ! wdens      : number of wakes per unit area
-
-  ! Variable de sortie :
-
-  ! wape : WAke Potential Energy
-  ! fip  : Front Incident Power (W/m2) - ALP
-  ! gfl  : Gust Front Length per unit area (m-1)
-  ! dtls : large scale temperature tendency due to wake
-  ! dqls : large scale humidity tendency due to wake
-  ! hw   : wake top hight (given by hw*deltatw(1)/2=wape)
-  ! dp_omgb : vertical gradient of large scale omega
-  ! awdens  : densite de poches actives
-  ! wdens   : densite de poches
-  ! omgbdth: flux of Delta_Theta transported by LS omega
-  ! dtKE   : differential heating (wake - unpertubed)
-  ! dqKE   : differential moistening (wake - unpertubed)
-  ! omg    : Delta_omg =vertical velocity diff. wake-undist. (Pa/s)
-  ! dp_deltomg  : vertical gradient of omg (s-1)
-  ! wkspread  : spreading term in d_t_wake and d_q_wake
-  ! deltatw     : updated temperature difference (T_w-T_u).
-  ! deltaqw     : updated humidity difference (q_w-q_u).
-  ! sigmaw      : updated wake fractional area.
-  ! d_deltat_gw : delta T tendency due to GW
-
-  ! Variables d'entree :
-
-  ! aire : aire de la maille
-  ! tenv0  : temperature dans l'environnement  (K)
-  ! qe0  : humidite dans l'environnement     (kg/kg)
-  ! omgb : vitesse verticale moyenne sur la maille (Pa/s)
-  ! dtdwn: source de chaleur due aux descentes (K/s)
-  ! dqdwn: source d'humidite due aux descentes (kg/kg/s)
-  ! dta  : source de chaleur due courants satures et detrain  (K/s)
-  ! dqa  : source d'humidite due aux courants satures et detra (kg/kg/s)
-  ! wgen : number of wakes generated per unit area and per sec (/m^2/s)
-  ! amdwn: flux de masse total des descentes, par unite de
-  !        surface de la maille (kg/m2/s)
-  ! amup : flux de masse total des ascendances, par unite de
-  !        surface de la maille (kg/m2/s)
-  ! sigd_con: 
-  ! Cin  : convective inhibition
-  ! p    : pressions aux milieux des couches (Pa)
-  ! ph   : pressions aux interfaces (Pa)
-  ! pi  : (p/p_0)**kapa (adim)
-  ! dtime: increment temporel (s)
-
-  ! Variables internes :
-
-  ! rhow : masse volumique de la poche froide
-  ! rho  : environment density at P levels
-  ! rhoh : environment density at Ph levels
-  ! tenv   : environment temperature | may change within
-  ! qe   : environment humidity    | sub-time-stepping
-  ! the  : environment potential temperature
-  ! thu  : potential temperature in undisturbed area
-  ! tu   :  temperature  in undisturbed area
-  ! qu   : humidity in undisturbed area
-  ! dp_omgb: vertical gradient og LS omega
-  ! omgbw  : wake average vertical omega
-  ! dp_omgbw: vertical gradient of omgbw
-  ! omgbdq : flux of Delta_q transported by LS omega
-  ! dth  : potential temperature diff. wake-undist.
-  ! th1  : first pot. temp. for vertical advection (=thu)
-  ! th2  : second pot. temp. for vertical advection (=thw)
-  ! q1   : first humidity for vertical advection
-  ! q2   : second humidity for vertical advection
-  ! d_deltatw   : terme de redistribution pour deltatw
-  ! d_deltaqw   : terme de redistribution pour deltaqw
-  ! deltatw0   : deltatw initial
-  ! deltaqw0   : deltaqw initial
-  ! hw0    : wake top hight (defined as the altitude at which deltatw=0)
-  ! amflux : horizontal mass flux through wake boundary
-  ! wdens_ref: initial number of wakes per unit area (3D) or per
-  ! unit length (2D), at the beginning of each time step
-  ! Tgw    : 1 sur la periode de onde de gravite
-  ! Cgw    : vitesse de propagation de onde de gravite
-  ! LL     : distance entre 2 poches
-
-  ! -------------------------------------------------------------------------
-  ! Declaration de variables
-  ! -------------------------------------------------------------------------
-
-
-  ! Arguments en entree
-  ! --------------------
-
-  INTEGER, INTENT(IN) :: klon,klev
-  INTEGER, DIMENSION (klon),        INTENT(IN)          :: znatsurf
-  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: p, pi
-  REAL, DIMENSION (klon, klev+1),   INTENT(IN)          :: ph
-  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: omgb
-  REAL,                             INTENT(IN)          :: dtime
-  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: tenv0, qe0
-  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: dtdwn, dqdwn
-  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: amdwn, amup
-  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: dta, dqa
-  REAL, DIMENSION (klon),           INTENT(IN)          :: wgen
-  REAL, DIMENSION (klon),           INTENT(IN)          :: sigd_con
-  REAL, DIMENSION (klon),           INTENT(IN)          :: Cin
-
-  !
-  ! Input/Output
-  ! State variables
-  REAL, DIMENSION (klon, klev),     INTENT(INOUT)       :: deltatw, deltaqw
-  REAL, DIMENSION (klon),           INTENT(INOUT)       :: sigmaw
-  REAL, DIMENSION (klon),           INTENT(INOUT)       :: awdens
-  REAL, DIMENSION (klon),           INTENT(INOUT)       :: wdens
-
-  ! Sorties
-  ! --------
-
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dth
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: tu, qu
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dtls, dqls
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dtke, dqke
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: wkspread    !  unused (jyg)
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: omgbdth, omg
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dp_omgb, dp_deltomg
-  REAL, DIMENSION (klon),           INTENT(OUT)         :: hw, wape, fip, gfl, cstar
-  INTEGER, DIMENSION (klon),        INTENT(OUT)         :: ktopw
-  ! Tendencies of state variables (2 is appended to the names of fields which are the cumul of fields 
-  !                                 computed at each sub-timestep; e.g. d_wdens2 is the cumul of d_wdens)
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: d_deltat_gw
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: d_deltatw2, d_deltaqw2
-  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_sigmaw2, d_awdens2, d_wdens2
-
-  ! Variables internes
-  ! -------------------
-
-  ! Variables a fixer
-
-  REAL                                                  :: delta_t_min
-  INTEGER                                               :: nsub
-  REAL                                                  :: dtimesub
-  REAL                                                  :: wdens0
-  ! IM 080208
-  LOGICAL, DIMENSION (klon)                             :: gwake
-
-  ! Variables de sauvegarde
-  REAL, DIMENSION (klon, klev)                          :: deltatw0
-  REAL, DIMENSION (klon, klev)                          :: deltaqw0
-  REAL, DIMENSION (klon, klev)                          :: tenv, qe
-!!  REAL, DIMENSION (klon)                                :: sigmaw1
-
-  ! Variables liees a la dynamique de population 1
-  REAL, DIMENSION(klon)                                 :: act
-  REAL, DIMENSION(klon)                                 :: rad_wk, tau_wk_inv
-  REAL, DIMENSION(klon)                                 :: f_shear
-  REAL, DIMENSION(klon)                                 :: drdt
-  
-  ! Variables liees a la dynamique de population 2
-  REAL, DIMENSION(klon)                                 :: cont_fact  
-  
-!!  REAL, DIMENSION(klon)                                 :: d_sig_gen, d_sig_death, d_sig_col
-  REAL, DIMENSION(klon)                                 :: wape1_act, wape2_act
-  LOGICAL, DIMENSION (klon)                             :: kill_wake
-  REAL                                                  :: drdt_pos
-  REAL                                                  :: tau_wk_inv_min
-  ! Some components of the tendencies of state variables  
-  REAL, DIMENSION (klon)                                :: d_sig_gen2, d_sig_death2, d_sig_col2, d_sig_spread2, d_sig_bnd2
-  REAL, DIMENSION (klon)                                :: d_dens_gen2, d_dens_death2, d_dens_col2, d_dens_bnd2
-  REAL, DIMENSION (klon)                                :: d_adens_death2, d_adens_icol2, d_adens_acol2, d_adens_bnd2
-
-  ! Variables pour les GW
-  REAL, DIMENSION (klon)                                :: ll
-  REAL, DIMENSION (klon, klev)                          :: n2
-  REAL, DIMENSION (klon, klev)                          :: cgw
-  REAL, DIMENSION (klon, klev)                          :: tgw
-
-  ! Variables liees au calcul de hw
-  REAL, DIMENSION (klon)                                :: ptop_provis, ptop, ptop_new
-  REAL, DIMENSION (klon)                                :: sum_dth
-  REAL, DIMENSION (klon)                                :: dthmin
-  REAL, DIMENSION (klon)                                :: z, dz, hw0
-  INTEGER, DIMENSION (klon)                             :: ktop, kupper
-
-  ! Variables liees au test de la forme triangulaire du profil de Delta_theta
-  REAL, DIMENSION (klon)                                :: sum_half_dth
-  REAL, DIMENSION (klon)                                :: dz_half
-
-  ! Sub-timestep tendencies and related variables
-  REAL, DIMENSION (klon, klev)                          :: d_deltatw, d_deltaqw
-  REAL, DIMENSION (klon, klev)                          :: d_tenv, d_qe
-  REAL, DIMENSION (klon)                                :: d_awdens, d_wdens, d_sigmaw 
-  REAL, DIMENSION (klon)                                :: d_sig_gen, d_sig_death, d_sig_col, d_sig_spread, d_sig_bnd
-  REAL, DIMENSION (klon)                                :: d_dens_gen, d_dens_death, d_dens_col, d_dens_bnd
-  REAL, DIMENSION (klon)                                :: d_adens_death, d_adens_icol, d_adens_acol, d_adens_bnd
-  REAL, DIMENSION (klon)                                :: alpha, alpha_tot
-  REAL, DIMENSION (klon)                                :: q0_min, q1_min
-  LOGICAL, DIMENSION (klon)                             :: wk_adv, ok_qx_qw
-
-  ! Autres variables internes
-  INTEGER                                               ::isubstep, k, i, igout
-
-  REAL                                                  :: sigmaw_targ
-  REAL                                                  :: wdens_targ
-  REAL                                                  :: d_sigmaw_targ
-  REAL                                                  :: d_wdens_targ
-
-  REAL, DIMENSION (klon)                                :: sum_thu, sum_tu, sum_qu, sum_thvu
-  REAL, DIMENSION (klon)                                :: sum_dq, sum_rho
-  REAL, DIMENSION (klon)                                :: sum_dtdwn, sum_dqdwn
-  REAL, DIMENSION (klon)                                :: av_thu, av_tu, av_qu, av_thvu
-  REAL, DIMENSION (klon)                                :: av_dth, av_dq, av_rho
-  REAL, DIMENSION (klon)                                :: av_dtdwn, av_dqdwn
-
-  REAL, DIMENSION (klon, klev)                          :: rho, rhow
-  REAL, DIMENSION (klon, klev+1)                        :: rhoh
-  REAL, DIMENSION (klon, klev)                          :: rhow_moyen
-  REAL, DIMENSION (klon, klev)                          :: zh
-  REAL, DIMENSION (klon, klev+1)                        :: zhh
-  REAL, DIMENSION (klon, klev)                          :: epaisseur1, epaisseur2
-
-  REAL, DIMENSION (klon, klev)                          :: the, thu
-
-  REAL, DIMENSION (klon, klev)                          :: omgbw
-  REAL, DIMENSION (klon)                                :: pupper
-  REAL, DIMENSION (klon)                                :: omgtop
-  REAL, DIMENSION (klon, klev)                          :: dp_omgbw
-  REAL, DIMENSION (klon)                                :: ztop, dztop
-  REAL, DIMENSION (klon, klev)                          :: alpha_up
-
-  REAL, DIMENSION (klon)                                :: rre1, rre2
-  REAL                                                  :: rrd1, rrd2
-  REAL, DIMENSION (klon, klev)                          :: th1, th2, q1, q2
-  REAL, DIMENSION (klon, klev)                          :: d_th1, d_th2, d_dth
-  REAL, DIMENSION (klon, klev)                          :: d_q1, d_q2, d_dq
-  REAL, DIMENSION (klon, klev)                          :: omgbdq
-
-  REAL, DIMENSION (klon)                                :: ff, gg
-  REAL, DIMENSION (klon)                                :: wape2, cstar2, heff
-                                                        
-  REAL, DIMENSION (klon, klev)                          :: crep
-                                                        
-  REAL, DIMENSION (klon, klev)                          :: ppi
-
-  ! cc nrlmd
-  REAL, DIMENSION (klon)                                :: death_rate
-!!  REAL, DIMENSION (klon)                                :: nat_rate
-  REAL, DIMENSION (klon, klev)                          :: entr
-  REAL, DIMENSION (klon, klev)                          :: detr
-
-  REAL, DIMENSION(klon)                                 :: sigmaw_in             ! pour les prints
-  REAL, DIMENSION(klon)                                 :: awdens_in, wdens_in   ! pour les prints
-
-  ! -------------------------------------------------------------------------
-  ! Initialisations
-  ! -------------------------------------------------------------------------
-  ! ALON = 3.e5
-  ! alon = 1.E6
-
-  !  Provisionnal; to be suppressed when f_shear is parameterized
-  f_shear(:) = 1.       ! 0. for strong shear, 1. for weak shear
-
-
-  ! Configuration de coefgw,stark,wdens (22/02/06 by YU Jingmei)
-
-  ! coefgw : Coefficient pour les ondes de gravite
-  ! stark : Coefficient k dans Cstar=k*sqrt(2*WAPE)
-  ! wdens : Densite surfacique de poche froide
-  ! -------------------------------------------------------------------------
-
-  ! cc nrlmd      coefgw=10
-  ! coefgw=1
-  ! wdens0 = 1.0/(alon**2)
-  ! cc nrlmd      wdens = 1.0/(alon**2)
-  ! cc nrlmd      stark = 0.50
-  ! CRtest
-  ! cc nrlmd      alpk=0.1
-  ! alpk = 1.0
-  ! alpk = 0.5
-  ! alpk = 0.05
-!print *,'XXXX dtime input ', dtime
- igout = klon/2+1/klon
-
- IF (iflag_wk_pop_dyn == 0) THEN
-  ! Initialisation de toutes des densites a wdens_ref.
-  ! Les densites peuvent evoluer si les poches debordent
-  ! (voir au tout debut de la boucle sur les substeps)
-  !jyg<
-  !!  wdens(:) = wdens_ref
-   DO i = 1,klon
-     wdens(i) = wdens_ref(znatsurf(i)+1)
-   ENDDO 
-  !>jyg
- ENDIF  ! (iflag_wk_pop_dyn == 0)
-
-  ! print*,'stark',stark
-  ! print*,'alpk',alpk
-  ! print*,'wdens',wdens
-  ! print*,'coefgw',coefgw
-  ! cc
-  ! Minimum value for |T_wake - T_undist|. Used for wake top definition
-  ! -------------------------------------------------------------------------
-
-  delta_t_min = 0.2
-
-  ! 1. - Save initial values, initialize tendencies, initialize output fields
-  ! ------------------------------------------------------------------------
-
-!jyg<
-!!  DO k = 1, klev
-!!    DO i = 1, klon
-!!      ppi(i, k) = pi(i, k)
-!!      deltatw0(i, k) = deltatw(i, k)
-!!      deltaqw0(i, k) = deltaqw(i, k)
-!!      tenv(i, k) = tenv0(i, k)
-!!      qe(i, k) = qe0(i, k)
-!!      dtls(i, k) = 0.
-!!      dqls(i, k) = 0.
-!!      d_deltat_gw(i, k) = 0.
-!!      d_tenv(i, k) = 0.
-!!      d_qe(i, k) = 0.
-!!      d_deltatw(i, k) = 0.
-!!      d_deltaqw(i, k) = 0.
-!!      ! IM 060508 beg
-!!      d_deltatw2(i, k) = 0.
-!!      d_deltaqw2(i, k) = 0.
-!!      ! IM 060508 end
-!!    END DO
-!!  END DO
-      ppi(:,:) = pi(:,:)
-      deltatw0(:,:) = deltatw(:,:)
-      deltaqw0(:,:) = deltaqw(:,:)
-      tenv(:,:) = tenv0(:,:)
-      qe(:,:) = qe0(:,:)
-      dtls(:,:) = 0.
-      dqls(:,:) = 0.
-      d_deltat_gw(:,:) = 0.
-      d_tenv(:,:) = 0.
-      d_qe(:,:) = 0.
-      d_deltatw(:,:) = 0.
-      d_deltaqw(:,:) = 0.
-      d_deltatw2(:,:) = 0.
-      d_deltaqw2(:,:) = 0.
-
-      IF (iflag_wk_act == 0) THEN
-        act(:) = 0.
-      ELSEIF (iflag_wk_act == 1) THEN
-        act(:) = 1.
-      ENDIF
-
-!!  DO i = 1, klon
-!!   sigmaw_in(i) = sigmaw(i)
-!!  END DO
-   sigmaw_in(:) = sigmaw(:)
-!>jyg
-!
-  IF (iflag_wk_pop_dyn >= 1) THEN
-    awdens_in(:) = awdens(:)
-    wdens_in(:) = wdens(:)
-!!    wdens(:) = wdens(:) + wgen(:)*dtime
-!!    d_wdens2(:) = wgen(:)*dtime
-!!  ELSE
-  ENDIF  ! (iflag_wk_pop_dyn >= 1)
-
-
-  ! sigmaw1=sigmaw
-  ! IF (sigd_con.GT.sigmaw1) THEN
-  ! print*, 'sigmaw,sigd_con', sigmaw, sigd_con
-  ! ENDIF
-  IF (iflag_wk_pop_dyn >= 1) THEN
-    DO i = 1, klon
-      d_dens_gen2(i)   = 0.
-      d_dens_death2(i) = 0.
-      d_dens_col2(i)   = 0.
-      d_awdens2(i) = 0.
-!
-      wdens_targ = max(wdens(i),wdensmin)
-      d_dens_bnd2(i) = wdens_targ - wdens(i)
-      d_wdens2(i) = wdens_targ - wdens(i)
-      wdens(i) = wdens_targ
-    END DO
-    IF (iflag_wk_pop_dyn == 2) THEN
-       DO i = 1, klon  
-          d_adens_death2(i) = 0.
-          d_adens_icol2(i) = 0.
-          d_adens_acol2(i) = 0.
-!      
-          wdens_targ = min(max(awdens(i),0.),wdens(i))
-          d_adens_bnd2(i) = wdens_targ - awdens(i)
-          d_awdens2(i) = wdens_targ - awdens(i)
-          awdens(i) = wdens_targ
-       END DO
-    ENDIF ! (iflag_wk_pop_dyn == 2)
-  ELSE  
-    DO i = 1, klon
-      d_awdens2(i) = 0.
-      d_wdens2(i) = 0.
-    END DO
-  ENDIF  ! (iflag_wk_pop_dyn >= 1)
-!
-  DO i = 1, klon
-    ! c      sigmaw(i) = amax1(sigmaw(i),sigd_con(i))
-!jyg<
-!!    sigmaw(i) = amax1(sigmaw(i), sigmad)
-!!    sigmaw(i) = amin1(sigmaw(i), 0.99)
-    d_sig_gen2(i)   = 0.
-    d_sig_death2(i) = 0.
-    d_sig_col2(i)   = 0.
-    d_sig_spread2(i)= 0.
-    sigmaw_targ = min(max(sigmaw(i), sigmad),0.99)
-    d_sig_bnd2(i) = sigmaw_targ - sigmaw(i)
-    d_sigmaw2(i) = sigmaw_targ - sigmaw(i)
-!  print *,'XXXX1 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
-    sigmaw(i) = sigmaw_targ
-!>jyg
-  END DO
-
-  wape(:) = 0.
-  wape2(:) = 0.
-  d_sigmaw(:) = 0.
-  ktopw(:) = 0
-!
-!<jyg
-dth(:,:) = 0.
-tu(:,:) = 0.
-qu(:,:) = 0.
-dtke(:,:) = 0.
-dqke(:,:) = 0.
-wkspread(:,:) = 0.
-omgbdth(:,:) = 0.
-omg(:,:) = 0.
-dp_omgb(:,:) = 0.
-dp_deltomg(:,:) = 0.
-hw(:) = 0.
-wape(:) = 0.
-fip(:) = 0.
-gfl(:) = 0.
-cstar(:) = 0.
-ktopw(:) = 0
-!
-!  Vertical advection local variables
-omgbw(:,:) = 0.
-omgtop(:) = 0
-dp_omgbw(:,:) = 0.
-omgbdq(:,:) = 0.
-
-!>jyg
-!
-  IF (prt_level>=10) THEN
-    PRINT *, 'wake-1, sigmaw(igout) ', sigmaw(igout)
-    PRINT *, 'wake-1, deltatw(igout,k) ', (k,deltatw(igout,k), k=1,klev)
-    PRINT *, 'wake-1, deltaqw(igout,k) ', (k,deltaqw(igout,k), k=1,klev)
-    PRINT *, 'wake-1, dowwdraughts, amdwn(igout,k) ', (k,amdwn(igout,k), k=1,klev)
-    PRINT *, 'wake-1, dowwdraughts, dtdwn(igout,k) ', (k,dtdwn(igout,k), k=1,klev)
-    PRINT *, 'wake-1, dowwdraughts, dqdwn(igout,k) ', (k,dqdwn(igout,k), k=1,klev)
-    PRINT *, 'wake-1, updraughts, amup(igout,k) ', (k,amup(igout,k), k=1,klev)
-    PRINT *, 'wake-1, updraughts, dta(igout,k) ', (k,dta(igout,k), k=1,klev)
-    PRINT *, 'wake-1, updraughts, dqa(igout,k) ', (k,dqa(igout,k), k=1,klev)
-  ENDIF
-
-  ! 2. - Prognostic part
-  ! --------------------
-
-
-  ! 2.1 - Undisturbed area and Wake integrals
-  ! ---------------------------------------------------------
-
-  DO i = 1, klon
-    z(i) = 0.
-    ktop(i) = 0
-    kupper(i) = 0
-    sum_thu(i) = 0.
-    sum_tu(i) = 0.
-    sum_qu(i) = 0.
-    sum_thvu(i) = 0.
-    sum_dth(i) = 0.
-    sum_dq(i) = 0.
-    sum_rho(i) = 0.
-    sum_dtdwn(i) = 0.
-    sum_dqdwn(i) = 0.
-
-    av_thu(i) = 0.
-    av_tu(i) = 0.
-    av_qu(i) = 0.
-    av_thvu(i) = 0.
-    av_dth(i) = 0.
-    av_dq(i) = 0.
-    av_rho(i) = 0.
-    av_dtdwn(i) = 0.
-    av_dqdwn(i) = 0.
-  END DO
-
-  ! Distance between wakes
-  DO i = 1, klon
-    ll(i) = (1-sqrt(sigmaw(i)))/sqrt(wdens(i))
-  END DO
-  ! Potential temperatures and humidity
-  ! ----------------------------------------------------------
-  DO k = 1, klev
-    DO i = 1, klon
-      ! write(*,*)'wake 1',i,k,RD,tenv(i,k)
-      rho(i, k) = p(i, k)/(RD*tenv(i,k))
-      ! write(*,*)'wake 2',rho(i,k)
-      IF (k==1) THEN
-        ! write(*,*)'wake 3',i,k,rd,tenv(i,k)
-        rhoh(i, k) = ph(i, k)/(RD*tenv(i,k))
-        ! write(*,*)'wake 4',i,k,rd,tenv(i,k)
-        zhh(i, k) = 0
-      ELSE
-        ! write(*,*)'wake 5',rd,(tenv(i,k)+tenv(i,k-1))
-        rhoh(i, k) = ph(i, k)*2./(RD*(tenv(i,k)+tenv(i,k-1)))
-        ! write(*,*)'wake 6',(-rhoh(i,k)*RG)+zhh(i,k-1)
-        zhh(i, k) = (ph(i,k)-ph(i,k-1))/(-rhoh(i,k)*RG) + zhh(i, k-1)
-      END IF
-      ! write(*,*)'wake 7',ppi(i,k)
-      the(i, k) = tenv(i, k)/ppi(i, k)
-      thu(i, k) = (tenv(i,k)-deltatw(i,k)*sigmaw(i))/ppi(i, k)
-      tu(i, k) = tenv(i, k) - deltatw(i, k)*sigmaw(i)
-      qu(i, k) = qe(i, k) - deltaqw(i, k)*sigmaw(i)
-      ! write(*,*)'wake 8',(RD*(tenv(i,k)+deltatw(i,k)))
-      rhow(i, k) = p(i, k)/(RD*(tenv(i,k)+deltatw(i,k)))
-      dth(i, k) = deltatw(i, k)/ppi(i, k)
-    END DO
-  END DO
-
-  DO k = 1, klev - 1
-    DO i = 1, klon
-      IF (k==1) THEN
-        n2(i, k) = 0
-      ELSE
-        n2(i, k) = amax1(0., -RG**2/the(i,k)*rho(i,k)*(the(i,k+1)-the(i,k-1))/ &
-                             (p(i,k+1)-p(i,k-1)))
-      END IF
-      zh(i, k) = (zhh(i,k)+zhh(i,k+1))/2
-
-      cgw(i, k) = sqrt(n2(i,k))*zh(i, k)
-      tgw(i, k) = coefgw*cgw(i, k)/ll(i)
-    END DO
-  END DO
-
-  DO i = 1, klon
-    n2(i, klev) = 0
-    zh(i, klev) = 0
-    cgw(i, klev) = 0
-    tgw(i, klev) = 0
-  END DO
-
-  ! Calcul de la masse volumique moyenne de la colonne   (bdlmd)
-  ! -----------------------------------------------------------------
-
-  DO k = 1, klev
-    DO i = 1, klon
-      epaisseur1(i, k) = 0.
-      epaisseur2(i, k) = 0.
-    END DO
-  END DO
-
-  DO i = 1, klon
-    epaisseur1(i, 1) = -(ph(i,2)-ph(i,1))/(rho(i,1)*RG) + 1.
-    epaisseur2(i, 1) = -(ph(i,2)-ph(i,1))/(rho(i,1)*RG) + 1.
-    rhow_moyen(i, 1) = rhow(i, 1)
-  END DO
-
-  DO k = 2, klev
-    DO i = 1, klon
-      epaisseur1(i, k) = -(ph(i,k+1)-ph(i,k))/(rho(i,k)*RG) + 1.
-      epaisseur2(i, k) = epaisseur2(i, k-1) + epaisseur1(i, k)
-      rhow_moyen(i, k) = (rhow_moyen(i,k-1)*epaisseur2(i,k-1)+rhow(i,k)* &
-        epaisseur1(i,k))/epaisseur2(i, k)
-    END DO
-  END DO
-
-  
-  ! Choose an integration bound well above wake top
-  ! -----------------------------------------------------------------
-
-  ! Determine Wake top pressure (Ptop) from buoyancy integral
-  ! --------------------------------------------------------
-
-  ! -1/ Pressure of the level where dth becomes less than delta_t_min.
-
-  DO i = 1, klon
-    ptop_provis(i) = ph(i, 1)
-  END DO
-  DO k = 2, klev
-    DO i = 1, klon
-
-      ! IM v3JYG; ptop_provis(i).LT. ph(i,1)
-
-      IF (dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min .AND. &
-          ptop_provis(i)==ph(i,1)) THEN
-        ptop_provis(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)- &
-                          (dth(i,k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
-      END IF
-    END DO
-  END DO
-
-  ! -2/ dth integral
-
-  DO i = 1, klon
-    sum_dth(i) = 0.
-    dthmin(i) = -delta_t_min
-    z(i) = 0.
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      dz(i) = -(amax1(ph(i,k+1),ptop_provis(i))-ph(i,k))/(rho(i,k)*RG)
-      IF (dz(i)>0) THEN
-        z(i) = z(i) + dz(i)
-        sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
-        dthmin(i) = amin1(dthmin(i), dth(i,k))
-      END IF
-    END DO
-  END DO
-
-  ! -3/ height of triangle with area= sum_dth and base = dthmin
-
-  DO i = 1, klon
-    hw0(i) = 2.*sum_dth(i)/amin1(dthmin(i), -0.5)
-    hw0(i) = amax1(hwmin, hw0(i))
-  END DO
-
-  ! -4/ now, get Ptop
-
-  DO i = 1, klon
-    z(i) = 0.
-    ptop(i) = ph(i, 1)
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      dz(i) = amin1(-(ph(i,k+1)-ph(i,k))/(rho(i,k)*RG), hw0(i)-z(i))
-      IF (dz(i)>0) THEN
-        z(i) = z(i) + dz(i)
-        ptop(i) = ph(i, k) - rho(i, k)*RG*dz(i)
-      END IF
-    END DO
-  END DO
-
-  IF (prt_level>=10) THEN
-    PRINT *, 'wake-2, ptop_provis(igout), ptop(igout) ', ptop_provis(igout), ptop(igout)
-  ENDIF
-
-
-  ! -5/ Determination de ktop et kupper
-
-  CALL pkupper (klon, klev, ptop, ph, pupper, kupper)
-  
-  DO k = klev, 1, -1
-    DO i = 1, klon
-      IF (ph(i,k+1)<ptop(i)) ktop(i) = k
-    END DO
-  END DO
-  !print*, 'ptop, pupper, ktop, kupper', ptop, pupper, ktop, kupper
- 
-
-
-  ! -6/ Correct ktop and ptop
-
-  DO i = 1, klon
-    ptop_new(i) = ptop(i)
-  END DO
-  DO k = klev, 2, -1
-    DO i = 1, klon
-      IF (k<=ktop(i) .AND. ptop_new(i)==ptop(i) .AND. &
-          dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN
-        ptop_new(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)-(dth(i, &
-          k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    ptop(i) = ptop_new(i)
-  END DO
-
-  DO k = klev, 1, -1
-    DO i = 1, klon
-      IF (ph(i,k+1)<ptop(i)) ktop(i) = k
-    END DO
-  END DO
-
-  IF (prt_level>=10) THEN
-    PRINT *, 'wake-3, ktop(igout), kupper(igout) ', ktop(igout), kupper(igout)
-  ENDIF
-
-  ! -5/ Set deltatw & deltaqw to 0 above kupper
-
-  DO k = 1, klev
-    DO i = 1, klon
-      IF (k>=kupper(i)) THEN
-        deltatw(i, k) = 0.
-        deltaqw(i, k) = 0.
-        d_deltatw2(i,k) = -deltatw0(i,k)
-        d_deltaqw2(i,k) = -deltaqw0(i,k)
-      END IF
-    END DO
-  END DO
-
-
-  ! Vertical gradient of LS omega
-
-  DO k = 1, klev
-    DO i = 1, klon
-      IF (k<=kupper(i)) THEN
-        dp_omgb(i, k) = (omgb(i,k+1)-omgb(i,k))/(ph(i,k+1)-ph(i,k))
-      END IF
-    END DO
-  END DO
-
-  ! Integrals (and wake top level number)
-  ! --------------------------------------
-
-  ! Initialize sum_thvu to 1st level virt. pot. temp.
-
-  DO i = 1, klon
-    z(i) = 1.
-    dz(i) = 1.
-    sum_thvu(i) = thu(i, 1)*(1.+epsim1*qu(i,1))*dz(i)
-    sum_dth(i) = 0.
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      dz(i) = -(amax1(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*RG)
-      IF (dz(i)>0) THEN
-        z(i) = z(i) + dz(i)
-        sum_thu(i) = sum_thu(i) + thu(i, k)*dz(i)
-        sum_tu(i) = sum_tu(i) + tu(i, k)*dz(i)
-        sum_qu(i) = sum_qu(i) + qu(i, k)*dz(i)
-        sum_thvu(i) = sum_thvu(i) + thu(i, k)*(1.+epsim1*qu(i,k))*dz(i)
-        sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
-        sum_dq(i) = sum_dq(i) + deltaqw(i, k)*dz(i)
-        sum_rho(i) = sum_rho(i) + rhow(i, k)*dz(i)
-        sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i, k)*dz(i)
-        sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i, k)*dz(i)
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    hw0(i) = z(i)
-  END DO
-
-
-  ! 2.1 - WAPE and mean forcing computation
-  ! ---------------------------------------
-
-  ! ---------------------------------------
-
-  ! Means
-
-  DO i = 1, klon
-    av_thu(i) = sum_thu(i)/hw0(i)
-    av_tu(i) = sum_tu(i)/hw0(i)
-    av_qu(i) = sum_qu(i)/hw0(i)
-    av_thvu(i) = sum_thvu(i)/hw0(i)
-    ! av_thve = sum_thve/hw0
-    av_dth(i) = sum_dth(i)/hw0(i)
-    av_dq(i) = sum_dq(i)/hw0(i)
-    av_rho(i) = sum_rho(i)/hw0(i)
-    av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
-    av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
-
-    wape(i) = -RG*hw0(i)*(av_dth(i)+ &
-        epsim1*(av_thu(i)*av_dq(i)+av_dth(i)*av_qu(i)+av_dth(i)*av_dq(i)))/av_thvu(i)
-
-  END DO
-
-  ! 2.2 Prognostic variable update
-  ! ------------------------------
-
-  ! Filter out bad wakes
-
-  DO k = 1, klev
-    DO i = 1, klon
-      IF (wape(i)<0.) THEN
-        deltatw(i, k) = 0.
-        deltaqw(i, k) = 0.
-        dth(i, k) = 0.
-        d_deltatw2(i,k) = -deltatw0(i,k)
-        d_deltaqw2(i,k) = -deltaqw0(i,k)
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    IF (wape(i)<0.) THEN
-      wape(i) = 0.
-      cstar(i) = 0.
-      hw(i) = hwmin
-!jyg<
-!!      sigmaw(i) = amax1(sigmad, sigd_con(i))
-      sigmaw_targ = max(sigmad, sigd_con(i))
-      d_sig_bnd2(i) = d_sig_bnd2(i) + sigmaw_targ - sigmaw(i)
-      d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
-!  print *,'XXXX2 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
-      sigmaw(i) = sigmaw_targ
-!>jyg
-      fip(i) = 0.
-      gwake(i) = .FALSE.
-    ELSE
-      hw(i) = hw0(i)
-      cstar(i) = stark*sqrt(2.*wape(i))
-      gwake(i) = .TRUE.
-    END IF
-  END DO
-
-
-  ! Check qx and qw positivity
-  ! --------------------------
-  DO i = 1, klon
-    q0_min(i) = min((qe(i,1)-sigmaw(i)*deltaqw(i,1)),  &
-                    (qe(i,1)+(1.-sigmaw(i))*deltaqw(i,1)))
-  END DO
-  DO k = 2, klev
-    DO i = 1, klon
-      q1_min(i) = min((qe(i,k)-sigmaw(i)*deltaqw(i,k)), &
-                      (qe(i,k)+(1.-sigmaw(i))*deltaqw(i,k)))
-      IF (q1_min(i)<=q0_min(i)) THEN
-        q0_min(i) = q1_min(i)
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    ok_qx_qw(i) = q0_min(i) >= 0.
-    alpha(i) = 1.
-    alpha_tot(i) = 1.
-  END DO
-
-  IF (prt_level>=10) THEN
-    PRINT *, 'wake-4, sigmaw(igout), cstar(igout), wape(igout), ktop(igout) ', &
-                      sigmaw(igout), cstar(igout), wape(igout), ktop(igout)
-  ENDIF
-
-
-  ! C -----------------------------------------------------------------
-  ! Sub-time-stepping
-  ! -----------------
-
-  nsub = 10
-  dtimesub = dtime/nsub
-
-
-  
-  ! ------------------------------------------------------------
-  DO isubstep = 1, nsub
-    ! ------------------------------------------------------------
-  CALL pkupper (klon, klev, ptop, ph, pupper, kupper)
- 
-    !print*, 'ptop, pupper, ktop, kupper', ptop, pupper, ktop, kupper
-
-    ! wk_adv is the logical flag enabling wake evolution in the time advance
-    ! loop
-    DO i = 1, klon
-      wk_adv(i) = ok_qx_qw(i) .AND. alpha(i) >= 1.
-    END DO
-    IF (prt_level>=10) THEN
-      PRINT *, 'wake-4.1, isubstep,wk_adv(igout),cstar(igout),wape(igout), ptop(igout) ', &
-                          isubstep,wk_adv(igout),cstar(igout),wape(igout), ptop(igout)
-     
-    ENDIF
-
-    ! cc nrlmd   Ajout d'un recalcul de wdens dans le cas d'un entrainement
-    ! negatif de ktop a kupper --------
-    ! cc           On calcule pour cela une densite wdens0 pour laquelle on
-    ! aurait un entrainement nul ---
-    !jyg<
-    ! Dans la configuration avec wdens prognostique, il s'agit d'un cas ou 
-    ! les poches sont insuffisantes pour accueillir tout le flux de masse 
-    ! des descentes unsaturees. Nous faisons alors l'hypothese que la 
-    ! convection profonde cree directement de nouvelles poches, sans passer 
-    ! par les thermiques. La nouvelle valeur de wdens est alors imposee.
-
-    DO i = 1, klon
-      ! c       print *,' isubstep,wk_adv(i),cstar(i),wape(i) ',
-      ! c     $           isubstep,wk_adv(i),cstar(i),wape(i)
-      IF (wk_adv(i) .AND. cstar(i)>0.01) THEN
-        IF ( iflag_wk_profile == 0 ) THEN
-           omg(i, kupper(i)+1)=-RG*amdwn(i, kupper(i)+1)/sigmaw(i) + &
-                               RG*amup(i, kupper(i)+1)/(1.-sigmaw(i))
-        ELSE
-           omg(i, kupper(i)+1)=0.
-        ENDIF
-        wdens0 = (sigmaw(i)/(4.*3.14))* &
-          ((1.-sigmaw(i))*omg(i,kupper(i)+1)/((ph(i,1)-pupper(i))*cstar(i)))**(2)
-        IF (prt_level >= 10) THEN
-             print*,'omg(i,kupper(i)+1),wdens0,wdens(i),cstar(i), ph(i,1)-pupper(i)', &
-                     omg(i,kupper(i)+1),wdens0,wdens(i),cstar(i), ph(i,1)-pupper(i)
-        ENDIF
-        IF (wdens(i)<=wdens0*1.1) THEN
-          IF (iflag_wk_pop_dyn >= 1) THEN
-             d_dens_bnd2(i) = d_dens_bnd2(i) + wdens0 - wdens(i)
-             d_wdens2(i) = d_wdens2(i) + wdens0 - wdens(i)
-          ENDIF
-          wdens(i) = wdens0
-        END IF
-      END IF
-    END DO
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        gfl(i) = 2.*sqrt(3.14*wdens(i)*sigmaw(i))
-        rad_wk(i) = sqrt(sigmaw(i)/(3.14*wdens(i)))
-!jyg<
-!!        sigmaw(i) = amin1(sigmaw(i), sigmaw_max)
-        sigmaw_targ = min(sigmaw(i), sigmaw_max)
-        d_sig_bnd2(i) = d_sig_bnd2(i) + sigmaw_targ - sigmaw(i)
-        d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
-!  print *,'XXXX3 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
-        sigmaw(i) = sigmaw_targ
-!>jyg
-      END IF
-    END DO
-
-    IF (iflag_wk_pop_dyn == 1) THEN
-  
-     CALL wake_popdyn_1 (klon, klev, dtime, cstar, tau_wk_inv, wgen, wdens, awdens, sigmaw, &
-                  dtimesub, gfl, rad_wk, f_shear, drdt_pos, &
-                  d_awdens, d_wdens, d_sigmaw, &
-                  iflag_wk_act, wk_adv, cin, wape, &
-                  drdt, &
-                  d_dens_gen, d_dens_death, d_dens_col, d_dens_bnd, &
-                  d_sig_gen, d_sig_death, d_sig_col, d_sig_spread, d_sig_bnd, &
-                  d_wdens_targ, d_sigmaw_targ)
-                      
-!    The variable "death_rate" is significant only when iflag_wk_pop_dyn = 0.
-!    Here, it has to be set to zero.
-      death_rate(:) = 0.
-    
-    ELSEIF (iflag_wk_pop_dyn == 2) THEN
-     CALL wake_popdyn_2 ( klon, klev, wk_adv, dtimesub, wgen, &
-                             sigmaw, wdens, awdens, &   !! states variables
-                             gfl, cstar, cin, wape, rad_wk, &
-                             d_sigmaw, d_wdens, d_awdens, &  !! tendences                              
-                             cont_fact, &
-                             d_sig_gen, d_sig_death, d_sig_col, d_sig_spread, d_sig_bnd, &
-                             d_dens_gen, d_dens_death, d_dens_col, d_dens_bnd, &
-                             d_adens_death, d_adens_icol, d_adens_acol, d_adens_bnd )
-     death_rate(:) = 0.
-sigmaw=sigmaw-d_sigmaw
-wdens=wdens-d_wdens
-awdens=awdens-d_awdens
-   
-    ELSEIF (iflag_wk_pop_dyn == 0) THEN
-    
-    ! cc nrlmd
-
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          ! cc nrlmd          Introduction du taux de mortalite des poches et
-          ! test sur sigmaw_max=0.4
-          ! cc         d_sigmaw(i) = gfl(i)*Cstar(i)*dtimesub
-          IF (sigmaw(i)>=sigmaw_max) THEN
-            death_rate(i) = gfl(i)*cstar(i)/sigmaw(i)
-          ELSE
-            death_rate(i) = 0.
-          END IF
-    
-          d_sigmaw(i) = gfl(i)*cstar(i)*dtimesub - death_rate(i)*sigmaw(i)* &
-            dtimesub
-          ! $              - nat_rate(i)*sigmaw(i)*dtimesub
-          ! c        print*, 'd_sigmaw(i),sigmaw(i),gfl(i),Cstar(i),wape(i),
-          ! c     $  death_rate(i),ktop(i),kupper(i)',
-          ! c     $	         d_sigmaw(i),sigmaw(i),gfl(i),Cstar(i),wape(i),
-          ! c     $  death_rate(i),ktop(i),kupper(i)
-    
-          ! sigmaw(i) =sigmaw(i) + gfl(i)*Cstar(i)*dtimesub
-          ! sigmaw(i) =min(sigmaw(i),0.99)     !!!!!!!!
-          ! wdens = wdens0/(10.*sigmaw)
-          ! sigmaw =max(sigmaw,sigd_con)
-          ! sigmaw =max(sigmaw,sigmad)
-        END IF
-      END DO
-
-    ENDIF   !  (iflag_wk_pop_dyn >= 1)
-
-
-    ! calcul de la difference de vitesse verticale poche - zone non perturbee
-    ! IM 060208 differences par rapport au code initial; init. a 0 dp_deltomg
-    ! IM 060208 et omg sur les niveaux de 1 a klev+1, alors que avant l'on definit
-    ! IM 060208 au niveau k=1...
-    !JYG 161013 Correction : maintenant omg est dimensionne a klev.
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN !!! nrlmd
-          dp_deltomg(i, k) = 0.
-        END IF
-      END DO
-    END DO
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN !!! nrlmd
-          omg(i, k) = 0.
-        END IF
-      END DO
-    END DO
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        z(i) = 0.
-        omg(i, 1) = 0.
-        dp_deltomg(i, 1) = -(gfl(i)*cstar(i))/(sigmaw(i)*(1-sigmaw(i)))
-      END IF
-    END DO
-
-    DO k = 2, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=ktop(i)) THEN
-          dz(i) = -(ph(i,k)-ph(i,k-1))/(rho(i,k-1)*RG)
-          z(i) = z(i) + dz(i)
-          dp_deltomg(i, k) = dp_deltomg(i, 1)
-          omg(i, k) = dp_deltomg(i, 1)*z(i)
-        END IF
-      END DO
-    END DO
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        dztop(i) = -(ptop(i)-ph(i,ktop(i)))/(rho(i,ktop(i))*RG)
-        ztop(i) = z(i) + dztop(i)
-        omgtop(i) = dp_deltomg(i, 1)*ztop(i)
-      END IF
-    END DO
-
-    IF (prt_level>=10) THEN
-      PRINT *, 'wake-4.2, omg(igout,k) ', (k,omg(igout,k), k=1,klev)
-      PRINT *, 'wake-4.2, omgtop(igout), ptop(igout), ktop(igout) ', &
-                          omgtop(igout), ptop(igout), ktop(igout)
-    ENDIF
-
-    ! -----------------
-    ! From m/s to Pa/s
-    ! -----------------
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        omgtop(i) = -rho(i, ktop(i))*RG*omgtop(i)
-        dp_deltomg(i, 1) = omgtop(i)/(ptop(i)-ph(i,1))
-      END IF
-    END DO
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=ktop(i)) THEN
-          omg(i, k) = -rho(i, k)*RG*omg(i, k)
-          dp_deltomg(i, k) = dp_deltomg(i, 1)
-        END IF
-      END DO
-    END DO
-
-    ! raccordement lineaire de omg de ptop a pupper
-
-    DO i = 1, klon
-      IF (wk_adv(i) .AND. kupper(i)>ktop(i)) THEN
-        IF ( iflag_wk_profile == 0 ) THEN
-           omg(i, kupper(i)+1) =-RG*amdwn(i, kupper(i)+1)/sigmaw(i) + &
-          RG*amup(i, kupper(i)+1)/(1.-sigmaw(i))
-        ELSE
-           omg(i, kupper(i)+1) = 0.
-        ENDIF
-        dp_deltomg(i, kupper(i)) = (omgtop(i)-omg(i,kupper(i)+1))/ &
-          (ptop(i)-pupper(i))
-      END IF
-    END DO
-
-    ! c      DO i=1,klon
-    ! c        print*,'Pente entre 0 et kupper (reference)'
-    ! c     $   	,omg(i,kupper(i)+1)/(pupper(i)-ph(i,1))
-    ! c        print*,'Pente entre ktop et kupper'
-    ! c     $  	,(omg(i,kupper(i)+1)-omgtop(i))/(pupper(i)-ptop(i))
-    ! c      ENDDO
-    ! c
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k>ktop(i) .AND. k<=kupper(i)) THEN
-          dp_deltomg(i, k) = dp_deltomg(i, kupper(i))
-          omg(i, k) = omgtop(i) + (ph(i,k)-ptop(i))*dp_deltomg(i, kupper(i))
-        END IF
-      END DO
-    END DO
-!!    print *,'omg(igout,k) ', (k,omg(igout,k),k=1,klev)
-    ! cc nrlmd
-    ! c      DO i=1,klon
-    ! c      print*,'deltaw_ktop,deltaw_conv',omgtop(i),omg(i,kupper(i)+1)
-    ! c      END DO
-    ! cc
-
-
-    ! --    Compute wake average vertical velocity omgbw
-
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          omgbw(i, k) = omgb(i, k) + (1.-sigmaw(i))*omg(i, k)
-        END IF
-      END DO
-    END DO
-    ! --    and its vertical gradient dp_omgbw
-
-    DO k = 1, klev-1
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          dp_omgbw(i, k) = (omgbw(i,k+1)-omgbw(i,k))/(ph(i,k+1)-ph(i,k))
-        END IF
-      END DO
-    END DO
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-          dp_omgbw(i, klev) = 0.
-      END IF
-    END DO
-
-    ! --    Upstream coefficients for omgb velocity
-    ! --    (alpha_up(k) is the coefficient of the value at level k)
-    ! --    (1-alpha_up(k) is the coefficient of the value at level k-1)
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          alpha_up(i, k) = 0.
-          IF (omgb(i,k)>0.) alpha_up(i, k) = 1.
-        END IF
-      END DO
-    END DO
-
-    ! Matrix expressing [The,deltatw] from  [Th1,Th2]
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        rre1(i) = 1. - sigmaw(i)
-        rre2(i) = sigmaw(i)
-      END IF
-    END DO
-    rrd1 = -1.
-    rrd2 = 1.
-
-    ! --    Get [Th1,Th2], dth and [q1,q2]
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=kupper(i)+1) THEN
-          dth(i, k) = deltatw(i, k)/ppi(i, k)
-! print *, 'VVVVwake k, the(i,k), dth(i,k), sigmaw(i) ', k, the(i,k), dth(i,k), sigmaw(i)
-          th1(i, k) = the(i, k) - sigmaw(i)*dth(i, k) ! undisturbed area
-          th2(i, k) = the(i, k) + (1.-sigmaw(i))*dth(i, k) ! wake
-          q1(i, k) = qe(i, k) - sigmaw(i)*deltaqw(i, k) ! undisturbed area
-          q2(i, k) = qe(i, k) + (1.-sigmaw(i))*deltaqw(i, k) ! wake
-        END IF
-      END DO
-    END DO
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        d_th1(i, 1) = 0.
-        d_th2(i, 1) = 0.
-        d_dth(i, 1) = 0.
-        d_q1(i, 1) = 0.
-        d_q2(i, 1) = 0.
-        d_dq(i, 1) = 0.
-      END IF
-    END DO
-
-    DO k = 2, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=kupper(i)+1) THEN
-          d_th1(i, k) = th1(i, k-1) - th1(i, k)
-          d_th2(i, k) = th2(i, k-1) - th2(i, k)
-          d_dth(i, k) = dth(i, k-1) - dth(i, k)
-          d_q1(i, k) = q1(i, k-1) - q1(i, k)
-          d_q2(i, k) = q2(i, k-1) - q2(i, k)
-          d_dq(i, k) = deltaqw(i, k-1) - deltaqw(i, k)
-        END IF
-      END DO
-    END DO
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        omgbdth(i, 1) = 0.
-        omgbdq(i, 1) = 0.
-      END IF
-    END DO
-
-    DO k = 2, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=kupper(i)+1) THEN !   loop on interfaces
-          omgbdth(i, k) = omgb(i, k)*(dth(i,k-1)-dth(i,k))
-          omgbdq(i, k) = omgb(i, k)*(deltaqw(i,k-1)-deltaqw(i,k))
-        END IF
-      END DO
-    END DO
-
-!!    IF (prt_level>=10) THEN
-    IF (prt_level>=10 .and. wk_adv(igout)) THEN
-      PRINT *, 'wake-4.3, th1(igout,k) ', (k,th1(igout,k), k=1,kupper(igout))
-      PRINT *, 'wake-4.3, th2(igout,k) ', (k,th2(igout,k), k=1,kupper(igout))
-      PRINT *, 'wake-4.3, dth(igout,k) ', (k,dth(igout,k), k=1,kupper(igout))
-      PRINT *, 'wake-4.3, omgbdth(igout,k) ', (k,omgbdth(igout,k), k=1,kupper(igout))
-    ENDIF
-
-    ! -----------------------------------------------------------------
-    DO k = 1, klev-1
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=kupper(i)-1) THEN
-          ! -----------------------------------------------------------------
-
-          ! Compute redistribution (advective) term
-
-          d_deltatw(i, k) = dtimesub/(ph(i,k)-ph(i,k+1))* &
-            (rrd1*omg(i,k)*sigmaw(i)*d_th1(i,k) - &
-             rrd2*omg(i,k+1)*(1.-sigmaw(i))*d_th2(i,k+1)- &
-             (1.-alpha_up(i,k))*omgbdth(i,k)- &
-             alpha_up(i,k+1)*omgbdth(i,k+1))*ppi(i, k)
-!           print*,'d_deltatw=', k, d_deltatw(i,k)
-
-          d_deltaqw(i, k) = dtimesub/(ph(i,k)-ph(i,k+1))* &
-            (rrd1*omg(i,k)*sigmaw(i)*d_q1(i,k)- &
-             rrd2*omg(i,k+1)*(1.-sigmaw(i))*d_q2(i,k+1)- &
-             (1.-alpha_up(i,k))*omgbdq(i,k)- &
-             alpha_up(i,k+1)*omgbdq(i,k+1))
-!           print*,'d_deltaqw=', k, d_deltaqw(i,k)
-
-          ! and increment large scale tendencies
-
-
-
-
-          ! C
-          ! -----------------------------------------------------------------
-          d_tenv(i, k) = dtimesub*((rre1(i)*omg(i,k)*sigmaw(i)*d_th1(i,k)- &
-                                  rre2(i)*omg(i,k+1)*(1.-sigmaw(i))*d_th2(i,k+1))/ &
-                                 (ph(i,k)-ph(i,k+1)) &
-                                 -sigmaw(i)*(1.-sigmaw(i))*dth(i,k)*(omg(i,k)-omg(i,k+1))/ &
-                                 (ph(i,k)-ph(i,k+1)) )*ppi(i, k)
-
-          d_qe(i, k) = dtimesub*((rre1(i)*omg(i,k)*sigmaw(i)*d_q1(i,k)- &
-                                  rre2(i)*omg(i,k+1)*(1.-sigmaw(i))*d_q2(i,k+1))/ &
-                                 (ph(i,k)-ph(i,k+1)) &
-                                 -sigmaw(i)*(1.-sigmaw(i))*deltaqw(i,k)*(omg(i,k)-omg(i,k+1))/ &
-                                 (ph(i,k)-ph(i,k+1)) )
-        ELSE IF (wk_adv(i) .AND. k==kupper(i)) THEN
-          d_tenv(i, k) = dtimesub*(rre1(i)*omg(i,k)*sigmaw(i)*d_th1(i,k)/(ph(i,k)-ph(i,k+1)))*ppi(i, k)
-
-          d_qe(i, k) = dtimesub*(rre1(i)*omg(i,k)*sigmaw(i)*d_q1(i,k)/(ph(i,k)-ph(i,k+1)))
-
-        END IF
-        ! cc
-      END DO
-    END DO
-    ! ------------------------------------------------------------------
-
-    IF (prt_level>=10) THEN
-      PRINT *, 'wake-4.3, d_deltatw(igout,k) ', (k,d_deltatw(igout,k), k=1,klev)
-      PRINT *, 'wake-4.3, d_deltaqw(igout,k) ', (k,d_deltaqw(igout,k), k=1,klev)
-    ENDIF
-
-    ! Increment state variables
-!jyg<
-    IF (iflag_wk_pop_dyn >= 1) THEN
-      DO k = 1, klev
-        DO i = 1, klon
-          IF (wk_adv(i) .AND. k<=kupper(i)) THEN
-            detr(i,k) = - d_sig_death(i) - d_sig_col(i)      
-            entr(i,k) = d_sig_gen(i)
-          ENDIF
-        ENDDO
-      ENDDO
-      ELSE  ! (iflag_wk_pop_dyn >= 1)
-      DO k = 1, klev
-        DO i = 1, klon
-          IF (wk_adv(i) .AND. k<=kupper(i)) THEN
-            detr(i, k) = 0.
-   
-            entr(i, k) = 0.
-          ENDIF
-        ENDDO
-      ENDDO
-    ENDIF  ! (iflag_wk_pop_dyn >= 1)
-
-    
-
-    DO k = 1, klev
-      DO i = 1, klon
-        ! cc nrlmd       IF( wk_adv(i) .AND. k .LE. kupper(i)-1) THEN
-        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
-          ! cc
-
-
-
-          ! Coefficient de repartition
-
-          crep(i, k) = crep_sol*(ph(i,kupper(i))-ph(i,k))/ &
-            (ph(i,kupper(i))-ph(i,1))
-          crep(i, k) = crep(i, k) + crep_upper*(ph(i,1)-ph(i,k))/ &
-            (p(i,1)-ph(i,kupper(i)))
-
-
-          ! Reintroduce compensating subsidence term.
-
-          ! dtKE(k)=(dtdwn(k)*Crep(k))/sigmaw
-          ! dtKE(k)=dtKE(k)-(dtdwn(k)*(1-Crep(k))+dta(k))
-          ! .                   /(1-sigmaw)
-          ! dqKE(k)=(dqdwn(k)*Crep(k))/sigmaw
-          ! dqKE(k)=dqKE(k)-(dqdwn(k)*(1-Crep(k))+dqa(k))
-          ! .                   /(1-sigmaw)
-
-          ! dtKE(k)=(dtdwn(k)*Crep(k)+(1-Crep(k))*dta(k))/sigmaw
-          ! dtKE(k)=dtKE(k)-(dtdwn(k)*(1-Crep(k))+dta(k)*Crep(k))
-          ! .                   /(1-sigmaw)
-          ! dqKE(k)=(dqdwn(k)*Crep(k)+(1-Crep(k))*dqa(k))/sigmaw
-          ! dqKE(k)=dqKE(k)-(dqdwn(k)*(1-Crep(k))+dqa(k)*Crep(k))
-          ! .                   /(1-sigmaw)
-
-          dtke(i, k) = (dtdwn(i,k)/sigmaw(i)-dta(i,k)/(1.-sigmaw(i)))
-          dqke(i, k) = (dqdwn(i,k)/sigmaw(i)-dqa(i,k)/(1.-sigmaw(i)))
-          ! print*,'dtKE= ',dtKE(i,k),' dqKE= ',dqKE(i,k)
-
-!
-
-          ! cc nrlmd          Prise en compte du taux de mortalite
-          ! cc               Definitions de entr, detr
-!jyg<
-!!            detr(i, k) = 0.
-!!   
-!!            entr(i, k) = detr(i, k) + gfl(i)*cstar(i) + &
-!!              sigmaw(i)*(1.-sigmaw(i))*dp_deltomg(i, k)
-!!
-            entr(i, k) = entr(i,k) + gfl(i)*cstar(i) + &
-                         sigmaw(i)*(1.-sigmaw(i))*dp_deltomg(i, k)   
-!>jyg
-            wkspread(i, k) = (entr(i,k)-detr(i,k))/sigmaw(i)
-
-          ! cc        wkspread(i,k) =
-          ! (1.-sigmaw(i))*dp_deltomg(i,k)+gfl(i)*Cstar(i)/
-          ! cc     $  sigmaw(i)
-
-
-          ! ajout d'un effet onde de gravite -Tgw(k)*deltatw(k) 03/02/06 YU
-          ! Jingmei
-
-          ! write(lunout,*)'wake.F ',i,k, dtimesub,d_deltat_gw(i,k),
-          ! &  Tgw(i,k),deltatw(i,k)
-          d_deltat_gw(i, k) = d_deltat_gw(i, k) - tgw(i, k)*deltatw(i, k)* &
-            dtimesub
-          ! write(lunout,*)'wake.F ',i,k, dtimesub,d_deltatw(i,k)
-          ff(i) = d_deltatw(i, k)/dtimesub
-
-          ! Sans GW
-
-          ! deltatw(k)=deltatw(k)+dtimesub*(ff+dtKE(k)-wkspread(k)*deltatw(k))
-
-          ! GW formule 1
-
-          ! deltatw(k) = deltatw(k)+dtimesub*
-          ! $         (ff+dtKE(k) - wkspread(k)*deltatw(k)-Tgw(k)*deltatw(k))
-
-          ! GW formule 2
-
-          IF (dtimesub*tgw(i,k)<1.E-10) THEN
-            d_deltatw(i, k) = dtimesub*(ff(i)+dtke(i,k) - & 
-               entr(i,k)*deltatw(i,k)/sigmaw(i) - &
-               (death_rate(i)*sigmaw(i)+detr(i,k))*deltatw(i,k)/(1.-sigmaw(i)) - & ! cc
-               tgw(i,k)*deltatw(i,k) )
-          ELSE
-            d_deltatw(i, k) = 1/tgw(i, k)*(1-exp(-dtimesub*tgw(i,k)))* &
-               (ff(i)+dtke(i,k) - &
-                entr(i,k)*deltatw(i,k)/sigmaw(i) - &
-                (death_rate(i)*sigmaw(i)+detr(i,k))*deltatw(i,k)/(1.-sigmaw(i)) - &
-                tgw(i,k)*deltatw(i,k) )
-          END IF
-
-          dth(i, k) = deltatw(i, k)/ppi(i, k)
-
-          gg(i) = d_deltaqw(i, k)/dtimesub
-
-          d_deltaqw(i, k) = dtimesub*(gg(i)+dqke(i,k) - & 
-            entr(i,k)*deltaqw(i,k)/sigmaw(i) - &
-            (death_rate(i)*sigmaw(i)+detr(i,k))*deltaqw(i,k)/(1.-sigmaw(i)))
-          ! cc
-
-          ! cc nrlmd
-          ! cc       d_deltatw2(i,k)=d_deltatw2(i,k)+d_deltatw(i,k)
-          ! cc       d_deltaqw2(i,k)=d_deltaqw2(i,k)+d_deltaqw(i,k)
-          ! cc
-        END IF
-      END DO
-    END DO
-
-
-    ! Scale tendencies so that water vapour remains positive in w and x.
-
-    CALL wake_vec_modulation(klon, klev, wk_adv, epsilon_loc, qe, d_qe, deltaqw, &
-      d_deltaqw, sigmaw, d_sigmaw, alpha)
-    !
-    ! Alpha_tot = Product of all the alpha's
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        alpha_tot(i) = alpha_tot(i)*alpha(i)    
-      END IF
-    END DO
-
-    ! cc nrlmd
-    ! c      print*,'alpha'
-    ! c      do i=1,klon
-    ! c         print*,alpha(i)
-    ! c      end do
-    ! cc
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
-          d_tenv(i, k) = alpha(i)*d_tenv(i, k)
-          d_qe(i, k) = alpha(i)*d_qe(i, k)
-          d_deltatw(i, k) = alpha(i)*d_deltatw(i, k)
-          d_deltaqw(i, k) = alpha(i)*d_deltaqw(i, k)
-          d_deltat_gw(i, k) = alpha(i)*d_deltat_gw(i, k)
-        END IF
-      END DO
-    END DO
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        d_sigmaw(i) = alpha(i)*d_sigmaw(i)
-      END IF
-    END DO
-
-    ! Update large scale variables and wake variables
-    ! IM 060208 manque DO i + remplace DO k=1,kupper(i)
-    ! IM 060208     DO k = 1,kupper(i)
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
-          dtls(i, k) = dtls(i, k) + d_tenv(i, k)
-          dqls(i, k) = dqls(i, k) + d_qe(i, k)
-          ! cc nrlmd
-          d_deltatw2(i, k) = d_deltatw2(i, k) + d_deltatw(i, k)
-          d_deltaqw2(i, k) = d_deltaqw2(i, k) + d_deltaqw(i, k)
-          ! cc
-        END IF
-      END DO
-    END DO
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
-          tenv(i, k) = tenv0(i, k) + dtls(i, k)
-          qe(i, k) = qe0(i, k) + dqls(i, k)
-          the(i, k) = tenv(i, k)/ppi(i, k)
-          deltatw(i, k) = deltatw(i, k) + d_deltatw(i, k)
-          deltaqw(i, k) = deltaqw(i, k) + d_deltaqw(i, k)
-          dth(i, k) = deltatw(i, k)/ppi(i, k)
-          ! c      print*,'k,qx,qw',k,qe(i,k)-sigmaw(i)*deltaqw(i,k)
-          ! c     $        ,qe(i,k)+(1-sigmaw(i))*deltaqw(i,k)
-        END IF
-      END DO
-    END DO
-!
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        sigmaw(i) = sigmaw(i) + d_sigmaw(i)
-        d_sigmaw2(i) = d_sigmaw2(i) + d_sigmaw(i)
-!  print *,'XXXX4 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
-      END IF
-    END DO
-!jyg<
-    IF (iflag_wk_pop_dyn >= 1) THEN
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! sigmaw !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!  Cumulatives
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          d_sig_gen2(i)   = d_sig_gen2(i)   + d_sig_gen(i)
-          d_sig_death2(i) = d_sig_death2(i) + d_sig_death(i)
-          d_sig_col2(i)   = d_sig_col2(i)   + d_sig_col(i)
-          d_sig_spread2(i)= d_sig_spread2(i)+ d_sig_spread(i)
-          d_sig_bnd2(i)   = d_sig_bnd2(i)   + d_sig_bnd(i)
-        END IF
-      END DO
-!  Bounds
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          sigmaw_targ = max(sigmaw(i),sigmad)
-          d_sig_bnd2(i) = d_sig_bnd2(i) + sigmaw_targ - sigmaw(i)
-          d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
-!  print *,'XXXX5 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
-          sigmaw(i) = sigmaw_targ
-        END IF
-      END DO
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! wdens  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!  Cumulatives
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          wdens(i) = wdens(i) + d_wdens(i)
-          d_wdens2(i) = d_wdens2(i) + d_wdens(i)
-          d_dens_gen2(i)   = d_dens_gen2(i)   + d_dens_gen(i)
-          d_dens_death2(i) = d_dens_death2(i) + d_dens_death(i)
-          d_dens_col2(i)   = d_dens_col2(i)   + d_dens_col(i)
-          d_dens_bnd2(i)   = d_dens_bnd2(i)   + d_dens_bnd(i)
-        END IF
-      END DO
-!  Bounds
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          wdens_targ = max(wdens(i),wdensmin)
-          d_dens_bnd2(i) = d_dens_bnd2(i) + wdens_targ - wdens(i)
-          d_wdens2(i) = d_wdens2(i) + wdens_targ - wdens(i)
-          wdens(i) = wdens_targ
-        END IF
-      END DO
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! awdens !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!  Cumulatives
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          awdens(i) = awdens(i) + d_awdens(i)
-          d_awdens2(i) = d_awdens2(i) + d_awdens(i)
-        END IF
-      END DO
-!  Bounds
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          wdens_targ = min( max(awdens(i),0.), wdens(i) )
-          d_awdens2(i) = d_awdens2(i) + wdens_targ - awdens(i)
-          awdens(i) = wdens_targ
-        END IF
-      END DO
-!
-      IF (iflag_wk_pop_dyn == 2) THEN
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! awdens again for iflag_wk_pop_dyn = 2!!!!!!
-!  Cumulatives
-          DO i = 1, klon
-             IF (wk_adv(i)) THEN
-                 d_adens_death2(i)   = d_adens_death2(i)   + d_adens_death(i)
-                 d_adens_icol2(i)   = d_adens_icol2(i)   + d_adens_icol(i)
-                 d_adens_acol2(i)   = d_adens_acol2(i)   + d_adens_acol(i)
-                 d_adens_bnd2(i)   = d_adens_bnd2(i)   + d_adens_bnd(i)          
-             END IF
-          END DO
-!  Bounds
-          DO i = 1, klon
-             IF (wk_adv(i)) THEN
-                 wdens_targ = min( max(awdens(i),0.), wdens(i) )
-                 d_adens_bnd2(i) = d_adens_bnd2(i) + wdens_targ - awdens(i)
-             END IF
-          END DO
-      ENDIF ! (iflag_wk_pop_dyn == 2)
-    ENDIF  ! (iflag_wk_pop_dyn >= 1)
-
-
-    ! Determine Ptop from buoyancy integral
-    ! ---------------------------------------
-
-    ! -     1/ Pressure of the level where dth changes sign.
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        ptop_provis(i) = ph(i, 1)
-      END IF
-    END DO
-
-    DO k = 2, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. ptop_provis(i)==ph(i,1) .AND. &
-            dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN
-          ptop_provis(i) = ((dth(i,k)+delta_t_min)*p(i,k-1) - &
-                            (dth(i,k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
-        END IF
-      END DO
-    END DO
-
-    ! -     2/ dth integral
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        sum_dth(i) = 0.
-        dthmin(i) = -delta_t_min
-        z(i) = 0.
-      END IF
-    END DO
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          dz(i) = -(amax1(ph(i,k+1),ptop_provis(i))-ph(i,k))/(rho(i,k)*RG)
-          IF (dz(i)>0) THEN
-            z(i) = z(i) + dz(i)
-            sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
-            dthmin(i) = amin1(dthmin(i), dth(i,k))
-          END IF
-        END IF
-      END DO
-    END DO
-
-    ! -     3/ height of triangle with area= sum_dth and base = dthmin
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        hw(i) = 2.*sum_dth(i)/amin1(dthmin(i), -0.5)
-        hw(i) = amax1(hwmin, hw(i))
-      END IF
-    END DO
-
-    ! -     4/ now, get Ptop
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        ktop(i) = 0
-        z(i) = 0.
-      END IF
-    END DO
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          dz(i) = amin1(-(ph(i,k+1)-ph(i,k))/(rho(i,k)*RG), hw(i)-z(i))
-          IF (dz(i)>0) THEN
-            z(i) = z(i) + dz(i)
-            ptop(i) = ph(i, k) - rho(i, k)*RG*dz(i)
-            ktop(i) = k
-          END IF
-        END IF
-      END DO
-    END DO
-
-    ! 4.5/Correct ktop and ptop
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        ptop_new(i) = ptop(i)
-      END IF
-    END DO
-
-    DO k = klev, 2, -1
-      DO i = 1, klon
-        ! IM v3JYG; IF (k .GE. ktop(i)
-        IF (wk_adv(i) .AND. k<=ktop(i) .AND. ptop_new(i)==ptop(i) .AND. &
-            dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN
-          ptop_new(i) = ((dth(i,k)+delta_t_min)*p(i,k-1) - &
-                         (dth(i,k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
-        END IF
-      END DO
-    END DO
-
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        ptop(i) = ptop_new(i)
-      END IF
-    END DO
-
-    DO k = klev, 1, -1
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN !!! nrlmd
-          IF (ph(i,k+1)<ptop(i)) ktop(i) = k
-        END IF
-      END DO
-    END DO
-
-    ! 5/ Set deltatw & deltaqw to 0 above kupper
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k>=kupper(i)) THEN
-          deltatw(i, k) = 0.
-          deltaqw(i, k) = 0.
-          d_deltatw2(i,k) = -deltatw0(i,k)
-          d_deltaqw2(i,k) = -deltaqw0(i,k)
-        END IF
-      END DO
-    END DO
-
-
-    ! -------------Cstar computation---------------------------------
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        sum_thu(i) = 0.
-        sum_tu(i) = 0.
-        sum_qu(i) = 0.
-        sum_thvu(i) = 0.
-        sum_dth(i) = 0.
-        sum_dq(i) = 0.
-        sum_rho(i) = 0.
-        sum_dtdwn(i) = 0.
-        sum_dqdwn(i) = 0.
-
-        av_thu(i) = 0.
-        av_tu(i) = 0.
-        av_qu(i) = 0.
-        av_thvu(i) = 0.
-        av_dth(i) = 0.
-        av_dq(i) = 0.
-        av_rho(i) = 0.
-        av_dtdwn(i) = 0.
-        av_dqdwn(i) = 0.
-      END IF
-    END DO
-
-    ! Integrals (and wake top level number)
-    ! --------------------------------------
-
-    ! Initialize sum_thvu to 1st level virt. pot. temp.
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        z(i) = 1.
-        dz(i) = 1.
-        sum_thvu(i) = thu(i, 1)*(1.+epsim1*qu(i,1))*dz(i)
-        sum_dth(i) = 0.
-      END IF
-    END DO
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN !!! nrlmd
-          dz(i) = -(max(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*RG)
-          IF (dz(i)>0) THEN
-            z(i) = z(i) + dz(i)
-            sum_thu(i) = sum_thu(i) + thu(i, k)*dz(i)
-            sum_tu(i) = sum_tu(i) + tu(i, k)*dz(i)
-            sum_qu(i) = sum_qu(i) + qu(i, k)*dz(i)
-            sum_thvu(i) = sum_thvu(i) + thu(i, k)*(1.+epsim1*qu(i,k))*dz(i)
-            sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
-            sum_dq(i) = sum_dq(i) + deltaqw(i, k)*dz(i)
-            sum_rho(i) = sum_rho(i) + rhow(i, k)*dz(i)
-            sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i, k)*dz(i)
-            sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i, k)*dz(i)
-          END IF
-        END IF
-      END DO
-    END DO
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        hw0(i) = z(i)
-      END IF
-    END DO
-
-
-    ! - WAPE and mean forcing computation
-    ! ---------------------------------------
-
-    ! ---------------------------------------
-
-    ! Means
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        av_thu(i) = sum_thu(i)/hw0(i)
-        av_tu(i) = sum_tu(i)/hw0(i)
-        av_qu(i) = sum_qu(i)/hw0(i)
-        av_thvu(i) = sum_thvu(i)/hw0(i)
-        av_dth(i) = sum_dth(i)/hw0(i)
-        av_dq(i) = sum_dq(i)/hw0(i)
-        av_rho(i) = sum_rho(i)/hw0(i)
-        av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
-        av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
-
-        wape(i) = -RG*hw0(i)*(av_dth(i)+epsim1*(av_thu(i)*av_dq(i) + &
-                              av_dth(i)*av_qu(i)+av_dth(i)*av_dq(i)))/av_thvu(i)
-      END IF
-    END DO
-
-    ! Filter out bad wakes
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN !!! nrlmd
-          IF (wape(i)<0.) THEN
-            deltatw(i, k) = 0.
-            deltaqw(i, k) = 0.
-            dth(i, k) = 0.
-            d_deltatw2(i,k) = -deltatw0(i,k)
-            d_deltaqw2(i,k) = -deltaqw0(i,k)
-          END IF
-        END IF
-      END DO
-    END DO
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        IF (wape(i)<0.) THEN
-          wape(i) = 0.
-          cstar(i) = 0.
-          hw(i) = hwmin
-!jyg<
-!!          sigmaw(i) = max(sigmad, sigd_con(i))
-          sigmaw_targ = max(sigmad, sigd_con(i))
-          d_sig_bnd2(i) = d_sig_bnd2(i) + sigmaw_targ - sigmaw(i)
-          d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
-!  print *,'XXXX6 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
-          sigmaw(i) = sigmaw_targ
-!>jyg
-          fip(i) = 0.
-          gwake(i) = .FALSE.
-        ELSE
-          cstar(i) = stark*sqrt(2.*wape(i))
-          gwake(i) = .TRUE.
-        END IF
-      END IF
-    END DO
-
-  END DO ! end sub-timestep loop
-
-  IF (prt_level>=10) THEN
-    PRINT *, 'wake-5, sigmaw(igout), cstar(igout), wape(igout), ptop(igout) ', &
-                      sigmaw(igout), cstar(igout), wape(igout), ptop(igout)
-  ENDIF
-
-
-  ! ----------------------------------------------------------
-  ! Determine wake final state; recompute wape, cstar, ktop;
-  ! filter out bad wakes.
-  ! ----------------------------------------------------------
-
-  ! 2.1 - Undisturbed area and Wake integrals
-  ! ---------------------------------------------------------
-
-  DO i = 1, klon
-    ! cc nrlmd       if (wk_adv(i)) then !!! nrlmd
-    IF (ok_qx_qw(i)) THEN
-      ! cc
-      z(i) = 0.
-      sum_thu(i) = 0.
-      sum_tu(i) = 0.
-      sum_qu(i) = 0.
-      sum_thvu(i) = 0.
-      sum_dth(i) = 0.
-      sum_half_dth(i) = 0.
-      sum_dq(i) = 0.
-      sum_rho(i) = 0.
-      sum_dtdwn(i) = 0.
-      sum_dqdwn(i) = 0.
-
-      av_thu(i) = 0.
-      av_tu(i) = 0.
-      av_qu(i) = 0.
-      av_thvu(i) = 0.
-      av_dth(i) = 0.
-      av_dq(i) = 0.
-      av_rho(i) = 0.
-      av_dtdwn(i) = 0.
-      av_dqdwn(i) = 0.
-
-      dthmin(i) = -delta_t_min
-    END IF
-  END DO
-  ! Potential temperatures and humidity
-  ! ----------------------------------------------------------
-
-  DO k = 1, klev
-    DO i = 1, klon
-      ! cc nrlmd       IF ( wk_adv(i)) THEN
-      IF (ok_qx_qw(i)) THEN
-        ! cc
-        rho(i, k) = p(i, k)/(RD*tenv(i,k))
-        IF (k==1) THEN
-          rhoh(i, k) = ph(i, k)/(RD*tenv(i,k))
-          zhh(i, k) = 0
-        ELSE
-          rhoh(i, k) = ph(i, k)*2./(RD*(tenv(i,k)+tenv(i,k-1)))
-          zhh(i, k) = (ph(i,k)-ph(i,k-1))/(-rhoh(i,k)*RG) + zhh(i, k-1)
-        END IF
-        the(i, k) = tenv(i, k)/ppi(i, k)
-        thu(i, k) = (tenv(i,k)-deltatw(i,k)*sigmaw(i))/ppi(i, k)
-        tu(i, k) = tenv(i, k) - deltatw(i, k)*sigmaw(i)
-        qu(i, k) = qe(i, k) - deltaqw(i, k)*sigmaw(i)
-        rhow(i, k) = p(i, k)/(RD*(tenv(i,k)+deltatw(i,k)))
-        dth(i, k) = deltatw(i, k)/ppi(i, k)
-      END IF
-    END DO
-  END DO
-
-  ! Integrals (and wake top level number)
-  ! -----------------------------------------------------------
-
-  ! Initialize sum_thvu to 1st level virt. pot. temp.
-
-  DO i = 1, klon
-    ! cc nrlmd       IF ( wk_adv(i)) THEN
-    IF (ok_qx_qw(i)) THEN
-      ! cc
-      z(i) = 1.
-      dz(i) = 1.
-      dz_half(i) = 1.
-      sum_thvu(i) = thu(i, 1)*(1.+epsim1*qu(i,1))*dz(i)
-      sum_dth(i) = 0.
-    END IF
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      ! cc nrlmd       IF ( wk_adv(i)) THEN
-      IF (ok_qx_qw(i)) THEN
-        ! cc
-        dz(i) = -(amax1(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*RG)
-        dz_half(i) = -(amax1(ph(i,k+1),0.5*(ptop(i)+ph(i,1)))-ph(i,k))/(rho(i,k)*RG)
-        IF (dz(i)>0) THEN
-          z(i) = z(i) + dz(i)
-          sum_thu(i) = sum_thu(i) + thu(i, k)*dz(i)
-          sum_tu(i) = sum_tu(i) + tu(i, k)*dz(i)
-          sum_qu(i) = sum_qu(i) + qu(i, k)*dz(i)
-          sum_thvu(i) = sum_thvu(i) + thu(i, k)*(1.+epsim1*qu(i,k))*dz(i)
-          sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
-          sum_dq(i) = sum_dq(i) + deltaqw(i, k)*dz(i)
-          sum_rho(i) = sum_rho(i) + rhow(i, k)*dz(i)
-          sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i, k)*dz(i)
-          sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i, k)*dz(i)
-!
-          dthmin(i) = min(dthmin(i), dth(i,k))
-        END IF
-        IF (dz_half(i)>0) THEN
-          sum_half_dth(i) = sum_half_dth(i) + dth(i, k)*dz_half(i)
-        END IF
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    ! cc nrlmd       IF ( wk_adv(i)) THEN
-    IF (ok_qx_qw(i)) THEN
-      ! cc
-      hw0(i) = z(i)
-    END IF
-  END DO
-
-  ! - WAPE and mean forcing computation
-  ! -------------------------------------------------------------
-
-  ! Means
-
-  DO i = 1, klon
-    ! cc nrlmd       IF ( wk_adv(i)) THEN
-    IF (ok_qx_qw(i)) THEN
-      ! cc
-      av_thu(i) = sum_thu(i)/hw0(i)
-      av_tu(i) = sum_tu(i)/hw0(i)
-      av_qu(i) = sum_qu(i)/hw0(i)
-      av_thvu(i) = sum_thvu(i)/hw0(i)
-      av_dth(i) = sum_dth(i)/hw0(i)
-      av_dq(i) = sum_dq(i)/hw0(i)
-      av_rho(i) = sum_rho(i)/hw0(i)
-      av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
-      av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
-
-      wape2(i) = -RG*hw0(i)*(av_dth(i)+epsim1*(av_thu(i)*av_dq(i) + &
-                             av_dth(i)*av_qu(i)+av_dth(i)*av_dq(i)))/av_thvu(i)
-    END IF
-  END DO
-
-
-
-  ! Prognostic variable update
-  ! ------------------------------------------------------------
-
-  ! Filter out bad wakes
-
-  IF (iflag_wk_check_trgl>=1) THEN
-    ! Check triangular shape of dth profile
-    DO i = 1, klon
-      IF (ok_qx_qw(i)) THEN
-        !! print *,'wake, hw0(i), dthmin(i) ', hw0(i), dthmin(i)
-        !! print *,'wake, 2.*sum_dth(i)/(hw0(i)*dthmin(i)) ', &
-        !!                2.*sum_dth(i)/(hw0(i)*dthmin(i))
-        !! print *,'wake, sum_half_dth(i), sum_dth(i) ', &
-        !!                sum_half_dth(i), sum_dth(i)
-        IF ((hw0(i) < 1.) .or. (dthmin(i) >= -delta_t_min) ) THEN
-          wape2(i) = -1.
-          !! print *,'wake, rej 1'
-        ELSE IF (iflag_wk_check_trgl==1.AND.abs(2.*sum_dth(i)/(hw0(i)*dthmin(i)) - 1.) > 0.5) THEN
-          wape2(i) = -1.
-          !! print *,'wake, rej 2'
-        ELSE IF (abs(sum_half_dth(i)) < 0.5*abs(sum_dth(i)) ) THEN
-          wape2(i) = -1.
-          !! print *,'wake, rej 3'
-        END IF
-      END IF
-    END DO
-  END IF
-
-
-  DO k = 1, klev
-    DO i = 1, klon
-      ! cc nrlmd        IF ( wk_adv(i) .AND. wape2(i) .LT. 0.) THEN
-      IF (ok_qx_qw(i) .AND. wape2(i)<0.) THEN
-        ! cc
-        deltatw(i, k) = 0.
-        deltaqw(i, k) = 0.
-        dth(i, k) = 0.
-        d_deltatw2(i,k) = -deltatw0(i,k)
-        d_deltaqw2(i,k) = -deltaqw0(i,k)
-      END IF
-    END DO
-  END DO
-
-
-  DO i = 1, klon
-    ! cc nrlmd       IF ( wk_adv(i)) THEN
-    IF (ok_qx_qw(i)) THEN
-      ! cc
-      IF (wape2(i)<0.) THEN
-        wape2(i) = 0.
-        cstar2(i) = 0.
-        hw(i) = hwmin
-!jyg<
-!!      sigmaw(i) = amax1(sigmad, sigd_con(i))
-      sigmaw_targ = max(sigmad, sigd_con(i))
-      d_sig_bnd2(i) = d_sig_bnd2(i) + sigmaw_targ - sigmaw(i)
-      d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
-!  print *,'XXXX7 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
-      sigmaw(i) = sigmaw_targ
-!>jyg
-        fip(i) = 0.
-        gwake(i) = .FALSE.
-      ELSE
-        IF (prt_level>=10) PRINT *, 'wape2>0'
-        cstar2(i) = stark*sqrt(2.*wape2(i))
-        gwake(i) = .TRUE.
-      END IF
-    END IF
-  END DO
-
-  DO i = 1, klon
-    ! cc nrlmd       IF ( wk_adv(i)) THEN
-    IF (ok_qx_qw(i)) THEN
-      ! cc
-      ktopw(i) = ktop(i)
-    END IF
-  END DO
-
-  DO i = 1, klon
-    ! cc nrlmd       IF ( wk_adv(i)) THEN
-    IF (ok_qx_qw(i)) THEN
-      ! cc
-      IF (ktopw(i)>0 .AND. gwake(i)) THEN
-
-        ! jyg1     Utilisation d'un h_efficace constant ( ~ feeding layer)
-        ! cc       heff = 600.
-        ! Utilisation de la hauteur hw
-        ! c       heff = 0.7*hw
-        heff(i) = hw(i)
-
-        fip(i) = 0.5*rho(i, ktopw(i))*cstar2(i)**3*heff(i)*2* &
-          sqrt(sigmaw(i)*wdens(i)*3.14)
-        fip(i) = alpk*fip(i)
-        ! jyg2
-      ELSE
-        fip(i) = 0.
-      END IF
-    END IF
-  END DO
-
-  ! Limitation de sigmaw
-
-  ! cc nrlmd
-  ! DO i=1,klon
-  ! IF (OK_qx_qw(i)) THEN
-  ! IF (sigmaw(i).GE.sigmaw_max) sigmaw(i)=sigmaw_max
-  ! ENDIF
-  ! ENDDO
-  ! cc
-
-  !jyg<
-  IF (iflag_wk_pop_dyn >= 1) THEN
-    DO i = 1, klon
-      kill_wake(i) = ((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
-          .NOT. ok_qx_qw(i) .OR. (wdens(i) < 2.*wdensmin)
-    ENDDO
-  ELSE  ! (iflag_wk_pop_dyn >= 1)
-    DO i = 1, klon
-      kill_wake(i) = ((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
-          .NOT. ok_qx_qw(i)
-    ENDDO
-  ENDIF  ! (iflag_wk_pop_dyn >= 1)
-  !>jyg
-
-  DO k = 1, klev
-    DO i = 1, klon
-!!jyg      IF (((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
-!!jyg          .NOT. ok_qx_qw(i)) THEN
-      IF (kill_wake(i)) THEN
-        ! cc
-        dtls(i, k) = 0.
-        dqls(i, k) = 0.
-        deltatw(i, k) = 0.
-        deltaqw(i, k) = 0.
-        d_deltatw2(i,k) = -deltatw0(i,k)
-        d_deltaqw2(i,k) = -deltaqw0(i,k)
-      END IF  ! (kill_wake(i))
-    END DO
-  END DO
-
-  DO i = 1, klon
-!!jyg    IF (((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
-!!jyg        .NOT. ok_qx_qw(i)) THEN
-      IF (kill_wake(i)) THEN
-      ktopw(i) = 0
-      wape(i) = 0.
-      cstar(i) = 0.
-!!jyg   Outside subroutine "Wake" hw, wdens and sigmaw are zero when there are no wakes
-!!      hw(i) = hwmin                       !jyg
-!!      sigmaw(i) = sigmad                  !jyg
-      hw(i) = 0.                            !jyg
-      fip(i) = 0.
-!!      sigmaw(i) = 0.                        !jyg
-      sigmaw_targ = 0.
-      d_sig_bnd2(i) = d_sig_bnd2(i) + sigmaw_targ - sigmaw(i)
-!!      d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
-      d_sigmaw2(i) = sigmaw_targ - sigmaw_in(i)      ! _in = correction jyg 20220124
-!  print *,'XXXX8 d_sigmaw2(i), sigmaw(i) ', d_sigmaw2(i), sigmaw(i)
-      sigmaw(i) = sigmaw_targ
-      IF (iflag_wk_pop_dyn >= 1) THEN
-!!        awdens(i) = 0.
-!!        wdens(i) = 0.
-        wdens_targ = 0.
-        d_dens_bnd2(i) = d_dens_bnd2(i) + wdens_targ - wdens(i)
-!!        d_wdens2(i) = wdens_targ - wdens(i)
-        d_wdens2(i) = wdens_targ - wdens_in(i)      ! jyg 20220916
-        wdens(i) = wdens_targ
-        wdens_targ = 0.
-!!jyg: bug fix : the d_adens_bnd2 computation must be before the update of awdens.
-        IF (iflag_wk_pop_dyn == 2) THEN
-            d_adens_bnd2(i) = d_adens_bnd2(i) + wdens_targ - awdens(i)
-        ENDIF ! (iflag_wk_pop_dyn == 2)
-!!        d_awdens2(i) = wdens_targ - awdens(i)
-        d_awdens2(i) = wdens_targ - awdens_in(i)    ! jyg 20220916
-        awdens(i) = wdens_targ
-!!        IF (iflag_wk_pop_dyn == 2) THEN
-!!            d_adens_bnd2(i) = d_adens_bnd2(i) + wdens_targ - awdens(i)
-!!        ENDIF ! (iflag_wk_pop_dyn == 2)
-      ENDIF  ! (iflag_wk_pop_dyn >= 1)
-    ELSE  ! (kill_wake(i))
-      wape(i) = wape2(i)
-      cstar(i) = cstar2(i)
-    END IF  ! (kill_wake(i))
-    ! c        print*,'wape wape2 ktopw OK_qx_qw =',
-    ! c     $          wape(i),wape2(i),ktopw(i),OK_qx_qw(i)
-  END DO
-
-  IF (prt_level>=10) THEN
-    PRINT *, 'wake-6, wape wape2 ktopw OK_qx_qw =', &
-                      wape(igout),wape2(igout),ktopw(igout),OK_qx_qw(igout)
-  ENDIF
-
-
-  ! -----------------------------------------------------------------
-  ! Get back to tendencies per second
-
-  DO k = 1, klev
-    DO i = 1, klon
-
-      ! cc nrlmd        IF ( wk_adv(i) .AND. k .LE. kupper(i)) THEN
-!jyg<
-!!      IF (ok_qx_qw(i) .AND. k<=kupper(i)) THEN
-      IF (ok_qx_qw(i)) THEN
-!>jyg
-        ! cc
-        dtls(i, k) = dtls(i, k)/dtime
-        dqls(i, k) = dqls(i, k)/dtime
-        d_deltatw2(i, k) = d_deltatw2(i, k)/dtime
-        d_deltaqw2(i, k) = d_deltaqw2(i, k)/dtime
-        d_deltat_gw(i, k) = d_deltat_gw(i, k)/dtime
-        ! c      print*,'k,dqls,omg,entr,detr',k,dqls(i,k),omg(i,k),entr(i,k)
-        ! c     $         ,death_rate(i)*sigmaw(i)
-      END IF
-    END DO
-  END DO
-!jyg<
-  IF (iflag_wk_pop_dyn >= 1) THEN
-  DO i = 1, klon
-      IF (ok_qx_qw(i)) THEN
-    d_sig_gen2(i) = d_sig_gen2(i)/dtime
-    d_sig_death2(i) = d_sig_death2(i)/dtime
-    d_sig_col2(i) = d_sig_col2(i)/dtime
-    d_sig_spread2(i) = d_sig_spread2(i)/dtime
-    d_sig_bnd2(i) = d_sig_bnd2(i)/dtime
-    d_sigmaw2(i) = d_sigmaw2(i)/dtime
-!  print *,'XXXX9 d_sigmaw2(i), sigmaw(i), dtime ', d_sigmaw2(i), sigmaw(i), dtime
-!
-    d_dens_gen2(i) = d_dens_gen2(i)/dtime
-    d_dens_death2(i) = d_dens_death2(i)/dtime
-    d_dens_col2(i) = d_dens_col2(i)/dtime
-    d_dens_bnd2(i) = d_dens_bnd2(i)/dtime
-    d_awdens2(i) = d_awdens2(i)/dtime
-    d_wdens2(i) = d_wdens2(i)/dtime
-      ENDIF
-  ENDDO
-  IF (iflag_wk_pop_dyn == 2) THEN
-    DO i = 1, klon
-      IF (ok_qx_qw(i)) THEN
-    d_adens_death2(i) = d_adens_death2(i)/dtime
-    d_adens_icol2(i) = d_adens_icol2(i)/dtime
-    d_adens_acol2(i) = d_adens_acol2(i)/dtime
-    d_adens_bnd2(i) = d_adens_bnd2(i)/dtime
-      ENDIF
-    ENDDO
-   ENDIF ! (iflag_wk_pop_dyn == 2)  
-  ENDIF  ! (iflag_wk_pop_dyn >= 1)
- 
-!>jyg
-
- RETURN
-END SUBROUTINE wake
-
-SUBROUTINE wake_vec_modulation(nlon, nl, wk_adv, epsilon_loc, qe, d_qe, deltaqw, &
-    d_deltaqw, sigmaw, d_sigmaw, alpha)
-  ! ------------------------------------------------------
-  ! Dtermination du coefficient alpha tel que les tendances
-  ! corriges alpha*d_G, pour toutes les grandeurs G, correspondent
-  ! a une humidite positive dans la zone (x) et dans la zone (w).
-  ! ------------------------------------------------------
-  IMPLICIT NONE
-
-  ! Input
-  REAL qe(nlon, nl), d_qe(nlon, nl)
-  REAL deltaqw(nlon, nl), d_deltaqw(nlon, nl)
-  REAL sigmaw(nlon), d_sigmaw(nlon)
-  LOGICAL wk_adv(nlon)
-  INTEGER nl, nlon
-  ! Output
-  REAL alpha(nlon)
-  ! Internal variables
-  REAL zeta(nlon, nl)
-  REAL alpha1(nlon)
-  REAL x, a, b, c, discrim
-  REAL epsilon_loc
-  INTEGER i,k
-
-  DO k = 1, nl
-    DO i = 1, nlon
-      IF (wk_adv(i)) THEN
-        IF ((deltaqw(i,k)+d_deltaqw(i,k))>=0.) THEN
-          zeta(i, k) = 0.
-        ELSE
-          zeta(i, k) = 1.
-        END IF
-      END IF
-    END DO
-    DO i = 1, nlon
-      IF (wk_adv(i)) THEN
-        x = qe(i, k) + (zeta(i,k)-sigmaw(i))*deltaqw(i, k) + d_qe(i, k) + &
-          (zeta(i,k)-sigmaw(i))*d_deltaqw(i, k) - d_sigmaw(i) * &
-          (deltaqw(i,k)+d_deltaqw(i,k))
-        a = -d_sigmaw(i)*d_deltaqw(i, k)
-        b = d_qe(i, k) + (zeta(i,k)-sigmaw(i))*d_deltaqw(i, k) - &
-          deltaqw(i, k)*d_sigmaw(i)
-        c = qe(i, k) + (zeta(i,k)-sigmaw(i))*deltaqw(i, k) + epsilon_loc
-        discrim = b*b - 4.*a*c
-        ! print*, 'x, a, b, c, discrim', x, a, b, c, discrim
-        IF (a+b>=0.) THEN !! Condition suffisante pour la positivite de ovap
-          alpha1(i) = 1.
-        ELSE
-          IF (x>=0.) THEN
-            alpha1(i) = 1.
-          ELSE
-            IF (a>0.) THEN
-              alpha1(i) = 0.9*min( (2.*c)/(-b+sqrt(discrim)),  &
-                                   (-b+sqrt(discrim))/(2.*a) )
-            ELSE IF (a==0.) THEN
-              alpha1(i) = 0.9*(-c/b)
-            ELSE
-              ! print*,'a,b,c discrim',a,b,c discrim
-              alpha1(i) = 0.9*max( (2.*c)/(-b+sqrt(discrim)),  &
-                                   (-b+sqrt(discrim))/(2.*a))
-            END IF
-          END IF
-        END IF
-        alpha(i) = min(alpha(i), alpha1(i))
-      END IF
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE wake_vec_modulation
-
-
-
-SUBROUTINE pkupper (klon, klev, ptop, ph, pupper, kupper)
-
-USE wake_ini_mod , ONLY : wk_pupper
-IMPLICIT NONE
-
-INTEGER,  INTENT(IN)                              :: klon,klev
-REAL,     INTENT(IN),   DIMENSION (klon,klev+1)   :: ph
-REAL,     INTENT(IN),   DIMENSION (klon)          :: ptop
-REAL,     INTENT(OUT),  DIMENSION (klon)          :: pupper
-INTEGER,  INTENT(OUT),  DIMENSION (klon)          :: kupper
-INTEGER                                           :: i,k
-
-
- kupper = 0
- 
-IF (wk_pupper<1.) THEN
- ! Choose an integration bound well above wake top
-  ! -----------------------------------------------------------------
-
-  ! Pupper = 50000.  ! melting level
-  ! Pupper = 60000.
-  ! Pupper = 80000.  ! essais pour case_e
-  DO i = 1, klon
-  !  pupper(i) = 0.6*ph(i, 1)
-    pupper(i) = wk_pupper*ph(i, 1)
-    pupper(i) = max(pupper(i), 45000.)
-    ! cc        Pupper(i) = 60000.
-  END DO
-
-ELSE
-  
-  DO i=1, klon
-     ! pupper(i) = wk_pupper*ptop(i)+(1.-wk_pupper)*ph(i, 1) 
-     pupper(i) = min( wk_pupper*ptop(i)+(1.-wk_pupper)*ph(i, 1) , ptop(i)-5000.) 
-  END DO
-END IF
- 
-  ! -5/ Determination de kupper
-
-  DO k = klev, 1, -1
-    DO i = 1, klon
-      IF (ph(i,k+1)<pupper(i)) kupper(i) = k
-    END DO
-  END DO
-
-  ! On evite kupper = 1 et kupper = klev
-  DO i = 1, klon
-    kupper(i) = max(kupper(i), 2)
-    kupper(i) = min(kupper(i), klev-1)
-  END DO 
-    RETURN
-END SUBROUTINE pkupper
-
-
-SUBROUTINE wake_popdyn_1(klon, klev, dtime, cstar, tau_wk_inv, wgen, wdens, awdens, sigmaw, &
-                  dtimesub, gfl, rad_wk, f_shear, drdt_pos, &
-                  d_awdens, d_wdens, d_sigmaw, &
-                  iflag_wk_act, wk_adv, cin, wape, &
-                  drdt, &
-                  d_dens_gen, d_dens_death, d_dens_col, d_dens_bnd, &
-                  d_sig_gen, d_sig_death, d_sig_col, d_sig_spread, d_sig_bnd, &
-                  d_wdens_targ, d_sigmaw_targ)
-                
-
-  USE wake_ini_mod , ONLY : wake_ini
-  USE wake_ini_mod , ONLY : prt_level,RG
-  USE wake_ini_mod , ONLY : stark, wdens_ref
-  USE wake_ini_mod , ONLY : tau_cv, rzero, aa0
-  USE wake_ini_mod , ONLY : iflag_wk_pop_dyn, wdensmin
-  USE wake_ini_mod , ONLY : sigmad, cstart, sigmaw_max
-  
-IMPLICIT NONE
-
-  INTEGER, INTENT(IN)                                   :: klon,klev
-  LOGICAL, DIMENSION (klon),        INTENT(IN)          :: wk_adv
-  REAL,                             INTENT(IN)          :: dtime
-  REAL,                             INTENT(IN)          :: dtimesub
-  REAL, DIMENSION (klon),           INTENT(IN)          :: wgen
-  REAL, DIMENSION (klon),           INTENT(IN)          :: wdens
-  REAL, DIMENSION (klon),           INTENT(IN)          :: awdens
-  REAL, DIMENSION (klon),           INTENT(IN)          :: sigmaw
-  REAL, DIMENSION (klon),           INTENT(IN)          :: gfl, cstar
-  REAL, DIMENSION (klon),           INTENT(IN)          :: cin, wape
-  REAL, DIMENSION (klon),           INTENT(IN)          :: rad_wk
-  REAL, DIMENSION (klon),           INTENT(IN)          :: f_shear
-  INTEGER,                          INTENT(IN)          :: iflag_wk_act
-
-  
-  !
- 
-  ! Tendencies of state variables (2 is appended to the names of fields which are the cumul of fields 
-  !                                 computed at each sub-timestep; e.g. d_wdens2 is the cumul of d_wdens)
-  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_sigmaw, d_awdens, d_wdens
-  REAL, DIMENSION (klon),           INTENT(OUT)         :: drdt
-  ! Some components of the tendencies of state variables  
-  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_sig_gen, d_sig_death, d_sig_col, d_sig_bnd
-  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_sig_spread
-  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_dens_gen, d_dens_death, d_dens_col, d_dens_bnd
-  REAL,                             INTENT(OUT)         :: d_wdens_targ, d_sigmaw_targ
- 
-  
-  REAL                                                  :: delta_t_min
-  INTEGER                                               :: nsub
-  INTEGER                                               :: i, k
-  REAL                                                  :: wdens0
-  ! IM 080208
-  LOGICAL, DIMENSION (klon)                             :: gwake
-  
-   ! Variables liees a la dynamique de population
-  REAL, DIMENSION(klon)                                 :: act
-  REAL, DIMENSION(klon)                                 :: tau_wk_inv
-  REAL, DIMENSION(klon)                                 :: wape1_act, wape2_act
-  LOGICAL, DIMENSION (klon)                             :: kill_wake
-  REAL                                                  :: drdt_pos
-  REAL                                                  :: tau_wk_inv_min
-  
-     
-
-      IF (iflag_wk_act == 0) THEN
-        act(:) = 0.
-      ELSEIF (iflag_wk_act == 1) THEN
-        act(:) = 1.
-      ELSEIF (iflag_wk_act ==2) THEN
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          wape1_act(i) = abs(cin(i))
-          wape2_act(i) = 2.*wape1_act(i) + 1.
-          act(i) = min(1., max(0., (wape(i)-wape1_act(i)) / (wape2_act(i)-wape1_act(i)) ))
-        ENDIF  ! (wk_adv(i))
-      ENDDO
-      ENDIF  ! (iflag_wk_act ==2)
-
-
-      DO i = 1, klon
-       ! print*, 'XXX wk_adv(i)', wk_adv(i)
-        IF (wk_adv(i)) THEN
-!!          tau_wk(i) = max(rad_wk(i)/(3.*cstar(i))*((cstar(i)/cstart)**1.5 - 1), 100.)
-          tau_wk_inv(i) = max( (3.*cstar(i))/(rad_wk(i)*((cstar(i)/cstart)**1.5 - 1)), 0.)
-          tau_wk_inv_min = min(tau_wk_inv(i), 1./dtimesub)
-          drdt(i) = (cstar(i) - wgen(i)*(sigmaw(i)/wdens(i)-aa0)/gfl(i)) / &
-                    (1 + 2*f_shear(i)*(2.*sigmaw(i)-aa0*wdens(i)) - 2.*sigmaw(i))
-!!                    (1 - 2*sigmaw(i)*(1.-f_shear(i)))
-          drdt_pos=max(drdt(i),0.)
-
-!!          d_wdens(i) = ( wgen(i)*(1.+2.*(sigmaw(i)-sigmad)) &
-!!                     - wdens(i)*tau_wk_inv_min &
-!!                     - 2.*gfl(i)*wdens(i)*Cstar(i) )*dtimesub
-!jyg+mlt<
-          d_awdens(i) = ( wgen(i) - (1./tau_cv)*(awdens(i) - act(i)*wdens(i)) )*dtimesub
-          d_dens_gen(i) = wgen(i)
-          d_dens_death(i) = - (wdens(i)-awdens(i))*tau_wk_inv_min 
-          d_dens_col(i) =  -2.*wdens(i)*gfl(i)*drdt_pos 
-          d_dens_gen(i) =  d_dens_gen(i)*dtimesub
-          d_dens_death(i) = d_dens_death(i)*dtimesub
-          d_dens_col(i) =  d_dens_col(i)*dtimesub 
-
-          d_wdens(i) = d_dens_gen(i)+d_dens_death(i)+d_dens_col(i)
-!!          d_wdens(i) = ( wgen(i) - (wdens(i)-awdens(i))*tau_wk_inv_min -  &
-!!                         2.*wdens(i)*gfl(i)*drdt_pos )*dtimesub
-!>jyg+mlt
-!
-!jyg<
-          d_wdens_targ = max(d_wdens(i), wdensmin-wdens(i))
-!!          d_dens_bnd(i) = d_dens_bnd(i) + d_wdens_targ - d_wdens(i)
-          d_dens_bnd(i) = d_wdens_targ - d_wdens(i)
-          d_wdens(i) = d_wdens_targ
-!!          d_wdens(i) = max(d_wdens(i), wdensmin-wdens(i))
-!>jyg
-
-!jyg+mlt<
-!!          d_sigmaw(i) = ( (1.-2*f_shear(i)*sigmaw(i))*(gfl(i)*Cstar(i)+wgen(i)*sigmad/wdens(i)) &
-!!                      + 2.*f_shear(i)*wgen(i)*sigmaw(i)**2/wdens(i) &
-!!                      - sigmaw(i)*tau_wk_inv_min )*dtimesub
-          d_sig_gen(i) = wgen(i)*aa0
-!!          print*, 'XXX sigmaw(i), awdens(i), wdens(i), tau_wk_inv_min', &
-!!                  sigmaw(i), awdens(i), wdens(i), tau_wk_inv_min
-          d_sig_death(i) = - sigmaw(i)*(1.-awdens(i)/wdens(i))*tau_wk_inv_min
-!!        
-          
-          d_sig_col(i) = - 2*f_shear(i)*sigmaw(i)*gfl(i)*drdt_pos
-          d_sig_col(i) = - 2*f_shear(i)*(2.*sigmaw(i)-wdens(i)*aa0)*gfl(i)*drdt_pos
-          d_sig_spread(i) = gfl(i)*cstar(i)
-          d_sig_gen(i) =  d_sig_gen(i)*dtimesub
-          d_sig_death(i) = d_sig_death(i)*dtimesub
-          d_sig_col(i) =  d_sig_col(i)*dtimesub 
-          d_sig_spread(i) =  d_sig_spread(i)*dtimesub 
-          d_sigmaw(i) =  d_sig_gen(i) + d_sig_death(i) + d_sig_col(i) + d_sig_spread(i)
-!>jyg+mlt
-!
-!jyg<
-          d_sigmaw_targ = max(d_sigmaw(i), sigmad-sigmaw(i))
-!!          d_sig_bnd(i) = d_sig_bnd(i) + d_sigmaw_targ - d_sigmaw(i)
-!!          d_sig_bnd_provis(i) = d_sigmaw_targ - d_sigmaw(i)
-          d_sig_bnd(i) = d_sigmaw_targ - d_sigmaw(i)
-          d_sigmaw(i) = d_sigmaw_targ
-!!          d_sigmaw(i) = max(d_sigmaw(i), sigmad-sigmaw(i))
-!>jyg
-        ENDIF
-      ENDDO
-
-      IF (prt_level >= 10) THEN
-        print *,'wake, cstar(1), cstar(1)/cstart, rad_wk(1), tau_wk_inv(1), drdt(1) ', &
-                       cstar(1), cstar(1)/cstart, rad_wk(1), tau_wk_inv(1), drdt(1)
-        print *,'wake, wdens(1), awdens(1), act(1), d_awdens(1) ', &
-                       wdens(1), awdens(1), act(1), d_awdens(1)
-        print *,'wake, wgen, -(wdens-awdens)*tau_wk_inv, -2.*wdens*gfl*drdt_pos, d_wdens ', &
-                       wgen(1), -(wdens(1)-awdens(1))*tau_wk_inv(1), -2.*wdens(1)*gfl(1)*drdt_pos, d_wdens(1)
-        print *,'wake, d_sig_gen(1), d_sig_death(1), d_sig_col(1), d_sigmaw(1) ', &
-                       d_sig_gen(1), d_sig_death(1), d_sig_col(1), d_sigmaw(1)
-      ENDIF
-    
-    RETURN 
-    END SUBROUTINE wake_popdyn_1
-    
-    SUBROUTINE wake_popdyn_2 ( klon, klev, wk_adv, dtimesub, wgen, &
-                             sigmaw, wdens, awdens, &   !! states variables
-                             gfl, cstar, cin, wape, rad_wk, &
-                             d_sigmaw, d_wdens, d_awdens, &  !! tendences 
-                             cont_fact, &
-                             d_sig_gen, d_sig_death, d_sig_col, d_sig_spread, d_sig_bnd, &
-                             d_dens_gen, d_dens_death, d_dens_col, d_dens_bnd, &
-                             d_adens_death, d_adens_icol, d_adens_acol, d_adens_bnd )
-                             
-                                             
-
-  USE wake_ini_mod , ONLY : wake_ini
-  USE wake_ini_mod , ONLY : prt_level,RG
-  USE wake_ini_mod , ONLY : stark, wdens_ref
-  USE wake_ini_mod , ONLY : tau_cv, rzero, aa0
-  USE wake_ini_mod , ONLY : iflag_wk_pop_dyn, wdensmin
-  USE wake_ini_mod , ONLY : sigmad, cstart, sigmaw_max
-  
-IMPLICIT NONE
-
-  INTEGER, INTENT(IN)                                   :: klon,klev
-  LOGICAL, DIMENSION (klon),        INTENT(IN)          :: wk_adv
-  REAL,                             INTENT(IN)          :: dtimesub
-  REAL, DIMENSION (klon),           INTENT(IN)          :: wgen      !! B = birth rate of wakes
-  REAL, DIMENSION (klon),           INTENT(INOUT)       :: sigmaw    !! sigma = fractional area of wakes 
-  REAL, DIMENSION (klon),           INTENT(INOUT)       :: wdens     !! D = number of wakes per unit area 
-  REAL, DIMENSION (klon),           INTENT(INOUT)       :: awdens    !! A = number of active wakes per unit area
-  REAL, DIMENSION (klon),           INTENT(IN)          :: gfl       !! Lg = gust front lenght per unit area
-  REAL, DIMENSION (klon),           INTENT(IN)          :: cstar     !! C* = spreading velocity of wakes
-  REAL, DIMENSION (klon),           INTENT(IN)          :: cin, wape  ! RM : A Faire disparaitre
-  REAL, DIMENSION (klon),           INTENT(IN)          :: rad_wk    !! r = wake radius
-
-!  
-  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_sigmaw, d_wdens, d_awdens
-  REAL, DIMENSION (klon),           INTENT(OUT)         :: cont_fact  !! RM facteur de contact = 2 pi * rad * C*
-  ! Some components of the tendencies of state variables  
-  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_sig_gen, d_sig_death, d_sig_col, d_sig_spread, d_sig_bnd
-  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_dens_gen, d_dens_death, d_dens_col, d_dens_bnd
-  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_adens_death, d_adens_icol, d_adens_acol, d_adens_bnd
-
-
-!! internal variables
-  
-  INTEGER                                               :: i, k
-  REAL, DIMENSION (klon)                                :: tau_wk_inv      !! tau = life time of wakes
-  REAL                                                  :: tau_wk_inv_min
-  REAL, DIMENSION (klon)                                :: tau_prime       !! tau_prime = life time of actives wakes
-  REAL                                                  :: d_wdens_targ, d_sigmaw_targ
-  
-
-!! Equations
-!! dD/dt = B - (D-A)/tau - f D^2
-!! dA/dt = B - A/tau_prime + f (D-A)^2 - f A^2
-!! dsigma/dt = B a0 - sigma/D (D-A)/tau + Lg C* - f (D-A)^2 (sigma/D-a0)
-!!
-!! f = 2 (B (a0-sigma/D) + Lg C*) / (2 (D-A)^2 (2 sigma/D-a0) + D (1-2 sigma))
-
-
-      DO i = 1, klon
-       ! print*, 'XXX wk_adv(i)', wk_adv(i)
-        IF (wk_adv(i)) THEN
-!!          tau_wk(i) = max(rad_wk(i)/(3.*cstar(i))*((cstar(i)/cstart)**1.5 - 1), 100.)
-          tau_wk_inv(i) = max( (3.*cstar(i))/(rad_wk(i)*((cstar(i)/cstart)**1.5 - 1)), 0.)
-          tau_wk_inv_min = min(tau_wk_inv(i), 1./dtimesub)
-          tau_prime(i) = tau_cv
-!!          cont_fact(i) = 2.*(wgen(i)*(aa0-sigmaw(i)/wdens(i)) + gfl(i)*cstar(i)) / &
-!!                             (2.*(wdens(i)-awdens(i))**2*(2.*sigmaw(i)/wdens(i) - aa0) + wdens(i)*(1.-2.*sigmaw(i)))
-!!          cont_fact(i) = 2.*3.14*rad_wk(i)*cstar(i)     ! bug
-!!          cont_fact(i) = 4.*3.14*rad_wk(i)*cstar(i)
-          cont_fact(i) = 2.*gfl(i)*cstar(i)/wdens(i)
-
-          d_sig_gen(i) = wgen(i)*aa0
-          d_sig_death(i) = - sigmaw(i)*(1.-awdens(i)/wdens(i))*tau_wk_inv_min
-          d_sig_col(i) = - cont_fact(i)*(wdens(i)-awdens(i))**2*(2.*sigmaw(i)/wdens(i)-aa0)
-          d_sig_spread(i) = gfl(i)*cstar(i)
-!
-          d_sig_gen(i) =  d_sig_gen(i)*dtimesub
-          d_sig_death(i) = d_sig_death(i)*dtimesub
-          d_sig_col(i) =  d_sig_col(i)*dtimesub 
-          d_sig_spread(i) =  d_sig_spread(i)*dtimesub 
-          d_sigmaw(i) =  d_sig_gen(i) + d_sig_death(i) + d_sig_col(i) + d_sig_spread(i)
-
-         
-          d_sigmaw_targ = max(d_sigmaw(i), sigmad-sigmaw(i))
-!!          d_sig_bnd(i) = d_sig_bnd(i) + d_sigmaw_targ - d_sigmaw(i)
-!!          d_sig_bnd_provis(i) = d_sigmaw_targ - d_sigmaw(i)
-          d_sig_bnd(i) = d_sigmaw_targ - d_sigmaw(i)
-          d_sigmaw(i) = d_sigmaw_targ
-!!          d_sigmaw(i) = max(d_sigmaw(i), sigmad-sigmaw(i))
-         
-         
-          d_dens_gen(i) = wgen(i)
-          d_dens_death(i) = - (wdens(i)-awdens(i))*tau_wk_inv_min 
-          d_dens_col(i) =  - cont_fact(i)*wdens(i)**2
-! 
-          d_dens_gen(i) =  d_dens_gen(i)*dtimesub
-          d_dens_death(i) = d_dens_death(i)*dtimesub
-          d_dens_col(i) =  d_dens_col(i)*dtimesub 
-          d_wdens(i) = d_dens_gen(i) + d_dens_death(i) + d_dens_col(i)
-
-
-          d_adens_death(i) = -awdens(i)/tau_prime(i)
-          d_adens_icol(i) = cont_fact(i)*(wdens(i)-awdens(i))**2
-          d_adens_acol(i) = - cont_fact(i)*awdens(i)**2
-!
-          d_adens_death(i) =  d_adens_death(i)*dtimesub
-          d_adens_icol(i) =   d_adens_icol(i)*dtimesub
-          d_adens_acol(i) =   d_adens_acol(i)*dtimesub
-          d_awdens(i) =   d_dens_gen(i) + d_adens_death(i) + d_adens_icol(i) + d_adens_acol(i)     
-            
-!!
-          d_wdens_targ = max(d_wdens(i), wdensmin-wdens(i))
-!!          d_dens_bnd(i) = d_dens_bnd(i) + d_wdens_targ - d_wdens(i)
-          d_dens_bnd(i) = d_wdens_targ - d_wdens(i)
-          d_wdens(i) = d_wdens_targ
-          
-          d_wdens_targ = min(max(d_awdens(i),-awdens(i)), wdens(i)-awdens(i))
-!!          d_dens_bnd(i) = d_dens_bnd(i) + d_wdens_targ - d_wdens(i)
-          d_adens_bnd(i) = d_wdens_targ - d_awdens(i)
-          d_awdens(i) = d_wdens_targ
-
-
-
-        ENDIF
-      ENDDO
-
-      IF (prt_level >= 10) THEN
-        print *,'wake, cstar(1), cstar(1)/cstart, rad_wk(1), tau_wk_inv(1), cont_fact(1) ', &
-                       cstar(1), cstar(1)/cstart, rad_wk(1), tau_wk_inv(1), cont_fact(1)
-        print *,'wake, wdens(1), awdens(1), d_awdens(1) ', &
-                       wdens(1), awdens(1), d_awdens(1)
-        print *,'wake, d_sig_gen(1), d_sig_death(1), d_sig_col(1), d_sigmaw(1) ', &
-                       d_sig_gen(1), d_sig_death(1), d_sig_col(1), d_sigmaw(1)
-      ENDIF
-sigmaw=sigmaw+d_sigmaw
-wdens=wdens+d_wdens
-awdens=awdens+d_awdens
-
-    RETURN 
-    END SUBROUTINE wake_popdyn_2  
-  
Index: DZ6/branches/LMDZ_ECRad/libf/phylmd/wake_ini_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/wake_ini_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,219 +1,0 @@
-MODULE wake_ini_mod
-IMPLICIT NONE 
-
-
-  ! ============================================================================
-
-
-  ! But : Decrire le comportement des poches froides apparaissant dans les
-  ! grands systemes convectifs, et fournir l'energie disponible pour
-  ! le declenchement de nouvelles colonnes convectives.
-
-  ! State variables : 
-  ! deltatw    : temperature difference between wake and off-wake regions
-  ! deltaqw    : specific humidity difference between wake and off-wake regions
-  ! sigmaw     : fractional area covered by wakes.
-  ! wdens      : number of wakes per unit area
-
-  ! -------------------------------------------------------------------------
-  ! Declaration de variables
-  ! -------------------------------------------------------------------------
-
-  ! Variables a fixer
-!jyg<
-!!  REAL, SAVE                                            :: stark, wdens_ref, coefgw, alpk
-  INTEGER, SAVE, PROTECTED                                         :: prt_level
-  REAL, SAVE, PROTECTED, DIMENSION(2)                              :: wdens_ref
-  REAL, SAVE, PROTECTED                                            :: stark, coefgw, alpk, wk_pupper
-!>jyg
-  REAL, SAVE, PROTECTED                                            :: crep_upper, crep_sol  
-  !$OMP THREADPRIVATE(stark, wdens_ref, coefgw, alpk, wk_pupper, crep_upper, crep_sol)
-
-  REAL, SAVE, PROTECTED                                            :: tau_cv
-  !$OMP THREADPRIVATE(tau_cv)
-  REAL, SAVE, PROTECTED                                            :: rzero, aa0 ! minimal wake radius and area
-  !$OMP THREADPRIVATE(rzero, aa0)
-
-  LOGICAL, SAVE, PROTECTED                                         :: flag_wk_check_trgl
-  !$OMP THREADPRIVATE(flag_wk_check_trgl)
-  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_act
-  !$OMP THREADPRIVATE(iflag_wk_act)
-
-  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_check_trgl
-  !$OMP THREADPRIVATE(iflag_wk_check_trgl)
-  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_pop_dyn
-  !$OMP THREADPRIVATE(iflag_wk_pop_dyn)
-
-  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_profile
-  !$OMP THREADPRIVATE(iflag_wk_profile)
-
-  REAL, SAVE, PROTECTED                                            :: wdensmin
-  !$OMP THREADPRIVATE(wdensmin)
-  REAL, SAVE, PROTECTED                                            :: sigmad, hwmin, wapecut, cstart
-  !$OMP THREADPRIVATE(sigmad, hwmin, wapecut, cstart)
-  REAL, SAVE, PROTECTED                                            :: sigmaw_max
-  !$OMP THREADPRIVATE(sigmaw_max)  
-  REAL, SAVE, PROTECTED                                            :: dens_rate
-  !$OMP THREADPRIVATE(dens_rate)
-  REAL, SAVE, PROTECTED                                            :: epsilon_loc
-  !$OMP THREADPRIVATE(epsilon_loc)
-  REAL, SAVE, PROTECTED                                            :: epsim1,RG,RD
-  !$OMP THREADPRIVATE(epsim1,RG,RD)
-
-
-
-CONTAINS
-
-  ! =========================================================================
-  SUBROUTINE wake_ini(rg_in,rd_in,rv_in,prt_lev)
-  ! =========================================================================
-
-  ! **************************************************************
-  ! *
-  ! WAKE                                                        *
-  ! retour a un Pupper fixe                                *
-  ! *
-  ! written by   :  GRANDPEIX Jean-Yves   09/03/2000            *
-  ! modified by :   ROEHRIG Romain        01/29/2007            *
-  ! **************************************************************
-
-  ! -------------------------------------------------------------------------
-  ! Initialisations
-  ! -------------------------------------------------------------------------
-
-  USE ioipsl_getin_p_mod, ONLY : getin_p
-  real eps
-  integer, intent(in) :: prt_lev
-  real, intent(in) :: rg_in,rd_in,rv_in
-
-  prt_level=prt_lev
-  epsilon_loc=1.E-15
-  wapecut=1. ! previously 5.
-  ! Essais d'initialisation avec sigmaw = 0.02 et hw = 10.
-  sigmad=0.02
-  hwmin=10.
-!!  DATA wdensmin/1.e-12/
-  wdensmin=1.e-14
-  ! cc nrlmd
-  sigmaw_max=0.4
-  dens_rate=0.1
-
-  eps = rd_in/rv_in
-  epsim1 = 1.0/eps - 1.0
-  RG=rg_in
-  RD=rd_in
-
-
-  ! cc
-  ! Longueur de maille (en m)
-  ! -------------------------------------------------------------------------
-
-  ! ALON = 3.e5
-  ! alon = 1.E6
-
-  ! Configuration de coefgw,stark,wdens (22/02/06 by YU Jingmei)
-
-  ! coefgw : Coefficient pour les ondes de gravite
-  ! stark : Coefficient k dans Cstar=k*sqrt(2*WAPE)
-  ! wdens : Densite surfacique de poche froide
-  ! -------------------------------------------------------------------------
-
-  ! cc nrlmd      coefgw=10
-  ! coefgw=1
-  ! wdens0 = 1.0/(alon**2)
-  ! cc nrlmd      wdens = 1.0/(alon**2)
-  ! cc nrlmd      stark = 0.50
-  ! CRtest
-  ! cc nrlmd      alpk=0.1
-  ! alpk = 1.0
-  ! alpk = 0.5
-  ! alpk = 0.05
-
-
-
-  crep_upper = 0.9
-  crep_sol = 1.0
-
-  ! Get wapecut from parameter file
-  wapecut = 1.
-
-print*,'wapecut',wapecut
-  CALL getin_p('wapecut', wapecut)
-print*,'wapecut',wapecut
-
-  ! cc nrlmd Lecture du fichier wake_param.data
-
-
-  ! cc nrlmd Lecture du fichier wake_param.data
-  stark=0.33
-  CALL getin_p('stark',stark)
-  cstart = stark*sqrt(2.*wapecut)
-
-  alpk=0.25
-  CALL getin_p('alpk',alpk)
-  
-  wk_pupper=0.6
-  CALL getin_p('wk_pupper',wk_pupper)
-
-
-!jyg<
-!!  wdens_ref=8.E-12
-!!  CALL getin_p('wdens_ref',wdens_ref)
-  wdens_ref(1)=8.E-12
-  wdens_ref(2)=8.E-12
-  CALL getin_p('wdens_ref_o',wdens_ref(1))    !wake number per unit area ; ocean
-  CALL getin_p('wdens_ref_l',wdens_ref(2))    !wake number per unit area ; land
-!>jyg
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!  Population dynamics parameters    !!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!------------------------------------------------------------------------ 
-
-  iflag_wk_pop_dyn = 0
-  CALL getin_p('iflag_wk_pop_dyn',iflag_wk_pop_dyn) ! switch between wdens prescribed 
-                                                    ! and wdens prognostic
-  iflag_wk_act = 0
-  CALL getin_p('iflag_wk_act',iflag_wk_act) ! 0: act(:)=0.
-                                            ! 1: act(:)=1.
-                                            ! 2: act(:)=f(Wape)
-
-  iflag_wk_profile = 0
-  CALL getin_p('iflag_wk_profile',iflag_wk_profile) ! switch between wdens prescribed 
-                                                    ! and wdens prognostic
-  rzero = 5000.
-  CALL getin_p('rzero_wk', rzero)
-  aa0 = 3.14*rzero*rzero
-!
-  tau_cv = 4000.
-  CALL getin_p('tau_cv', tau_cv)
-
-!------------------------------------------------------------------------ 
-
-  coefgw=4.
-  CALL getin_p('coefgw',coefgw)
-
-  WRITE(*,*) 'stark=', stark
-  WRITE(*,*) 'alpk=', alpk
-  WRITE(*,*) 'wk_pupper=', wk_pupper
-!jyg<
-!!  WRITE(*,*) 'wdens_ref=', wdens_ref
-  WRITE(*,*) 'wdens_ref_o=', wdens_ref(1)
-  WRITE(*,*) 'wdens_ref_l=', wdens_ref(2)
-!>jyg
-  WRITE(*,*) 'iflag_wk_pop_dyn=',iflag_wk_pop_dyn
-  WRITE(*,*) 'iflag_wk_act',iflag_wk_act
-  WRITE(*,*) 'coefgw=', coefgw 
-
-  flag_wk_check_trgl=.false.
-  CALL getin_p('flag_wk_check_trgl ', flag_wk_check_trgl)
-  WRITE(*,*) 'flag_wk_check_trgl=', flag_wk_check_trgl
-  WRITE(*,*) 'flag_wk_check_trgl OBSOLETE. Utilisr iflag_wk_check_trgl plutot'
-  iflag_wk_check_trgl=0 ; IF (flag_wk_check_trgl) iflag_wk_check_trgl=1
-  CALL getin_p('iflag_wk_check_trgl ', iflag_wk_check_trgl)
-  WRITE(*,*) 'iflag_wk_check_trgl=', iflag_wk_check_trgl
-
- RETURN
-
-END SUBROUTINE wake_ini
-
-END MODULE wake_ini_mod
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/yamada.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/yamada.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/yamada.F90	(revision 4727)
@@ -128,5 +128,5 @@
     l0(ig) = 100.
   END DO
-  DO k = 2, klev - 1
+  DO k = 2, klev
     DO ig = 1, ngrid
       l(ig, k) = l0(ig)*kap*zlev(ig, k)/(kap*zlev(ig,k)+l0(ig))
@@ -139,5 +139,6 @@
       sqz(ig) = 1.E-10
     END DO
-    DO k = 2, klev - 1
+    !DO k = 2, klev - 1
+    DO k = 2, klev
       DO ig = 1, ngrid
         q2(ig, k) = l(ig, k)**2*zz(ig, k)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/yamada_c.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/yamada_c.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmd/yamada_c.F90	(revision 4727)
@@ -10,5 +10,5 @@
 
       IMPLICIT NONE
-#include "YOMCST.h"
+      INCLUDE "YOMCST.h"
 !
 ! timestep : pas de temps
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/StratAer
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/StratAer	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/StratAer	(revision 4727)
@@ -1,1 +1,1 @@
-link ../phylmd/StratAer/
+link ../phylmd/StratAer
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/add_phys_tend_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/add_phys_tend_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/add_phys_tend_mod.F90	(revision 4727)
@@ -16,5 +16,5 @@
 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 &
 #ifdef ISO
         ,zdxt,zdxtl,zdxti &
@@ -62,5 +62,5 @@
   ! ------------
   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)
@@ -104,5 +104,5 @@
     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 &
 #ifdef ISO
         ,zzdxt,zdxtl,zdxti &
@@ -110,5 +110,5 @@
         )
   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 &
 #ifdef ISO
         ,zdxt,zdxtl,zdxti &
@@ -123,5 +123,5 @@
 ! $Id$
 !
-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 &
 #ifdef ISO
@@ -142,5 +142,5 @@
 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
 #ifdef ISO
 USE phys_local_var_mod, ONLY: xtl_seri, xts_seri, xt_seri
@@ -150,6 +150,6 @@
 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
 
 #ifdef ISO
@@ -167,5 +167,5 @@
 !------------
 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
@@ -197,5 +197,5 @@
 ! 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
@@ -228,7 +228,9 @@
 ! 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)
 !
@@ -237,7 +239,8 @@
 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)
 
@@ -278,4 +281,5 @@
     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(:,:)
@@ -304,7 +308,7 @@
 
     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)
@@ -313,4 +317,23 @@
 ! Ajout des tendances sur le vent et l'eau liquide
 !======================================================================
+
+#ifdef ISO
+#ifdef ISOVERIF
+        if (iso_eau.gt.0) then
+          call iso_verif_egalite_vect2D( &
+                xt_seri,q_seri, &
+                'add_phys_tend 321a: '//text,ntraciso,klon,klev)
+          call iso_verif_egalite_vect2D( &
+                xtl_seri,ql_seri, &
+                'add_phys_tend 321b: '//text,ntraciso,klon,klev)
+         endif !if (iso_eau.gt.0) then
+#ifdef ISOTRAC
+        call iso_verif_traceur_vect(xt_seri,klon,klev, &
+     &           'add_phys_tend 328a: '//text)
+        call iso_verif_traceur_vect(xtl_seri,klon,klev, &
+     &           'add_phys_tend 328b: '//text)
+#endif
+#endif
+#endif
 
      u_seri(:,:)=u_seri(:,:)+zdu(:,:)
@@ -318,4 +341,5 @@
      ql_seri(:,:)=ql_seri(:,:)+zdql(:,:)
      qs_seri(:,:)=qs_seri(:,:)+zdqi(:,:)
+     qbs_seri(:,:)=qbs_seri(:,:)+zdqbs(:,:)
 #ifdef ISO 
      xtl_seri(:,:,:)=xtl_seri(:,:,:)+zdxtl(:,:,:) 
@@ -370,4 +394,10 @@
                 'add_phys_tend 138: '//text,ntraciso,klon,klev)
          endif !if (iso_eau.gt.0) then
+#ifdef ISOTRAC
+        call iso_verif_traceur_vect(xt_seri,klon,klev, &
+     &           'add_phys_tend 374a: '//text)
+        call iso_verif_traceur_vect(xtl_seri,klon,klev, &
+     &           'add_phys_tend 374b: '//text)
+#endif
 #endif
 #endif
@@ -495,4 +525,8 @@
                         'add_phys_tend 175'//text,ntraciso,klon,klev)
       endif !if (iso_eau.gt.0) then
+#ifdef ISOTRAC
+        call iso_verif_traceur_vect(xt_seri,klon,klev, &
+     &           'add_phys_tend 499'//text)
+#endif
 #endif
 #endif
@@ -572,4 +606,5 @@
         ql_seri(:,:)=ql_seri(:,:)-zdql(:,:)
         qs_seri(:,:)=qs_seri(:,:)-zdqi(:,:)
+        qbs_seri(:,:)=qbs_seri(:,:)-zdqbs(:,:)
       ENDIF
 
@@ -586,7 +621,7 @@
 
     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))
 
     ! ------------------------------------------------
@@ -597,5 +632,6 @@
     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
@@ -605,4 +641,5 @@
     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 
@@ -616,4 +653,5 @@
     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(:,:)
@@ -630,6 +668,6 @@
 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 
@@ -647,6 +685,6 @@
 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"
@@ -657,7 +695,7 @@
 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
@@ -666,5 +704,5 @@
 !--------
 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
 
 
@@ -689,5 +727,6 @@
 ! 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)
 !
@@ -696,7 +735,8 @@
 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)
 
@@ -731,7 +771,7 @@
 
     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)
@@ -746,4 +786,5 @@
      ql_n(:,:)=ql(:,:)+zdql(:,:)
      qs_n(:,:)=qs(:,:)+zdqs(:,:)
+     qbs_n(:,:)=qbs(:,:)+zdqbs(:,:)
      temp_n(:,:)=temp(:,:)+zdt(:,:)
 
@@ -762,7 +803,7 @@
 
     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))
 
     ! ------------------------------------------------
@@ -773,5 +814,6 @@
     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
@@ -785,4 +827,5 @@
     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 
@@ -795,7 +838,7 @@
 
 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
@@ -804,14 +847,14 @@
 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
 
@@ -823,4 +866,5 @@
     zql_col(:) = 0.
     zqs_col(:) = 0.
+    zqbs_col(:) = 0.
     zek_col(:) = 0.
     zh_dair_col(:) = 0.
@@ -828,4 +872,5 @@
     zh_ql_col(:) = 0.
     zh_qs_col(:) = 0.
+    zh_qbs_col(:) = 0.
 
 !JLD    write (*,*) "rcpd, zcpvap, zcwat, zcice ",rcpd, zcpvap, zcwat, zcice
@@ -840,4 +885,5 @@
         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)
@@ -848,8 +894,9 @@
         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
@@ -866,12 +913,12 @@
 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
@@ -910,4 +957,7 @@
       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)
@@ -946,6 +996,6 @@
   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
 
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/atke_exchange_coeff_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/atke_exchange_coeff_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/atke_exchange_coeff_mod.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/atke_turbulence_ini_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/atke_turbulence_ini_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/atke_turbulence_ini_mod.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/calcratqs.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/calcratqs.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/calcratqs.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/calcratqs_multi_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/calcratqs_multi_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/calcratqs_multi_mod.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/calwake.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/calwake.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/calwake.F90	(revision 4727)
@@ -39,4 +39,6 @@
   USE isotopes_mod, ONLY: iso_eau
   USE isotopes_verif_mod
+  USE lmdz_wake, ONLY : wake
+
 #endif
 #endif
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/chemistry_cycle_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/chemistry_cycle_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/chemistry_cycle_mod.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/chemistry_cycle_mod.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/clc_core_cp.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/clc_core_cp.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/clc_core_cp.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/clc_core_cp.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/climb_qbs_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/climb_qbs_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/climb_qbs_mod.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/climb_qbs_mod.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/cloudth_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cloudth_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/cloudth_mod.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/coare30_flux_cnrm.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/coare30_flux_cnrm.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/coare30_flux_cnrm.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/coare30_flux_cnrm.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/coare_cp.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/coare_cp.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/coare_cp.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/coare_cp.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/concvl.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/concvl.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/concvl.F90	(revision 4727)
@@ -3,5 +3,5 @@
                   t, q, t_wake, q_wake, s_wake, u, v, tra, ntra, &
                   Ale, Alp, sig1, w01, &
-                  d_t, d_q, d_u, d_v, d_tra, &
+                  d_t, d_q, d_qcomp, d_u, d_v, d_tra, &
                   rain, snow, kbas, ktop, sigd, &
                   cbmf, plcl, plfc, wbeff, convoccur, &
@@ -16,5 +16,5 @@
                   dd_t, dd_q, lalim_conv, wght_th, &                 ! RomP
                   evap, ep, epmlmMm, eplaMm, &                       ! RomP
-                  wdtrainA, wdtrainS, wdtrainM, wght, qtc, sigt, &
+                  wdtrainA, wdtrainS, wdtrainM, wght, qtc, sigt, detrain, &
                   tau_cld_cv, coefw_cld_cv, &                           ! RomP+RL, AJ
 !RomP <<<
@@ -138,5 +138,5 @@
   REAL, DIMENSION(klon,klev),   INTENT(INOUT)   :: sig1, w01
 
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: d_t, d_q, d_u, d_v
+  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: d_t, d_q, d_qcomp, d_u, d_v
   REAL, DIMENSION(klon,klev, nbtr),INTENT(OUT)  :: d_tra
   REAL, DIMENSION(klon),        INTENT(OUT)     :: rain, snow
@@ -186,5 +186,5 @@
   REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: wght                       !RL
   REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: qtc
-  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: sigt
+  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: sigt, detrain
   REAL,                         INTENT(OUT)     :: tau_cld_cv, coefw_cld_cv
   REAL, DIMENSION(klon),        INTENT(OUT)     :: epmax_diag                ! epmax_cape
@@ -588,5 +588,5 @@
                     Ale, Alp, omega, &
                     em_sig1feed, em_sig2feed, em_wght, &
-                    iflag, d_t, d_q, d_u, d_v, d_tra, rain, kbas, ktop, &
+                    iflag, d_t, d_q, d_qcomp, d_u, d_v, d_tra, rain, kbas, ktop, &
                     cbmf, plcl, plfc, wbeff, sig1, w01, ptop2, sigd, &
                     Ma, mip, Vprecip, Vprecipi, upwd, dnwd, dnwdbis, qcondc, wd, &
@@ -599,5 +599,5 @@
                     da, phi, mp, phii, d1a, dam, sij, wght, &           ! RomP+RL
                     qta, clw, elij, evap, ep, epmlmMm, eplaMm, &        ! RomP+RL
-                    wdtrainA, wdtrainS, wdtrainM, qtc, sigt, &
+                    wdtrainA, wdtrainS, wdtrainM, qtc, sigt, detrain, &
                     tau_cld_cv, coefw_cld_cv, &                         ! RomP,AJ
 !AC!+!RomP+jyg
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_etat0_limit_unstruct.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_etat0_limit_unstruct.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/create_etat0_limit_unstruct.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_etat0_limit_unstruct_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_etat0_limit_unstruct_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_etat0_limit_unstruct_mod.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/create_etat0_limit_unstruct_mod.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_etat0_unstruct.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_etat0_unstruct.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/create_etat0_unstruct.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_etat0_unstruct_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_etat0_unstruct_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_etat0_unstruct_mod.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/create_etat0_unstruct_mod.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_limit_unstruct.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_limit_unstruct.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/create_limit_unstruct.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_limit_unstruct_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_limit_unstruct_mod.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/create_limit_unstruct_mod.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/create_limit_unstruct_mod.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv30_routines.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv30_routines.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv30_routines.F90	(revision 4727)
@@ -2647,7 +2647,7 @@
      &          )
 #ifdef ISO
-    use infotrac_phy, ONLY: ntraciso=>ntiso
+    use infotrac_phy, ONLY: ntraciso=>ntiso, niso
     use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO,ridicule
-    use isotopes_routines_mod, ONLY: appel_stewart_vectall
+    use isotopes_routines_mod, ONLY: appel_stewart_vectall,appel_stewart_debug
 #ifdef ISOVERIF
     use isotopes_verif_mod, ONLY: errmax,errmaxrel, &
@@ -3208,4 +3208,6 @@
        enddo
 #endif
+
+        if (1.eq.0) then
         ! appel de appel_stewart_vectorise
         call appel_stewart_vectall(lwork,ncum, &
@@ -3218,4 +3220,13 @@
      &          i,inb, & ! altitude: car cas particulier en INB 
      &          na,nd,nloc,cvflag_grav,ginv,1e-16)
+
+        else !if (1.eq.0) then
+          ! truc simple sans fractionnement
+          ! juste pour debuggage
+          call appel_stewart_debug(lwork,nloc,inb,na,i, &
+                evap,water,rpprec,rr,wdtrain, &
+                xtevap,xtwater,xtp,xt,xtwdtrain)
+        endif ! if (1.eq.0) then
+
 
 #ifdef ISOVERIF
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv3_routines.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv3_routines.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv3_routines.F90	(revision 4727)
@@ -4720,9 +4720,9 @@
                      tv, tvp, wghti, &
                      iflag, precip, Vprecip, Vprecipi, &     ! jyg: Vprecipi
-                     ft, fr, fu, fv, ftra, &                 ! jyg
+                     ft, fr, fr_comp, fu, fv, ftra, &                 ! jyg
                      cbmf, upwd, dnwd, dnwd0, ma, mip, &
 !!                     tls, tps,                             ! useless . jyg
                      qcondc, wd, &
-                     ftd, fqd, qta, qtc, sigt, tau_cld_cv, coefw_cld_cv &
+                     ftd, fqd, qta, qtc, sigt, detrain, tau_cld_cv, coefw_cld_cv &
 #ifdef ISO
      &                    ,xt,xt_wake,xtclw,xtp,xtwater,xtice,xtevap &
@@ -4816,5 +4816,5 @@
 !outputs:
       REAL, DIMENSION (nloc), INTENT (OUT)               :: precip
-      REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: ft, fr, fu, fv
+      REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: ft, fr, fu, fv , fr_comp
       REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: ftd, fqd
       REAL, DIMENSION (nloc, nd, ntra), INTENT (OUT)     :: ftra
@@ -4826,4 +4826,5 @@
       REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: qcondc                      ! cld
       REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: qtc, sigt                   ! cld
+      REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: detrain                     ! Louis : pour le calcul de Klein du terme de variance qui détraine dans lenvironnement
       REAL, DIMENSION (nloc), INTENT (OUT)               :: wd                          ! gust
       REAL, DIMENSION (nloc), INTENT (OUT)               :: cbmf
@@ -4852,4 +4853,5 @@
       REAL, DIMENSION (nloc)                             :: esum, fsum, gsum, hsum
       REAL, DIMENSION (nloc, nd)                         :: th_wake
+      REAL, DIMENSION (nloc, nd, nd)                     :: qdet
       REAL, DIMENSION (nloc)                             :: alpha_qpos, alpha_qpos1
       REAL, DIMENSION (nloc, nd)                         :: qcond, nqcond, wa           ! cld
@@ -4940,4 +4942,5 @@
       ft(il, i) = 0.0
       fr(il, i) = 0.0
+      fr_comp(il,i) = 0.0
       fu(il, i) = 0.0
       fv(il, i) = 0.0
@@ -4950,4 +4953,6 @@
       sigment(il, i) = 0.0 ! cld
       sigt(il, i) = 0.0 ! cld
+      qdet(il,i,:) = 0.0 ! cld
+      detrain(il, i) = 0.0 ! cld
       nqcond(il, i) = 0.0 ! cld
 #ifdef ISO
@@ -5358,4 +5363,5 @@
       IF (j<=inb(il) .AND. iflag(il)<=1) THEN
         fr(il, 1) = fr(il, 1) + 0.01*grav*work(il)*ment(il, j, 1)*(qent(il,j,1)-rr(il,1))
+        fr_comp(il,1) = fr_comp(il,1) + 0.01*grav*work(il)*ment(il, j, 1)*(qent(il,j,1)-rr(il,1))
 
 #ifdef ISO
@@ -5627,4 +5633,5 @@
       IF (i<=inb(il) .AND. iflag(il)<=1) num1 = num1 + 1
     END DO
+        qdet(il,i,i) = qent(il,i,i)                                            ! cld Louis : specific humidity in detraining water
     IF (num1<=0) GO TO 500
 
@@ -6243,4 +6250,5 @@
           fr(il, i) = fr(il, i) + 0.01*grav*dpinv*ment(il, k, i) * &
                                                        (qent(il,k,i)-awat(il)-rr(il,i))
+          fr_comp(il,i) = fr_comp(il,i) + 0.01*grav*dpinv*ment(il, k, i)*(qent(il,k,i)-awat(il)-rr(il,i))
 
 #ifdef ISO
@@ -6313,4 +6321,5 @@
 ! (saturated updrafts resulting from mixing)                                   ! cld
           qcond(il, i) = qcond(il, i) + (elij(il,k,i)-awat(il))                ! cld
+          qdet(il,k,i) = (qent(il,k,i)-awat(il))                               ! cld Louis : specific humidity in detraining water
           qtment(il, i) = qtment(il, i) + qent(il,k,i)                         ! cld
           nqcond(il, i) = nqcond(il, i) + 1.                                   ! cld
@@ -6460,4 +6469,5 @@
 ! (saturated downdrafts resulting from mixing)                                 ! cld
           qcond(il, i) = qcond(il, i) + elij(il, k, i)                         ! cld
+          qdet(il,k,i) = qent(il,k,i)                                          ! cld Louis : specific humidity in detraining water
           qtment(il, i) = qent(il,k,i) + qtment(il,i)                          ! cld
           nqcond(il, i) = nqcond(il, i) + 1.                                   ! cld
@@ -7255,4 +7265,5 @@
         IF  (k<=inb(il) .AND. i<=inb(il) .AND. iflag(il)<=1) THEN   ! cld
           sument(il) =sument(il) + abs(ment(il,k,i))
+          detrain(il,i) = detrain(il,i) + abs(ment(il,k,i))*(qdet(il,k,i) - rr(il,i))*(qdet(il,k,i) - rr(il,i)) ! Louis terme de détrainement dans le bilan de variance
         ENDIF
       ENDDO     ! il
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv3a_uncompress.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv3a_uncompress.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv3a_uncompress.F90	(revision 4727)
@@ -2,5 +2,5 @@
                            iflag, kbas, ktop, &
                            precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
-                           ft, fq, fu, fv, ftra,  &
+                           ft, fq, fqcomp, fu, fv, ftra,  &
                            sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
                            qcondc, wd, cape, cin, &
@@ -12,9 +12,9 @@
                            qta, clw, elij, evap, ep, epmlmMm, eplaMm, &         ! RomP+jyg
                            wdtrainA, wdtrainS, wdtrainM, &                      ! RomP
-                           qtc, sigt,          &
+                           qtc, sigt, detrain,         &
                            epmax_diag, & ! epmax_cape
                            iflag1, kbas1, ktop1, &
                            precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
-                           ft1, fq1, fu1, fv1, ftra1, &
+                           ft1, fq1, fqcomp1, fu1, fv1, ftra1, &
                            sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
                            qcondc1, wd1, cape1, cin1, &
@@ -26,5 +26,5 @@
                            qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &  ! RomP+jyg
                            wdtrainA1, wdtrainS1, wdtrainM1, &                   ! RomP
-                           qtc1, sigt1, &
+                           qtc1, sigt1, detrain1, &
                            epmax_diag1  & ! epmax_cape
 #ifdef ISO
@@ -72,5 +72,5 @@
   REAL, DIMENSION (nloc), INTENT (IN)                :: ptop2
   REAL, DIMENSION (nloc), INTENT (IN)                :: epmax_diag
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: ft, fq, fu, fv
+  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: ft, fq, fqcomp, fu, fv
   REAL, DIMENSION (nloc, nd, ntra), INTENT (IN)      :: ftra
   REAL, DIMENSION (nloc), INTENT (IN)                :: sigd
@@ -99,5 +99,5 @@
   REAL, DIMENSION (nloc, nd, nd), INTENT (IN)        :: epmlmMm                !RomP+jyg
   REAL, DIMENSION (nloc, nd), INTENT (IN)            :: eplamM                 !RomP+jyg
-  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: qtc, sigt              !RomP
+  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: qtc, sigt, detrain              !RomP
   REAL, DIMENSION (nloc, nd), INTENT (IN)            :: wdtrainA, wdtrainS, wdtrainM     !RomP
 
@@ -120,5 +120,5 @@
   REAL, DIMENSION (len), INTENT (OUT)                :: epmax_diag1 ! epmax_cape
   REAL, DIMENSION (len), INTENT (OUT)                :: ptop21
-  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ft1, fq1, fu1, fv1
+  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ft1, fq1, fqcomp1, fu1, fv1
   REAL, DIMENSION (len, nd, ntra), INTENT (OUT)      :: ftra1
   REAL, DIMENSION (len), INTENT (OUT)                :: sigd1
@@ -147,5 +147,5 @@
   REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: epmlmMm1               !RomP+jyg
   REAL, DIMENSION (len, nd), INTENT (OUT)            :: eplamM1                !RomP+jyg
-  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qtc1, sigt1            !RomP
+  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qtc1, sigt1, detrain1            !RomP
   REAL, DIMENSION (len, nd), INTENT (OUT)            :: wdtrainA1, wdtrainS1, wdtrainM1   !RomP
 
@@ -244,4 +244,5 @@
         ft1(idcum(i), k) = ft(i, k)
         fq1(idcum(i), k) = fq(i, k)
+        fqcomp1(idcum(i), k) = fqcomp(i, k)
         fu1(idcum(i), k) = fu(i, k)
         fv1(idcum(i), k) = fv(i, k)
@@ -273,4 +274,5 @@
         qtc1(idcum(i), k) = qtc(i, k)
         sigt1(idcum(i), k) = sigt(i, k)
+        detrain1(idcum(i), k) = detrain(i, k)
    
 #ifdef ISO
@@ -418,4 +420,5 @@
       ft1(:, 1:nl) = ft(:, 1:nl)
       fq1(:, 1:nl) = fq(:, 1:nl)
+      fqcomp1(:, 1:nl) = fqcomp(:, 1:nl)
       fu1(:, 1:nl) = fu(:, 1:nl)
       fv1(:, 1:nl) = fv(:, 1:nl)
@@ -447,4 +450,5 @@
       qtc1(:, 1:nl) = qtc(:, 1:nl)
       sigt1(:, 1:nl) = sigt(:, 1:nl)
+      detrain1(:, 1:nl) = detrain(:, 1:nl)
 !
       ma1(:, nlp) = 0.
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv3p_mixing.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv3p_mixing.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv3p_mixing.F90	(revision 4727)
@@ -451,5 +451,5 @@
           call iso_verif_aberrant_choix( &
                  xtelij(iso_HDO,il,i,j),elij(il,i,j), &
-                 ridicule,deltalim,'cv3p_mixing 1993')
+                 ridicule,deltalim_snow,'cv3p_mixing 1993')
         endif !if (iso_hdo.gt.0) then
 #ifdef ISOTRAC  
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv_driver.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv_driver.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cv_driver.F90	(revision 4727)
@@ -997,5 +997,5 @@
 
 #ifdef ISO
-       write(*,*) 'klev=',klev
+!       write(*,*) 'klev=',klev
 #ifdef ISOVERIF
        write(*,*) 'cv_driver 930: apres cv3_unsat'
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cva_driver.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cva_driver.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/cva_driver.F90	(revision 4727)
@@ -11,5 +11,5 @@
                       Ale1, Alp1, omega1, &
                       sig1feed1, sig2feed1, wght1, &
-                      iflag1, ft1, fq1, fu1, fv1, ftra1, &
+                      iflag1, ft1, fq1, fqcomp1, fu1, fv1, ftra1, &
                       precip1, kbas1, ktop1, &
                       cbmf1, plcl1, plfc1, wbeff1, &
@@ -26,5 +26,5 @@
                       da1, phi1, mp1, phi21, d1a1, dam1, sigij1, wghti1, & ! RomP, RL
                       qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &  ! RomP, RL
-                      wdtrainA1, wdtrainS1, wdtrainM1, qtc1, sigt1, tau_cld_cv, &     !!jygprl
+                      wdtrainA1, wdtrainS1, wdtrainM1, qtc1, sigt1, detrain1, tau_cld_cv, &     !!jygprl
                       coefw_cld_cv, &                                      ! RomP, AJ
                       epmax_diag1 &  ! epmax_cape
@@ -88,4 +88,5 @@
 ! ntra          Integer        Input        number of tracors
 ! nloc          Integer        Input        dimension of arrays for compressed fields
+! fqcomp1       Real           Output       spec hum tend (only mixed draughts)
 ! k_upper       Integer        Input        upmost level for vertical loops
 ! iflag_con     Integer        Input        version of convect (3/4)
@@ -135,4 +136,5 @@
 ! upwd1         Real           Output       total upward mass flux (adiab+mixed)
 ! dnwd1         Real           Output       saturated downward mass flux (mixed)
+! detrain1      Real           Output     detrainment terme klein
 ! dnwd01        Real           Output       unsaturated downward mass flux
 ! qcondc1       Real           Output       in-cld mixing ratio of condensed water
@@ -209,4 +211,5 @@
   LOGICAL, INTENT (IN)                               :: ok_conserv_q
   REAL, INTENT (IN)                                  :: tau_cld_cv
+  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fqcomp1
   REAL, INTENT (IN)                                  :: coefw_cld_cv
   REAL, INTENT (IN)                                  :: delt
@@ -248,4 +251,5 @@
   REAL, DIMENSION (len), INTENT (OUT)                :: cbmf1
   REAL, DIMENSION (len), INTENT (OUT)                :: plcl1
+  REAL, DIMENSION (len, nd), INTENT (OUT)            :: detrain1   ! detrainement term of mixed draughts in environment
   REAL, DIMENSION (len), INTENT (OUT)                :: plfc1
   REAL, DIMENSION (len), INTENT (OUT)                :: wbeff1
@@ -572,5 +576,5 @@
   REAL, DIMENSION(len,nd)     :: ice, fondue, b
   REAL, DIMENSION(len,nd)     :: frac_a, frac_s, faci               !!jygprl
-  REAL ft(nloc, nd), fq(nloc, nd)
+  REAL ft(nloc, nd), fq(nloc, nd), fqcomp(nloc, nd)
   REAL ftd(nloc, nd), fqd(nloc, nd)
   REAL fu(nloc, nd), fv(nloc, nd)
@@ -598,4 +602,5 @@
   REAL qtc(nloc, nd)         ! cld
   REAL sigt(nloc, nd)        ! cld
+  REAL detrain(nloc, nd)     ! cld
  
 ! RomP >>>
@@ -706,4 +711,5 @@
   ft1(:, :) = 0.0
   fq1(:, :) = 0.0
+  fqcomp1(:, :) = 0.0
   fu1(:, :) = 0.0
   fv1(:, :) = 0.0
@@ -766,4 +772,5 @@
 ! RomP >>>
   sigt1(:, :) = 0.
+  detrain1(:, :) = 0.
   qtc1(:, :) = 0.
   wdtrainA1(:, :) = 0.
@@ -1561,4 +1568,5 @@
         if (prt_level >= 9) &
              PRINT *, 'cva_driver -> cv3_yield'
+
       CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, &                      ! na->nd
                      icb, inb, delt, &
@@ -1570,10 +1578,10 @@
                      nent, elij, traent, sig, &
                      tv, tvp, wghti, &
-                     iflag, precip, Vprecip, Vprecipi, ft, fq, fu, fv, ftra, &      ! jyg
+                     iflag, precip, Vprecip, Vprecipi, ft, fq, fqcomp, fu, fv, ftra, &      ! jyg
                      cbmf, upwd, dnwd, dnwd0, ma, mip, &
 !!                     tls, tps, &                            ! useless . jyg
                      qcondc, wd, &
 !!                     ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
-                     ftd, fqd, qta, qtc, sigt, tau_cld_cv, coefw_cld_cv &  !!jygprl
+                     ftd, fqd, qta, qtc, sigt,detrain,tau_cld_cv, coefw_cld_cv &  !!jygprl
 #ifdef ISO
      &                     ,xt,xt_wake,xtclw,xtp,xtwater,xtice,xtevap &
@@ -1673,5 +1681,5 @@
                            iflag, icb, inb, &
                            precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
-                           ft, fq, fu, fv, ftra, &
+                           ft, fq, fqcomp, fu, fv, ftra, &
                            sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
                            qcondc, wd, cape, cin, &
@@ -1683,8 +1691,8 @@
                            qta, clw, elij, evap, ep, epmlmMm, eplaMm, &  ! RomP
                            wdtrainA, wdtrainS, wdtrainM, &                         ! RomP
-                           qtc, sigt, epmax_diag, & ! epmax_cape
+                           qtc, sigt, detrain, epmax_diag, & ! epmax_cape
                            iflag1, kbas1, ktop1, &
                            precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
-                           ft1, fq1, fu1, fv1, ftra1, &
+                           ft1, fq1, fqcomp1, fu1, fv1, ftra1, &
                            sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
                            qcondc1, wd1, cape1, cin1, &
@@ -1696,5 +1704,5 @@
                            qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
                            wdtrainA1, wdtrainS1, wdtrainM1,                  & ! RomP
-                           qtc1, sigt1, epmax_diag1 & ! epmax_cape
+                           qtc1, sigt1,detrain1,epmax_diag1 & ! epmax_cape
 #ifdef ISO
      &          ,xtprecip,fxt,fxtd, xtVprecip,xtVprecipi, xtclw,xtevap,xtwdtraina       &
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/ecumev6_flux.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/ecumev6_flux.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/ecumev6_flux.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/ecumev6_flux.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/fisrtilp.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/fisrtilp.F90	(revision 4726)
+++ 	(revision )
@@ -1,2739 +1,0 @@
-!
-! $Id: fisrtilp.F90 3493 2019-05-07 08:45:07Z idelkadi $
-!
-!
-SUBROUTINE fisrtilp(dtime,paprs,pplay,t,q,ptconv,ratqs, &
-     d_t, d_q, d_ql, d_qi, rneb, radliq, rain, snow,          &
-     pfrac_impa, pfrac_nucl, pfrac_1nucl,               &
-     frac_impa, frac_nucl, beta,                        &
-     prfl, psfl, rhcl, zqta, fraca,                     &
-     ztv, zpspsk, ztla, zthl, iflag_cld_th,             &
-     iflag_ice_thermo &
-#ifdef ISO
-     &           ,xt,xtrain,xtsnow                      &
-     &           ,d_xt,d_xtl,d_xti,pxtrainfl,pxtsnowfl        &
-#endif      
-     &  )
-
-  !
-  USE dimphy
-  USE icefrac_lsc_mod ! compute ice fraction (JBM 3/14)
-  USE print_control_mod, ONLY: prt_level, lunout
-  USE cloudth_mod 
-  USE ioipsl_getin_p_mod, ONLY : getin_p
-  USE phys_local_var_mod, ONLY: ql_seri,qs_seri
-  USE phys_local_var_mod, ONLY: rneblsvol
-  ! flag to include modifications to ensure energy conservation (if flag >0)
-  USE add_phys_tend_mod, only : fl_cor_ebil 
-#ifdef ISO
-  USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso
-  USE isotopes_mod
-!, ONLY: essai_convergence,bidouille_anti_divergence, &
-!        &       Rdefault,ridicule,pxtice,pxtmelt,iso_eau,iso_HDO, &
-!        &       iso_O18,ridicule_rain
-  USE isotopes_routines_mod, ONLY: iso_revap_fisrtilp, &
-        condiso_liq_ice_vectall
-#ifdef ISOVERIF
-  USE isotopes_verif_mod, ONLY: errmax,errmaxrel,deltalim_snow,deltalim, &
-        iso_verif_egalite_choix,iso_verif_aberrant_choix, &
-        iso_verif_positif,iso_verif_positif_choix,iso_verif_noNaN, &
-        iso_verif_aberrant,iso_verif_positif_choix_nostop, &
-        iso_verif_aberrant_encadre,iso_verif_egalite_choix_nostop, &
-        iso_verif_aberrant_nostop,iso_verif_o18_aberrant_nostop, &
-        deltaD,deltaO,iso_verif_egalite
-#endif
-#ifdef ISOTRAC
-    use isotrac_mod, only: option_traceurs,option_tmin,seuil_tag_tmin_ls, &
-&       izone_poubelle, option_cond,izone_cond,index_iso, index_zone,izone_oce,izone_ddft
-    use isotrac_routines_mod, only: iso_recolorise_condensation
-    use isotopes_routines_mod, only: condiso_liq_ice_vectall_trac
-#ifdef ISOVERIF
-  USE isotopes_verif_mod, ONLY: iso_verif_traceur_nostop,iso_verif_traceur
-  USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
-#endif
-#endif
-#endif
-
-  IMPLICIT none
-  !======================================================================
-  ! Auteur(s): Z.X. Li (LMD/CNRS)
-  ! Date: le 20 mars 1995
-  ! Objet: condensation et precipitation stratiforme.
-  !        schema de nuage
-  ! Fusion de fisrt (physique sursaturation, P. LeVan K. Laval)
-  !             et ilp (il pleut, L. Li)
-  ! Principales parties:
-  ! P0> Thermalisation des precipitations venant de la couche du dessus
-  ! P1> Evaporation de la precipitation (qui vient du niveau k+1)
-  ! P2> Formation du nuage (en k) 
-  ! P2.A.0> Calcul des grandeurs nuageuses une pdf en creneau
-  ! P2.A.1> Avec les nouvelles PDFs, calcul des grandeurs nuageuses pour 
-  ! les valeurs de T et Q initiales
-  ! P2.A.2> Prise en compte du couplage entre eau condensee et T.
-  ! P2.A.3> Calcul des valeures finales associees a la formation des nuages
-  ! P2.B> Nuage "tout ou rien"
-  ! P2.C> Prise en compte de la Chaleur latente apres formation nuage
-  ! P3> Formation de la precipitation (en k)
-  !======================================================================
-  ! JLD: 
-  ! * Routine probablement fausse (au moins incoherente) si thermcep = .false.
-  ! * fl_cor_ebil doit etre > 0 ; 
-  !   fl_cor_ebil= 0 pour reproduire anciens bugs
-  !======================================================================
-  include "YOMCST.h"
-  include "fisrtilp.h"
-  include "nuage.h" ! JBM (3/14)
-
-  !
-  ! Principaux inputs:
-  !
-  REAL, INTENT(IN)                              :: dtime  ! intervalle du temps (s)
-  REAL, DIMENSION(klon,klev+1),    INTENT(IN)   :: paprs  ! pression a inter-couche
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: pplay  ! pression au milieu de couche
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: t      ! temperature (K)
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: q      ! humidite specifique (kg/kg)
-  LOGICAL, DIMENSION(klon,klev),   INTENT(IN)   :: ptconv ! points ou le schema de conv. prof. est actif
-  INTEGER,                         INTENT(IN)   :: iflag_cld_th
-  INTEGER,                         INTENT(IN)   :: iflag_ice_thermo
-  !
-  ! Inputs lies aux thermiques
-  ! 
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: ztv
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: zqta, fraca 
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: zpspsk, ztla
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: zthl
-  !
-  !  Input/output
-  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: ratqs  ! determine la largeur de distribution de vapeur
-  !
-  ! Principaux outputs:
-  !
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_t  ! incrementation de la temperature (K)
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_q  ! incrementation de la vapeur d'eau
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_ql ! incrementation de l'eau liquide
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_qi ! incrementation de l'eau glace
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rneb ! fraction nuageuse
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: radliq ! eau liquide utilisee dans rayonnements
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rhcl ! humidite relative en ciel clair
-  REAL, DIMENSION(klon),           INTENT(OUT)  :: rain
-  REAL, DIMENSION(klon),           INTENT(OUT)  :: snow
-  REAL, DIMENSION(klon,klev+1),    INTENT(OUT)  :: prfl
-  REAL, DIMENSION(klon,klev+1),    INTENT(OUT)  :: psfl 
-
-#ifdef ISO
-      real double_to_real
-      double precision real_to_double
-      !integer niso
-      real xt(ntraciso,klon,klev)
-      real d_xt(ntraciso,klon,klev)
-      real d_xtl(ntraciso,klon,klev)
-      real d_xti(ntraciso,klon,klev)
-      real xtrain(ntraciso,klon)
-      real xtsnow(ntraciso,klon)
-      real pxtrainfl(ntraciso,klon,klev+1)
-      real pxtsnowfl(ntraciso,klon,klev+1)      
-      ! xt <-> q
-      ! xtrain et xtsonw <-> rain et snow
-      ! d_xt et d_xtl <-> d_q et d_ql
-      ! pxtrainfl et pxtsnowflux <-> prfl et psfl
-#endif
-
-
-  !AA
-  ! Coeffients de fraction lessivee : pour OFF-LINE
-  !
-  REAL, DIMENSION(klon,klev),      INTENT(INOUT)  :: pfrac_nucl
-  REAL, DIMENSION(klon,klev),      INTENT(INOUT)  :: pfrac_1nucl
-  REAL, DIMENSION(klon,klev),      INTENT(INOUT)  :: pfrac_impa
-  !
-  ! Fraction d'aerosols lessivee par impaction et par nucleation
-  ! POur ON-LINE
-  !
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_impa
-  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_nucl
-  !AA
-  ! --------------------------------------------------------------------------------
-  !
-  ! Options du programme:
-  !
-  REAL, SAVE :: seuil_neb=0.001 ! un nuage existe vraiment au-dela
-  !$OMP THREADPRIVATE(seuil_neb)
-
-
-  INTEGER ninter ! sous-intervals pour la precipitation
-  PARAMETER (ninter=5)
-  INTEGER,SAVE :: iflag_evap_prec=1 ! evaporation de la pluie
-  !$OMP THREADPRIVATE(iflag_evap_prec)
-  !
-  LOGICAL cpartiel ! condensation partielle
-  PARAMETER (cpartiel=.TRUE.)
-  REAL t_coup
-  PARAMETER (t_coup=234.0)
-  REAL DDT0
-  PARAMETER (DDT0=.01)
-  REAL ztfondue
-  PARAMETER (ztfondue=278.15)
-  ! --------------------------------------------------------------------------------
-  !
-  ! Variables locales:
-  !
-  INTEGER i, k, n, kk
-  INTEGER,save::itap=0
-  !$OMP THREADPRIVATE(itap)
-
-  REAL qsl, qsi
-  real zct      ,zcl
-  INTEGER ncoreczq  
-  REAL ctot(klon,klev)
-  REAL ctot_vol(klon,klev)
-  REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5  
-  REAL zdqsdT_raw(klon)
-  REAL Tbef(klon),qlbef(klon),DT(klon),num,denom
-
-  logical lognormale(klon)
-  logical ice_thermo
-  LOGICAL convergence(klon)
-  INTEGER n_i(klon), iter
-  REAL cste
-
-  real zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
-  real Zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon)
-  real erf   
-  REAL qcloud(klon)
- 
-  REAL zrfl(klon), zrfln(klon), zqev, zqevt 
-  REAL zifl(klon), zifln(klon), zqev0,zqevi, zqevti
-  REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq 
-  REAL zoliqp(klon), zoliqi(klon)
-  REAL zt(klon)
-! JBM (3/14) nexpo is replaced by exposant_glace
-! REAL nexpo ! exponentiel pour glace/eau
-! INTEGER, PARAMETER :: nexpo=6
-  INTEGER exposant_glace_old
-  REAL t_glace_min_old
-  REAL zdz(klon),zrho(klon),ztot      , zrhol(klon)
-  REAL zchau      ,zfroi      ,zfice(klon),zneb(klon),znebprecip(klon)
-  REAL zmelt, zpluie, zice
-  REAL dzfice(klon)
-  REAL zsolid
-!!!!
-!  Variables pour Bergeron
-  REAL zcp, coef1, DeltaT, Deltaq, Deltaqprecl
-  REAL zqpreci(klon), zqprecl(klon)
-! Variable pour conservation enegie des precipitations
-  REAL zmqc(klon)
-
-#ifdef ISO
-      real zxtrfl(ntraciso,klon)
-      real zxtrfln(ntraciso,klon)
-      REAL zxtifl(ntraciso,klon), zxtifln(ntraciso,klon)  
-      real zxt(ntraciso,klon) ! equivalent local de xt
-      real zxtn(ntraciso,klon) ! isotpes nuageux
-      real zxtn_reduit(niso)
-      real zxtcond(ntraciso,klon)
-      real zxtoliq(ntraciso,klon)
-      real zq_ancien(klon)
-      REAL zxtpreci(ntraciso,klon), zxtprecl(ntraciso,klon)
-      integer ixt
-#ifdef ISOVERIF   
-!      integer iso_verif_aberrant_nostop
-!      integer iso_verif_egalite_choix_nostop
-!      integer iso_verif_positif_nostop
-!      integer iso_verif_positif_choix_nostop
-      integer trace_cas(klon)
-!      integer iso_verif_traceur_nostop
-#endif      
-      integer iso_verif_nonan_nostop
-      real zxtice(ntraciso,klon),zxtliq(ntraciso,klon)
-      real zrfl_ancien(klon)
-      real zqev_diag(klon)
-      real zxtrfl_ancien(ntraciso,klon)
-      real zxt_ancien(ntraciso,klon)
-#ifdef ISOTRAC
-        real zxtres(ntraciso) ! humidite spec nuageuse après condensation et precip
-        real zqcs(klon) ! humidite spec en ciel clair
-        real zxtcs(ntraciso,klon)        
-        real zcondn(klon) ! humidite spec de l'eau liquide dans le nuage
-        real zxtcondn(ntraciso,klon)
-        integer izone
-#ifdef ISOVERIF           
-        real zq_verif
-#endif        
-#endif 
-!      logical negation ! pour nier conditions logiques
-#endif
-
-  !
-  LOGICAL appel1er
-  SAVE appel1er
-  !$OMP THREADPRIVATE(appel1er)
-  !
-! iflag_oldbug_fisrtilp=0 enleve le BUG par JYG : tglace_min -> tglace_max
-! iflag_oldbug_fisrtilp=1 ajoute le BUG
-  INTEGER,SAVE :: iflag_oldbug_fisrtilp=0 !=0 sans bug
-  !$OMP THREADPRIVATE(iflag_oldbug_fisrtilp)
-  !---------------------------------------------------------------
-  !
-  !AA Variables traceurs:
-  !AA  Provisoire !!! Parametres alpha du lessivage
-  !AA  A priori on a 4 scavenging # possibles
-  !
-  REAL a_tr_sca(4)
-  save a_tr_sca
-  !$OMP THREADPRIVATE(a_tr_sca)
-  !
-  ! Variables intermediaires
-  !
-  REAL zalpha_tr
-  REAL zfrac_lessi
-  REAL zprec_cond(klon)
-  !AA
-! RomP >>> 15 nov 2012
-  REAL   beta(klon,klev) ! taux de conversion de l'eau cond
-! RomP <<<
-  REAL zmair(klon), zcpair, zcpeau
-  !     Pour la conversion eau-neige
-  REAL zlh_solid(klon), zm_solid
-  !---------------------------------------------------------------
-  !
-  ! Fonctions en ligne:
-  !
-  REAL fallvs,fallvc ! Vitesse de chute pour cristaux de glace
-                     ! (Heymsfield & Donner, 1990)
-  REAL zzz
-
-  include "YOETHF.h"
-  include "FCTTRE.h"
-  fallvc (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_con
-  fallvs (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_lsc
-  !
-  DATA appel1er /.TRUE./
-  !ym
-!CR: pour iflag_ice_thermo=2, on active que la convection
-!  ice_thermo = iflag_ice_thermo .GE. 1
-
-  itap=itap+1
-  znebprecip(:)=0.
-
-  ice_thermo = (iflag_ice_thermo .EQ. 1).OR.(iflag_ice_thermo .GE. 3)
-  zdelq=0.0
-  ctot_vol(1:klon,1:klev)=0.0
-  rneblsvol(1:klon,1:klev)=0.0
-
-  if (prt_level>9)write(lunout,*)'NUAGES4 A. JAM'
-  IF (appel1er) THEN
-     CALL getin_p('iflag_oldbug_fisrtilp',iflag_oldbug_fisrtilp)
-     CALL getin_p('iflag_evap_prec',iflag_evap_prec)
-     CALL getin_p('seuil_neb',seuil_neb)
-     write(lunout,*)' iflag_oldbug_fisrtilp =',iflag_oldbug_fisrtilp 
-     !
-     WRITE(lunout,*) 'fisrtilp, ninter:', ninter
-     WRITE(lunout,*) 'fisrtilp, iflag_evap_prec:', iflag_evap_prec
-     WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel
-     
-     IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
-        WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
-        WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes'
-        !         CALL abort
-     ENDIF
-     appel1er = .FALSE.
-
-#ifdef ISO
-        ! cam verif 
-#ifdef ISOVERIF
-        write(*,*) 'ilp 310'
-          do k=1,klev
-           do i=1,klon             
-            if (iso_eau.gt.0) then        
-             call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &   
-     &                   'il pleut 205',errmax,errmaxrel)
-            endif !if (iso_eau.gt.0) then
-            if (iso_HDO.gt.0) then    
-             if (q(i,k).gt.ridicule) then
-               call iso_verif_aberrant(xt(iso_HDO,i,k)/q(i,k), &
-     &           'il pleut 210')
-             endif !if (zq(i).gt.ridicule) then
-            endif  !if (iso_HDO.gt.0) then
-           enddo !do k=1,klev
-          enddo !do i=1,klon
-        do k=1,klev
-           do i=1,klon
-             call iso_verif_positif(370.0-t(i,k),'il pleut 250')
-             call iso_verif_positif(t(i,k)-100.0,'il pleut 251')
-           enddo
-        enddo
-        write(*,*) 'ilp 331'
-#endif
-         ! end cam verif
-#endif 
-
-     !
-     !AA initialiation provisoire
-     a_tr_sca(1) = -0.5
-     a_tr_sca(2) = -0.5
-     a_tr_sca(3) = -0.5
-     a_tr_sca(4) = -0.5
-     !
-     !AA Initialisation a 1 des coefs des fractions lessivees 
-     !
-     !cdir collapse
-     DO k = 1, klev
-        DO i = 1, klon
-           pfrac_nucl(i,k)=1.
-           pfrac_1nucl(i,k)=1.
-           pfrac_impa(i,k)=1.
-           beta(i,k)=0.  !RomP initialisation
-        ENDDO
-     ENDDO
-
-  ENDIF          !  test sur appel1er
-  !
-  !MAf Initialisation a 0 de zoliq
-  !      DO i = 1, klon
-  !         zoliq(i)=0.
-  !      ENDDO 
-  ! Determiner les nuages froids par leur temperature
-  !  nexpo regle la raideur de la transition eau liquide / eau glace.
-  !
-!CR: on est oblige de definir des valeurs fisrt car les valeurs de newmicro ne sont pas les memes par defaut
-  IF (iflag_t_glace.EQ.0) THEN
-!   ztglace = RTT - 15.0
-    t_glace_min_old = RTT - 15.0
-    !AJ<
-    IF (ice_thermo) THEN
-!     nexpo = 2
-      exposant_glace_old = 2
-    ELSE
-!     nexpo = 6
-      exposant_glace_old = 6
-    ENDIF
-    
-  ENDIF
-  
-!!  RLVTT = 2.501e6 ! pas de redefinition des constantes physiques (jyg)
-!!  RLSTT = 2.834e6 ! pas de redefinition des constantes physiques (jyg)
-!>AJ
-  !cc      nexpo = 1
-  !
-  ! Initialiser les sorties:
-  !
-  !cdir collapse
-  DO k = 1, klev+1
-     DO i = 1, klon
-        prfl(i,k) = 0.0
-        psfl(i,k) = 0.0
-#ifdef ISO                 
-          do ixt=1,ntraciso
-            pxtrainfl(ixt,i,k)=0.0
-            pxtsnowfl(ixt,i,k)=0.0
-          enddo !do ixt=1,niso
-#endif
-     ENDDO
-  ENDDO
-
-  !cdir collapse
-  DO k = 1, klev
-     DO i = 1, klon
-        d_t(i,k) = 0.0
-        d_q(i,k) = 0.0
-        d_ql(i,k) = 0.0
-        d_qi(i,k) = 0.0
-#ifdef ISO
-          do ixt=1,ntraciso
-            d_xt(ixt,i,k) = 0.0
-            d_xtl(ixt,i,k) = 0.0
-            d_xti(ixt,i,k) = 0.0
-          enddo !do ixt=1,niso
-#endif 
-        rneb(i,k) = 0.0
-        radliq(i,k) = 0.0
-        frac_nucl(i,k) = 1. 
-        frac_impa(i,k) = 1. 
-     ENDDO
-  ENDDO
-  DO i = 1, klon
-     rain(i) = 0.0
-     snow(i) = 0.0
-     zoliq(i)=0.
-#ifdef ISO
-         do ixt=1,ntraciso
-            xtrain(ixt,i) = 0.0
-            xtsnow(ixt,i) = 0.0
-            zxtoliq(ixt,i)=0.
-         enddo !do ixt=1,niso
-#endif
-     !     ENDDO
-     !
-     ! Initialiser le flux de precipitation a zero
-     !
-     !     DO i = 1, klon
-     zrfl(i) = 0.0
-     zifl(i) = 0.0
-     zrfln(i) = 0.0 ! C Risi pour plus de securite
-     zifln(i) = 0.0 ! C Risi pour plus de securite
-#ifdef ISO
-          do ixt=1,ntraciso
-            zxtrfl(ixt,i)=0.0
-            zxtifl(ixt,i)=0.0
-            zxtrfln(ixt,i)=0.0
-            zxtifln(ixt,i)=0.0
-          enddo
-#endif
-     zneb(i) = seuil_neb
-  ENDDO
-  !
-  !
-  !AA Pour plus de securite 
-
-  zalpha_tr   = 0.
-  zfrac_lessi = 0.
-
-  !AA==================================================================
-  !
-  ncoreczq=0
-  ! BOUCLE VERTICALE (DU HAUT VERS LE BAS)
-  !
-  DO k = klev, 1, -1
-     !
-     !
-#ifdef ISO      
-      ! cam debug!      
-       ! verif en debut de boucle
-#ifdef ISOVERIF
-       !write(*,*) 'ilp 478: boucle en k: k=',k         
-       do i=1,klon
-        if (iso_eau.gt.0) then
-        call iso_verif_egalite_choix(zxtrfl(iso_eau,i), &
-     &           zrfl(i), &
-     &           'il pleut 310',errmax,errmaxrel)
-        endif !if (iso_eau.gt.0) then
-        if (iso_HDO.gt.0) then  
-         if (zrfl(i).gt.ridicule_rain) then
-             call iso_verif_aberrant(zxtrfl(iso_HDO,i) &
-     &           /zrfl(i),'il pleut 316')
-         endif !if (zrfl(i).gt.ridicule_rain) then
-        endif  !if (iso_HDO.gt.0) then  
-#ifdef ISOTRAC   
-        call iso_verif_traceur(zxtrfl(1,i), &
-     &          'il pleut 365')   
-        call iso_verif_traceur_pbidouille(zxtrfl(1,i), &
-     &          'il pleut 388')
-#endif         
-       enddo !do i=1,klon
-#endif
-#ifdef ISOVERIF   
-        !write(*,*) 'ilp tmp 412'      
-       do i=1,klon
-         do ixt=1,ntraciso
-           call iso_verif_noNaN(zxtrfl(ixt,i),'ilp 406')
-           call iso_verif_noNaN(zxtoliq(ixt,i),'ilp 407')
-         enddo !do ixt=1,ntraciso
-       enddo !do i=1,klon
-#endif
-      ! end verif en debut de boucle
-      ! end cam debug
-#endif
-     !AA===============================================================
-     !
-     ! Initialisation temperature et vapeur
-     DO i = 1, klon
-        zt(i)=t(i,k)
-        zq(i)=q(i,k)
-#ifdef ISOVERIF
-        if (q(i,k).lt.0.0) then
-               write(*,*) 'ilp 400: avant clmain 31janv: i,k,q=', &
-     &           i,k,q(i,k)
-               CALL abort_physic('ilp 484', 'on stop', 1)
-        endif 
-#endif
-#ifdef ISO
-           zq(i)=max(0.0,zq(i))
-#ifdef ISOTRAC
-#ifdef ISOVERIF         
-          call iso_verif_traceur(xt(1,i,k),'ilp 404')           
-          call iso_verif_traceur_pbidouille(xt(1,i,k),'ilp 407')
-#endif          
-#endif          
-         do ixt=1,ntraciso
-           zxt(ixt,i)=xt(ixt,i,k)
-           zxt(ixt,i)=max(0.0,zxt(ixt,i))
-         enddo !do ixt=1,niso  
-
-         ! cam verif
-#ifdef ISOVERIF
-         !write(*,*) 'ilp tmp 562'
-             call iso_verif_positif(370.0-zt(i),'il pleut 425')
-             call iso_verif_positif(zt(i)-100.0,'il pleut 426')
-          if (iso_eau.gt.0) then        
-            call iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
-     &                   'il pleut 289',errmax,errmaxrel)
-          endif !if (iso_eau.gt.0) then
-          if (iso_HDO.gt.0) then    
-             if (zq(i).gt.ridicule) then
-               call iso_verif_aberrant(zxt(iso_HDO,i)/zq(i), &
-     &           'il pleut 337')
-             endif !if (zq(i).gt.ridicule) then
-          endif  !if (iso_HDO.gt.0) then  
-#ifdef ISOTRAC
-          call iso_verif_traceur(zxt(1,i),'ilp 431')
-#endif           
-#endif
-         ! end cam verif
-#endif  
-
-     ENDDO
-     !
-     ! ----------------------------------------------------------------
-     ! P0> Thermalisation des precipitations venant de la couche du dessus
-     ! ----------------------------------------------------------------
-     ! Calculer la varition de temp. de l'air du a la chaleur sensible
-     ! transporter par la pluie. On thermalise la pluie avec l'air de la couche.
-     ! Cette quantite de pluie qui est thermalisee, et devra continue a l'etre lors
-     ! des differentes transformations thermodynamiques. Cette masse d'eau doit
-     ! donc etre ajoute a l'humidite de la couche lorsque l'on calcule la variation
-     ! de l'enthalpie  de la couche avec la temperature
-     ! Variables calculees ou modifiees:
-     !   -  zt: temperature de la cocuhe
-     !   - zmqc: masse de precip qui doit etre thermalisee
-     !
-     IF(k.LE.klevm1) THEN         
-        DO i = 1, klon
-           !IM
-           zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
-           ! il n'y a pas encore d'eau liquide ni glace dans la maiille, donc zq suffit
-           zcpair=RCPD*(1.0+RVTMP2*zq(i))
-           zcpeau=RCPD*RVTMP2
-         if (fl_cor_ebil .GT. 0) then
-           ! zmqc: masse de precip qui doit etre thermalisee avec l'air de la couche atm 
-           ! pour s'assurer que la precip arrivant au sol aura bien la temperature de la 
-           ! derniere couche
-           zmqc(i) = (zrfl(i)+zifl(i))*dtime/zmair(i)
-           ! t(i,k+1)+d_t(i,k+1): nouvelle temp de la couche au dessus
-           zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zmqc(i)*zcpeau + zcpair*zt(i) ) &
-                 / (zcpair + zmqc(i)*zcpeau)
-         else ! si on maintient les anciennes erreurs
-           zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zrfl(i)*dtime*zcpeau &
-                + zmair(i)*zcpair*zt(i) ) &
-                / (zmair(i)*zcpair + zrfl(i)*dtime*zcpeau)
-         end if
-        ENDDO
-     ELSE  ! IF(k.LE.klevm1) 
-        DO i = 1, klon 
-           zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG 
-           zmqc(i) = 0.
-        ENDDO
-     ENDIF ! end IF(k.LE.klevm1)
-     !
-     ! ----------------------------------------------------------------
-     ! P1> Calcul de l'evaporation de la precipitation
-     ! ----------------------------------------------------------------
-     ! On evapore une partie des precipitations venant de la maille du dessus.
-     ! On calcule l'evaporation et la sublimation des precipitations, jusqu'a
-     ! ce que la fraction de cette couche qui est sous le nuage soit saturee.
-     ! Variables calculees ou modifiees:
-     !   - zrfl et zifl: flux de precip liquide et glace
-     !   - zq, zt: humidite et temperature de la cocuhe
-     !   - zmqc: masse de precip qui doit etre thermalisee
-     !
-#ifdef ISO
-      DO i = 1, klon
-         zq_ancien(i)=zq(i)
-         zqev_diag(i)=0.0
-         zrfl_ancien(i)=zrfl(i)
-         do ixt=1,ntraciso
-           zxtrfl_ancien(ixt,i)=zxtrfl(ixt,i)
-           zxt_ancien(ixt,i)=zxt(ixt,i)
-         enddo 
-      enddo   ! DO i = 1, klon  
-#ifdef ISOVERIF
-        !write(*,*) 'ilp tmp 616'
-      if (iso_eau.gt.0) then
-       DO i = 1, klon           
-          call iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
-     &           'il pleut 426a',errmax,errmaxrel) 
-          call iso_verif_egalite_choix(zxtrfl_ancien(iso_eau,i), &
-     &            zrfl_ancien(i), &
-     &           'il pleut 426b',errmax,errmaxrel)
-        enddo
-      endif
-#ifdef ISOTRAC
-       do i=1,klon      
-            call iso_verif_traceur(zxt_ancien(1,i),'ilp 532')
-            call iso_verif_traceur(zxtrfl_ancien(1,i), &
-     &           'ilp 533')  
-       enddo !do i=1,klon  
-#endif      
-#endif      
-#endif
-
-
-     IF (iflag_evap_prec>=1) THEN
-        DO i = 1, klon
-!          S'il y a des precipitations
-           IF (zrfl(i)+zifl(i).GT.0.) THEN
-              ! Calcul du qsat
-              IF (thermcep) THEN
-                 zdelta=MAX(0.,SIGN(1.,RTT-zt(i)))
-                 zqs(i)= R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
-                 zqs(i)=MIN(0.5,zqs(i))
-                 zcor=1./(1.-RETV*zqs(i))
-                 zqs(i)=zqs(i)*zcor
-              ELSE
-                 IF (zt(i) .LT. t_coup) THEN
-                    zqs(i) = qsats(zt(i)) / pplay(i,k)
-                 ELSE
-                    zqs(i) = qsatl(zt(i)) / pplay(i,k)
-                 ENDIF
-              ENDIF
-           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
-        ENDDO
-!AJ<
-
-       IF (.NOT. ice_thermo) THEN
-        DO i = 1, klon
-!          S'il y a des precipitations
-           IF (zrfl(i)+zifl(i).GT.0.) THEN                
-                ! Evap max pour ne pas saturer la fraction sous le nuage
-                ! Evap max jusqu'à atteindre la saturation dans la partie
-                ! de la maille qui est sous le nuage de la couche du dessus
-                !!! On ne tient compte de cette fraction que sous une seule
-                !!! couche sous le nuage
-                zqev = MAX (0.0, (zqs(i)-zq(i))*zneb(i) )
-             ! Ajout de la prise en compte des precip a thermiser
-             ! avec petite reecriture 
-             if  (fl_cor_ebil .GT. 0) then ! nouveau
-                ! Calcul de l'evaporation du flux de precip herite
-                !   d'au-dessus
-                zqevt = coef_eva * (1.0-zq(i)/zqs(i)) * SQRT(zrfl(i)) &
-                     * zmair(i)/pplay(i,k)*zt(i)*RD
-                zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) * dtime/zmair(i)
-                ! Seuil pour ne pas saturer la fraction sous le nuage
-                zqev = MIN (zqev, zqevt)
-                ! Nouveau flux de precip
-                zrfln(i) = zrfl(i) - zqev*zmair(i)/dtime
-                ! Aucun flux liquide pour T < t_coup, on reevapore tout.
-                IF (zt(i) .LT. t_coup.and.reevap_ice) THEN
-                  zrfln(i)=0.
-                  zqev = (zrfl(i)-zrfln(i))/zmair(i)*dtime
-                END IF
-                ! Nouvelle vapeur 
-                zq(i) = zq(i) + zqev
-                zmqc(i) = zmqc(i)-zqev
-                ! Nouvelle temperature (chaleur latente)
-                zt(i) = zt(i) - zqev &
-                     * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
-!!JLD debut de partie a supprimer a terme
-            else ! if  (fl_cor_ebil .GT. 0)
-                ! Calcul de l'evaporation du flux de precip herite
-                !   d'au-dessus
-                zqevt = coef_eva * (1.0-zq(i)/zqs(i)) * SQRT(zrfl(i)) &
-                     * (paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-                zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) &
-                     * RG*dtime/(paprs(i,k)-paprs(i,k+1))
-                ! Seuil pour ne pas saturer la fraction sous le nuage
-                zqev = MIN (zqev, zqevt)
-                ! Nouveau flux de precip
-                zrfln(i) = zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1)) &
-                     /RG/dtime
-                ! Aucun flux liquide pour T < t_coup
-                IF (zt(i) .LT. t_coup.and.reevap_ice) zrfln(i)=0.
-                ! Nouvelle vapeur 
-                zq(i) = zq(i) - (zrfln(i)-zrfl(i)) &
-                     * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-                ! Nouvelle temperature (chaleur latente)
-                zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
-                     * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
-                     * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
-              end if ! if  (fl_cor_ebil .GT. 0)
-
-!!JLD fin de partie a supprimer a terme
-                zrfl(i) = zrfln(i)
-                zifl(i) = 0.
-#ifdef ISO
-         zqev_diag(i)=zqev
-#endif
-
-           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
-
-
-        ENDDO
-#ifdef ISO
-
-      ! * traitement de l'évaporation
-      call iso_revap_fisrtilp(klon,klev,k, &
-     &            zrfl_ancien,zrfl,zrfln,zt,zxt_ancien, &
-     &            zxtrfl,zxtrfl_ancien,zxtrfln,zxt, &
-     &            paprs,dtime, &
-     &            zqs,zq_ancien,zqev_diag,zq)  
-#endif
-
-!
-       ELSE ! (.NOT. ice_thermo) 
-
-#ifdef ISO
-        CALL abort_physic('ilp 664', 'isotopes pas encore prevus dans ice_thermo', 1)        
-#endif
-!      ================================
-!      Avec thermodynamique de la glace
-!      ================================
-        DO i = 1, klon
-!AJ<
-!        S'il y a des precipitations
-         IF (zrfl(i)+zifl(i).GT.0.) THEN
-
-         IF (iflag_evap_prec==1) THEN
-            znebprecip(i)=zneb(i)
-         ELSE
-            znebprecip(i)=MAX(zneb(i),znebprecip(i))
-         ENDIF
-     
-        ! Evap max pour ne pas saturer la fraction sous le nuage
-         zqev0 = MAX (0.0, (zqs(i)-zq(i))*znebprecip(i) )
-
-         !JAM
-         ! On differencie qsat pour l'eau et la glace
-         ! Si zdelta=1. --> glace
-         ! Si zdelta=0. --> eau liquide
-        
-         ! Calcul du qsat par rapport a l'eau liquide
-         qsl= R2ES*FOEEW(zt(i),0.)/pplay(i,k)
-         qsl= MIN(0.5,qsl)
-         zcor= 1./(1.-RETV*qsl)
-         qsl= qsl*zcor
-         
-         ! Calcul de l'evaporation du flux de precip venant du dessus
-         ! Formulation en racine du flux de precip
-         ! (Klemp & Wilhelmson, 1978; Sundqvist, 1988)
-         IF (iflag_evap_prec==3) THEN
-         zqevt = znebprecip(i)*coef_eva*(1.0-zq(i)/qsl) &
-              *SQRT(zrfl(i)/max(1.e-4,znebprecip(i))) &
-              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-         ELSE
-         zqevt = 1.*coef_eva*(1.0-zq(i)/qsl)*SQRT(zrfl(i)) &
-              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-         ENDIF
-
-
-         zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) &
-              *RG*dtime/(paprs(i,k)-paprs(i,k+1)) 
-         
-         ! Calcul du qsat par rapport a la glace
-         qsi= R2ES*FOEEW(zt(i),1.)/pplay(i,k)
-         qsi= MIN(0.5,qsi)
-         zcor= 1./(1.-RETV*qsi)
-         qsi= qsi*zcor
-
-         ! Calcul de la sublimation du flux de precip solide herite
-         !   d'au-dessus
-         IF (iflag_evap_prec==3) THEN
-         zqevti = znebprecip(i)*coef_eva*(1.0-zq(i)/qsi) &
-              *SQRT(zifl(i)/max(1.e-4,znebprecip(i))) &
-              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-         ELSE
-         zqevti = 1.*coef_eva*(1.0-zq(i)/qsi)*SQRT(zifl(i)) &
-              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-         ENDIF
-         zqevti = MAX(0.0,MIN(zqevti,zifl(i))) &
-              *RG*dtime/(paprs(i,k)-paprs(i,k+1))   
-
-        !JAM
-        ! Limitation de l'evaporation. On s'assure qu'on ne sature pas 
-        ! la fraction de la couche sous le nuage sinon on repartit zqev0 
-        ! en conservant la proportion liquide / glace
-     
-         IF (zqevt+zqevti.GT.zqev0) THEN
-            zqev=zqev0*zqevt/(zqevt+zqevti)
-            zqevi=zqev0*zqevti/(zqevt+zqevti)
-         ELSE
-!JLD je ne comprends pas les lignes ci-dessous. On repartit les precips
-!       liquides et solides meme si on ne sature pas la couche. 
-!       A mon avis, le test est inutile, et il faudrait tout remplacer par:
-!            zqev=zqevt
-!            zqevi=zqevti
-             IF (zqevt+zqevti.GT.0.) THEN
-                zqev=MIN(zqev0*zqevt/(zqevt+zqevti),zqevt)
-                zqevi=MIN(zqev0*zqevti/(zqevt+zqevti),zqevti)
-             ELSE
-             zqev=0.
-             zqevi=0.
-             ENDIF
-         ENDIF
-         ! Nouveaux flux de precip liquide et solide 
-         zrfln(i) = Max(0.,zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1)) &
-                                 /RG/dtime)
-         zifln(i) = Max(0.,zifl(i) - zqevi*(paprs(i,k)-paprs(i,k+1)) &
-                                 /RG/dtime)
-
-         ! Mise a jour de la vapeur, temperature et flux de precip
-         zq(i) = zq(i) - (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
-                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-       if (fl_cor_ebil .GT. 0) then ! avec correction thermalisation des precips
-         zmqc(i) = zmqc(i) + (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
-                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-         zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
-                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
-                  * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i))) &
-                  + (zifln(i)-zifl(i)) &
-                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
-                  * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
-       else ! sans correction thermalisation des precips
-         zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
-                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
-                  * RLVTT/RCPD/(1.0+RVTMP2*zq(i)) &
-                  + (zifln(i)-zifl(i)) &
-                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
-                  * RLSTT/RCPD/(1.0+RVTMP2*zq(i))
-       end if
-        ! Nouvelles vaeleurs des precips liquides et solides 
-         zrfl(i) = zrfln(i)
-         zifl(i) = zifln(i)
-!        print*,'REEVAP ',itap,k,znebprecip(1),zqev0,zqev,zqevi,zrfl(1)
-
-!CR ATTENTION: deplacement de la fonte de la glace
-!jyg : Bug !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! jyg
-!!!        zmelt = ((zt(i)-273.15)/(ztfondue-273.15))**2  !!!!!!!!! jyg
-!jyg : Bug !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! jyg
-           zmelt = ((zt(i)-273.15)/(ztfondue-273.15))             ! jyg
-           ! fraction de la precip solide qui est fondue
-           zmelt = MIN(MAX(zmelt,0.),1.)
-           ! Fusion de la glace
-           zrfl(i)=zrfl(i)+zmelt*zifl(i)
-           if (fl_cor_ebil .LE. 0) then
-             ! the following line should not be here. Indeed, if zifl is modified
-             ! now, zifl(i)*zmelt is no more the amount of ice that has melt
-             ! and therefore the change in temperature computed below is wrong
-             zifl(i)=zifl(i)*(1.-zmelt)
-           end if
-           ! Chaleur latente de fusion
-        if (fl_cor_ebil .GT. 0) then ! avec correction thermalisation des precips
-           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
-                      *RLMLT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
-        else ! sans correction thermalisation des precips
-           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
-                      *RLMLT/RCPD/(1.0+RVTMP2*zq(i))
-        end if
-           if (fl_cor_ebil .GT. 0) then ! correction bug, deplacement ligne precedente
-             zifl(i)=zifl(i)*(1.-zmelt)
-           end if
-
-           ELSE
-              ! Si on n'a plus de pluies, on reinitialise a 0 la farcion
-              ! sous nuageuse utilisee pour la pluie.
-              znebprecip(i)=0.
-           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
-        ENDDO
-
-      ENDIF ! (.NOT. ice_thermo) 
-     
-     ! ----------------------------------------------------------------
-     ! Fin evaporation de la precipitation
-     ! ----------------------------------------------------------------
-     ENDIF ! (iflag_evap_prec>=1)
-     !
-     ! Calculer Qs et L/Cp*dQs/dT:
-#ifdef ISOVERIF
-!        write(*,*) 'ilp tmp 849'
-           do i=1,klon
-             call iso_verif_positif(370.0-zt(i),'il pleut 938')
-             call iso_verif_positif(zt(i)-100.0,'il pleut 939')
-             do ixt=1,ntraciso
-              call iso_verif_positif_choix(zxt(ixt,i),0.0,'ilp 614')
-             enddo   
-             if (zq(i).gt.ridicule) then
-               if (iso_HDO.gt.0) then
-                  call iso_verif_aberrant_encadre(zxt(iso_HDO,i)/zq(i), &
-     &                   'il pleut 856')                 
-                  if (iso_O18.gt.0) then                
-                   if (iso_verif_O18_aberrant_nostop(zxt(iso_HDO,i)/zq(i), &
-     &               zxt(iso_O18,i)/zq(i),'il pleut 859').eq.1) then
-                     write(*,*) 'i,k,zq=',i,k,zq(i)
-                     write(*,*) 'zqev_diag(i)=',zqev_diag(i)
-                     write(*,*) 'zrfl_ancien(i)=',zrfl_ancien(i)
-                     write(*,*) 'zrfln(i)=',zrfln(i)
-                     write(*,*) 'zq_ancien(i)=',zq_ancien(i)
-                     write(*,*) 'deltaD(zrfl_ancien)=',deltaD(zxtrfl_ancien(iso_HDO,i))
-                     write(*,*) 'deltaO(zrfl_ancien)=',deltaO(zxtrfl_ancien(iso_O18,i))
-                     write(*,*) 'deltaD(zq_ancien)=',deltaD(zxt_ancien(iso_HDO,i))
-                     write(*,*) 'deltaO(zq_ancien)=',deltaO(zxt_ancien(iso_O18,i))
-                     write(*,*) 'zt=',zt(i)
-                     stop
-                endif !if (iso_verif_O18_aberrant_nostop
-               endif !if (iso_O18.gt.0) then
-              endif !if (iso_HDO.gt.0) then
-             endif !if (zq(i).gt.ridicule) then                
-           enddo !do i=1,klon
-#ifdef ISOTRAC
-!      write(*,*) 'ilp tmp 633'
-           do i=1,klon
-              call iso_verif_traceur(zxtrfl(1,i),'il pleut 632')
-           enddo
-!      write(*,*) 'ilp tmp 637,thermcep'
-#endif           
-#endif    
-#ifdef ISOVERIF
-!        write(*,*) 'ilp tmp 888'
-           do i=1,klon
-            do ixt=1,ntraciso
-             call iso_verif_noNaN(zxtrfl(ixt,i),'ilp 624')
-            enddo !do ixt=1,ntraciso
-           enddo ! do i=1,klon
-!        write(*,*) 'ilp tmp 638: k,zoliq,zxtoliq(1,363)=',k,zoliq(363),zxtoliq(1,363)
-#endif
-     !
-     IF (thermcep) THEN
-        DO i = 1, klon
-           zdelta = MAX(0.,SIGN(1.,RTT-zt(i)))
-           zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-       if  (fl_cor_ebil .GT. 0) then ! nouveau
-           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
-       else    
-           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i))
-       endif
-           zqs(i) = R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
-           zqs(i) = MIN(0.5,zqs(i))
-           zcor = 1./(1.-RETV*zqs(i))
-           zqs(i) = zqs(i)*zcor
-           zdqs(i) = FOEDE(zt(i),zdelta,zcvm5,zqs(i),zcor)
-           zdqsdT_raw(i) = zdqs(i)*  &
-         &         RCPD*(1.0+RVTMP2*zq(i)) / (RLVTT*(1.-zdelta) + RLSTT*zdelta)
-        ENDDO
-     ELSE
-        DO i = 1, klon
-           IF (zt(i).LT.t_coup) THEN
-              zqs(i) = qsats(zt(i))/pplay(i,k)
-              zdqs(i) = dqsats(zt(i),zqs(i))
-           ELSE
-              zqs(i) = qsatl(zt(i))/pplay(i,k)
-              zdqs(i) = dqsatl(zt(i),zqs(i))
-           ENDIF
-        ENDDO
-     ENDIF
-     !
-     ! Determiner la condensation partielle et calculer la quantite
-     ! de l'eau condensee:
-     !
-!verification de la valeur de iflag_fisrtilp_qsat pour iflag_ice_thermo=1
-!       if ((iflag_ice_thermo.eq.1).and.(iflag_fisrtilp_qsat.ne.0)) then
-!         write(*,*) " iflag_ice_thermo==1 requires iflag_fisrtilp_qsat==0", &
-!        " but iflag_fisrtilp_qsat=",iflag_fisrtilp_qsat, ". Might as well stop here."
-!         stop
-!       endif
-
-     ! ----------------------------------------------------------------
-     ! P2> Formation du nuage
-     ! ----------------------------------------------------------------
-     ! Variables calculees:
-     !   rneb  : fraction nuageuse
-     !   zcond : eau condensee moyenne dans la maille.
-     !   rhcl: humidite relative ciel-clair
-     !   zt : temperature de la maille
-     ! ----------------------------------------------------------------
-     !
-     IF (cpartiel) THEN
-        ! -------------------------
-        ! P2.A> Nuage fractionnaire
-        ! -------------------------
-        !
-        !   Calcul de l'eau condensee et de la fraction nuageuse et de l'eau
-        !   nuageuse a partir des PDF de Sandrine Bony.
-        !   rneb  : fraction nuageuse
-        !   zqn   : eau totale dans le nuage
-        !   zcond : eau condensee moyenne dans la maille.
-        !  on prend en compte le réchauffement qui diminue la partie
-        ! condensee
-        !
-        !   Version avec les raqts
-
-        ! ----------------------------------------------------------------
-        ! P2.A.0> Calcul des grandeurs nuageuses une pdf en creneau
-        ! ----------------------------------------------------------------
-
-#ifdef ISO          
-#ifdef ISOVERIF
-        do i=1,klon
-          if (iso_eau.gt.0) then    
-            if (iso_verif_egalite_choix_nostop(zxt(iso_eau,i),zq(i), &
-     &            'il pleut 608',errmax,errmaxrel).eq.1) then
-              write(*,*) 'i=',i
-              stop
-            endif
-          endif !if (iso_eau.gt.0) then
-#ifdef ISOTRAC
-          call iso_verif_traceur(zxt(1,i),'il pleut 1106')
-#endif          
-        enddo !do i=1,klon        
-#endif
-#endif 
-
-        if (iflag_pdf.eq.0) then
-
-           ! version creneau de (Li, 1998)
-           do i=1,klon
-              zdelq = min(ratqs(i,k),0.99) * zq(i)
-              rneb(i,k) = (zq(i)+zdelq-zqs(i)) / (2.0*zdelq)
-              zqn(i) = (zq(i)+zdelq+zqs(i))/2.0
-           enddo
-
-        else !  if (iflag_pdf.eq.0)
-           ! ----------------------------------------------------------------
-           ! P2.A.1> Avec les nouvelles PDFs, calcul des grandeurs nuageuses pour 
-           ! les valeurs de T et Q initiales
-           ! ----------------------------------------------------------------
-           do i=1,klon
-              if(zq(i).lt.1.e-15) then
-                 ncoreczq=ncoreczq+1
-#ifdef ISO
-                zq_ancien(i)=zq(i)
-#endif
-                 zq(i)=1.e-15
-#ifdef ISO
-                ! on conserve le même rapport pour les isotopes
-                if (zq_ancien(i).gt.0.0) then
-                   do ixt=1,ntraciso
-                     zxt(ixt,i)=zxt(ixt,i)/zq_ancien(i)*zq(i)
-                     zxt(ixt,i)=max(0.0,zxt(ixt,i))
-                   enddo   
-                else !if (zq_ancien(i).gt.0.0) then
-                    do ixt=1,ntraciso
-                     zxt(ixt,i)=0.0
-                   enddo 
-                endif !if (zq_ancien(i).gt.0.0) then
-
-                ! verif
-#ifdef ISOVERIF
-                  if (iso_eau.gt.0) then
-                    call iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
-     &                 'il pleut 654',errmax,errmaxrel)
-                  endif !if (iso_eau.gt.0) then
-#ifdef ISOTRAC
-             call iso_verif_traceur(zxt(1,i),'il pleut 1207')
-#endif                    
-#endif
-                ! end verif
-#endif 
-              endif
-           enddo
-
-           if (iflag_cld_th>=5) then
-
-              if (iflag_cloudth_vert<=2) then
-               call cloudth(klon,klev,k,ztv, &
-                   zq,zqta,fraca, &
-                   qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
-                   ratqs,zqs,t)
-              elseif (iflag_cloudth_vert>=3 .and. iflag_cloudth_vert<=5) then
-               call cloudth_v3(klon,klev,k,ztv, &
-                   zq,zqta,fraca, &
-                   qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
-                   ratqs,zqs,t)
-              !----------------------------------
-              !Version these Jean Jouhaud, Decembre 2018 
-              !----------------------------------              
-              elseif (iflag_cloudth_vert==6) then
-               call cloudth_v6(klon,klev,k,ztv, &
-                   zq,zqta,fraca, &
-                   qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
-                   ratqs,zqs,t)
-
-              endif
-              do i=1,klon
-                 rneb(i,k)=ctot(i,k)
-                 rneblsvol(i,k)=ctot_vol(i,k)
-                 zqn(i)=qcloud(i)
-              enddo
-
-           endif
-
-           if (iflag_cld_th <= 4) then
-              lognormale = .true.
-           elseif (iflag_cld_th >= 6) then
-              ! lognormale en l'absence des thermiques
-              lognormale = fraca(:,k) < 1e-10
-           else
-              ! Dans le cas iflag_cld_th=5, on prend systématiquement la
-              ! bi-gaussienne
-              lognormale = .false.
-           end if
-
-!CR: variation de qsat avec T en presence de glace ou non
-!initialisations
-           do i=1,klon
-              DT(i) = 0.
-              n_i(i)=0
-              Tbef(i)=zt(i)
-              qlbef(i)=0.
-           enddo
-
-        ! ----------------------------------------------------------------
-        ! P2.A.2> Prise en compte du couplage entre eau condensee et T.
-        ! Calcul des grandeurs nuageuses en tenant compte de l'effet de
-        ! la condensation sur T, et donc sur qsat et sur les grandeurs nuageuses
-        ! qui en dependent. Ce changement de temperature est provisoire, et
-        ! la valeur definitive sera calcule plus tard.
-        ! Variables calculees: 
-        !   rneb : nebulosite
-        !   zcond: eau condensee en moyenne dans la maille
-        ! note JLD: si on n'a pas de pdf lognormale, ce qui se passe ne me semble
-        ! pas clair, il n'y a probablement pas de prise en compte de l'effet de
-        ! T sur qsat
-        ! ----------------------------------------------------------------
-
-!Boucle iterative: ATTENTION, l'option -1 n'est plus activable ici
-           if (iflag_fisrtilp_qsat.ge.0) then
-             ! Iteration pour condensation avec variation de qsat(T) 
-             ! -----------------------------------------------------
-             do iter=1,iflag_fisrtilp_qsat+1
-                
-               do i=1,klon
-!                 do while ((abs(DT(i)).gt.DDT0).or.(n_i(i).eq.0))
-                 ! !! convergence = .true. tant que l'on n'a pas converge !!
-                 ! ------------------------------
-                 convergence(i)=abs(DT(i)).gt.DDT0
-                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
-                 ! si on n'a pas converge
-                 !
-                 ! P2.A.2.1> Calcul de la fraction nuageuse et de la quantite d'eau condensee
-                 ! ---------------------------------------------------------------
-                 ! Variables calculees: 
-                 ! rneb : nebulosite
-                 ! zqn : eau condensee, dans le nuage (in cloud water content)
-                 ! zcond: eau condensee en moyenne dans la maille
-                 ! rhcl: humidite relative ciel-clair
-                 !
-                 Tbef(i)=Tbef(i)+DT(i) ! nouvelle temperature
-                 if (.not.ice_thermo) then   
-                    zdelta = MAX(0.,SIGN(1.,RTT-Tbef(i)))
-                 else
-                    if (iflag_t_glace.eq.0) then
-                    zdelta = MAX(0.,SIGN(1.,t_glace_min_old-Tbef(i)))
-                    else if (iflag_t_glace.ge.1) then
-                       if (iflag_oldbug_fisrtilp.EQ.0) then
-                          zdelta = MAX(0.,SIGN(1.,t_glace_max-Tbef(i)))
-                       else
-                          !avec bug : zdelta = MAX(0.,SIGN(1.,t_glace_min-Tbef(i)))
-                          zdelta = MAX(0.,SIGN(1.,t_glace_min-Tbef(i)))
-                       endif
-                    endif
-                 endif
-                 ! Calcul de rneb, qzn et zcond pour les PDF lognormales
-                 zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-               if (fl_cor_ebil .GT. 0) then
-                 zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
-               else
-                 zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i))
-               end if
-                 zqs(i) = R2ES*FOEEW(Tbef(i),zdelta)/pplay(i,k)
-                 zqs(i) = MIN(0.5,zqs(i))
-                 zcor = 1./(1.-RETV*zqs(i))
-                 zqs(i) = zqs(i)*zcor
-                 zdqs(i) = FOEDE(Tbef(i),zdelta,zcvm5,zqs(i),zcor)
-                 zpdf_sig(i)=ratqs(i,k)*zq(i)
-                 zpdf_k(i)=-sqrt(log(1.+(zpdf_sig(i)/zq(i))**2))
-                 zpdf_delta(i)=log(zq(i)/zqs(i))
-                 zpdf_a(i)=zpdf_delta(i)/(zpdf_k(i)*sqrt(2.))
-                 zpdf_b(i)=zpdf_k(i)/(2.*sqrt(2.))
-                 zpdf_e1(i)=zpdf_a(i)-zpdf_b(i)
-                 zpdf_e1(i)=sign(min(abs(zpdf_e1(i)),5.),zpdf_e1(i))
-                 zpdf_e1(i)=1.-erf(zpdf_e1(i))
-                 zpdf_e2(i)=zpdf_a(i)+zpdf_b(i)
-                 zpdf_e2(i)=sign(min(abs(zpdf_e2(i)),5.),zpdf_e2(i))
-                 zpdf_e2(i)=1.-erf(zpdf_e2(i))
-             
-                 if (zpdf_e1(i).lt.1.e-10) then
-                    rneb(i,k)=0.
-                    zqn(i)=zqs(i)
-                 else
-                    rneb(i,k)=0.5*zpdf_e1(i)
-                    zqn(i)=zq(i)*zpdf_e2(i)/zpdf_e1(i)
-                 endif
-
-                 ! If vertical heterogeneity, change fraction by volume as well
-                 if (iflag_cloudth_vert>=3) then
-                   ctot_vol(i,k)=rneb(i,k)
-                   rneblsvol(i,k)=ctot_vol(i,k)
-                 endif
-
-                 endif !convergence
-
-               enddo ! boucle en i
-
-                 ! P2.A.2.2> Calcul APPROCHE de la variation de temperature DT 
-                 !         due a la condensation.
-                 ! ---------------------------------------------------------------
-                 ! Variables calculees: 
-                 ! DT : variation de temperature due a la condensation 
-
-                 if (.not. ice_thermo) then
-                 ! --------------------------
-                 do i=1,klon
-                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
-
-                 qlbef(i)=max(0.,zqn(i)-zqs(i))
-               if (fl_cor_ebil .GT. 0) then
-                 num=-Tbef(i)+zt(i)+rneb(i,k)*RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
-               else
-                 num=-Tbef(i)+zt(i)+rneb(i,k)*RLVTT/RCPD/(1.0+RVTMP2*zq(i))*qlbef(i)
-               end if
-                 denom=1.+rneb(i,k)*zdqs(i)
-                 DT(i)=num/denom
-                 n_i(i)=n_i(i)+1
-                 endif
-                 enddo
-
-                 else ! if (.not. ice_thermo)
-                 ! --------------------------
-                 if (iflag_t_glace.ge.1) then
-                 CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
-                 endif
-
-                 do i=1,klon
-                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
-                 
-                 if (iflag_t_glace.eq.0) then
-                    zfice(i) = 1.0 - (Tbef(i)-t_glace_min_old) / (RTT-t_glace_min_old)
-                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
-                    zfice(i) = zfice(i)**exposant_glace_old
-                    dzfice(i)= exposant_glace_old * zfice(i)**(exposant_glace_old-1) &
-          &                     / (t_glace_min_old - RTT)
-                 endif
-                 
-                 if (iflag_t_glace.ge.1.and.zfice(i)>0.) then
-                 dzfice(i)= exposant_glace * zfice(i)**(exposant_glace-1) &
-          &                    / (t_glace_min - t_glace_max)
-                 endif
-               
-                 if ((zfice(i).eq.0).or.(zfice(i).eq.1)) then
-                    dzfice(i)=0.
-                 endif
-
-                 if (zfice(i).lt.1) then
-                    cste=RLVTT
-                 else
-                    cste=RLSTT
-                 endif
-
-                 qlbef(i)=max(0.,zqn(i)-zqs(i))
-               if (fl_cor_ebil .GT. 0) then
-                 num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT &
-           &          +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
-                 denom = 1.+rneb(i,k)*((1-zfice(i))*RLVTT+zfice(i)*RLSTT)/cste*zdqs(i) &
-                         -(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*rneb(i,k)    &
-           &               *qlbef(i)*dzfice(i)
-               else
-                 num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT &
-           &         +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*zq(i))*qlbef(i)
-                 denom = 1.+rneb(i,k)*((1-zfice(i))*RLVTT+zfice(i)*RLSTT)/cste*zdqs(i) &
-                         -(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*zq(i))*rneb(i,k)*qlbef(i)*dzfice(i)
-               end if
-                 DT(i)=num/denom
-                 n_i(i)=n_i(i)+1
-
-                 endif ! fin convergence
-                 enddo ! fin boucle i
-
-                 endif !ice_thermo
-
-             enddo ! iter=1,iflag_fisrtilp_qsat+1
-             ! Fin d'iteration pour condensation avec variation de qsat(T) 
-             ! -----------------------------------------------------------
-           endif !  if (iflag_fisrtilp_qsat.ge.0)
-     ! ----------------------------------------------------------------
-     ! Fin de P2.A.2> la prise en compte du couplage entre eau condensee et T
-     ! ----------------------------------------------------------------
-
-        endif ! iflag_pdf
-
-!        if (iflag_fisrtilp_qsat.eq.-1) then 
-!------------------------------------------
-!CR: ATTENTION option fausse mais a existe:
-! pour la re-activer, prendre iflag_fisrtilp_qsat=0 et
-! activer les lignes suivantes: 
-       IF (1.eq.0) THEN 
-       DO i=1,klon
-           IF (rneb(i,k) .LE. 0.0) THEN
-              zqn(i) = 0.0
-              rneb(i,k) = 0.0
-              zcond(i) = 0.0
-              rhcl(i,k)=zq(i)/zqs(i)
-           ELSE IF (rneb(i,k) .GE. 1.0) THEN
-              zqn(i) = zq(i)
-              rneb(i,k) = 1.0                 
-              zcond(i) = MAX(0.0,zqn(i)-zqs(i))/(1+zdqs(i))
-              rhcl(i,k)=1.0
-           ELSE
-              zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)/(1+zdqs(i))
-              rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
-           ENDIF
-       ENDDO
-       ENDIF
-!------------------------------------------
-
-!        ELSE
-        ! ----------------------------------------------------------------
-        ! P2.A.3> Calcul des valeures finales associees a la formation des nuages
-        ! Variables calculees: 
-        !   rneb : nebulosite
-        !   zcond: eau condensee en moyenne dans la maille
-        !   zq : eau vapeur dans la maille
-        !   zt : temperature de la maille
-        !   rhcl: humidite relative ciel-clair
-        ! ----------------------------------------------------------------
-        !
-        ! Bornage de l'eau in-cloud (zqn) et de la fraction nuageuse (rneb) 
-        ! Calcule de l'eau condensee moyenne dans la maille (zcond),
-        ! et de l'humidite relative ciel-clair (rhcl)
-        DO i=1,klon
-           IF (rneb(i,k) .LE. 0.0) THEN
-              zqn(i) = 0.0
-              rneb(i,k) = 0.0
-              zcond(i) = 0.0
-              rhcl(i,k)=zq(i)/zqs(i)
-           ELSE IF (rneb(i,k) .GE. 1.0) THEN
-              zqn(i) = zq(i)
-              rneb(i,k) = 1.0
-              zcond(i) = MAX(0.0,zqn(i)-zqs(i))
-              rhcl(i,k)=1.0
-           ELSE
-              zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)
-              rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
-           ENDIF
-        ENDDO
-        ! If vertical heterogeneity, change fraction by volume as well
-        if (iflag_cloudth_vert>=3) then
-          ctot_vol(1:klon,k)=min(max(ctot_vol(1:klon,k),0.),1.)
-          rneblsvol(1:klon,k)=ctot_vol(1:klon,k)
-        endif
-
-!        ENDIF
-
-     ELSE ! de IF (cpartiel) 
-        ! -------------------------
-        ! P2.B> Nuage "tout ou rien"
-        ! -------------------------
-        ! note JLD: attention, rhcl non calcule. Ca peut avoir des consequences?
-        DO i = 1, klon
-           IF (zq(i).GT.zqs(i)) THEN
-              rneb(i,k) = 1.0
-           ELSE
-              rneb(i,k) = 0.0
-           ENDIF
-           zcond(i) = MAX(0.0,zq(i)-zqs(i))/(1.+zdqs(i))
-        ENDDO
-     ENDIF ! de IF (cpartiel) 
-
-#ifdef ISO
-        ! on calcule la compo iso de l'eau dans le nuage et en ciel
-        ! clair: zxtn/zqn et zxtcs/zqcs
-
-              ! Hypothèsesimplificatrice mais peut-être fausse: 
-              ! eau nuageuse a même composition que eau de la maille 
-
-              ! ce calcul n'eat pas sensé dépendre du type de PDF utilisé     
-         do i=1,klon  
-#ifdef ISOTRAC
-            if (option_tmin.eq.1) then
-                ! c'est mieux si zqn>=0.0
-            if (essai_convergence) then
-            else
-                zqn(i)=max(0.0,zqn(i))
-            endif    
-
-            if (rneb(i,k).lt.1.0) then
-                zqcs(i)=(zq(i)-zqn(i)*rneb(i,k))/(1.0-rneb(i,k))
-#ifdef ISOVERIF
-!                write(*,*) 'rneb,zq,zqn,zqcs=',rneb(i,k),zq(i), &
-!     &                zqn(i),zqcs(i)
-                call iso_verif_positif(zqcs(i),'ipleut 853')
-#endif                
-            else
-                zqcs(i)=0.0
-            endif
-            endif ! if (option_tmin.eq.1) then
-#endif                  
-#ifdef ISOVERIF
-              if (iso_eau.gt.0) then  
-                 call iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
-     &                   'il pleut 748',errmax,errmaxrel) 
-              endif !if (iso_eau.gt.0) then
-              do ixt=1,ntraciso
-                call iso_verif_positif_choix(zxt(ixt,i),0.0,'ilp 857')
-              enddo 
-#ifdef ISOTRAC
-              call iso_verif_traceur_pbidouille(zxt(1,i), &
-     &           'il pleut 874')
-#endif              
-#endif
-              if ((bidouille_anti_divergence).and. &
-     &           (iso_eau.gt.0)) then
-                zxt(iso_eau,i)= max(zq(i),0.0)  
-!                if (zxt(iso_eau,i).gt.0.0) then
-!                    do ixt=1,niso
-!                        zxt(ixt,i)=zxt(ixt,i)*zq(i)/zxt(iso_eau,i)
-!                    enddo
-!                else !if (zxt(iso_eau,i).gt.0.0) then
-!                    do ixt=1,niso
-!                        zxt(ixt,i)=0.0
-!                    enddo    
-!                endif !if (zxt(iso_eau,i).gt.0.0) then
-              endif !if ((bidouille_anti_divergence).and. 
-
-              if (zq(i).gt.1e-15) then   
-                ! 2 fev 2010: on modifie seuil de zq  
-                ! avant, c'était 0. Vérifier que ça n'a pas de
-                ! conséquences trop graves pour les isotopes.
-                do ixt=1,ntraciso             
-                   zxtn(ixt,i)=zqn(i)*(zxt(ixt,i)/zq(i))  
-                enddo !do ixt=1,niso         
-#ifdef ISOTRAC
-               if (option_tmin.eq.1) then
-                 do ixt=1,ntraciso
-                   zxtcs(ixt,i)=(zqcs(i))*(zxt(ixt,i)/zq(i))
-                 enddo !do ixt=1,ntraciso
-               endif ! if (option_tmin.eq.1) then
-#endif                
-              else !if (zq(i).gt.0.0) then 
-                  ! problème: zq~0 et sans compo, mais zqn >0
-                  ! on fait ce qu'on peut dans ce cas pathologique
-                do ixt=1,ntraciso           
-                   zxtn(ixt,i)=0.0              
-                enddo !do ixt=1,niso 
-#ifdef ISOTRAC
-                if (option_tmin.eq.1) then
-                 do ixt=1,ntraciso
-                   zxtcs(ixt,i)=0.0
-                 enddo !do ixt=1,niso    
-                endif ! if (option_tmin.eq.1) then
-#endif                     
-                if ((bidouille_anti_divergence) &
-     &                   .and.(iso_eau.gt.0)) then
-!                   write(*,*) 'ilp tmp 848: warning: bidouille'
-                   zxtn(iso_eau,i)=zqn(i)
-#ifdef ISOTRAC
-                   zxtn(itZonIso(izone_poubelle,iso_eau),i)=zqn(i)  
-                   if (option_tmin.eq.1) then                   
-                     zxtcs(iso_eau,i)=zqcs(i)
-                   endif ! if (option_tmin.eq.1) then
-!                   write(*,*) 'zxtn(:,i)=',zxtn(:,i)
-#endif                   
-                endif !if ((bidouille_anti_divergence)
-              endif  !if (zq(i).gt.0.0) then 
-
-#ifdef ISOVERIF
-             do ixt=1,niso     
-                  call iso_verif_positif(zxtn(ixt,i),'il pleut 1062')  
-             enddo !do ixt=1,niso
-             if (iso_eau.gt.0) then
-                   call iso_verif_egalite_choix(zxtn(iso_eau,i),zqn(i), &
-     &                   'il pleut 932',errmax,errmaxrel)
-             endif !if ((iso_eau.gt.0)) then
-#ifdef ISOTRAC
-!             write(*,*) 'zxt(:,i)=',zxt(:,i)   
-!             write(*,*) 'zq,zqn=',zq(i) ,zqn(i)  
-             call iso_verif_traceur_pbidouille(zxtn(1,i), &
-     &           'il pleut 1277')
-             if (option_tmin.eq.1) then
-              call iso_verif_positif(zxtcs(ixt,i),'il pleut 895')  
-              do ixt=1,niso     
-               call iso_verif_positif(zxtcs(ixt,i),'il pleut 897')  
-              enddo !do ixt=1,niso
-              if (iso_eau.gt.0) then
-               call iso_verif_egalite_choix(zxtcs(iso_eau,i), &
-     &              zqcs(i),'il pleut 733',errmax,errmaxrel)
-              endif !if ((iso_eau.gt.0)) then
-             endif ! if (option_tmin.eq.1) then
-#endif 
-#endif                   
-!                 write(*,*) 'il pleut 695: calcul de zxtn, i=',i
-!                 write(*,*) 'zxtn(4,i)=',zxtn(4,i)
-!                 write(*,*) 'zqn(i)=',zqn(i)
-              do ixt=1,ntraciso    
-               zxtn(ixt,i)=max(0.0,zxtn(ixt,i))          
-              enddo !do ixt=1,niso
-#ifdef ISOTRAC
-              if (option_tmin.eq.1) then
-              do ixt=1,ntraciso
-               zxtcs(ixt,i)=max(0.0,zxtcs(ixt,i))
-              enddo
-              endif ! if (option_tmin.eq.1) then
-#endif                            
-
-#ifdef ISOVERIF
-               if (iso_eau.gt.0) then
-                  call iso_verif_egalite_choix(zxtn(iso_eau,i),zqn(i), &
-     &                   'il pleut 746',errmax,errmaxrel) 
-               endif !if (iso_eau.gt.0) then
-               if (iso_HDO.gt.0) then
-                if (zqn(i).gt.ridicule) then
-                   call iso_verif_aberrant(zxtn(iso_HDO,i)/zqn(i), &
-     &                   'il pleut 977') 
-                endif  !if (zqn(i).gt.ridicule) then
-               endif  !if (iso_HDO.gt.0) then  
-#ifdef ISOTRAC               
-             call iso_verif_traceur_pbidouille  &
-     &                  (zxtn(1,i),'il pleut 1300')
-             if (option_tmin.eq.1) then
-               if (iso_eau.gt.0) then   
-                   call iso_verif_egalite_choix(zxtcs(iso_eau,i), &
-     &                   zqcs(i), &
-     &                   'il pleut 971',errmax,errmaxrel)
-               endif !if (iso_eau.gt.0) then
-               call iso_verif_traceur_pbidouille &
-     &                  (zxtcs(1,i),'il pleut 1300')
-             
-             endif ! if (option_tmin.eq.1) then
-#endif                
-#endif   
-         enddo ! do i=1,klon
-         
-!        write(*,*) 'ilp tmp 1311: zoliq,zxtoliq(1,363)=',zoliq(363),zxtoliq(1,363)
-#endif    
-     !
-     ! Mise a jour vapeur d'eau
-     ! -------------------------
-     DO i = 1, klon
-        zq(i) = zq(i) - zcond(i)
-        !         zt(i) = zt(i) + zcond(i) * RLVTT/RCPD
-     ENDDO
-!AJ<
-     ! ------------------------------------
-     ! P2.C> Prise en compte de la Chaleur latente apres formation nuage
-     ! -------------------------------------
-     ! Variable calcule:
-     !   zt : temperature de la maille
-     !
-     IF (.NOT. ice_thermo) THEN
-        if (iflag_fisrtilp_qsat.lt.1) then
-           DO i = 1, klon
-             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
-           ENDDO
-        else if (iflag_fisrtilp_qsat.gt.0) then
-           DO i= 1, klon
-    if (fl_cor_ebil .GT. 0) then
-             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
-    else
-             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i)))
-    end if
-           ENDDO
-        endif
-     ELSE
-         if (iflag_t_glace.ge.1) then
-            CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
-         endif
-         if (iflag_fisrtilp_qsat.lt.1) then
-           DO i = 1, klon
-! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
-!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
-!                                     t_glace_max, exposant_glace)
-              if (iflag_t_glace.eq.0) then
-                    zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
-                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
-                    zfice(i) = zfice(i)**exposant_glace_old
-              endif
-              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i)) &
-                       +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*zq(i))
-           ENDDO
-         else
-           DO i=1, klon
-! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
-!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
-!                                     t_glace_max, exposant_glace)
-              if (iflag_t_glace.eq.0) then
-                    zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
-                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
-                    zfice(i) = zfice(i)**exposant_glace_old
-              endif
-        if (fl_cor_ebil .GT. 0) then
-              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) & 
-           &             * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i))) &
-                      +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
-        else 
-              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i))) &
-                      +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i)))
-        end if
-           ENDDO
-         endif
-!         print*,zt(i),zrfl(i),zifl(i),'temp1'
-       ENDIF
-!>AJ
-
-      ! isotopes lors de la condensation
-#ifdef ISO          
-#ifdef ISOVERIF
-!        write(*,*) 'ilp tmp 1823'
-      do i=1,klon
-        ! verif
-        if (iso_eau.gt.0) then
-          call iso_verif_egalite_choix(zxtn(iso_eau,i),zqn(i), &
-     &           'il pleut 810',errmax,errmaxrel) 
-        endif !if (iso_eau.gt.0) then 
-#ifdef ISOTRAC
-        call iso_verif_traceur(zxtn(1,i),'il pleut 1408')
-!        write(*,*) 'fisrtilp 1421: appel condiso_liq_ice_vectall'
-#endif
-       enddo !do i=1,klon 
-!       write(*,*) 'il pleut 961: avant condensation'
-       ! end verif
-#endif
-      
-      do i=1,klon  
-!        call calcul_zfice(zt(i),zfice(i)) ! inliner pour optimisation:
-        zfice(i)=1.0-(zt(i)-pxtice)/(pxtmelt-pxtice)
-        zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
-       enddo  
-        
-        ! calcul de la composition du condensat
-        ! hypothèse simplificatrice (mais à garder en mémoire!): l'eau
-        ! nuageuse a la même composition que l'eau totale de la maille:
-        ! c'est à dire zxtn=(zxt/zq)*zqn
-        
-        call condiso_liq_ice_vectall(zxtn,zqn,zcond,zt,zfice, &
-     &            zxtice,zxtliq,klon)
-#ifdef ISOTRAC
-!#ifdef ISOVERIF
-!        write(*,*) 'il pleut 980: condensation pour les traceurs'
-!#endif        
-        call condiso_liq_ice_vectall_trac(zxtn,zqn,zcond, &
-     &            zt,zfice,zxtice,zxtliq,klon)
-#ifdef ISOVERIF
-!        write(*,*) 'ilp tmp 1859'
-        do i=1,klon             
-             call iso_verif_traceur(zxtn(1,i),'il pleut 1428a')
-             call iso_verif_traceur(zxtliq(1,i),'il pleut 1428b')
-             call iso_verif_traceur(zxtice(1,i),'il pleut 1428c')
-        enddo
-#endif
-#endif
-        do i=1,klon
-        do ixt=1,ntraciso                 
-          zxtcond(ixt,i)=zxtice(ixt,i)+zxtliq(ixt,i)
-          zxtcond(ixt,i)=max(zxtcond(ixt,i),0.0)
-          zxtcond(ixt,i)=min(zxtcond(ixt,i),zxt(ixt,i))
-        enddo !do ixt=1,niso 
-        enddo !do i=1,klon
-
-       do i=1,klon   
-       enddo  !do i=1,klon       
-        
-!#ifdef ISOVERIF
-#ifdef ISOVERIF
-        do i=1,klon
-          do ixt=1,ntraciso  
-            call iso_verif_noNAN(zxtcond(ixt,i),'il pleut 638')
-          enddo
-        enddo !do i=1,klon 
-#endif       
-#ifdef ISOVERIF       
-        if (iso_eau.gt.0) then
-          do i=1,klon      
-              call iso_verif_egalite_choix(zxtcond(iso_eau,i),zcond(i), &
-     &                   'il pleut 645',errmax,errmaxrel)
-          enddo ! do i=1,klon     
-        endif
-        if (iso_HDO.gt.0) then
-           do i=1,klon  
-              if (zcond(i).gt.ridicule) then
-                 call iso_verif_aberrant(zxtcond(iso_HDO,i) &
-     &                  /zcond(i), 'il pleut 637')                
-              endif  !if (zcond(i).gt.ridicule) then
-              IF ((t(i,1)) .LT. RTT) THEN
-                  call iso_verif_aberrant_choix(zxtcond(iso_hdo,i), &
-     &           zcond(i),ridicule_rain,deltalim_snow,'il pleut 1276')
-              endif
-           enddo ! do i=1,klon  
-        endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
-#ifdef ISOTRAC
-        do i=1,klon
-             if (iso_verif_traceur_nostop(zxtcond(1,i),'il pleut 1455') &
-     &                   .eq.1) then
-               write(*,*) 'zxtn(:,i)=',zxtn(:,i)
-               write(*,*) 'zxt(:,i)=',zxt(:,i)
-               write(*,*) 'zxtliq(:,i)=',zxtliq(:,i)
-               write(*,*) 'zxtice(:,i)=',zxtice(:,i)
-               stop
-             endif
-        enddo     
-#endif         
-#endif
-
-       ! retranchage à zxt 
-      do i=1,klon 
-       do ixt=1,ntraciso
-          zxt(ixt,i)=zxt(ixt,i)-zxtcond(ixt,i)
-       enddo !do ixt=1,niso   
-      enddo !do i=1,klon 
-
-#ifdef ISOVERIF
-      do i=1,klon
-         do ixt=1,niso
-          call iso_verif_positif(zxt(ixt,i),'il pleut 1088')
-         enddo !do ixt=1,niso
-#ifdef ISOTRAC  
-         ! on sépare pour mieux débugger 8 fev 2010
-         do ixt=1,ntraciso
-          call iso_verif_positif(zxt(ixt,i),'il pleut 1093')
-         enddo !do ixt=1,niso
-#endif      
-      enddo   !do i=1,klon
-#endif
-
-#ifdef ISOTRAC        
-        if (option_tmin.ge.1) then
-        do i=1,klon    
-        ! colorier la vapeur résiduelle selon température de
-        ! condensation, et le condensat en un tag spécifique
-        ! Attention: zqn,zxtn ne servent qu'au calcul de zcond,zxtcond.
-        ! C'est en fait zxt qui se fait retranché
-        ! correction le 31 mars 2010: c'est à qn qu'il faut retrancher
-        ! le condensat, car la condensation LS est un processus sous
-        ! maille -> ne tagguer que le résidus de qn.
-          if ((zcond(i).gt.0.0).and.(zq(i).gt.0.0)) then 
-
-            if (rneb(i,k).gt.0.0) then
-              zcondn(i)=zcond(i)/rneb(i,k)
-              do ixt=1,ntraciso
-                zxtcondn(ixt,i)=zxtcond(ixt,i)/rneb(i,k)
-              enddo !do ixt=1,ntraciso
-            else !if (rneb.eq.0.0)
-              zcondn(i)=0.0
-              do ixt=1,ntraciso
-                zxtcondn(ixt,i)=0.0
-              enddo !do ixt=1,ntraciso
-#ifdef ISOVERIF
-              call iso_verif_egalite(zcond(i),0.0,'ilp 1225')
-#endif              
-            endif !if (rneb.eq.0.0)
-            
-#ifdef ISOVERIF
-          call iso_verif_egalite_choix(zxtcondn(iso_eau,i),zcondn(i), &
-     &                   'il pleut 1244',errmax*10,errmaxrel*10)
-          call iso_verif_traceur(zxtcondn(1,i),'cv3_routines 2302')
-          zq_verif=rneb(i,k)*zqn(i)+(1.0-rneb(i,k))*zqcs(i)-zcond(i)
-          call iso_verif_egalite_choix(zq(i),zq_verif, &
-     &                   'il pleut 1235',errmax,errmaxrel)
-          do ixt=1,niso
-            zq_verif=rneb(i,k)*zxtn(ixt,i) &
-     &           +(1.0-rneb(i,k))*zxtcs(ixt,i)-zxtcond(ixt,i)
-            call iso_verif_egalite_choix(zxt(ixt,i),zq_verif, &
-     &                   'il pleut 1235',errmax,errmaxrel)
-          enddo
-#endif            
-          ! bidouille
-          if (bidouille_anti_divergence) then
-                zxtcondn(iso_eau,i)=zcondn(i)
-#ifdef ISOVERIF                
-                call iso_verif_traceur_pbidouille(zxtcondn(1,i), &
-     &          'il pleut 1261')
-#endif                
-          endif
-
-            if (option_traceurs.eq.17) then      
-            call iso_recolorise_condensation(zqn(i),zcondn(i), &
-     &           zxtn(1,i),zxtcondn(1,i),zt(i),1.0,zxtres, &
-     &           seuil_tag_tmin_ls)
-            else !if (option_traceurs.eq.17) then
-                ! cas du tag 18 ou 19
-                call iso_recolorise_condensation(zqn(i),zcondn(i), &
-     &           zxtn(1,i),zxtcondn(1,i),zqs(i),1.0,zxtres, &
-     &           seuil_tag_tmin_ls)
-            endif !if (option_traceurs.eq.17) then
-            do ixt=1+niso,ntraciso
-               zxt(ixt,i)=rneb(i,k)*zxtres(ixt) &
-     &           +(1.0-rneb(i,k))*zxtcs(ixt,i)
-            enddo         
-#ifdef ISOVERIF
-         call iso_verif_traceur(zxt(1,i),'ilp 1025')
-         do izone=izone_oce,izone_ddft
-          if ((izone.eq.izone_oce).or.(izone.eq.izone_ddft)) then
-           ! avec condensation, on ne peut que perdre des traceurs à
-           ! part le tag résuel et le condensat
-           if (iso_verif_positif_choix_nostop( &
-     &           zxt_ancien(itZonIso(izone,iso_eau),i) &
-     &          -zxt(itZonIso(izone,iso_eau),i),1e-8,'ilp 1270') &
-     &          .eq.1) then
-            write(*,*) 'i,izone,rneb=',i,izone,rneb(i,k)
-            write(*,*) 'zxt(:,i)=',zxt(:,i)
-            write(*,*) 'zxt_ancien(:,i)=',zxt_ancien(:,i)
-            write(*,*) 'zxtcs(:,i)=',zxtcs(:,i)
-            write(*,*) 'zxtres(:)=',zxtres(:)
-            write(*,*) 'zxtcond(:,i)=',zxtcond(:,i)
-            write(*,*) 'zxtn(:,i)=',zxtn(:,i)
-            write(*,*) 'zxtcondn(:,i)=',zxtcondn(:,i)
-            stop
-           endif !if (iso_verif_positif_nostop(
-          endif !if ((izone.eq.izone_oce).or.(izone.eq.izone_ddft)) then
-         enddo !do izone=izone_oce,izone_revap
-#endif                     
-          endif !if (cond.gt.0.0) then
-        enddo !do i=1,klon
-
-#ifdef ISOVERIF
-        ! vérifier qu'on recolorise bien le condensat
-        call iso_verif_positif(float(option_cond-1),'ilp 1310')
-#endif        
-        endif ! if (option_tmin.ge.1) then
-
-        if (option_cond.eq.1) then
-        ! colorier le condensat en un tag spécifique
-        do i=1,klon        
-          do ixt=1+niso,ntraciso
-            if (index_zone(ixt).eq.izone_cond) then
-              zxtcond(ixt,i)=zxtcond(index_iso(ixt),i)
-            else
-              zxtcond(ixt,i)=0.0
-            endif
-          enddo !do ixt=1,ntraciso
-        enddo !do i=1,klon
-#ifdef ISOVERIF
-        do i=1,klon    
-          call iso_verif_egalite_choix(zxtcond(iso_eau,i),zcond(i), &
-     &                   'il pleut 1139',errmax,errmaxrel)
-          call iso_verif_traceur(zxtcond(1,i),'cv3_routines 2302')
-        enddo !do i=1,klon        
-#endif         
-      endif ! if (option_cond.ge.1) then
-#endif        
-     
-      
-#ifdef ISOVERIF
-!        write(*,*) 'ilp tmp 2066'
-      do i=1,klon
-         do ixt=1,niso
-          call iso_verif_positif(zxt(ixt,i),'il pleut 778')
-         enddo !do ixt=1,niso
-#ifdef ISOTRAC  
-         ! on sépare pour mieux débugger 8 fev 2010
-         do ixt=1,ntraciso
-          call iso_verif_positif(zxt(ixt,i),'il pleut 1135')
-          call iso_verif_traceur(zxt(1,i),'il pleut 1485')
-         enddo !do ixt=1,niso
-#endif
-         if (iso_eau.gt.0) then
-            call iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
-     &                   'il pleut 644',errmax,errmaxrel)
-         endif !if (iso_eau.gt.0) then
-         if (iso_HDO.gt.0) then  
-            if (zq(i).gt.ridicule) then
-             call iso_verif_aberrant_encadre(zxt(iso_HDO,i)/zq(i), &
-     &                   'il pleut 648')                 
-              if (iso_O18.gt.0) then                
-                if (iso_verif_O18_aberrant_nostop(zxt(iso_HDO,i)/zq(i), &
-     &           zxt(iso_O18,i)/zq(i),'il pleut 2059').eq.1) then
-                   write(*,*) 'i,k,zq=',i,k,zq(i)
-                   stop
-                endif !if (iso_verif_O18_aberrant_nostop
-              endif !if (iso_O18.gt.0) then
-            endif !if (zq(i).gt.ridicule) then
-         endif  ! if (iso_HDO.gt.0) then 
-        enddo  ! i=1,klon
-#ifdef ISOTRAC
-        do i=1,klon
-             call iso_verif_traceur(zxt(1,i),'il pleut 1485')
-        enddo     
-#endif         
-#endif
-#ifdef ISOVERIF   
-       do i=1,klon   
-           do ixt=1,ntraciso
-             call iso_verif_noNAN(zxtcond(ixt,i),'il pleut 1560')
-             call iso_verif_noNAN(zxt(ixt,i),'il pleut 1561')
-           enddo   ! ixt=1,niso
-        enddo  !do i=1,klon         
-#endif   
-#endif    
-     ! ----------------------------------------------------------------
-     ! P3> Formation des precipitations
-     ! ----------------------------------------------------------------
-     !
-     ! Partager l'eau condensee en precipitation et eau liquide nuageuse
-     !
-
-     ! Initialisation de zoliq (eau condensee moyenne dans la maille)
-     DO i = 1, klon
-        IF (rneb(i,k).GT.0.0) THEN
-           zoliq(i) = zcond(i)
-           zrho(i) = pplay(i,k) / zt(i) / RD
-           zdz(i) = (paprs(i,k)-paprs(i,k+1)) / (zrho(i)*RG)
-        ENDIF
-     ENDDO
-!AJ<
-     IF (.NOT. ice_thermo) THEN
-       IF (iflag_t_glace.EQ.0) THEN
-         DO i = 1, klon
-            IF (rneb(i,k).GT.0.0) THEN
-               zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (273.13-t_glace_min_old)
-               zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
-               zfice(i) = zfice(i)**exposant_glace_old
-!              zfice(i) = zfice(i)**nexpo
-         !!      zfice(i)=0.
-            ENDIF
-         ENDDO
-       ELSE ! of IF (iflag_t_glace.EQ.0)
-         CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
-!         DO i = 1, klon
-!            IF (rneb(i,k).GT.0.0) THEN
-! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
-!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
-!                                     t_glace_max, exposant_glace)
-!            ENDIF
-!         ENDDO
-       ENDIF
-     ENDIF
-
-     ! Calcul de radliq (eau condensee pour le rayonnement)
-     ! Iteration pour realiser une moyenne de l'eau nuageuse lors de la precip
-     ! Remarque: ce n'est donc pas l'eau restante en fin de precip mais une
-     ! eau moyenne restante dans le nuage sur la duree du pas de temps qui est
-     ! transmise au rayonnement;
-     ! ----------------------------------------------------------------
-     DO i = 1, klon
-        IF (rneb(i,k).GT.0.0) THEN
-           zneb(i) = MAX(rneb(i,k), seuil_neb)
-     !      zt(i) = zt(i)+zcond(i)*zfice(i)*RLMLT/RCPD/(1.0+RVTMP2*zq(i))  
-!           print*,zt(i),'fractionglace'
-!>AJ
-           radliq(i,k) = zoliq(i)/REAL(ninter+1)
-        ENDIF
-     ENDDO
-#ifdef ISO
-      ! initilsation des quantités totales d'eau liquide et solide qui
-      ! tombent
-      do i=1,klon
-         if (rneb(i,k).gt.0.0) then
-            do ixt=1,ntraciso
-               zxtoliq(ixt,i)=zxtcond(ixt,i)
-            enddo
-         endif ! if (rneb(i,k).gt.0.0)
-       enddo
-          
-#ifdef ISOVERIF
-!       write(*,*) 'ilp tmp 1626: k,zoliq,zxtoliq(1,363)=',k,zoliq(363),zxtoliq(1,363)
-       do i=1,klon   
-         do ixt=1,ntraciso
-           if (iso_verif_noNAN_nostop(zxtoliq(ixt,i), &
-     &           'il pleut 1628').eq.1) then
-             write(*,*) 'i,k,ixt=',i,k,ixt
-             write(*,*) 'rneb(i,k)=',rneb(i,k)
-             write(*,*) 'zxtcond(ixt,i)=',zxtcond(ixt,i)
-             stop
-           endif
-         enddo   ! ixt=1,niso
-        enddo  !do i=1,klon  
-#endif                
-#ifdef ISOVERIF
-       !i=519
-       !write(*,*) 'k,i,zoliq(i)=',k,i,zoliq(i)
-       do i=1,klon   
-           ! cam verif
-           if (iso_eau.gt.0) then
-            call iso_verif_egalite_choix(zxtoliq(iso_eau,i),zoliq(i), &
-     &            'il pleut 678',errmax,errmaxrel)
-           endif !if (iso_eau.gt.0) then
-           if (zoliq(i).gt.ridicule) then
-            if (iso_HDO.gt.0) then  
-                call iso_verif_aberrant(zxtoliq(iso_HDO,i)/zoliq(i), &
-     &           'il pleut 895a')
-              if (iso_O18.gt.0) then
-                if (iso_verif_O18_aberrant_nostop(zxtoliq(iso_HDO,i)/zoliq(i), &
-     &           zxtoliq(iso_O18,i)/zoliq(i),'il pleut 895b').eq.1) then
-                   write(*,*) 'i,k,zoliq,zfice=',i,k,zoliq(i),zfice(i)
-                   stop
-                endif
-              endif ! if (iso_HDO.gt.0) then
-            endif  !if (iso_HDO.gt.0) then
-           endif !if (zoliq(i).gt.ridicule) then
-          ! end cam verif
-         enddo ! do i=1,klon
-#endif
-#endif
-
-     !
-     DO n = 1, ninter
-        DO i = 1, klon
-           IF (rneb(i,k).GT.0.0) THEN
-              zrhol(i) = zrho(i) * zoliq(i) / zneb(i)
-              ! Initialization of zpluie and zice:
-              zpluie=0
-              zice=0
-              IF (zneb(i).EQ.seuil_neb) THEN
-                 ztot = 0.0
-              ELSE
-                 !  quantite d'eau a eliminer: zchau (Sundqvist, 1978)
-                 !  meme chose pour la glace: zfroi (Zender & Kiehl, 1997)
-                 if (ptconv(i,k)) then
-                    zcl   =cld_lc_con
-                    zct   =1./cld_tau_con
-                    zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i) &
-                         *fallvc(zrhol(i)) * zfice(i)
-                 else
-                    zcl   =cld_lc_lsc
-                    zct   =1./cld_tau_lsc
-                    zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i) &
-                         *fallvs(zrhol(i)) * zfice(i)
-                 endif
-
-                 ! si l'heterogeneite verticale est active, on utilise 
-                 ! la fraction volumique "vraie" plutot que la fraction
-                 ! surfacique modifiee, qui est plus grande et reduit
-                 ! sinon l'eau in-cloud de facon artificielle
-                 if ((iflag_cloudth_vert>=3).AND.(iflag_rain_incloud_vol==1)) then
-                    zchau    = zct   *dtime/REAL(ninter) * zoliq(i) &
-                         *(1.0-EXP(-(zoliq(i)/ctot_vol(i,k)/zcl   )**2)) *(1.-zfice(i))
-                 else
-                    zchau    = zct   *dtime/REAL(ninter) * zoliq(i) &
-                         *(1.0-EXP(-(zoliq(i)/zneb(i)/zcl   )**2)) *(1.-zfice(i))
-                 endif
-!AJ<
-                 IF (.NOT. ice_thermo) THEN
-                   ztot    = zchau + zfroi
-                 ELSE
-                   zpluie = MIN(MAX(zchau,0.0),zoliq(i)*(1.-zfice(i)))
-                   zice = MIN(MAX(zfroi,0.0),zoliq(i)*zfice(i)) 
-                   ztot    = zpluie    + zice
-                 ENDIF
-!>AJ
-                 ztot    = MAX(ztot   ,0.0)
-              ENDIF
-              ztot    = MIN(ztot,zoliq(i))
-!AJ<
-     !         zoliqp = MAX(zoliq(i)*(1.-zfice(i))-1.*zpluie   , 0.0)
-     !         zoliqi = MAX(zoliq(i)*zfice(i)-1.*zice   , 0.0)
-!JLD : les 2 variables zoliqp et zoliqi crorresponent a des pseudo precip
-!      temporaires et ne doivent pas etre calcule (alors qu'elles le sont
-!      si iflag_bergeron <> 2
-!      A SUPPRIMER A TERME
-              zoliqp(i) = MAX(zoliq(i)*(1.-zfice(i))-1.*zpluie  , 0.0)
-              zoliqi(i) = MAX(zoliq(i)*zfice(i)-1.*zice  , 0.0)
-              zoliq(i) = MAX(zoliq(i)-ztot   , 0.0)
-!>AJ
-              radliq(i,k) = radliq(i,k) + zoliq(i)/REAL(ninter+1)
-           ENDIF
-        ENDDO  ! i = 1,klon
-     ENDDO     ! n = 1,ninter
-
-     ! ----------------------------------------------------------------
-     !
-#ifdef ISO
-      do i=1,klon
-       IF (rneb(i,k).GT.0.0) THEN
-        if (zcond(i).gt.ridicule**2) then
-            ! le 21 dec: on change .gt.0 en .gt.ridicule**2 pour éviter valeur
-            ! ridiculement petites
-           do ixt=1,ntraciso
-             zxtoliq(ixt,i)=zoliq(i)*(zxtcond(ixt,i)/zcond(i))
-           enddo !do ixt=1,niso           
-        else !if (zcond(i).gt.0.0) then            
-           if (zoliq(i).lt.ridicule) then
-               do ixt=1,ntraciso
-                zxtoliq(ixt,i)=0.0
-               enddo
-           else !if (zoliq(i).lt.ridicule) then
-               ! modif 28 oct 2008
-              do ixt=1,niso
-                zxtoliq(ixt,i)=zoliq(i)*Rdefault(ixt)
-              enddo !do ixt=1,niso
-#ifdef ISOTRAC
-              do ixt=niso+1,ntraciso
-                if (index_zone(ixt).eq.izone_poubelle) then
-                    zxtoliq(ixt,i)=zoliq(i)*Rdefault(ixt)
-                else
-                    zxtoliq(ixt,i)=0.0
-                endif
-              enddo  
-#endif    
-#ifdef ISOVERIF                   
-              write(*,*) 'il pleut 1412: zcond(i)=',zcond(i)
-              write(*,*) 'zoliq(i)=',zoliq(i)
-              stop
-#endif                   
-            endif   !if (zoliq(i).lt.ridicule) then         
-        endif !if (zcond(i).gt.0.0) then
-       endif !IF (rneb(i,k).GT.0.0) THEN
-      enddo ! do i=1,klon 
-           
-         ! cam verif
-#ifdef ISOVERIF
-      do i=1,klon  
-        IF (rneb(i,k).GT.0.0) THEN 
-           do ixt=1,niso
-             call iso_verif_noNAN(zxtoliq(ixt,i),'il pleut 718')
-           ! end cam verif
-           enddo ! do ixt=1,niso
-          ! cam verif
-        endif !IF (rneb(i,k).GT.0.0) THEN 
-      enddo !do i=1,klon  
-#endif
-#ifdef ISOVERIF
-      do i=1,klon  
-        IF (rneb(i,k).GT.0.0) THEN
-          if (iso_eau.gt.0) then
-            call iso_verif_egalite_choix(zxtoliq(iso_eau,i),zoliq(i), &
-     &           'il pleut 749',errmax,errmaxrel)
-          endif !if (iso_eau.gt.0) then
-          if (iso_HDO.gt.0) then
-             if (zoliq(i).gt.ridicule) then
-                call iso_verif_aberrant(zxtoliq(iso_HDO,i)/zoliq(i), &
-     &           'il pleut 963')
-             endif
-          endif !if (iso_HDO.gt.0) then
-        ! end cam verif
-#ifdef ISOTRAC
-!             write(*,*) 'ilp 1201 tmp: i=',i
-!             write(*,*) 'zoliq(i)=',zoliq(i)
-!             write(*,*) 'zxtoliq(i)=',zxtoliq(iso_eau:ntraciso:3,i)
-!             write(*,*) 'zcond(i)=',zcond(i)
-!             write(*,*) 'zxtcond(i)=',zxtcond(iso_eau:ntraciso:3,i)
-             call iso_verif_traceur(zxtoliq(1,i),'il pleut 1634')
-#endif        
-         endif !IF (rneb(i,k).GT.0.0) THEN
-       enddo ! do i=1,klon
-#endif        
-#endif      
-     IF (.NOT. ice_thermo) THEN
-       DO i = 1, klon
-         IF (rneb(i,k).GT.0.0) THEN
-           d_ql(i,k) = zoliq(i)
-           zrfl(i) = zrfl(i)+ MAX(zcond(i)-zoliq(i),0.0) &
-                * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
-
-#ifdef ISO   
-         do ixt=1,ntraciso
-            d_xtl(ixt,i,k)=zxtoliq(ixt,i)
-         enddo ! do ixt=1,niso   
-            ! Rq: 28 oct 2008: si zoliq a la même compo que zcond, alors
-            ! on évite pb numériques si on prend directement zrfl avec
-            ! la compo de zcond?
-!          do ixt=1,niso  
-!            zxtrfl(ixt,i)=zxtrfl(ixt,i) &
-!     &           +max(zxtcond(ixt,i)-zxtoliq(ixt,i),0.0) &
-!     &           * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
-!          enddo  
-            if (zcond(i).gt.ridicule**2) then
-                ! modif le 19 dec 2012 pour éviter zcond pathologiquement petits
-                do ixt=1,ntraciso
-                  zxtrfl(ixt,i)=zxtrfl(ixt,i) &
-     &                  +(zxtcond(ixt,i)/zcond(i)) &
-     &                  * MAX(zcond(i)-zoliq(i),0.0) &
-     &                  * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
-                enddo !do ixt=1,niso
-            else !if (zcond(i).gt.0.0) then
-                if (zcond(i)-zoliq(i).gt.0.0) then
-                    do ixt=1,niso
-                        zxtrfl(ixt,i)=zxtrfl(ixt,i) &
-     &                  +Rdefault(ixt) &
-     &                  * MAX(zcond(i)-zoliq(i),0.0) &
-     &                  * (paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
-                    enddo !do ixt=1,niso  
-#ifdef ISOVERIF                   
-                    write(*,*) 'il pleut 1023: zcond(i)=',zcond(i)
-                    write(*,*) 'zcond(i),zoliq(i)=',zcond(i),zoliq(i)
-                    stop
-#endif        
-#ifdef ISOTRAC
-                   do ixt=niso+1,ntraciso
-                      if (index_zone(ixt).eq.izone_poubelle) then
-                        zxtrfl(ixt,i)=zxtrfl(ixt,i) &
-     &                  +Rdefault(ixt) &
-     &                  * MAX(zcond(i)-zoliq(i),0.0) &
-     &                  * (paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
-                      endif
-                    enddo !do ixt=1,niso
-#endif                 
-                else !if (zcond(i)-zoliq(i).gt.0.0) then
-                    ! zrfl non modifié
-                endif !if (zcond(i)-zoliq(i).gt.0.0) then
-            endif !if (zcond(i).gt.0.0) then
-
-         ! cam verif         
-!#ifdef ISOVERIF
-#ifdef ISOVERIF
-            do ixt=1,ntraciso
-             if ((iso_verif_noNAN_nostop(zxtrfl(ixt,i), &
-     &                   'il pleut 772').eq.1).or. &
-     &                   (iso_verif_noNAN_nostop(zxtoliq(ixt,i), &
-     &                   'il pleut 772b').eq.1)) then
-               write(*,*) 'zcond(i)=',zcond(i)
-               write(*,*) 'zxtcond(ixt,i)=',zxtcond(ixt,i)
-               write(*,*) 'zoliq(i)=',zoliq(i)
-               write(*,*) 'Rdefault(ixt)=',Rdefault(ixt)
-               write(*,*) 'paprs(i,k),paprs(i,k+1)=',paprs(i,k),paprs(i,k+1)
-               stop
-             endif
-            enddo
-#endif
-#ifdef ISOVERIF
-            if (iso_eau.gt.0) then
-              call iso_verif_egalite_choix(d_xtl(iso_eau,i,k), &
-     &           d_ql(i,k),'il pleut 771',errmax,errmaxrel)
-              if (iso_verif_egalite_choix_nostop( &
-     &           zxtrfl(iso_eau,i),zrfl(i), &
-     &           'il pleut 771b',errmax,errmaxrel).eq.1)then
-                 write(*,*) 'trace_cas(i)=',trace_cas(i)
-                 write(*,*) 'zxtcond(iso_eau,i)',zxtcond(iso_eau,i)
-                 write(*,*) 'zcond(i)',zcond(i)
-                 write(*,*) 'zxtoliq(iso_eau,i)',zxtoliq(iso_eau,i)
-                 write(*,*) 'zoliq(i)',zoliq(i)
-                 stop
-              endif
-            endif !if (iso_eau.gt.0) then
-            if (iso_HDO.gt.0) then
-                IF ((t(i,1)) .LT. RTT) THEN
-                call iso_verif_aberrant_choix(zxtrfl(iso_hdo,i), &
-     &           zrfl(i),ridicule_rain,deltalim_snow,'il pleut 1458')
-                endif
-            endif !if (iso_HDO.gt.0) then
-#ifdef ISOTRAC
-             call iso_verif_traceur(zxtrfl(1,i),'il pleut 1729')
-#endif            
-#endif
-         ! bidouille
-         if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then 
-               zxtrfl(iso_eau,i)= zrfl(i)   
-!             if (zxtrfl(iso_eau,i).gt.0.0) then
-!             do ixt=1,niso
-!               zxtrfl(ixt,i)=zxtrfl(ixt,i)*zrfl(i)/zxtrfl(iso_eau,i)
-!             enddo
-!           endif !if (zxtrfl(iso_eau,i).gt.0.0) then
-         endif ! if (bidouille_anti_divergence) then
-         ! end bidouille
-         ! end cam verif
-#endif
-         ENDIF !IF (rneb(i,k).GT.0.0) THEN
-       ENDDO
-     ELSE
-
-#ifdef ISO
-        CALL abort_physic('ilp 2347', 'isotopes pas encore prevus ici', 1)
-#endif
-!
-!CR&JYG<
-! On prend en compte l'effet Bergeron dans les flux de precipitation :
-! Si T < 0 C, alors les precipitations liquides sont converties en glace, ce qui
-! provoque un accroissement de temperature DeltaT. L'effet de DeltaT sur le condensat
-! et les precipitations est grossierement pris en compte en linearisant les equations 
-! et en approximant le processus de precipitation liquide par un processus a seuil.
-! On fait l'hypothese que le condensat nuageux n'est pas modifié dans cette opération.
-! Le condensat precipitant liquide est supprime (dans la limite DeltaT<273-T).
-! Le condensat precipitant solide est augmente.
-! La vapeur d'eau est augmentee.
-!
-       IF ((iflag_bergeron .EQ. 2)) THEN
-         DO i = 1, klon
-           IF (rneb(i,k) .GT. 0.0) THEN
-             zqpreci(i)=(zcond(i)-zoliq(i))*zfice(i)
-             zqprecl(i)=(zcond(i)-zoliq(i))*(1.-zfice(i))
-           if (fl_cor_ebil .GT. 0) then
-             zcp=RCPD*(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
-             coef1 = rneb(i,k)*RLSTT/zcp*zdqsdT_raw(i)
-!            Calcul de DT si toute les precips liquides congelent
-             DeltaT = RLMLT*zqprecl(i) / (zcp*(1.+coef1))
-!            On ne veut pas que T devienne superieur a la temp. de congelation.
-!            donc que Delta > RTT-zt(i
-             DeltaT = max( min( RTT-zt(i), DeltaT) , 0. )
-             zt(i)      = zt(i)      + DeltaT
-!            Eau vaporisee du fait de l'augmentation de T
-             Deltaq = rneb(i,k)*zdqsdT_raw(i)*DeltaT
-!            on reajoute cette eau vaporise a la vapeur et on l'enleve des precips
-             zq(i) = zq(i) +  Deltaq
-!            Les 3 max si dessous prtotegent uniquement des erreurs d'arrondies
-             zcond(i)   = max( zcond(i)- Deltaq, 0. )
-!            precip liquide qui congele ou qui s'evapore
-             Deltaqprecl = -zcp/RLMLT*(1.+coef1)*DeltaT
-             zqprecl(i) = max( zqprecl(i) + Deltaqprecl, 0. )
-!            bilan eau glacee
-             zqpreci(i) = max (zqpreci(i) - Deltaqprecl - Deltaq, 0.)
-           else ! if (fl_cor_ebil .GT. 0)
-!            ancien calcul
-             zcp=RCPD*(1.0+RVTMP2*(zq(i)+zcond(i)))
-             coef1 = RLMLT*zdqs(i)/RLVTT
-             DeltaT = max( min( RTT-zt(i), RLMLT*zqprecl(i)/zcp/(1.+coef1) ) , 0.)
-             zqpreci(i) = zqpreci(i) + zcp/RLMLT*DeltaT
-             zqprecl(i) = max( zqprecl(i) - zcp/RLMLT*(1.+coef1)*DeltaT, 0. )
-             zcond(i)   = max( zcond(i)   - zcp/RLVTT*zdqs(i)*DeltaT, 0. )
-             zq(i)      = zq(i)      + zcp/RLVTT*zdqs(i)*DeltaT
-             zt(i)      = zt(i)      + DeltaT
-           end if ! if (fl_cor_ebil .GT. 0)
-           ENDIF  ! rneb(i,k) .GT. 0.0
-         ENDDO
-         DO i = 1, klon
-           IF (rneb(i,k).GT.0.0) THEN
-             d_ql(i,k) = (1-zfice(i))*zoliq(i)
-             d_qi(i,k) = zfice(i)*zoliq(i)
-             zrfl(i) = zrfl(i)+ zqprecl(i) &
-                 *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
-             zifl(i) = zifl(i)+ zqpreci(i) &
-                      *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)  
-           ENDIF                      
-         ENDDO
-!!
-       ELSE  ! iflag_bergeron
-!>CR&JYG
-!!
-       DO i = 1, klon
-         IF (rneb(i,k).GT.0.0) THEN
-!CR on prend en compte la phase glace
-!JLD inutile car on ne passe jamais ici si .not.ice_thermo
-!           if (.not.ice_thermo) then
-!           d_ql(i,k) = zoliq(i)
-!           d_qi(i,k) = 0.
-!           else
-           d_ql(i,k) = (1-zfice(i))*zoliq(i)
-           d_qi(i,k) = zfice(i)*zoliq(i)
-!           endif
-!AJ<
-           zrfl(i) = zrfl(i)+ MAX(zcond(i)*(1.-zfice(i))-zoliqp(i),0.0) &
-               *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
-           zifl(i) = zifl(i)+ MAX(zcond(i)*zfice(i)-zoliqi(i),0.0) &
-                    *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)  
-     !      zrfl(i) = zrfl(i)+  zpluie                         &
-     !          *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
-     !      zifl(i) = zifl(i)+  zice                    &
-     !               *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)                                    
-
-!CR : on prend en compte l'effet Bergeron dans les flux de precipitation
-           IF ((iflag_bergeron .EQ. 1) .AND. (zt(i) .LT. 273.15)) THEN
-              zsolid = zrfl(i)
-              zifl(i) = zifl(i)+zrfl(i)
-              zrfl(i) = 0.
-           if (fl_cor_ebil .GT. 0) then
-              zt(i)=zt(i)+zsolid*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
-                      *(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
-           else
-              zt(i)=zt(i)+zsolid*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
-                      *(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*zq(i))
-           end if
-           ENDIF  ! (iflag_bergeron .EQ. 1) .AND. (zt(i) .LT. 273.15)
-!RC   
-
-         ENDIF ! rneb(i,k).GT.0.0
-       ENDDO
-
-       ENDIF  ! iflag_bergeron .EQ. 2
-     ENDIF  ! .NOT. ice_thermo
-
-!CR: la fonte est faite au debut
-!      IF (ice_thermo) THEN
-!       DO i = 1, klon
-!           zmelt = ((zt(i)-273.15)/(ztfondue-273.15))**2
-!           zmelt = MIN(MAX(zmelt,0.),1.)
-!           zrfl(i)=zrfl(i)+zmelt*zifl(i)
-!           zifl(i)=zifl(i)*(1.-zmelt)
-!           print*,zt(i),'octavio1'
-!           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
-!                      *RLMLT/RCPD/(1.0+RVTMP2*zq(i))
-!           print*,zt(i),zrfl(i),zifl(i),zmelt,'octavio2'
-!       ENDDO
-!     ENDIF
-
-       
-     IF (.NOT. ice_thermo) THEN
-       DO i = 1, klon
-         IF (zt(i).LT.RTT) THEN
-           psfl(i,k)=zrfl(i)
-#ifdef ISO
-         do ixt=1,ntraciso
-           pxtsnowfl(ixt,i,k)=zxtrfl(ixt,i)
-         enddo
-#endif
-         ELSE
-           prfl(i,k)=zrfl(i)
-#ifdef ISO
-         do ixt=1,ntraciso
-           pxtrainfl(ixt,i,k)=zxtrfl(ixt,i)
-         enddo         
-#endif
-         ENDIF
-       ENDDO
-     ELSE ! if ice_thermo
-     ! JAM*************************************************
-     ! Revoir partie ci-dessous: a quoi servent psfl et prfl?
-     ! *****************************************************
-
-#ifdef ISO
-     CALL abort_physic('ilp 2465', 'isos pas prevus ici', 1)   
-#endif
-       DO i = 1, klon
-     !   IF (zt(i).LT.RTT) THEN
-           psfl(i,k)=zifl(i) 
-     !   ELSE
-           prfl(i,k)=zrfl(i)
-     !   ENDIF
-!>AJ
-       ENDDO
-     ENDIF
-
-#ifdef ISO
-#ifdef ISOVERIF
-      DO i = 1, klon
-        if (iso_eau.gt.0) then
-          call iso_verif_egalite_choix(pxtrainfl(iso_eau,i,k),prfl(i,k), & 
-     &           'il pleut 804',errmax,errmaxrel)
-          call iso_verif_egalite_choix(pxtsnowfl(iso_eau,i,k),psfl(i,k), &  
-     &           'il pleut 805',errmax,errmaxrel) 
-          call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &  
-     &           'il pleut 1612',errmax,errmaxrel) 
-          if (iso_verif_positif_choix_nostop(pxtrainfl(iso_eau,i,k), &
-     &           ridicule_rain,'ilp 1547').eq.1) then
-            write(*,*) 'prfl(i,k)=',prfl(i,k)
-            stop
-          endif  
-        endif !if (iso_eau.gt.0) then
-        if (iso_HDO.gt.0) then
-          if (prfl(i,k).gt.ridicule_rain) then
-            call iso_verif_aberrant(pxtrainfl(iso_HDO,i,k)/prfl(i,k), &
-     &            'il pleut 1020')
-          endif !if (prfl(i,k).gt.ridicule_rain) then        
-          if (psfl(i,k).gt.ridicule_rain) then
-            call iso_verif_aberrant(pxtsnowfl(iso_HDO,i,k)/psfl(i,k), &
-     &           'il pleut 1024')
-          endif !if (psfl(i,k).gt.ridicule_rain) then
-          if (zq(i).gt.ridicule) then
-              call iso_verif_aberrant_encadre(zxt(iso_HDO,i)/zq(i), &
-     &           'il pleut 1204')
-          endif !if (zq(i).gt.ridicule) then          
-         endif !if (iso_HDO.gt.0) then
-#ifdef ISOTRAC
-          call iso_verif_traceur(zxt(1,i),'il pleut 1792')
-          call iso_verif_traceur(pxtsnowfl(1,i,k),'il pleut 1793')
-          call iso_verif_traceur(pxtrainfl(1,i,k),'il pleut 1794')
-#endif         
-       ENDDO !DO i = 1, klon  
-#endif
-#endif 
-     ! ----------------------------------------------------------------
-     ! Fin de formation des precipitations
-     ! ----------------------------------------------------------------
-     !
-     ! Calculer les tendances de q et de t:
-     !
-     DO i = 1, klon
-        d_q(i,k) = zq(i) - q(i,k)
-#ifdef ISO
-         do ixt=1,ntraciso
-             d_xt(ixt,i,k)=zxt(ixt,i)-xt(ixt,i,k)   
-         enddo
-         ! cam verif
-#ifdef ISOVERIF
-           if (iso_eau.gt.0) then
-             if (iso_verif_egalite_choix_nostop(d_xt(iso_eau,i,k), &
-     &            d_q(i,k),'il pleut 838',errmax,errmaxrel).eq.1) then
-                write(*,*) 'i,k=',i,k
-                write(*,*) 'zxt,zq=',zxt(iso_eau,i),zq(i)
-                write(*,*) 'xt,q=',xt(iso_eau,i,k),q(i,k)
-                stop
-             endif
-           endif !if (iso_eau.gt.0) then
-           if (1.eq.0) then
-           if (iso_HDO.gt.0) then
-            if (abs(d_q(i,k)).gt.max(errmaxrel*q(i,k),errmax)) then
-              if (iso_verif_aberrant_nostop( &
-     &           d_xt(iso_HDO,i,k)/d_q(i,k),'il pleut 1229').eq.1) then
-!                write(*,*) 'd_q(i,k)=',d_q(i,k)
-!                write(*,*) 'q(i,k)=',q(i,k)
-!                write(*,*) 'zq(i)=',zq(i)
-!                write(*,*) 'deltaD_prec=',deltaD(xt(iso_HDO,i,k)/q(i,k))
-!                write(*,*) 'deltaD=',deltaD(zxt(iso_HDO,i)/zq(i))
-!                stop       
-              endif !   if (iso_verif_aberrant_nostop(
-            endif !if (zq(i).gt.ridicule) then          
-           endif !if (iso_HDO.gt.0) then
-          endif !if (1.eq.0) then
-#endif
-         ! end cam verif
-#endif
-        d_t(i,k) = zt(i) - t(i,k)
-     ENDDO
-     !
-     !AA--------------- Calcul du lessivage stratiforme  -------------
-
-     DO i = 1,klon
-        !
-        if(zcond(i).gt.zoliq(i)+1.e-10) then
-         beta(i,k) = (zcond(i)-zoliq(i))/zcond(i)/dtime
-        else
-         beta(i,k) = 0.
-        endif
-        zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0) &
-             * (paprs(i,k)-paprs(i,k+1))/RG
-        IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
-           !AA lessivage nucleation LMD5 dans la couche elle-meme
-          IF (iflag_t_glace.EQ.0) THEN
-           if (t(i,k) .GE. t_glace_min_old) THEN
-              zalpha_tr = a_tr_sca(3)
-           else
-              zalpha_tr = a_tr_sca(4)
-           endif
-          ELSE ! of IF (iflag_t_glace.EQ.0)
-           if (t(i,k) .GE. t_glace_min) THEN
-              zalpha_tr = a_tr_sca(3)
-           else
-              zalpha_tr = a_tr_sca(4)
-           endif
-          ENDIF
-           zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
-           pfrac_nucl(i,k)=pfrac_nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
-           frac_nucl(i,k)= 1.-zneb(i)*zfrac_lessi 
-           !
-           ! nucleation avec un facteur -1 au lieu de -0.5
-           zfrac_lessi = 1. - EXP(-zprec_cond(i)/zneb(i))
-           pfrac_1nucl(i,k)=pfrac_1nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
-        ENDIF
-        !
-     ENDDO      ! boucle sur i
-     !
-     !AA Lessivage par impaction dans les couches en-dessous
-     DO kk = k-1, 1, -1
-        DO i = 1, klon
-           IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
-             IF (iflag_t_glace.EQ.0) THEN
-              if (t(i,kk) .GE. t_glace_min_old) THEN
-                 zalpha_tr = a_tr_sca(1)
-              else
-                 zalpha_tr = a_tr_sca(2)
-              endif
-             ELSE ! of IF (iflag_t_glace.EQ.0)
-              if (t(i,kk) .GE. t_glace_min) THEN
-                 zalpha_tr = a_tr_sca(1)
-              else
-                 zalpha_tr = a_tr_sca(2)
-              endif
-             ENDIF
-              zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
-              pfrac_impa(i,kk)=pfrac_impa(i,kk)*(1.-zneb(i)*zfrac_lessi)
-              frac_impa(i,kk)= 1.-zneb(i)*zfrac_lessi
-           ENDIF
-        ENDDO
-     ENDDO !DO kk = k-1, 1, -1
-
-#ifdef ISO      
-      ! verif en fin de boucle
-#ifdef ISOVERIF
-      if (iso_eau.gt.0) then
-        do i=1,klon       
-        call iso_verif_egalite_choix(zxtrfl(iso_eau,i) &
-     &      ,zrfl(i), 'il pleut 1089',errmax,errmaxrel)
-        call iso_verif_egalite_choix(d_xtl(iso_eau,i,k),d_ql(i,k), &
-     &           'il pleut 1205',errmax,errmaxrel) 
-#ifdef ISOTRAC
-        call iso_verif_traceur(zxtrfl(1,i),'il pleut 1894')
-        call iso_verif_traceur(d_xtl(1,i,k),'il pleut 1895')
-#endif        
-        enddo !do i=1,klon
-      endif !  if (iso_eau.gt.0) then        
-#endif
-#endif      
-      ! end verif en fin de boucle
-
-     !
-     !AA===============================================================
-     !                     FIN DE LA BOUCLE VERTICALE  
-  end DO
-  !
-  !AA==================================================================
-  !
-  ! Pluie ou neige au sol selon la temperature de la 1ere couche
-  !
-!CR: si la thermo de la glace est active, on calcule zifl directement
-  IF (.NOT.ice_thermo) THEN
-  DO i = 1, klon
-     IF ((t(i,1)+d_t(i,1)) .LT. RTT) THEN
-!AJ<
-!        snow(i) = zrfl(i)
-        snow(i) = zrfl(i)+zifl(i)
-!>AJ
-        zlh_solid(i) = RLSTT-RLVTT
-#ifdef ISO
-        do ixt=1,ntraciso
-          xtsnow(ixt,i) = zxtrfl(ixt,i)
-        enddo !do ixt=1,ntraciso
-#endif
-     ELSE
-        rain(i) = zrfl(i)
-        zlh_solid(i) = 0.
-#ifdef ISO
-        do ixt=1,ntraciso
-          xtrain(ixt,i) = zxtrfl(ixt,i)
-        enddo !do ixt=1,ntraciso
-#endif
-     ENDIF
-#ifdef ISO
-      ! cam verif 
-#ifdef ISOVERIF
-       do ixt=1,ntraciso
-        call iso_verif_noNAN(xtrain(ixt,i),'il pleut 927')
-        call iso_verif_noNAN(xtsnow(ixt,i),'il pleut 927')
-       enddo ! do ixt=1,niso
-#endif         
-#ifdef ISOVERIF
-       if (iso_eau.gt.0) then
-        call iso_verif_egalite_choix(xtrain(iso_eau,i),rain(i), &
-     &           'il pleut 926a',errmax,errmaxrel)  
-        if (snow(i)*dtime.gt.ridicule) then
-           call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
-     &            'il pleut 938a',errmax,errmaxrel)
-        endif !if (snow(i)*dtime.gt.ridicule) then
-       endif !if (iso_eau.gt.0) then
-       if (iso_HDO.gt.0) then
-           call iso_verif_aberrant_choix(xtrain(iso_hdo,i),rain(i), &
-     &           ridicule_rain,deltalim,'il pleut 926b')  
-           call iso_verif_aberrant_choix(xtsnow(iso_hdo,i),snow(i), &
-     &            ridicule_rain,deltalim_snow,'il pleut 938b')
-       endif !if (iso_eau.gt.0) then
-#ifdef ISOTRAC
-       call iso_verif_traceur(xtrain(1,i),'il pleut 1952')
-       call iso_verif_traceur(xtsnow(1,i),'il pleut 1953')
-#endif       
-#endif
-       ! end cam verif   
-#endif
-  ENDDO
-
-  ELSE
-#ifdef ISO
-        CALL abort_physic('ilp 2708', 'isos pas prevus ici', 1)
-#endif
-     DO i = 1, klon
-        snow(i) = zifl(i)
-        rain(i) = zrfl(i)
-     ENDDO
-   
-   ENDIF
-  !
-  ! For energy conservation : when snow is present, the solification
-  ! latent heat is considered.
-!CR: si thermo de la glace, neige deja prise en compte
-  IF (.not.ice_thermo) THEN
-  DO k = 1, klev
-     DO i = 1, klon
-        zcpair=RCPD*(1.0+RVTMP2*(q(i,k)+d_q(i,k)))
-        zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
-        zm_solid = (prfl(i,k)-prfl(i,k+1)+psfl(i,k)-psfl(i,k+1))*dtime
-        d_t(i,k) = d_t(i,k) + zlh_solid(i) *zm_solid / (zcpair*zmair(i))
-     END DO
-  END DO
-  ENDIF
-  !
-
-  if (ncoreczq>0) then
-     WRITE(lunout,*)'WARNING : ZQ dans fisrtilp ',ncoreczq,' val < 1.e-15.'
-  endif
-
-
-#ifdef ISO
-      ! verif en sortie de il pleut 
-#ifdef ISOVERIF
-       do k=1,klev
-        do i=1,klon
-         if (iso_eau.gt.0) then
-           call iso_verif_egalite_choix(d_xtl(iso_eau,i,k),d_ql(i,k), &
-     &            'il pleut 1289',errmax,errmaxrel)
-         endif !if (iso_eau.gt.0) then
-#ifdef ISOTRAC
-         call iso_verif_traceur(d_xtl(1,i,k),'il pleut 1982')
-#endif
-        enddo !do i=1,klon
-       enddo !do k=1,klev
-#endif
-      ! end verif
-#endif
-
-END SUBROUTINE fisrtilp
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/fisrtilp.h
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/fisrtilp.h	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/fisrtilp.h
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/ini_csts.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/ini_csts.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/ini_csts.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/ini_csts.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotopes_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotopes_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotopes_mod.F90	(revision 4727)
@@ -302,5 +302,10 @@
    IF(getKey('Rdefault',Rdefault,isoName)) CALL abort_physic(modname, 'can''t get Rdefault',1)
    IF(getKey('Rmethox', Rmethox, isoName)) CALL abort_physic(modname, 'can''t get Rmethox', 1)
-   IF(.NOT.Rdefault_smow) Rdefault(:) = 0.0
+
+   IF(.NOT.Rdefault_smow) then
+        Rdefault(:) = 0.0
+        if (iso_eau.gt.0) Rdefault(iso_eau) = 1.0 ! correction Camille 30 mars 2023
+   ENDIF
+   write(*,*) 'Rdefault=',Rdefault
 
    !--- Sensitivity test: no kinetic effect in sfc evaporation
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotopes_routines_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotopes_routines_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotopes_routines_mod.F90	(revision 4727)
@@ -154,4 +154,8 @@
 &                   'revap_ilp 131')
        enddo
+#ifdef ISOTRAC
+     call iso_verif_traceur(zxtrfl_ancien(1,i), &
+&           'iso_revap_fisrtilp 158: debut')
+#endif
 #endif
     endif !if (zrfln(i).gt.ridicule*1e-2) then  
@@ -193,4 +197,8 @@
         endif !if (zq(i).gt.ridicule) then
      endif !if ((iso_HDO.gt.0.and.(iso_O18.gt.0) then
+#ifdef ISOTRAC
+     call iso_verif_traceur(zxtrfl_ancien(1,i), &
+&           'iso_revap_fisrtilp 201: debut quand pas de precip')
+#endif
 !     write(*,*) 'iso_routines tmp 184'
 #endif               
@@ -504,5 +512,5 @@
 !             stop
   endif
-  enddo
+  enddo !do iiso=1,niso
 enddo !do i=1,ncas_evap_liq
 #endif          
@@ -514,6 +522,8 @@
 &       izone,zqevfl(1),Exi(1,1),fac_fluxtomixratio(1), &
 &       xtrevap_tag(1,1),1,hdiag(1))
+        ! dans cette routine, zxtrfl reçoit zxtrfln_cas
 
   enddo !do izone=1,ntraceurs_zone
+
 #ifdef ISOVERIF
 do i=1,ncas_evap_liq
@@ -522,4 +532,6 @@
 &              0.0,'revap_ilp 414')
 enddo
+     call iso_verif_traceur(zxtrfl(1,cas_evap_liq(i)), &
+&           'iso_revap_fisrtilp 470a: apres stewart_explicite_vectall')
 enddo !do i=1,ncas
 #endif            
@@ -536,6 +548,8 @@
      call iso_verif_traceur(zxt(1,cas_evap_liq(i)), &
 &           'iso_revap_fisrtilp 282')
+     call iso_verif_traceur(zxtrfl(1,cas_evap_liq(i)), &
+&           'iso_revap_fisrtilp 804a')
      call iso_verif_traceur(zxtrfln(1,cas_evap_liq(i)), &
-&           'iso_revap_fisrtilp 804')
+&           'iso_revap_fisrtilp 804b')
      do ixt=1,ntraciso
         call iso_verif_positif_choix(zxt(ixt,cas_evap_liq(i)), &
@@ -676,9 +690,6 @@
    if (iso_HDO.gt.0) then
       do i=1,ncas_evap_glace
-         if (zrfln_cas(i).gt.ridicule_rain) then
-                call iso_verif_aberrant( &
-&                  (zxtrfln_cas(iso_HDO,i) &
-&                 /zrfln_cas(i)), 'iso_revap_fisrtilp 4563')
-         endif
+                call iso_verif_aberrant_choix(zxtrfln_cas(iso_HDO,i), zrfln_cas(i), &
+                  ridicule_rain,deltalim_snow, 'iso_revap_fisrtilp 4563')
        enddo !do i=1,ncas_evap_glace
    endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
@@ -789,6 +800,8 @@
      call iso_verif_traceur(zxt(1,cas_evap_glace(i)), &
 &           'iso_revap_fisrtilp 1033')
+     call iso_verif_traceur(zxtrfl(1,cas_evap_glace(i)), &
+&           'iso_revap_fisrtilp 1035a')
      call iso_verif_traceur(zxtrfln(1,cas_evap_glace(i)), &
-&           'iso_revap_fisrtilp 1035')
+&           'iso_revap_fisrtilp 1035b')
   enddo
 #endif          
@@ -830,5 +843,7 @@
     call iso_verif_traceur(zxt(1,i),'iso_revap_fisrtilp 532')
     call iso_verif_traceur(zxtrfln(1,i), &
-&           'iso_revap_fisrtilp 533') 
+&           'iso_revap_fisrtilp 533a') 
+    call iso_verif_traceur(zxtrfl(1,i), &
+&           'iso_revap_fisrtilp 533b')
     do ixt=1,ntraciso
         call iso_verif_positif_choix(zxt(ixt,i),0.0, &
@@ -836,5 +851,5 @@
     enddo
 enddo !do i=1,klon
-        write(*,*) 'revap_ilp 814: sortie'
+        !write(*,*) 'revap_ilp 814: sortie'
 #endif       
 #endif          
@@ -2384,12 +2399,12 @@
     endif !if (iso_eau.gt.0) then
     if (abs(evap(i)).gt.ridicule_rain) then
-      if (iso_HDO.gt.0) then                  
-         if (iso_verif_aberrant_nostop(xtevap(iso_HDO,i)/evap(i), &
-&           'iso_surf>iso_rosee_givre 3193').eq.1) then    
+      if (iso_HDO.gt.0) then                      
+         if (iso_verif_aberrant_choix_nostop(xtevap(iso_HDO,i),evap(i), &
+&           ridicule_rain,deltalim_snow,'iso_surf>iso_rosee_givre 3193').eq.1) then    
                 write(*,*) 'zxtalphai(iso_HDO)=',zxtalphai(iso_HDO)
                 write(*,*) 'deltaD1eff=',deltaD(xt1lay(iso_HDO,i)/q1lay(i))
                 write(*,*) 'tsurf(i)=',tsurf(i)
                 write(*,*) 'q1lay(i)=',q1lay(i)   
-                stop  
+                !stop  
            endif !if (iso_verif_aberrant_nostop
       endif  !if (iso_HDO.gt.0) then  
@@ -2534,5 +2549,5 @@
 
 ! quelques verifs de bilan d'eau
-#ifdef ISOVERIF      
+#ifdef ISOVERIF   
 do il=1,ncas
   do ixt=1,niso
@@ -2647,7 +2662,5 @@
 &             'stewart_explicite_vectall 220')
     enddo
-#endif
-#ifdef ISOVERIF
-      if (iso_eau.gt.0) then
+    if (iso_eau.gt.0) then
         call iso_verif_egalite_choix( &
 &              (Exi(iso_eau,il)*fac_ftmr(il)), &
@@ -2669,9 +2682,5 @@
 &                   *fac_ftmr(il))),'stewart_explicite 214')
        endif !if ((iso_HDO.gt.0).and.
-       if ((debug.eq.1).and.(il.eq.il_debug)) then
-           write(*,*) 'stewart_explicit 224: cas Pqisup<=0'
-           write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
-&                   deltaD((Exi(iso_HDO,il)/Eqi(il)))
-       endif
+
 #endif              
 else !if (Pqisup.eq.0) then
@@ -2679,5 +2688,5 @@
 h(il)=qeff(il)/qs(il)       
 h(il)= MAX(MIN(h(il),1.0),0.0)
-#ifdef ISOVERIF        
+#ifdef ISOVERIF
 call iso_verif_positif(h(il)-thumxt1,'stewart_explicit 209') 
 #endif        
@@ -2739,5 +2748,5 @@
       endif !if ((iso_HDO.gt.0).and.
     endif !if (iso_HDO.gt.0) then
-    if ((debug.eq.1).and.(il.eq.il_debug)) then
+    if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
            write(*,*) 'stewart_explicit 302: cas evap~0'
            write(*,*) 'deltaDv est inchangé:',deltaD( &
@@ -2779,5 +2788,5 @@
 f(il)=m(il)/m0(il)    
 ! verifs
-#ifdef ISOVERIF        
+#ifdef ISOVERIF       
 call iso_verif_positif((m(il)), &
 &           'stewart_explicite 173')
@@ -2836,9 +2845,7 @@
     ! rajout verif 4 sept 2009
     if (iso_HDO.gt.0) then
-     if (Pqisup(il).gt.ridicule) then
-        call iso_verif_aberrant((Rl0(iso_HDO,il)), &
-&                   'stewart_explicite 368')
-     endif
-    endif
+        call iso_verif_aberrant_choix(Rl0(iso_HDO,il)*Pqisup(il),Pqisup(il), &
+&                   ridicule_rain,deltalim_snow,'stewart_explicite 368')
+    endif !if (iso_HDO.gt.0) then
   endif !(iso_eau.gt.0)
 #endif
@@ -2868,6 +2875,4 @@
 &                   'stewart_explicite 271')
    enddo !do ixt=1,niso   
-#endif
-#ifdef ISOVERIF  
    if (iso_eau.gt.0) then
       call iso_verif_egalite_choix( &
@@ -2923,5 +2928,5 @@
        endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
      endif !if (iso_HDO.gt.0)
-     if ((debug.eq.1).and.(il.eq.il_debug)) then
+     if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
          write(*,*) 'stewart_explicit 442: tout se réévapore'
          write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
@@ -2943,7 +2948,4 @@
 if ((h(il).gt.0.99).or. &
 &           (h(il).gt.0.98).and.(f(il).lt.1e-3)) then
-#ifdef ISOVERIF          
-!            write(*,*) 'stewart_explicit 191: cas h=1: il=',il
-#endif            
     do ixt=1,niso
     interm(ixt,il)=alphap(ixt,il)*(1.0-h(il)) &
@@ -2981,6 +2983,4 @@
 &           'stewart_explicite 261')
     enddo !do ixt=1,niso
-#endif           
-#ifdef ISOVERIF
     if (iso_eau.gt.0) then
         call iso_verif_egalite_choix( &
@@ -3007,8 +3007,6 @@
       
      if (iso_HDO.gt.0) then 
-       if (Pqiinf(il).gt.ridicule_rain) then
-           if (iso_verif_aberrant_nostop( &
-&                  (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
-&                   'stewart_explicie 248').eq.1) then
+       if (iso_verif_aberrant_choix_nostop(Pxtiinf(iso_HDO,il),Pqiinf(il), &
+&                ridicule_rain,deltalim_snow,'stewart_explicite 248').eq.1) then
              write(*,*) 'cas reeq totale, il=',il
              write(*,*) 'deltaDl0=',deltaD( &
@@ -3019,6 +3017,5 @@
 &                   (Rb(iso_hdo,il)))
              stop
-           endif 
-       endif  !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
+       endif !if (iso_verif_aberrant_choix_nostop
        if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
          call iso_verif_aberrant(( &
@@ -3027,5 +3024,5 @@
        endif !if ((iso_HDO.gt.0).and.
      endif  !if (iso_HDO.gt.0) then
-    if ((debug.eq.1).and.(il.eq.il_debug)) then
+     if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
          write(*,*) 'stewart_explicit 526: cas h~1: rééq'
          write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
@@ -3034,10 +3031,10 @@
 &                   (Rb0(iso_hdo,il))),deltaD( &
 &                   (Rl0(iso_hdo,il)))
-    endif 
+     endif !if ((debug.eq.1).and.(il.eq.il_debug)) then
 #endif
     ! end verifs
 
 else if ((f(il).gt.0.998).and. &
-&           (Eqi(il)*fac_ftmr(il).lt.1e-2*qp0(il))) then
+&           (Eqi(il)*fac_ftmr(il).lt.1e-2*qp0(il))) then ! if ((h(il).gt.0.99).or. 
 
 !*** cas particulier pour éviter imprécisions numériques:
@@ -3083,6 +3080,4 @@
 &           'stewart_explicite 397')
    enddo !do ixt=1,niso 
-#endif
-#ifdef ISOVERIF
    if (iso_eau.gt.0) then
         call iso_verif_egalite_choix( &
@@ -3167,7 +3162,7 @@
            stop
          endif !if (iso_verif_aberrant_nostop((
-       endif !if ((iso_HDO.gt.0).and.
+       endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
      endif !!if ((iso_HDO.gt.0)
-     if ((debug.eq.1).and.(il.eq.il_debug)) then
+     if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
          write(*,*) 'stewart_explicit 663: cas où réévap faible'
          write(*,*) 'ordre 1 pour la vapeur et le liquide'
@@ -3271,5 +3266,5 @@
              endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
           endif !if ((iso_HDO.gt.0)
-     if ((debug.eq.1).and.(il.eq.il_debug)) then
+     if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
          write(*,*) 'stewart_explicit 767: cas de réévap sèche'
          write(*,*) 'distill de Rayleigh'
@@ -3317,6 +3312,4 @@
 &                   'stewart_explicite 467')
     enddo !do ixt=1,niso    
-#endif          
-#ifdef ISOVERIF  
           if (iso_eau.gt.0) then
             call iso_verif_egalite_choix( &
@@ -3360,5 +3353,5 @@
             endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
           endif !if (iso_HDO.gt.0)
-      if ((debug.eq.1).and.(il.eq.il_debug)) then
+      if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
          write(*,*) 'stewart_explicit 831: flux de masse vap~0'
          write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
@@ -3429,5 +3422,5 @@
         enddo !do ixt=1,niso    
 #endif
-#ifdef ISOVERIF   
+#ifdef ISOVERIF
           if (iso_eau.gt.0) then
             call iso_verif_egalite_choix( &
@@ -3546,5 +3539,5 @@
         enddo !do ixt=1,niso 
 #endif
-#ifdef ISOVERIF      
+#ifdef ISOVERIF   
           if (iso_eau.gt.0) then
             call iso_verif_egalite_choix( &
@@ -3750,6 +3743,5 @@
        ! pour meilleure convergence numérique:
        !xtnew=qp0+Eqi*fac_ftmr
-   endif   ! if (iso_eau.gt.0).and.(ixt.eq.iso_eau)    
-
+   endif   ! if (iso_eau.gt.0).and.(ixt.eq.iso_eau)  
    if (iso_HDO.gt.0) then
      if (Pqiinf(il).gt.ridicule_rain) then
@@ -3778,13 +3770,13 @@
 &                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
 &                   *fac_ftmr(il))),'stewart_explicite 912')
-        endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
-      endif !if (iso_HDO.gt.0)
-      if ((debug.eq.1).and.(il.eq.il_debug)) then
+       endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
+       if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
          write(*,*) 'stewart_explicit 991: fcas général'
          write(*,*) 'mais avec formule simplifiée'
-         write(*,*) 'il,Eqi(il),deltaD=',il,Eqi(il), &
-&                   deltaD((Exi(iso_HDO,il)/Eqi(il)))
-      endif
-#endif     
+         write(*,*) 'il,Eqi(il)=',il,Eqi(il)
+         write(*,*) 'deltaD=',deltaD((Exi(iso_HDO,il)/Eqi(il)))
+       endif
+      endif !if (iso_HDO.gt.0)  
+#endif
   ! end verifs  
     
@@ -3838,5 +3830,5 @@
 ! compression
 if (ncas_Jsimple+ncas_rieman.gt.0) then
-!#ifdef ISOVERIF          
+!#ifdef ISOVERIF         
 !        write(*,*) 'stewart_explicite_vectall 873:compression_calculJ' 
 !#endif        
@@ -3927,33 +3919,7 @@
     ! ******* traitement vectoriel du cas Rieman (=2533)
 if (ncas_rieman.gt.0) then
-!#ifdef ISOVERIF
-!!          write(*,*) 'traitement vectoriel rieman: x',ncas_rieman
-!          do icas_rieman=1+ncas_Jsimple,ncas_rieman+ncas_Jsimple
-!!            write(*,*) 'ntot_cas(icas_rieman)=',ntot_cas(icas_rieman)
-!          call iso_verif_positif(float(ntot_cas(icas_rieman))-1.0,
-!     :           'stewart_expl 984: ntot faux') 
-!          enddo   !do icas_rieman=1,ncas_rieman       
-!#endif            
+            
    icas_rieman=1+ncas_Jsimple
-!           write(*,*) 'stewart_expl 988 tmp: icas_rieman=',icas_rieman
-!           write(*,*) 'qp0_cas(1)=',qp0_cas(1)
-!           write(*,*) 'A_cas(1)=',A_cas(1)
-!           write(*,*) 'm0_cas(1)=',m0_cas(1)
-!           write(*,*) 'm_cas(1)=',m_cas(1)
-!           if (iso_eau.gt.0) then
-!           write(*,*) 'beta_cas(iso_eau,1)=',beta_cas(iso_eau,1)
-!           write(*,*) 'gama_cas(iso_eau,1)=',gama_cas(iso_eau,1)
-!           endif
-!           write(*,*) 'f_cas(1)=',f_cas(1)
-!           write(*,*) 'g_cas(1)=',g_cas(1)
-!#ifdef rieman           
-!           call integrale_rieman_vectall
-!     :       (ncas_rieman,m_cas(icas_rieman),
-!     :       J(1,icas_rieman),e(1,icas_rieman),
-!     :       qp0_cas(icas_rieman),A_cas(icas_rieman),
-!     :       m0_cas(icas_rieman),beta_cas(1,icas_rieman),
-!     :       gama_cas(1,icas_rieman),f_cas(icas_rieman),
-!     :       g_cas(icas_rieman),ntot_cas(icas_rieman))
-!#else
+
    call integrale_gauss_vectall &
 &       (ncas_rieman,m_cas(icas_rieman), &
@@ -3964,22 +3930,4 @@
 !     :       g_cas(icas_rieman),ntot_cas(icas_rieman))
 &       g_cas(icas_rieman))      
-!#endif
-!#ifdef ISOVERIF
-!           do il=1+ncas_Jsimple,ncas_rieman+ncas_Jsimple
-!             do ixt=1,niso
-!               call integrale_Rieman_precision(m_cas(il),m0_cas(il),
-!     :          Jtmp,etmp,ntot_cas(il)*1e2,
-!     :           qp0_cas(il),A_cas(il),m0_cas(il),
-!     :          beta_cas(ixt,il),gama_cas(ixt,il),f_cas(il),g_cas(il))
-!               call iso_verif_egalite_choix((Jtmp),
-!     :           (J(ixt,il)),
-!     :           'stewart_exp 999: test rieman',errmax,errmaxrel)
-!               if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
-!                 write(*,*) 'stew exp tmp 1005: il,J(iso_eau,il),Jtmp=',
-!     :           il,J(iso_eau,il),Jtmp
-!               endif
-!             enddo             
-!           enddo
-!#endif           
 
   endif !if (ncas_rieman.gt.0) then
@@ -4008,33 +3956,4 @@
 &          -beta_cas(ixt,il)*gama_cas(ixt,il)*r_jqp0(ixt,il) &
 &                   /g_cas(il)/g_cas(il))
-!#ifdef ISOVERIF            
-!            if ((iso_eau.gt.0).and.(iso_eau.eq.ixt)) then
-!              write(*,*) 'stewart_explicite tmp 1071: il=',il
-!              if (il.le.ncas_Jsimple) then
-!                write(*,*) 'cas_Jsimple(il)=',cas_Jsimple(il)
-!              else !if (il.le.ncas_Jsimple) then
-!                write(*,*) 'cas_rieman(il)=',cas_rieman(il)
-!              endif !if (il.le.ncas_Jsimple) then
-!              write(*,*) 'f_cas(il),beta_cas(ixt,il),gama_cas(ixt,il)=',
-!     :                   f_cas(il),beta_cas(ixt,il),gama_cas(ixt,il)
-!              write(*,*) 'g_cas(il),r_jqp0(ixt,il),r_jl0(ixt,il)=',
-!     ;          g_cas(il),r_jqp0(ixt,il),r_jl0(ixt,il)
-!              write(*,*) 'A_cas(il)=',A_cas(il)
-!              write(*,*) 'pond Rl0=',(f_cas(il)**beta_cas(ixt,il))
-!     :          *(g_cas(il)**(-beta_cas(ixt,il)*gama_cas(ixt,il)))
-!     :          +beta(ixt,il)*gama_cas(ixt,il)*r_jqp0(ixt,il)
-!     :                   /f_cas(il)/g_cas(il)
-!              write(*,*) 'pond Rb0=',gama_cas(ixt,il)*beta_cas(ixt,il)
-!     :                   *r_jl0(ixt,il)/f_cas(il)/g_cas(il)
-!              write(*,*) 'pondRl0=fac1*fac2+t3'
-!              write(*,*) 'fac1=',
-!     :           f_cas(il)**beta_cas(ixt,il)
-!              write(*,*) 'fac2=',
-!     :             g_cas(il)**(-beta_cas(ixt,il)*gama_cas(ixt,il)) 
-!              write(*,*) 't3=',
-!     :           beta_cas(ixt,il)*gama_cas(ixt,il)*r_jqp0(ixt,il)
-!     :                   /f_cas(il)/g_cas(il)     
-!            endif
-!#endif
 
     Pxtiinf_cas(ixt,il)=Pqiinf_cas(il)*Rl(ixt,il) 
@@ -4097,5 +4016,5 @@
     enddo
 #endif
-#ifdef ISOVERIF            
+#ifdef ISOVERIF         
     if (iso_eau.gt.0) then
       if (iso_verif_egalite_choix_nostop( &
@@ -4411,7 +4330,6 @@
    if (iso_HDO.gt.0) then
     if (Pqiinf(il).gt.ridicule_rain) then
-      if (iso_verif_aberrant_nostop( &
-&                  (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
-&                   'stewart_explicie 871').eq.1)  then
+      if (iso_verif_aberrant_choix_nostop(Pxtiinf(iso_HDO,il),Pqiinf(il),ridicule_rain,deltalim_snow, &
+&                   'stewart_explicite 871').eq.1)  then
       write(*,*) 'deltaDl0=',deltaD( &
 &           (Rl0(iso_HDO,il)))
@@ -4428,5 +4346,5 @@
     endif !if (iso_HDO.gt.0)
 
-    if ((debug.eq.1).and.(il.eq.il_debug)) then
+    if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
           write(*,*) 'stewart_explicit 1558: cas avec calcul J'
           write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
@@ -4478,5 +4396,5 @@
 
 #ifdef ISOVERIF
-!          write(*,*) 'stewart_explicite vectall 1179: fin'
+          write(*,*) 'stewart_explicite vectall 1179: fin'
 #endif         
 
@@ -4702,9 +4620,7 @@
 &           'stewart_sublim_nofrac 39')              
 endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
-if ((iso_HDO.gt.0).and. &
-&           (Pqisup(il).gt.ridicule_rain)) then
-    call iso_verif_aberrant( &
-&           (Pxtisup(iso_HDO,il)/Pqisup(il)), &
-&           'stewart_sublim_nofrac 40')     
+if (iso_HDO.gt.0) then ! Camille 9 mars 2023: moins stricte pour condensat
+    call iso_verif_aberrant_choix(Pxtisup(iso_HDO,il),Pqisup(il), &
+&           ridicule_rain,deltalim_snow, 'stewart_sublim_nofrac 40') 
 endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
 enddo !do il=1,ncas
@@ -4834,9 +4750,7 @@
         enddo ! do ixt=1,niso
         ! verif que deltaD(Pqiinf) raisonable
-        if ((iso_HDO.gt.0).and. &
-     &           (Pqiinf(il).gt.ridicule_rain)) then
-            call iso_verif_aberrant( &
-     &           (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
-     &           'stewart_sublim 175')
+        if (iso_HDO.gt.0) then
+            call iso_verif_aberrant_choix(Pxtiinf(iso_HDO,il),Pqiinf(il), &
+     &           ridicule_rain,deltalim_snow, 'stewart_sublim 175')
         endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
         if (iso_eau.gt.0) then
@@ -4923,6 +4837,4 @@
 !         integer ntot_cas(ncas)
          integer il,ixt        
-         integer coeff_precision
-         parameter (coeff_precision=0.2)
 
 
@@ -10827,5 +10739,5 @@
      &          Exi_cas(1,1),Exi(1,1), &
 #endif       
-     &          xtp_avantevaptrac_cas,0,hdiag(1)) ! hdiag ne sera pas utilisé
+     &          xtp_avantevaptrac_cas,0,hdiag(1)) ! hdiag ne sera pas utilise
 
        enddo ! do izone=1,ntraceurs_zone
@@ -12615,5 +12527,5 @@
                   if (iso_verif_aberrant_choix_nostop( &
      &               zxtliq(iso_HDO,i),cond(i), &
-     &               ridicule,deltalim, &
+     &               ridicule,deltalim_snow, &
      &               'condiso_liq_ice_vectall 32b').eq.1) then
                     write(*,*) 'deltaDvap=',deltaD(xt(iso_hdo,i)/qt(i))
@@ -12636,5 +12548,5 @@
                         write(*,*) 'deltaO18(zxtliq/cond)=',deltaO(zxtliq(iso_O18,i)/cond(i))
                         write(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'
-                        stop
+                        !stop ! Camille 9 mars 2023: trop strict
                     endif  !if (iso_verif_O18_aberrant_nostop(     
                     endif ! if (iso_O18.gt.0) then      
@@ -12714,5 +12626,5 @@
                         write(*,*) 'zxtalphai(iso_O18,i)=',zxtalphai(iso_O18,i)
                         write(*,*) 'xt(1:niso,i)=',xt(1:niso,i)
-                        stop
+                        !stop ! Camille 9 mars 2023: trop strict
                     endif  !if (iso_verif_O18_aberrant_nostop(     
                     endif ! if (iso_O18.gt.0) then
@@ -12765,5 +12677,7 @@
           if (zfice(i).gt.0.9) then
               if (iso_verif_aberrant_choix_nostop( &
-     &          zxtice(iso_HDO,i),cond(i),ridicule,deltalim_snow, &
+     &          zxtice(iso_HDO,i),cond(i),ridicule,deltalim_snow, & 
+                ! Camille 9 mars 2023: pour le condensat, on laisse plus de
+                ! marge
      &          'condiso_liq_ice_vect 412').eq.1) then
                 write(*,*) 'debug condiso_liq_ice_vect 449: i,zfice=', &
@@ -13470,5 +13384,8 @@
           endif !if (iso_eau.gt.0) then
 #ifdef ISOTRAC
-          call iso_verif_traceur(xtsnow_evap(1,i), &
+!          call iso_verif_traceur(xtsnow_evap(1,i), &
+!     &           'gestion neige 2146') ! attention car snow_evap parfois
+!     négatif -> il ne faut pas passer dans les verifs de positivité.
+          call iso_verif_traceur_justmass(xtsnow_evap(1,i), &
      &           'gestion neige 2146')
 #endif          
@@ -14141,6 +14058,6 @@
         if (iso_HDO.gt.0) then
             call iso_verif_aberrant_choix(-xtsol_evap(iso_HDO,i), &
-     &           sol_evap(i),ridicule_evap,deltalim, &
-     &           'calcul_iso_surf_sic 257')
+     &           sol_evap(i),ridicule_evap,deltalim_snow, &
+     &           'calcul_iso_surf_sic 257_sol_evap')
         endif
 #endif            
@@ -14162,8 +14079,6 @@
               endif !if (iso_eau.gt.0) then
               if (iso_HDO.gt.0) then
-                if (evap(i).gt.ridicule_evap) then  
-                   call iso_verif_aberrant(xtevap(iso_HDO,i)/evap(i), &
-     &                  'calcul_iso_surf_sic 257')
-               endif !if (evap(i).gt.ridicule_evap) then  
+                   call iso_verif_aberrant_choix(xtevap(iso_HDO,i),evap(i), &
+     &                  ridicule_evap,deltalim_snow,'calcul_iso_surf_sic 257_evap')
               endif !if (iso_eau.gt.0) then
 #ifdef ISOTRAC
@@ -14323,11 +14238,16 @@
         enddo !do i=1,knon
         endif !if (iso_HDO.gt.0) then
-        
-        if (iso_eau.gt.0) then  
+            
         do i=1,knon
+        if (iso_eau.gt.0) then
           call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i),  &
-     &         'calcul_iso_surf_lic_vectall 587',errmax,errmaxrel)
-        enddo
+     &         'calcul_iso_surf_lic_vectall 587a',errmax,errmaxrel)
         endif
+        if (iso_HDO.gt.0) then
+          call iso_verif_aberrant_choix(xtsnow(iso_HDO,i), &
+     &               snow(i),ridicule_snow,deltalim_snow, &
+     &               'calcul_iso_surf_lic 587b')
+        endif
+        enddo !do i=1,knon
 #endif             
         
@@ -14476,16 +14396,10 @@
      &                  'calcul_iso_surf_lic 363',errmax,errmaxrel)  
               endif !if (iso_eau.gt.0) then
-              if (iso_HDO.gt.0) then  
-                if (snow(i).gt.ridicule_snow) then  
-                 call iso_verif_aberrant(xtsnow(iso_HDO,i)/snow(i), &
-     &                  'calcul_iso_surf_lic 367')
-                endif !if (snow(i).gt.ridicule_snow) then 
+              if (iso_HDO.gt.0) then   
                 call iso_verif_aberrant_choix(xtsnow(iso_HDO,i), &
-     &               snow(i),ridicule,deltalim_snow, &
+     &               snow(i),ridicule_snow,deltalim_snow, &
      &               'calcul_iso_surf_lic 797') 
-                if (abs(evap(i)).gt.ridicule_evap) then  
-                 call iso_verif_aberrant(xtevap(iso_HDO,i)/evap(i), &
-     &                  'calcul_iso_surf_lic 369')
-                endif ! if (evap(i).gt.ridicule_evap) then 
+                call iso_verif_aberrant_choix(xtevap(iso_HDO,i),evap(i), &
+     &                  ridicule_evap,deltalim_snow, 'calcul_iso_surf_lic 369')
               endif !if (iso_eau.gt.0) then
 #ifdef ISOTRAC
@@ -15795,8 +15709,6 @@
               endif !if (iso_eau.gt.0) then
               if (iso_HDO.gt.0) then  
-                 if (snow(i).gt.ridicule_snow) then 
-                    call iso_verif_aberrant(xtsnow(iso_HDO,i)/snow(i), &
-     &                  'calcul_iso_surf_ter 749')
-                 endif !if (snow(i).gt.ridicule_snow) then
+                 call iso_verif_aberrant_choix(xtsnow(iso_HDO,i),snow(i), &
+     &                  ridicule_snow,deltalim_snow, 'calcul_iso_surf_ter 749')
                  call iso_verif_aberrant_choix(xtsnow(iso_HDO,i), &
      &               snow(i),ridicule,deltalim_snow, &
@@ -15809,7 +15721,7 @@
                      write(*,*) 'sol_evap,snow_evap=', &
      &                   sol_evap(i),snow_evap(i)
-                     write(*,*) 'deltaDsol_evap=', &
+                     if (sol_evap(i).gt.ridicule_evap)write(*,*) 'deltaDsol_evap=', &
      &                   deltaD(xtsol_evap(iso_hdo,i)/sol_evap(i))
-                     write(*,*) 'deltaDsnow_evap=', &
+                     if (snow_evap(i).gt.ridicule_evap)write(*,*) 'deltaDsnow_evap=', &
      &                   deltaD(xtsnow_evap(iso_hdo,i)/snow_evap(i))
                      write(*,*) 'deltaD1new=',deltaD( &
@@ -16094,8 +16006,6 @@
           endif !if (iso_eau.gt.0) then
           if (iso_HDO.gt.0) then
-            if (snow(i,nsrf).gt.ridicule_snow) then
-            call iso_verif_aberrant(xtsnow(iso_hdo,i,nsrf)/snow(i,nsrf), &
-     &                'phyisoetat0 117')
-            endif
+            call iso_verif_aberrant_choix(xtsnow(iso_hdo,i,nsrf),snow(i,nsrf), &
+     &                ridicule_snow, deltalim_snow, 'phyisoetat0 117')
           endif !if (iso_eau.gt.0) then
         enddo !do nsrf=1,nbsrf
@@ -16180,6 +16090,4 @@
         real deltaD_snow_fall_O18,deltaD_rain_fall_O18
         real alpha(niso),kcin(niso)
-        real q0,h0
-        parameter (q0=20e-3,h0=0.7)
 !      character*50 text
         
@@ -16314,8 +16222,7 @@
         do k=1,klev
           do ixt=1,niso
-           RMerlivat(ixt)=toce(ixt)/alpha(ixt) &
-     &                  *(1-kcin(ixt))/(1.0-kcin(ixt)*h0)
-           xt_ancien(ixt,i,k)=q_ancien(i,k)*RMerlivat(ixt) &
-     &                  *(min(q0,q_ancien(i,k))/q0)**(alpha(ixt)-1.0)
+           call iso_init_ideal(q_ancien(i,k),xt_ancien(ixt,i,k),ixt, &
+                alpha(ixt),kcin(ixt),toce(ixt))
+
            if (q_ancien(i,k).gt.ridicule) then
            xtl_ancien(ixt,i,k)=ql_ancien(i,k)*alpha(ixt) &
@@ -16338,24 +16245,24 @@
      &           'phyisoetat0 16067')  
         enddo !do ixt=1,niso
-        if ((k.eq.1).and.(iso_HDO.gt.0).and.(iso_O18.gt.0) &
-                .and.(abs(q_ancien(i,k)-q0).lt.1e-3)) then
-                ! vérifier qu'on est proche de la fermeture de Merlivat
-            write(*,*) 'i,k=',i,k
-            write(*,*) 'q_ancien(i,k)=',q_ancien(i,k)
-            write(*,*) 'deltaD=',deltaD(xt_ancien(iso_HDO,i,k)/q_ancien(i,k))
-            write(*,*) 'deltaDM=',deltaD(RMerlivat(iso_HDO))
-            write(*,*) 'deltaO=',deltaO(xt_ancien(iso_O18,i,k)/q_ancien(i,k))
-            write(*,*) 'deltaOM=',deltaO(RMerlivat(iso_O18))
-            write(*,*) 'dexcess=',dexcess(xt_ancien(iso_HDO,i,k)/q_ancien(i,k), &
-                    xt_ancien(iso_O18,i,k)/q_ancien(i,k))
-            write(*,*) 'dexcessM=',dexcess(RMerlivat(iso_HDO),RMerlivat(iso_O18))
-            write(*,*) 'kcin=',kcin
-            write(*,*) 'toce=',toce
-            write(*,*) 'alpha=',alpha
-            call iso_verif_positif(20.0-abs(-80.0-deltaD(xt_ancien(iso_HDO,i,k)/q_ancien(i,k))), &
-                    'phyisoetat0 16398a')   
-            call iso_verif_positif(5.0-abs(10.0-dexcess(xt_ancien(iso_HDO,i,k)/q_ancien(i,k), &
-                    xt_ancien(iso_O18,i,k)/q_ancien(i,k))),'phyisoetat0 16398b') 
-        endif 
+
+        ! Camille 7 mars 2023: ajout d'un check
+        if ((i.eq.1).and.(k.eq.1).and.(iso_HDO.gt.0)) then
+        write(*,*) 'phyisoetat0 16362: q_ancien(1,1)=',q_ancien(1,1) 
+        write(*,*) 'deltaD_ancien=',deltaD(xt_ancien(iso_HDO,i,k)/q_ancien(i,k))
+        write(*,*) 'xt_ancien(:,i,k)=',xt_ancien(:,i,k)
+        endif !if ((i.eq.1).and.(k.eq.1)) then
+
+        if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then 
+            if (q_ancien(i,k).gt.ridicule) then  
+               if (iso_verif_o18_aberrant_nostop( &
+     &              xt_ancien(iso_HDO,i,k)/q_ancien(i,k), &
+     &              xt_ancien(iso_O18,i,k)/q_ancien(i,k), &
+     &              'phyisoetat0 16366 q_ancien').eq.1) then
+                  write(*,*) 'phyisoetat0 16367: i,k,q_ancien(i,k)=',i,k,q_ancien(i,k) 
+                  write(*,*) 'xt_ancien(:,i,k)=',xt_ancien(:,i,k)
+                  stop
+              endif !  if (iso_verif_o18_aberrant_nostop 
+            endif !if (q_seri(i,k).gt.errmax) then  
+        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then 
 #endif 
 
@@ -16543,5 +16450,5 @@
    CHARACTER(LEN=2) :: str2
    CHARACTER(LEN=5) :: str5
-   CHARACTER(LEN=maxlen) :: outiso, oldIso, modname, nam(2)
+   CHARACTER(LEN=maxlen) :: outiso, oldIso, modname, nam(3), oldIso2
    REAL :: xmin, xmax
    LOGICAL :: found
@@ -16559,11 +16466,17 @@
       outiso = isoName(ixt)
       oldIso = strTail(new2oldH2O(outiso), '_')            !--- Remove "H2O_" from "H2O_<iso>[_<tag>]"
+      i = INDEX(outiso, '_', .TRUE.)
+      oldIso2 = outiso(1:i-1)//outiso(i+1:LEN_TRIM(outiso)) ! CR 2023: on ajoute cette possibilité aussi, elle correspond au cas le plus récent.
+!      write(*,*) 'tmp 16541:'
+!      write(*,*) 'outiso=',outiso
+!      write(*,*) 'oldIso=',oldIso
+!      write(*,*) 'oldIso2=',oldIso2
+
       ! on lit seulement si ixt<=niso ou si on initialise les traceurs d'après fichier:
 #ifdef ISOTRAC
       IF(ixt <= niso .OR. initialisation_isotrac == 0) THEN
 #endif
-      found = phyetat0iso_srf3(xtsnow,      "XTSNOW", "Surface snow", 0.)
-      if (.NOT.found) CALL abort_physic('isotopes_routines_mod', 'phyiso_etat0_fichier 16581: unfound isotopic variable',1)
       found = phyetat0iso_srf3(fxtevap,     "XTEVAP", "evaporation",  0.)
+      if (.NOT.found) CALL abort_physic('isotopes_routines_mod', 'phyiso_etat0_fichier 16581a: unfound isotopic variable',1)
       found = phyetat0iso_get2(xtrain_fall, "xtrain_f", "xrain fall", 0.)
       found = phyetat0iso_get2(xtsnow_fall, "xtsnow_f", "xsnow fall", 0.)
@@ -16571,5 +16484,4 @@
       found = phyetat0iso_get3(xtl_ancien,  "XTLANCIEN", "QLANCIEN",  0.)
       found = phyetat0iso_get3(xts_ancien,  "XTSANCIEN", "QSANCIEN",  0.)
-      found = phyetat0iso_get2(xtrun_off_lic_0, "XTRUNOFFLIC0", "RUNOFFLIC0", 0.)
       found = phyetat0iso_get3(wake_deltaxt,  "WAKE_DELTAXT", "Delta hum. wake/env",  0.)
 #ifdef ISOVERIF
@@ -16580,5 +16492,4 @@
             DO nsrf = 1, nbsrf
                CALL iso_verif_egalite(fxtevap(iso_eau,i,nsrf),fevap(i,nsrf),TRIM(modname)//' 231c')
-               CALL iso_verif_egalite( xtsnow(iso_eau,i,nsrf), snow(i,nsrf),TRIM(modname)//' 231d')
             END DO
          END DO
@@ -16592,19 +16503,13 @@
          END DO
       END IF
-      IF(iso_eau > 0 .AND. ixt == iso_eau) THEN
-         DO i=1,klon
-            IF(iso_verif_egalite_nostop(run_off_lic_0(i),xtrun_off_lic_0(iso_eau,i),TRIM(modname)//' 326') == 1) THEN
-               WRITE(*,*) 'i=',i
-               STOP
-            END IF
-         END DO
-      END IF
 #endif
       ! ces variables n'ont pas de traceurs:
       IF(ixt <= niso) THEN
          found = phyetat0iso_get2(xtsol, "XTSOL", "Surface humidity / bucket", 0.)
+         if (.NOT.found) CALL abort_physic('isotopes_routines_mod', 'phyiso_etat0_fichier 16581b: unfound isotopic variable',1)
          found = phyetat0iso_get2(Rland_ice, "Rland_ice", "SR land ice", 0.)
-#ifdef ISOVERIF
-
+         found = phyetat0iso_srf3(xtsnow,      "XTSNOW", "Surface snow", 0.) ! CR avril 2023: deplacer ici 
+         found = phyetat0iso_get2(xtrun_off_lic_0, "XTRUNOFFLIC0", "RUNOFFLIC0", 0.)
+#ifdef ISOVERIF
          DO i=1,klon
             IF(iso_verif_noNaN_nostop(xtsol(ixt,i),TRIM(modname)//' 95') == 1) THEN
@@ -16612,5 +16517,12 @@
                STOP
             END IF
-         END DO
+            IF(ixt == iso_eau .AND. iso_eau > 0) THEN
+             DO nsrf = 1, nbsrf
+               CALL iso_verif_egalite(fxtevap(iso_eau,i,nsrf),fevap(i,nsrf),TRIM(modname)//' 231c')
+               CALL iso_verif_egalite( xtsnow(iso_eau,i,nsrf), snow(i,nsrf),TRIM(modname)//' 231d')
+             END DO
+             CALL iso_verif_egalite( xtrun_off_lic_0(iso_eau,i), run_off_lic_0(i),TRIM(modname)//' 231e')
+            ENDIF !IF(ixt == iso_eau .AND. iso_eau > 0) THEN
+         END DO !DO i=1,klon
 #endif
       END IF
@@ -16680,4 +16592,5 @@
   nam(1) = TRIM(pref)//TRIM(outiso)
   nam(2) = TRIM(pref)//TRIM(oldIso)
+  nam(3) = TRIM(pref)//TRIM(oldIso2)
   lFound = phyetat0_get(iso_tmp, nam, descr, default)
   field(ixt,:) = iso_tmp
@@ -16692,4 +16605,5 @@
   nam(1) = TRIM(pref)//TRIM(outiso)
   nam(2) = TRIM(pref)//TRIM(oldIso)
+  nam(3) = TRIM(pref)//TRIM(oldIso2)
   lFound = phyetat0_get(iso_tmp_lonlev, nam, descr, default)
   field(ixt,:,:) = iso_tmp_lonlev(:,:)
@@ -16703,4 +16617,5 @@
   nam(1) = TRIM(pref)//TRIM(outiso)
   nam(2) = TRIM(pref)//TRIM(oldIso)
+  nam(3) = TRIM(pref)//TRIM(oldIso2)
   lFound = phyetat0_srf(iso_tmp_lonsrf, nam, descr, default)
   field(ixt,:,:) = iso_tmp_lonsrf
@@ -18129,7 +18044,7 @@
 
       do iessai=1,nessai
-         day_nucl(iessai)   = 0.
-         month_nucl(iessai) = 0.
-         year_nucl(iessai)  = 0. 
+         day_nucl(iessai)   = 0
+         month_nucl(iessai) = 0
+         year_nucl(iessai)  = 0
          lat_nucl(iessai)   = 0.
          lon_nucl(iessai)   = 0.
@@ -18816,7 +18731,7 @@
           do i=1,n
             qttrac(i)=xt(ieau,i)
-!            if (qt(i).gt.0.0) then ! modif C Risi juillet 2020
-            if ((qt(i).gt.0.0).and.(xt(ieau,i).gt.0.0)) then
-               zcondtrac(i)=(zcond(i)/qt(i))*xt(ieau,i)
+            if (qt(i).gt.0.0) then ! modif C Risi juillet 2020 ! remodif Camille 9 mars 2023
+!            if ((qt(i).gt.0.0).and.(xt(ieau,i).gt.0.0)) then
+               zcondtrac(i)=(zcond(i)/qt(i))*qttrac(i)
             else !if (qt(i).eq.0) then
 #ifdef ISOVERIF              
@@ -18836,9 +18751,7 @@
             endif
             if (iso_HDO.gt.0) then
-!              if (qttrac(i).gt.ridicule_trac) then
                 call iso_verif_aberrant_choix(xttrac(iso_HDO,i), &
      &           qttrac(i),ridicule_trac,deltalimtrac, &
      &           'condisotrac 205')
-!              endif
             endif
             call iso_verif_positif(qt(i)-cond(i), &
@@ -18853,7 +18766,5 @@
           call condiso_liq_ice_vectall(xttrac,qttrac,zcondtrac, &
      &           tcond,zfice,zxticetrac,zxtliqtrac,n)
-#ifdef ISOVERIF          
-          write(*,*) 'condisotrac 167: après condiso'
-#endif           
+
           do i=1,n
           do iiso=1,niso          
@@ -18881,4 +18792,114 @@
 #endif
 
+subroutine iso_init_ideal(q,xt,ixt,alpha,kcin,toce)
+
+        USE isotopes_mod, ONLY: iso_eau,iso_HDO,ridicule
+#ifdef ISOVERIF
+        USE isotopes_verif_mod
+#endif
+        implicit none
+
+        ! inputs
+        real q ! humidité spec
+        integer ixt ! indice isotopique
+        real alpha ! coef frac à l'eq
+        real kcin ! coef frac cinétique
+        real toce ! rapport iso ds ocean surface
+
+        ! outputs
+        real xt ! equivalent iso de l'humidité spec, même unité.
+
+        ! locals
+        real RMerlivat
+        real q0,h0 ! conditions initiales de la distill de Rayleigh
+        parameter (q0=20e-3,h0=0.7)
+
+        ! verifier que ixt est un isotope et pas un tagging
+        if (ixt.gt.niso) then
+          CALL abort_physic('isotopes_routines_mod', 'iso_init_ideal, ixt>niso', 1)
+        endif
+
+        ! R selon Merlivat:
+        RMerlivat=toce/alpha *(1.0-kcin)/(1.0-kcin*h0)
+
+        ! R d'après Rayleigh
+        xt=q*RMerlivat*(min(q0,q)/q0)**(alpha-1.0)
+
+#ifdef ISOVERIF
+        call iso_verif_noNaN(xt, 'isotopes_routines_mod 18930a: iso_init_ideal')
+        if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
+            if (q.gt.ridicule) then
+                call iso_verif_aberrant_encadre( xt/q, 'isotopes_routines_mod 18930b: iso_init_ideal')
+            endif
+        endif
+        if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
+             call iso_verif_egalite(xt,q, 'isotopes_routines_mod 18930c: iso_init_ideal')
+        endif
+#endif
+        
+
+end subroutine iso_init_ideal
+
+
+subroutine appel_stewart_debug(lwork,nloc,inb,na,i, &
+                evap,water,rpprec,rr,wdtrain, &
+                xtevap,xtwater,xtp,xt,xtwdtrain)
+USE isotopes_mod, ONLY: iso_eau, iso_HDO,thumxt1, &
+&       bidouille_anti_divergence,ridicule,Rdefault
+use infotrac_phy, ONLY: ntraciso=>ntiso, niso
+#ifdef ISOTRAC
+    use isotrac_mod, only: option_cond,izone_cond,index_iso,index_zone,izone_poubelle
+#endif
+#ifdef ISOVERIF
+USE isotopes_verif_mod
+#endif
+implicit none
+
+
+! inputs
+integer nloc,na,i ! dimension horiz effective
+logical lwork(nloc)
+real wdtrain(nloc),xtwdtrain(ntraciso,nloc)
+real xt(ntraciso,nloc,na)
+real evap(nloc,na),water(nloc,na),rpprec(nloc,na),rr(nloc,na)
+integer inb(nloc)
+
+! outputs
+real xtevap(ntraciso,nloc,na),xtwater(ntraciso,nloc,na),xtp(ntraciso,nloc,na)
+
+! locals
+integer il,ixt
+
+     do il=1,nloc
+       if (i.le.inb(il) .and. lwork(il)) then
+          if (wdtrain(il).gt.0.) then
+            do ixt=1,ntraciso
+             xtwater(ixt,il,i)= xtwdtrain(ixt,il)/wdtrain(il)*water(il,i)
+             xtevap(ixt,il,i)= xtwdtrain(ixt,il)/wdtrain(il)*evap(il,i)
+            enddo
+          else !if (wdtrain(il).gt.0.) then
+            do ixt=1,niso
+             xtwater(ixt,il,i)= Rdefault(ixt)*water(il,i)
+             xtevap(ixt,il,i)= Rdefault(ixt)*evap(il,i)
+            enddo
+#ifdef ISOTRAC
+            do ixt=1+niso,ntraciso
+             if (index_zone(ixt).eq.izone_poubelle) then
+               xtwater(ixt,il,i)= Rdefault(index_iso(ixt))*water(il,i)
+               xtevap(ixt,il,i)= Rdefault(index_iso(ixt))*evap(il,i)
+             else
+               xtwater(ixt,il,i)= 0.
+               xtevap(ixt,il,i)=0.
+             endif
+            enddo ! do ixt=1+niso,ntraciso
+#endif 
+         endif !if (wdtrain(il).gt.0.) then
+         do ixt=1,ntraciso
+             xtp(ixt,il,i)= xt(ixt,il,i)/rr(il,i)*rpprec(il,i)
+         enddo !do ixt=1,ntraciso
+      endif
+    enddo ! do il=1,ncum
+end subroutine appel_stewart_debug
+
 END MODULE isotopes_routines_mod
 #endif
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotopes_verif_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotopes_verif_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotopes_verif_mod.F90	(revision 4727)
@@ -2028,9 +2028,13 @@
 
           if (iso_verif_egalite_choix_nostop(xtractot,x(iiso), &
-     &        err_msg//', verif trac egalite, iso '// &
+     &        err_msg//', verif trac egalite1, iso '// &
      &        TRIM(isoName(iiso)), &
      &        errmaxin,errmaxrelin).eq.1) then
             write(*,*) 'iso_verif_traceur 202: x=',x
 !            write(*,*) 'xtractot=',xtractot
+            do izone=1,nzone  
+              ixt=itZonIso(izone,iiso)
+              write(*,*) 'izone,iiso,ixt=',izone,iiso,ixt
+            enddo
             iso_verif_tracm_choix_nostop=1
           endif
@@ -2398,5 +2402,5 @@
         call iso_verif_egalite_std_vect( &
      &           xtractot,xiiso, &
-     &           err_msg//', verif trac egalite, iso ' &
+     &           err_msg//', verif trac egalite2, iso ' &
      &           //TRIM(isoName(iiso)), &
      &           n,m,errmax,errmaxrel)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotrac_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotrac_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotrac_mod.F90	(revision 4727)
@@ -638,5 +638,6 @@
          strtrac(izone_conv_UT)='cut'
       CASE DEFAULT
-         WRITE(*,*) 'traceurs_init 36: option pas encore prevue' ; STOP
+         WRITE(*,*) 'traceurs_init 36: option pas encore prevue'
+         CALL abort_physic ('isotrac_mod 641','option pas encore prevue',1)
    END SELECT
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotrac_routines_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotrac_routines_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/isotrac_routines_mod.F90	(revision 4727)
@@ -508,4 +508,6 @@
 !          write(*,*) 'compress 910: xtp_avantevap(iso_eau,cas(1))=',
 !     :           xtp_avantevap(iso_eau,cas(1))
+!        write(*,*) 'compress_evap_liq_zone 510: ncas,ncum=',ncas,ncum
+        ptrac(:)=0. ! CR 31 mars 2023: initialisation de ptrac
 
           ieau=index_trac(izone,iso_eau)
@@ -519,5 +521,5 @@
             else
 #ifdef ISOVERIF 
-                call iso_verif_egalite(( &
+              call iso_verif_egalite(( &
      &                   Eqi_prime(cas(il))),0.0, &
      &                   'compress_stewart 979')
@@ -685,5 +687,5 @@
                 call iso_verif_egalite(( &
      &                   Eqi_prime(cas(il))),0.0, &
-     &                   'compress_stewart 979')
+     &                   'compress_stewart 979b')
 #endif                
               Eqi_prime_cas(il)=0.0 
@@ -870,11 +872,4 @@
             enddo ! do iiso=1,niso           
           endif !if ((Eqi(il)*fac_ftmr(il).gt.evap_franche).and.
-#ifdef ISOVERIF
-          if (il.eq.9) then            
-            ixt=index_trac(2,2)
-            write(*,*) 'il,ixt,xtrevap_tag(ixt,il)=', &
-     &           il,xtrevap_tag(ixt,il)
-          endif !if (il.eq.9) then
-#endif          
          enddo !do il=1,ncas
 !         write(*,*) 'compress_stewart 1453 tmp: zxt=',
@@ -2791,5 +2786,4 @@
        real xtractot
         
-        write(*,*) 'iso_verif_traceur tmp 822: xt(:,66,1)=',x(:,66,1)
         ! verif noNaN
         call iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/limit_read_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/limit_read_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/limit_read_mod.F90	(revision 4727)
@@ -40,7 +40,5 @@
   USE surface_data
   USE mod_phys_lmdz_para
-#ifdef CPP_XIOS
-  USE XIOS
-#endif
+  USE lmdz_xios
   IMPLICIT NONE
     INTEGER, INTENT(IN) :: first_day
@@ -49,7 +47,5 @@
     IF ( type_ocean /= 'couple') THEN
       IF (grid_type==unstructured) THEN
-#ifdef CPP_XIOS
-        IF (is_omp_master) CALL xios_set_file_attr("limit_read",enabled=.TRUE.,record_offset=first_day)
-#endif
+          IF (is_omp_master) CALL xios_set_file_attr("limit_read",enabled=.TRUE.,record_offset=first_day)
       ENDIF  
     ENDIF
@@ -288,7 +284,5 @@
     USE phys_cal_mod, ONLY : calend, year_len
     USE print_control_mod, ONLY: lunout, prt_level
-#ifdef CPP_XIOS
-    USE XIOS, ONLY: xios_recv_field
-#endif
+    USE lmdz_XIOS, ONLY: xios_recv_field
     
     IMPLICIT NONE
@@ -416,5 +410,4 @@
       IF (grid_type==unstructured) THEN
 
-#ifdef CPP_XIOS
         IF ( type_ocean /= 'couple') THEN
 
@@ -450,7 +443,5 @@
           CALL Scatter_omp(rug_mpi, rugos)
        END IF
-#endif
-
- 
+
      ELSE      ! grid_type==regular
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_atke_exchange_coeff.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_atke_exchange_coeff.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_atke_exchange_coeff.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_atke_exchange_coeff.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_atke_turbulence_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_atke_turbulence_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_atke_turbulence_ini.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_atke_turbulence_ini.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_blowing_snow_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_blowing_snow_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_blowing_snow_ini.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_blowing_snow_ini.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_blowing_snow_sublim_sedim.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_blowing_snow_sublim_sedim.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_blowing_snow_sublim_sedim.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_blowing_snow_sublim_sedim.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_call_atke.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_call_atke.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_call_atke.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_call_atke.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_call_blowing_snow.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_call_blowing_snow.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_call_blowing_snow.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_call_blowing_snow.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_call_cloud_optics_prop.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_call_cloud_optics_prop.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_call_cloud_optics_prop.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_call_cloud_optics_prop.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_cloud_optics_prop.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_cloud_optics_prop.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_cloud_optics_prop.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_cloud_optics_prop.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_cloud_optics_prop_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_cloud_optics_prop_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_cloud_optics_prop_ini.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_cloud_optics_prop_ini.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_cloudth.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_cloudth.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_cloudth.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_cloudth.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_cloudth_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_cloudth_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_cloudth_ini.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_cloudth_ini.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_lscp.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_lscp.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_lscp.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_lscp.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_lscp_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_lscp_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_lscp_ini.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_lscp_ini.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_lscp_old.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_lscp_old.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_lscp_old.F90	(revision 4727)
@@ -0,0 +1,2745 @@
+!
+! $Id: fisrtilp.F90 3493 2019-05-07 08:45:07Z idelkadi $
+!
+!
+MODULE lmdz_lscp_old
+CONTAINS
+SUBROUTINE fisrtilp(dtime,paprs,pplay,t,q,ptconv,ratqs, &
+     d_t, d_q, d_ql, d_qi, rneb, radliq, rain, snow,          &
+     pfrac_impa, pfrac_nucl, pfrac_1nucl,               &
+     frac_impa, frac_nucl, beta,                        &
+     prfl, psfl, rhcl, zqta, fraca,                     &
+     ztv, zpspsk, ztla, zthl, iflag_cld_th,             &
+     iflag_ice_thermo &
+#ifdef ISO
+     &           ,xt,xtrain,xtsnow                      &
+     &           ,d_xt,d_xtl,d_xti,pxtrainfl,pxtsnowfl        &
+#endif      
+     &  )
+
+  !
+  USE dimphy
+  USE icefrac_lsc_mod ! compute ice fraction (JBM 3/14)
+  USE print_control_mod, ONLY: prt_level, lunout
+  USE lmdz_cloudth, only : cloudth, cloudth_v3, cloudth_v6
+  USE ioipsl_getin_p_mod, ONLY : getin_p
+  USE phys_local_var_mod, ONLY: ql_seri,qs_seri
+  USE phys_local_var_mod, ONLY: rneblsvol
+  ! flag to include modifications to ensure energy conservation (if flag >0)
+  USE add_phys_tend_mod, only : fl_cor_ebil 
+  USE lmdz_lscp_ini, ONLY: iflag_t_glace,t_glace_min, t_glace_max, exposant_glace
+  USE lmdz_lscp_ini, ONLY: iflag_cloudth_vert, iflag_rain_incloud_vol 
+  USE lmdz_lscp_ini, ONLY: coef_eva, coef_eva_i, ffallv_lsc, ffallv_con
+  USE lmdz_lscp_ini, ONLY: cld_tau_lsc, cld_tau_con, cld_lc_lsc, cld_lc_con
+  USE lmdz_lscp_ini, ONLY: reevap_ice, iflag_bergeron, iflag_fisrtilp_qsat, iflag_pdf 
+      use phys_output_var_mod, ONLY : cloudth_sth,cloudth_senv
+      use phys_output_var_mod, ONLY : cloudth_sigmath,cloudth_sigmaenv
+
+
+
+
+#ifdef ISO
+  USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso
+  USE isotopes_mod
+!, ONLY: essai_convergence,bidouille_anti_divergence, &
+!        &       Rdefault,ridicule,pxtice,pxtmelt,iso_eau,iso_HDO, &
+!        &       iso_O18,ridicule_rain
+  USE isotopes_routines_mod, ONLY: iso_revap_fisrtilp, &
+        condiso_liq_ice_vectall
+#ifdef ISOVERIF
+  USE isotopes_verif_mod, ONLY: errmax,errmaxrel,deltalim_snow,deltalim, &
+        iso_verif_egalite_choix,iso_verif_aberrant_choix, &
+        iso_verif_positif,iso_verif_positif_choix,iso_verif_noNaN, &
+        iso_verif_aberrant,iso_verif_positif_choix_nostop, &
+        iso_verif_aberrant_encadre,iso_verif_egalite_choix_nostop, &
+        iso_verif_aberrant_nostop,iso_verif_o18_aberrant_nostop, &
+        deltaD,deltaO,iso_verif_egalite
+#endif
+#ifdef ISOTRAC
+    use isotrac_mod, only: option_traceurs,option_tmin,seuil_tag_tmin_ls, &
+&       izone_poubelle, option_cond,izone_cond,index_iso, index_zone,izone_oce,izone_ddft
+    use isotrac_routines_mod, only: iso_recolorise_condensation
+    use isotopes_routines_mod, only: condiso_liq_ice_vectall_trac
+#ifdef ISOVERIF
+  USE isotopes_verif_mod, ONLY: iso_verif_traceur_nostop,iso_verif_traceur
+  USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
+#endif
+#endif
+#endif
+
+  IMPLICIT none
+  !======================================================================
+  ! Auteur(s): Z.X. Li (LMD/CNRS)
+  ! Date: le 20 mars 1995
+  ! Objet: condensation et precipitation stratiforme.
+  !        schema de nuage
+  ! Fusion de fisrt (physique sursaturation, P. LeVan K. Laval)
+  !             et ilp (il pleut, L. Li)
+  ! Principales parties:
+  ! P0> Thermalisation des precipitations venant de la couche du dessus
+  ! P1> Evaporation de la precipitation (qui vient du niveau k+1)
+  ! P2> Formation du nuage (en k) 
+  ! P2.A.0> Calcul des grandeurs nuageuses une pdf en creneau
+  ! P2.A.1> Avec les nouvelles PDFs, calcul des grandeurs nuageuses pour 
+  ! les valeurs de T et Q initiales
+  ! P2.A.2> Prise en compte du couplage entre eau condensee et T.
+  ! P2.A.3> Calcul des valeures finales associees a la formation des nuages
+  ! P2.B> Nuage "tout ou rien"
+  ! P2.C> Prise en compte de la Chaleur latente apres formation nuage
+  ! P3> Formation de la precipitation (en k)
+  !======================================================================
+  ! JLD: 
+  ! * Routine probablement fausse (au moins incoherente) si thermcep = .false.
+  ! * fl_cor_ebil doit etre > 0 ; 
+  !   fl_cor_ebil= 0 pour reproduire anciens bugs
+  !======================================================================
+  include "YOMCST.h"
+  !
+  ! Principaux inputs:
+  !
+  REAL, INTENT(IN)                              :: dtime  ! intervalle du temps (s)
+  REAL, DIMENSION(klon,klev+1),    INTENT(IN)   :: paprs  ! pression a inter-couche
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: pplay  ! pression au milieu de couche
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: t      ! temperature (K)
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: q      ! humidite specifique (kg/kg)
+  LOGICAL, DIMENSION(klon,klev),   INTENT(IN)   :: ptconv ! points ou le schema de conv. prof. est actif
+  INTEGER,                         INTENT(IN)   :: iflag_cld_th
+  INTEGER,                         INTENT(IN)   :: iflag_ice_thermo
+  !
+  ! Inputs lies aux thermiques
+  ! 
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: ztv
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: zqta, fraca 
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: zpspsk, ztla
+  REAL, DIMENSION(klon,klev),      INTENT(INOUT)   :: zthl
+  !
+  !  Input/output
+  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: ratqs  ! determine la largeur de distribution de vapeur
+  !
+  ! Principaux outputs:
+  !
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_t  ! incrementation de la temperature (K)
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_q  ! incrementation de la vapeur d'eau
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_ql ! incrementation de l'eau liquide
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: d_qi ! incrementation de l'eau glace
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rneb ! fraction nuageuse
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: radliq ! eau liquide utilisee dans rayonnements
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: rhcl ! humidite relative en ciel clair
+  REAL, DIMENSION(klon),           INTENT(OUT)  :: rain
+  REAL, DIMENSION(klon),           INTENT(OUT)  :: snow
+  REAL, DIMENSION(klon,klev+1),    INTENT(OUT)  :: prfl
+  REAL, DIMENSION(klon,klev+1),    INTENT(OUT)  :: psfl 
+
+#ifdef ISO
+      real double_to_real
+      double precision real_to_double
+      !integer niso
+      real xt(ntraciso,klon,klev)
+      real d_xt(ntraciso,klon,klev)
+      real d_xtl(ntraciso,klon,klev)
+      real d_xti(ntraciso,klon,klev)
+      real xtrain(ntraciso,klon)
+      real xtsnow(ntraciso,klon)
+      real pxtrainfl(ntraciso,klon,klev+1)
+      real pxtsnowfl(ntraciso,klon,klev+1)      
+      ! xt <-> q
+      ! xtrain et xtsonw <-> rain et snow
+      ! d_xt et d_xtl <-> d_q et d_ql
+      ! pxtrainfl et pxtsnowflux <-> prfl et psfl
+#endif
+
+
+  !AA
+  ! Coeffients de fraction lessivee : pour OFF-LINE
+  !
+  REAL, DIMENSION(klon,klev),      INTENT(INOUT)  :: pfrac_nucl
+  REAL, DIMENSION(klon,klev),      INTENT(INOUT)  :: pfrac_1nucl
+  REAL, DIMENSION(klon,klev),      INTENT(INOUT)  :: pfrac_impa
+  !
+  ! Fraction d'aerosols lessivee par impaction et par nucleation
+  ! POur ON-LINE
+  !
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_impa
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_nucl
+  !AA
+  ! --------------------------------------------------------------------------------
+  !
+  ! Options du programme:
+  !
+  REAL, SAVE :: seuil_neb=0.001 ! un nuage existe vraiment au-dela
+  !$OMP THREADPRIVATE(seuil_neb)
+
+
+  INTEGER ninter ! sous-intervals pour la precipitation
+  PARAMETER (ninter=5)
+  INTEGER,SAVE :: iflag_evap_prec=1 ! evaporation de la pluie
+  !$OMP THREADPRIVATE(iflag_evap_prec)
+  !
+  LOGICAL cpartiel ! condensation partielle
+  PARAMETER (cpartiel=.TRUE.)
+  REAL t_coup
+  PARAMETER (t_coup=234.0)
+  REAL DDT0
+  PARAMETER (DDT0=.01)
+  REAL ztfondue
+  PARAMETER (ztfondue=278.15)
+  ! --------------------------------------------------------------------------------
+  !
+  ! Variables locales:
+  !
+  INTEGER i, k, n, kk
+  INTEGER,save::itap=0
+  !$OMP THREADPRIVATE(itap)
+
+  REAL qsl, qsi
+  real zct      ,zcl
+  INTEGER ncoreczq  
+  REAL ctot(klon,klev)
+  REAL ctot_vol(klon,klev)
+  REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5  
+  REAL zdqsdT_raw(klon)
+  REAL Tbef(klon),qlbef(klon),DT(klon),num,denom
+
+  logical lognormale(klon)
+  logical ice_thermo
+  LOGICAL convergence(klon)
+  INTEGER n_i(klon), iter
+  REAL cste
+
+  real zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
+  real Zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon)
+  real erf   
+  REAL qcloud(klon)
+ 
+  REAL zrfl(klon), zrfln(klon), zqev, zqevt 
+  REAL zifl(klon), zifln(klon), zqev0,zqevi, zqevti
+  REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq 
+  REAL zoliqp(klon), zoliqi(klon)
+  REAL zt(klon)
+! JBM (3/14) nexpo is replaced by exposant_glace
+! REAL nexpo ! exponentiel pour glace/eau
+! INTEGER, PARAMETER :: nexpo=6
+  INTEGER exposant_glace_old
+  REAL t_glace_min_old
+  REAL zdz(klon),zrho(klon),ztot      , zrhol(klon)
+  REAL zchau      ,zfroi      ,zfice(klon),zneb(klon),znebprecip(klon)
+  REAL zmelt, zpluie, zice
+  REAL dzfice(klon)
+  REAL zsolid
+!!!!
+!  Variables pour Bergeron
+  REAL zcp, coef1, DeltaT, Deltaq, Deltaqprecl
+  REAL zqpreci(klon), zqprecl(klon)
+! Variable pour conservation enegie des precipitations
+  REAL zmqc(klon)
+
+#ifdef ISO
+      real zxtrfl(ntraciso,klon)
+      real zxtrfln(ntraciso,klon)
+      REAL zxtifl(ntraciso,klon), zxtifln(ntraciso,klon)  
+      real zxt(ntraciso,klon) ! equivalent local de xt
+      real zxtn(ntraciso,klon) ! isotpes nuageux
+      real zxtn_reduit(niso)
+      real zxtcond(ntraciso,klon)
+      real zxtoliq(ntraciso,klon)
+      real zq_ancien(klon)
+      REAL zxtpreci(ntraciso,klon), zxtprecl(ntraciso,klon)
+      integer ixt
+#ifdef ISOVERIF   
+!      integer iso_verif_aberrant_nostop
+!      integer iso_verif_egalite_choix_nostop
+!      integer iso_verif_positif_nostop
+!      integer iso_verif_positif_choix_nostop
+      integer trace_cas(klon)
+!      integer iso_verif_traceur_nostop
+#endif      
+      integer iso_verif_nonan_nostop
+      real zxtice(ntraciso,klon),zxtliq(ntraciso,klon)
+      real zrfl_ancien(klon)
+      real zqev_diag(klon)
+      real zxtrfl_ancien(ntraciso,klon)
+      real zxt_ancien(ntraciso,klon)
+#ifdef ISOTRAC
+        real zxtres(ntraciso) ! humidite spec nuageuse après condensation et precip
+        real zqcs(klon) ! humidite spec en ciel clair
+        real zxtcs(ntraciso,klon)        
+        real zcondn(klon) ! humidite spec de l'eau liquide dans le nuage
+        real zxtcondn(ntraciso,klon)
+        integer izone
+#ifdef ISOVERIF           
+        real zq_verif
+#endif        
+#endif 
+!      logical negation ! pour nier conditions logiques
+#endif
+
+  !
+  LOGICAL appel1er
+  SAVE appel1er
+  !$OMP THREADPRIVATE(appel1er)
+  !
+! iflag_oldbug_fisrtilp=0 enleve le BUG par JYG : tglace_min -> tglace_max
+! iflag_oldbug_fisrtilp=1 ajoute le BUG
+  INTEGER,SAVE :: iflag_oldbug_fisrtilp=0 !=0 sans bug
+  !$OMP THREADPRIVATE(iflag_oldbug_fisrtilp)
+  !---------------------------------------------------------------
+  !
+  !AA Variables traceurs:
+  !AA  Provisoire !!! Parametres alpha du lessivage
+  !AA  A priori on a 4 scavenging # possibles
+  !
+  REAL a_tr_sca(4)
+  save a_tr_sca
+  !$OMP THREADPRIVATE(a_tr_sca)
+  !
+  ! Variables intermediaires
+  !
+  REAL zalpha_tr
+  REAL zfrac_lessi
+  REAL zprec_cond(klon)
+  !AA
+! RomP >>> 15 nov 2012
+  REAL   beta(klon,klev) ! taux de conversion de l'eau cond
+! RomP <<<
+  REAL zmair(klon), zcpair, zcpeau
+  !     Pour la conversion eau-neige
+  REAL zlh_solid(klon), zm_solid
+  !---------------------------------------------------------------
+  !
+  ! Fonctions en ligne:
+  !
+  REAL fallvs,fallvc ! Vitesse de chute pour cristaux de glace
+                     ! (Heymsfield & Donner, 1990)
+  REAL zzz
+
+  include "YOETHF.h"
+  include "FCTTRE.h"
+  fallvc (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_con
+  fallvs (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_lsc
+  !
+  DATA appel1er /.TRUE./
+  !ym
+!CR: pour iflag_ice_thermo=2, on active que la convection
+!  ice_thermo = iflag_ice_thermo .GE. 1
+
+  itap=itap+1
+  znebprecip(:)=0.
+
+  ice_thermo = (iflag_ice_thermo .EQ. 1).OR.(iflag_ice_thermo .GE. 3)
+  zdelq=0.0
+  ctot_vol(1:klon,1:klev)=0.0
+  rneblsvol(1:klon,1:klev)=0.0
+
+  if (prt_level>9)write(lunout,*)'NUAGES4 A. JAM'
+  IF (appel1er) THEN
+     CALL getin_p('iflag_oldbug_fisrtilp',iflag_oldbug_fisrtilp)
+     CALL getin_p('iflag_evap_prec',iflag_evap_prec)
+     CALL getin_p('seuil_neb',seuil_neb)
+     write(lunout,*)' iflag_oldbug_fisrtilp =',iflag_oldbug_fisrtilp 
+     !
+     WRITE(lunout,*) 'fisrtilp, ninter:', ninter
+     WRITE(lunout,*) 'fisrtilp, iflag_evap_prec:', iflag_evap_prec
+     WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel
+     
+     IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
+        WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
+        WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes'
+        !         CALL abort
+     ENDIF
+     appel1er = .FALSE.
+
+#ifdef ISO
+        ! cam verif 
+#ifdef ISOVERIF
+        write(*,*) 'ilp 310'
+          do k=1,klev
+           do i=1,klon             
+            if (iso_eau.gt.0) then        
+             call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &   
+     &                   'il pleut 205',errmax,errmaxrel)
+            endif !if (iso_eau.gt.0) then
+            if (iso_HDO.gt.0) then    
+             if (q(i,k).gt.ridicule) then
+               call iso_verif_aberrant(xt(iso_HDO,i,k)/q(i,k), &
+     &           'il pleut 210')
+             endif !if (zq(i).gt.ridicule) then
+            endif  !if (iso_HDO.gt.0) then
+           enddo !do k=1,klev
+          enddo !do i=1,klon
+        do k=1,klev
+           do i=1,klon
+             call iso_verif_positif(370.0-t(i,k),'il pleut 250')
+             call iso_verif_positif(t(i,k)-100.0,'il pleut 251')
+           enddo
+        enddo
+        write(*,*) 'ilp 331'
+#endif
+         ! end cam verif
+#endif 
+
+     !
+     !AA initialiation provisoire
+     a_tr_sca(1) = -0.5
+     a_tr_sca(2) = -0.5
+     a_tr_sca(3) = -0.5
+     a_tr_sca(4) = -0.5
+     !
+     !AA Initialisation a 1 des coefs des fractions lessivees 
+     !
+     !cdir collapse
+     DO k = 1, klev
+        DO i = 1, klon
+           pfrac_nucl(i,k)=1.
+           pfrac_1nucl(i,k)=1.
+           pfrac_impa(i,k)=1.
+           beta(i,k)=0.  !RomP initialisation
+        ENDDO
+     ENDDO
+
+  ENDIF          !  test sur appel1er
+  !
+  !MAf Initialisation a 0 de zoliq
+  !      DO i = 1, klon
+  !         zoliq(i)=0.
+  !      ENDDO 
+  ! Determiner les nuages froids par leur temperature
+  !  nexpo regle la raideur de la transition eau liquide / eau glace.
+  !
+!CR: on est oblige de definir des valeurs fisrt car les valeurs de newmicro ne sont pas les memes par defaut
+  IF (iflag_t_glace.EQ.0) THEN
+!   ztglace = RTT - 15.0
+    t_glace_min_old = RTT - 15.0
+    !AJ<
+    IF (ice_thermo) THEN
+!     nexpo = 2
+      exposant_glace_old = 2
+    ELSE
+!     nexpo = 6
+      exposant_glace_old = 6
+    ENDIF
+    
+  ENDIF
+  
+!!  RLVTT = 2.501e6 ! pas de redefinition des constantes physiques (jyg)
+!!  RLSTT = 2.834e6 ! pas de redefinition des constantes physiques (jyg)
+!>AJ
+  !cc      nexpo = 1
+  !
+  ! Initialiser les sorties:
+  !
+  !cdir collapse
+  DO k = 1, klev+1
+     DO i = 1, klon
+        prfl(i,k) = 0.0
+        psfl(i,k) = 0.0
+#ifdef ISO                 
+          do ixt=1,ntraciso
+            pxtrainfl(ixt,i,k)=0.0
+            pxtsnowfl(ixt,i,k)=0.0
+          enddo !do ixt=1,niso
+#endif
+     ENDDO
+  ENDDO
+
+  !cdir collapse
+  DO k = 1, klev
+     DO i = 1, klon
+        d_t(i,k) = 0.0
+        d_q(i,k) = 0.0
+        d_ql(i,k) = 0.0
+        d_qi(i,k) = 0.0
+#ifdef ISO
+          do ixt=1,ntraciso
+            d_xt(ixt,i,k) = 0.0
+            d_xtl(ixt,i,k) = 0.0
+            d_xti(ixt,i,k) = 0.0
+          enddo !do ixt=1,niso
+#endif 
+        rneb(i,k) = 0.0
+        radliq(i,k) = 0.0
+        frac_nucl(i,k) = 1. 
+        frac_impa(i,k) = 1. 
+     ENDDO
+  ENDDO
+  DO i = 1, klon
+     rain(i) = 0.0
+     snow(i) = 0.0
+     zoliq(i)=0.
+#ifdef ISO
+         do ixt=1,ntraciso
+            xtrain(ixt,i) = 0.0
+            xtsnow(ixt,i) = 0.0
+            zxtoliq(ixt,i)=0.
+         enddo !do ixt=1,niso
+#endif
+     !     ENDDO
+     !
+     ! Initialiser le flux de precipitation a zero
+     !
+     !     DO i = 1, klon
+     zrfl(i) = 0.0
+     zifl(i) = 0.0
+     zrfln(i) = 0.0 ! C Risi pour plus de securite
+     zifln(i) = 0.0 ! C Risi pour plus de securite
+#ifdef ISO
+          do ixt=1,ntraciso
+            zxtrfl(ixt,i)=0.0
+            zxtifl(ixt,i)=0.0
+            zxtrfln(ixt,i)=0.0
+            zxtifln(ixt,i)=0.0
+          enddo
+#endif
+     zneb(i) = seuil_neb
+  ENDDO
+  !
+  !
+  !AA Pour plus de securite 
+
+  zalpha_tr   = 0.
+  zfrac_lessi = 0.
+
+  !AA==================================================================
+  !
+  ncoreczq=0
+  ! BOUCLE VERTICALE (DU HAUT VERS LE BAS)
+  !
+  DO k = klev, 1, -1
+     !
+     !
+#ifdef ISO      
+      ! cam debug!      
+       ! verif en debut de boucle
+#ifdef ISOVERIF
+       !write(*,*) 'ilp 478: boucle en k: k=',k         
+       do i=1,klon
+        if (iso_eau.gt.0) then
+        call iso_verif_egalite_choix(zxtrfl(iso_eau,i), &
+     &           zrfl(i), &
+     &           'il pleut 310',errmax,errmaxrel)
+        endif !if (iso_eau.gt.0) then
+        if (iso_HDO.gt.0) then  
+             call iso_verif_aberrant_choix(zxtrfl(iso_HDO,i) &
+     &           ,zrfl(i),ridicule_rain,deltalim_snow,'il pleut 316')
+        endif  !if (iso_HDO.gt.0) then  
+#ifdef ISOTRAC   
+        call iso_verif_traceur(zxtrfl(1,i), &
+     &          'il pleut 365')   
+        call iso_verif_traceur_pbidouille(zxtrfl(1,i), &
+     &          'il pleut 388')
+#endif         
+       enddo !do i=1,klon
+#endif
+#ifdef ISOVERIF   
+        !write(*,*) 'ilp tmp 412'      
+       do i=1,klon
+         do ixt=1,ntraciso
+           call iso_verif_noNaN(zxtrfl(ixt,i),'ilp 406')
+           call iso_verif_noNaN(zxtoliq(ixt,i),'ilp 407')
+         enddo !do ixt=1,ntraciso
+       enddo !do i=1,klon
+#endif
+      ! end verif en debut de boucle
+      ! end cam debug
+#endif
+     !AA===============================================================
+     !
+     ! Initialisation temperature et vapeur
+     DO i = 1, klon
+        zt(i)=t(i,k)
+        zq(i)=q(i,k)
+#ifdef ISOVERIF
+        if (q(i,k).lt.0.0) then
+               write(*,*) 'ilp 400: avant clmain 31janv: i,k,q=', &
+     &           i,k,q(i,k)
+               CALL abort_physic('ilp 484', 'on stop', 1)
+        endif 
+#endif
+#ifdef ISO
+           zq(i)=max(0.0,zq(i))
+#ifdef ISOTRAC
+#ifdef ISOVERIF         
+          call iso_verif_traceur(xt(1,i,k),'ilp 404')           
+          call iso_verif_traceur_pbidouille(xt(1,i,k),'ilp 407')
+#endif          
+#endif          
+         do ixt=1,ntraciso
+           zxt(ixt,i)=xt(ixt,i,k)
+           zxt(ixt,i)=max(0.0,zxt(ixt,i))
+         enddo !do ixt=1,niso  
+
+         ! cam verif
+#ifdef ISOVERIF
+         !write(*,*) 'ilp tmp 562'
+             call iso_verif_positif(370.0-zt(i),'il pleut 425')
+             call iso_verif_positif(zt(i)-100.0,'il pleut 426')
+          if (iso_eau.gt.0) then        
+            call iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
+     &                   'il pleut 289',errmax,errmaxrel)
+          endif !if (iso_eau.gt.0) then
+          if (iso_HDO.gt.0) then    
+             if (zq(i).gt.ridicule) then
+               call iso_verif_aberrant(zxt(iso_HDO,i)/zq(i), &
+     &           'il pleut 337')
+             endif !if (zq(i).gt.ridicule) then
+          endif  !if (iso_HDO.gt.0) then  
+#ifdef ISOTRAC
+          call iso_verif_traceur(zxt(1,i),'ilp 431')
+#endif           
+#endif
+         ! end cam verif
+#endif  
+
+     ENDDO
+     !
+     ! ----------------------------------------------------------------
+     ! P0> Thermalisation des precipitations venant de la couche du dessus
+     ! ----------------------------------------------------------------
+     ! Calculer la varition de temp. de l'air du a la chaleur sensible
+     ! transporter par la pluie. On thermalise la pluie avec l'air de la couche.
+     ! Cette quantite de pluie qui est thermalisee, et devra continue a l'etre lors
+     ! des differentes transformations thermodynamiques. Cette masse d'eau doit
+     ! donc etre ajoute a l'humidite de la couche lorsque l'on calcule la variation
+     ! de l'enthalpie  de la couche avec la temperature
+     ! Variables calculees ou modifiees:
+     !   -  zt: temperature de la cocuhe
+     !   - zmqc: masse de precip qui doit etre thermalisee
+     !
+     IF(k.LE.klevm1) THEN         
+        DO i = 1, klon
+           !IM
+           zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
+           ! il n'y a pas encore d'eau liquide ni glace dans la maiille, donc zq suffit
+           zcpair=RCPD*(1.0+RVTMP2*zq(i))
+           zcpeau=RCPD*RVTMP2
+         if (fl_cor_ebil .GT. 0) then
+           ! zmqc: masse de precip qui doit etre thermalisee avec l'air de la couche atm 
+           ! pour s'assurer que la precip arrivant au sol aura bien la temperature de la 
+           ! derniere couche
+           zmqc(i) = (zrfl(i)+zifl(i))*dtime/zmair(i)
+           ! t(i,k+1)+d_t(i,k+1): nouvelle temp de la couche au dessus
+           zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zmqc(i)*zcpeau + zcpair*zt(i) ) &
+                 / (zcpair + zmqc(i)*zcpeau)
+         else ! si on maintient les anciennes erreurs
+           zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zrfl(i)*dtime*zcpeau &
+                + zmair(i)*zcpair*zt(i) ) &
+                / (zmair(i)*zcpair + zrfl(i)*dtime*zcpeau)
+         end if
+        ENDDO
+     ELSE  ! IF(k.LE.klevm1) 
+        DO i = 1, klon 
+           zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG 
+           zmqc(i) = 0.
+        ENDDO
+     ENDIF ! end IF(k.LE.klevm1)
+     !
+     ! ----------------------------------------------------------------
+     ! P1> Calcul de l'evaporation de la precipitation
+     ! ----------------------------------------------------------------
+     ! On evapore une partie des precipitations venant de la maille du dessus.
+     ! On calcule l'evaporation et la sublimation des precipitations, jusqu'a
+     ! ce que la fraction de cette couche qui est sous le nuage soit saturee.
+     ! Variables calculees ou modifiees:
+     !   - zrfl et zifl: flux de precip liquide et glace
+     !   - zq, zt: humidite et temperature de la cocuhe
+     !   - zmqc: masse de precip qui doit etre thermalisee
+     !
+#ifdef ISO
+      DO i = 1, klon
+         zq_ancien(i)=zq(i)
+         zqev_diag(i)=0.0
+         zrfl_ancien(i)=zrfl(i)
+         do ixt=1,ntraciso
+           zxtrfl_ancien(ixt,i)=zxtrfl(ixt,i)
+           zxt_ancien(ixt,i)=zxt(ixt,i)
+         enddo 
+      enddo   ! DO i = 1, klon  
+#ifdef ISOVERIF
+        !write(*,*) 'ilp tmp 616'
+      if (iso_eau.gt.0) then
+       DO i = 1, klon           
+          call iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
+     &           'il pleut 426a',errmax,errmaxrel) 
+          call iso_verif_egalite_choix(zxtrfl_ancien(iso_eau,i), &
+     &            zrfl_ancien(i), &
+     &           'il pleut 426b',errmax,errmaxrel)
+        enddo
+      endif
+#ifdef ISOTRAC
+       do i=1,klon      
+            call iso_verif_traceur(zxt_ancien(1,i),'ilp 532')
+            call iso_verif_traceur(zxtrfl_ancien(1,i), &
+     &           'ilp 533')  
+       enddo !do i=1,klon  
+#endif      
+#endif      
+#endif
+
+
+     IF (iflag_evap_prec>=1) THEN
+        DO i = 1, klon
+!          S'il y a des precipitations
+           IF (zrfl(i)+zifl(i).GT.0.) THEN
+              ! Calcul du qsat
+              IF (thermcep) THEN
+                 zdelta=MAX(0.,SIGN(1.,RTT-zt(i)))
+                 zqs(i)= R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
+                 zqs(i)=MIN(0.5,zqs(i))
+                 zcor=1./(1.-RETV*zqs(i))
+                 zqs(i)=zqs(i)*zcor
+              ELSE
+                 IF (zt(i) .LT. t_coup) THEN
+                    zqs(i) = qsats(zt(i)) / pplay(i,k)
+                 ELSE
+                    zqs(i) = qsatl(zt(i)) / pplay(i,k)
+                 ENDIF
+              ENDIF
+           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
+        ENDDO
+!AJ<
+
+       IF (.NOT. ice_thermo) THEN
+        DO i = 1, klon
+!          S'il y a des precipitations
+           IF (zrfl(i)+zifl(i).GT.0.) THEN                
+                ! Evap max pour ne pas saturer la fraction sous le nuage
+                ! Evap max jusqu'à atteindre la saturation dans la partie
+                ! de la maille qui est sous le nuage de la couche du dessus
+                !!! On ne tient compte de cette fraction que sous une seule
+                !!! couche sous le nuage
+                zqev = MAX (0.0, (zqs(i)-zq(i))*zneb(i) )
+             ! Ajout de la prise en compte des precip a thermiser
+             ! avec petite reecriture 
+             if  (fl_cor_ebil .GT. 0) then ! nouveau
+                ! Calcul de l'evaporation du flux de precip herite
+                !   d'au-dessus
+                zqevt = coef_eva * (1.0-zq(i)/zqs(i)) * SQRT(zrfl(i)) &
+                     * zmair(i)/pplay(i,k)*zt(i)*RD
+                zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) * dtime/zmair(i)
+                ! Seuil pour ne pas saturer la fraction sous le nuage
+                zqev = MIN (zqev, zqevt)
+                ! Nouveau flux de precip
+                zrfln(i) = zrfl(i) - zqev*zmair(i)/dtime
+                ! Aucun flux liquide pour T < t_coup, on reevapore tout.
+                IF (zt(i) .LT. t_coup.and.reevap_ice) THEN
+                  zrfln(i)=0.
+                  zqev = (zrfl(i)-zrfln(i))/zmair(i)*dtime
+                END IF
+                ! Nouvelle vapeur 
+                zq(i) = zq(i) + zqev
+                zmqc(i) = zmqc(i)-zqev
+                ! Nouvelle temperature (chaleur latente)
+                zt(i) = zt(i) - zqev &
+                     * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
+!!JLD debut de partie a supprimer a terme
+            else ! if  (fl_cor_ebil .GT. 0)
+                ! Calcul de l'evaporation du flux de precip herite
+                !   d'au-dessus
+                zqevt = coef_eva * (1.0-zq(i)/zqs(i)) * SQRT(zrfl(i)) &
+                     * (paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+                zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) &
+                     * RG*dtime/(paprs(i,k)-paprs(i,k+1))
+                ! Seuil pour ne pas saturer la fraction sous le nuage
+                zqev = MIN (zqev, zqevt)
+                ! Nouveau flux de precip
+                zrfln(i) = zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1)) &
+                     /RG/dtime
+                ! Aucun flux liquide pour T < t_coup
+                IF (zt(i) .LT. t_coup.and.reevap_ice) zrfln(i)=0.
+                ! Nouvelle vapeur 
+                zq(i) = zq(i) - (zrfln(i)-zrfl(i)) &
+                     * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
+                ! Nouvelle temperature (chaleur latente)
+                zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
+                     * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
+                     * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
+              end if ! if  (fl_cor_ebil .GT. 0)
+
+!!JLD fin de partie a supprimer a terme
+                zrfl(i) = zrfln(i)
+                zifl(i) = 0.
+#ifdef ISO
+         zqev_diag(i)=zqev
+#endif
+
+           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
+
+
+        ENDDO
+#ifdef ISO
+
+      ! * traitement de l'évaporation
+      call iso_revap_fisrtilp(klon,klev,k, &
+     &            zrfl_ancien,zrfl,zrfln,zt,zxt_ancien, &
+     &            zxtrfl,zxtrfl_ancien,zxtrfln,zxt, &
+     &            paprs,dtime, &
+     &            zqs,zq_ancien,zqev_diag,zq)  
+#endif
+
+!
+       ELSE ! (.NOT. ice_thermo) 
+
+#ifdef ISO
+        CALL abort_physic('ilp 664', 'isotopes pas encore prevus dans ice_thermo', 1)        
+#endif
+!      ================================
+!      Avec thermodynamique de la glace
+!      ================================
+        DO i = 1, klon
+!AJ<
+!        S'il y a des precipitations
+         IF (zrfl(i)+zifl(i).GT.0.) THEN
+
+         IF (iflag_evap_prec==1) THEN
+            znebprecip(i)=zneb(i)
+         ELSE
+            znebprecip(i)=MAX(zneb(i),znebprecip(i))
+         ENDIF
+     
+        ! Evap max pour ne pas saturer la fraction sous le nuage
+         zqev0 = MAX (0.0, (zqs(i)-zq(i))*znebprecip(i) )
+
+         !JAM
+         ! On differencie qsat pour l'eau et la glace
+         ! Si zdelta=1. --> glace
+         ! Si zdelta=0. --> eau liquide
+        
+         ! Calcul du qsat par rapport a l'eau liquide
+         qsl= R2ES*FOEEW(zt(i),0.)/pplay(i,k)
+         qsl= MIN(0.5,qsl)
+         zcor= 1./(1.-RETV*qsl)
+         qsl= qsl*zcor
+         
+         ! Calcul de l'evaporation du flux de precip venant du dessus
+         ! Formulation en racine du flux de precip
+         ! (Klemp & Wilhelmson, 1978; Sundqvist, 1988)
+         IF (iflag_evap_prec==3) THEN
+         zqevt = znebprecip(i)*coef_eva*(1.0-zq(i)/qsl) &
+              *SQRT(zrfl(i)/max(1.e-4,znebprecip(i))) &
+              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+         ELSE
+         zqevt = 1.*coef_eva*(1.0-zq(i)/qsl)*SQRT(zrfl(i)) &
+              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+         ENDIF
+
+
+         zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) &
+              *RG*dtime/(paprs(i,k)-paprs(i,k+1)) 
+         
+         ! Calcul du qsat par rapport a la glace
+         qsi= R2ES*FOEEW(zt(i),1.)/pplay(i,k)
+         qsi= MIN(0.5,qsi)
+         zcor= 1./(1.-RETV*qsi)
+         qsi= qsi*zcor
+
+         ! Calcul de la sublimation du flux de precip solide herite
+         !   d'au-dessus
+         IF (iflag_evap_prec==3) THEN
+         zqevti = znebprecip(i)*coef_eva*(1.0-zq(i)/qsi) &
+              *SQRT(zifl(i)/max(1.e-4,znebprecip(i))) &
+              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+         ELSE
+         zqevti = 1.*coef_eva*(1.0-zq(i)/qsi)*SQRT(zifl(i)) &
+              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+         ENDIF
+         zqevti = MAX(0.0,MIN(zqevti,zifl(i))) &
+              *RG*dtime/(paprs(i,k)-paprs(i,k+1))   
+
+        !JAM
+        ! Limitation de l'evaporation. On s'assure qu'on ne sature pas 
+        ! la fraction de la couche sous le nuage sinon on repartit zqev0 
+        ! en conservant la proportion liquide / glace
+     
+         IF (zqevt+zqevti.GT.zqev0) THEN
+            zqev=zqev0*zqevt/(zqevt+zqevti)
+            zqevi=zqev0*zqevti/(zqevt+zqevti)
+         ELSE
+!JLD je ne comprends pas les lignes ci-dessous. On repartit les precips
+!       liquides et solides meme si on ne sature pas la couche. 
+!       A mon avis, le test est inutile, et il faudrait tout remplacer par:
+!            zqev=zqevt
+!            zqevi=zqevti
+             IF (zqevt+zqevti.GT.0.) THEN
+                zqev=MIN(zqev0*zqevt/(zqevt+zqevti),zqevt)
+                zqevi=MIN(zqev0*zqevti/(zqevt+zqevti),zqevti)
+             ELSE
+             zqev=0.
+             zqevi=0.
+             ENDIF
+         ENDIF
+         ! Nouveaux flux de precip liquide et solide 
+         zrfln(i) = Max(0.,zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1)) &
+                                 /RG/dtime)
+         zifln(i) = Max(0.,zifl(i) - zqevi*(paprs(i,k)-paprs(i,k+1)) &
+                                 /RG/dtime)
+
+         ! Mise a jour de la vapeur, temperature et flux de precip
+         zq(i) = zq(i) - (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
+                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
+       if (fl_cor_ebil .GT. 0) then ! avec correction thermalisation des precips
+         zmqc(i) = zmqc(i) + (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
+                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
+         zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
+                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
+                  * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i))) &
+                  + (zifln(i)-zifl(i)) &
+                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
+                  * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
+       else ! sans correction thermalisation des precips
+         zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
+                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
+                  * RLVTT/RCPD/(1.0+RVTMP2*zq(i)) &
+                  + (zifln(i)-zifl(i)) &
+                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
+                  * RLSTT/RCPD/(1.0+RVTMP2*zq(i))
+       end if
+        ! Nouvelles vaeleurs des precips liquides et solides 
+         zrfl(i) = zrfln(i)
+         zifl(i) = zifln(i)
+!        print*,'REEVAP ',itap,k,znebprecip(1),zqev0,zqev,zqevi,zrfl(1)
+
+!CR ATTENTION: deplacement de la fonte de la glace
+!jyg : Bug !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! jyg
+!!!        zmelt = ((zt(i)-273.15)/(ztfondue-273.15))**2  !!!!!!!!! jyg
+!jyg : Bug !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! jyg
+           zmelt = ((zt(i)-273.15)/(ztfondue-273.15))             ! jyg
+           ! fraction de la precip solide qui est fondue
+           zmelt = MIN(MAX(zmelt,0.),1.)
+           ! Fusion de la glace
+           zrfl(i)=zrfl(i)+zmelt*zifl(i)
+           if (fl_cor_ebil .LE. 0) then
+             ! the following line should not be here. Indeed, if zifl is modified
+             ! now, zifl(i)*zmelt is no more the amount of ice that has melt
+             ! and therefore the change in temperature computed below is wrong
+             zifl(i)=zifl(i)*(1.-zmelt)
+           end if
+           ! Chaleur latente de fusion
+        if (fl_cor_ebil .GT. 0) then ! avec correction thermalisation des precips
+           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
+                      *RLMLT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
+        else ! sans correction thermalisation des precips
+           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
+                      *RLMLT/RCPD/(1.0+RVTMP2*zq(i))
+        end if
+           if (fl_cor_ebil .GT. 0) then ! correction bug, deplacement ligne precedente
+             zifl(i)=zifl(i)*(1.-zmelt)
+           end if
+
+           ELSE
+              ! Si on n'a plus de pluies, on reinitialise a 0 la farcion
+              ! sous nuageuse utilisee pour la pluie.
+              znebprecip(i)=0.
+           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
+        ENDDO
+
+      ENDIF ! (.NOT. ice_thermo) 
+     
+     ! ----------------------------------------------------------------
+     ! Fin evaporation de la precipitation
+     ! ----------------------------------------------------------------
+     ENDIF ! (iflag_evap_prec>=1)
+     !
+     ! Calculer Qs et L/Cp*dQs/dT:
+#ifdef ISOVERIF
+!        write(*,*) 'ilp tmp 849'
+           do i=1,klon
+             call iso_verif_positif(370.0-zt(i),'il pleut 938')
+             call iso_verif_positif(zt(i)-100.0,'il pleut 939')
+             do ixt=1,ntraciso
+              call iso_verif_positif_choix(zxt(ixt,i),0.0,'ilp 614')
+             enddo   
+             if (zq(i).gt.ridicule) then
+               if (iso_HDO.gt.0) then
+                  call iso_verif_aberrant_encadre(zxt(iso_HDO,i)/zq(i), &
+     &                   'il pleut 856')                 
+                  if (iso_O18.gt.0) then                
+                   if (iso_verif_O18_aberrant_nostop(zxt(iso_HDO,i)/zq(i), &
+     &               zxt(iso_O18,i)/zq(i),'il pleut 859').eq.1) then
+                     write(*,*) 'i,k,zq=',i,k,zq(i)
+                     write(*,*) 'zqev_diag(i)=',zqev_diag(i)
+                     write(*,*) 'zrfl_ancien(i)=',zrfl_ancien(i)
+                     write(*,*) 'zrfln(i)=',zrfln(i)
+                     write(*,*) 'zq_ancien(i)=',zq_ancien(i)
+                     write(*,*) 'deltaD(zrfl_ancien)=',deltaD(zxtrfl_ancien(iso_HDO,i))
+                     write(*,*) 'deltaO(zrfl_ancien)=',deltaO(zxtrfl_ancien(iso_O18,i))
+                     write(*,*) 'deltaD(zq_ancien)=',deltaD(zxt_ancien(iso_HDO,i))
+                     write(*,*) 'deltaO(zq_ancien)=',deltaO(zxt_ancien(iso_O18,i))
+                     write(*,*) 'zt=',zt(i)
+                     stop
+                endif !if (iso_verif_O18_aberrant_nostop
+               endif !if (iso_O18.gt.0) then
+              endif !if (iso_HDO.gt.0) then
+             endif !if (zq(i).gt.ridicule) then                
+           enddo !do i=1,klon
+#ifdef ISOTRAC
+!      write(*,*) 'ilp tmp 633'
+           do i=1,klon
+              call iso_verif_traceur(zxtrfl(1,i),'il pleut 632')
+           enddo
+!      write(*,*) 'ilp tmp 637,thermcep'
+#endif           
+#endif    
+#ifdef ISOVERIF
+!        write(*,*) 'ilp tmp 888'
+           do i=1,klon
+            do ixt=1,ntraciso
+             call iso_verif_noNaN(zxtrfl(ixt,i),'ilp 624')
+            enddo !do ixt=1,ntraciso
+           enddo ! do i=1,klon
+!        write(*,*) 'ilp tmp 638: k,zoliq,zxtoliq(1,363)=',k,zoliq(363),zxtoliq(1,363)
+#endif
+     !
+     IF (thermcep) THEN
+        DO i = 1, klon
+           zdelta = MAX(0.,SIGN(1.,RTT-zt(i)))
+           zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
+       if  (fl_cor_ebil .GT. 0) then ! nouveau
+           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
+       else    
+           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i))
+       endif
+           zqs(i) = R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
+           zqs(i) = MIN(0.5,zqs(i))
+           zcor = 1./(1.-RETV*zqs(i))
+           zqs(i) = zqs(i)*zcor
+           zdqs(i) = FOEDE(zt(i),zdelta,zcvm5,zqs(i),zcor)
+           zdqsdT_raw(i) = zdqs(i)*  &
+         &         RCPD*(1.0+RVTMP2*zq(i)) / (RLVTT*(1.-zdelta) + RLSTT*zdelta)
+        ENDDO
+     ELSE
+        DO i = 1, klon
+           IF (zt(i).LT.t_coup) THEN
+              zqs(i) = qsats(zt(i))/pplay(i,k)
+              zdqs(i) = dqsats(zt(i),zqs(i))
+           ELSE
+              zqs(i) = qsatl(zt(i))/pplay(i,k)
+              zdqs(i) = dqsatl(zt(i),zqs(i))
+           ENDIF
+        ENDDO
+     ENDIF
+     !
+     ! Determiner la condensation partielle et calculer la quantite
+     ! de l'eau condensee:
+     !
+!verification de la valeur de iflag_fisrtilp_qsat pour iflag_ice_thermo=1
+!       if ((iflag_ice_thermo.eq.1).and.(iflag_fisrtilp_qsat.ne.0)) then
+!         write(*,*) " iflag_ice_thermo==1 requires iflag_fisrtilp_qsat==0", &
+!        " but iflag_fisrtilp_qsat=",iflag_fisrtilp_qsat, ". Might as well stop here."
+!         stop
+!       endif
+
+     ! ----------------------------------------------------------------
+     ! P2> Formation du nuage
+     ! ----------------------------------------------------------------
+     ! Variables calculees:
+     !   rneb  : fraction nuageuse
+     !   zcond : eau condensee moyenne dans la maille.
+     !   rhcl: humidite relative ciel-clair
+     !   zt : temperature de la maille
+     ! ----------------------------------------------------------------
+     !
+     IF (cpartiel) THEN
+        ! -------------------------
+        ! P2.A> Nuage fractionnaire
+        ! -------------------------
+        !
+        !   Calcul de l'eau condensee et de la fraction nuageuse et de l'eau
+        !   nuageuse a partir des PDF de Sandrine Bony.
+        !   rneb  : fraction nuageuse
+        !   zqn   : eau totale dans le nuage
+        !   zcond : eau condensee moyenne dans la maille.
+        !  on prend en compte le réchauffement qui diminue la partie
+        ! condensee
+        !
+        !   Version avec les raqts
+
+        ! ----------------------------------------------------------------
+        ! P2.A.0> Calcul des grandeurs nuageuses une pdf en creneau
+        ! ----------------------------------------------------------------
+
+#ifdef ISO          
+#ifdef ISOVERIF
+        do i=1,klon
+          if (iso_eau.gt.0) then    
+            if (iso_verif_egalite_choix_nostop(zxt(iso_eau,i),zq(i), &
+     &            'il pleut 608',errmax,errmaxrel).eq.1) then
+              write(*,*) 'i=',i
+              stop
+            endif
+          endif !if (iso_eau.gt.0) then
+#ifdef ISOTRAC
+          call iso_verif_traceur(zxt(1,i),'il pleut 1106')
+#endif          
+        enddo !do i=1,klon        
+#endif
+#endif 
+
+        if (iflag_pdf.eq.0) then
+
+           ! version creneau de (Li, 1998)
+           do i=1,klon
+              zdelq = min(ratqs(i,k),0.99) * zq(i)
+              rneb(i,k) = (zq(i)+zdelq-zqs(i)) / (2.0*zdelq)
+              zqn(i) = (zq(i)+zdelq+zqs(i))/2.0
+           enddo
+
+        else !  if (iflag_pdf.eq.0)
+           ! ----------------------------------------------------------------
+           ! P2.A.1> Avec les nouvelles PDFs, calcul des grandeurs nuageuses pour 
+           ! les valeurs de T et Q initiales
+           ! ----------------------------------------------------------------
+           do i=1,klon
+              if(zq(i).lt.1.e-15) then
+                 ncoreczq=ncoreczq+1
+#ifdef ISO
+                zq_ancien(i)=zq(i)
+#endif
+                 zq(i)=1.e-15
+#ifdef ISO
+                ! on conserve le même rapport pour les isotopes
+                if (zq_ancien(i).gt.0.0) then
+                   do ixt=1,ntraciso
+                     zxt(ixt,i)=zxt(ixt,i)/zq_ancien(i)*zq(i)
+                     zxt(ixt,i)=max(0.0,zxt(ixt,i))
+                   enddo   
+                else !if (zq_ancien(i).gt.0.0) then
+                    do ixt=1,ntraciso
+                     zxt(ixt,i)=0.0
+                   enddo 
+                endif !if (zq_ancien(i).gt.0.0) then
+
+                ! verif
+#ifdef ISOVERIF
+                  if (iso_eau.gt.0) then
+                    call iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
+     &                 'il pleut 654',errmax,errmaxrel)
+                  endif !if (iso_eau.gt.0) then
+#ifdef ISOTRAC
+             call iso_verif_traceur(zxt(1,i),'il pleut 1207')
+#endif                    
+#endif
+                ! end verif
+#endif 
+              endif
+           enddo
+
+           if (iflag_cld_th>=5) then
+
+              if (iflag_cloudth_vert<=2) then
+               call cloudth(klon,klev,k,ztv, &
+                   zq,zqta,fraca, &
+                   qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
+                   ratqs,zqs,t, &
+                   cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+              elseif (iflag_cloudth_vert>=3 .and. iflag_cloudth_vert<=5) then
+               call cloudth_v3(klon,klev,k,ztv, &
+                   zq,zqta,fraca, &
+                   qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
+                   ratqs,zqs,t, &
+                   cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+              !----------------------------------
+              !Version these Jean Jouhaud, Decembre 2018 
+              !----------------------------------              
+              elseif (iflag_cloudth_vert==6) then
+               call cloudth_v6(klon,klev,k,ztv, &
+                   zq,zqta,fraca, &
+                   qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
+                   ratqs,zqs,t, &
+                   cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
+
+              endif
+              do i=1,klon
+                 rneb(i,k)=ctot(i,k)
+                 rneblsvol(i,k)=ctot_vol(i,k)
+                 zqn(i)=qcloud(i)
+              enddo
+
+           endif
+
+           if (iflag_cld_th <= 4) then
+              lognormale = .true.
+           elseif (iflag_cld_th >= 6) then
+              ! lognormale en l'absence des thermiques
+              lognormale = fraca(:,k) < 1e-10
+           else
+              ! Dans le cas iflag_cld_th=5, on prend systématiquement la
+              ! bi-gaussienne
+              lognormale = .false.
+           end if
+
+!CR: variation de qsat avec T en presence de glace ou non
+!initialisations
+           do i=1,klon
+              DT(i) = 0.
+              n_i(i)=0
+              Tbef(i)=zt(i)
+              qlbef(i)=0.
+           enddo
+
+        ! ----------------------------------------------------------------
+        ! P2.A.2> Prise en compte du couplage entre eau condensee et T.
+        ! Calcul des grandeurs nuageuses en tenant compte de l'effet de
+        ! la condensation sur T, et donc sur qsat et sur les grandeurs nuageuses
+        ! qui en dependent. Ce changement de temperature est provisoire, et
+        ! la valeur definitive sera calcule plus tard.
+        ! Variables calculees: 
+        !   rneb : nebulosite
+        !   zcond: eau condensee en moyenne dans la maille
+        ! note JLD: si on n'a pas de pdf lognormale, ce qui se passe ne me semble
+        ! pas clair, il n'y a probablement pas de prise en compte de l'effet de
+        ! T sur qsat
+        ! ----------------------------------------------------------------
+
+!Boucle iterative: ATTENTION, l'option -1 n'est plus activable ici
+           if (iflag_fisrtilp_qsat.ge.0) then
+             ! Iteration pour condensation avec variation de qsat(T) 
+             ! -----------------------------------------------------
+             do iter=1,iflag_fisrtilp_qsat+1
+                
+               do i=1,klon
+!                 do while ((abs(DT(i)).gt.DDT0).or.(n_i(i).eq.0))
+                 ! !! convergence = .true. tant que l'on n'a pas converge !!
+                 ! ------------------------------
+                 convergence(i)=abs(DT(i)).gt.DDT0
+                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
+                 ! si on n'a pas converge
+                 !
+                 ! P2.A.2.1> Calcul de la fraction nuageuse et de la quantite d'eau condensee
+                 ! ---------------------------------------------------------------
+                 ! Variables calculees: 
+                 ! rneb : nebulosite
+                 ! zqn : eau condensee, dans le nuage (in cloud water content)
+                 ! zcond: eau condensee en moyenne dans la maille
+                 ! rhcl: humidite relative ciel-clair
+                 !
+                 Tbef(i)=Tbef(i)+DT(i) ! nouvelle temperature
+                 if (.not.ice_thermo) then   
+                    zdelta = MAX(0.,SIGN(1.,RTT-Tbef(i)))
+                 else
+                    if (iflag_t_glace.eq.0) then
+                    zdelta = MAX(0.,SIGN(1.,t_glace_min_old-Tbef(i)))
+                    else if (iflag_t_glace.ge.1) then
+                       if (iflag_oldbug_fisrtilp.EQ.0) then
+                          zdelta = MAX(0.,SIGN(1.,t_glace_max-Tbef(i)))
+                       else
+                          !avec bug : zdelta = MAX(0.,SIGN(1.,t_glace_min-Tbef(i)))
+                          zdelta = MAX(0.,SIGN(1.,t_glace_min-Tbef(i)))
+                       endif
+                    endif
+                 endif
+                 ! Calcul de rneb, qzn et zcond pour les PDF lognormales
+                 zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
+               if (fl_cor_ebil .GT. 0) then
+                 zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
+               else
+                 zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i))
+               end if
+                 zqs(i) = R2ES*FOEEW(Tbef(i),zdelta)/pplay(i,k)
+                 zqs(i) = MIN(0.5,zqs(i))
+                 zcor = 1./(1.-RETV*zqs(i))
+                 zqs(i) = zqs(i)*zcor
+                 zdqs(i) = FOEDE(Tbef(i),zdelta,zcvm5,zqs(i),zcor)
+                 zpdf_sig(i)=ratqs(i,k)*zq(i)
+                 zpdf_k(i)=-sqrt(log(1.+(zpdf_sig(i)/zq(i))**2))
+                 zpdf_delta(i)=log(zq(i)/zqs(i))
+                 zpdf_a(i)=zpdf_delta(i)/(zpdf_k(i)*sqrt(2.))
+                 zpdf_b(i)=zpdf_k(i)/(2.*sqrt(2.))
+                 zpdf_e1(i)=zpdf_a(i)-zpdf_b(i)
+                 zpdf_e1(i)=sign(min(abs(zpdf_e1(i)),5.),zpdf_e1(i))
+                 zpdf_e1(i)=1.-erf(zpdf_e1(i))
+                 zpdf_e2(i)=zpdf_a(i)+zpdf_b(i)
+                 zpdf_e2(i)=sign(min(abs(zpdf_e2(i)),5.),zpdf_e2(i))
+                 zpdf_e2(i)=1.-erf(zpdf_e2(i))
+             
+                 if (zpdf_e1(i).lt.1.e-10) then
+                    rneb(i,k)=0.
+                    zqn(i)=zqs(i)
+                 else
+                    rneb(i,k)=0.5*zpdf_e1(i)
+                    zqn(i)=zq(i)*zpdf_e2(i)/zpdf_e1(i)
+                 endif
+
+                 ! If vertical heterogeneity, change fraction by volume as well
+                 if (iflag_cloudth_vert>=3) then
+                   ctot_vol(i,k)=rneb(i,k)
+                   rneblsvol(i,k)=ctot_vol(i,k)
+                 endif
+
+                 endif !convergence
+
+               enddo ! boucle en i
+
+                 ! P2.A.2.2> Calcul APPROCHE de la variation de temperature DT 
+                 !         due a la condensation.
+                 ! ---------------------------------------------------------------
+                 ! Variables calculees: 
+                 ! DT : variation de temperature due a la condensation 
+
+                 if (.not. ice_thermo) then
+                 ! --------------------------
+                 do i=1,klon
+                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
+
+                 qlbef(i)=max(0.,zqn(i)-zqs(i))
+               if (fl_cor_ebil .GT. 0) then
+                 num=-Tbef(i)+zt(i)+rneb(i,k)*RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
+               else
+                 num=-Tbef(i)+zt(i)+rneb(i,k)*RLVTT/RCPD/(1.0+RVTMP2*zq(i))*qlbef(i)
+               end if
+                 denom=1.+rneb(i,k)*zdqs(i)
+                 DT(i)=num/denom
+                 n_i(i)=n_i(i)+1
+                 endif
+                 enddo
+
+                 else ! if (.not. ice_thermo)
+                 ! --------------------------
+                 if (iflag_t_glace.ge.1) then
+                 CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
+                 endif
+
+                 do i=1,klon
+                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
+                 
+                 if (iflag_t_glace.eq.0) then
+                    zfice(i) = 1.0 - (Tbef(i)-t_glace_min_old) / (RTT-t_glace_min_old)
+                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
+                    zfice(i) = zfice(i)**exposant_glace_old
+                    dzfice(i)= exposant_glace_old * zfice(i)**(exposant_glace_old-1) &
+          &                     / (t_glace_min_old - RTT)
+                 endif
+                 
+                 if (iflag_t_glace.ge.1.and.zfice(i)>0.) then
+                 dzfice(i)= exposant_glace * zfice(i)**(exposant_glace-1) &
+          &                    / (t_glace_min - t_glace_max)
+                 endif
+               
+                 if ((zfice(i).eq.0).or.(zfice(i).eq.1)) then
+                    dzfice(i)=0.
+                 endif
+
+                 if (zfice(i).lt.1) then
+                    cste=RLVTT
+                 else
+                    cste=RLSTT
+                 endif
+
+                 qlbef(i)=max(0.,zqn(i)-zqs(i))
+               if (fl_cor_ebil .GT. 0) then
+                 num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT &
+           &          +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
+                 denom = 1.+rneb(i,k)*((1-zfice(i))*RLVTT+zfice(i)*RLSTT)/cste*zdqs(i) &
+                         -(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*rneb(i,k)    &
+           &               *qlbef(i)*dzfice(i)
+               else
+                 num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT &
+           &         +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*zq(i))*qlbef(i)
+                 denom = 1.+rneb(i,k)*((1-zfice(i))*RLVTT+zfice(i)*RLSTT)/cste*zdqs(i) &
+                         -(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*zq(i))*rneb(i,k)*qlbef(i)*dzfice(i)
+               end if
+                 DT(i)=num/denom
+                 n_i(i)=n_i(i)+1
+
+                 endif ! fin convergence
+                 enddo ! fin boucle i
+
+                 endif !ice_thermo
+
+             enddo ! iter=1,iflag_fisrtilp_qsat+1
+             ! Fin d'iteration pour condensation avec variation de qsat(T) 
+             ! -----------------------------------------------------------
+           endif !  if (iflag_fisrtilp_qsat.ge.0)
+     ! ----------------------------------------------------------------
+     ! Fin de P2.A.2> la prise en compte du couplage entre eau condensee et T
+     ! ----------------------------------------------------------------
+
+        endif ! iflag_pdf
+
+!        if (iflag_fisrtilp_qsat.eq.-1) then 
+!------------------------------------------
+!CR: ATTENTION option fausse mais a existe:
+! pour la re-activer, prendre iflag_fisrtilp_qsat=0 et
+! activer les lignes suivantes: 
+       IF (1.eq.0) THEN 
+       DO i=1,klon
+           IF (rneb(i,k) .LE. 0.0) THEN
+              zqn(i) = 0.0
+              rneb(i,k) = 0.0
+              zcond(i) = 0.0
+              rhcl(i,k)=zq(i)/zqs(i)
+           ELSE IF (rneb(i,k) .GE. 1.0) THEN
+              zqn(i) = zq(i)
+              rneb(i,k) = 1.0                 
+              zcond(i) = MAX(0.0,zqn(i)-zqs(i))/(1+zdqs(i))
+              rhcl(i,k)=1.0
+           ELSE
+              zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)/(1+zdqs(i))
+              rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
+           ENDIF
+       ENDDO
+       ENDIF
+!------------------------------------------
+
+!        ELSE
+        ! ----------------------------------------------------------------
+        ! P2.A.3> Calcul des valeures finales associees a la formation des nuages
+        ! Variables calculees: 
+        !   rneb : nebulosite
+        !   zcond: eau condensee en moyenne dans la maille
+        !   zq : eau vapeur dans la maille
+        !   zt : temperature de la maille
+        !   rhcl: humidite relative ciel-clair
+        ! ----------------------------------------------------------------
+        !
+        ! Bornage de l'eau in-cloud (zqn) et de la fraction nuageuse (rneb) 
+        ! Calcule de l'eau condensee moyenne dans la maille (zcond),
+        ! et de l'humidite relative ciel-clair (rhcl)
+        DO i=1,klon
+           IF (rneb(i,k) .LE. 0.0) THEN
+              zqn(i) = 0.0
+              rneb(i,k) = 0.0
+              zcond(i) = 0.0
+              rhcl(i,k)=zq(i)/zqs(i)
+           ELSE IF (rneb(i,k) .GE. 1.0) THEN
+              zqn(i) = zq(i)
+              rneb(i,k) = 1.0
+              zcond(i) = MAX(0.0,zqn(i)-zqs(i))
+              rhcl(i,k)=1.0
+           ELSE
+              zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)
+              rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
+           ENDIF
+        ENDDO
+        ! If vertical heterogeneity, change fraction by volume as well
+        if (iflag_cloudth_vert>=3) then
+          ctot_vol(1:klon,k)=min(max(ctot_vol(1:klon,k),0.),1.)
+          rneblsvol(1:klon,k)=ctot_vol(1:klon,k)
+        endif
+
+!        ENDIF
+
+     ELSE ! de IF (cpartiel) 
+        ! -------------------------
+        ! P2.B> Nuage "tout ou rien"
+        ! -------------------------
+        ! note JLD: attention, rhcl non calcule. Ca peut avoir des consequences?
+        DO i = 1, klon
+           IF (zq(i).GT.zqs(i)) THEN
+              rneb(i,k) = 1.0
+           ELSE
+              rneb(i,k) = 0.0
+           ENDIF
+           zcond(i) = MAX(0.0,zq(i)-zqs(i))/(1.+zdqs(i))
+        ENDDO
+     ENDIF ! de IF (cpartiel) 
+
+#ifdef ISO
+        ! on calcule la compo iso de l'eau dans le nuage et en ciel
+        ! clair: zxtn/zqn et zxtcs/zqcs
+
+              ! Hypothèsesimplificatrice mais peut-être fausse: 
+              ! eau nuageuse a même composition que eau de la maille 
+
+              ! ce calcul n'eat pas sensé dépendre du type de PDF utilisé     
+         do i=1,klon  
+#ifdef ISOTRAC
+            if (option_tmin.eq.1) then
+                ! c'est mieux si zqn>=0.0
+            if (essai_convergence) then
+            else
+                zqn(i)=max(0.0,zqn(i))
+            endif    
+
+            if (rneb(i,k).lt.1.0) then
+                zqcs(i)=(zq(i)-zqn(i)*rneb(i,k))/(1.0-rneb(i,k))
+#ifdef ISOVERIF
+!                write(*,*) 'rneb,zq,zqn,zqcs=',rneb(i,k),zq(i), &
+!     &                zqn(i),zqcs(i)
+                call iso_verif_positif(zqcs(i),'ipleut 853')
+#endif                
+            else
+                zqcs(i)=0.0
+            endif
+            endif ! if (option_tmin.eq.1) then
+#endif                  
+#ifdef ISOVERIF
+              if (iso_eau.gt.0) then  
+                 call iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
+     &                   'il pleut 748',errmax,errmaxrel) 
+              endif !if (iso_eau.gt.0) then
+              do ixt=1,ntraciso
+                call iso_verif_positif_choix(zxt(ixt,i),0.0,'ilp 857')
+              enddo 
+#ifdef ISOTRAC
+              call iso_verif_traceur_pbidouille(zxt(1,i), &
+     &           'il pleut 874')
+#endif              
+#endif
+              if ((bidouille_anti_divergence).and. &
+     &           (iso_eau.gt.0)) then
+                zxt(iso_eau,i)= max(zq(i),0.0)  
+!                if (zxt(iso_eau,i).gt.0.0) then
+!                    do ixt=1,niso
+!                        zxt(ixt,i)=zxt(ixt,i)*zq(i)/zxt(iso_eau,i)
+!                    enddo
+!                else !if (zxt(iso_eau,i).gt.0.0) then
+!                    do ixt=1,niso
+!                        zxt(ixt,i)=0.0
+!                    enddo    
+!                endif !if (zxt(iso_eau,i).gt.0.0) then
+              endif !if ((bidouille_anti_divergence).and. 
+
+              if (zq(i).gt.1e-15) then   
+                ! 2 fev 2010: on modifie seuil de zq  
+                ! avant, c'était 0. Vérifier que ça n'a pas de
+                ! conséquences trop graves pour les isotopes.
+                do ixt=1,ntraciso             
+                   zxtn(ixt,i)=zqn(i)*(zxt(ixt,i)/zq(i))  
+                enddo !do ixt=1,niso         
+#ifdef ISOTRAC
+               if (option_tmin.eq.1) then
+                 do ixt=1,ntraciso
+                   zxtcs(ixt,i)=(zqcs(i))*(zxt(ixt,i)/zq(i))
+                 enddo !do ixt=1,ntraciso
+               endif ! if (option_tmin.eq.1) then
+#endif                
+              else !if (zq(i).gt.0.0) then 
+                  ! problème: zq~0 et sans compo, mais zqn >0
+                  ! on fait ce qu'on peut dans ce cas pathologique
+                do ixt=1,ntraciso           
+                   zxtn(ixt,i)=0.0              
+                enddo !do ixt=1,niso 
+#ifdef ISOTRAC
+                if (option_tmin.eq.1) then
+                 do ixt=1,ntraciso
+                   zxtcs(ixt,i)=0.0
+                 enddo !do ixt=1,niso    
+                endif ! if (option_tmin.eq.1) then
+#endif                     
+                if ((bidouille_anti_divergence) &
+     &                   .and.(iso_eau.gt.0)) then
+!                   write(*,*) 'ilp tmp 848: warning: bidouille'
+                   zxtn(iso_eau,i)=zqn(i)
+#ifdef ISOTRAC
+                   zxtn(itZonIso(izone_poubelle,iso_eau),i)=zqn(i)  
+                   if (option_tmin.eq.1) then                   
+                     zxtcs(iso_eau,i)=zqcs(i)
+                   endif ! if (option_tmin.eq.1) then
+!                   write(*,*) 'zxtn(:,i)=',zxtn(:,i)
+#endif                   
+                endif !if ((bidouille_anti_divergence)
+              endif  !if (zq(i).gt.0.0) then 
+
+#ifdef ISOVERIF
+             do ixt=1,niso     
+                  call iso_verif_positif(zxtn(ixt,i),'il pleut 1062')  
+             enddo !do ixt=1,niso
+             if (iso_eau.gt.0) then
+                   call iso_verif_egalite_choix(zxtn(iso_eau,i),zqn(i), &
+     &                   'il pleut 932',errmax,errmaxrel)
+             endif !if ((iso_eau.gt.0)) then
+#ifdef ISOTRAC
+!             write(*,*) 'zxt(:,i)=',zxt(:,i)   
+!             write(*,*) 'zq,zqn=',zq(i) ,zqn(i)  
+             call iso_verif_traceur_pbidouille(zxtn(1,i), &
+     &           'il pleut 1277')
+             if (option_tmin.eq.1) then
+              call iso_verif_positif(zxtcs(ixt,i),'il pleut 895')  
+              do ixt=1,niso     
+               call iso_verif_positif(zxtcs(ixt,i),'il pleut 897')  
+              enddo !do ixt=1,niso
+              if (iso_eau.gt.0) then
+               call iso_verif_egalite_choix(zxtcs(iso_eau,i), &
+     &              zqcs(i),'il pleut 733',errmax,errmaxrel)
+              endif !if ((iso_eau.gt.0)) then
+             endif ! if (option_tmin.eq.1) then
+#endif 
+#endif                   
+!                 write(*,*) 'il pleut 695: calcul de zxtn, i=',i
+!                 write(*,*) 'zxtn(4,i)=',zxtn(4,i)
+!                 write(*,*) 'zqn(i)=',zqn(i)
+              do ixt=1,ntraciso    
+               zxtn(ixt,i)=max(0.0,zxtn(ixt,i))          
+              enddo !do ixt=1,niso
+#ifdef ISOTRAC
+              if (option_tmin.eq.1) then
+              do ixt=1,ntraciso
+               zxtcs(ixt,i)=max(0.0,zxtcs(ixt,i))
+              enddo
+              endif ! if (option_tmin.eq.1) then
+#endif                            
+
+#ifdef ISOVERIF
+               if (iso_eau.gt.0) then
+                  call iso_verif_egalite_choix(zxtn(iso_eau,i),zqn(i), &
+     &                   'il pleut 746',errmax,errmaxrel) 
+               endif !if (iso_eau.gt.0) then
+               if (iso_HDO.gt.0) then
+                if (zqn(i).gt.ridicule) then
+                   call iso_verif_aberrant(zxtn(iso_HDO,i)/zqn(i), &
+     &                   'il pleut 977') 
+                endif  !if (zqn(i).gt.ridicule) then
+               endif  !if (iso_HDO.gt.0) then  
+#ifdef ISOTRAC               
+             call iso_verif_traceur_pbidouille  &
+     &                  (zxtn(1,i),'il pleut 1300')
+             if (option_tmin.eq.1) then
+               if (iso_eau.gt.0) then   
+                   call iso_verif_egalite_choix(zxtcs(iso_eau,i), &
+     &                   zqcs(i), &
+     &                   'il pleut 971',errmax,errmaxrel)
+               endif !if (iso_eau.gt.0) then
+               call iso_verif_traceur_pbidouille &
+     &                  (zxtcs(1,i),'il pleut 1300')
+             
+             endif ! if (option_tmin.eq.1) then
+#endif                
+#endif   
+         enddo ! do i=1,klon
+         
+!        write(*,*) 'ilp tmp 1311: zoliq,zxtoliq(1,363)=',zoliq(363),zxtoliq(1,363)
+#endif    
+     !
+     ! Mise a jour vapeur d'eau
+     ! -------------------------
+     DO i = 1, klon
+        zq(i) = zq(i) - zcond(i)
+        !         zt(i) = zt(i) + zcond(i) * RLVTT/RCPD
+     ENDDO
+!AJ<
+     ! ------------------------------------
+     ! P2.C> Prise en compte de la Chaleur latente apres formation nuage
+     ! -------------------------------------
+     ! Variable calcule:
+     !   zt : temperature de la maille
+     !
+     IF (.NOT. ice_thermo) THEN
+        if (iflag_fisrtilp_qsat.lt.1) then
+           DO i = 1, klon
+             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
+           ENDDO
+        else if (iflag_fisrtilp_qsat.gt.0) then
+           DO i= 1, klon
+    if (fl_cor_ebil .GT. 0) then
+             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
+    else
+             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i)))
+    end if
+           ENDDO
+        endif
+     ELSE
+         if (iflag_t_glace.ge.1) then
+            CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
+         endif
+         if (iflag_fisrtilp_qsat.lt.1) then
+           DO i = 1, klon
+! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
+!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
+!                                     t_glace_max, exposant_glace)
+              if (iflag_t_glace.eq.0) then
+                    zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
+                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
+                    zfice(i) = zfice(i)**exposant_glace_old
+              endif
+              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i)) &
+                       +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*zq(i))
+           ENDDO
+         else
+           DO i=1, klon
+! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
+!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
+!                                     t_glace_max, exposant_glace)
+              if (iflag_t_glace.eq.0) then
+                    zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
+                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
+                    zfice(i) = zfice(i)**exposant_glace_old
+              endif
+        if (fl_cor_ebil .GT. 0) then
+              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) & 
+           &             * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i))) &
+                      +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
+        else 
+              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i))) &
+                      +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i)))
+        end if
+           ENDDO
+         endif
+!         print*,zt(i),zrfl(i),zifl(i),'temp1'
+       ENDIF
+!>AJ
+
+      ! isotopes lors de la condensation
+#ifdef ISO          
+#ifdef ISOVERIF
+!        write(*,*) 'ilp tmp 1823'
+      do i=1,klon
+        ! verif
+        if (iso_eau.gt.0) then
+          call iso_verif_egalite_choix(zxtn(iso_eau,i),zqn(i), &
+     &           'il pleut 810',errmax,errmaxrel) 
+        endif !if (iso_eau.gt.0) then 
+#ifdef ISOTRAC
+        call iso_verif_traceur(zxtn(1,i),'il pleut 1408')
+!        write(*,*) 'fisrtilp 1421: appel condiso_liq_ice_vectall'
+#endif
+       enddo !do i=1,klon 
+!       write(*,*) 'il pleut 961: avant condensation'
+       ! end verif
+#endif
+      
+      do i=1,klon  
+!        call calcul_zfice(zt(i),zfice(i)) ! inliner pour optimisation:
+        zfice(i)=1.0-(zt(i)-pxtice)/(pxtmelt-pxtice)
+        zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
+       enddo  
+        
+        ! calcul de la composition du condensat
+        ! hypothèse simplificatrice (mais à garder en mémoire!): l'eau
+        ! nuageuse a la même composition que l'eau totale de la maille:
+        ! c'est à dire zxtn=(zxt/zq)*zqn
+        
+        call condiso_liq_ice_vectall(zxtn,zqn,zcond,zt,zfice, &
+     &            zxtice,zxtliq,klon)
+#ifdef ISOTRAC
+!#ifdef ISOVERIF
+!        write(*,*) 'il pleut 980: condensation pour les traceurs'
+!#endif        
+        call condiso_liq_ice_vectall_trac(zxtn,zqn,zcond, &
+     &            zt,zfice,zxtice,zxtliq,klon)
+#ifdef ISOVERIF
+!        write(*,*) 'ilp tmp 1859'
+        do i=1,klon             
+             call iso_verif_traceur(zxtn(1,i),'il pleut 1428a')
+             call iso_verif_traceur(zxtliq(1,i),'il pleut 1428b')
+             call iso_verif_traceur(zxtice(1,i),'il pleut 1428c')
+        enddo
+#endif
+#endif
+        do i=1,klon
+        do ixt=1,ntraciso                 
+          zxtcond(ixt,i)=zxtice(ixt,i)+zxtliq(ixt,i)
+          zxtcond(ixt,i)=max(zxtcond(ixt,i),0.0)
+          zxtcond(ixt,i)=min(zxtcond(ixt,i),zxt(ixt,i))
+        enddo !do ixt=1,niso 
+        enddo !do i=1,klon
+
+       do i=1,klon   
+       enddo  !do i=1,klon       
+        
+!#ifdef ISOVERIF
+#ifdef ISOVERIF
+        do i=1,klon
+          do ixt=1,ntraciso  
+            call iso_verif_noNAN(zxtcond(ixt,i),'il pleut 638')
+          enddo
+        enddo !do i=1,klon 
+#endif       
+#ifdef ISOVERIF       
+        if (iso_eau.gt.0) then
+          do i=1,klon      
+              call iso_verif_egalite_choix(zxtcond(iso_eau,i),zcond(i), &
+     &                   'il pleut 645',errmax,errmaxrel)
+          enddo ! do i=1,klon     
+        endif
+        if (iso_HDO.gt.0) then
+           do i=1,klon  
+                  call iso_verif_aberrant_choix(zxtcond(iso_hdo,i), &
+     &           zcond(i),ridicule_rain,deltalim_snow,'il pleut 1276')
+           enddo ! do i=1,klon  
+        endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
+#ifdef ISOTRAC
+        do i=1,klon
+             if (iso_verif_traceur_nostop(zxtcond(1,i),'il pleut 1455') &
+     &                   .eq.1) then
+               write(*,*) 'zxtn(:,i)=',zxtn(:,i)
+               write(*,*) 'zxt(:,i)=',zxt(:,i)
+               write(*,*) 'zxtliq(:,i)=',zxtliq(:,i)
+               write(*,*) 'zxtice(:,i)=',zxtice(:,i)
+               stop
+             endif
+        enddo     
+#endif         
+#endif
+
+       ! retranchage à zxt 
+      do i=1,klon 
+       do ixt=1,ntraciso
+          zxt(ixt,i)=zxt(ixt,i)-zxtcond(ixt,i)
+       enddo !do ixt=1,niso   
+      enddo !do i=1,klon 
+
+#ifdef ISOVERIF
+      do i=1,klon
+         do ixt=1,niso
+          call iso_verif_positif(zxt(ixt,i),'il pleut 1088')
+         enddo !do ixt=1,niso
+#ifdef ISOTRAC  
+         ! on sépare pour mieux débugger 8 fev 2010
+         do ixt=1,ntraciso
+          call iso_verif_positif(zxt(ixt,i),'il pleut 1093')
+         enddo !do ixt=1,niso
+#endif      
+      enddo   !do i=1,klon
+#endif
+
+#ifdef ISOTRAC        
+        if (option_tmin.ge.1) then
+        do i=1,klon    
+        ! colorier la vapeur résiduelle selon température de
+        ! condensation, et le condensat en un tag spécifique
+        ! Attention: zqn,zxtn ne servent qu'au calcul de zcond,zxtcond.
+        ! C'est en fait zxt qui se fait retranché
+        ! correction le 31 mars 2010: c'est à qn qu'il faut retrancher
+        ! le condensat, car la condensation LS est un processus sous
+        ! maille -> ne tagguer que le résidus de qn.
+          if ((zcond(i).gt.0.0).and.(zq(i).gt.0.0)) then 
+
+            if (rneb(i,k).gt.0.0) then
+              zcondn(i)=zcond(i)/rneb(i,k)
+              do ixt=1,ntraciso
+                zxtcondn(ixt,i)=zxtcond(ixt,i)/rneb(i,k)
+              enddo !do ixt=1,ntraciso
+            else !if (rneb.eq.0.0)
+              zcondn(i)=0.0
+              do ixt=1,ntraciso
+                zxtcondn(ixt,i)=0.0
+              enddo !do ixt=1,ntraciso
+#ifdef ISOVERIF
+              call iso_verif_egalite(zcond(i),0.0,'ilp 1225')
+#endif              
+            endif !if (rneb.eq.0.0)
+            
+#ifdef ISOVERIF
+          call iso_verif_egalite_choix(zxtcondn(iso_eau,i),zcondn(i), &
+     &                   'il pleut 1244',errmax*10,errmaxrel*10)
+          call iso_verif_traceur(zxtcondn(1,i),'cv3_routines 2302')
+          zq_verif=rneb(i,k)*zqn(i)+(1.0-rneb(i,k))*zqcs(i)-zcond(i)
+          call iso_verif_egalite_choix(zq(i),zq_verif, &
+     &                   'il pleut 1235',errmax,errmaxrel)
+          do ixt=1,niso
+            zq_verif=rneb(i,k)*zxtn(ixt,i) &
+     &           +(1.0-rneb(i,k))*zxtcs(ixt,i)-zxtcond(ixt,i)
+            call iso_verif_egalite_choix(zxt(ixt,i),zq_verif, &
+     &                   'il pleut 1235',errmax,errmaxrel)
+          enddo
+#endif            
+          ! bidouille
+          if (bidouille_anti_divergence) then
+                zxtcondn(iso_eau,i)=zcondn(i)
+#ifdef ISOVERIF                
+                call iso_verif_traceur_pbidouille(zxtcondn(1,i), &
+     &          'il pleut 1261')
+#endif                
+          endif
+
+            if (option_traceurs.eq.17) then      
+            call iso_recolorise_condensation(zqn(i),zcondn(i), &
+     &           zxtn(1,i),zxtcondn(1,i),zt(i),1.0,zxtres, &
+     &           seuil_tag_tmin_ls)
+            else !if (option_traceurs.eq.17) then
+                ! cas du tag 18 ou 19
+                call iso_recolorise_condensation(zqn(i),zcondn(i), &
+     &           zxtn(1,i),zxtcondn(1,i),zqs(i),1.0,zxtres, &
+     &           seuil_tag_tmin_ls)
+            endif !if (option_traceurs.eq.17) then
+            do ixt=1+niso,ntraciso
+               zxt(ixt,i)=rneb(i,k)*zxtres(ixt) &
+     &           +(1.0-rneb(i,k))*zxtcs(ixt,i)
+            enddo         
+#ifdef ISOVERIF
+         call iso_verif_traceur(zxt(1,i),'ilp 1025')
+         do izone=izone_oce,izone_ddft
+          if ((izone.eq.izone_oce).or.(izone.eq.izone_ddft)) then
+           ! avec condensation, on ne peut que perdre des traceurs à
+           ! part le tag résuel et le condensat
+           if (iso_verif_positif_choix_nostop( &
+     &           zxt_ancien(itZonIso(izone,iso_eau),i) &
+     &          -zxt(itZonIso(izone,iso_eau),i),1e-8,'ilp 1270') &
+     &          .eq.1) then
+            write(*,*) 'i,izone,rneb=',i,izone,rneb(i,k)
+            write(*,*) 'zxt(:,i)=',zxt(:,i)
+            write(*,*) 'zxt_ancien(:,i)=',zxt_ancien(:,i)
+            write(*,*) 'zxtcs(:,i)=',zxtcs(:,i)
+            write(*,*) 'zxtres(:)=',zxtres(:)
+            write(*,*) 'zxtcond(:,i)=',zxtcond(:,i)
+            write(*,*) 'zxtn(:,i)=',zxtn(:,i)
+            write(*,*) 'zxtcondn(:,i)=',zxtcondn(:,i)
+            stop
+           endif !if (iso_verif_positif_nostop(
+          endif !if ((izone.eq.izone_oce).or.(izone.eq.izone_ddft)) then
+         enddo !do izone=izone_oce,izone_revap
+#endif                     
+          endif !if (cond.gt.0.0) then
+        enddo !do i=1,klon
+
+#ifdef ISOVERIF
+        ! vérifier qu'on recolorise bien le condensat
+        call iso_verif_positif(float(option_cond-1),'ilp 1310')
+#endif        
+        endif ! if (option_tmin.ge.1) then
+
+        if (option_cond.eq.1) then
+        ! colorier le condensat en un tag spécifique
+        do i=1,klon        
+          do ixt=1+niso,ntraciso
+            if (index_zone(ixt).eq.izone_cond) then
+              zxtcond(ixt,i)=zxtcond(index_iso(ixt),i)
+            else
+              zxtcond(ixt,i)=0.0
+            endif
+          enddo !do ixt=1,ntraciso
+        enddo !do i=1,klon
+#ifdef ISOVERIF
+        do i=1,klon    
+          call iso_verif_egalite_choix(zxtcond(iso_eau,i),zcond(i), &
+     &                   'il pleut 1139',errmax,errmaxrel)
+          call iso_verif_traceur(zxtcond(1,i),'cv3_routines 2302')
+        enddo !do i=1,klon        
+#endif         
+      endif ! if (option_cond.ge.1) then
+#endif        
+     
+      
+#ifdef ISOVERIF
+!        write(*,*) 'ilp tmp 2066'
+      do i=1,klon
+         do ixt=1,niso
+          call iso_verif_positif(zxt(ixt,i),'il pleut 778')
+         enddo !do ixt=1,niso
+#ifdef ISOTRAC  
+         ! on sépare pour mieux débugger 8 fev 2010
+         do ixt=1,ntraciso
+          call iso_verif_positif(zxt(ixt,i),'il pleut 1135')
+          call iso_verif_traceur(zxt(1,i),'il pleut 1485')
+         enddo !do ixt=1,niso
+#endif
+         if (iso_eau.gt.0) then
+            call iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
+     &                   'il pleut 644',errmax,errmaxrel)
+         endif !if (iso_eau.gt.0) then
+         if (iso_HDO.gt.0) then  
+            if (zq(i).gt.ridicule) then
+             call iso_verif_aberrant_encadre(zxt(iso_HDO,i)/zq(i), &
+     &                   'il pleut 648')                 
+              if (iso_O18.gt.0) then                
+                if (iso_verif_O18_aberrant_nostop(zxt(iso_HDO,i)/zq(i), &
+     &           zxt(iso_O18,i)/zq(i),'il pleut 2059').eq.1) then
+                   write(*,*) 'i,k,zq=',i,k,zq(i)
+                   stop
+                endif !if (iso_verif_O18_aberrant_nostop
+              endif !if (iso_O18.gt.0) then
+            endif !if (zq(i).gt.ridicule) then
+         endif  ! if (iso_HDO.gt.0) then 
+        enddo  ! i=1,klon
+#ifdef ISOTRAC
+        do i=1,klon
+             call iso_verif_traceur(zxt(1,i),'il pleut 1485')
+        enddo     
+#endif         
+#endif
+#ifdef ISOVERIF   
+       do i=1,klon   
+           do ixt=1,ntraciso
+             call iso_verif_noNAN(zxtcond(ixt,i),'il pleut 1560')
+             call iso_verif_noNAN(zxt(ixt,i),'il pleut 1561')
+           enddo   ! ixt=1,niso
+        enddo  !do i=1,klon         
+#endif   
+#endif    
+     ! ----------------------------------------------------------------
+     ! P3> Formation des precipitations
+     ! ----------------------------------------------------------------
+     !
+     ! Partager l'eau condensee en precipitation et eau liquide nuageuse
+     !
+
+     ! Initialisation de zoliq (eau condensee moyenne dans la maille)
+     DO i = 1, klon
+        IF (rneb(i,k).GT.0.0) THEN
+           zoliq(i) = zcond(i)
+           zrho(i) = pplay(i,k) / zt(i) / RD
+           zdz(i) = (paprs(i,k)-paprs(i,k+1)) / (zrho(i)*RG)
+        ENDIF
+     ENDDO
+!AJ<
+     IF (.NOT. ice_thermo) THEN
+       IF (iflag_t_glace.EQ.0) THEN
+         DO i = 1, klon
+            IF (rneb(i,k).GT.0.0) THEN
+               zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (273.13-t_glace_min_old)
+               zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
+               zfice(i) = zfice(i)**exposant_glace_old
+!              zfice(i) = zfice(i)**nexpo
+         !!      zfice(i)=0.
+            ENDIF
+         ENDDO
+       ELSE ! of IF (iflag_t_glace.EQ.0)
+         CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
+!         DO i = 1, klon
+!            IF (rneb(i,k).GT.0.0) THEN
+! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
+!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
+!                                     t_glace_max, exposant_glace)
+!            ENDIF
+!         ENDDO
+       ENDIF
+     ENDIF
+
+     ! Calcul de radliq (eau condensee pour le rayonnement)
+     ! Iteration pour realiser une moyenne de l'eau nuageuse lors de la precip
+     ! Remarque: ce n'est donc pas l'eau restante en fin de precip mais une
+     ! eau moyenne restante dans le nuage sur la duree du pas de temps qui est
+     ! transmise au rayonnement;
+     ! ----------------------------------------------------------------
+     DO i = 1, klon
+        IF (rneb(i,k).GT.0.0) THEN
+           zneb(i) = MAX(rneb(i,k), seuil_neb)
+     !      zt(i) = zt(i)+zcond(i)*zfice(i)*RLMLT/RCPD/(1.0+RVTMP2*zq(i))  
+!           print*,zt(i),'fractionglace'
+!>AJ
+           radliq(i,k) = zoliq(i)/REAL(ninter+1)
+        ENDIF
+     ENDDO
+#ifdef ISO
+      ! initilsation des quantités totales d'eau liquide et solide qui
+      ! tombent
+      do i=1,klon
+         if (rneb(i,k).gt.0.0) then
+            do ixt=1,ntraciso
+               zxtoliq(ixt,i)=zxtcond(ixt,i)
+            enddo
+         endif ! if (rneb(i,k).gt.0.0)
+       enddo
+          
+#ifdef ISOVERIF
+!       write(*,*) 'ilp tmp 1626: k,zoliq,zxtoliq(1,363)=',k,zoliq(363),zxtoliq(1,363)
+       do i=1,klon   
+         do ixt=1,ntraciso
+           if (iso_verif_noNAN_nostop(zxtoliq(ixt,i), &
+     &           'il pleut 1628').eq.1) then
+             write(*,*) 'i,k,ixt=',i,k,ixt
+             write(*,*) 'rneb(i,k)=',rneb(i,k)
+             write(*,*) 'zxtcond(ixt,i)=',zxtcond(ixt,i)
+             stop
+           endif
+         enddo   ! ixt=1,niso
+        enddo  !do i=1,klon  
+#endif                
+#ifdef ISOVERIF
+       !i=519
+       !write(*,*) 'k,i,zoliq(i)=',k,i,zoliq(i)
+       do i=1,klon   
+           ! cam verif
+           if (iso_eau.gt.0) then
+            call iso_verif_egalite_choix(zxtoliq(iso_eau,i),zoliq(i), &
+     &            'il pleut 678',errmax,errmaxrel)
+           endif !if (iso_eau.gt.0) then
+           if (zoliq(i).gt.ridicule) then
+            if (iso_HDO.gt.0) then  
+                ! Camille 9 mars 2023: on est moins stricte avec le condensat
+                call iso_verif_aberrant_choix(zxtoliq(iso_HDO,i),zoliq(i), &
+     &           ridicule_rain,deltalim_snow, 'il pleut 895a')
+              if (iso_O18.gt.0) then
+                if (iso_verif_O18_aberrant_nostop(zxtoliq(iso_HDO,i)/zoliq(i), &
+     &           zxtoliq(iso_O18,i)/zoliq(i),'il pleut 895b').eq.1) then
+                   write(*,*) 'i,k,zoliq,zfice=',i,k,zoliq(i),zfice(i)
+                   !stop
+                endif
+              endif ! if (iso_HDO.gt.0) then
+            endif  !if (iso_HDO.gt.0) then
+           endif !if (zoliq(i).gt.ridicule) then
+          ! end cam verif
+         enddo ! do i=1,klon
+#endif
+#endif
+
+     !
+     DO n = 1, ninter
+        DO i = 1, klon
+           IF (rneb(i,k).GT.0.0) THEN
+              zrhol(i) = zrho(i) * zoliq(i) / zneb(i)
+              ! Initialization of zpluie and zice:
+              zpluie=0
+              zice=0
+              IF (zneb(i).EQ.seuil_neb) THEN
+                 ztot = 0.0
+              ELSE
+                 !  quantite d'eau a eliminer: zchau (Sundqvist, 1978)
+                 !  meme chose pour la glace: zfroi (Zender & Kiehl, 1997)
+                 if (ptconv(i,k)) then
+                    zcl   =cld_lc_con
+                    zct   =1./cld_tau_con
+                    zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i) &
+                         *fallvc(zrhol(i)) * zfice(i)
+                 else
+                    zcl   =cld_lc_lsc
+                    zct   =1./cld_tau_lsc
+                    zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i) &
+                         *fallvs(zrhol(i)) * zfice(i)
+                 endif
+
+                 ! si l'heterogeneite verticale est active, on utilise 
+                 ! la fraction volumique "vraie" plutot que la fraction
+                 ! surfacique modifiee, qui est plus grande et reduit
+                 ! sinon l'eau in-cloud de facon artificielle
+                 if ((iflag_cloudth_vert>=3).AND.(iflag_rain_incloud_vol==1)) then
+                    zchau    = zct   *dtime/REAL(ninter) * zoliq(i) &
+                         *(1.0-EXP(-(zoliq(i)/ctot_vol(i,k)/zcl   )**2)) *(1.-zfice(i))
+                 else
+                    zchau    = zct   *dtime/REAL(ninter) * zoliq(i) &
+                         *(1.0-EXP(-(zoliq(i)/zneb(i)/zcl   )**2)) *(1.-zfice(i))
+                 endif
+!AJ<
+                 IF (.NOT. ice_thermo) THEN
+                   ztot    = zchau + zfroi
+                 ELSE
+                   zpluie = MIN(MAX(zchau,0.0),zoliq(i)*(1.-zfice(i)))
+                   zice = MIN(MAX(zfroi,0.0),zoliq(i)*zfice(i)) 
+                   ztot    = zpluie    + zice
+                 ENDIF
+!>AJ
+                 ztot    = MAX(ztot   ,0.0)
+              ENDIF
+              ztot    = MIN(ztot,zoliq(i))
+!AJ<
+     !         zoliqp = MAX(zoliq(i)*(1.-zfice(i))-1.*zpluie   , 0.0)
+     !         zoliqi = MAX(zoliq(i)*zfice(i)-1.*zice   , 0.0)
+!JLD : les 2 variables zoliqp et zoliqi crorresponent a des pseudo precip
+!      temporaires et ne doivent pas etre calcule (alors qu'elles le sont
+!      si iflag_bergeron <> 2
+!      A SUPPRIMER A TERME
+              zoliqp(i) = MAX(zoliq(i)*(1.-zfice(i))-1.*zpluie  , 0.0)
+              zoliqi(i) = MAX(zoliq(i)*zfice(i)-1.*zice  , 0.0)
+              zoliq(i) = MAX(zoliq(i)-ztot   , 0.0)
+!>AJ
+              radliq(i,k) = radliq(i,k) + zoliq(i)/REAL(ninter+1)
+           ENDIF
+        ENDDO  ! i = 1,klon
+     ENDDO     ! n = 1,ninter
+
+     ! ----------------------------------------------------------------
+     !
+#ifdef ISO
+      do i=1,klon
+       IF (rneb(i,k).GT.0.0) THEN
+        if (zcond(i).gt.ridicule**2) then
+            ! le 21 dec: on change .gt.0 en .gt.ridicule**2 pour éviter valeur
+            ! ridiculement petites
+           do ixt=1,ntraciso
+             zxtoliq(ixt,i)=zoliq(i)*(zxtcond(ixt,i)/zcond(i))
+           enddo !do ixt=1,niso           
+        else !if (zcond(i).gt.0.0) then            
+           if (zoliq(i).lt.ridicule) then
+               do ixt=1,ntraciso
+                zxtoliq(ixt,i)=0.0
+               enddo
+           else !if (zoliq(i).lt.ridicule) then
+               ! modif 28 oct 2008
+              do ixt=1,niso
+                zxtoliq(ixt,i)=zoliq(i)*Rdefault(ixt)
+              enddo !do ixt=1,niso
+#ifdef ISOTRAC
+              do ixt=niso+1,ntraciso
+                if (index_zone(ixt).eq.izone_poubelle) then
+                    zxtoliq(ixt,i)=zoliq(i)*Rdefault(ixt)
+                else
+                    zxtoliq(ixt,i)=0.0
+                endif
+              enddo  
+#endif    
+#ifdef ISOVERIF                   
+              write(*,*) 'il pleut 1412: zcond(i)=',zcond(i)
+              write(*,*) 'zoliq(i)=',zoliq(i)
+              stop
+#endif                   
+            endif   !if (zoliq(i).lt.ridicule) then         
+        endif !if (zcond(i).gt.0.0) then
+       endif !IF (rneb(i,k).GT.0.0) THEN
+      enddo ! do i=1,klon 
+           
+         ! cam verif
+#ifdef ISOVERIF
+      do i=1,klon  
+        IF (rneb(i,k).GT.0.0) THEN 
+           do ixt=1,niso
+             call iso_verif_noNAN(zxtoliq(ixt,i),'il pleut 718')
+           ! end cam verif
+           enddo ! do ixt=1,niso
+          ! cam verif
+        endif !IF (rneb(i,k).GT.0.0) THEN 
+      enddo !do i=1,klon  
+#endif
+#ifdef ISOVERIF
+      do i=1,klon  
+        IF (rneb(i,k).GT.0.0) THEN
+          if (iso_eau.gt.0) then
+            call iso_verif_egalite_choix(zxtoliq(iso_eau,i),zoliq(i), &
+     &           'il pleut 749',errmax,errmaxrel)
+          endif !if (iso_eau.gt.0) then
+          if (iso_HDO.gt.0) then
+                call iso_verif_aberrant_choix(zxtoliq(iso_HDO,i),zoliq(i), &
+     &           ridicule_rain, deltalim_snow, 'il pleut 963')
+          endif !if (iso_HDO.gt.0) then
+        ! end cam verif
+#ifdef ISOTRAC
+!             write(*,*) 'ilp 1201 tmp: i=',i
+!             write(*,*) 'zoliq(i)=',zoliq(i)
+!             write(*,*) 'zxtoliq(i)=',zxtoliq(iso_eau:ntraciso:3,i)
+!             write(*,*) 'zcond(i)=',zcond(i)
+!             write(*,*) 'zxtcond(i)=',zxtcond(iso_eau:ntraciso:3,i)
+             call iso_verif_traceur(zxtoliq(1,i),'il pleut 1634')
+#endif        
+         endif !IF (rneb(i,k).GT.0.0) THEN
+       enddo ! do i=1,klon
+#endif        
+#endif      
+     IF (.NOT. ice_thermo) THEN
+       DO i = 1, klon
+         IF (rneb(i,k).GT.0.0) THEN
+           d_ql(i,k) = zoliq(i)
+           zrfl(i) = zrfl(i)+ MAX(zcond(i)-zoliq(i),0.0) &
+                * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
+
+#ifdef ISO   
+         do ixt=1,ntraciso
+            d_xtl(ixt,i,k)=zxtoliq(ixt,i)
+         enddo ! do ixt=1,niso   
+            ! Rq: 28 oct 2008: si zoliq a la même compo que zcond, alors
+            ! on évite pb numériques si on prend directement zrfl avec
+            ! la compo de zcond?
+!          do ixt=1,niso  
+!            zxtrfl(ixt,i)=zxtrfl(ixt,i) &
+!     &           +max(zxtcond(ixt,i)-zxtoliq(ixt,i),0.0) &
+!     &           * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
+!          enddo  
+            if (zcond(i).gt.ridicule**2) then
+                ! modif le 19 dec 2012 pour éviter zcond pathologiquement petits
+                do ixt=1,ntraciso
+                  zxtrfl(ixt,i)=zxtrfl(ixt,i) &
+     &                  +(zxtcond(ixt,i)/zcond(i)) &
+     &                  * MAX(zcond(i)-zoliq(i),0.0) &
+     &                  * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
+                enddo !do ixt=1,niso
+            else !if (zcond(i).gt.0.0) then
+                if (zcond(i)-zoliq(i).gt.0.0) then
+                    do ixt=1,niso
+                        zxtrfl(ixt,i)=zxtrfl(ixt,i) &
+     &                  +Rdefault(ixt) &
+     &                  * MAX(zcond(i)-zoliq(i),0.0) &
+     &                  * (paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
+                    enddo !do ixt=1,niso  
+#ifdef ISOVERIF                   
+                    write(*,*) 'il pleut 1023: zcond(i)=',zcond(i)
+                    write(*,*) 'zcond(i),zoliq(i)=',zcond(i),zoliq(i)
+                    stop
+#endif        
+#ifdef ISOTRAC
+                   do ixt=niso+1,ntraciso
+                      if (index_zone(ixt).eq.izone_poubelle) then
+                        zxtrfl(ixt,i)=zxtrfl(ixt,i) &
+     &                  +Rdefault(ixt) &
+     &                  * MAX(zcond(i)-zoliq(i),0.0) &
+     &                  * (paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
+                      endif
+                    enddo !do ixt=1,niso
+#endif                 
+                else !if (zcond(i)-zoliq(i).gt.0.0) then
+                    ! zrfl non modifié
+                endif !if (zcond(i)-zoliq(i).gt.0.0) then
+            endif !if (zcond(i).gt.0.0) then
+
+         ! cam verif         
+!#ifdef ISOVERIF
+#ifdef ISOVERIF
+            do ixt=1,ntraciso
+             if ((iso_verif_noNAN_nostop(zxtrfl(ixt,i), &
+     &                   'il pleut 772').eq.1).or. &
+     &                   (iso_verif_noNAN_nostop(zxtoliq(ixt,i), &
+     &                   'il pleut 772b').eq.1)) then
+               write(*,*) 'zcond(i)=',zcond(i)
+               write(*,*) 'zxtcond(ixt,i)=',zxtcond(ixt,i)
+               write(*,*) 'zoliq(i)=',zoliq(i)
+               write(*,*) 'Rdefault(ixt)=',Rdefault(ixt)
+               write(*,*) 'paprs(i,k),paprs(i,k+1)=',paprs(i,k),paprs(i,k+1)
+               stop
+             endif
+            enddo
+#endif
+#ifdef ISOVERIF
+            if (iso_eau.gt.0) then
+              call iso_verif_egalite_choix(d_xtl(iso_eau,i,k), &
+     &           d_ql(i,k),'il pleut 771',errmax,errmaxrel)
+              if (iso_verif_egalite_choix_nostop( &
+     &           zxtrfl(iso_eau,i),zrfl(i), &
+     &           'il pleut 771b',errmax,errmaxrel).eq.1)then
+                 write(*,*) 'trace_cas(i)=',trace_cas(i)
+                 write(*,*) 'zxtcond(iso_eau,i)',zxtcond(iso_eau,i)
+                 write(*,*) 'zcond(i)',zcond(i)
+                 write(*,*) 'zxtoliq(iso_eau,i)',zxtoliq(iso_eau,i)
+                 write(*,*) 'zoliq(i)',zoliq(i)
+                 stop
+              endif
+            endif !if (iso_eau.gt.0) then
+            if (iso_HDO.gt.0) then
+                IF ((t(i,1)) .LT. RTT) THEN
+                call iso_verif_aberrant_choix(zxtrfl(iso_hdo,i), &
+     &           zrfl(i),ridicule_rain,deltalim_snow,'il pleut 1458')
+                endif
+            endif !if (iso_HDO.gt.0) then
+#ifdef ISOTRAC
+             call iso_verif_traceur(zxtrfl(1,i),'il pleut 1729')
+#endif            
+#endif
+         ! bidouille
+         if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then 
+               zxtrfl(iso_eau,i)= zrfl(i)   
+!             if (zxtrfl(iso_eau,i).gt.0.0) then
+!             do ixt=1,niso
+!               zxtrfl(ixt,i)=zxtrfl(ixt,i)*zrfl(i)/zxtrfl(iso_eau,i)
+!             enddo
+!           endif !if (zxtrfl(iso_eau,i).gt.0.0) then
+         endif ! if (bidouille_anti_divergence) then
+         ! end bidouille
+         ! end cam verif
+#endif
+         ENDIF !IF (rneb(i,k).GT.0.0) THEN
+       ENDDO
+     ELSE
+
+#ifdef ISO
+        CALL abort_physic('ilp 2347', 'isotopes pas encore prevus ici', 1)
+#endif
+!
+!CR&JYG<
+! On prend en compte l'effet Bergeron dans les flux de precipitation :
+! Si T < 0 C, alors les precipitations liquides sont converties en glace, ce qui
+! provoque un accroissement de temperature DeltaT. L'effet de DeltaT sur le condensat
+! et les precipitations est grossierement pris en compte en linearisant les equations 
+! et en approximant le processus de precipitation liquide par un processus a seuil.
+! On fait l'hypothese que le condensat nuageux n'est pas modifié dans cette opération.
+! Le condensat precipitant liquide est supprime (dans la limite DeltaT<273-T).
+! Le condensat precipitant solide est augmente.
+! La vapeur d'eau est augmentee.
+!
+       IF ((iflag_bergeron .EQ. 2)) THEN
+         DO i = 1, klon
+           IF (rneb(i,k) .GT. 0.0) THEN
+             zqpreci(i)=(zcond(i)-zoliq(i))*zfice(i)
+             zqprecl(i)=(zcond(i)-zoliq(i))*(1.-zfice(i))
+           if (fl_cor_ebil .GT. 0) then
+             zcp=RCPD*(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
+             coef1 = rneb(i,k)*RLSTT/zcp*zdqsdT_raw(i)
+!            Calcul de DT si toute les precips liquides congelent
+             DeltaT = RLMLT*zqprecl(i) / (zcp*(1.+coef1))
+!            On ne veut pas que T devienne superieur a la temp. de congelation.
+!            donc que Delta > RTT-zt(i
+             DeltaT = max( min( RTT-zt(i), DeltaT) , 0. )
+             zt(i)      = zt(i)      + DeltaT
+!            Eau vaporisee du fait de l'augmentation de T
+             Deltaq = rneb(i,k)*zdqsdT_raw(i)*DeltaT
+!            on reajoute cette eau vaporise a la vapeur et on l'enleve des precips
+             zq(i) = zq(i) +  Deltaq
+!            Les 3 max si dessous prtotegent uniquement des erreurs d'arrondies
+             zcond(i)   = max( zcond(i)- Deltaq, 0. )
+!            precip liquide qui congele ou qui s'evapore
+             Deltaqprecl = -zcp/RLMLT*(1.+coef1)*DeltaT
+             zqprecl(i) = max( zqprecl(i) + Deltaqprecl, 0. )
+!            bilan eau glacee
+             zqpreci(i) = max (zqpreci(i) - Deltaqprecl - Deltaq, 0.)
+           else ! if (fl_cor_ebil .GT. 0)
+!            ancien calcul
+             zcp=RCPD*(1.0+RVTMP2*(zq(i)+zcond(i)))
+             coef1 = RLMLT*zdqs(i)/RLVTT
+             DeltaT = max( min( RTT-zt(i), RLMLT*zqprecl(i)/zcp/(1.+coef1) ) , 0.)
+             zqpreci(i) = zqpreci(i) + zcp/RLMLT*DeltaT
+             zqprecl(i) = max( zqprecl(i) - zcp/RLMLT*(1.+coef1)*DeltaT, 0. )
+             zcond(i)   = max( zcond(i)   - zcp/RLVTT*zdqs(i)*DeltaT, 0. )
+             zq(i)      = zq(i)      + zcp/RLVTT*zdqs(i)*DeltaT
+             zt(i)      = zt(i)      + DeltaT
+           end if ! if (fl_cor_ebil .GT. 0)
+           ENDIF  ! rneb(i,k) .GT. 0.0
+         ENDDO
+         DO i = 1, klon
+           IF (rneb(i,k).GT.0.0) THEN
+             d_ql(i,k) = (1-zfice(i))*zoliq(i)
+             d_qi(i,k) = zfice(i)*zoliq(i)
+             zrfl(i) = zrfl(i)+ zqprecl(i) &
+                 *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
+             zifl(i) = zifl(i)+ zqpreci(i) &
+                      *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)  
+           ENDIF                      
+         ENDDO
+!!
+       ELSE  ! iflag_bergeron
+!>CR&JYG
+!!
+       DO i = 1, klon
+         IF (rneb(i,k).GT.0.0) THEN
+!CR on prend en compte la phase glace
+!JLD inutile car on ne passe jamais ici si .not.ice_thermo
+!           if (.not.ice_thermo) then
+!           d_ql(i,k) = zoliq(i)
+!           d_qi(i,k) = 0.
+!           else
+           d_ql(i,k) = (1-zfice(i))*zoliq(i)
+           d_qi(i,k) = zfice(i)*zoliq(i)
+!           endif
+!AJ<
+           zrfl(i) = zrfl(i)+ MAX(zcond(i)*(1.-zfice(i))-zoliqp(i),0.0) &
+               *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
+           zifl(i) = zifl(i)+ MAX(zcond(i)*zfice(i)-zoliqi(i),0.0) &
+                    *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)  
+     !      zrfl(i) = zrfl(i)+  zpluie                         &
+     !          *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
+     !      zifl(i) = zifl(i)+  zice                    &
+     !               *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)                                    
+
+!CR : on prend en compte l'effet Bergeron dans les flux de precipitation
+           IF ((iflag_bergeron .EQ. 1) .AND. (zt(i) .LT. 273.15)) THEN
+              zsolid = zrfl(i)
+              zifl(i) = zifl(i)+zrfl(i)
+              zrfl(i) = 0.
+           if (fl_cor_ebil .GT. 0) then
+              zt(i)=zt(i)+zsolid*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
+                      *(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
+           else
+              zt(i)=zt(i)+zsolid*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
+                      *(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*zq(i))
+           end if
+           ENDIF  ! (iflag_bergeron .EQ. 1) .AND. (zt(i) .LT. 273.15)
+!RC   
+
+         ENDIF ! rneb(i,k).GT.0.0
+       ENDDO
+
+       ENDIF  ! iflag_bergeron .EQ. 2
+     ENDIF  ! .NOT. ice_thermo
+
+!CR: la fonte est faite au debut
+!      IF (ice_thermo) THEN
+!       DO i = 1, klon
+!           zmelt = ((zt(i)-273.15)/(ztfondue-273.15))**2
+!           zmelt = MIN(MAX(zmelt,0.),1.)
+!           zrfl(i)=zrfl(i)+zmelt*zifl(i)
+!           zifl(i)=zifl(i)*(1.-zmelt)
+!           print*,zt(i),'octavio1'
+!           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
+!                      *RLMLT/RCPD/(1.0+RVTMP2*zq(i))
+!           print*,zt(i),zrfl(i),zifl(i),zmelt,'octavio2'
+!       ENDDO
+!     ENDIF
+
+       
+     IF (.NOT. ice_thermo) THEN
+       DO i = 1, klon
+         IF (zt(i).LT.RTT) THEN
+           psfl(i,k)=zrfl(i)
+#ifdef ISO
+         do ixt=1,ntraciso
+           pxtsnowfl(ixt,i,k)=zxtrfl(ixt,i)
+         enddo
+#endif
+         ELSE
+           prfl(i,k)=zrfl(i)
+#ifdef ISO
+         do ixt=1,ntraciso
+           pxtrainfl(ixt,i,k)=zxtrfl(ixt,i)
+         enddo         
+#endif
+         ENDIF
+       ENDDO
+     ELSE ! if ice_thermo
+     ! JAM*************************************************
+     ! Revoir partie ci-dessous: a quoi servent psfl et prfl?
+     ! *****************************************************
+
+#ifdef ISO
+     CALL abort_physic('ilp 2465', 'isos pas prevus ici', 1)   
+#endif
+       DO i = 1, klon
+     !   IF (zt(i).LT.RTT) THEN
+           psfl(i,k)=zifl(i) 
+     !   ELSE
+           prfl(i,k)=zrfl(i)
+     !   ENDIF
+!>AJ
+       ENDDO
+     ENDIF
+
+#ifdef ISO
+#ifdef ISOVERIF
+      DO i = 1, klon
+        if (iso_eau.gt.0) then
+          call iso_verif_egalite_choix(pxtrainfl(iso_eau,i,k),prfl(i,k), & 
+     &           'il pleut 804',errmax,errmaxrel)
+          call iso_verif_egalite_choix(pxtsnowfl(iso_eau,i,k),psfl(i,k), &  
+     &           'il pleut 805',errmax,errmaxrel) 
+          call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &  
+     &           'il pleut 1612',errmax,errmaxrel) 
+          if (iso_verif_positif_choix_nostop(pxtrainfl(iso_eau,i,k), &
+     &           ridicule_rain,'ilp 1547').eq.1) then
+            write(*,*) 'prfl(i,k)=',prfl(i,k)
+            stop
+          endif  
+        endif !if (iso_eau.gt.0) then
+        if (iso_HDO.gt.0) then
+          if (prfl(i,k).gt.ridicule_rain) then
+            call iso_verif_aberrant(pxtrainfl(iso_HDO,i,k)/prfl(i,k), &
+     &            'il pleut 1020')
+          endif !if (prfl(i,k).gt.ridicule_rain) then           
+          call iso_verif_aberrant_choix(pxtsnowfl(iso_HDO,i,k),psfl(i,k), &
+     &           ridicule_rain, deltalim_snow, 'il pleut 1024')
+          if (zq(i).gt.ridicule) then
+              call iso_verif_aberrant_encadre(zxt(iso_HDO,i)/zq(i), &
+     &           'il pleut 1204')
+          endif !if (zq(i).gt.ridicule) then          
+         endif !if (iso_HDO.gt.0) then
+#ifdef ISOTRAC
+          call iso_verif_traceur(zxt(1,i),'il pleut 1792')
+          call iso_verif_traceur(pxtsnowfl(1,i,k),'il pleut 1793')
+          call iso_verif_traceur(pxtrainfl(1,i,k),'il pleut 1794')
+#endif         
+       ENDDO !DO i = 1, klon  
+#endif
+#endif 
+     ! ----------------------------------------------------------------
+     ! Fin de formation des precipitations
+     ! ----------------------------------------------------------------
+     !
+     ! Calculer les tendances de q et de t:
+     !
+     DO i = 1, klon
+        d_q(i,k) = zq(i) - q(i,k)
+#ifdef ISO
+         do ixt=1,ntraciso
+             d_xt(ixt,i,k)=zxt(ixt,i)-xt(ixt,i,k)   
+         enddo
+         ! cam verif
+#ifdef ISOVERIF
+           if (iso_eau.gt.0) then
+             if (iso_verif_egalite_choix_nostop(d_xt(iso_eau,i,k), &
+     &            d_q(i,k),'il pleut 838',errmax,errmaxrel).eq.1) then
+                write(*,*) 'i,k=',i,k
+                write(*,*) 'zxt,zq=',zxt(iso_eau,i),zq(i)
+                write(*,*) 'xt,q=',xt(iso_eau,i,k),q(i,k)
+                stop
+             endif
+           endif !if (iso_eau.gt.0) then
+           if (1.eq.0) then
+           if (iso_HDO.gt.0) then
+            if (abs(d_q(i,k)).gt.max(errmaxrel*q(i,k),errmax)) then
+              if (iso_verif_aberrant_nostop( &
+     &           d_xt(iso_HDO,i,k)/d_q(i,k),'il pleut 1229').eq.1) then
+!                write(*,*) 'd_q(i,k)=',d_q(i,k)
+!                write(*,*) 'q(i,k)=',q(i,k)
+!                write(*,*) 'zq(i)=',zq(i)
+!                write(*,*) 'deltaD_prec=',deltaD(xt(iso_HDO,i,k)/q(i,k))
+!                write(*,*) 'deltaD=',deltaD(zxt(iso_HDO,i)/zq(i))
+!                stop       
+              endif !   if (iso_verif_aberrant_nostop(
+            endif !if (zq(i).gt.ridicule) then          
+           endif !if (iso_HDO.gt.0) then
+          endif !if (1.eq.0) then
+#endif
+         ! end cam verif
+#endif
+        d_t(i,k) = zt(i) - t(i,k)
+     ENDDO
+     !
+     !AA--------------- Calcul du lessivage stratiforme  -------------
+
+     DO i = 1,klon
+        !
+        if(zcond(i).gt.zoliq(i)+1.e-10) then
+         beta(i,k) = (zcond(i)-zoliq(i))/zcond(i)/dtime
+        else
+         beta(i,k) = 0.
+        endif
+        zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0) &
+             * (paprs(i,k)-paprs(i,k+1))/RG
+        IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
+           !AA lessivage nucleation LMD5 dans la couche elle-meme
+          IF (iflag_t_glace.EQ.0) THEN
+           if (t(i,k) .GE. t_glace_min_old) THEN
+              zalpha_tr = a_tr_sca(3)
+           else
+              zalpha_tr = a_tr_sca(4)
+           endif
+          ELSE ! of IF (iflag_t_glace.EQ.0)
+           if (t(i,k) .GE. t_glace_min) THEN
+              zalpha_tr = a_tr_sca(3)
+           else
+              zalpha_tr = a_tr_sca(4)
+           endif
+          ENDIF
+           zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
+           pfrac_nucl(i,k)=pfrac_nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
+           frac_nucl(i,k)= 1.-zneb(i)*zfrac_lessi 
+           !
+           ! nucleation avec un facteur -1 au lieu de -0.5
+           zfrac_lessi = 1. - EXP(-zprec_cond(i)/zneb(i))
+           pfrac_1nucl(i,k)=pfrac_1nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
+        ENDIF
+        !
+     ENDDO      ! boucle sur i
+     !
+     !AA Lessivage par impaction dans les couches en-dessous
+     DO kk = k-1, 1, -1
+        DO i = 1, klon
+           IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
+             IF (iflag_t_glace.EQ.0) THEN
+              if (t(i,kk) .GE. t_glace_min_old) THEN
+                 zalpha_tr = a_tr_sca(1)
+              else
+                 zalpha_tr = a_tr_sca(2)
+              endif
+             ELSE ! of IF (iflag_t_glace.EQ.0)
+              if (t(i,kk) .GE. t_glace_min) THEN
+                 zalpha_tr = a_tr_sca(1)
+              else
+                 zalpha_tr = a_tr_sca(2)
+              endif
+             ENDIF
+              zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
+              pfrac_impa(i,kk)=pfrac_impa(i,kk)*(1.-zneb(i)*zfrac_lessi)
+              frac_impa(i,kk)= 1.-zneb(i)*zfrac_lessi
+           ENDIF
+        ENDDO
+     ENDDO !DO kk = k-1, 1, -1
+
+#ifdef ISO      
+      ! verif en fin de boucle
+#ifdef ISOVERIF
+      if (iso_eau.gt.0) then
+        do i=1,klon       
+        call iso_verif_egalite_choix(zxtrfl(iso_eau,i) &
+     &      ,zrfl(i), 'il pleut 1089',errmax,errmaxrel)
+        call iso_verif_egalite_choix(d_xtl(iso_eau,i,k),d_ql(i,k), &
+     &           'il pleut 1205',errmax,errmaxrel) 
+#ifdef ISOTRAC
+        call iso_verif_traceur(zxtrfl(1,i),'il pleut 1894')
+        call iso_verif_traceur(d_xtl(1,i,k),'il pleut 1895')
+#endif        
+        enddo !do i=1,klon
+      endif !  if (iso_eau.gt.0) then        
+#endif
+#endif      
+      ! end verif en fin de boucle
+
+     !
+     !AA===============================================================
+     !                     FIN DE LA BOUCLE VERTICALE  
+  end DO
+  !
+  !AA==================================================================
+  !
+  ! Pluie ou neige au sol selon la temperature de la 1ere couche
+  !
+!CR: si la thermo de la glace est active, on calcule zifl directement
+  IF (.NOT.ice_thermo) THEN
+  DO i = 1, klon
+     IF ((t(i,1)+d_t(i,1)) .LT. RTT) THEN
+!AJ<
+!        snow(i) = zrfl(i)
+        snow(i) = zrfl(i)+zifl(i)
+!>AJ
+        zlh_solid(i) = RLSTT-RLVTT
+#ifdef ISO
+        do ixt=1,ntraciso
+          xtsnow(ixt,i) = zxtrfl(ixt,i)
+        enddo !do ixt=1,ntraciso
+#endif
+     ELSE
+        rain(i) = zrfl(i)
+        zlh_solid(i) = 0.
+#ifdef ISO
+        do ixt=1,ntraciso
+          xtrain(ixt,i) = zxtrfl(ixt,i)
+        enddo !do ixt=1,ntraciso
+#endif
+     ENDIF
+#ifdef ISO
+      ! cam verif 
+#ifdef ISOVERIF
+       do ixt=1,ntraciso
+        call iso_verif_noNAN(xtrain(ixt,i),'il pleut 927')
+        call iso_verif_noNAN(xtsnow(ixt,i),'il pleut 927')
+       enddo ! do ixt=1,niso
+#endif         
+#ifdef ISOVERIF
+       if (iso_eau.gt.0) then
+        call iso_verif_egalite_choix(xtrain(iso_eau,i),rain(i), &
+     &           'il pleut 926a',errmax,errmaxrel)  
+        if (snow(i)*dtime.gt.ridicule) then
+           call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
+     &            'il pleut 938a',errmax,errmaxrel)
+        endif !if (snow(i)*dtime.gt.ridicule) then
+       endif !if (iso_eau.gt.0) then
+       if (iso_HDO.gt.0) then
+           call iso_verif_aberrant_choix(xtrain(iso_hdo,i),rain(i), &
+     &           ridicule_rain,deltalim,'il pleut 926b')  
+           call iso_verif_aberrant_choix(xtsnow(iso_hdo,i),snow(i), &
+     &            ridicule_rain,deltalim_snow,'il pleut 938b')
+       endif !if (iso_eau.gt.0) then
+#ifdef ISOTRAC
+       call iso_verif_traceur(xtrain(1,i),'il pleut 1952')
+       call iso_verif_traceur(xtsnow(1,i),'il pleut 1953')
+#endif       
+#endif
+       ! end cam verif   
+#endif
+  ENDDO
+
+  ELSE
+#ifdef ISO
+        CALL abort_physic('ilp 2708', 'isos pas prevus ici', 1)
+#endif
+     DO i = 1, klon
+        snow(i) = zifl(i)
+        rain(i) = zrfl(i)
+     ENDDO
+   
+   ENDIF
+  !
+  ! For energy conservation : when snow is present, the solification
+  ! latent heat is considered.
+!CR: si thermo de la glace, neige deja prise en compte
+  IF (.not.ice_thermo) THEN
+  DO k = 1, klev
+     DO i = 1, klon
+        zcpair=RCPD*(1.0+RVTMP2*(q(i,k)+d_q(i,k)))
+        zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
+        zm_solid = (prfl(i,k)-prfl(i,k+1)+psfl(i,k)-psfl(i,k+1))*dtime
+        d_t(i,k) = d_t(i,k) + zlh_solid(i) *zm_solid / (zcpair*zmair(i))
+     END DO
+  END DO
+  ENDIF
+  !
+
+  if (ncoreczq>0) then
+     WRITE(lunout,*)'WARNING : ZQ dans fisrtilp ',ncoreczq,' val < 1.e-15.'
+  endif
+
+
+#ifdef ISO
+      ! verif en sortie de il pleut 
+#ifdef ISOVERIF
+       do k=1,klev
+        do i=1,klon
+         if (iso_eau.gt.0) then
+           call iso_verif_egalite_choix(d_xtl(iso_eau,i,k),d_ql(i,k), &
+     &            'il pleut 1289',errmax,errmaxrel)
+         endif !if (iso_eau.gt.0) then
+#ifdef ISOTRAC
+         call iso_verif_traceur(d_xtl(1,i,k),'il pleut 1982')
+#endif
+        enddo !do i=1,klon
+       enddo !do k=1,klev
+#endif
+      ! end verif
+#endif
+
+END SUBROUTINE fisrtilp
+END MODULE lmdz_lscp_old
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_lscp_tools.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_lscp_tools.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_lscp_tools.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_lscp_tools.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_ratqs_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_ratqs_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_ratqs_ini.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_ratqs_ini.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_ratqs_main.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_ratqs_main.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_ratqs_main.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_ratqs_main.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_ratqs_multi.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_ratqs_multi.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_ratqs_multi.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_ratqs_multi.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_alim.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_alim.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_alim.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_alim.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_alp.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_alp.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_alp.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_alp.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_closure.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_closure.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_closure.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_closure.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_down.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_down.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_down.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_down.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_dq.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_dq.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_dq.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_dq.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_dry.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_dry.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_dry.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_dry.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_dtke.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_dtke.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_dtke.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_dtke.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_dv2.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_dv2.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_dv2.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_dv2.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_env.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_env.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_env.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_env.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_flux2.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_flux2.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_flux2.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_flux2.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_height.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_height.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_height.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_height.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_ini.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_ini.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_main.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_main.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_main.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_main.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_old.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_old.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_old.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_old.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_plume.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_plume.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_plume.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_plume.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_plume_6A.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_plume_6A.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_plume_6A.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_plume_6A.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_qsat.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_qsat.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_thermcell_qsat.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_thermcell_qsat.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_wake.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_wake.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_wake.F90	(revision 4727)
@@ -0,0 +1,2629 @@
+MODULE lmdz_wake
+! $Id: wake.F90 3648 2020-03-16 15:36:59Z jghattas $
+CONTAINS
+SUBROUTINE wake(znatsurf, p, ph, pi, dtime, &
+                te0, qe0, omgb, &
+                dtdwn, dqdwn, amdwn, amup, dta, dqa, wgen, &
+                sigd_con, Cin, &
+                deltatw, deltaqw, sigmaw, awdens, wdens, &                  ! state variables
+                dth, hw, wape, fip, gfl, &
+                dtls, dqls, ktopw, omgbdth, dp_omgb, tu, qu, &
+                dtke, dqke, omg, dp_deltomg, spread, cstar, &
+                d_deltat_gw, &
+                d_deltatw2, d_deltaqw2, d_sigmaw2, d_awdens2, d_wdens2 &     ! tendencies
+
+#ifdef ISO
+                     ,xte0,dxtdwn,dxta,deltaxtw &
+                     ,dxtls,xtu,dxtke,d_deltaxtw2 &
+#endif                  
+                )  
+
+
+  ! **************************************************************
+  ! *
+  ! WAKE                                                        *
+  ! retour a un Pupper fixe                                *
+  ! *
+  ! written by   :  GRANDPEIX Jean-Yves   09/03/2000            *
+  ! modified by :   ROEHRIG Romain        01/29/2007            *
+  ! **************************************************************
+
+  USE ioipsl_getin_p_mod, ONLY : getin_p
+  USE dimphy
+  use mod_phys_lmdz_para
+  USE print_control_mod, ONLY: prt_level
+#ifdef ISO
+  USE infotrac_phy, ONLY : ntraciso=>ntiso
+#ifdef ISOVERIF
+  USE isotopes_verif_mod
+!, ONLY: errmax,errmaxrel
+  USE isotopes_mod, ONLY: iso_eau,iso_hdo,ridicule
+#endif
+#endif
+  IMPLICIT NONE
+  ! ============================================================================
+
+
+  ! But : Decrire le comportement des poches froides apparaissant dans les
+  ! grands systemes convectifs, et fournir l'energie disponible pour
+  ! le declenchement de nouvelles colonnes convectives.
+
+  ! State variables : 
+  ! deltatw    : temperature difference between wake and off-wake regions
+  ! deltaqw    : specific humidity difference between wake and off-wake regions
+  ! sigmaw     : fractional area covered by wakes.
+  ! wdens      : number of wakes per unit area
+
+  ! Variable de sortie :
+
+  ! wape : WAke Potential Energy
+  ! fip  : Front Incident Power (W/m2) - ALP
+  ! gfl  : Gust Front Length per unit area (m-1)
+  ! dtls : large scale temperature tendency due to wake
+  ! dqls : large scale humidity tendency due to wake
+  ! hw   : wake top hight (given by hw*deltatw(1)/2=wape)
+  ! dp_omgb : vertical gradient of large scale omega
+  ! awdens  : densite de poches actives
+  ! wdens   : densite de poches
+  ! omgbdth: flux of Delta_Theta transported by LS omega
+  ! dtKE   : differential heating (wake - unpertubed)
+  ! dqKE   : differential moistening (wake - unpertubed)
+  ! omg    : Delta_omg =vertical velocity diff. wake-undist. (Pa/s)
+  ! dp_deltomg  : vertical gradient of omg (s-1)
+  ! spread  : spreading term in d_t_wake and d_q_wake
+  ! deltatw     : updated temperature difference (T_w-T_u).
+  ! deltaqw     : updated humidity difference (q_w-q_u).
+  ! sigmaw      : updated wake fractional area.
+  ! d_deltat_gw : delta T tendency due to GW
+
+  ! Variables d'entree :
+
+  ! aire : aire de la maille
+  ! te0  : temperature dans l'environnement  (K)
+  ! qe0  : humidite dans l'environnement     (kg/kg)
+  ! omgb : vitesse verticale moyenne sur la maille (Pa/s)
+  ! dtdwn: source de chaleur due aux descentes (K/s)
+  ! dqdwn: source d'humidite due aux descentes (kg/kg/s)
+  ! dta  : source de chaleur due courants satures et detrain  (K/s)
+  ! dqa  : source d'humidite due aux courants satures et detra (kg/kg/s)
+  ! wgen : number of wakes generated per unit area and per sec (/m^2/s)
+  ! amdwn: flux de masse total des descentes, par unite de
+  !        surface de la maille (kg/m2/s)
+  ! amup : flux de masse total des ascendances, par unite de
+  !        surface de la maille (kg/m2/s)
+  ! sigd_con: 
+  ! Cin  : convective inhibition
+  ! p    : pressions aux milieux des couches (Pa)
+  ! ph   : pressions aux interfaces (Pa)
+  ! pi  : (p/p_0)**kapa (adim)
+  ! dtime: increment temporel (s)
+
+  ! Variables internes :
+
+  ! rhow : masse volumique de la poche froide
+  ! rho  : environment density at P levels
+  ! rhoh : environment density at Ph levels
+  ! te   : environment temperature | may change within
+  ! qe   : environment humidity    | sub-time-stepping
+  ! the  : environment potential temperature
+  ! thu  : potential temperature in undisturbed area
+  ! tu   :  temperature  in undisturbed area
+  ! qu   : humidity in undisturbed area
+  ! dp_omgb: vertical gradient og LS omega
+  ! omgbw  : wake average vertical omega
+  ! dp_omgbw: vertical gradient of omgbw
+  ! omgbdq : flux of Delta_q transported by LS omega
+  ! dth  : potential temperature diff. wake-undist.
+  ! th1  : first pot. temp. for vertical advection (=thu)
+  ! th2  : second pot. temp. for vertical advection (=thw)
+  ! q1   : first humidity for vertical advection
+  ! q2   : second humidity for vertical advection
+  ! d_deltatw   : terme de redistribution pour deltatw
+  ! d_deltaqw   : terme de redistribution pour deltaqw
+  ! deltatw0   : deltatw initial
+  ! deltaqw0   : deltaqw initial
+  ! hw0    : wake top hight (defined as the altitude at which deltatw=0)
+  ! amflux : horizontal mass flux through wake boundary
+  ! wdens_ref: initial number of wakes per unit area (3D) or per
+  ! unit length (2D), at the beginning of each time step
+  ! Tgw    : 1 sur la période de onde de gravité
+  ! Cgw    : vitesse de propagation de onde de gravité
+  ! LL     : distance entre 2 poches
+
+  ! -------------------------------------------------------------------------
+  ! Déclaration de variables
+  ! -------------------------------------------------------------------------
+
+  include "YOMCST.h"
+  include "cvthermo.h"
+
+  ! Arguments en entree
+  ! --------------------
+
+  INTEGER, DIMENSION (klon),        INTENT(IN)          :: znatsurf
+  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: p, pi
+  REAL, DIMENSION (klon, klev+1),   INTENT(IN)          :: ph
+  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: omgb
+  REAL,                             INTENT(IN)          :: dtime
+  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: te0, qe0
+  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: dtdwn, dqdwn
+  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: amdwn, amup
+  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: dta, dqa
+  REAL, DIMENSION (klon),           INTENT(IN)          :: wgen
+  REAL, DIMENSION (klon),           INTENT(IN)          :: sigd_con
+  REAL, DIMENSION (klon),           INTENT(IN)          :: Cin
+#ifdef ISO
+  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(IN)          :: xte0
+  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(IN)          :: dxtdwn
+  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(IN)          :: dxta
+#endif
+
+  !
+  ! Input/Output
+  ! State variables
+  REAL, DIMENSION (klon, klev),     INTENT(INOUT)       :: deltatw, deltaqw
+  REAL, DIMENSION (klon),           INTENT(INOUT)       :: sigmaw
+  REAL, DIMENSION (klon),           INTENT(INOUT)       :: awdens
+  REAL, DIMENSION (klon),           INTENT(INOUT)       :: wdens
+#ifdef ISO
+  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(INOUT)       :: deltaxtw
+#endif
+
+  ! Sorties
+  ! --------
+
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dth
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: tu, qu
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dtls, dqls
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dtke, dqke
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: spread    !  unused (jyg)
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: omgbdth, omg
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dp_omgb, dp_deltomg
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: d_deltat_gw
+  REAL, DIMENSION (klon),           INTENT(OUT)         :: hw, wape, fip, gfl, cstar
+  INTEGER, DIMENSION (klon),        INTENT(OUT)         :: ktopw
+  ! Tendencies of state variables
+  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: d_deltatw2, d_deltaqw2
+  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_sigmaw2, d_awdens2, d_wdens2
+#ifdef ISO
+  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(OUT)         :: xtu
+  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(OUT)         :: dxtls
+  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(OUT)         :: dxtke
+  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(OUT)         :: d_deltaxtw2
+#endif
+
+  ! Variables internes
+  ! -------------------
+
+  ! Variables à fixer
+  INTEGER, SAVE                                         :: igout
+  !$OMP THREADPRIVATE(igout)
+  LOGICAL, SAVE                                         :: first = .TRUE.
+  !$OMP THREADPRIVATE(first)
+!jyg<
+!!  REAL, SAVE                                            :: stark, wdens_ref, coefgw, alpk
+  REAL, SAVE, DIMENSION(2)                              :: wdens_ref
+  REAL, SAVE                                            :: stark, coefgw, alpk
+!>jyg
+  REAL, SAVE                                            :: crep_upper, crep_sol  
+  !$OMP THREADPRIVATE(stark, wdens_ref, coefgw, alpk, crep_upper, crep_sol)
+
+  REAL, SAVE                                            :: tau_cv
+  !$OMP THREADPRIVATE(tau_cv)
+  REAL, SAVE                                            :: rzero, aa0 ! minimal wake radius and area
+  !$OMP THREADPRIVATE(rzero, aa0)
+
+  LOGICAL, SAVE                                         :: flag_wk_check_trgl
+  !$OMP THREADPRIVATE(flag_wk_check_trgl)
+  INTEGER, SAVE                                         :: iflag_wk_check_trgl
+  !$OMP THREADPRIVATE(iflag_wk_check_trgl)
+  INTEGER, SAVE                                         :: iflag_wk_pop_dyn
+  !$OMP THREADPRIVATE(iflag_wk_pop_dyn)
+
+  REAL                                                  :: delta_t_min
+  INTEGER                                               :: nsub
+  REAL                                                  :: dtimesub
+  REAL, SAVE                                            :: wdensmin
+  !$OMP THREADPRIVATE(wdensmin)
+  REAL, SAVE                                            :: sigmad, hwmin, wapecut, cstart
+  !$OMP THREADPRIVATE(sigmad, hwmin, wapecut, cstart)
+  REAL, SAVE                                            :: sigmaw_max
+  !$OMP THREADPRIVATE(sigmaw_max)  
+  REAL, SAVE                                            :: dens_rate
+  !$OMP THREADPRIVATE(dens_rate)
+  REAL                                                  :: wdens0
+  ! IM 080208
+  LOGICAL, DIMENSION (klon)                             :: gwake
+
+  ! Variables de sauvegarde
+  REAL, DIMENSION (klon, klev)                          :: deltatw0
+  REAL, DIMENSION (klon, klev)                          :: deltaqw0
+  REAL, DIMENSION (klon, klev)                          :: te, qe
+!!  REAL, DIMENSION (klon)                                :: sigmaw1
+#ifdef ISO
+  REAL, DIMENSION (ntraciso,klon, klev)                          :: deltaxtw0
+  REAL, DIMENSION (ntraciso,klon, klev)                          :: xte
+#endif
+
+  ! Variables liees a la dynamique de population
+  REAL, DIMENSION(klon)                                 :: act
+  REAL, DIMENSION(klon)                                 :: rad_wk, tau_wk_inv
+  REAL, DIMENSION(klon)                                 :: f_shear
+  REAL, DIMENSION(klon)                                 :: drdt
+  REAL, DIMENSION(klon)                                 :: d_sig_gen, d_sig_death, d_sig_col
+  REAL, DIMENSION(klon)                                 :: wape1_act, wape2_act
+  LOGICAL, DIMENSION (klon)                             :: kill_wake
+  INTEGER, SAVE                                         :: iflag_wk_act
+  !$OMP THREADPRIVATE(iflag_wk_act)
+  REAL                                                  :: drdt_pos
+  REAL                                                  :: tau_wk_inv_min
+
+  ! Variables pour les GW
+  REAL, DIMENSION (klon)                                :: ll
+  REAL, DIMENSION (klon, klev)                          :: n2
+  REAL, DIMENSION (klon, klev)                          :: cgw
+  REAL, DIMENSION (klon, klev)                          :: tgw
+
+  ! Variables liees au calcul de hw
+  REAL, DIMENSION (klon)                                :: ptop_provis, ptop, ptop_new
+  REAL, DIMENSION (klon)                                :: sum_dth
+  REAL, DIMENSION (klon)                                :: dthmin
+  REAL, DIMENSION (klon)                                :: z, dz, hw0
+  INTEGER, DIMENSION (klon)                             :: ktop, kupper
+
+  ! Variables liees au test de la forme triangulaire du profil de Delta_theta
+  REAL, DIMENSION (klon)                                :: sum_half_dth
+  REAL, DIMENSION (klon)                                :: dz_half
+
+  ! Sub-timestep tendencies and related variables
+  REAL, DIMENSION (klon, klev)                          :: d_deltatw, d_deltaqw
+  REAL, DIMENSION (klon, klev)                          :: d_te, d_qe
+  REAL, DIMENSION (klon)                                :: d_awdens, d_wdens
+  REAL, DIMENSION (klon)                                :: d_sigmaw, alpha
+  REAL, DIMENSION (klon)                                :: q0_min, q1_min
+  LOGICAL, DIMENSION (klon)                             :: wk_adv, ok_qx_qw
+#ifdef ISO
+  REAL, DIMENSION (ntraciso,klon, klev)                          :: d_deltaxtw
+  REAL, DIMENSION (ntraciso,klon, klev)                          :: d_xte
+#endif
+  REAL, SAVE                                            :: epsilon
+  !$OMP THREADPRIVATE(epsilon)
+  DATA epsilon/1.E-15/
+
+  ! Autres variables internes
+  INTEGER                                               ::isubstep, k, i
+
+  REAL                                                  :: wdens_targ
+  REAL                                                  :: sigmaw_targ
+
+  REAL, DIMENSION (klon)                                :: sum_thu, sum_tu, sum_qu, sum_thvu
+  REAL, DIMENSION (klon)                                :: sum_dq, sum_rho
+  REAL, DIMENSION (klon)                                :: sum_dtdwn, sum_dqdwn
+  REAL, DIMENSION (klon)                                :: av_thu, av_tu, av_qu, av_thvu
+  REAL, DIMENSION (klon)                                :: av_dth, av_dq, av_rho
+  REAL, DIMENSION (klon)                                :: av_dtdwn, av_dqdwn
+! pas besoin d'isos ici
+
+  REAL, DIMENSION (klon, klev)                          :: rho, rhow
+  REAL, DIMENSION (klon, klev+1)                        :: rhoh
+  REAL, DIMENSION (klon, klev)                          :: rhow_moyen
+  REAL, DIMENSION (klon, klev)                          :: zh
+  REAL, DIMENSION (klon, klev+1)                        :: zhh
+  REAL, DIMENSION (klon, klev)                          :: epaisseur1, epaisseur2
+
+  REAL, DIMENSION (klon, klev)                          :: the, thu
+
+  REAL, DIMENSION (klon, klev)                          :: omgbw
+  REAL, DIMENSION (klon)                                :: pupper
+  REAL, DIMENSION (klon)                                :: omgtop
+  REAL, DIMENSION (klon, klev)                          :: dp_omgbw
+  REAL, DIMENSION (klon)                                :: ztop, dztop
+  REAL, DIMENSION (klon, klev)                          :: alpha_up
+
+  REAL, DIMENSION (klon)                                :: rre1, rre2
+  REAL                                                  :: rrd1, rrd2
+  REAL, DIMENSION (klon, klev)                          :: th1, th2, q1, q2
+  REAL, DIMENSION (klon, klev)                          :: d_th1, d_th2, d_dth
+  REAL, DIMENSION (klon, klev)                          :: d_q1, d_q2, d_dq
+  REAL, DIMENSION (klon, klev)                          :: omgbdq
+#ifdef ISO
+      REAL, DIMENSION(ntraciso,klon,klev) :: xt1, xt2
+      REAL, DIMENSION(ntraciso,klon,klev) :: D_xt1, D_xt2, D_dxt
+      REAL, DIMENSION(ntraciso,klon,klev) :: omgbdxt
+      integer ixt
+#endif
+
+  REAL, DIMENSION (klon)                                :: ff, gg
+  REAL, DIMENSION (klon)                                :: wape2, cstar2, heff
+                                                        
+  REAL, DIMENSION (klon, klev)                          :: crep
+                                                        
+  REAL, DIMENSION (klon, klev)                          :: ppi
+
+  ! cc nrlmd
+  REAL, DIMENSION (klon)                                :: death_rate
+!!  REAL, DIMENSION (klon)                                :: nat_rate
+  REAL, DIMENSION (klon, klev)                          :: entr
+  REAL, DIMENSION (klon, klev)                          :: detr
+
+  REAL, DIMENSION(klon)                                 :: sigmaw_in             ! pour les prints
+  REAL, DIMENSION(klon)                                 :: awdens_in, wdens_in   ! pour les prints
+
+  ! -------------------------------------------------------------------------
+  ! Initialisations
+  ! -------------------------------------------------------------------------
+
+  ! print*, 'wake initialisations'
+!#ifdef ISOVERIF
+!        write(*,*) 'wake 358: entree'
+!#endif
+
+  ! Essais d'initialisation avec sigmaw = 0.02 et hw = 10.
+  ! -------------------------------------------------------------------------
+
+!!  DATA wapecut, sigmad, hwmin/5., .02, 10./
+!!  DATA wapecut, sigmad, hwmin/1., .02, 10./
+  DATA sigmad, hwmin/.02, 10./
+!!  DATA wdensmin/1.e-12/
+  DATA wdensmin/1.e-14/
+  ! cc nrlmd
+  DATA sigmaw_max/0.4/
+  DATA dens_rate/0.1/
+  ! cc
+  ! Longueur de maille (en m)
+  ! -------------------------------------------------------------------------
+
+  ! ALON = 3.e5
+  ! alon = 1.E6
+
+  !  Provisionnal; to be suppressed when f_shear is parameterized
+  f_shear(:) = 1.       ! 0. for strong shear, 1. for weak shear
+
+
+  ! Configuration de coefgw,stark,wdens (22/02/06 by YU Jingmei)
+
+  ! coefgw : Coefficient pour les ondes de gravité
+  ! stark : Coefficient k dans Cstar=k*sqrt(2*WAPE)
+  ! wdens : Densité surfacique de poche froide
+  ! -------------------------------------------------------------------------
+
+  ! cc nrlmd      coefgw=10
+  ! coefgw=1
+  ! wdens0 = 1.0/(alon**2)
+  ! cc nrlmd      wdens = 1.0/(alon**2)
+  ! cc nrlmd      stark = 0.50
+  ! CRtest
+  ! cc nrlmd      alpk=0.1
+  ! alpk = 1.0
+  ! alpk = 0.5
+  ! alpk = 0.05
+
+ if (first) then
+
+  igout = klon/2+1/klon
+
+  crep_upper = 0.9
+  crep_sol = 1.0
+
+  ! Get wapecut from parameter file
+  wapecut = 1.
+  CALL getin_p('wapecut', wapecut)
+
+  ! cc nrlmd Lecture du fichier wake_param.data
+  stark=0.33
+  CALL getin_p('stark',stark)
+  cstart = stark*sqrt(2.*wapecut)
+
+  alpk=0.25
+  CALL getin_p('alpk',alpk)
+!jyg<
+!!  wdens_ref=8.E-12
+!!  CALL getin_p('wdens_ref',wdens_ref)
+  wdens_ref(1)=8.E-12
+  wdens_ref(2)=8.E-12
+  CALL getin_p('wdens_ref_o',wdens_ref(1))    !wake number per unit area ; ocean
+  CALL getin_p('wdens_ref_l',wdens_ref(2))    !wake number per unit area ; land
+!>jyg
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!  Population dynamics parameters    !!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!------------------------------------------------------------------------ 
+
+  iflag_wk_pop_dyn = 0
+  CALL getin_p('iflag_wk_pop_dyn',iflag_wk_pop_dyn) ! switch between wdens prescribed 
+                                                    ! and wdens prognostic
+  iflag_wk_act = 0
+  CALL getin_p('iflag_wk_act',iflag_wk_act) ! 0: act(:)=0.
+                                            ! 1: act(:)=1.
+                                            ! 2: act(:)=f(Wape)
+
+  rzero = 5000.
+  CALL getin_p('rzero_wk', rzero)
+  aa0 = 3.14*rzero*rzero
+!
+  tau_cv = 4000.
+  CALL getin_p('tau_cv', tau_cv)
+
+!------------------------------------------------------------------------ 
+
+  coefgw=4.
+  CALL getin_p('coefgw',coefgw)
+
+  WRITE(*,*) 'stark=', stark
+  WRITE(*,*) 'alpk=', alpk
+!jyg<
+!!  WRITE(*,*) 'wdens_ref=', wdens_ref
+  WRITE(*,*) 'wdens_ref_o=', wdens_ref(1)
+  WRITE(*,*) 'wdens_ref_l=', wdens_ref(2)
+!>jyg
+  WRITE(*,*) 'iflag_wk_pop_dyn=',iflag_wk_pop_dyn
+  WRITE(*,*) 'iflag_wk_act',iflag_wk_act
+  WRITE(*,*) 'coefgw=', coefgw 
+
+  flag_wk_check_trgl=.false.
+  CALL getin_p('flag_wk_check_trgl ', flag_wk_check_trgl)
+  WRITE(*,*) 'flag_wk_check_trgl=', flag_wk_check_trgl
+  WRITE(*,*) 'flag_wk_check_trgl OBSOLETE. Utilisr iflag_wk_check_trgl plutot'
+  iflag_wk_check_trgl=0 ; IF (flag_wk_check_trgl) iflag_wk_check_trgl=1
+  CALL getin_p('iflag_wk_check_trgl ', iflag_wk_check_trgl)
+  WRITE(*,*) 'iflag_wk_check_trgl=', iflag_wk_check_trgl
+
+  first=.false.
+ endif
+
+ IF (iflag_wk_pop_dyn == 0) THEN
+  ! Initialisation de toutes des densites a wdens_ref.
+  ! Les densites peuvent evoluer si les poches debordent
+  ! (voir au tout debut de la boucle sur les substeps)
+  !jyg<
+  !!  wdens(:) = wdens_ref
+   DO i = 1,klon
+     wdens(i) = wdens_ref(znatsurf(i)+1)
+   ENDDO 
+  !>jyg
+ ENDIF  ! (iflag_wk_pop_dyn == 0)
+
+  ! print*,'stark',stark
+  ! print*,'alpk',alpk
+  ! print*,'wdens',wdens
+  ! print*,'coefgw',coefgw
+  ! cc
+  ! Minimum value for |T_wake - T_undist|. Used for wake top definition
+  ! -------------------------------------------------------------------------
+
+  delta_t_min = 0.2
+
+  ! 1. - Save initial values, initialize tendencies, initialize output fields
+  ! ------------------------------------------------------------------------
+
+!jyg<
+!!  DO k = 1, klev
+!!    DO i = 1, klon
+!!      ppi(i, k) = pi(i, k)
+!!      deltatw0(i, k) = deltatw(i, k)
+!!      deltaqw0(i, k) = deltaqw(i, k)
+!!      te(i, k) = te0(i, k)
+!!      qe(i, k) = qe0(i, k)
+!!      dtls(i, k) = 0.
+!!      dqls(i, k) = 0.
+!!      d_deltat_gw(i, k) = 0.
+!!      d_te(i, k) = 0.
+!!      d_qe(i, k) = 0.
+!!      d_deltatw(i, k) = 0.
+!!      d_deltaqw(i, k) = 0.
+!!      ! IM 060508 beg
+!!      d_deltatw2(i, k) = 0.
+!!      d_deltaqw2(i, k) = 0.
+!!      ! IM 060508 end
+!!    END DO
+!!  END DO
+      ppi(:,:) = pi(:,:)
+      deltatw0(:,:) = deltatw(:,:)
+      deltaqw0(:,:) = deltaqw(:,:)
+      te(:,:) = te0(:,:)
+      qe(:,:) = qe0(:,:)
+      dtls(:,:) = 0.
+      dqls(:,:) = 0.
+      d_deltat_gw(:,:) = 0.
+      d_te(:,:) = 0.
+      d_qe(:,:) = 0.
+      d_deltatw(:,:) = 0.
+      d_deltaqw(:,:) = 0.
+      d_deltatw2(:,:) = 0.
+      d_deltaqw2(:,:) = 0. 
+#ifdef ISO
+      deltaxtw0(:,:,:)= deltaxtw(:,:,:)
+      xte(:,:,:) = xte0(:,:,:)
+      dxtls(:,:,:) = 0.
+      d_xte(:,:,:) = 0.
+      d_deltaxtw(:,:,:) = 0. 
+      d_deltaxtw2(:,:,:)=0. 
+      xt1(:,:,:) = 0. 
+      xt2(:,:,:)=0.   
+      ! init non indispensable mais facilite verif iso
+      q1(:,:)=0.0
+      q2(:,:)=0.0
+#endif
+
+      IF (iflag_wk_act == 0) THEN
+        act(:) = 0.
+      ELSEIF (iflag_wk_act == 1) THEN
+        act(:) = 1.
+      ENDIF
+
+!!  DO i = 1, klon
+!!   sigmaw_in(i) = sigmaw(i)
+!!  END DO
+   sigmaw_in(:) = sigmaw(:)
+!>jyg
+
+  ! sigmaw1=sigmaw
+  ! IF (sigd_con.GT.sigmaw1) THEN
+  ! print*, 'sigmaw,sigd_con', sigmaw, sigd_con
+  ! ENDIF
+  IF (iflag_wk_pop_dyn >=1) THEN
+    DO i = 1, klon
+      wdens_targ = max(wdens(i),wdensmin)
+      d_wdens2(i) = wdens_targ - wdens(i)
+      wdens(i) = wdens_targ
+    END DO
+  ELSE
+    DO i = 1, klon
+      d_awdens2(i) = 0.
+      d_wdens2(i) = 0.
+    END DO
+  ENDIF  ! (iflag_wk_pop_dyn >=1)
+!
+  DO i = 1, klon
+    ! c      sigmaw(i) = amax1(sigmaw(i),sigd_con(i))
+!jyg<
+!!    sigmaw(i) = amax1(sigmaw(i), sigmad)
+!!    sigmaw(i) = amin1(sigmaw(i), 0.99)
+    sigmaw_targ = min(max(sigmaw(i), sigmad),0.99)
+    d_sigmaw2(i) = sigmaw_targ - sigmaw(i)
+    sigmaw(i) = sigmaw_targ
+!>jyg
+  END DO
+
+!
+  IF (iflag_wk_pop_dyn >= 1) THEN
+    awdens_in(:) = awdens(:)
+    wdens_in(:) = wdens(:)
+!!    wdens(:) = wdens(:) + wgen(:)*dtime
+!!    d_wdens2(:) = wgen(:)*dtime
+!!  ELSE
+  ENDIF  ! (iflag_wk_pop_dyn >= 1)
+
+  wape(:) = 0.
+  wape2(:) = 0.
+  d_sigmaw(:) = 0.
+  ktopw(:) = 0
+!
+!<jyg
+dth(:,:) = 0.
+tu(:,:) = 0.
+qu(:,:) = 0.
+dtke(:,:) = 0.
+dqke(:,:) = 0.
+spread(:,:) = 0.
+omgbdth(:,:) = 0.
+omg(:,:) = 0.
+dp_omgb(:,:) = 0.
+dp_deltomg(:,:) = 0.
+hw(:) = 0.
+wape(:) = 0.
+fip(:) = 0.
+gfl(:) = 0.
+cstar(:) = 0.
+ktopw(:) = 0
+!
+!  Vertical advection local variables
+omgbw(:,:) = 0.
+omgtop(:) = 0
+dp_omgbw(:,:) = 0.
+omgbdq(:,:) = 0.
+#ifdef ISO
+xtu(:,:,:) = 0.
+dxtke(:,:,:) = 0.
+omgbdxt(:,:,:) = 0.
+#endif
+!>jyg
+!
+  IF (prt_level>=10) THEN
+    PRINT *, 'wake-1, sigmaw(igout) ', sigmaw(igout)
+    PRINT *, 'wake-1, deltatw(igout,k) ', (k,deltatw(igout,k), k=1,klev)
+    PRINT *, 'wake-1, deltaqw(igout,k) ', (k,deltaqw(igout,k), k=1,klev)
+    PRINT *, 'wake-1, dowwdraughts, amdwn(igout,k) ', (k,amdwn(igout,k), k=1,klev)
+    PRINT *, 'wake-1, dowwdraughts, dtdwn(igout,k) ', (k,dtdwn(igout,k), k=1,klev)
+    PRINT *, 'wake-1, dowwdraughts, dqdwn(igout,k) ', (k,dqdwn(igout,k), k=1,klev)
+    PRINT *, 'wake-1, updraughts, amup(igout,k) ', (k,amup(igout,k), k=1,klev)
+    PRINT *, 'wake-1, updraughts, dta(igout,k) ', (k,dta(igout,k), k=1,klev)
+    PRINT *, 'wake-1, updraughts, dqa(igout,k) ', (k,dqa(igout,k), k=1,klev)
+  ENDIF
+
+  ! 2. - Prognostic part
+  ! --------------------
+
+
+  ! 2.1 - Undisturbed area and Wake integrals
+  ! ---------------------------------------------------------
+
+  DO i = 1, klon
+    z(i) = 0.
+    ktop(i) = 0
+    kupper(i) = 0
+    sum_thu(i) = 0.
+    sum_tu(i) = 0.
+    sum_qu(i) = 0.
+    sum_thvu(i) = 0.
+    sum_dth(i) = 0.
+    sum_dq(i) = 0.
+    sum_rho(i) = 0.
+    sum_dtdwn(i) = 0.
+    sum_dqdwn(i) = 0.
+
+    av_thu(i) = 0.
+    av_tu(i) = 0.
+    av_qu(i) = 0.
+    av_thvu(i) = 0.
+    av_dth(i) = 0.
+    av_dq(i) = 0.
+    av_rho(i) = 0.
+    av_dtdwn(i) = 0.
+    av_dqdwn(i) = 0.
+    ! pas besoin d'isos ici
+  END DO
+
+
+#ifdef ISOVERIF
+      ! TODO      
+#endif 
+
+  ! Distance between wakes
+  DO i = 1, klon
+    ll(i) = (1-sqrt(sigmaw(i)))/sqrt(wdens(i))
+  END DO
+  ! Potential temperatures and humidity
+  ! ----------------------------------------------------------
+  DO k = 1, klev
+    DO i = 1, klon
+      ! write(*,*)'wake 1',i,k,rd,te(i,k)
+      rho(i, k) = p(i, k)/(rd*te(i,k))
+      ! write(*,*)'wake 2',rho(i,k)
+      IF (k==1) THEN
+        ! write(*,*)'wake 3',i,k,rd,te(i,k)
+        rhoh(i, k) = ph(i, k)/(rd*te(i,k))
+        ! write(*,*)'wake 4',i,k,rd,te(i,k)
+        zhh(i, k) = 0
+      ELSE
+        ! write(*,*)'wake 5',rd,(te(i,k)+te(i,k-1))
+        rhoh(i, k) = ph(i, k)*2./(rd*(te(i,k)+te(i,k-1)))
+        ! write(*,*)'wake 6',(-rhoh(i,k)*RG)+zhh(i,k-1)
+        zhh(i, k) = (ph(i,k)-ph(i,k-1))/(-rhoh(i,k)*rg) + zhh(i, k-1)
+      END IF
+      ! write(*,*)'wake 7',ppi(i,k)
+      the(i, k) = te(i, k)/ppi(i, k)
+      thu(i, k) = (te(i,k)-deltatw(i,k)*sigmaw(i))/ppi(i, k)
+      tu(i, k) = te(i, k) - deltatw(i, k)*sigmaw(i)
+      qu(i, k) = qe(i, k) - deltaqw(i, k)*sigmaw(i)
+      ! write(*,*)'wake 8',(rd*(te(i,k)+deltatw(i,k)))
+      rhow(i, k) = p(i, k)/(rd*(te(i,k)+deltatw(i,k)))
+      dth(i, k) = deltatw(i, k)/ppi(i, k)
+#ifdef ISO
+        do ixt=1,ntraciso
+          xtu(ixt,i,k)  =  xte(ixt,i,k) - deltaxtw(ixt,i,k)*sigmaw(i)
+        enddo !do ixt=1,ntraciso
+#ifdef ISOVERIF
+        if (iso_eau.gt.0) then
+              call iso_verif_egalite(deltaqw(i,k),deltaxtw(iso_eau,i,k),'wake 723a')
+              call iso_verif_egalite(qu(i,k),xtu(iso_eau,i,k),'wake 723b')
+        endif
+        if (iso_HDO.gt.0) then
+               if (iso_verif_aberrant_enc_choix_nostop(xtu(iso_hdo,i,k),qu(i,k),ridicule,deltalim, &
+                        'wake 723c xtu').eq.1) then
+                     stop
+               endif
+         endif  
+#endif
+#endif
+    END DO
+  END DO
+
+
+
+  DO k = 1, klev - 1
+    DO i = 1, klon
+      IF (k==1) THEN
+        n2(i, k) = 0
+      ELSE
+        n2(i, k) = amax1(0., -rg**2/the(i,k)*rho(i,k)*(the(i,k+1)-the(i,k-1))/ &
+                             (p(i,k+1)-p(i,k-1)))
+      END IF
+      zh(i, k) = (zhh(i,k)+zhh(i,k+1))/2
+
+      cgw(i, k) = sqrt(n2(i,k))*zh(i, k)
+      tgw(i, k) = coefgw*cgw(i, k)/ll(i)
+    END DO
+  END DO
+
+  DO i = 1, klon
+    n2(i, klev) = 0
+    zh(i, klev) = 0
+    cgw(i, klev) = 0
+    tgw(i, klev) = 0
+  END DO
+
+  ! Calcul de la masse volumique moyenne de la colonne   (bdlmd)
+  ! -----------------------------------------------------------------
+
+  DO k = 1, klev
+    DO i = 1, klon
+      epaisseur1(i, k) = 0.
+      epaisseur2(i, k) = 0.
+    END DO
+  END DO
+
+  DO i = 1, klon
+    epaisseur1(i, 1) = -(ph(i,2)-ph(i,1))/(rho(i,1)*rg) + 1.
+    epaisseur2(i, 1) = -(ph(i,2)-ph(i,1))/(rho(i,1)*rg) + 1.
+    rhow_moyen(i, 1) = rhow(i, 1)
+  END DO
+
+  DO k = 2, klev
+    DO i = 1, klon
+      epaisseur1(i, k) = -(ph(i,k+1)-ph(i,k))/(rho(i,k)*rg) + 1.
+      epaisseur2(i, k) = epaisseur2(i, k-1) + epaisseur1(i, k)
+      rhow_moyen(i, k) = (rhow_moyen(i,k-1)*epaisseur2(i,k-1)+rhow(i,k)* &
+        epaisseur1(i,k))/epaisseur2(i, k)
+    END DO
+  END DO
+
+
+  ! Choose an integration bound well above wake top
+  ! -----------------------------------------------------------------
+
+  ! Pupper = 50000.  ! melting level
+  ! Pupper = 60000.
+  ! Pupper = 80000.  ! essais pour case_e
+  DO i = 1, klon
+    pupper(i) = 0.6*ph(i, 1)
+    pupper(i) = max(pupper(i), 45000.)
+    ! cc        Pupper(i) = 60000.
+  END DO
+
+
+  ! Determine Wake top pressure (Ptop) from buoyancy integral
+  ! --------------------------------------------------------
+
+  ! -1/ Pressure of the level where dth becomes less than delta_t_min.
+
+  DO i = 1, klon
+    ptop_provis(i) = ph(i, 1)
+  END DO
+  DO k = 2, klev
+    DO i = 1, klon
+
+      ! IM v3JYG; ptop_provis(i).LT. ph(i,1)
+
+      IF (dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min .AND. &
+          ptop_provis(i)==ph(i,1)) THEN
+        ptop_provis(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)- &
+                          (dth(i,k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
+      END IF
+    END DO
+  END DO
+
+  ! -2/ dth integral
+
+  DO i = 1, klon
+    sum_dth(i) = 0.
+    dthmin(i) = -delta_t_min
+    z(i) = 0.
+  END DO
+
+  DO k = 1, klev
+    DO i = 1, klon
+      dz(i) = -(amax1(ph(i,k+1),ptop_provis(i))-ph(i,k))/(rho(i,k)*rg)
+      IF (dz(i)>0) THEN
+        z(i) = z(i) + dz(i)
+        sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
+        dthmin(i) = amin1(dthmin(i), dth(i,k))
+      END IF
+    END DO
+  END DO
+
+  ! -3/ height of triangle with area= sum_dth and base = dthmin
+
+  DO i = 1, klon
+    hw0(i) = 2.*sum_dth(i)/amin1(dthmin(i), -0.5)
+    hw0(i) = amax1(hwmin, hw0(i))
+  END DO
+
+  ! -4/ now, get Ptop
+
+  DO i = 1, klon
+    z(i) = 0.
+    ptop(i) = ph(i, 1)
+  END DO
+
+  DO k = 1, klev
+    DO i = 1, klon
+      dz(i) = amin1(-(ph(i,k+1)-ph(i,k))/(rho(i,k)*rg), hw0(i)-z(i))
+      IF (dz(i)>0) THEN
+        z(i) = z(i) + dz(i)
+        ptop(i) = ph(i, k) - rho(i, k)*rg*dz(i)
+      END IF
+    END DO
+  END DO
+
+  IF (prt_level>=10) THEN
+    PRINT *, 'wake-2, ptop_provis(igout), ptop(igout) ', ptop_provis(igout), ptop(igout)
+  ENDIF
+
+
+  ! -5/ Determination de ktop et kupper
+
+  DO k = klev, 1, -1
+    DO i = 1, klon
+      IF (ph(i,k+1)<ptop(i)) ktop(i) = k
+      IF (ph(i,k+1)<pupper(i)) kupper(i) = k
+    END DO
+  END DO
+
+  ! On evite kupper = 1 et kupper = klev
+  DO i = 1, klon
+    kupper(i) = max(kupper(i), 2)
+    kupper(i) = min(kupper(i), klev-1)
+  END DO
+
+
+  ! -6/ Correct ktop and ptop
+
+  DO i = 1, klon
+    ptop_new(i) = ptop(i)
+  END DO
+  DO k = klev, 2, -1
+    DO i = 1, klon
+      IF (k<=ktop(i) .AND. ptop_new(i)==ptop(i) .AND. &
+          dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN
+        ptop_new(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)-(dth(i, &
+          k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
+      END IF
+    END DO
+  END DO
+
+  DO i = 1, klon
+    ptop(i) = ptop_new(i)
+  END DO
+
+  DO k = klev, 1, -1
+    DO i = 1, klon
+      IF (ph(i,k+1)<ptop(i)) ktop(i) = k
+    END DO
+  END DO
+
+  IF (prt_level>=10) THEN
+    PRINT *, 'wake-3, ktop(igout), kupper(igout) ', ktop(igout), kupper(igout)
+  ENDIF
+
+  ! -5/ Set deltatw & deltaqw to 0 above kupper
+
+  DO k = 1, klev
+    DO i = 1, klon
+      IF (k>=kupper(i)) THEN
+        deltatw(i, k) = 0.
+        deltaqw(i, k) = 0.
+        d_deltatw2(i,k) = -deltatw0(i,k)
+#ifdef ISO
+        do ixt=1,ntraciso
+        deltaxtw(ixt,i, k) = 0.
+        d_deltaxtw2(ixt,i,k) = -deltaxtw0(ixt,i,k)
+        enddo
+#endif
+      END IF
+    END DO
+  END DO
+
+
+  ! Vertical gradient of LS omega
+
+  DO k = 1, klev
+    DO i = 1, klon
+      IF (k<=kupper(i)) THEN
+        dp_omgb(i, k) = (omgb(i,k+1)-omgb(i,k))/(ph(i,k+1)-ph(i,k))
+      END IF
+    END DO
+  END DO
+
+  ! Integrals (and wake top level number)
+  ! --------------------------------------
+
+  ! Initialize sum_thvu to 1st level virt. pot. temp.
+
+  DO i = 1, klon
+    z(i) = 1.
+    dz(i) = 1.
+    sum_thvu(i) = thu(i, 1)*(1.+epsim1*qu(i,1))*dz(i)
+    sum_dth(i) = 0.
+  END DO
+
+  DO k = 1, klev
+    DO i = 1, klon
+      dz(i) = -(amax1(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*rg)
+      IF (dz(i)>0) THEN
+        z(i) = z(i) + dz(i)
+        sum_thu(i) = sum_thu(i) + thu(i, k)*dz(i)
+        sum_tu(i) = sum_tu(i) + tu(i, k)*dz(i)
+        sum_qu(i) = sum_qu(i) + qu(i, k)*dz(i)
+        sum_thvu(i) = sum_thvu(i) + thu(i, k)*(1.+epsim1*qu(i,k))*dz(i)
+        sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
+        sum_dq(i) = sum_dq(i) + deltaqw(i, k)*dz(i)
+        sum_rho(i) = sum_rho(i) + rhow(i, k)*dz(i)
+        sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i, k)*dz(i)
+        sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i, k)*dz(i)
+      END IF
+    END DO
+  END DO
+
+  DO i = 1, klon
+    hw0(i) = z(i)
+  END DO
+
+
+  ! 2.1 - WAPE and mean forcing computation
+  ! ---------------------------------------
+
+  ! ---------------------------------------
+
+  ! Means
+
+  DO i = 1, klon
+    av_thu(i) = sum_thu(i)/hw0(i)
+    av_tu(i) = sum_tu(i)/hw0(i)
+    av_qu(i) = sum_qu(i)/hw0(i)
+    av_thvu(i) = sum_thvu(i)/hw0(i)
+    ! av_thve = sum_thve/hw0
+    av_dth(i) = sum_dth(i)/hw0(i)
+    av_dq(i) = sum_dq(i)/hw0(i)
+    av_rho(i) = sum_rho(i)/hw0(i)
+    av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
+    av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
+
+    wape(i) = -rg*hw0(i)*(av_dth(i)+ &
+        epsim1*(av_thu(i)*av_dq(i)+av_dth(i)*av_qu(i)+av_dth(i)*av_dq(i)))/av_thvu(i)
+
+  END DO
+
+  ! 2.2 Prognostic variable update
+  ! ------------------------------
+
+  ! Filter out bad wakes
+
+  DO k = 1, klev
+    DO i = 1, klon
+      IF (wape(i)<0.) THEN
+        deltatw(i, k) = 0.
+        deltaqw(i, k) = 0.
+        dth(i, k) = 0.
+        d_deltatw2(i,k) = -deltatw0(i,k)
+        d_deltaqw2(i,k) = -deltaqw0(i,k)
+#ifdef ISO
+        do ixt=1,ntraciso
+        deltaxtw(ixt,i, k) = 0.
+        d_deltaxtw2(ixt,i,k) = -deltaxtw0(ixt,i,k)
+        enddo
+#endif
+      END IF
+    END DO
+  END DO
+
+  DO i = 1, klon
+    IF (wape(i)<0.) THEN
+      wape(i) = 0.
+      cstar(i) = 0.
+      hw(i) = hwmin
+!jyg<
+!!      sigmaw(i) = amax1(sigmad, sigd_con(i))
+      sigmaw_targ = max(sigmad, sigd_con(i))
+      d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
+      sigmaw(i) = sigmaw_targ
+!>jyg
+      fip(i) = 0.
+      gwake(i) = .FALSE.
+    ELSE
+      hw(i) = hw0(i)
+      cstar(i) = stark*sqrt(2.*wape(i))
+      gwake(i) = .TRUE.
+    END IF
+  END DO
+
+
+  ! Check qx and qw positivity
+  ! --------------------------
+  DO i = 1, klon
+    q0_min(i) = min((qe(i,1)-sigmaw(i)*deltaqw(i,1)),  &
+                    (qe(i,1)+(1.-sigmaw(i))*deltaqw(i,1)))
+  END DO
+  DO k = 2, klev
+    DO i = 1, klon
+      q1_min(i) = min((qe(i,k)-sigmaw(i)*deltaqw(i,k)), &
+                      (qe(i,k)+(1.-sigmaw(i))*deltaqw(i,k)))
+      IF (q1_min(i)<=q0_min(i)) THEN
+        q0_min(i) = q1_min(i)
+      END IF
+    END DO
+  END DO
+
+  DO i = 1, klon
+    ok_qx_qw(i) = q0_min(i) >= 0.
+    alpha(i) = 1.
+  END DO
+
+  IF (prt_level>=10) THEN
+    PRINT *, 'wake-4, sigmaw(igout), cstar(igout), wape(igout), ktop(igout) ', &
+                      sigmaw(igout), cstar(igout), wape(igout), ktop(igout)
+  ENDIF
+
+
+  ! C -----------------------------------------------------------------
+  ! Sub-time-stepping
+  ! -----------------
+
+  nsub = 10
+  dtimesub = dtime/nsub
+
+  ! ------------------------------------------------------------
+  DO isubstep = 1, nsub
+    ! ------------------------------------------------------------
+
+    ! wk_adv is the logical flag enabling wake evolution in the time advance
+    ! loop
+    DO i = 1, klon
+      wk_adv(i) = ok_qx_qw(i) .AND. alpha(i) >= 1.
+    END DO
+    IF (prt_level>=10) THEN
+      PRINT *, 'wake-4.1, isubstep,wk_adv(igout),cstar(igout),wape(igout), ptop(igout) ', &
+                          isubstep,wk_adv(igout),cstar(igout),wape(igout), ptop(igout)
+    ENDIF
+
+    ! cc nrlmd   Ajout d'un recalcul de wdens dans le cas d'un entrainement
+    ! négatif de ktop à kupper --------
+    ! cc           On calcule pour cela une densité wdens0 pour laquelle on
+    ! aurait un entrainement nul ---
+    !jyg<
+    ! Dans la configuration avec wdens prognostique, il s'agit d'un cas ou 
+    ! les poches sont insuffisantes pour accueillir tout le flux de masse 
+    ! des descentes unsaturees. Nous faisons alors l'hypothese que la 
+    ! convection profonde cree directement de nouvelles poches, sans passer 
+    ! par les thermiques. La nouvelle valeur de wdens est alors imposée.
+
+    DO i = 1, klon
+      ! c       print *,' isubstep,wk_adv(i),cstar(i),wape(i) ',
+      ! c     $           isubstep,wk_adv(i),cstar(i),wape(i)
+      IF (wk_adv(i) .AND. cstar(i)>0.01) THEN
+        omg(i, kupper(i)+1) = -rg*amdwn(i, kupper(i)+1)/sigmaw(i) + &
+                               rg*amup(i, kupper(i)+1)/(1.-sigmaw(i))
+        wdens0 = (sigmaw(i)/(4.*3.14))* &
+          ((1.-sigmaw(i))*omg(i,kupper(i)+1)/((ph(i,1)-pupper(i))*cstar(i)))**(2)
+        IF (prt_level >= 10) THEN
+             print*,'omg(i,kupper(i)+1),wdens0,wdens(i),cstar(i), ph(i,1)-pupper(i)', &
+                     omg(i,kupper(i)+1),wdens0,wdens(i),cstar(i), ph(i,1)-pupper(i)
+        ENDIF
+        IF (wdens(i)<=wdens0*1.1) THEN
+          IF (iflag_wk_pop_dyn >= 1) THEN
+             d_wdens2(i) = d_wdens2(i) + wdens0 - wdens(i)
+          ENDIF
+          wdens(i) = wdens0
+        END IF
+      END IF
+    END DO
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        gfl(i) = 2.*sqrt(3.14*wdens(i)*sigmaw(i))
+        rad_wk(i) = sqrt(sigmaw(i)/(3.14*wdens(i)))
+!jyg<
+!!        sigmaw(i) = amin1(sigmaw(i), sigmaw_max)
+        sigmaw_targ = min(sigmaw(i), sigmaw_max)
+        d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
+        sigmaw(i) = sigmaw_targ
+!>jyg
+      END IF
+    END DO
+
+    IF (iflag_wk_pop_dyn >= 1) THEN
+!    The variable "death_rate" is significant only when iflag_wk_pop_dyn = 0.
+!    Here, it has to be set to zero.
+      death_rate(:) = 0.
+
+      IF (iflag_wk_act ==2) THEN
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          wape1_act(i) = abs(cin(i))
+          wape2_act(i) = 2.*wape1_act(i) + 1.
+          act(i) = min(1., max(0., (wape(i)-wape1_act(i)) / (wape2_act(i)-wape1_act(i)) ))
+        ENDIF  ! (wk_adv(i))
+      ENDDO
+      ENDIF  ! (iflag_wk_act ==2)
+
+
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+!!          tau_wk(i) = max(rad_wk(i)/(3.*cstar(i))*((cstar(i)/cstart)**1.5 - 1), 100.)
+          tau_wk_inv(i) = max( (3.*cstar(i))/(rad_wk(i)*((cstar(i)/cstart)**1.5 - 1)), 0.)
+          tau_wk_inv_min = min(tau_wk_inv(i), 1./dtimesub)
+          drdt(i) = (cstar(i) - wgen(i)*(sigmaw(i)/wdens(i)-aa0)/gfl(i)) / &
+                    (1 + 2*f_shear(i)*(2.*sigmaw(i)-aa0*wdens(i)) - 2.*sigmaw(i))
+!!                    (1 - 2*sigmaw(i)*(1.-f_shear(i)))
+          drdt_pos=max(drdt(i),0.)
+
+!!          d_wdens(i) = ( wgen(i)*(1.+2.*(sigmaw(i)-sigmad)) &
+!!                     - wdens(i)*tau_wk_inv_min &
+!!                     - 2.*gfl(i)*wdens(i)*Cstar(i) )*dtimesub
+          d_awdens(i) = ( wgen(i) - (1./tau_cv)*(awdens(i) - act(i)*wdens(i)) )*dtimesub
+          d_wdens(i) = ( wgen(i) - (wdens(i)-awdens(i))*tau_wk_inv_min -  &
+                         2.*wdens(i)*gfl(i)*drdt_pos )*dtimesub
+          d_wdens(i) = max(d_wdens(i), wdensmin-wdens(i))
+
+!!          d_sigmaw(i) = ( (1.-2*f_shear(i)*sigmaw(i))*(gfl(i)*Cstar(i)+wgen(i)*sigmad/wdens(i)) &
+!!                      + 2.*f_shear(i)*wgen(i)*sigmaw(i)**2/wdens(i) &
+!!                      - sigmaw(i)*tau_wk_inv_min )*dtimesub
+          d_sig_gen(i) = wgen(i)*aa0
+          d_sig_death(i) = - sigmaw(i)*(1.-awdens(i)/wdens(i))*tau_wk_inv_min
+!!          d_sig_col(i) = - 2*f_shear(i)*sigmaw(i)*gfl(i)*drdt_pos
+          d_sig_col(i) = - 2*f_shear(i)*(2.*sigmaw(i)-wdens(i)*aa0)*gfl(i)*drdt_pos
+          d_sigmaw(i) = ( d_sig_gen(i) + d_sig_death(i) + d_sig_col(i) + gfl(i)*cstar(i) )*dtimesub
+          d_sigmaw(i) = max(d_sigmaw(i), sigmad-sigmaw(i))
+        ENDIF
+      ENDDO
+
+      IF (prt_level >= 10) THEN
+        print *,'wake, cstar(1), cstar(1)/cstart, rad_wk(1), tau_wk_inv(1), drdt(1) ', &
+                       cstar(1), cstar(1)/cstart, rad_wk(1), tau_wk_inv(1), drdt(1)
+        print *,'wake, wdens(1), awdens(1), act(1), d_awdens(1) ', &
+                       wdens(1), awdens(1), act(1), d_awdens(1)
+        print *,'wake, wgen, -(wdens-awdens)*tau_wk_inv, -2.*wdens*gfl*drdt_pos, d_wdens ', &
+                       wgen(1), -(wdens(1)-awdens(1))*tau_wk_inv(1), -2.*wdens(1)*gfl(1)*drdt_pos, d_wdens(1)
+        print *,'wake, d_sig_gen(1), d_sig_death(1), d_sig_col(1), d_sigmaw(1) ', &
+                       d_sig_gen(1), d_sig_death(1), d_sig_col(1), d_sigmaw(1)
+      ENDIF
+    
+    ELSE  !  (iflag_wk_pop_dyn >= 1)
+
+    ! cc nrlmd
+
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          ! cc nrlmd          Introduction du taux de mortalité des poches et
+          ! test sur sigmaw_max=0.4
+          ! cc         d_sigmaw(i) = gfl(i)*Cstar(i)*dtimesub
+          IF (sigmaw(i)>=sigmaw_max) THEN
+            death_rate(i) = gfl(i)*cstar(i)/sigmaw(i)
+          ELSE
+            death_rate(i) = 0.
+          END IF
+    
+          d_sigmaw(i) = gfl(i)*cstar(i)*dtimesub - death_rate(i)*sigmaw(i)* &
+            dtimesub
+          ! $              - nat_rate(i)*sigmaw(i)*dtimesub
+          ! c        print*, 'd_sigmaw(i),sigmaw(i),gfl(i),Cstar(i),wape(i),
+          ! c     $  death_rate(i),ktop(i),kupper(i)',
+          ! c     $	         d_sigmaw(i),sigmaw(i),gfl(i),Cstar(i),wape(i),
+          ! c     $  death_rate(i),ktop(i),kupper(i)
+    
+          ! sigmaw(i) =sigmaw(i) + gfl(i)*Cstar(i)*dtimesub
+          ! sigmaw(i) =min(sigmaw(i),0.99)     !!!!!!!!
+          ! wdens = wdens0/(10.*sigmaw)
+          ! sigmaw =max(sigmaw,sigd_con)
+          ! sigmaw =max(sigmaw,sigmad)
+        END IF
+      END DO
+
+    ENDIF   !  (iflag_wk_pop_dyn >= 1)
+
+
+    ! calcul de la difference de vitesse verticale poche - zone non perturbee
+    ! IM 060208 differences par rapport au code initial; init. a 0 dp_deltomg
+    ! IM 060208 et omg sur les niveaux de 1 a klev+1, alors que avant l'on definit
+    ! IM 060208 au niveau k=1..?
+    !JYG 161013 Correction : maintenant omg est dimensionne a klev.
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN !!! nrlmd
+          dp_deltomg(i, k) = 0.
+        END IF
+      END DO
+    END DO
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN !!! nrlmd
+          omg(i, k) = 0.
+        END IF
+      END DO
+    END DO
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        z(i) = 0.
+        omg(i, 1) = 0.
+        dp_deltomg(i, 1) = -(gfl(i)*cstar(i))/(sigmaw(i)*(1-sigmaw(i)))
+      END IF
+    END DO
+
+    DO k = 2, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=ktop(i)) THEN
+          dz(i) = -(ph(i,k)-ph(i,k-1))/(rho(i,k-1)*rg)
+          z(i) = z(i) + dz(i)
+          dp_deltomg(i, k) = dp_deltomg(i, 1)
+          omg(i, k) = dp_deltomg(i, 1)*z(i)
+        END IF
+      END DO
+    END DO
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        dztop(i) = -(ptop(i)-ph(i,ktop(i)))/(rho(i,ktop(i))*rg)
+        ztop(i) = z(i) + dztop(i)
+        omgtop(i) = dp_deltomg(i, 1)*ztop(i)
+      END IF
+    END DO
+
+    IF (prt_level>=10) THEN
+      PRINT *, 'wake-4.2, omg(igout,k) ', (k,omg(igout,k), k=1,klev)
+      PRINT *, 'wake-4.2, omgtop(igout), ptop(igout), ktop(igout) ', &
+                          omgtop(igout), ptop(igout), ktop(igout)
+    ENDIF
+
+    ! -----------------
+    ! From m/s to Pa/s
+    ! -----------------
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        omgtop(i) = -rho(i, ktop(i))*rg*omgtop(i)
+        dp_deltomg(i, 1) = omgtop(i)/(ptop(i)-ph(i,1))
+      END IF
+    END DO
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=ktop(i)) THEN
+          omg(i, k) = -rho(i, k)*rg*omg(i, k)
+          dp_deltomg(i, k) = dp_deltomg(i, 1)
+        END IF
+      END DO
+    END DO
+
+    ! raccordement lineaire de omg de ptop a pupper
+
+    DO i = 1, klon
+      IF (wk_adv(i) .AND. kupper(i)>ktop(i)) THEN
+        omg(i, kupper(i)+1) = -rg*amdwn(i, kupper(i)+1)/sigmaw(i) + &
+          rg*amup(i, kupper(i)+1)/(1.-sigmaw(i))
+        dp_deltomg(i, kupper(i)) = (omgtop(i)-omg(i,kupper(i)+1))/ &
+          (ptop(i)-pupper(i))
+      END IF
+    END DO
+
+    ! c      DO i=1,klon
+    ! c        print*,'Pente entre 0 et kupper (référence)'
+    ! c     $   	,omg(i,kupper(i)+1)/(pupper(i)-ph(i,1))
+    ! c        print*,'Pente entre ktop et kupper'
+    ! c     $  	,(omg(i,kupper(i)+1)-omgtop(i))/(pupper(i)-ptop(i))
+    ! c      ENDDO
+    ! c
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k>ktop(i) .AND. k<=kupper(i)) THEN
+          dp_deltomg(i, k) = dp_deltomg(i, kupper(i))
+          omg(i, k) = omgtop(i) + (ph(i,k)-ptop(i))*dp_deltomg(i, kupper(i))
+        END IF
+      END DO
+    END DO
+!!    print *,'omg(igout,k) ', (k,omg(igout,k),k=1,klev)
+    ! cc nrlmd
+    ! c      DO i=1,klon
+    ! c      print*,'deltaw_ktop,deltaw_conv',omgtop(i),omg(i,kupper(i)+1)
+    ! c      END DO
+    ! cc
+
+
+    ! --    Compute wake average vertical velocity omgbw
+
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          omgbw(i, k) = omgb(i, k) + (1.-sigmaw(i))*omg(i, k)
+        END IF
+      END DO
+    END DO
+    ! --    and its vertical gradient dp_omgbw
+
+    DO k = 1, klev-1
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          dp_omgbw(i, k) = (omgbw(i,k+1)-omgbw(i,k))/(ph(i,k+1)-ph(i,k))
+        END IF
+      END DO
+    END DO
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+          dp_omgbw(i, klev) = 0.
+      END IF
+    END DO
+
+    ! --    Upstream coefficients for omgb velocity
+    ! --    (alpha_up(k) is the coefficient of the value at level k)
+    ! --    (1-alpha_up(k) is the coefficient of the value at level k-1)
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          alpha_up(i, k) = 0.
+          IF (omgb(i,k)>0.) alpha_up(i, k) = 1.
+        END IF
+      END DO
+    END DO
+
+    ! Matrix expressing [The,deltatw] from  [Th1,Th2]
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        rre1(i) = 1. - sigmaw(i)
+        rre2(i) = sigmaw(i)
+      END IF
+    END DO
+    rrd1 = -1.
+    rrd2 = 1.
+
+    ! --    Get [Th1,Th2], dth and [q1,q2]
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=kupper(i)+1) THEN
+          dth(i, k) = deltatw(i, k)/ppi(i, k)
+          th1(i, k) = the(i, k) - sigmaw(i)*dth(i, k) ! undisturbed area
+          th2(i, k) = the(i, k) + (1.-sigmaw(i))*dth(i, k) ! wake
+          q1(i, k) = qe(i, k) - sigmaw(i)*deltaqw(i, k) ! undisturbed area
+          q2(i, k) = qe(i, k) + (1.-sigmaw(i))*deltaqw(i, k) ! wake
+#ifdef ISO
+          do ixt=1,ntraciso
+            xt1(ixt,i,k) = xte(ixt,i,k) -sigmaw(i)     *deltaxtw(ixt,i,k) ! undisturbed area
+            xt2(ixt,i,k) = xte(ixt,i,k) +(1.-sigmaw(i))*deltaxtw(ixt,i,k) ! wake
+          enddo
+#endif
+        END IF
+      END DO
+    END DO
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        d_th1(i, 1) = 0.
+        d_th2(i, 1) = 0.
+        d_dth(i, 1) = 0.
+        d_q1(i, 1) = 0.
+        d_q2(i, 1) = 0.
+        d_dq(i, 1) = 0.
+#ifdef ISO
+        do ixt=1,ntraciso
+          d_xt1(ixt,i,1) = 0.
+          d_xt2(ixt,i,1) = 0.
+          d_dxt(ixt,i,1) = 0.
+        enddo !do ixt=1,ntraciso
+#endif
+      END IF
+    END DO
+
+    DO k = 2, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=kupper(i)+1) THEN
+          d_th1(i, k) = th1(i, k-1) - th1(i, k)
+          d_th2(i, k) = th2(i, k-1) - th2(i, k)
+          d_dth(i, k) = dth(i, k-1) - dth(i, k)
+          d_q1(i, k) = q1(i, k-1) - q1(i, k)
+          d_q2(i, k) = q2(i, k-1) - q2(i, k)
+          d_dq(i, k) = deltaqw(i, k-1) - deltaqw(i, k)
+#ifdef ISO
+        do ixt=1,ntraciso
+          d_xt1(ixt,i,k) = xt1(ixt,i,k-1)-xt1(ixt,i,k)
+          d_xt2(ixt,i,k) = xt2(ixt,i,k-1)-xt2(ixt,i,k)
+          d_dxt(ixt,i,k) = deltaxtw(ixt,i,k-1)-deltaxtw(ixt,i,k)
+        enddo !do ixt=1,ntraciso
+#endif
+        END IF
+      END DO
+    END DO
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        omgbdth(i, 1) = 0.
+        omgbdq(i, 1) = 0.
+#ifdef ISO
+        do ixt=1,ntraciso
+         omgbdxt(ixt,i,1) = 0.
+        enddo !do ixt=1,ntraciso
+#endif
+      END IF
+    END DO
+
+    DO k = 2, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=kupper(i)+1) THEN !   loop on interfaces
+          omgbdth(i, k) = omgb(i, k)*(dth(i,k-1)-dth(i,k))
+          omgbdq(i, k) = omgb(i, k)*(deltaqw(i,k-1)-deltaqw(i,k))
+#ifdef ISO
+        do ixt=1,ntraciso
+          omgbdxt(ixt,i,k)  = omgb(i,k)*(deltaxtw(ixt,i,k-1) - deltaxtw(ixt,i,k))
+        enddo !do ixt=1,ntraciso
+#ifdef ISOVERIF
+      if (iso_eau.gt.0) then
+        call iso_verif_egalite(deltaqw(i,k-1),deltaxtw(iso_eau,i,k-1),'wake 1460a')
+        call iso_verif_egalite(deltaqw(i,k),deltaxtw(iso_eau,i,k),'wake 1460b')
+        call iso_verif_egalite(omgbdq(i,k),omgbdxt(iso_eau,i,k),'wake 1460c')
+      endif
+#endif
+#endif
+        END IF
+      END DO
+    END DO
+
+    IF (prt_level>=10) THEN
+      PRINT *, 'wake-4.3, th1(igout,k) ', (k,th1(igout,k), k=1,klev)
+      PRINT *, 'wake-4.3, th2(igout,k) ', (k,th2(igout,k), k=1,klev)
+      PRINT *, 'wake-4.3, dth(igout,k) ', (k,dth(igout,k), k=1,klev)
+      PRINT *, 'wake-4.3, omgbdth(igout,k) ', (k,omgbdth(igout,k), k=1,klev)
+    ENDIF
+
+    ! -----------------------------------------------------------------
+    DO k = 1, klev-1
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=kupper(i)-1) THEN
+          ! -----------------------------------------------------------------
+
+          ! Compute redistribution (advective) term
+
+          d_deltatw(i, k) = dtimesub/(ph(i,k)-ph(i,k+1))* &
+            (rrd1*omg(i,k)*sigmaw(i)*d_th1(i,k) - &
+             rrd2*omg(i,k+1)*(1.-sigmaw(i))*d_th2(i,k+1)- &
+             (1.-alpha_up(i,k))*omgbdth(i,k)- &
+             alpha_up(i,k+1)*omgbdth(i,k+1))*ppi(i, k)
+!           print*,'d_deltatw=', k, d_deltatw(i,k)
+
+          d_deltaqw(i, k) = dtimesub/(ph(i,k)-ph(i,k+1))* &
+            (rrd1*omg(i,k)*sigmaw(i)*d_q1(i,k)- &
+             rrd2*omg(i,k+1)*(1.-sigmaw(i))*d_q2(i,k+1)- &
+             (1.-alpha_up(i,k))*omgbdq(i,k)- &
+             alpha_up(i,k+1)*omgbdq(i,k+1))
+!           print*,'d_deltaqw=', k, d_deltaqw(i,k)
+#ifdef ISO
+        do ixt=1,ntraciso
+          d_deltaxtw(ixt,i,k) = dtimesub/(Ph(i,k)-Ph(i,k+1))* &
+            (rrd1*omg(i,k  )*sigmaw(i)     *d_xt1(ixt,i,k)- &
+            rrd2*omg(i,k+1)*(1.-sigmaw(i))*d_xt2(ixt,i,k+1)- &
+            (1.-alpha_up(i,k))*omgbdxt(ixt,i,k)- &
+            alpha_up(i,k+1)*omgbdxt(ixt,i,k+1))
+        enddo !do ixt=1,ntraciso
+#ifdef ISOVERIF
+      if (iso_eau.gt.0) then
+        call iso_verif_egalite(d_q1(i,k),d_xt1(iso_eau,i,k),'wake 1502a')
+        call iso_verif_egalite(d_q2(i,k),d_xt2(iso_eau,i,k),'wake 1502b')
+        call iso_verif_egalite(omgbdq(i,k),omgbdxt(iso_eau,i,k),'wake 1502c')
+        call iso_verif_egalite(omgbdq(i,k+1),omgbdxt(iso_eau,i,k+1),'wake 1502d')
+        call iso_verif_egalite(d_deltaqw(i,k),d_deltaxtw(iso_eau,i,k),'wake 1502e')
+      endif
+#endif
+#endif
+
+          ! and increment large scale tendencies
+
+
+
+
+          ! C
+          ! -----------------------------------------------------------------
+          d_te(i, k) = dtimesub*((rre1(i)*omg(i,k)*sigmaw(i)*d_th1(i,k)- &
+                                  rre2(i)*omg(i,k+1)*(1.-sigmaw(i))*d_th2(i,k+1))/ &
+                                 (ph(i,k)-ph(i,k+1)) &
+                                 -sigmaw(i)*(1.-sigmaw(i))*dth(i,k)*(omg(i,k)-omg(i,k+1))/ &
+                                 (ph(i,k)-ph(i,k+1)) )*ppi(i, k)
+
+          d_qe(i, k) = dtimesub*((rre1(i)*omg(i,k)*sigmaw(i)*d_q1(i,k)- &
+                                  rre2(i)*omg(i,k+1)*(1.-sigmaw(i))*d_q2(i,k+1))/ &
+                                 (ph(i,k)-ph(i,k+1)) &
+                                 -sigmaw(i)*(1.-sigmaw(i))*deltaqw(i,k)*(omg(i,k)-omg(i,k+1))/ &
+                                 (ph(i,k)-ph(i,k+1)) )
+#ifdef ISO
+        do ixt=1,ntraciso
+         d_xte(ixt,i,k) =  dtimesub*( &
+             ( rre1(i)*omg(i,k  )*sigmaw(i)     *d_xt1(ixt,i,k) &
+              -rre2(i)*omg(i,k+1)*(1.-sigmaw(i))*d_xt2(ixt,i,k+1) ) &
+                    /(Ph(i,k)-Ph(i,k+1)) &
+              -sigmaw(i)*(1.-sigmaw(i))*deltaxtw(ixt,i,k) &
+              *(omg(i,k)-omg(i,k+1))/(Ph(i,k)-Ph(i,k+1)) &
+              )
+        enddo !do ixt=1,ntraciso
+#endif 
+        ELSE IF (wk_adv(i) .AND. k==kupper(i)) THEN
+          d_te(i, k) = dtimesub*(rre1(i)*omg(i,k)*sigmaw(i)*d_th1(i,k)/(ph(i,k)-ph(i,k+1)))*ppi(i, k)
+
+          d_qe(i, k) = dtimesub*(rre1(i)*omg(i,k)*sigmaw(i)*d_q1(i,k)/(ph(i,k)-ph(i,k+1)))
+
+#ifdef ISO
+        do ixt=1,ntraciso
+         d_xte(ixt,i,k) =  dtimesub*( &
+            ( rre1(i)*omg(i,k  )*sigmaw(i)  *d_xt1(ixt,i,k)     &   
+             /(Ph(i,k)-Ph(i,k+1))) &
+                            )
+        enddo !do ixt=1,ntraciso
+#endif
+        END IF
+        ! cc
+      END DO
+    END DO
+    ! ------------------------------------------------------------------
+
+    IF (prt_level>=10) THEN
+      PRINT *, 'wake-4.3, d_deltatw(igout,k) ', (k,d_deltatw(igout,k), k=1,klev)
+      PRINT *, 'wake-4.3, d_deltaqw(igout,k) ', (k,d_deltaqw(igout,k), k=1,klev)
+    ENDIF
+
+    ! Increment state variables
+!jyg<
+    IF (iflag_wk_pop_dyn >= 1) THEN
+      DO k = 1, klev
+        DO i = 1, klon
+          IF (wk_adv(i) .AND. k<=kupper(i)) THEN
+            detr(i,k) = - d_sig_death(i) - d_sig_col(i)      
+            entr(i,k) = d_sig_gen(i)
+          ENDIF
+        ENDDO
+      ENDDO
+      ELSE  ! (iflag_wk_pop_dyn >= 1)
+      DO k = 1, klev
+        DO i = 1, klon
+          IF (wk_adv(i) .AND. k<=kupper(i)) THEN
+            detr(i, k) = 0.
+   
+            entr(i, k) = 0.
+          ENDIF
+        ENDDO
+      ENDDO
+    ENDIF  ! (iflag_wk_pop_dyn >= 1)
+
+    
+
+    DO k = 1, klev
+      DO i = 1, klon
+        ! cc nrlmd       IF( wk_adv(i) .AND. k .LE. kupper(i)-1) THEN
+        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
+          ! cc
+
+
+
+          ! Coefficient de répartition
+
+          crep(i, k) = crep_sol*(ph(i,kupper(i))-ph(i,k))/ &
+            (ph(i,kupper(i))-ph(i,1))
+          crep(i, k) = crep(i, k) + crep_upper*(ph(i,1)-ph(i,k))/ &
+            (p(i,1)-ph(i,kupper(i)))
+
+
+          ! Reintroduce compensating subsidence term.
+
+          ! dtKE(k)=(dtdwn(k)*Crep(k))/sigmaw
+          ! dtKE(k)=dtKE(k)-(dtdwn(k)*(1-Crep(k))+dta(k))
+          ! .                   /(1-sigmaw)
+          ! dqKE(k)=(dqdwn(k)*Crep(k))/sigmaw
+          ! dqKE(k)=dqKE(k)-(dqdwn(k)*(1-Crep(k))+dqa(k))
+          ! .                   /(1-sigmaw)
+
+          ! dtKE(k)=(dtdwn(k)*Crep(k)+(1-Crep(k))*dta(k))/sigmaw
+          ! dtKE(k)=dtKE(k)-(dtdwn(k)*(1-Crep(k))+dta(k)*Crep(k))
+          ! .                   /(1-sigmaw)
+          ! dqKE(k)=(dqdwn(k)*Crep(k)+(1-Crep(k))*dqa(k))/sigmaw
+          ! dqKE(k)=dqKE(k)-(dqdwn(k)*(1-Crep(k))+dqa(k)*Crep(k))
+          ! .                   /(1-sigmaw)
+
+          dtke(i, k) = (dtdwn(i,k)/sigmaw(i)-dta(i,k)/(1.-sigmaw(i)))
+          dqke(i, k) = (dqdwn(i,k)/sigmaw(i)-dqa(i,k)/(1.-sigmaw(i)))
+#ifdef ISO
+        do ixt=1,ntraciso
+          dxtke(ixt,i,k)=(dxtdwn(ixt,i,k)/sigmaw(i) - dxta(ixt,i,k) &
+               /(1.-sigmaw(i)))
+        enddo !do ixt=1,ntraciso
+#ifdef ISOVERIF
+      if (iso_eau.gt.0) then
+        call iso_verif_egalite(dqke(i,k),dxtKE(iso_eau,i,k),'wake 1621a')
+        call iso_verif_egalite(dqdwn(i,k),dxtdwn(iso_eau,i,k),'wake 1621b')
+        call iso_verif_egalite(dqa(i,k),dxta(iso_eau,i,k),'wake 1621c')
+        call iso_verif_egalite(d_deltaqw(i,k),d_deltaxtw(iso_eau,i,k),'wake 1621d')
+      endif
+#endif
+#endif
+          ! print*,'dtKE= ',dtKE(i,k),' dqKE= ',dqKE(i,k)
+
+!
+
+          ! cc nrlmd          Prise en compte du taux de mortalité
+          ! cc               Définitions de entr, detr
+!jyg<
+!!            detr(i, k) = 0.
+!!   
+!!            entr(i, k) = detr(i, k) + gfl(i)*cstar(i) + &
+!!              sigmaw(i)*(1.-sigmaw(i))*dp_deltomg(i, k)
+!!
+            entr(i, k) = entr(i,k) + gfl(i)*cstar(i) + &
+                         sigmaw(i)*(1.-sigmaw(i))*dp_deltomg(i, k)   
+!>jyg
+            spread(i, k) = (entr(i,k)-detr(i,k))/sigmaw(i)
+
+          ! cc        spread(i,k) =
+          ! (1.-sigmaw(i))*dp_deltomg(i,k)+gfl(i)*Cstar(i)/
+          ! cc     $  sigmaw(i)
+
+
+          ! ajout d'un effet onde de gravité -Tgw(k)*deltatw(k) 03/02/06 YU
+          ! Jingmei
+
+          ! write(lunout,*)'wake.F ',i,k, dtimesub,d_deltat_gw(i,k),
+          ! &  Tgw(i,k),deltatw(i,k)
+          d_deltat_gw(i, k) = d_deltat_gw(i, k) - tgw(i, k)*deltatw(i, k)* &
+            dtimesub
+          ! write(lunout,*)'wake.F ',i,k, dtimesub,d_deltatw(i,k)
+          ff(i) = d_deltatw(i, k)/dtimesub
+
+          ! Sans GW
+
+          ! deltatw(k)=deltatw(k)+dtimesub*(ff+dtKE(k)-spread(k)*deltatw(k))
+
+          ! GW formule 1
+
+          ! deltatw(k) = deltatw(k)+dtimesub*
+          ! $         (ff+dtKE(k) - spread(k)*deltatw(k)-Tgw(k)*deltatw(k))
+
+          ! GW formule 2
+
+          IF (dtimesub*tgw(i,k)<1.E-10) THEN
+            d_deltatw(i, k) = dtimesub*(ff(i)+dtke(i,k) - & 
+               entr(i,k)*deltatw(i,k)/sigmaw(i) - &
+               (death_rate(i)*sigmaw(i)+detr(i,k))*deltatw(i,k)/(1.-sigmaw(i)) - & ! cc
+               tgw(i,k)*deltatw(i,k) )
+          ELSE
+            d_deltatw(i, k) = 1/tgw(i, k)*(1-exp(-dtimesub*tgw(i,k)))* &
+               (ff(i)+dtke(i,k) - &
+                entr(i,k)*deltatw(i,k)/sigmaw(i) - &
+                (death_rate(i)*sigmaw(i)+detr(i,k))*deltatw(i,k)/(1.-sigmaw(i)) - &
+                tgw(i,k)*deltatw(i,k) )
+          END IF
+
+          dth(i, k) = deltatw(i, k)/ppi(i, k)
+
+          gg(i) = d_deltaqw(i, k)/dtimesub
+
+          d_deltaqw(i, k) = dtimesub*(gg(i)+dqke(i,k) - & 
+            entr(i,k)*deltaqw(i,k)/sigmaw(i) - &
+            (death_rate(i)*sigmaw(i)+detr(i,k))*deltaqw(i,k)/(1.-sigmaw(i)))
+#ifdef ISO
+        do ixt=1,ntraciso
+          gg(i)=d_deltaxtw(ixt,i,k)/dtimesub
+          d_deltaxtw(ixt,i,k) = dtimesub*(gg(i) + dxtKE(ixt,i,k) - &
+             entr(i,k)*deltaxtw(ixt,i,k)/sigmaw(i) - &
+             (death_rate(i)*sigmaw(i)+detr(i,k))*deltaxtw(ixt,i,k)/(1.-sigmaw(i)))
+        enddo !do ixt=1,ntraciso
+#ifdef ISOVERIF
+      if (iso_eau.gt.0) then
+        call iso_verif_egalite(dqke(i,k),dxtKE(iso_eau,i,k),'wake 1692a')
+        call iso_verif_egalite(deltaqw(i,k),deltaxtw(iso_eau,i,k),'wake 1692b')
+        call iso_verif_egalite(d_deltaqw(i,k),d_deltaxtw(iso_eau,i,k),'wake 1692c')
+      endif
+#endif
+#endif
+          ! cc
+
+          ! cc nrlmd
+          ! cc       d_deltatw2(i,k)=d_deltatw2(i,k)+d_deltatw(i,k)
+          ! cc       d_deltaqw2(i,k)=d_deltaqw2(i,k)+d_deltaqw(i,k)
+          ! cc
+        END IF
+      END DO
+    END DO
+
+#ifdef ISO
+#ifdef ISOVERIF
+      if (iso_eau.gt.0) then
+             call iso_verif_egalite_vect2D(d_deltaxtw,d_deltaqw, &
+                 'wake 1359',ntraciso,klon,klev)
+      endif      
+#endif         
+#endif  
+
+    ! Scale tendencies so that water vapour remains positive in w and x.
+
+    CALL wake_vec_modulation(klon, klev, wk_adv, epsilon, qe, d_qe, deltaqw, &
+      d_deltaqw, sigmaw, d_sigmaw, alpha)
+
+    ! cc nrlmd
+    ! c      print*,'alpha'
+    ! c      do i=1,klon
+    ! c         print*,alpha(i)
+    ! c      end do
+    ! cc
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
+          d_te(i, k) = alpha(i)*d_te(i, k)
+          d_qe(i, k) = alpha(i)*d_qe(i, k)
+          d_deltatw(i, k) = alpha(i)*d_deltatw(i, k)
+          d_deltaqw(i, k) = alpha(i)*d_deltaqw(i, k)
+          d_deltat_gw(i, k) = alpha(i)*d_deltat_gw(i, k)
+#ifdef ISO
+        do ixt=1,ntraciso
+          d_xte(ixt,i,k)=alpha(i)*d_xte(ixt,i,k)
+          d_deltaxtw(ixt,i,k)=alpha(i)*d_deltaxtw(ixt,i,k)
+        enddo !do ixt=1,ntraciso
+#endif
+        END IF
+      END DO
+    END DO
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        d_sigmaw(i) = alpha(i)*d_sigmaw(i)
+      END IF
+    END DO
+
+    ! Update large scale variables and wake variables
+    ! IM 060208 manque DO i + remplace DO k=1,kupper(i)
+    ! IM 060208     DO k = 1,kupper(i)
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
+          dtls(i, k) = dtls(i, k) + d_te(i, k)
+          dqls(i, k) = dqls(i, k) + d_qe(i, k)
+#ifdef ISO
+        do ixt=1,ntraciso
+          dxtls(ixt,i,k)=dxtls(ixt,i,k)+d_xte(ixt,i,k)
+        enddo !do ixt=1,ntraciso
+#endif
+          ! cc nrlmd
+          d_deltatw2(i, k) = d_deltatw2(i, k) + d_deltatw(i, k)
+          d_deltaqw2(i, k) = d_deltaqw2(i, k) + d_deltaqw(i, k)
+#ifdef ISO
+        do ixt=1,ntraciso
+          d_deltaxtw2(ixt,i,k)=d_deltaxtw2(ixt,i,k)+d_deltaxtw(ixt,i,k)
+        enddo !do ixt=1,ntraciso
+#endif
+          ! cc
+        END IF
+      END DO
+    END DO
+
+
+#ifdef ISO
+#ifdef ISOVERIF
+      if (iso_eau.gt.0) then
+        DO k= 1,klev 
+          DO i = 1,klon 
+              call iso_verif_egalite_choix(dxtls(iso_eau,i,k), &
+                dqls(i,k),'wake 1379',errmax,errmaxrel)
+          enddo ! DO i = 1,klon     
+        enddo ! DO k= 1,klev 
+      endif !if (iso_eau.gt.0) then
+#endif
+#endif
+
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
+          te(i, k) = te0(i, k) + dtls(i, k)
+          qe(i, k) = qe0(i, k) + dqls(i, k)
+          the(i, k) = te(i, k)/ppi(i, k)
+          deltatw(i, k) = deltatw(i, k) + d_deltatw(i, k)
+          deltaqw(i, k) = deltaqw(i, k) + d_deltaqw(i, k)
+          dth(i, k) = deltatw(i, k)/ppi(i, k)
+          ! c      print*,'k,qx,qw',k,qe(i,k)-sigmaw(i)*deltaqw(i,k)
+          ! c     $        ,qe(i,k)+(1-sigmaw(i))*deltaqw(i,k)
+#ifdef ISO
+        do ixt=1,ntraciso
+          xte(ixt,i,k) = xte0(ixt,i,k) + dxtls(ixt,i,k)
+          deltaxtw(ixt,i,k) = deltaxtw(ixt,i,k)+d_deltaxtw(ixt,i,k)
+        enddo !do ixt=1,ntraciso
+#endif
+        END IF
+      END DO
+    END DO
+!
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        sigmaw(i) = sigmaw(i) + d_sigmaw(i)
+        d_sigmaw2(i) = d_sigmaw2(i) + d_sigmaw(i)
+      END IF
+    END DO
+
+#ifdef ISO
+#ifdef ISOVERIF
+      write(*,*) 'wake 1859'
+      if (iso_eau.gt.0) then
+        DO k= 1,klev 
+          DO i = 1,klon 
+              call iso_verif_egalite_choix(xte(iso_eau,i,k), &
+                qe(i,k),'wake 1379',errmax,errmaxrel)
+          enddo ! DO i = 1,klon     
+        enddo ! DO k= 1,klev 
+      endif !if (iso_eau.gt.0) then     
+      if (iso_hdo.gt.0) then
+      call iso_verif_aberrant_enc_vect2D( &
+            xte,qe, &
+            'wake 1456, xte apres modifs',ntraciso,klon,klev)
+!      call iso_verif_aberrant_enc_vect2D_ns(
+!     :       deltaxtw,deltaqw,
+!     :       'wake 1518, deltaqw apres modifs',ntraciso,klon,klev)
+      endif
+#endif
+#endif 
+
+!jyg<
+    IF (iflag_wk_pop_dyn >= 1) THEN
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          awdens(i) = awdens(i) + d_awdens(i)
+          wdens(i) = wdens(i) + d_wdens(i)
+          d_awdens2(i) = d_awdens2(i) + d_awdens(i)
+          d_wdens2(i) = d_wdens2(i) + d_wdens(i)
+        END IF
+      END DO
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          wdens_targ = max(wdens(i),wdensmin)
+          d_wdens2(i) = d_wdens2(i) + wdens_targ - wdens(i)
+          wdens(i) = wdens_targ
+!
+          wdens_targ = min( max(awdens(i),0.), wdens(i) )
+          d_awdens2(i) = d_awdens2(i) + wdens_targ - awdens(i)
+          awdens(i) = wdens_targ
+        END IF
+      END DO
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          sigmaw_targ = max(sigmaw(i),sigmad)
+          d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
+          sigmaw(i) = sigmaw_targ
+        END IF
+      END DO
+    ENDIF  ! (iflag_wk_pop_dyn >= 1)
+!>jyg
+
+
+    ! Determine Ptop from buoyancy integral
+    ! ---------------------------------------
+
+    ! -     1/ Pressure of the level where dth changes sign.
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        ptop_provis(i) = ph(i, 1)
+      END IF
+    END DO
+
+    DO k = 2, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. ptop_provis(i)==ph(i,1) .AND. &
+            dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN
+          ptop_provis(i) = ((dth(i,k)+delta_t_min)*p(i,k-1) - &
+                            (dth(i,k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
+        END IF
+      END DO
+    END DO
+
+    ! -     2/ dth integral
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        sum_dth(i) = 0.
+        dthmin(i) = -delta_t_min
+        z(i) = 0.
+      END IF
+    END DO
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          dz(i) = -(amax1(ph(i,k+1),ptop_provis(i))-ph(i,k))/(rho(i,k)*rg)
+          IF (dz(i)>0) THEN
+            z(i) = z(i) + dz(i)
+            sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
+            dthmin(i) = amin1(dthmin(i), dth(i,k))
+          END IF
+        END IF
+      END DO
+    END DO
+
+    ! -     3/ height of triangle with area= sum_dth and base = dthmin
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        hw(i) = 2.*sum_dth(i)/amin1(dthmin(i), -0.5)
+        hw(i) = amax1(hwmin, hw(i))
+      END IF
+    END DO
+
+    ! -     4/ now, get Ptop
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        ktop(i) = 0
+        z(i) = 0.
+      END IF
+    END DO
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN
+          dz(i) = amin1(-(ph(i,k+1)-ph(i,k))/(rho(i,k)*rg), hw(i)-z(i))
+          IF (dz(i)>0) THEN
+            z(i) = z(i) + dz(i)
+            ptop(i) = ph(i, k) - rho(i, k)*rg*dz(i)
+            ktop(i) = k
+          END IF
+        END IF
+      END DO
+    END DO
+
+    ! 4.5/Correct ktop and ptop
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        ptop_new(i) = ptop(i)
+      END IF
+    END DO
+
+    DO k = klev, 2, -1
+      DO i = 1, klon
+        ! IM v3JYG; IF (k .GE. ktop(i)
+        IF (wk_adv(i) .AND. k<=ktop(i) .AND. ptop_new(i)==ptop(i) .AND. &
+            dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN
+          ptop_new(i) = ((dth(i,k)+delta_t_min)*p(i,k-1) - &
+                         (dth(i,k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
+        END IF
+      END DO
+    END DO
+
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN
+        ptop(i) = ptop_new(i)
+      END IF
+    END DO
+
+    DO k = klev, 1, -1
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN !!! nrlmd
+          IF (ph(i,k+1)<ptop(i)) ktop(i) = k
+        END IF
+      END DO
+    END DO
+
+    ! 5/ Set deltatw & deltaqw to 0 above kupper
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i) .AND. k>=kupper(i)) THEN
+          deltatw(i, k) = 0.
+          deltaqw(i, k) = 0.
+          d_deltatw2(i,k) = -deltatw0(i,k)
+          d_deltaqw2(i,k) = -deltaqw0(i,k)
+#ifdef ISO
+        do ixt=1,ntraciso
+          deltaxtw(ixt,i,k) = 0.
+          d_deltaxtw2(ixt,i,k) = -deltaxtw0(ixt,i,k)
+        enddo !do ixt=1,ntraciso
+#endif
+        END IF
+      END DO
+    END DO
+
+
+    ! -------------Cstar computation---------------------------------
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        sum_thu(i) = 0.
+        sum_tu(i) = 0.
+        sum_qu(i) = 0.
+        sum_thvu(i) = 0.
+        sum_dth(i) = 0.
+        sum_dq(i) = 0.
+        sum_rho(i) = 0.
+        sum_dtdwn(i) = 0.
+        sum_dqdwn(i) = 0.
+
+        av_thu(i) = 0.
+        av_tu(i) = 0.
+        av_qu(i) = 0.
+        av_thvu(i) = 0.
+        av_dth(i) = 0.
+        av_dq(i) = 0.
+        av_rho(i) = 0.
+        av_dtdwn(i) = 0.
+        av_dqdwn(i) = 0.
+      END IF
+    END DO
+
+    ! Integrals (and wake top level number)
+    ! --------------------------------------
+
+    ! Initialize sum_thvu to 1st level virt. pot. temp.
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        z(i) = 1.
+        dz(i) = 1.
+        sum_thvu(i) = thu(i, 1)*(1.+epsim1*qu(i,1))*dz(i)
+        sum_dth(i) = 0.
+      END IF
+    END DO
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN !!! nrlmd
+          dz(i) = -(max(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*rg)
+          IF (dz(i)>0) THEN
+            z(i) = z(i) + dz(i)
+            sum_thu(i) = sum_thu(i) + thu(i, k)*dz(i)
+            sum_tu(i) = sum_tu(i) + tu(i, k)*dz(i)
+            sum_qu(i) = sum_qu(i) + qu(i, k)*dz(i)
+            sum_thvu(i) = sum_thvu(i) + thu(i, k)*(1.+epsim1*qu(i,k))*dz(i)
+            sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
+            sum_dq(i) = sum_dq(i) + deltaqw(i, k)*dz(i)
+            sum_rho(i) = sum_rho(i) + rhow(i, k)*dz(i)
+            sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i, k)*dz(i)
+            sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i, k)*dz(i)
+          END IF
+        END IF
+      END DO
+    END DO
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        hw0(i) = z(i)
+      END IF
+    END DO
+
+
+    ! - WAPE and mean forcing computation
+    ! ---------------------------------------
+
+    ! ---------------------------------------
+
+    ! Means
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        av_thu(i) = sum_thu(i)/hw0(i)
+        av_tu(i) = sum_tu(i)/hw0(i)
+        av_qu(i) = sum_qu(i)/hw0(i)
+        av_thvu(i) = sum_thvu(i)/hw0(i)
+        av_dth(i) = sum_dth(i)/hw0(i)
+        av_dq(i) = sum_dq(i)/hw0(i)
+        av_rho(i) = sum_rho(i)/hw0(i)
+        av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
+        av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
+
+        wape(i) = -rg*hw0(i)*(av_dth(i)+epsim1*(av_thu(i)*av_dq(i) + &
+                              av_dth(i)*av_qu(i)+av_dth(i)*av_dq(i)))/av_thvu(i)
+      END IF
+    END DO
+
+    ! Filter out bad wakes
+
+    DO k = 1, klev
+      DO i = 1, klon
+        IF (wk_adv(i)) THEN !!! nrlmd
+          IF (wape(i)<0.) THEN
+            deltatw(i, k) = 0.
+            deltaqw(i, k) = 0.
+            dth(i, k) = 0.
+            d_deltatw2(i,k) = -deltatw0(i,k)
+            d_deltaqw2(i,k) = -deltaqw0(i,k)
+#ifdef ISO
+        do ixt=1,ntraciso
+          deltaxtw(ixt,i,k) = 0.
+          d_deltaxtw2(ixt,i,k) = -deltaxtw0(ixt,i,k)
+        enddo !do ixt=1,ntraciso
+#endif
+          END IF
+        END IF
+      END DO
+    END DO
+
+    DO i = 1, klon
+      IF (wk_adv(i)) THEN !!! nrlmd
+        IF (wape(i)<0.) THEN
+          wape(i) = 0.
+          cstar(i) = 0.
+          hw(i) = hwmin
+!jyg<
+!!          sigmaw(i) = max(sigmad, sigd_con(i))
+          sigmaw_targ = max(sigmad, sigd_con(i))
+          d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
+          sigmaw(i) = sigmaw_targ
+!>jyg
+          fip(i) = 0.
+          gwake(i) = .FALSE.
+        ELSE
+          cstar(i) = stark*sqrt(2.*wape(i))
+          gwake(i) = .TRUE.
+        END IF
+      END IF
+    END DO
+
+  END DO ! end sub-timestep loop
+
+  IF (prt_level>=10) THEN
+    PRINT *, 'wake-5, sigmaw(igout), cstar(igout), wape(igout), ptop(igout) ', &
+                      sigmaw(igout), cstar(igout), wape(igout), ptop(igout)
+  ENDIF
+
+
+  ! ----------------------------------------------------------
+  ! Determine wake final state; recompute wape, cstar, ktop;
+  ! filter out bad wakes.
+  ! ----------------------------------------------------------
+
+  ! 2.1 - Undisturbed area and Wake integrals
+  ! ---------------------------------------------------------
+
+  DO i = 1, klon
+    ! cc nrlmd       if (wk_adv(i)) then !!! nrlmd
+    IF (ok_qx_qw(i)) THEN
+      ! cc
+      z(i) = 0.
+      sum_thu(i) = 0.
+      sum_tu(i) = 0.
+      sum_qu(i) = 0.
+      sum_thvu(i) = 0.
+      sum_dth(i) = 0.
+      sum_half_dth(i) = 0.
+      sum_dq(i) = 0.
+      sum_rho(i) = 0.
+      sum_dtdwn(i) = 0.
+      sum_dqdwn(i) = 0.
+
+      av_thu(i) = 0.
+      av_tu(i) = 0.
+      av_qu(i) = 0.
+      av_thvu(i) = 0.
+      av_dth(i) = 0.
+      av_dq(i) = 0.
+      av_rho(i) = 0.
+      av_dtdwn(i) = 0.
+      av_dqdwn(i) = 0.
+
+      dthmin(i) = -delta_t_min
+    END IF
+  END DO
+  ! Potential temperatures and humidity
+  ! ----------------------------------------------------------
+
+  DO k = 1, klev
+    DO i = 1, klon
+      ! cc nrlmd       IF ( wk_adv(i)) THEN
+      IF (ok_qx_qw(i)) THEN
+        ! cc
+        rho(i, k) = p(i, k)/(rd*te(i,k))
+        IF (k==1) THEN
+          rhoh(i, k) = ph(i, k)/(rd*te(i,k))
+          zhh(i, k) = 0
+        ELSE
+          rhoh(i, k) = ph(i, k)*2./(rd*(te(i,k)+te(i,k-1)))
+          zhh(i, k) = (ph(i,k)-ph(i,k-1))/(-rhoh(i,k)*rg) + zhh(i, k-1)
+        END IF
+        the(i, k) = te(i, k)/ppi(i, k)
+        thu(i, k) = (te(i,k)-deltatw(i,k)*sigmaw(i))/ppi(i, k)
+        tu(i, k) = te(i, k) - deltatw(i, k)*sigmaw(i)
+        qu(i, k) = qe(i, k) - deltaqw(i, k)*sigmaw(i)
+        rhow(i, k) = p(i, k)/(rd*(te(i,k)+deltatw(i,k)))
+        dth(i, k) = deltatw(i, k)/ppi(i, k)
+#ifdef ISO
+        do ixt=1,ntraciso
+          xtu(ixt,i,k)  =  xte(ixt,i,k) - deltaxtw(ixt,i,k)*sigmaw(i)
+        enddo !do ixt=1,ntraciso
+#endif
+      END IF
+    END DO
+  END DO
+
+#ifdef ISO
+#ifdef ISOVERIF
+      if (iso_hdo.gt.0) then
+      call iso_verif_aberrant_enc_vect2D( &
+              xtu,qu, &
+              'wake 1834, apres modifs',ntraciso,klon,klev)
+      endif   
+#endif
+#endif   
+
+  ! Integrals (and wake top level number)
+  ! -----------------------------------------------------------
+
+  ! Initialize sum_thvu to 1st level virt. pot. temp.
+
+  DO i = 1, klon
+    ! cc nrlmd       IF ( wk_adv(i)) THEN
+    IF (ok_qx_qw(i)) THEN
+      ! cc
+      z(i) = 1.
+      dz(i) = 1.
+      dz_half(i) = 1.
+      sum_thvu(i) = thu(i, 1)*(1.+epsim1*qu(i,1))*dz(i)
+      sum_dth(i) = 0.
+    END IF
+  END DO
+
+  DO k = 1, klev
+    DO i = 1, klon
+      ! cc nrlmd       IF ( wk_adv(i)) THEN
+      IF (ok_qx_qw(i)) THEN
+        ! cc
+        dz(i) = -(amax1(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*rg)
+        dz_half(i) = -(amax1(ph(i,k+1),0.5*(ptop(i)+ph(i,1)))-ph(i,k))/(rho(i,k)*rg)
+        IF (dz(i)>0) THEN
+          z(i) = z(i) + dz(i)
+          sum_thu(i) = sum_thu(i) + thu(i, k)*dz(i)
+          sum_tu(i) = sum_tu(i) + tu(i, k)*dz(i)
+          sum_qu(i) = sum_qu(i) + qu(i, k)*dz(i)
+          sum_thvu(i) = sum_thvu(i) + thu(i, k)*(1.+epsim1*qu(i,k))*dz(i)
+          sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
+          sum_dq(i) = sum_dq(i) + deltaqw(i, k)*dz(i)
+          sum_rho(i) = sum_rho(i) + rhow(i, k)*dz(i)
+          sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i, k)*dz(i)
+          sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i, k)*dz(i)
+!
+          dthmin(i) = min(dthmin(i), dth(i,k))
+        END IF
+        IF (dz_half(i)>0) THEN
+          sum_half_dth(i) = sum_half_dth(i) + dth(i, k)*dz_half(i)
+        END IF
+      END IF
+    END DO
+  END DO
+
+  DO i = 1, klon
+    ! cc nrlmd       IF ( wk_adv(i)) THEN
+    IF (ok_qx_qw(i)) THEN
+      ! cc
+      hw0(i) = z(i)
+    END IF
+  END DO
+
+  ! - WAPE and mean forcing computation
+  ! -------------------------------------------------------------
+
+  ! Means
+
+  DO i = 1, klon
+    ! cc nrlmd       IF ( wk_adv(i)) THEN
+    IF (ok_qx_qw(i)) THEN
+      ! cc
+      av_thu(i) = sum_thu(i)/hw0(i)
+      av_tu(i) = sum_tu(i)/hw0(i)
+      av_qu(i) = sum_qu(i)/hw0(i)
+      av_thvu(i) = sum_thvu(i)/hw0(i)
+      av_dth(i) = sum_dth(i)/hw0(i)
+      av_dq(i) = sum_dq(i)/hw0(i)
+      av_rho(i) = sum_rho(i)/hw0(i)
+      av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
+      av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
+
+      wape2(i) = -rg*hw0(i)*(av_dth(i)+epsim1*(av_thu(i)*av_dq(i) + &
+                             av_dth(i)*av_qu(i)+av_dth(i)*av_dq(i)))/av_thvu(i)
+    END IF
+  END DO
+
+
+
+  ! Prognostic variable update
+  ! ------------------------------------------------------------
+
+  ! Filter out bad wakes
+
+  IF (iflag_wk_check_trgl>=1) THEN
+    ! Check triangular shape of dth profile
+    DO i = 1, klon
+      IF (ok_qx_qw(i)) THEN
+        !! print *,'wake, hw0(i), dthmin(i) ', hw0(i), dthmin(i)
+        !! print *,'wake, 2.*sum_dth(i)/(hw0(i)*dthmin(i)) ', &
+        !!                2.*sum_dth(i)/(hw0(i)*dthmin(i))
+        !! print *,'wake, sum_half_dth(i), sum_dth(i) ', &
+        !!                sum_half_dth(i), sum_dth(i)
+        IF ((hw0(i) < 1.) .or. (dthmin(i) >= -delta_t_min) ) THEN
+          wape2(i) = -1.
+          !! print *,'wake, rej 1'
+        ELSE IF (iflag_wk_check_trgl==1.AND.abs(2.*sum_dth(i)/(hw0(i)*dthmin(i)) - 1.) > 0.5) THEN
+          wape2(i) = -1.
+          !! print *,'wake, rej 2'
+        ELSE IF (abs(sum_half_dth(i)) < 0.5*abs(sum_dth(i)) ) THEN
+          wape2(i) = -1.
+          !! print *,'wake, rej 3'
+        END IF
+      END IF
+    END DO
+  END IF
+
+
+  DO k = 1, klev
+    DO i = 1, klon
+      ! cc nrlmd        IF ( wk_adv(i) .AND. wape2(i) .LT. 0.) THEN
+      IF (ok_qx_qw(i) .AND. wape2(i)<0.) THEN
+        ! cc
+        deltatw(i, k) = 0.
+        deltaqw(i, k) = 0.
+        dth(i, k) = 0.
+        d_deltatw2(i,k) = -deltatw0(i,k)
+        d_deltaqw2(i,k) = -deltaqw0(i,k)
+#ifdef ISO
+        do ixt=1,ntraciso
+          deltaxtw(ixt,i,k) = 0.
+          d_deltaxtw2(ixt,i,k) = -deltaxtw0(ixt,i,k)
+        enddo !do ixt=1,ntraciso
+#endif
+      END IF
+    END DO
+  END DO
+
+
+  DO i = 1, klon
+    ! cc nrlmd       IF ( wk_adv(i)) THEN
+    IF (ok_qx_qw(i)) THEN
+      ! cc
+      IF (wape2(i)<0.) THEN
+        wape2(i) = 0.
+        cstar2(i) = 0.
+        hw(i) = hwmin
+!jyg<
+!!      sigmaw(i) = amax1(sigmad, sigd_con(i))
+      sigmaw_targ = max(sigmad, sigd_con(i))
+      d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
+      sigmaw(i) = sigmaw_targ
+!>jyg
+        fip(i) = 0.
+        gwake(i) = .FALSE.
+      ELSE
+        IF (prt_level>=10) PRINT *, 'wape2>0'
+        cstar2(i) = stark*sqrt(2.*wape2(i))
+        gwake(i) = .TRUE.
+      END IF
+    END IF
+  END DO
+
+  DO i = 1, klon
+    ! cc nrlmd       IF ( wk_adv(i)) THEN
+    IF (ok_qx_qw(i)) THEN
+      ! cc
+      ktopw(i) = ktop(i)
+    END IF
+  END DO
+
+  DO i = 1, klon
+    ! cc nrlmd       IF ( wk_adv(i)) THEN
+    IF (ok_qx_qw(i)) THEN
+      ! cc
+      IF (ktopw(i)>0 .AND. gwake(i)) THEN
+
+        ! jyg1     Utilisation d'un h_efficace constant ( ~ feeding layer)
+        ! cc       heff = 600.
+        ! Utilisation de la hauteur hw
+        ! c       heff = 0.7*hw
+        heff(i) = hw(i)
+
+        fip(i) = 0.5*rho(i, ktopw(i))*cstar2(i)**3*heff(i)*2* &
+          sqrt(sigmaw(i)*wdens(i)*3.14)
+        fip(i) = alpk*fip(i)
+        ! jyg2
+      ELSE
+        fip(i) = 0.
+      END IF
+    END IF
+  END DO
+
+  ! Limitation de sigmaw
+
+  ! cc nrlmd
+  ! DO i=1,klon
+  ! IF (OK_qx_qw(i)) THEN
+  ! IF (sigmaw(i).GE.sigmaw_max) sigmaw(i)=sigmaw_max
+  ! ENDIF
+  ! ENDDO
+  ! cc
+
+  !jyg<
+  IF (iflag_wk_pop_dyn >= 1) THEN
+    DO i = 1, klon
+      kill_wake(i) = ((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
+          .NOT. ok_qx_qw(i) .OR. (wdens(i) < 2.*wdensmin)
+    ENDDO
+  ELSE  ! (iflag_wk_pop_dyn >= 1)
+    DO i = 1, klon
+      kill_wake(i) = ((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
+          .NOT. ok_qx_qw(i)
+    ENDDO
+  ENDIF  ! (iflag_wk_pop_dyn >= 1)
+  !>jyg
+
+  DO k = 1, klev
+    DO i = 1, klon
+!!jyg      IF (((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
+!!jyg          .NOT. ok_qx_qw(i)) THEN
+      IF (kill_wake(i)) THEN
+        ! cc
+        dtls(i, k) = 0.
+        dqls(i, k) = 0.
+        deltatw(i, k) = 0.
+        deltaqw(i, k) = 0.
+        d_deltatw2(i,k) = -deltatw0(i,k)
+        d_deltaqw2(i,k) = -deltaqw0(i,k)
+#ifdef ISO
+        do ixt=1,ntraciso
+          dxtls(ixt,i,k) = 0.
+          deltaxtw(ixt,i,k) = 0.
+          d_deltaxtw2(ixt,i,k) = -deltaxtw0(ixt,i,k)
+        enddo !do ixt=1,ntraciso
+#endif
+      END IF  ! (kill_wake(i))
+    END DO
+  END DO
+
+  DO i = 1, klon
+!!jyg    IF (((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
+!!jyg        .NOT. ok_qx_qw(i)) THEN
+      IF (kill_wake(i)) THEN
+      ktopw(i) = 0
+      wape(i) = 0.
+      cstar(i) = 0.
+!!jyg   Outside subroutine "Wake" hw, wdens and sigmaw are zero when there are no wakes
+!!      hw(i) = hwmin                       !jyg
+!!      sigmaw(i) = sigmad                  !jyg
+      hw(i) = 0.                            !jyg
+      fip(i) = 0.
+!!      sigmaw(i) = 0.                        !jyg
+      sigmaw_targ = 0.
+      d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
+      sigmaw(i) = sigmaw_targ
+      IF (iflag_wk_pop_dyn >= 1) THEN
+!!        awdens(i) = 0.
+!!        wdens(i) = 0.
+        wdens_targ = 0.
+        d_wdens2(i) = wdens_targ - wdens(i)
+        wdens(i) = wdens_targ
+        wdens_targ = 0.
+        d_awdens2(i) = wdens_targ - awdens(i)
+        awdens(i) = wdens_targ
+      ENDIF  ! (iflag_wk_pop_dyn >= 1)
+    ELSE  ! (kill_wake(i))
+      wape(i) = wape2(i)
+      cstar(i) = cstar2(i)
+    END IF  ! (kill_wake(i))
+    ! c        print*,'wape wape2 ktopw OK_qx_qw =',
+    ! c     $          wape(i),wape2(i),ktopw(i),OK_qx_qw(i)
+  END DO
+
+  IF (prt_level>=10) THEN
+    PRINT *, 'wake-6, wape wape2 ktopw OK_qx_qw =', &
+                      wape(igout),wape2(igout),ktopw(igout),OK_qx_qw(igout)
+  ENDIF
+
+
+  ! -----------------------------------------------------------------
+  ! Get back to tendencies per second
+
+  DO k = 1, klev
+    DO i = 1, klon
+
+      ! cc nrlmd        IF ( wk_adv(i) .AND. k .LE. kupper(i)) THEN
+!jyg<
+!!      IF (ok_qx_qw(i) .AND. k<=kupper(i)) THEN
+      IF (ok_qx_qw(i)) THEN
+!>jyg
+        ! cc
+        dtls(i, k) = dtls(i, k)/dtime
+        dqls(i, k) = dqls(i, k)/dtime
+        d_deltatw2(i, k) = d_deltatw2(i, k)/dtime
+        d_deltaqw2(i, k) = d_deltaqw2(i, k)/dtime
+        d_deltat_gw(i, k) = d_deltat_gw(i, k)/dtime
+        ! c      print*,'k,dqls,omg,entr,detr',k,dqls(i,k),omg(i,k),entr(i,k)
+        ! c     $         ,death_rate(i)*sigmaw(i)
+#ifdef ISO
+        do ixt=1,ntraciso
+          dxtls(ixt,i, k) = dxtls(ixt,i, k)/dtime
+          d_deltaxtw2(ixt,i, k) = d_deltaxtw2(ixt,i, k)/dtime
+        enddo
+#endif
+      END IF
+    END DO
+  END DO
+!jyg<
+  DO i = 1, klon
+    d_sigmaw2(i) = d_sigmaw2(i)/dtime
+    d_awdens2(i) = d_awdens2(i)/dtime
+    d_wdens2(i) = d_wdens2(i)/dtime
+  ENDDO
+!>jyg
+
+
+
+  RETURN
+END SUBROUTINE wake
+
+SUBROUTINE wake_vec_modulation(nlon, nl, wk_adv, epsilon, qe, d_qe, deltaqw, &
+    d_deltaqw, sigmaw, d_sigmaw, alpha)
+  ! ------------------------------------------------------
+  ! D\'etermination du coefficient alpha tel que les tendances
+  ! corriges alpha*d_G, pour toutes les grandeurs G, correspondent
+  ! a une humidite positive dans la zone (x) et dans la zone (w).
+  ! ------------------------------------------------------
+  IMPLICIT NONE
+
+  ! Input
+  REAL qe(nlon, nl), d_qe(nlon, nl)
+  REAL deltaqw(nlon, nl), d_deltaqw(nlon, nl)
+  REAL sigmaw(nlon), d_sigmaw(nlon)
+  LOGICAL wk_adv(nlon)
+  INTEGER nl, nlon
+  ! Output
+  REAL alpha(nlon)
+  ! Internal variables
+  REAL zeta(nlon, nl)
+  REAL alpha1(nlon)
+  REAL x, a, b, c, discrim
+  REAL epsilon
+  ! DATA epsilon/1.e-15/
+  INTEGER i,k
+
+  DO k = 1, nl
+    DO i = 1, nlon
+      IF (wk_adv(i)) THEN
+        IF ((deltaqw(i,k)+d_deltaqw(i,k))>=0.) THEN
+          zeta(i, k) = 0.
+        ELSE
+          zeta(i, k) = 1.
+        END IF
+      END IF
+    END DO
+    DO i = 1, nlon
+      IF (wk_adv(i)) THEN
+        x = qe(i, k) + (zeta(i,k)-sigmaw(i))*deltaqw(i, k) + d_qe(i, k) + &
+          (zeta(i,k)-sigmaw(i))*d_deltaqw(i, k) - d_sigmaw(i) * &
+          (deltaqw(i,k)+d_deltaqw(i,k))
+        a = -d_sigmaw(i)*d_deltaqw(i, k)
+        b = d_qe(i, k) + (zeta(i,k)-sigmaw(i))*d_deltaqw(i, k) - &
+          deltaqw(i, k)*d_sigmaw(i)
+        c = qe(i, k) + (zeta(i,k)-sigmaw(i))*deltaqw(i, k) + epsilon
+        discrim = b*b - 4.*a*c
+        ! print*, 'x, a, b, c, discrim', x, a, b, c, discrim
+        IF (a+b>=0.) THEN !! Condition suffisante pour la positivité de ovap
+          alpha1(i) = 1.
+        ELSE
+          IF (x>=0.) THEN
+            alpha1(i) = 1.
+          ELSE
+            IF (a>0.) THEN
+              alpha1(i) = 0.9*min( (2.*c)/(-b+sqrt(discrim)),  &
+                                   (-b+sqrt(discrim))/(2.*a) )
+            ELSE IF (a==0.) THEN
+              alpha1(i) = 0.9*(-c/b)
+            ELSE
+              ! print*,'a,b,c discrim',a,b,c discrim
+              alpha1(i) = 0.9*max( (2.*c)/(-b+sqrt(discrim)),  &
+                                   (-b+sqrt(discrim))/(2.*a))
+            END IF
+          END IF
+        END IF
+        alpha(i) = min(alpha(i), alpha1(i))
+      END IF
+    END DO
+  END DO
+
+  RETURN
+END SUBROUTINE wake_vec_modulation
+
+END MODULE lmdz_wake
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_wake_ini.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_wake_ini.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lmdz_wake_ini.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/lmdz_wake_ini.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/lscp_ini_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lscp_ini_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/lscp_ini_mod.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/lscp_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lscp_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/lscp_mod.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/lscp_tools_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/lscp_tools_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/lscp_tools_mod.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/modd_csts.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/modd_csts.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/modd_csts.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/modd_csts.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/newmicro.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/newmicro.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/newmicro.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/pbl_surface_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/pbl_surface_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/pbl_surface_mod.F90	(revision 4727)
@@ -21,7 +21,8 @@
   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 lmdz_call_atke,      ONLY :  call_atke
   USE ioipsl_getin_p_mod,  ONLY : getin_p
   USE cdrag_mod
@@ -261,7 +262,7 @@
        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,           &
@@ -275,8 +276,8 @@
        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,                              &
@@ -301,5 +302,5 @@
        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,                    &
@@ -307,5 +308,5 @@
 !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
@@ -410,12 +411,7 @@
          dser, dt_ds, zsig, zmea
     use phys_output_var_mod, only: tkt, tks, taur, sss
-#ifdef CPP_XIOS
-    USE wxios, ONLY: missing_val
-#else
-    use netcdf, only: missing_val => nf90_fill_real
-#endif
-
-     
-
+    use lmdz_blowing_snow_ini, only : zeta_bs
+    USE wxios, ONLY: missing_val_xios => missing_val, using_xios
+    use netcdf, only: nf90_fill_real
 
     IMPLICIT NONE
@@ -442,6 +438,7 @@
     REAL, DIMENSION(klon),        INTENT(IN)        :: rugoro  ! rugosity length
     REAL, DIMENSION(klon),        INTENT(IN)        :: rmu0    ! cosine of solar zenith angle
-    REAL, DIMENSION(klon),        INTENT(IN)        :: rain_f  ! rain fall
+    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
@@ -449,4 +446,5 @@
     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
@@ -521,4 +519,5 @@
                                                                   ! (=> 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 ???
@@ -537,4 +536,6 @@
     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)
@@ -604,5 +605,5 @@
     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
@@ -631,6 +632,9 @@
     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
+
 #ifdef ISO   
     REAL, DIMENSION(ntraciso,klon),       INTENT(OUT)        :: dflux_xt    ! change of water vapour flux
@@ -683,8 +687,8 @@
     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
 #ifdef ISO
     REAL, DIMENSION(ntraciso,klon)              :: yxt1
@@ -699,4 +703,5 @@
     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
@@ -707,4 +712,5 @@
 #endif
     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
@@ -736,4 +742,5 @@
 #endif
     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
@@ -744,12 +751,12 @@
     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
 #ifdef ISO
     REAL, DIMENSION(ntraciso,klon)              :: yxtevap
@@ -819,4 +826,5 @@
     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
@@ -824,4 +832,5 @@
     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
@@ -929,5 +938,6 @@
     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
 !!    Variables intermediaires pour le raccord des deux colonnes \`a la surface
@@ -1016,4 +1026,5 @@
     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)
@@ -1035,5 +1046,5 @@
     ! compression of delta_sst, delta_sal, ds_ns, dt_ns, dter, dser,
     ! dt_ds, tkt, tks, taur, sss on ocean points
-
+    REAL :: missing_val
 #ifdef ISO
     REAL, DIMENSION(klon)       :: h1
@@ -1047,6 +1058,12 @@
 ! End of declarations
 !****************************************************************************************
-
+    
       IF (prt_level >=10) print *,' -> pbl_surface, itap ',itap
+      
+      IF (using_xios) THEN
+        missing_val = missing_val_xios
+      ELSE
+        missing_val = nf90_fill_real
+      ENDIF
 !
 !!jyg      iflag_split = mod(iflag_pbl_split,2)
@@ -1189,10 +1206,10 @@
   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.
@@ -1214,11 +1231,13 @@
  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.
@@ -1266,12 +1285,13 @@
     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
-    ysollw = 0.0  ; yz0m = 0.0 ; yz0h = 0.0    ; yu1 = 0.0    
-    yv1 = 0.0     ; ypaprs = 0.0     ; ypplay = 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     ; 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 
@@ -1288,4 +1308,5 @@
     ycldt = 0.0      ; yrmu0 = 0.0
     ! Martin
+    y_d_qbs(:,:)=0.0
 
 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
@@ -1629,4 +1650,5 @@
           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)
@@ -1640,4 +1662,5 @@
           yu1(j)     = u(i,1)
           yv1(j)     = v(i,1)
+          yqbs1(j)   = qbs(i,1)
           ypaprs(j,klev+1) = paprs(i,klev+1)
 !jyg<
@@ -1653,4 +1676,6 @@
 !!! nrlmd le 13/06/2011
           y_delta_tsurf(j)=delta_tsurf(i,nsrf)
+          yfluxbs(j)=0.0
+          y_flux_bs(j) = 0.0
 !!!
 #ifdef ISO
@@ -1721,4 +1746,5 @@
              yt(j,k) = t(i,k)
              yq(j,k) = q(i,k)
+             yqbs(j,k)=qbs(i,k)
 #ifdef ISO
              do ixt=1,ntraciso   
@@ -1849,7 +1875,7 @@
         ENDDO
         CALL cdrag(knon, nsrf, &
-            speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1),&
+            speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1), s_pblh, &
             yts, yqsurf, yz0m, yz0h, yri0, 0, &
-            ycdragm, ycdragh, zri1, pref )
+            ycdragm, ycdragh, zri1, pref, rain_f, zxtsol, ypplay(:,1))
 
 ! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
@@ -1883,7 +1909,7 @@
 
             CALL cdrag(knon, nsrf, &
-            speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),&
+            speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),s_pblh_x,&
             yts_x, yqsurf_x, yz0m, yz0h, yri0, 0, &
-            ycdragm_x, ycdragh_x, zri1_x, pref_x )
+            ycdragm_x, ycdragh_x, zri1_x, pref_x, rain_f, zxtsol, ypplay(:,1) )
 
 ! --- special Dice. JYG+MPL 25112013
@@ -1910,9 +1936,10 @@
         ENDDO
         CALL cdrag(knon, nsrf, &
-            speed_w, yt_w(:,1), yq_w(:,1), zgeo1_w, ypaprs(:,1),&
+            speed_w, yt_w(:,1), yq_w(:,1), zgeo1_w, ypaprs(:,1),s_pblh_w,&
             yts_w, yqsurf_w, yz0m, yz0h, yri0, 0, &
-            ycdragm_w, ycdragh_w, zri1_w, pref_w )
-!
-        zgeo1(:) = wake_s(:)*zgeo1_w(:) + (1.-wake_s(:))*zgeo1_x(:)
+            ycdragm_w, ycdragh_w, zri1_w, pref_w, rain_f, zxtsol, ypplay(:,1) )
+!
+!!!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
@@ -1951,14 +1978,12 @@
       print *,' args coef_diff_turb: ycdragh ', ycdragh
       print *,' args coef_diff_turb: ytke ', ytke
-
        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,yq, &
              ypplay,ypaprs,ytke,ycoefm, ycoefh)
 
         ELSE
-
 
         CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
@@ -1981,6 +2006,8 @@
 
         IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh ',ycoefh
-!
+
+
        ELSE  !(iflag_split .eq.0)
+
       IF (prt_level >=10) THEN
       print *,' args coef_diff_turb: yu_x ',  yu_x  
@@ -1998,5 +2025,5 @@
         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,yq_x, &
              ypplay,ypaprs,ytke_x,ycoefm_x, ycoefh_x)
 
@@ -2020,5 +2047,5 @@
        ENDIF
 
-       ENDIF ! iflag_pbl >= 50
+        ENDIF ! iflag_pbl >= 50
 
         IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_x ',ycoefh_x
@@ -2034,9 +2061,9 @@
       print *,' args coef_diff_turb: ycdragh_w ', ycdragh_w
       print *,' args coef_diff_turb: ytke_w ', ytke_w
-       ENDIF
+      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,yq_w, &
              ypplay,ypaprs,ytke_w,ycoefm_w, ycoefh_w)
 
@@ -2062,5 +2089,5 @@
 
         IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_w ',ycoefh_w
-!
+
 !!!jyg le 10/04/2013
 !!   En attendant de traiter le transport des traceurs dans les poches froides, formule
@@ -2072,7 +2099,5 @@
         ENDDO
       ENDDO
-!!!
        ENDIF  ! (iflag_split .eq.0)
-!!!
        
 !****************************************************************************************
@@ -2171,4 +2196,24 @@
        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
+
+
 
 !****************************************************************************************
@@ -2336,5 +2381,5 @@
                yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
                yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
-               yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
+               yt2m, yq2m, yt10m, yq10m, yu10m, yustar, ypblh, rain_f, zxtsol)
           ENDIF
           
@@ -2356,5 +2401,5 @@
                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, & 
@@ -2362,5 +2407,5 @@
                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, &
@@ -2407,4 +2452,6 @@
             call iso_verif_noNaN(yxtevap(ixt,j), &
          &      'pbl_surface 1056a: apres surf_land')
+          enddo
+          do ixt=1,niso
             call iso_verif_noNaN(yxtsol(ixt,j), &
          &      'pbl_surface 1056b: apres surf_land')
@@ -2431,12 +2478,12 @@
                   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, &
@@ -2475,4 +2522,6 @@
                    call iso_verif_noNaN(yxtevap(ixt,j), &
                         &      'pbl_surface 1095a: apres surf_landice')
+                enddo
+                do ixt=1,niso
                    call iso_verif_noNaN(yxtsol(ixt,j), &
                         &      'pbl_surface 1095b: apres surf_landice')
@@ -2495,5 +2544,5 @@
                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, &
@@ -2570,4 +2619,6 @@
             call iso_verif_noNaN(yxtevap(ixt,j), &
          &      'pbl_surface 1165a: apres surf_seaice')
+          enddo
+          do ixt=1,niso
             call iso_verif_noNaN(yxtsol(ixt,j), &
          &      'pbl_surface 1165b: apres surf_seaice')
@@ -2658,4 +2709,11 @@
           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
 !
 ! ------------------------------------------------------------------------------
@@ -2985,4 +3043,14 @@
 !
        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
+
 !!!
 !!
@@ -3151,12 +3219,20 @@
 !!!
 
-!      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)
@@ -3386,4 +3462,15 @@
           ENDDO
        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
+
 
 #ifdef ISO
@@ -3522,5 +3609,5 @@
        IF (iflag_split .eq.0) THEN
         IF (iflag_new_t2mq2m==1) THEN
-         CALL stdlevvarn(klon, knon, nsrf, zxli, &
+           CALL stdlevvarn(klon, knon, nsrf, zxli, &
             uzon, vmer, tair1, qair1, zgeo1, &
             tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
@@ -3531,5 +3618,5 @@
             uzon, vmer, tair1, qair1, zgeo1, &
             tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
-            yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
+            yt2m, yq2m, yt10m, yq10m, yu10m, yustar, ypblh, rain_f, zxtsol)
         ENDIF
        ELSE  !(iflag_split .eq.0)
@@ -3549,9 +3636,9 @@
             uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
             tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
-            yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x)
+            yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x, ypblh_x, rain_f, zxtsol)
         CALL stdlevvar(klon, knon, nsrf, zxli, &
             uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
             tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
-            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w)
+            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w, ypblh_w, rain_f, zxtsol)
         ENDIF
 !!!
@@ -3888,4 +3975,22 @@
        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
+
+   
+    
 #ifdef ISO
     DO i = 1, klon
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phyaqua_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phyaqua_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phyaqua_mod.F90	(revision 4727)
@@ -536,7 +536,5 @@
     USE mod_phys_lmdz_para, ONLY: is_omp_master, klon_mpi
     USE mod_phys_lmdz_transfert_para, ONLY: gather_omp
-#ifdef CPP_XIOS
-    USE xios
-#endif
+    USE lmdz_xios
     IMPLICIT NONE
 
@@ -558,5 +556,4 @@
       ! on the whole physics grid
  
-#ifdef CPP_XIOS
     PRINT *, 'writelim: Ecriture du fichier limit'
 
@@ -584,5 +581,5 @@
     CALL gather_omp(phy_rug, phy_mpi)
     IF (is_omp_master) CALL xios_send_field('rug_limout',phy_mpi)
-#endif
+
   END SUBROUTINE writelim_unstruct
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phyetat0_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phyetat0_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phyetat0_mod.F90	(revision 4727)
@@ -24,7 +24,7 @@
        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, &
@@ -36,5 +36,5 @@
        zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, u10m, v10m, treedrg, &
        ale_wake, ale_bl_stat, ds_ns, dt_ns, delta_sst, delta_sal, dter, dser, &
-       dt_ds, ratqs_inter
+       dt_ds, ratqs_inter_
 !FC
   USE geometry_mod,     ONLY: longitude_deg, latitude_deg
@@ -47,9 +47,6 @@
   USE ocean_slab_mod,   ONLY: nslay, tslab, seaice, tice, ocean_slab_init
   USE time_phylmdz_mod, ONLY: init_iteration, pdtphys, itau_phy
-#ifdef CPP_XIOS
-  USE wxios, ONLY: missing_val
-#else
-  use netcdf, only: missing_val => nf90_fill_real
-#endif
+  USE wxios, ONLY: missing_val_xios => missing_val, using_xios
+  use netcdf, only:  nf90_fill_real
   use config_ocean_skin_m, only: activate_ocean_skin
 #ifdef ISO
@@ -108,5 +105,5 @@
   REAL :: lon_startphy(klon), lat_startphy(klon)
   CHARACTER(LEN=maxlen) :: tname, t(2)
-
+  REAL :: missing_val
 #ifdef ISO
   REAL xtsnow(niso,klon, nbsrf)
@@ -119,4 +116,9 @@
 
   ! Ouvrir le fichier contenant l'etat initial:
+  IF (using_xios) THEN
+    missing_val = missing_val_xios
+  ELSE
+    missing_val =  nf90_fill_real
+  ENDIF
 
   CALL open_startphy(fichnom)
@@ -349,4 +351,11 @@
   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
@@ -410,4 +419,14 @@
   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
   !          dummy values (as is the case when generated by ce0l,
@@ -423,4 +442,12 @@
     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
+
 
   found=phyetat0_get(clwcon,"CLWCON","CLWCON",0.)
@@ -485,5 +512,5 @@
 
 ! fisrtilp/Clouds 0.002 could be ratqsbas. But can stay like this as well
-  found=phyetat0_get(ratqs_inter,"RATQS_INTER","Relative width of the lsc sugrid scale water",0.002)
+  found=phyetat0_get(ratqs_inter_,"RATQS_INTER","Relative width of the lsc sugrid scale water",0.002)
 
 !===========================================
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phyredem.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phyredem.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phyredem.F90	(revision 4727)
@@ -15,9 +15,9 @@
                                 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,  u_ancien,             &
+                                prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien,      &
+                                ql_ancien, qs_ancien, qbs_ancien,  u_ancien, &
                                 v_ancien, clwcon, rnebcon, ratqs, pbl_tke,   &
                                 wake_delta_pbl_tke, zmax0, f0, sig1, w01,    &
@@ -30,5 +30,5 @@
                                 du_gwd_rando, du_gwd_front, u10m, v10m, &
                                 treedrg, solswfdiff, delta_sal, ds_ns, dt_ns, &
-                                delta_sst, ratqs_inter, dter, dser, dt_ds
+                                delta_sst, ratqs_inter_, dter, dser, dt_ds
 #ifdef ISO
   USE phys_state_var_mod, ONLY: xtsol, fxtevap,xtrain_fall, xtsnow_fall,     &
@@ -261,4 +261,10 @@
     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,"PRWANCIEN", "PRWANCIEN", prw_ancien)
 
@@ -341,5 +347,5 @@
 
     ! fisrtilp/clouds
-    CALL put_field(pass,"RATQS_INTER","Relative width of the lsc sugrid scale water",ratqs_inter)
+    CALL put_field(pass,"RATQS_INTER","Relative width of the lsc sugrid scale water",ratqs_inter_)
 
 
@@ -581,7 +587,4 @@
       CALL put_field_srf1(pass, "XTEVAP"//TRIM(outiso), "Evaporation de surface",iso_tmp_lonsrf)
 
-      iso_tmp_lonsrf(:,:)=xtsnow(ixt,:,:)
-      CALL put_field_srf1(pass, "XTSNOW"//TRIM(outiso), "NEIGE",       iso_tmp_lonsrf)       
-
       iso_tmp(:)=xtrain_fall(ixt,:)
       CALL put_field(pass,    "xtrain_f"//TRIM(outiso), "precipitation liquide",iso_tmp)
@@ -602,19 +605,22 @@
       CALL put_field(pass,"WAKE_DELTAXT"//TRIM(outiso), "WAKE_DELTAQ", iso_tmp_lonlev)
 
+      iso_tmp_lonlev(:,:)=wake_deltaxt(ixt,:,:)
+      CALL put_field(pass,"WAKE_DELTAXT"//TRIM(outiso), "WAKE_DELTAXT",iso_tmp_lonlev)
+
+      ! variables seulement pour niso:
+      if (ixt.le.niso) then
+
+      iso_tmp_lonsrf(:,:)=xtsnow(ixt,:,:)
+      CALL put_field_srf1(pass, "XTSNOW"//TRIM(outiso), "NEIGE",       iso_tmp_lonsrf)
+
+      iso_tmp(:)=xtsol(ixt,:)
+      CALL put_field(pass,      "XTSOL"//TRIM(outiso), "Eau dans le sol (mm)",iso_tmp)
+
+      iso_tmp(:)=Rland_ice(ixt,:)
+      CALL put_field(pass,  "Rland_ice"//TRIM(outiso), "ratio land ice",      iso_tmp)
+
       iso_tmp(:)=xtrun_off_lic_0(ixt,:)
       CALL put_field(pass,"XTRUNOFFLIC0"//TRIM(outiso), "Runofflic0",  iso_tmp)
 
-      iso_tmp_lonlev(:,:)=wake_deltaxt(ixt,:,:)
-      CALL put_field(pass,"WAKE_DELTAXT"//TRIM(outiso), "WAKE_DELTAXT",iso_tmp_lonlev)
-
-      ! variables seulement pour niso:
-      if (ixt.le.niso) then
-
-      iso_tmp(:)=xtsol(ixt,:)
-      CALL put_field(pass,      "XTSOL"//TRIM(outiso), "Eau dans le sol (mm)",iso_tmp)
-
-      iso_tmp(:)=Rland_ice(ixt,:)
-      CALL put_field(pass,  "Rland_ice"//TRIM(outiso), "ratio land ice",      iso_tmp)
-
       endif ! if (ixt.le.niso) then
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phys_local_var_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phys_local_var_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phys_local_var_mod.F90	(revision 4727)
@@ -14,4 +14,6 @@
       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)
@@ -26,8 +28,8 @@
       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)
@@ -69,6 +71,6 @@
       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)
@@ -78,4 +80,6 @@
       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(:,:)
@@ -194,30 +198,6 @@
       REAL, SAVE, ALLOCATABLE :: tau3d_aero(:,:,:,:) 
       !$OMP THREADPRIVATE(tau3d_aero) 
-      REAL, SAVE, ALLOCATABLE :: scdnc(:,:)
-      !$OMP THREADPRIVATE(scdnc)
       REAL, SAVE, ALLOCATABLE :: dNovrN(:) 
       !$OMP THREADPRIVATE(dNovrN) 
-      REAL, SAVE, ALLOCATABLE :: cldncl(:)
-      !$OMP THREADPRIVATE(cldncl)
-      REAL, SAVE, ALLOCATABLE :: reffclwtop(:)
-      !$OMP THREADPRIVATE(reffclwtop)
-      REAL, SAVE, ALLOCATABLE :: lcc(:)
-      !$OMP THREADPRIVATE(lcc)
-      REAL, SAVE, ALLOCATABLE :: reffclws(:,:)
-      !$OMP THREADPRIVATE(reffclws)
-      REAL, SAVE, ALLOCATABLE :: reffclwc(:,:)
-      !$OMP THREADPRIVATE(reffclwc)
-      REAL, SAVE, ALLOCATABLE :: cldnvi(:) 
-      !$OMP THREADPRIVATE(cldnvi)
-      REAL, SAVE, ALLOCATABLE :: lcc3d(:,:)
-      !$OMP THREADPRIVATE(lcc3d)
-      REAL, SAVE, ALLOCATABLE :: lcc3dcon(:,:)
-      !$OMP THREADPRIVATE(lcc3dcon)
-      REAL, SAVE, ALLOCATABLE :: lcc3dstra(:,:)
-      !$OMP THREADPRIVATE(lcc3dstra)
-      REAL, SAVE, ALLOCATABLE :: icc3dcon(:,:)
-      !$OMP THREADPRIVATE(icc3dcon)
-      REAL, SAVE, ALLOCATABLE :: icc3dstra(:,:)
-      !$OMP THREADPRIVATE(icc3dstra)
       REAL, SAVE, ALLOCATABLE :: zfice(:,:)
       !$OMP THREADPRIVATE(zfice)
@@ -313,4 +293,8 @@
 !$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
@@ -361,6 +345,6 @@
       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)
@@ -379,4 +363,6 @@
       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)
@@ -567,6 +553,6 @@
       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)
@@ -585,4 +571,10 @@
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rneb,rnebjn,rneblsvol
 !$OMP THREADPRIVATE(rneb,rnebjn,rneblsvol)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pfraclr,pfracld
+!$OMP THREADPRIVATE(pfraclr,pfracld)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: distcltop
+!$OMP THREADPRIVATE(distcltop)
+      REAL, SAVE, ALLOCATABLE :: temp_cltop(:,:) 
+!$OMP THREADPRIVATE(temp_cltop)
 
 ! variables de sorties MM
@@ -734,5 +726,5 @@
 
 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))
@@ -741,6 +733,6 @@
       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
@@ -765,5 +757,6 @@
       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))
@@ -830,17 +823,5 @@
       ALLOCATE(drytausum_aero(klon,naero_tot))
       ALLOCATE(tau3d_aero(klon,klev,nwave,naero_tot)) 
-      ALLOCATE(scdnc(klon, klev))
       ALLOCATE(dNovrN(klon))
-      ALLOCATE(cldncl(klon))
-      ALLOCATE(reffclwtop(klon))
-      ALLOCATE(lcc(klon))
-      ALLOCATE(reffclws(klon, klev))
-      ALLOCATE(reffclwc(klon, klev))
-      ALLOCATE(cldnvi(klon))
-      ALLOCATE(lcc3d(klon, klev))
-      ALLOCATE(lcc3dcon(klon, klev))
-      ALLOCATE(lcc3dstra(klon, klev))
-      ALLOCATE(icc3dcon(klon, klev))
-      ALLOCATE(icc3dstra(klon, klev))
       ALLOCATE(zfice(klon, klev))
       ALLOCATE(od443aer(klon))
@@ -925,6 +906,6 @@
       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))
@@ -1012,4 +993,7 @@
       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
@@ -1055,4 +1039,5 @@
       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))
 
@@ -1068,5 +1053,8 @@
       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))
+      ALLOCATE(temp_cltop(klon,klev))
 
       ALLOCATE (zxsnow(klon),snowhgt(klon),qsnow(klon),to_ice(klon))
@@ -1141,5 +1129,5 @@
 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)
@@ -1147,6 +1135,6 @@
       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
@@ -1171,4 +1159,6 @@
       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)
 #ifdef ISO
       deallocate(xt_seri,xtl_seri,xts_seri)
@@ -1215,17 +1205,5 @@
       DEALLOCATE(drytausum_aero) 
       DEALLOCATE(tau3d_aero) 
-      DEALLOCATE(scdnc)
       DEALLOCATE(dNovrN)
-      DEALLOCATE(cldncl)
-      DEALLOCATE(reffclwtop)
-      DEALLOCATE(lcc)
-      DEALLOCATE(reffclws)
-      DEALLOCATE(reffclwc)
-      DEALLOCATE(cldnvi)
-      DEALLOCATE(lcc3d)
-      DEALLOCATE(lcc3dcon)
-      DEALLOCATE(lcc3dstra)
-      DEALLOCATE(icc3dcon)
-      DEALLOCATE(icc3dstra)
       DEALLOCATE(zfice)
       DEALLOCATE(od443aer)
@@ -1308,6 +1286,6 @@
       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)
 !
@@ -1322,4 +1300,5 @@
       DEALLOCATE(zxfqcalving, zxfluxlat)
       DEALLOCATE(zxrunofflic)
+      DEALLOCATE(zxustartlic, zxrhoslic)
       DEALLOCATE(zxtsol, snow_lsc, zxfqfonte, zxqsurf)
       DEALLOCATE(rain_lsc)
@@ -1364,4 +1343,6 @@
       DEALLOCATE(alp_bl_stat, n2, s2)
       DEALLOCATE(proba_notrig, random_notrig)
+!FC
+      DEALLOCATE(zxfluxq,zxfluxt)
 
       DEALLOCATE(dnwd0)
@@ -1423,5 +1404,5 @@
 
 
-      DEALLOCATE(prfl, psfl, fraca, Vprecip)
+      DEALLOCATE(prfl, psfl, bsfl, fraca, Vprecip)
       DEALLOCATE(zw2)
 
@@ -1436,4 +1417,7 @@
       DEALLOCATE(beta_prec)
       DEALLOCATE(rneb)
+      DEALLOCATE(pfraclr,pfracld)
+      DEALLOCATE(distcltop)
+      DEALLOCATE(temp_cltop)
       DEALLOCATE (zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic)
 #ifdef ISO
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phys_output_ctrlout_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phys_output_ctrlout_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phys_output_ctrlout_mod.F90	(revision 4727)
@@ -378,7 +378,14 @@
   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,4 +750,6 @@
   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) /))
@@ -1413,7 +1422,7 @@
     'ec550aer', 'Extinction at 550nm', 'm^-1', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_lwcon = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'lwcon', 'Cloud liquid water content', 'kg/kg', (/ ('', i=1, 10) /))
+    'lwcon', 'Cloud liquid water content seen by radiation', 'kg/kg', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_iwcon = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'iwcon', 'Cloud ice water content', 'kg/kg', (/ ('', i=1, 10) /))
+    'iwcon', 'Cloud ice water content seen by radiation', 'kg/kg', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_temp = ctrl_out((/ 2, 3, 4, 10, 10, 10, 11, 11, 11, 11/), &
     'temp', 'Air temperature', 'K', (/ ('', i=1, 10) /))
@@ -1432,4 +1441,6 @@
   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,4 +1473,8 @@
   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,4 +1509,8 @@
   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,4 +1521,6 @@
   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,4 +1551,9 @@
   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,4 +1625,8 @@
   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,4 +1703,12 @@
   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
@@ -1835,4 +1873,5 @@
   TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtprecip(:)
   TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtevap(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtevap_srf(:,:) ! ajout Camille 8 mai 2023
   TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtplul(:)
   TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtpluc(:)
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phys_output_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phys_output_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phys_output_mod.F90	(revision 4727)
@@ -47,8 +47,6 @@
     USE vertical_layers_mod, ONLY: ap,bp,preff,presnivs, aps, bps, pseudoalt
     USE time_phylmdz_mod, ONLY: day_ini, itau_phy, start_time, annee_ref, day_ref
-#ifdef CPP_XIOS
     ! ug Pour les sorties XIOS
     USE wxios
-#endif
 #ifdef ISO
     USE isotopes_mod, ONLY: isoName,iso_HTO
@@ -140,5 +138,4 @@
     REAL, DIMENSION(klev+1)   :: lev_index
                 
-#ifdef CPP_XIOS
     ! ug Variables utilis\'ees pour r\'ecup\'erer le calendrier pour xios
     INTEGER :: x_an, x_mois, x_jour
@@ -146,5 +143,4 @@
     INTEGER :: ini_an, ini_mois, ini_jour
     REAL :: ini_heure
-#endif
     INTEGER                         :: ISW
     REAL, DIMENSION(NSW)            :: wl1_sun, wl2_sun !wavelength bounds (in um) for SW
@@ -178,4 +174,5 @@
     ALLOCATE(o_xtpluc(ntraciso))
     ALLOCATE(o_xtevap(ntraciso))
+    ALLOCATE(o_xtevap_srf(ntraciso,4))
     ALLOCATE(o_xtovap(ntraciso))
     ALLOCATE(o_xtoliq(ntraciso))
@@ -325,12 +322,12 @@
      ENDIF
 
-#ifdef CPP_XIOS
-    ! ug R\'eglage du calendrier xios
-    !Temps julian => an, mois, jour, heure
-    CALL ju2ymds(zjulian, x_an, x_mois, x_jour, x_heure)
-    CALL ju2ymds(zjulian_start, ini_an, ini_mois, ini_jour, ini_heure)
-    CALL wxios_set_cal(dtime, calend, x_an, x_mois, x_jour, x_heure, ini_an, &
-                       ini_mois, ini_jour, ini_heure )
-#endif
+    IF (using_xios) THEN
+      ! ug R\'eglage du calendrier xios
+      !Temps julian => an, mois, jour, heure
+      CALL ju2ymds(zjulian, x_an, x_mois, x_jour, x_heure)
+      CALL ju2ymds(zjulian_start, ini_an, ini_mois, ini_jour, ini_heure)
+      CALL wxios_set_cal(dtime, calend, x_an, x_mois, x_jour, x_heure, ini_an, &
+                         ini_mois, ini_jour, ini_heure )
+    ENDIF
 
 !!!!!!!!!!!!!!!!!!!!!!! Boucle sur les fichiers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -365,62 +362,62 @@
 
 
-#ifdef CPP_XIOS
+    IF (using_xios) THEN
 !!! Ouverture de chaque fichier XIOS !!!!!!!!!!!
-    IF (.not. ok_all_xml) THEN
+      IF (.not. ok_all_xml) THEN
+        IF (prt_level >= 10) THEN
+         print*,'phys_output_open: call wxios_add_file with phys_out_filenames(iff)=',trim(phys_out_filenames(iff))    
+        ENDIF
+        CALL wxios_add_file(phys_out_filenames(iff),chtimestep(iff),lev_files(iff))  
+      ENDIF
+
+!!! Declaration des axes verticaux de chaque fichier:
       IF (prt_level >= 10) THEN
-        print*,'phys_output_open: call wxios_add_file with phys_out_filenames(iff)=',trim(phys_out_filenames(iff))    
+        print*,'phys_output_open: Declare vertical axes for each file'
       ENDIF
-      CALL wxios_add_file(phys_out_filenames(iff),chtimestep(iff),lev_files(iff))  
-    ENDIF
-
-!!! Declaration des axes verticaux de chaque fichier:
-    IF (prt_level >= 10) THEN
-      print*,'phys_output_open: Declare vertical axes for each file'
-    ENDIF
-
-   IF (iff.LE.6.OR.iff.EQ.10) THEN
-    CALL wxios_add_vaxis("presnivs", &
-            levmax(iff) - levmin(iff) + 1, presnivs(levmin(iff):levmax(iff)))
-    CALL wxios_add_vaxis("Ahyb", &
+
+      IF (iff.LE.6.OR.iff.EQ.10) THEN
+        CALL wxios_add_vaxis("presnivs", &
+             levmax(iff) - levmin(iff) + 1, presnivs(levmin(iff):levmax(iff)))
+        CALL wxios_add_vaxis("Ahyb", &
             levmax(iff) - levmin(iff) + 1, aps(levmin(iff):levmax(iff)), positif='down', &
             bnds=Ahyb_bounds(levmin(iff):levmax(iff),:))
-    CALL wxios_add_vaxis("Bhyb", &
+        CALL wxios_add_vaxis("Bhyb", &
             levmax(iff) - levmin(iff) + 1, bps(levmin(iff):levmax(iff)), positif='down', &
             bnds=Bhyb_bounds(levmin(iff):levmax(iff),:))
-    CALL wxios_add_vaxis("klev", levmax(iff) - levmin(iff) + 1, &
+        CALL wxios_add_vaxis("klev", levmax(iff) - levmin(iff) + 1, &
                           lev_index(levmin(iff):levmax(iff)))
-    CALL wxios_add_vaxis("klevp1", klev+1, &
+        CALL wxios_add_vaxis("klevp1", klev+1, &
                           lev_index(1:klev+1))
-    CALL wxios_add_vaxis("bnds", 2, (/1.,2./))
-
-    CALL wxios_add_vaxis("Alt", &
+        CALL wxios_add_vaxis("bnds", 2, (/1.,2./))
+
+        CALL wxios_add_vaxis("Alt", &
             levmax(iff) - levmin(iff) + 1, pseudoalt)
-
-    ! wl1_sun/wl2_sun: minimum/maximum bound of wavelength (in um)
-    SELECT CASE(NSW)
-      CASE(6)
-        wl1_sun(1:6) = [0.180, 0.250, 0.440, 0.690, 1.190, 2.380]
-        wl2_sun(1:6) = [0.250, 0.440, 0.690, 1.190, 2.380, 4.000]
-      CASE(2)
-        wl1_sun(1:2) = [0.250, 0.690]
-        wl2_sun(1:2) = [0.690, 4.000]
-    END SELECT
-
-    DO ISW=1, NSW
-     wn1_sun(ISW)=1.e+6/wl1_sun(ISW) 
-     wn2_sun(ISW)=1.e+6/wl2_sun(ISW) 
-     spbnds_sun(ISW,1)=wn2_sun(ISW)
-     spbnds_sun(ISW,2)=wn1_sun(ISW)
-     spectband(ISW)=(wn1_sun(ISW)+wn2_sun(ISW))/2
-    ENDDO
+  
+        ! wl1_sun/wl2_sun: minimum/maximum bound of wavelength (in um)
+        SELECT CASE(NSW)
+          CASE(6)
+          wl1_sun(1:6) = [0.180, 0.250, 0.440, 0.690, 1.190, 2.380]
+          wl2_sun(1:6) = [0.250, 0.440, 0.690, 1.190, 2.380, 4.000]
+        CASE(2)
+          wl1_sun(1:2) = [0.250, 0.690]
+          wl2_sun(1:2) = [0.690, 4.000]
+        END SELECT
+
+        DO ISW=1, NSW
+          wn1_sun(ISW)=1.e+6/wl1_sun(ISW) 
+          wn2_sun(ISW)=1.e+6/wl2_sun(ISW) 
+          spbnds_sun(ISW,1)=wn2_sun(ISW)
+          spbnds_sun(ISW,2)=wn1_sun(ISW)
+          spectband(ISW)=(wn1_sun(ISW)+wn2_sun(ISW))/2
+        ENDDO
 !
 !!! ajout axe vertical spectband : solar band number
-    CALL wxios_add_vaxis("spectband", NSW, spectband, positif='down')
-   ELSE
+        CALL wxios_add_vaxis("spectband", NSW, spectband, positif='down')
+      ELSE
     ! NMC files
-    CALL wxios_add_vaxis("plev", &
+        CALL wxios_add_vaxis("plev", &
             levmax(iff) - levmin(iff) + 1, rlevSTD(levmin(iff):levmax(iff)))
-   ENDIF
-#endif 
+      ENDIF
+    ENDIF 
 
         IF (clef_files(iff)) THEN
@@ -557,4 +554,11 @@
       o_xtplul  (ixt)=ctrl_out(flag,   'plul'//TRIM(outiso),   'Large-scale Precip.', unit, [('',i=1,nfiles)])
       o_xtevap  (ixt)=ctrl_out(flag,   'evap'//TRIM(outiso),             'Evaporat.', unit, [('',i=1,nfiles)])
+
+      ! ajout Camille 8 mai 2023
+      flag = [1, 6, 10, 10, 10, 10, 11, 11, 11, 11]
+      o_xtevap_srf (ixt,1)=ctrl_out(flag,   'evap_ter'//TRIM(outiso), 'Evap sfc'//clnsurf(1), unit, [('',i=1,nfiles)])
+      o_xtevap_srf (ixt,2)=ctrl_out(flag,   'evap_lic'//TRIM(outiso), 'Evap sfc'//clnsurf(2), unit, [('',i=1,nfiles)])
+      o_xtevap_srf (ixt,3)=ctrl_out(flag,   'evap_oce'//TRIM(outiso), 'Evap sfc'//clnsurf(3), unit, [('',i=1,nfiles)])
+      o_xtevap_srf (ixt,4)=ctrl_out(flag,   'evap_sic'//TRIM(outiso), 'Evap sfc'//clnsurf(4), unit, [('',i=1,nfiles)])
 
       flag = [2,  3,  4, 10, 10, 10, 11, 11, 11, 11]; unit = 'kg/kg'
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phys_output_var_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phys_output_var_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/phys_output_var_mod.F90	(revision 4727)
@@ -29,5 +29,6 @@
   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)
@@ -35,8 +36,9 @@
   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 
@@ -64,5 +66,31 @@
   !$OMP THREADPRIVATE(map_emis_Cb,map_pcld_Cb,map_tcld_Cb,map_emis_ThCi)
   REAL, SAVE, ALLOCATABLE :: map_emis_Anv(:),map_pcld_Anv(:),map_tcld_Anv(:)
-  !$OMP THREADPRIVATE(map_pcld_ThCi,map_tcld_ThCi,map_emis_Anv,map_pcld_Anv,map_tcld_Anv)              
+  !$OMP THREADPRIVATE(map_pcld_ThCi,map_tcld_ThCi,map_emis_Anv,map_pcld_Anv,map_tcld_Anv)
+
+  ! variables deplacees de phys_local_var_mod
+  REAL, SAVE, ALLOCATABLE :: scdnc(:,:)
+  !$OMP THREADPRIVATE(scdnc)
+  REAL, SAVE, ALLOCATABLE :: cldncl(:)
+  !$OMP THREADPRIVATE(cldncl)
+  REAL, SAVE, ALLOCATABLE :: reffclwtop(:)
+  !$OMP THREADPRIVATE(reffclwtop)
+  REAL, SAVE, ALLOCATABLE :: lcc(:)
+  !$OMP THREADPRIVATE(lcc)
+  REAL, SAVE, ALLOCATABLE :: reffclws(:,:)
+  !$OMP THREADPRIVATE(reffclws)
+  REAL, SAVE, ALLOCATABLE :: reffclwc(:,:)
+  !$OMP THREADPRIVATE(reffclwc)
+  REAL, SAVE, ALLOCATABLE :: cldnvi(:) 
+  !$OMP THREADPRIVATE(cldnvi)
+  REAL, SAVE, ALLOCATABLE :: lcc3d(:,:)
+  !$OMP THREADPRIVATE(lcc3d)
+  REAL, SAVE, ALLOCATABLE :: lcc3dcon(:,:)
+  !$OMP THREADPRIVATE(lcc3dcon)
+  REAL, SAVE, ALLOCATABLE :: lcc3dstra(:,:)
+  !$OMP THREADPRIVATE(lcc3dstra)
+  REAL, SAVE, ALLOCATABLE :: icc3dcon(:,:)
+  !$OMP THREADPRIVATE(icc3dcon)
+  REAL, SAVE, ALLOCATABLE :: icc3dstra(:,:)
+  !$OMP THREADPRIVATE(icc3dstra)  
    
 
@@ -173,8 +201,8 @@
 
     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
@@ -211,4 +239,18 @@
          sss(klon))
 
+! Sorties de lmdz_cloud_optics_pro
+    ALLOCATE(scdnc(klon, klev))
+    ALLOCATE(cldncl(klon))
+    ALLOCATE(reffclwtop(klon))
+    ALLOCATE(lcc(klon))
+    ALLOCATE(reffclws(klon, klev))
+    ALLOCATE(reffclwc(klon, klev))
+    ALLOCATE(cldnvi(klon))
+    ALLOCATE(lcc3d(klon, klev))
+    ALLOCATE(lcc3dcon(klon, klev))
+    ALLOCATE(lcc3dstra(klon, klev))
+    ALLOCATE(icc3dcon(klon, klev))
+    ALLOCATE(icc3dstra(klon, klev))
+
   END SUBROUTINE phys_output_var_init
 
@@ -223,6 +265,6 @@
     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
@@ -249,4 +291,17 @@
   !   endif
 
+    DEALLOCATE(scdnc)
+    DEALLOCATE(cldncl)
+    DEALLOCATE(reffclwtop)
+    DEALLOCATE(lcc)
+    DEALLOCATE(reffclws)
+    DEALLOCATE(reffclwc)
+    DEALLOCATE(cldnvi)
+    DEALLOCATE(lcc3d)
+    DEALLOCATE(lcc3dcon)
+    DEALLOCATE(lcc3dstra)
+    DEALLOCATE(icc3dcon)
+    DEALLOCATE(icc3dstra)
+
   END SUBROUTINE phys_output_var_end
 
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/physiq_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/physiq_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/physiq_mod.F90	(revision 4727)
@@ -76,13 +76,21 @@
     USE vampir
     USE write_field_phy
-#ifdef CPP_XIOS
     USE wxios, ONLY: g_ctx, wxios_set_context
-#endif
-    USE atke_turbulence_ini_mod, ONLY : atke_ini
-    USE lscp_ini_mod, ONLY : lscp_ini
-    USE lscp_mod, ONLY : lscp
-    USE wake_ini_mod, ONLY : wake_ini
+    USE lmdz_lscp, ONLY : lscp
+    USE lmdz_call_cloud_optics_prop, ONLY : call_cloud_optics_prop
+    USE lmdz_lscp_old, ONLY : fisrtilp
+    USE lmdz_call_blowing_snow, ONLY : call_blowing_snow_sublim_sedim
+    USE lmdz_wake_ini, ONLY : wake_ini
     USE yamada_ini_mod, ONLY : yamada_ini
-    USE thermcell_ini_mod, ONLY : thermcell_ini
+    USE lmdz_atke_turbulence_ini, ONLY : atke_ini
+    USE lmdz_thermcell_ini, ONLY : thermcell_ini, iflag_thermals_tenv
+    USE lmdz_thermcell_dtke, ONLY : thermcell_dtke
+    USE lmdz_blowing_snow_ini, ONLY : blowing_snow_ini , qbst_bs 
+    USE lmdz_lscp_ini, ONLY : lscp_ini
+    USE lmdz_ratqs_main, ONLY : ratqs_main
+    USE lmdz_ratqs_ini, ONLY : ratqs_ini
+    USE lmdz_cloud_optics_prop_ini, ONLY : cloud_optics_prop_ini
+    USE phys_output_var_mod, ONLY :      cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
+
 
     !USE cmp_seri_mod
@@ -124,14 +132,15 @@
 
 #ifdef CPP_StratAer
-    USE strataer_mod, ONLY: strataer_init
-#endif
-
-
-#ifdef CPP_XIOS
-    USE xios, ONLY: xios_update_calendar, xios_context_finalize
-    USE xios, ONLY: xios_get_field_attr, xios_field_is_active, xios_context
-    USE xios, ONLY: xios_set_current_context
-    USE wxios, ONLY: missing_val, missing_val_omp
-#endif
+    USE strataer_local_var_mod
+    USE strataer_nuc_mod, ONLY: strataer_nuc_init
+    USE strataer_emiss_mod, ONLY: strataer_emiss_init
+#endif
+
+
+    USE lmdz_xios, ONLY: xios_update_calendar, xios_context_finalize
+    USE lmdz_xios, ONLY: xios_get_field_attr, xios_field_is_active, xios_context
+    USE lmdz_xios, ONLY: xios_set_current_context
+    USE wxios, ONLY: missing_val_xios => missing_val, using_xios
+
 #ifndef CPP_XIOS
     USE paramLMDZ_phy_mod
@@ -157,5 +166,5 @@
         & iso_verif_aberrant_choix,iso_verif_positif, &
         & iso_verif_positif_choix_vect,iso_verif_o18_aberrant_nostop, &
-        & iso_verif_init,&
+        & iso_verif_init,iso_verif_aberrant_enc_choix_nostop,&
         & iso_verif_positif_strict_nostop,iso_verif_O18_aberrant_enc_vect2D
 #endif
@@ -183,8 +192,8 @@
        ! [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, &
        ! 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, &
@@ -203,8 +212,10 @@
        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, &
@@ -254,6 +265,6 @@
        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,                   &
@@ -328,4 +339,6 @@
        !
        rneblsvol, &
+       pfraclr,pfracld, &
+       distcltop,temp_cltop, &
        zqsatl, zqsats, &
        qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, &
@@ -343,5 +356,5 @@
        fsolsw, wfbils, wfbilo,  &
        wfevap, wfrain, wfsnow,  &  
-       prfl, psfl, fraca, Vprecip,  &
+       prfl, psfl,bsfl, fraca, Vprecip,  &
        zw2,  &
        !
@@ -355,5 +368,6 @@
        beta_prec,  &
        rneb,  &
-       zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic
+       zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic, &
+       zxfluxt,zxfluxq
 
 
@@ -384,4 +398,8 @@
 #endif
        !
+       USE phys_local_var_mod, ONLY: zfice, dNovrN, ptconv
+       USE phys_output_var_mod, ONLY: scdnc, cldncl, reffclwtop, lcc, reffclws, &
+       reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra
+
 
     IMPLICIT NONE
@@ -510,7 +528,7 @@
     SAVE seuil_inversion
     !$OMP THREADPRIVATE(seuil_inversion)
-    INTEGER iflag_ratqs
-    SAVE iflag_ratqs
-    !$OMP THREADPRIVATE(iflag_ratqs)
+    
+    
+    
     real facteur
 
@@ -526,7 +544,7 @@
     !======================================================================
     !
-    ! 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)
     !
     !
@@ -593,4 +611,5 @@
     !
     !
+    include "radepsi.h"
     include "radopt.h"
     !
@@ -875,5 +894,4 @@
     !KE43
     EXTERNAL conema3  ! convect4.3
-    EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
     !AA 
     ! JBM (3/14) fisrtilp_tr not loaded
@@ -905,11 +923,13 @@
     REAL dialiq(klon,klev)  ! eau liquide nuageuse
     REAL diafra(klon,klev)  ! fraction nuageuse
-    REAL cldliq(klon,klev)  ! eau liquide nuageuse
+    REAL radocond(klon,klev)  ! eau condensee nuageuse
     !
     !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)
@@ -1009,5 +1029,5 @@
     !
     ! tendance nulles
-    REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0
+    REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0, dqbs0
 #ifdef ISO
     REAL, dimension(ntraciso,klon,klev):: dxt0, dxtl0, dxti0
@@ -1156,4 +1176,6 @@
     REAL ztsol(klon)
     REAL q2m(klon,nbsrf)  ! humidite a 2m
+    REAL fsnowerosion(klon,nbsrf) ! blowing snow flux at surface
+    REAL qbsfra  ! blowing snow fraction
 #ifdef ISO
     REAL d_xtw(ntraciso),d_xtl(ntraciso), d_xts(ntraciso)
@@ -1219,7 +1241,7 @@
     !     climatology and the daylight climatology
     INTEGER,SAVE :: ncid_climoz                ! NetCDF file identifier
-    REAL, POINTER, SAVE :: press_cen_climoz(:) ! Pressure levels
-    REAL, POINTER, SAVE :: press_edg_climoz(:) ! Edges of pressure intervals
-    REAL, POINTER, SAVE :: time_climoz(:)      ! Time vector
+    REAL, ALLOCATABLE, SAVE :: press_cen_climoz(:) ! Pressure levels
+    REAL, ALLOCATABLE, SAVE :: press_edg_climoz(:) ! Edges of pressure intervals
+    REAL, ALLOCATABLE, SAVE :: time_climoz(:)      ! Time vector
     CHARACTER(LEN=13), PARAMETER :: vars_climoz(2) &
                                   = ["tro3         ","tro3_daylight"]
@@ -1234,5 +1256,4 @@
     !IM 100106 BEG : pouvoir sortir les ctes de la physique
     include "conema3.h"
-    include "fisrtilp.h"
     include "nuage.h"
     include "compbl.h"
@@ -1312,6 +1333,13 @@
     real xtql1(ntraciso,klon),xtql2(ntraciso,klon),corrxtql(ntraciso)
 #endif
+    
+
+    REAL, dimension(klon,klev) :: t_env,q_env
+
+    REAL, dimension(klon) :: pr_et
+    REAL, dimension(klon) :: w_et, jlr_g_c, jlr_g_s
 
     REAL pi
+    INTEGER ieru
 
     pi = 4. * ATAN(1.)
@@ -1329,4 +1357,5 @@
     CALL update_time(pdtphys)
     phys_tstep=NINT(pdtphys)
+    IF (.NOT. using_xios) missing_val=nf90_fill_real
 #ifdef CPP_XIOS
 ! switch to XIOS LMDZ physics context 
@@ -1372,4 +1401,5 @@
        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)
@@ -1388,5 +1418,5 @@
             solarlong0,seuil_inversion, &
             fact_cldcon, facttemps,ok_newmicro,iflag_radia, &
-            iflag_cld_th,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
+            iflag_cld_th,ratqsbas,ratqshaut,tau_ratqs, &
             ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan, flag_volc_surfstrat, aerosol_couple, &
             chemistry_couple, flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
@@ -1403,4 +1433,6 @@
 #ifdef CPP_StratAer
        CALL strataer_init
+       CALL strataer_nuc_init
+       CALL strataer_emiss_init
 #endif
 
@@ -1421,5 +1453,5 @@
        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.'
@@ -1440,4 +1472,14 @@
        ENDIF
 
+        IF (ok_bs) THEN
+          abort_message='blowing snow cannot be activated with water isotopes yet'
+          CALL abort_physic(modname,abort_message, 1)
+         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
        dnwd0=0.0
@@ -1578,4 +1620,5 @@
           piz_aero(:,:,:,:) = 0.
           cg_aero(:,:,:,:) = 0.
+          d_q_ch4(:,:) = 0.
 
           config_inca='none' ! default
@@ -1589,4 +1632,5 @@
        piz_aero(:,:,:,:) = 1.
        cg_aero(:,:,:,:)  = 0.
+       d_q_ch4(:,:) = 0.
 
        IF (aerosol_couple .AND. (config_inca /= "aero" &
@@ -1807,5 +1851,5 @@
 
 !       CALL create_climoz(read_climoz)
-      IF (.NOT. create_etat0_limit) CALL init_aero_fromfile(flag_aerosol)  !! initialise aero from file for XIOS interpolation (unstructured_grid)
+      IF (.NOT. create_etat0_limit) CALL init_aero_fromfile(flag_aerosol, aerosol_couple)  !! initialise aero from file for XIOS interpolation (unstructured_grid)
       IF (.NOT. create_etat0_limit) CALL init_readaerosolstrato(flag_aerosol_strat)  !! initialise aero strato from file for XIOS interpolation (unstructured_grid)
 
@@ -1887,11 +1931,32 @@
        CALL wake_ini(rg,rd,rv,prt_level)
        CALL yamada_ini(klon,lunout,prt_level)
-       CALL atke_ini(prt_level, lunout, RG, RD, RPI, RCPD)
+       CALL atke_ini(prt_level, lunout, RG, RD, RPI, RCPD, RV)
        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 ratqs_ini(klon,klev,iflag_thermals,lunout,nbsrf,is_lic,is_ter,RG,RV,RD,RCPD,RLSTT,RLVTT,RTT)
+       CALL lscp_ini(pdtphys,lunout,prt_level,ok_ice_sursat,iflag_ratqs,fl_cor_ebil,RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT,RD,RG)
+       CALL blowing_snow_ini(prt_level,lunout, &
+                             RCPD, RLSTT, RLVTT, RLMLT, &
+                             RVTMP2, RTT,RD,RG)
+       ! Test de coherence sur oc_cdnc utilisé uniquement par cloud_optics_prop
+       IF (ok_newmicro) then
+          IF (iflag_rrtm.EQ.1) THEN
+#ifdef CPP_RRTM
+             IF (ok_cdnc.AND.NRADLP.NE.3) THEN
+             abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 ' &
+                  // 'pour ok_cdnc' 
+             CALL abort_physic(modname,abort_message,1)
+             ENDIF
+#else
+
+             abort_message='You should compile with -rrtm if running with '//'iflag_rrtm=1'
+             CALL abort_physic(modname,abort_message,1)
+#endif
+          ENDIF
+       ENDIF   
+       CALL cloud_optics_prop_ini(klon, prt_level, lunout, flag_aerosol, &
+                                  & ok_cdnc, bl95_b0, &
+                                  & bl95_b1, latitude_deg, rpi, rg, rd, &
+                                  & zepsec, novlp, iflag_ice_thermo, ok_new_lscp)
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -1919,8 +1984,8 @@
        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,           &
-                              flag_aerosol, flag_aerosol_strat, ok_cdnc)
+                              flag_aerosol, flag_aerosol_strat, ok_cdnc,t,u1,v1)
 #endif
 
@@ -2119,22 +2184,17 @@
        !=============================================================
 
-#ifdef CPP_XIOS
-       ! Get "missing_val" value from XML files (from temperature variable)
-       !$OMP MASTER
-       CALL xios_get_field_attr("temp",default_value=missing_val_omp)
-       !$OMP END MASTER
-       !$OMP BARRIER
-       missing_val=missing_val_omp
-#endif
-
-#ifdef CPP_XIOS 
+       IF (using_xios) THEN    
+         ! Get "missing_val" value from XML files (from temperature variable)
+         IF (is_omp_master) CALL xios_get_field_attr("temp",default_value=missing_val)
+         CALL bcast_omp(missing_val)
+       ENDIF
+
+      IF (using_xios) THEN 
 ! Need to put this initialisation after phyetat0 as in the coupled model the XIOS context is only
 ! initialised at that moment
        ! Get "missing_val" value from XML files (from temperature variable)
-       !$OMP MASTER
-       CALL xios_get_field_attr("temp",default_value=missing_val_omp)
-       !$OMP END MASTER
-       !$OMP BARRIER
-       missing_val=missing_val_omp
+        IF (is_omp_master) CALL xios_get_field_attr("temp",default_value=missing_val)
+        CALL bcast_omp(missing_val)
+       
        ! 
        ! Now we activate some double radiation call flags only if some
@@ -2177,5 +2237,7 @@
        CALL bcast(dryaod_diag)
        CALL bcast(ok_4xCO2atm)
-#endif 
+
+     ENDIF !using_xios 
+
        !
        CALL printflag( tabcntr0,radpas,ok_journe, &
@@ -2406,4 +2468,5 @@
     dql0(:,:)=0.
     dqi0(:,:)=0.
+    dqbs0(:,:)=0.
 #ifdef ISO
       dxt0(:,:,:)=0.
@@ -2463,4 +2526,5 @@
           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
@@ -2470,8 +2534,16 @@
              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
@@ -2480,5 +2552,6 @@
 #ifdef ISO
 #ifdef ISOVERIF
-!    write(*,*) 'physiq 1847: qx(1,1,:)=',qx(1,1,:)
+    write(*,*) 'physiq 1847: qx(1,1,:)=',qx(1,1,:)
+    write(*,*) 'iqIsoPha(:,ivap)=',iqIsoPha(:,ivap)
     write(*,*) 'physiq 1846b: ok_isotopes,ntraciso,niso=',niso>0,ntraciso,niso
 #endif
@@ -2514,5 +2587,5 @@
     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
 #ifdef ISO
@@ -2596,5 +2669,5 @@
      &              'physiq 2099 ql').eq.1) then
                   write(*,*) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k) 
-                  stop
+                  !stop
               endif !  if (iso_verif_o18_aberrant_nostop 
             endif !if (q_seri(i,k).gt.errmax) then  
@@ -2605,10 +2678,19 @@
      &              'physiq 2099 qs').eq.1) then
                   write(*,*) 'i,k,qs_seri(i,k)=',i,k,qs_seri(i,k) 
-                  stop
+                  !stop
               endif !  if (iso_verif_o18_aberrant_nostop 
             endif !if (q_seri(i,k).gt.errmax) then
           enddo !k=1,klev
          enddo  !i=1,klon
-        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
+        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then         
+#ifdef ISOTRAC  
+         DO k = 1, klev
+           DO i = 1, klon    
+             call iso_verif_traceur(xt_seri(1,i,k),'physiq 2620a')
+             call iso_verif_traceur(xtl_seri(1,i,k),'physiq 2620b')
+             call iso_verif_traceur(xts_seri(1,i,k),'physiq 2620c') 
+           enddo
+         enddo
+#endif
 #endif
     !
@@ -2621,4 +2703,5 @@
        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
@@ -2627,4 +2710,6 @@
        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
@@ -2713,4 +2798,5 @@
        d_ql_dyn2d(:) = 0.0
        d_qs_dyn2d(:) = 0.0
+       d_qbs_dyn2d(:)= 0.0
 
 #ifdef ISO
@@ -2736,4 +2822,5 @@
        ! !! RomP <<<
        d_rneb_dyn(:,:)=0.0
+       d_qbs_dyn(:,:)=0.0
        ancien_ok = .TRUE.
     ENDIF
@@ -2844,4 +2931,17 @@
        ENDIF
     ENDIF
+
+#ifdef ISO
+#ifdef ISOVERIF 
+#ifdef ISOTRAC 
+         DO k = 1, klev
+           DO i = 1, klon         
+             call iso_verif_traceur(xt_seri(1,i,k), &
+     &           'physiq 2856: avant reevp')
+           enddo
+         enddo
+#endif
+#endif
+#endif
     !
     ! Re-evaporer l'eau liquide nuageuse
@@ -2855,5 +2955,5 @@
 
      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 &
 #ifdef ISO
@@ -3008,4 +3108,15 @@
        ELSE IF (iflag_gusts==2) THEN
           gustiness(1:klon)=f_gust_bl*ale_bl_stat(1:klon)+f_gust_wk*ale_wake(1:klon)
+       !!!! modif olivier torres
+       ELSE IF (iflag_gusts==3) THEN
+          w_et=wstar(1,3)
+          jlr_g_s=(0.65*w_et)**2
+          pr_et=rain_con*8640
+          jlr_g_c = (((19.8*(pr_et(1:klon)**2))/(1.5+pr_et(1:klon)+pr_et(1:klon)**2))**(0.4))**2
+          gustiness(1:klon)=jlr_g_c+jlr_g_s
+!!       write(*,*) "rain ",pr_et
+!!       write(*,*) "jlr_g_c",jlr_g_c
+!!       write(*,*) "wstar",wstar(1,3)
+!!       write(*,*) "jlr_g_s",jlr_g_s
           ! ELSE IF (iflag_gusts==2) THEN
           !    do i = 1, klon
@@ -3024,7 +3135,7 @@
             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, &
@@ -3037,9 +3148,9 @@
                                 !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<
@@ -3067,5 +3178,5 @@
             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, &
@@ -3179,5 +3290,5 @@
        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 &
 #ifdef ISO
@@ -3187,5 +3298,5 @@
        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 &
 #ifdef ISO
@@ -3249,4 +3360,28 @@
 
     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  &
+#ifdef ISO                                       
+       &    ,dxt0,dxtl0,dxti0 &                    
+#endif                                       
+       &   )
+
+    ENDIF
+
     ! =================================================================== c
     !   Calcul de Qsat
@@ -3458,4 +3593,20 @@
                   call iso_verif_egalite(q_w(i,k),xt_w(iso_eau,i,k),'physiq 3338')
                 endif
+                if (iso_HDO.gt.0) then
+                  if ((iso_verif_aberrant_enc_choix_nostop(xt_x(iso_hdo,i,k),q_x(i,k), &
+                        ridicule,deltalim,'physic 3462a xt_x').eq.1).or. &
+                        (iso_verif_aberrant_enc_choix_nostop(xt_w(iso_hdo,i,k),q_w(i,k), &
+                        ridicule,deltalim,'physic 3462b xt_w').eq.1)) then
+                     write(*,*) 'i,k=',i,k
+                     write(*,*) 'q_x(i,k),q_seri(i,k),wake_s(i),wake_deltaq(i,k)=', &
+                                q_x(i,k),q_seri(i,k),wake_s(i),wake_deltaq(i,k)
+                     write(*,*) 'xt_x(iso_hdo,i,k),xt_seri(iso_hdo,i,k),wake_s(i),wake_deltaxt(iso_hdo,i,k)=', &
+                                xt_x(iso_hdo,i,k),xt_seri(iso_hdo,i,k),wake_s(i),wake_deltaxt(iso_hdo,i,k)
+                     write(*,*) 'deltaD_seri,wake=',deltaD(xt_seri(iso_hdo,i,k)/q_seri(i,k)), &
+                                deltaD(wake_deltaxt(iso_hdo,i,k)/wake_deltaq(i,k))
+                     write(*,*) 'deltaD_x,deltaD_w=',deltaD(xt_x(iso_hdo,i,k)/q_x(i,k)),deltaD(xt_w(iso_hdo,i,k)/q_w(i,k))
+                     stop
+                  endif
+                endif
 #endif
 #endif
@@ -3590,5 +3741,5 @@
               call iso_verif_aberrant_encadre( &
      &           xt_w(iso_hdo,i,k)/q_w(i,k), &
-     &          'physic 2657b')
+     &          'physic 2657c')
              endif !if (q_x(i,k).gt.ridicule) then
            endif !if (iso_HDO.gt.0) then
@@ -3671,5 +3822,5 @@
                ALE,ALP, &
                sig1,w01, &
-               d_t_con,d_q_con,d_u_con,d_v_con,d_tr, &
+               d_t_con,d_q_con,fqcomp,d_u_con,d_v_con,d_tr, &
                rain_con, snow_con, ibas_con, itop_con, sigd, &
                ema_cbmf,plcl,plfc,wbeff,convoccur,upwd,dnwd,dnwd0, &
@@ -3682,5 +3833,5 @@
                ftd,fqd,lalim_conv,wght_th, &
                ev, ep,epmlmMm,eplaMm, &
-               wdtrainA, wdtrainS, wdtrainM,wght_cvfd,qtc_cv,sigt_cv, &
+               wdtrainA, wdtrainS, wdtrainM,wght_cvfd,qtc_cv,sigt_cv,detrain_cv, &
                tau_cld_cv,coefw_cld_cv,epmax_diag &
 #ifdef ISO
@@ -3734,4 +3885,5 @@
           clwcon0=qcondc
           pmfu(:,:)=upwd(:,:)+dnwd(:,:)
+          fm_cv(:,:)=upwd(:,:)+dnwd(:,:)+dnwd0(:,:)
           !
           !jyg<
@@ -3920,5 +4072,5 @@
 !!
 !!
-    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 &
 #ifdef ISO
@@ -4152,5 +4304,5 @@
        !-----------------------------------------------------------------------
        ! 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 &
 #ifdef ISO
@@ -4255,5 +4407,5 @@
              endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then    
              if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
-               if ((q_seri(i,k).gt.ridicule).and.(l.lt.nlevmaxO17)) then
+               if ((q_seri(i,k).gt.ridicule).and.(k.lt.nlevmaxO17)) then
                  call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
      &           /q_seri(i,k),xt_seri(iso_o18,i,k) &
@@ -4356,8 +4508,17 @@
 #endif
           !>jyg
+          ! WARNING !!! introduction d'une subtilite avec la distinction
+          ! entre deux types de profiles pour les thermiques.
+          ! Ne change pas les resultats avec les isotopes tant qu'on
+          ! tourne avec le defaut : iflag_thermals_tenv=0
+          if ( iflag_thermals_tenv /= 0 ) then 
+              abort_message ='iflag_thermals_env/=0 : non prevu avec les isotopes'
+              CALL abort_physic (modname,abort_message,1)
+          endif
+
           CALL calltherm(pdtphys &
                ,pplay,paprs,pphi,weak_inversion &
                         ! ,u_seri,v_seri,t_seri,q_seri,zqsat,debut & !jyg
-               ,u_therm,v_therm,t_therm,q_therm,zqsat,debut &  !jyg
+               ,u_therm,v_therm,t_therm,q_therm,t_therm,q_therm,zqsat,debut &  !jyg
                ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs &
                ,fm_therm,entr_therm,detr_therm &
@@ -4431,5 +4592,5 @@
           !
           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 &
 #ifdef ISO
      &    ,d_xt_ajs,dxtl0,dxti0 &
@@ -4547,5 +4708,5 @@
           !--------------------------------------------------------------------
           ! 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 &
 #ifdef ISO
@@ -4582,12 +4743,15 @@
     ENDDO
 
-    CALL  calcratqs(klon,klev,prt_level,lunout,        &
+    CALL ratqs_main(klon,klev,nbsrf,prt_level,lunout,        &
          iflag_ratqs,iflag_con,iflag_cld_th,pdtphys,  &
          ratqsbas,ratqshaut,ratqsp0, ratqsdp, &
+         pctsrf,s_pblh,zstd, &
          tau_ratqs,fact_cldcon,wake_s, wake_deltaq,   &
          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, &
-         ratqs,ratqsc,ratqs_inter)
+         paprs,pplay,t_seri,q_seri, &
+         qtc_cv, sigt_cv,detrain_cv,fm_cv,fqd,fqcomp,sigd,zqsat, &
+         omega,pbl_tke(:,:,is_ave),tke_dissip_ave,l_mix_ave,wprime_ave, &
+         t2m,q2m,fm_therm,entr_therm,detr_therm,cell_area, &
+         ratqs,ratqsc,ratqs_inter_)
 
     !
@@ -4619,5 +4783,5 @@
         do i=1,klon
            if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
-            if ((q_seri(i,k).gt.ridicule).and.(l.lt.nlevmaxO17)) then
+            if ((q_seri(i,k).gt.ridicule).and.(k.lt.nlevmaxO17)) then
              call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
      &           /q_seri(i,k),xt_seri(iso_o18,i,k) &
@@ -4692,11 +4856,14 @@
          t_seri, q_seri,ptconv,ratqs, &
          d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, rneb_seri, &
-         cldliq, picefra, rain_lsc, snow_lsc, &
+         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, temp_cltop, &
          qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, &
-         Tcontr, qcontr, qcontr2, fcontrN, fcontrP )
+         Tcontr, qcontr, qcontr2, fcontrN, fcontrP , &
+         cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
+
 
     ELSE
@@ -4704,5 +4871,5 @@
     CALL fisrtilp(phys_tstep,paprs,pplay, &
          t_seri, q_seri,ptconv,ratqs, &
-         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, cldliq, &
+         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, radocond, &
          rain_lsc, snow_lsc, &
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &
@@ -4752,5 +4919,5 @@
 !    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 &
 #ifdef ISO
@@ -4789,15 +4956,39 @@
     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?
-          IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
+          !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
 #ifdef ISO      
 !#ifdef ISOVERIF
@@ -4841,6 +5032,6 @@
             endif !if (q_seri(i,k).gt.errmax) then
             if (ql_seri(i,k).gt.ridicule) then
-               call iso_verif_aberrant( &
-     &           xtl_seri(iso_HDO,i,k)/ql_seri(i,k),'physiq 2871')
+               call iso_verif_aberrant_choix(xtl_seri(iso_HDO,i,k),ql_seri(i,k), &
+                        ridicule,deltalim_snow,'physiq 2871')
                if (iso_O18.gt.0) then  
                  if (iso_verif_o18_aberrant_nostop( &
@@ -4854,5 +5045,5 @@
                         write(*,*) 'deltaO(d_ql_lsc(i,k))=',deltaO( &
      &                           d_xtl_lsc(iso_O18,i,k)/d_ql_lsc(i,k))
-                        stop
+                        !stop
                  endif
                endif ! if (iso_O18.gt.0) then  
@@ -4864,5 +5055,5 @@
         do i=1,klon 
           do k=1,nlev
-           if ((q_seri(i,k).gt.ridicule).and.(l.lt.nlevmaxO17)) then
+           if ((q_seri(i,k).gt.ridicule).and.(k.lt.nlevmaxO17)) then
             call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
      &           /q_seri(i,k),xt_seri(iso_o18,i,k) &
@@ -4962,5 +5153,5 @@
           DO i = 1, klon
              IF (diafra(i,k).GT.cldfra(i,k)) THEN
-                cldliq(i,k) = dialiq(i,k)
+                radocond(i,k) = dialiq(i,k)
                 cldfra(i,k) = diafra(i,k)
              ENDIF
@@ -4999,9 +5190,9 @@
                 DO i=1,klon
                    IF (ptconv(i,k).AND.ptconvth(i,k)) THEN
-                      cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
+                      radocond(i,k)=radocond(i,k)+rnebcon(i,k)*clwcon(i,k)
                       cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
                    ELSE IF (ptconv(i,k)) THEN
                       cldfra(i,k)=rnebcon(i,k)
-                      cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
+                      radocond(i,k)=rnebcon(i,k)*clwcon(i,k)
                    ENDIF
                 ENDDO
@@ -5012,5 +5203,5 @@
                 DO i=1,klon
                    cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
-                   cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
+                   radocond(i,k)=radocond(i,k)+rnebcon(i,k)*clwcon(i,k)
                 ENDDO
              ENDDO
@@ -5030,5 +5221,5 @@
                    IF (ptconv(i,k).AND. .NOT.ptconvth(i,k)) THEN
                       cldfra(i,k)=rnebcon(i,k)
-                      cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
+                      radocond(i,k)=rnebcon(i,k)*clwcon(i,k)
                    ENDIF
                 ENDDO
@@ -5041,5 +5232,5 @@
           ! Ancienne version
           cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
-          cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)
+          radocond(:,:)=radocond(:,:)+rnebcon(:,:)*clwcon(:,:)
        ENDIF
 
@@ -5061,5 +5252,5 @@
           DO i = 1, klon
              IF (diafra(i,k).GT.cldfra(i,k)) THEN
-                cldliq(i,k) = dialiq(i,k)
+                radocond(i,k) = dialiq(i,k)
                 cldfra(i,k) = diafra(i,k)
              ENDIF
@@ -5420,35 +5611,15 @@
        ENDIF
 
-       IF (ok_newmicro) then
-! AI          IF (iflag_rrtm.NE.0) THEN 
-          IF (iflag_rrtm.EQ.1) THEN
-#ifdef CPP_RRTM
-             IF (ok_cdnc.AND.NRADLP.NE.3) THEN
-             abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 ' &
-                  // 'pour ok_cdnc' 
-             CALL abort_physic(modname,abort_message,1)
-             ENDIF
-#else
-
-             abort_message='You should compile with -rrtm if running with '//'iflag_rrtm=1'
-             CALL abort_physic(modname,abort_message,1)
-#endif
-          ENDIF
-          CALL newmicro (flag_aerosol, ok_cdnc, bl95_b0, bl95_b1, &
-               paprs, pplay, t_seri, cldliq, picefra, cldfra, &
+       !Rajout appel a interface calcul proprietes optiques des nuages
+       CALL call_cloud_optics_prop(klon, klev, ok_newmicro, &
+               paprs, pplay, t_seri, radocond, picefra, cldfra, &
                cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, &
-               flwp, fiwp, flwc, fiwc, &
+               flwp, fiwp, flwc, fiwc, ok_aie, &
                mass_solu_aero, mass_solu_aero_pi, &
-               cldtaupi, latitude_deg, re, fl, ref_liq, ref_ice, &
-               ref_liq_pi, ref_ice_pi)
-       ELSE
-          CALL nuage (paprs, pplay, &
-               t_seri, cldliq, picefra, cldfra, cldtau, cldemi, &
-               cldh, cldl, cldm, cldt, cldq, &
-               ok_aie, &
-               mass_solu_aero, mass_solu_aero_pi, &
-               bl95_b0, bl95_b1, &
-               cldtaupi, re, fl)
-       ENDIF
+               cldtaupi, distcltop, temp_cltop, re, fl, ref_liq, ref_ice, &
+               ref_liq_pi, ref_ice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, &
+               reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  & 
+               zfice, dNovrN, ptconv, rnebcon, clwcon)
+
        !
        !IM betaCRF
@@ -5635,16 +5806,16 @@
           cool = cool + betalwoff * (cool0 - cool)
  
-#ifndef CPP_XIOS
-          !
-          !IM 2eme calcul radiatif pour le cas perturbe ou au moins un
-          !IM des taux doit etre different du taux actuel
-          !IM Par defaut on a les taux perturbes egaux aux taux actuels
-          !
-          IF (RCO2_per.NE.RCO2_act.OR. &
-              RCH4_per.NE.RCH4_act.OR. &
-              RN2O_per.NE.RN2O_act.OR. &
-              RCFC11_per.NE.RCFC11_act.OR. &
-              RCFC12_per.NE.RCFC12_act) ok_4xCO2atm =.TRUE. 
-#endif
+          IF (.NOT. using_xios) THEN
+            !
+            !IM 2eme calcul radiatif pour le cas perturbe ou au moins un
+            !IM des taux doit etre different du taux actuel
+            !IM Par defaut on a les taux perturbes egaux aux taux actuels
+            !
+            IF (RCO2_per.NE.RCO2_act.OR. &
+                RCH4_per.NE.RCH4_act.OR. &
+                RN2O_per.NE.RN2O_act.OR. &
+                RCFC11_per.NE.RCFC11_act.OR. &
+                RCFC12_per.NE.RCFC12_act) ok_4xCO2atm =.TRUE. 
+          ENDIF
    ! 
           IF (ok_4xCO2atm) THEN
@@ -5753,5 +5924,5 @@
     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 &
 #ifdef ISO
      &    ,dxt0,dxtl0,dxti0 &
@@ -5759,5 +5930,5 @@
      &  )
     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 &
 #ifdef ISO
      &    ,dxt0,dxtl0,dxti0 &
@@ -5807,5 +5978,5 @@
           ! -> condition on zrel_oro can deactivate the drag on tilted planar terrains
           !    such as ice sheets (work by V. Wiener)
-          ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to 
+          ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to
           ! earn computation time but they are not physical.
           IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN
@@ -5838,5 +6009,5 @@
        !-----------------------------------------------------------------------
        ! 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 &
 #ifdef ISO
@@ -5893,5 +6064,5 @@
 
        ! 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 &
 #ifdef ISO
@@ -5922,5 +6093,5 @@
        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 &
 #ifdef ISO
      &    ,dxt0,dxtl0,dxti0 &
@@ -5944,5 +6115,5 @@
        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 &
 #ifdef ISO
@@ -5957,5 +6128,5 @@
             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 &
 #ifdef ISO
@@ -6010,5 +6181,11 @@
     !DC Calcul de la tendance due au methane
     IF (ok_qch4) THEN
+!      d_q_ch4: H2O source in ppmv/sec
+#ifdef CPP_StratAer
+       CALL stratH2O_methox(debut,paprs,d_q_ch4)
+#else
+!      ecmwf routine METHOX
        CALL METHOX(1,klon,klon,klev,q_seri,d_q_ch4,pplay)
+#endif
        ! ajout de la tendance d'humidite due au methane
        d_q_ch4_dtime(:,:) = d_q_ch4(:,:)*phys_tstep
@@ -6016,5 +6193,5 @@
        d_xt_ch4_dtime(:,:,:) = d_xt_ch4(:,:,:)*phys_tstep
 #endif
-       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 &
 #ifdef ISO
@@ -6029,4 +6206,50 @@
     !
     !
+#ifdef CPP_StratAer
+    IF (ok_qemiss) THEN
+       flh2o=1
+       IF(flag_verbose_strataer) THEN
+          print *,'IN physiq_mod: ok_qemiss =yes (',ok_qemiss,'), flh2o=',flh2o
+          print *,'IN physiq_mod: flag_emit=',flag_emit,', nErupt=',nErupt
+          print *,'IN physiq_mod: nAerErupt=',nAerErupt
+       ENDIF
+       
+       SELECT CASE(flag_emit)
+       CASE(1) ! emission volc H2O dans LMDZ
+          DO ieru=1, nErupt
+             IF (year_cur==year_emit_vol(ieru).AND.&
+                  mth_cur==mth_emit_vol(ieru).AND.&
+                  day_cur>=day_emit_vol(ieru).AND.&
+                  day_cur<(day_emit_vol(ieru)+injdur)) THEN
+                
+                IF(flag_verbose_strataer) print *,'IN physiq_mod: date=',year_cur,mth_cur,day_cur
+                ! initialisation tendance q emission
+                d_q_emiss(:,:)=0.
+                ! daily injection mass emission - NL
+                m_H2O_emiss_vol_daily = m_H2O_emiss_vol(ieru)/(REAL(injdur)&
+                     *REAL(ponde_lonlat_vol(ieru)))
+                !
+                CALL STRATEMIT(pdtphys,pdtphys,latitude_deg,longitude_deg,t_seri,&
+                     pplay,paprs,tr_seri,&
+                     m_H2O_emiss_vol_daily,&
+                     xlat_min_vol(ieru),xlat_max_vol(ieru),&
+                     xlon_min_vol(ieru),xlon_max_vol(ieru),&
+                     altemiss_vol(ieru),&
+                     sigma_alt_vol(ieru),1,&
+                     1,nAerErupt+1,0)
+                
+                IF(flag_verbose_strataer) print *,'IN physiq_mod: min max d_q_emiss=',&
+                     minval(d_q_emiss),maxval(d_q_emiss)
+                
+                CALL add_phys_tend(du0, dv0, dt0, d_q_emiss, dql0, dqi0, dqbs0, paprs, &
+                     'q_emiss',abortphy,flag_inhib_tend,itap,0)
+                IF (abortphy==1) Print*,'ERROR ABORT TEND EMISS'
+             ENDIF
+          ENDDO
+          flh2o=0
+       END SELECT ! emission scenario (flag_emit)
+    ENDIF
+#endif
+
 
 !===============================================================
@@ -6082,5 +6305,5 @@
 ! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE
 ! Mais attention, cela ne va pas dans le sens de la conservation de l'energie! 
-          IF ((zstd(i).GT.1.0).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN
+          IF ((zstd(i).GT.1.0) .AND.(zrel_oro(i).LE.zrel_oro_t)) THEN
              itest(i)=1
              igwd=igwd+1
@@ -6149,5 +6372,5 @@
      &              xt_seri(iso_HDO,i,k)/q_seri(i,k), &
      &              xt_seri(iso_O18,i,k)/q_seri(i,k), &
-     &              'physiq 5937, juste apres methox, qv').eq.1) then
+     &              'physiq 5937a, juste apres methox, qv').eq.1) then
                   write(*,*) 'physic 2444: i,k,q_seri(i,k)=',i,k,q_seri(i,k) 
                   write(*,*) 'xt_seri(:,i,k)=',xt_seri(:,i,k)
@@ -6159,7 +6382,7 @@
      &              xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
      &              xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
-     &              'physiq 5937, juste apres methox, ql').eq.1) then
+     &              'physiq 5937b, juste apres methox, ql').eq.1) then
                   write(*,*) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k) 
-                  stop
+                  !stop
               endif !  if (iso_verif_o18_aberrant_nostop 
             endif !if (q_seri(i,k).gt.errmax) then  
@@ -6168,7 +6391,7 @@
      &              xts_seri(iso_HDO,i,k)/qs_seri(i,k), &
      &              xts_seri(iso_O18,i,k)/qs_seri(i,k), &
-     &              'physiq 5937, juste apres methox, qs').eq.1) then
+     &              'physiq 5937c, juste apres methox, qs').eq.1) then
                   write(*,*) 'i,k,qs_seri(i,k)=',i,k,qs_seri(i,k) 
-                  stop
+                  !stop
               endif !  if (iso_verif_o18_aberrant_nostop 
             endif !if (q_seri(i,k).gt.errmax) then
@@ -6342,5 +6565,5 @@
     !
 
-    IF (type_trac=='repr') THEN
+    IF (type_trac == 'repr') THEN
 !MM pas d'impact, car on recupere q_seri,tr_seri,t_seri via phys_local_var_mod
 !MM                               dans Reprobus
@@ -6392,5 +6615,5 @@
          presnivs, pphis,     pphi,     albsol1, &
          sh_in,   ch_in,    rhcl,      cldfra,   rneb, &
-         diafra,   cldliq,    itop_con, ibas_con, &
+         diafra,   radocond,    itop_con, ibas_con, &
          pmflxr,   pmflxs,    prfl,     psfl, &
          da,       phi,       mp,       upwd, &
@@ -6409,5 +6632,5 @@
 
      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'
@@ -6486,11 +6709,14 @@
     !   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
 
@@ -6563,7 +6789,13 @@
           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
@@ -6610,4 +6842,18 @@
       qql2(:)=qql2(:)+(q_seri(:,k)+ql_seri(:,k)+qs_seri(:,k))*zmasse(:,k)
     ENDDO
+    
+#ifdef CPP_StratAer
+    IF (ok_qemiss) THEN
+       DO k = 1, klev
+          qql1(:) = qql1(:)+d_q_emiss(:,k)*zmasse(:,k)
+       ENDDO
+    ENDIF
+#endif
+    IF (ok_qch4) THEN
+       DO k = 1, klev
+          qql1(:) = qql1(:)+d_q_ch4_dtime(:,k)*zmasse(:,k)
+       ENDDO
+    ENDIF
+    
     DO i = 1, klon
       !--compute ratio of what q+ql should be with conservation to what it is
@@ -6645,4 +6891,5 @@
     ql_ancien(:,:) = ql_seri(:,:)
     qs_ancien(:,:) = qs_seri(:,:)
+    qbs_ancien(:,:) = qbs_seri(:,:)
     rneb_ancien(:,:) = rneb_seri(:,:)
 #ifdef ISO
@@ -6654,4 +6901,5 @@
     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(:,:,:)
@@ -6782,8 +7030,8 @@
     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,           &
-         flag_aerosol, flag_aerosol_strat, ok_cdnc)
+         flag_aerosol, flag_aerosol_strat, ok_cdnc,t,u1,v1)
 #endif
 
@@ -6796,50 +7044,51 @@
 ! Pour XIOS : On remet des variables a .false. apres un premier appel
     IF (debut) THEN
-#ifdef CPP_XIOS
-      swaero_diag=.FALSE.
-      swaerofree_diag=.FALSE.
-      dryaod_diag=.FALSE.
-      ok_4xCO2atm= .FALSE.
-!      write (lunout,*)'ok_4xCO2atm= ',swaero_diag, swaerofree_diag, dryaod_diag, ok_4xCO2atm
-
-      IF (is_master) THEN
-        !--setting up swaero_diag to TRUE in XIOS case 
-        IF (xios_field_is_active("topswad").OR.xios_field_is_active("topswad0").OR. & 
-           xios_field_is_active("solswad").OR.xios_field_is_active("solswad0").OR. & 
-           xios_field_is_active("topswai").OR.xios_field_is_active("solswai").OR.  & 
-             (iflag_rrtm==1.AND.(xios_field_is_active("toplwad").OR.xios_field_is_active("toplwad0").OR. & 
-                                 xios_field_is_active("sollwad").OR.xios_field_is_active("sollwad0"))))  & 
-           !!!--for now these fields are not in the XML files so they are omitted 
-           !!!  xios_field_is_active("toplwai").OR.xios_field_is_active("sollwai") !))) & 
-           swaero_diag=.TRUE. 
-
-        !--setting up swaerofree_diag to TRUE in XIOS case 
-        IF (xios_field_is_active("SWdnSFCcleanclr").OR.xios_field_is_active("SWupSFCcleanclr").OR. &
-           xios_field_is_active("SWupTOAcleanclr").OR.xios_field_is_active("rsucsaf").OR.   &
-           xios_field_is_active("rsdcsaf") .OR. xios_field_is_active("LWdnSFCcleanclr").OR. &
-           xios_field_is_active("LWupTOAcleanclr")) &
-           swaerofree_diag=.TRUE. 
-
-        !--setting up dryaod_diag to TRUE in XIOS case 
-        DO naero = 1, naero_tot-1
-         IF (xios_field_is_active("dryod550_"//name_aero_tau(naero))) dryaod_diag=.TRUE. 
-        ENDDO
-        !
-        !--setting up ok_4xCO2atm to TRUE in XIOS case 
-        IF (xios_field_is_active("rsut4co2").OR.xios_field_is_active("rlut4co2").OR. & 
-           xios_field_is_active("rsutcs4co2").OR.xios_field_is_active("rlutcs4co2").OR. &
-           xios_field_is_active("rsu4co2").OR.xios_field_is_active("rsucs4co2").OR. &
-           xios_field_is_active("rsd4co2").OR.xios_field_is_active("rsdcs4co2").OR. &
-           xios_field_is_active("rlu4co2").OR.xios_field_is_active("rlucs4co2").OR. &
-           xios_field_is_active("rld4co2").OR.xios_field_is_active("rldcs4co2")) &
-           ok_4xCO2atm=.TRUE. 
-      ENDIF
-      !$OMP BARRIER
-      CALL bcast(swaero_diag)
-      CALL bcast(swaerofree_diag)
-      CALL bcast(dryaod_diag)
-      CALL bcast(ok_4xCO2atm)
-!      write (lunout,*)'ok_4xCO2atm= ',swaero_diag, swaerofree_diag, dryaod_diag, ok_4xCO2atm
-#endif
+
+      IF (using_xios) THEN
+        swaero_diag=.FALSE.
+        swaerofree_diag=.FALSE.
+        dryaod_diag=.FALSE.
+        ok_4xCO2atm= .FALSE.
+!       write (lunout,*)'ok_4xCO2atm= ',swaero_diag, swaerofree_diag, dryaod_diag, ok_4xCO2atm
+
+        IF (is_master) THEN
+          !--setting up swaero_diag to TRUE in XIOS case 
+          IF (xios_field_is_active("topswad").OR.xios_field_is_active("topswad0").OR. & 
+             xios_field_is_active("solswad").OR.xios_field_is_active("solswad0").OR. & 
+             xios_field_is_active("topswai").OR.xios_field_is_active("solswai").OR.  & 
+               (iflag_rrtm==1.AND.(xios_field_is_active("toplwad").OR.xios_field_is_active("toplwad0").OR. & 
+                                   xios_field_is_active("sollwad").OR.xios_field_is_active("sollwad0"))))  & 
+             !!!--for now these fields are not in the XML files so they are omitted 
+             !!!  xios_field_is_active("toplwai").OR.xios_field_is_active("sollwai") !))) & 
+             swaero_diag=.TRUE. 
+
+          !--setting up swaerofree_diag to TRUE in XIOS case 
+          IF (xios_field_is_active("SWdnSFCcleanclr").OR.xios_field_is_active("SWupSFCcleanclr").OR. &
+             xios_field_is_active("SWupTOAcleanclr").OR.xios_field_is_active("rsucsaf").OR.   &
+             xios_field_is_active("rsdcsaf") .OR. xios_field_is_active("LWdnSFCcleanclr").OR. &
+             xios_field_is_active("LWupTOAcleanclr")) &
+             swaerofree_diag=.TRUE. 
+
+          !--setting up dryaod_diag to TRUE in XIOS case 
+          DO naero = 1, naero_tot-1
+           IF (xios_field_is_active("dryod550_"//name_aero_tau(naero))) dryaod_diag=.TRUE. 
+          ENDDO
+          !
+          !--setting up ok_4xCO2atm to TRUE in XIOS case 
+          IF (xios_field_is_active("rsut4co2").OR.xios_field_is_active("rlut4co2").OR. & 
+             xios_field_is_active("rsutcs4co2").OR.xios_field_is_active("rlutcs4co2").OR. &
+             xios_field_is_active("rsu4co2").OR.xios_field_is_active("rsucs4co2").OR. &
+             xios_field_is_active("rsd4co2").OR.xios_field_is_active("rsdcs4co2").OR. &
+             xios_field_is_active("rlu4co2").OR.xios_field_is_active("rlucs4co2").OR. &
+             xios_field_is_active("rld4co2").OR.xios_field_is_active("rldcs4co2")) &
+             ok_4xCO2atm=.TRUE. 
+        ENDIF
+        !$OMP BARRIER
+        CALL bcast(swaero_diag)
+        CALL bcast(swaerofree_diag)
+        CALL bcast(dryaod_diag)
+        CALL bcast(ok_4xCO2atm)
+!        write (lunout,*)'ok_4xCO2atm= ',swaero_diag, swaerofree_diag, dryaod_diag, ok_4xCO2atm
+      ENDIF !using_xios
     ENDIF
 
@@ -6903,16 +7152,16 @@
        
        ENDIF
-#ifdef CPP_XIOS
-       IF (is_omp_master) CALL xios_context_finalize
+       
+       IF (using_xios) THEN
+         IF (is_omp_master) CALL xios_context_finalize
 
 #ifdef INCA
-       if (type_trac == 'inca') then 
-          IF (is_omp_master .and. grid_type==unstructured) THEN 
-             CALL finalize_inca
-          ENDIF
-       endif
-#endif
-
-#endif
+         if (type_trac == 'inca') then 
+            IF (is_omp_master .and. grid_type==unstructured) THEN 
+               CALL finalize_inca
+            ENDIF
+         endif
+#endif
+       ENDIF !using_xios
        WRITE(lunout,*) ' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
     ENDIF
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/qsat_seawater.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/qsat_seawater.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/qsat_seawater.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/qsat_seawater.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/qsat_seawater2.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/qsat_seawater2.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/qsat_seawater2.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/qsat_seawater2.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/qsatseaw_1D.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/qsatseaw_1D.F90	(revision 4727)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/qsatseaw_1D.F90	(revision 4727)
@@ -0,0 +1,1 @@
+link ../phylmd/qsatseaw_1D.F90
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/reevap.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/reevap.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/reevap.F90	(revision 4727)
@@ -85,13 +85,13 @@
       do ixt=1,ntiso
         call iso_verif_noNaN(xt_seri(ixt,i,k), &
-     &     'physiq 2417: apres evap tot')
+     &     'reevap 2417: apres evap tot')
       enddo
       if (iso_eau.gt.0) then
               call iso_verif_egalite_choix( &
      &           xt_seri(iso_eau,i,k),q_seri(i,k), &
-     &          'physiq 1891+, après reevap totale',errmax,errmaxrel)
+     &          'reevap 1891+, après reevap totale',errmax,errmaxrel)
               call iso_verif_egalite_choix( &
      &           xtl_seri(iso_eau,i,k),ql_seri(i,k), &
-     &          'physiq 2209+, après reevap totale',errmax,errmaxrel)
+     &          'reevap 2209+, après reevap totale',errmax,errmaxrel)
        endif !if (iso_eau.gt.0) then       
       if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then  
@@ -100,5 +100,5 @@
      &              xt_seri(iso_HDO,i,k)/q_seri(i,k), &
      &              xt_seri(iso_O18,i,k)/q_seri(i,k), &
-     &              'physiq 2315: apres reevap totale').eq.1) then
+     &              'reevap 2315: apres reevap totale').eq.1) then
                   write(*,*) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)
                   write(*,*) 'd_q_eva(i,k)=',d_q_eva(i,k)
@@ -111,7 +111,7 @@
 #ifdef ISOTRAC      
              call iso_verif_traceur(xt_seri(1,i,k), &
-     &           'physiq 2165')
+     &           'reevap 2165a')
              call iso_verif_traceur_pbidouille(xt_seri(1,i,k), &
-     &           'physiq 2165b')
+     &           'reevap 2165b')
 #endif               
          
@@ -146,16 +146,16 @@
       do ixt=1,ntiso
       call iso_verif_noNaN(xt_seri(ixt,i,k), &
-     &     'physiq 2417: apres evap tot')
+     &     'reevap 2417: apres evap tot')
       enddo
       if (iso_eau.gt.0) then
               call iso_verif_egalite_choix( &
      &           xt_seri(iso_eau,i,k),q_seri(i,k), &
-     &          'physiq 1891, après réévap totale',errmax,errmaxrel)
+     &          'reevap 1891, après réévap totale',errmax,errmaxrel)
               call iso_verif_egalite_choix( &
      &           xtl_seri(iso_eau,i,k),ql_seri(i,k), &
-     &          'physiq 2209, après réévap totale',errmax,errmaxrel)
+     &          'reevap 2209, après réévap totale',errmax,errmaxrel)
               call iso_verif_egalite_choix( &
      &           xts_seri(iso_eau,i,k),qs_seri(i,k), &
-     &          'physiq 2209b, après réévap totale',errmax,errmaxrel)
+     &          'reevap 2209b, après réévap totale',errmax,errmaxrel)
        endif !if (iso_eau.gt.0) then
      
@@ -165,5 +165,5 @@
      &              xt_seri(iso_HDO,i,k)/q_seri(i,k), &
      &              xt_seri(iso_O18,i,k)/q_seri(i,k), &
-     &              'physiq 2408: apres reevap totale').eq.1) then
+     &              'reevap 2408: apres reevap totale').eq.1) then
                   write(*,*) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
                   stop
@@ -173,7 +173,7 @@
 #ifdef ISOTRAC      
              call iso_verif_traceur(xt_seri(1,i,k), &
-     &           'physiq 2165')
+     &           'reevap 2165c')
              call iso_verif_traceur_pbidouille(xt_seri(1,i,k), &
-     &           'physiq 2165b')
+     &           'reevap 2165d')
 #endif                  
 #endif                  
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/surf_land_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/surf_land_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/surf_land_mod.F90	(revision 4727)
@@ -11,5 +11,5 @@
        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,5 +17,5 @@
        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 , & 
@@ -94,5 +94,5 @@
     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
@@ -129,5 +129,5 @@
 !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
@@ -152,4 +152,5 @@
     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
 
@@ -166,4 +167,13 @@
 #endif  
 
+!****************************************************************************************
+!Total solid precip
+
+IF (ok_bs) THEN
+precip_totsnow(:)=precip_snow(:)+precip_bs(:)
+ELSE
+precip_totsnow(:)=precip_snow(:)
+ENDIF
+!****************************************************************************************
 #ifdef ISO
 #ifdef ISOVERIF
@@ -228,7 +238,7 @@
             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, &
@@ -277,5 +287,5 @@
 #endif
        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, &
@@ -293,4 +303,6 @@
     ENDIF ! ok_veget
 
+        ! blowing snow not treated yet over land
+        fluxbs(:)=0.
 !****************************************************************************************
 ! Calculation for all land models
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/surf_landice_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/surf_landice_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/surf_landice_mod.F90	(revision 4727)
@@ -12,10 +12,11 @@
        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, &
@@ -34,5 +35,6 @@
     USE cpl_mod,          ONLY : cpl_send_landice_fields
     USE calcul_fluxs_mod
-    USE phys_output_var_mod
+    USE phys_local_var_mod, ONLY : zxrhoslic, zxustartlic
+    USE phys_output_var_mod, ONLY : snow_o,zfra_o
 #ifdef ISO   
     USE fonte_neige_mod,  ONLY : xtrun_off_lic
@@ -48,5 +50,5 @@
 !FC
     USE ioipsl_getin_p_mod, ONLY : getin_p
-
+    USE lmdz_blowing_snow_ini, ONLY : zeta_bs, pbst_bs, prt_bs, iflag_saltation_bs
 
 #ifdef CPP_INLANDSIS
@@ -72,11 +74,12 @@
     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
@@ -118,4 +121,5 @@
 !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      
@@ -179,5 +183,12 @@
 
     REAL,DIMENSION(klon) :: alb1,alb2
+    REAL,DIMENSION(klon) :: precip_totsnow, evap_totsnow
     REAL, DIMENSION (klon,6) :: alb6
+    REAL                   :: rho0, rhoice, ustart0,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, hsalt, snowini
+    REAL                   :: maxerosion ! in kg/s
+
 ! End definition
 !****************************************************************************************
@@ -214,15 +225,13 @@
            PRINT*, 'alb_nir_sno_lic',alb_nir_sno_lic
   
-!  z0m=1.e-3
-!  z0h = z0m
   firstcall=.false.
   ENDIF
 !******************************************************************************************
-!
+
 ! Initialize output variables
     alb3(:) = 999999.
     alb2(:) = 999999.
     alb1(:) = 999999.
-    
+    fluxbs(:)=0.  
     runoff(:) = 0.
 !****************************************************************************************
@@ -232,4 +241,6 @@
     radsol(:) = 0.0
     radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
+
+!****************************************************************************************
 
 !****************************************************************************************
@@ -327,5 +338,4 @@
 
 
-
     ELSE 
 
@@ -342,6 +352,5 @@
     IF (soil_model) THEN 
        CALL soil(dtime, is_lic, knon, snow, tsurf, qsol, &
-    & longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil, soilcap, soilflux)
-
+        & longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil, soilcap, soilflux)
        cal(1:knon) = RCPD / soilcap(1:knon)
        radsol(1:knon)  = radsol(1:knon) + soilflux(1:knon)
@@ -406,11 +415,142 @@
          flux_u1, flux_v1)
 
-!****************************************************************************************
-! Calculate snow height, age, run-off,..
+
+!****************************************************************************************
+! Calculate albedo
+!
+!****************************************************************************************
+ 
+    CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))  
+
+
+! 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"
+!       alb1(1 : knon)  = 0.6 !IM cf FH/GK 
+!       alb1(1 : knon)  = 0.82
+!       alb1(1 : knon)  = 0.77 !211003 Ksta0.77
+!       alb1(1 : knon)  = 0.8 !KstaTER0.8 & LMD_ARMIP5
+!IM: KstaTER0.77 & LMD_ARMIP6    
+
+! Attantion: alb1 and alb2 are not the same!
+    alb1(1:knon)  = alb_vis_sno_lic
+    alb2(1:knon)  = alb_nir_sno_lic
+
+
+!****************************************************************************************
+! Rugosity
+!
+!****************************************************************************************
+    z0m = z0m_landice
+    z0h = z0h_landice
+    !z0m = SQRT(z0m**2+rugoro**2)
+
+
+
+  ! Simple blowing snow param
+  if (ok_bs) then
+       ustart0 = 0.211
+       rhoice = 920.0
+       rho0 = 300.0
+       rhomax=450.0
+       rhohard=450.0
+       tau_dens0=86400.0*10.  ! 10 days by default, in s
+       tau_densmin=21600.0    ! 1/4 days according to in situ obs by C. Amory during blowing snow +
+                              ! Marshall et al. 1999 (snow densification during rain)
+
+       ! computation of threshold friction velocity
+       ! which depends on surface snow density
+       do j = 1, knon
+           ! estimation of snow density
+           ! snow density increases with snow age and
+           ! increases even faster in case of sedimentation of blowing snow or rain
+           tau_dens=max(tau_densmin, tau_dens0*exp(-abs(precip_bs(j))/pbst_bs &
+                   -abs(precip_rain(j))/prt_bs) *exp(-max(tsurf(j)-272.0,0.)))
+           rhos(j)=rho0+(rhohard-rho0)*(1.-exp(-agesno(j)*86400.0/tau_dens))
+           ! blowing snow flux formula used in MAR
+           ws1(j)=(u1(j)**2+v1(j)**2)**0.5
+           ustar(j)=(cdragm(j)*(u1(j)**2+v1(j)**2))**0.5
+           ustart(j)=ustart0*exp(max(rhoice/rho0-rhoice/rhos(j),0.))*exp(max(0.,rhos(j)-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 j =1, knon
+               rhod=p1lay(j)/RD/temp_air(j)
+               nunu=max(ustar(j)/ustart(j),1.e-3)
+               fluxsalt=rhod/RG*(ustar(j)**3)*(1.-nunu**(-2)) * &
+                        (aa+bb*nunu**(-2)+cc*nunu**(-1))  
+               csalt=fluxsalt/(2.8*ustart(j))
+               hsalt(j)=0.08436*ustar(j)**1.27
+               qsalt(j)=1./rhod*csalt*lambdasalt*RG/(max(ustar(j)**2,1E-6)) &
+                       * exp(-lambdasalt*RG*hsalt(j)/max(ustar(j)**2,1E-6))
+               qsalt(j)=max(qsalt(j),0.)
+          enddo
+
+
+       else
+       ! default formulation from MAR model (Amory et al. 2021, Gallee et al. 2001)        
+          do j=1, knon
+              esalt=1./(3.25*max(ustar(j),0.001))
+              hsalt(j)=0.08436*ustar(j)**1.27
+              qsalt(j)=(max(ustar(j)**2-ustart(j)**2,0.))/(RG*hsalt(j))*esalt
+              !ep=qsalt*cdragm(j)*sqrt(u1(j)**2+v1(j)**2)
+          enddo
+       endif
+
+        ! calculation of erosion (flux positive towards the surface here) 
+        ! consistent with implicit resolution of turbulent mixing equation
+       do j=1, knon
+              i = knindex(j)
+              rhod=p1lay(j)/RD/temp_air(j)
+              ! Nemoto and Nishimura 2004 show that steady-state saltation is achieved within an interval of about 10s
+              ! we thus prevent snowerosion (snow particle transfer from the saltation layer to the first model level)
+              ! to exceed (in intensity) integrated over 10s to exceed the total mass of snow particle in the saltation layer
+              ! (rho*qsalt*hsalt)
+              maxerosion=hsalt(j)*qsalt(j)*rhod/10.
+              fluxbs(j)=rhod*ws1(j)*cdragm(j)*(AcoefQBS(j)-qsalt(j)) &
+                       / (1.-rhod*ws1(j)*cdragm(j)*BcoefQBS(j)*dtime)
+              !fluxbs(j)= rhod*ws1(j)*cdragm(j)*(qbs1(j)-qsalt(j))
+              fluxbs(j)=max(-maxerosion,fluxbs(j))
+
+              ! for outputs
+
+              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_snow, &
-         snow, qsol, tsurf_new, evap &
+         tsurf, precip_rain, precip_totsnow, &
+         snow, qsol, tsurf_new, evap_totsnow &
 #ifdef ISO    
      & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
@@ -446,35 +586,6 @@
 
 
-!****************************************************************************************
-! Calculate albedo
-!
-!****************************************************************************************
-    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))
-!
-!IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux"
-!       alb1(1 : knon)  = 0.6 !IM cf FH/GK 
-!       alb1(1 : knon)  = 0.82
-!       alb1(1 : knon)  = 0.77 !211003 Ksta0.77
-!       alb1(1 : knon)  = 0.8 !KstaTER0.8 & LMD_ARMIP5
-!IM: KstaTER0.77 & LMD_ARMIP6    
-
-! Attantion: alb1 and alb2 are not the same!
-    alb1(1:knon)  = alb_vis_sno_lic
-    alb2(1:knon)  = alb_nir_sno_lic
-
-
-!****************************************************************************************
-! Rugosity
-!
-!****************************************************************************************
-    z0m=1.e-3
-    z0h = z0m
-    z0m = SQRT(z0m**2+rugoro**2)
-
+    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)))  
 
 
@@ -494,5 +605,5 @@
           run_off_lic_frac(j) = pctsrf(i,is_lic)
        ENDDO
-       
+
        CALL cpl_send_landice_fields(itime, knon, knindex, run_off_lic, run_off_lic_frac)
     ENDIF
@@ -501,16 +612,4 @@
     runoff(1:knon)=run_off_lic(1:knon)/dtime
 
-  
-!****************************************************************************************
-! Etienne: comment these lines because of duplication just below
-!       snow_o=0.
-!       zfra_o = 0.
-!       DO j = 1, knon
-!           i = knindex(j)
-!           snow_o(i) = snow(j) 
-!           zfra_o(i) = zfra(j)
-!       ENDDO
-!
-!****************************************************************************************
        snow_o=0.
        zfra_o = 0.
@@ -553,6 +652,4 @@
 !albedo SB <<<
 
-  
-  
 
   END SUBROUTINE surf_landice
Index: /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/surf_ocean_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/surf_ocean_mod.F90	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/surf_ocean_mod.F90	(revision 4727)
@@ -13,5 +13,5 @@
        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, &
@@ -72,5 +72,5 @@
     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
@@ -169,4 +169,5 @@
     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)
@@ -200,4 +201,14 @@
     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
+
     !******************************************************************************
     ! Cdragq computed from cdrag
@@ -227,5 +238,5 @@
             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, &
@@ -239,5 +250,5 @@
        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, &
@@ -250,5 +261,5 @@
        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, &
@@ -370,5 +381,5 @@
        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), &
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_alim.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_alim.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_alim.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_alp.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_alp.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_alp.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_closure.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_closure.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_closure.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_down.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_down.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_down.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_dq.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_dq.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_dq.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_dry.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_dry.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_dry.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_dtke.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_dtke.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_dtke.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_dv2.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_dv2.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_dv2.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_env.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_env.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_env.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_flux2.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_flux2.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_flux2.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_height.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_height.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_height.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_ini_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_ini_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_ini_mod.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_main.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_main.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_main.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_old.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_old.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_old.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_plume.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_plume.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_plume.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_plume_6A.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_plume_6A.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_plume_6A.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_qsat.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/thermcell_qsat.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/thermcell_qsat.F90
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/wake.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/wake.F90	(revision 4726)
+++ 	(revision )
@@ -1,2623 +1,0 @@
-
-! $Id: wake.F90 3648 2020-03-16 15:36:59Z jghattas $
-
-SUBROUTINE wake(znatsurf, p, ph, pi, dtime, &
-                te0, qe0, omgb, &
-                dtdwn, dqdwn, amdwn, amup, dta, dqa, wgen, &
-                sigd_con, Cin, &
-                deltatw, deltaqw, sigmaw, awdens, wdens, &                  ! state variables
-                dth, hw, wape, fip, gfl, &
-                dtls, dqls, ktopw, omgbdth, dp_omgb, tu, qu, &
-                dtke, dqke, omg, dp_deltomg, spread, cstar, &
-                d_deltat_gw, &
-                d_deltatw2, d_deltaqw2, d_sigmaw2, d_awdens2, d_wdens2 &     ! tendencies
-
-#ifdef ISO
-                     ,xte0,dxtdwn,dxta,deltaxtw &
-                     ,dxtls,xtu,dxtke,d_deltaxtw2 &
-#endif                  
-                )  
-
-
-  ! **************************************************************
-  ! *
-  ! WAKE                                                        *
-  ! retour a un Pupper fixe                                *
-  ! *
-  ! written by   :  GRANDPEIX Jean-Yves   09/03/2000            *
-  ! modified by :   ROEHRIG Romain        01/29/2007            *
-  ! **************************************************************
-
-  USE ioipsl_getin_p_mod, ONLY : getin_p
-  USE dimphy
-  use mod_phys_lmdz_para
-  USE print_control_mod, ONLY: prt_level
-#ifdef ISO
-  USE infotrac_phy, ONLY : ntraciso=>ntiso
-#ifdef ISOVERIF
-  USE isotopes_verif_mod
-!, ONLY: errmax,errmaxrel
-  USE isotopes_mod, ONLY: iso_eau,iso_hdo
-#endif
-#endif
-  IMPLICIT NONE
-  ! ============================================================================
-
-
-  ! But : Decrire le comportement des poches froides apparaissant dans les
-  ! grands systemes convectifs, et fournir l'energie disponible pour
-  ! le declenchement de nouvelles colonnes convectives.
-
-  ! State variables : 
-  ! deltatw    : temperature difference between wake and off-wake regions
-  ! deltaqw    : specific humidity difference between wake and off-wake regions
-  ! sigmaw     : fractional area covered by wakes.
-  ! wdens      : number of wakes per unit area
-
-  ! Variable de sortie :
-
-  ! wape : WAke Potential Energy
-  ! fip  : Front Incident Power (W/m2) - ALP
-  ! gfl  : Gust Front Length per unit area (m-1)
-  ! dtls : large scale temperature tendency due to wake
-  ! dqls : large scale humidity tendency due to wake
-  ! hw   : wake top hight (given by hw*deltatw(1)/2=wape)
-  ! dp_omgb : vertical gradient of large scale omega
-  ! awdens  : densite de poches actives
-  ! wdens   : densite de poches
-  ! omgbdth: flux of Delta_Theta transported by LS omega
-  ! dtKE   : differential heating (wake - unpertubed)
-  ! dqKE   : differential moistening (wake - unpertubed)
-  ! omg    : Delta_omg =vertical velocity diff. wake-undist. (Pa/s)
-  ! dp_deltomg  : vertical gradient of omg (s-1)
-  ! spread  : spreading term in d_t_wake and d_q_wake
-  ! deltatw     : updated temperature difference (T_w-T_u).
-  ! deltaqw     : updated humidity difference (q_w-q_u).
-  ! sigmaw      : updated wake fractional area.
-  ! d_deltat_gw : delta T tendency due to GW
-
-  ! Variables d'entree :
-
-  ! aire : aire de la maille
-  ! te0  : temperature dans l'environnement  (K)
-  ! qe0  : humidite dans l'environnement     (kg/kg)
-  ! omgb : vitesse verticale moyenne sur la maille (Pa/s)
-  ! dtdwn: source de chaleur due aux descentes (K/s)
-  ! dqdwn: source d'humidite due aux descentes (kg/kg/s)
-  ! dta  : source de chaleur due courants satures et detrain  (K/s)
-  ! dqa  : source d'humidite due aux courants satures et detra (kg/kg/s)
-  ! wgen : number of wakes generated per unit area and per sec (/m^2/s)
-  ! amdwn: flux de masse total des descentes, par unite de
-  !        surface de la maille (kg/m2/s)
-  ! amup : flux de masse total des ascendances, par unite de
-  !        surface de la maille (kg/m2/s)
-  ! sigd_con: 
-  ! Cin  : convective inhibition
-  ! p    : pressions aux milieux des couches (Pa)
-  ! ph   : pressions aux interfaces (Pa)
-  ! pi  : (p/p_0)**kapa (adim)
-  ! dtime: increment temporel (s)
-
-  ! Variables internes :
-
-  ! rhow : masse volumique de la poche froide
-  ! rho  : environment density at P levels
-  ! rhoh : environment density at Ph levels
-  ! te   : environment temperature | may change within
-  ! qe   : environment humidity    | sub-time-stepping
-  ! the  : environment potential temperature
-  ! thu  : potential temperature in undisturbed area
-  ! tu   :  temperature  in undisturbed area
-  ! qu   : humidity in undisturbed area
-  ! dp_omgb: vertical gradient og LS omega
-  ! omgbw  : wake average vertical omega
-  ! dp_omgbw: vertical gradient of omgbw
-  ! omgbdq : flux of Delta_q transported by LS omega
-  ! dth  : potential temperature diff. wake-undist.
-  ! th1  : first pot. temp. for vertical advection (=thu)
-  ! th2  : second pot. temp. for vertical advection (=thw)
-  ! q1   : first humidity for vertical advection
-  ! q2   : second humidity for vertical advection
-  ! d_deltatw   : terme de redistribution pour deltatw
-  ! d_deltaqw   : terme de redistribution pour deltaqw
-  ! deltatw0   : deltatw initial
-  ! deltaqw0   : deltaqw initial
-  ! hw0    : wake top hight (defined as the altitude at which deltatw=0)
-  ! amflux : horizontal mass flux through wake boundary
-  ! wdens_ref: initial number of wakes per unit area (3D) or per
-  ! unit length (2D), at the beginning of each time step
-  ! Tgw    : 1 sur la période de onde de gravité
-  ! Cgw    : vitesse de propagation de onde de gravité
-  ! LL     : distance entre 2 poches
-
-  ! -------------------------------------------------------------------------
-  ! Déclaration de variables
-  ! -------------------------------------------------------------------------
-
-  include "YOMCST.h"
-  include "cvthermo.h"
-
-  ! Arguments en entree
-  ! --------------------
-
-  INTEGER, DIMENSION (klon),        INTENT(IN)          :: znatsurf
-  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: p, pi
-  REAL, DIMENSION (klon, klev+1),   INTENT(IN)          :: ph
-  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: omgb
-  REAL,                             INTENT(IN)          :: dtime
-  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: te0, qe0
-  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: dtdwn, dqdwn
-  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: amdwn, amup
-  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: dta, dqa
-  REAL, DIMENSION (klon),           INTENT(IN)          :: wgen
-  REAL, DIMENSION (klon),           INTENT(IN)          :: sigd_con
-  REAL, DIMENSION (klon),           INTENT(IN)          :: Cin
-#ifdef ISO
-  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(IN)          :: xte0
-  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(IN)          :: dxtdwn
-  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(IN)          :: dxta
-#endif
-
-  !
-  ! Input/Output
-  ! State variables
-  REAL, DIMENSION (klon, klev),     INTENT(INOUT)       :: deltatw, deltaqw
-  REAL, DIMENSION (klon),           INTENT(INOUT)       :: sigmaw
-  REAL, DIMENSION (klon),           INTENT(INOUT)       :: awdens
-  REAL, DIMENSION (klon),           INTENT(INOUT)       :: wdens
-#ifdef ISO
-  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(INOUT)       :: deltaxtw
-#endif
-
-  ! Sorties
-  ! --------
-
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dth
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: tu, qu
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dtls, dqls
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dtke, dqke
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: spread    !  unused (jyg)
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: omgbdth, omg
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dp_omgb, dp_deltomg
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: d_deltat_gw
-  REAL, DIMENSION (klon),           INTENT(OUT)         :: hw, wape, fip, gfl, cstar
-  INTEGER, DIMENSION (klon),        INTENT(OUT)         :: ktopw
-  ! Tendencies of state variables
-  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: d_deltatw2, d_deltaqw2
-  REAL, DIMENSION (klon),           INTENT(OUT)         :: d_sigmaw2, d_awdens2, d_wdens2
-#ifdef ISO
-  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(OUT)         :: xtu
-  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(OUT)         :: dxtls
-  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(OUT)         :: dxtke
-  REAL, DIMENSION (ntraciso,klon, klev),     INTENT(OUT)         :: d_deltaxtw2
-#endif
-
-  ! Variables internes
-  ! -------------------
-
-  ! Variables à fixer
-  INTEGER, SAVE                                         :: igout
-  !$OMP THREADPRIVATE(igout)
-  LOGICAL, SAVE                                         :: first = .TRUE.
-  !$OMP THREADPRIVATE(first)
-!jyg<
-!!  REAL, SAVE                                            :: stark, wdens_ref, coefgw, alpk
-  REAL, SAVE, DIMENSION(2)                              :: wdens_ref
-  REAL, SAVE                                            :: stark, coefgw, alpk
-!>jyg
-  REAL, SAVE                                            :: crep_upper, crep_sol  
-  !$OMP THREADPRIVATE(stark, wdens_ref, coefgw, alpk, crep_upper, crep_sol)
-
-  REAL, SAVE                                            :: tau_cv
-  !$OMP THREADPRIVATE(tau_cv)
-  REAL, SAVE                                            :: rzero, aa0 ! minimal wake radius and area
-  !$OMP THREADPRIVATE(rzero, aa0)
-
-  LOGICAL, SAVE                                         :: flag_wk_check_trgl
-  !$OMP THREADPRIVATE(flag_wk_check_trgl)
-  INTEGER, SAVE                                         :: iflag_wk_check_trgl
-  !$OMP THREADPRIVATE(iflag_wk_check_trgl)
-  INTEGER, SAVE                                         :: iflag_wk_pop_dyn
-  !$OMP THREADPRIVATE(iflag_wk_pop_dyn)
-
-  REAL                                                  :: delta_t_min
-  INTEGER                                               :: nsub
-  REAL                                                  :: dtimesub
-  REAL, SAVE                                            :: wdensmin
-  !$OMP THREADPRIVATE(wdensmin)
-  REAL, SAVE                                            :: sigmad, hwmin, wapecut, cstart
-  !$OMP THREADPRIVATE(sigmad, hwmin, wapecut, cstart)
-  REAL, SAVE                                            :: sigmaw_max
-  !$OMP THREADPRIVATE(sigmaw_max)  
-  REAL, SAVE                                            :: dens_rate
-  !$OMP THREADPRIVATE(dens_rate)
-  REAL                                                  :: wdens0
-  ! IM 080208
-  LOGICAL, DIMENSION (klon)                             :: gwake
-
-  ! Variables de sauvegarde
-  REAL, DIMENSION (klon, klev)                          :: deltatw0
-  REAL, DIMENSION (klon, klev)                          :: deltaqw0
-  REAL, DIMENSION (klon, klev)                          :: te, qe
-!!  REAL, DIMENSION (klon)                                :: sigmaw1
-#ifdef ISO
-  REAL, DIMENSION (ntraciso,klon, klev)                          :: deltaxtw0
-  REAL, DIMENSION (ntraciso,klon, klev)                          :: xte
-#endif
-
-  ! Variables liees a la dynamique de population
-  REAL, DIMENSION(klon)                                 :: act
-  REAL, DIMENSION(klon)                                 :: rad_wk, tau_wk_inv
-  REAL, DIMENSION(klon)                                 :: f_shear
-  REAL, DIMENSION(klon)                                 :: drdt
-  REAL, DIMENSION(klon)                                 :: d_sig_gen, d_sig_death, d_sig_col
-  REAL, DIMENSION(klon)                                 :: wape1_act, wape2_act
-  LOGICAL, DIMENSION (klon)                             :: kill_wake
-  INTEGER, SAVE                                         :: iflag_wk_act
-  !$OMP THREADPRIVATE(iflag_wk_act)
-  REAL                                                  :: drdt_pos
-  REAL                                                  :: tau_wk_inv_min
-
-  ! Variables pour les GW
-  REAL, DIMENSION (klon)                                :: ll
-  REAL, DIMENSION (klon, klev)                          :: n2
-  REAL, DIMENSION (klon, klev)                          :: cgw
-  REAL, DIMENSION (klon, klev)                          :: tgw
-
-  ! Variables liees au calcul de hw
-  REAL, DIMENSION (klon)                                :: ptop_provis, ptop, ptop_new
-  REAL, DIMENSION (klon)                                :: sum_dth
-  REAL, DIMENSION (klon)                                :: dthmin
-  REAL, DIMENSION (klon)                                :: z, dz, hw0
-  INTEGER, DIMENSION (klon)                             :: ktop, kupper
-
-  ! Variables liees au test de la forme triangulaire du profil de Delta_theta
-  REAL, DIMENSION (klon)                                :: sum_half_dth
-  REAL, DIMENSION (klon)                                :: dz_half
-
-  ! Sub-timestep tendencies and related variables
-  REAL, DIMENSION (klon, klev)                          :: d_deltatw, d_deltaqw
-  REAL, DIMENSION (klon, klev)                          :: d_te, d_qe
-  REAL, DIMENSION (klon)                                :: d_awdens, d_wdens
-  REAL, DIMENSION (klon)                                :: d_sigmaw, alpha
-  REAL, DIMENSION (klon)                                :: q0_min, q1_min
-  LOGICAL, DIMENSION (klon)                             :: wk_adv, ok_qx_qw
-#ifdef ISO
-  REAL, DIMENSION (ntraciso,klon, klev)                          :: d_deltaxtw
-  REAL, DIMENSION (ntraciso,klon, klev)                          :: d_xte
-#endif
-  REAL, SAVE                                            :: epsilon
-  !$OMP THREADPRIVATE(epsilon)
-  DATA epsilon/1.E-15/
-
-  ! Autres variables internes
-  INTEGER                                               ::isubstep, k, i
-
-  REAL                                                  :: wdens_targ
-  REAL                                                  :: sigmaw_targ
-
-  REAL, DIMENSION (klon)                                :: sum_thu, sum_tu, sum_qu, sum_thvu
-  REAL, DIMENSION (klon)                                :: sum_dq, sum_rho
-  REAL, DIMENSION (klon)                                :: sum_dtdwn, sum_dqdwn
-  REAL, DIMENSION (klon)                                :: av_thu, av_tu, av_qu, av_thvu
-  REAL, DIMENSION (klon)                                :: av_dth, av_dq, av_rho
-  REAL, DIMENSION (klon)                                :: av_dtdwn, av_dqdwn
-! pas besoin d'isos ici
-
-  REAL, DIMENSION (klon, klev)                          :: rho, rhow
-  REAL, DIMENSION (klon, klev+1)                        :: rhoh
-  REAL, DIMENSION (klon, klev)                          :: rhow_moyen
-  REAL, DIMENSION (klon, klev)                          :: zh
-  REAL, DIMENSION (klon, klev+1)                        :: zhh
-  REAL, DIMENSION (klon, klev)                          :: epaisseur1, epaisseur2
-
-  REAL, DIMENSION (klon, klev)                          :: the, thu
-
-  REAL, DIMENSION (klon, klev)                          :: omgbw
-  REAL, DIMENSION (klon)                                :: pupper
-  REAL, DIMENSION (klon)                                :: omgtop
-  REAL, DIMENSION (klon, klev)                          :: dp_omgbw
-  REAL, DIMENSION (klon)                                :: ztop, dztop
-  REAL, DIMENSION (klon, klev)                          :: alpha_up
-
-  REAL, DIMENSION (klon)                                :: rre1, rre2
-  REAL                                                  :: rrd1, rrd2
-  REAL, DIMENSION (klon, klev)                          :: th1, th2, q1, q2
-  REAL, DIMENSION (klon, klev)                          :: d_th1, d_th2, d_dth
-  REAL, DIMENSION (klon, klev)                          :: d_q1, d_q2, d_dq
-  REAL, DIMENSION (klon, klev)                          :: omgbdq
-#ifdef ISO
-      REAL, DIMENSION(ntraciso,klon,klev) :: xt1, xt2
-      REAL, DIMENSION(ntraciso,klon,klev) :: D_xt1, D_xt2, D_dxt
-      REAL, DIMENSION(ntraciso,klon,klev) :: omgbdxt
-      integer ixt
-#endif
-
-  REAL, DIMENSION (klon)                                :: ff, gg
-  REAL, DIMENSION (klon)                                :: wape2, cstar2, heff
-                                                        
-  REAL, DIMENSION (klon, klev)                          :: crep
-                                                        
-  REAL, DIMENSION (klon, klev)                          :: ppi
-
-  ! cc nrlmd
-  REAL, DIMENSION (klon)                                :: death_rate
-!!  REAL, DIMENSION (klon)                                :: nat_rate
-  REAL, DIMENSION (klon, klev)                          :: entr
-  REAL, DIMENSION (klon, klev)                          :: detr
-
-  REAL, DIMENSION(klon)                                 :: sigmaw_in             ! pour les prints
-  REAL, DIMENSION(klon)                                 :: awdens_in, wdens_in   ! pour les prints
-
-  ! -------------------------------------------------------------------------
-  ! Initialisations
-  ! -------------------------------------------------------------------------
-
-  ! print*, 'wake initialisations'
-!#ifdef ISOVERIF
-!        write(*,*) 'wake 358: entree'
-!#endif
-
-  ! Essais d'initialisation avec sigmaw = 0.02 et hw = 10.
-  ! -------------------------------------------------------------------------
-
-!!  DATA wapecut, sigmad, hwmin/5., .02, 10./
-!!  DATA wapecut, sigmad, hwmin/1., .02, 10./
-  DATA sigmad, hwmin/.02, 10./
-!!  DATA wdensmin/1.e-12/
-  DATA wdensmin/1.e-14/
-  ! cc nrlmd
-  DATA sigmaw_max/0.4/
-  DATA dens_rate/0.1/
-  ! cc
-  ! Longueur de maille (en m)
-  ! -------------------------------------------------------------------------
-
-  ! ALON = 3.e5
-  ! alon = 1.E6
-
-  !  Provisionnal; to be suppressed when f_shear is parameterized
-  f_shear(:) = 1.       ! 0. for strong shear, 1. for weak shear
-
-
-  ! Configuration de coefgw,stark,wdens (22/02/06 by YU Jingmei)
-
-  ! coefgw : Coefficient pour les ondes de gravité
-  ! stark : Coefficient k dans Cstar=k*sqrt(2*WAPE)
-  ! wdens : Densité surfacique de poche froide
-  ! -------------------------------------------------------------------------
-
-  ! cc nrlmd      coefgw=10
-  ! coefgw=1
-  ! wdens0 = 1.0/(alon**2)
-  ! cc nrlmd      wdens = 1.0/(alon**2)
-  ! cc nrlmd      stark = 0.50
-  ! CRtest
-  ! cc nrlmd      alpk=0.1
-  ! alpk = 1.0
-  ! alpk = 0.5
-  ! alpk = 0.05
-
- if (first) then
-
-  igout = klon/2+1/klon
-
-  crep_upper = 0.9
-  crep_sol = 1.0
-
-  ! Get wapecut from parameter file
-  wapecut = 1.
-  CALL getin_p('wapecut', wapecut)
-
-  ! cc nrlmd Lecture du fichier wake_param.data
-  stark=0.33
-  CALL getin_p('stark',stark)
-  cstart = stark*sqrt(2.*wapecut)
-
-  alpk=0.25
-  CALL getin_p('alpk',alpk)
-!jyg<
-!!  wdens_ref=8.E-12
-!!  CALL getin_p('wdens_ref',wdens_ref)
-  wdens_ref(1)=8.E-12
-  wdens_ref(2)=8.E-12
-  CALL getin_p('wdens_ref_o',wdens_ref(1))    !wake number per unit area ; ocean
-  CALL getin_p('wdens_ref_l',wdens_ref(2))    !wake number per unit area ; land
-!>jyg
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!  Population dynamics parameters    !!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!------------------------------------------------------------------------ 
-
-  iflag_wk_pop_dyn = 0
-  CALL getin_p('iflag_wk_pop_dyn',iflag_wk_pop_dyn) ! switch between wdens prescribed 
-                                                    ! and wdens prognostic
-  iflag_wk_act = 0
-  CALL getin_p('iflag_wk_act',iflag_wk_act) ! 0: act(:)=0.
-                                            ! 1: act(:)=1.
-                                            ! 2: act(:)=f(Wape)
-
-  rzero = 5000.
-  CALL getin_p('rzero_wk', rzero)
-  aa0 = 3.14*rzero*rzero
-!
-  tau_cv = 4000.
-  CALL getin_p('tau_cv', tau_cv)
-
-!------------------------------------------------------------------------ 
-
-  coefgw=4.
-  CALL getin_p('coefgw',coefgw)
-
-  WRITE(*,*) 'stark=', stark
-  WRITE(*,*) 'alpk=', alpk
-!jyg<
-!!  WRITE(*,*) 'wdens_ref=', wdens_ref
-  WRITE(*,*) 'wdens_ref_o=', wdens_ref(1)
-  WRITE(*,*) 'wdens_ref_l=', wdens_ref(2)
-!>jyg
-  WRITE(*,*) 'iflag_wk_pop_dyn=',iflag_wk_pop_dyn
-  WRITE(*,*) 'iflag_wk_act',iflag_wk_act
-  WRITE(*,*) 'coefgw=', coefgw 
-
-  flag_wk_check_trgl=.false.
-  CALL getin_p('flag_wk_check_trgl ', flag_wk_check_trgl)
-  WRITE(*,*) 'flag_wk_check_trgl=', flag_wk_check_trgl
-  WRITE(*,*) 'flag_wk_check_trgl OBSOLETE. Utilisr iflag_wk_check_trgl plutot'
-  iflag_wk_check_trgl=0 ; IF (flag_wk_check_trgl) iflag_wk_check_trgl=1
-  CALL getin_p('iflag_wk_check_trgl ', iflag_wk_check_trgl)
-  WRITE(*,*) 'iflag_wk_check_trgl=', iflag_wk_check_trgl
-
-  first=.false.
- endif
-
- IF (iflag_wk_pop_dyn == 0) THEN
-  ! Initialisation de toutes des densites a wdens_ref.
-  ! Les densites peuvent evoluer si les poches debordent
-  ! (voir au tout debut de la boucle sur les substeps)
-  !jyg<
-  !!  wdens(:) = wdens_ref
-   DO i = 1,klon
-     wdens(i) = wdens_ref(znatsurf(i)+1)
-   ENDDO 
-  !>jyg
- ENDIF  ! (iflag_wk_pop_dyn == 0)
-
-  ! print*,'stark',stark
-  ! print*,'alpk',alpk
-  ! print*,'wdens',wdens
-  ! print*,'coefgw',coefgw
-  ! cc
-  ! Minimum value for |T_wake - T_undist|. Used for wake top definition
-  ! -------------------------------------------------------------------------
-
-  delta_t_min = 0.2
-
-  ! 1. - Save initial values, initialize tendencies, initialize output fields
-  ! ------------------------------------------------------------------------
-
-!jyg<
-!!  DO k = 1, klev
-!!    DO i = 1, klon
-!!      ppi(i, k) = pi(i, k)
-!!      deltatw0(i, k) = deltatw(i, k)
-!!      deltaqw0(i, k) = deltaqw(i, k)
-!!      te(i, k) = te0(i, k)
-!!      qe(i, k) = qe0(i, k)
-!!      dtls(i, k) = 0.
-!!      dqls(i, k) = 0.
-!!      d_deltat_gw(i, k) = 0.
-!!      d_te(i, k) = 0.
-!!      d_qe(i, k) = 0.
-!!      d_deltatw(i, k) = 0.
-!!      d_deltaqw(i, k) = 0.
-!!      ! IM 060508 beg
-!!      d_deltatw2(i, k) = 0.
-!!      d_deltaqw2(i, k) = 0.
-!!      ! IM 060508 end
-!!    END DO
-!!  END DO
-      ppi(:,:) = pi(:,:)
-      deltatw0(:,:) = deltatw(:,:)
-      deltaqw0(:,:) = deltaqw(:,:)
-      te(:,:) = te0(:,:)
-      qe(:,:) = qe0(:,:)
-      dtls(:,:) = 0.
-      dqls(:,:) = 0.
-      d_deltat_gw(:,:) = 0.
-      d_te(:,:) = 0.
-      d_qe(:,:) = 0.
-      d_deltatw(:,:) = 0.
-      d_deltaqw(:,:) = 0.
-      d_deltatw2(:,:) = 0.
-      d_deltaqw2(:,:) = 0. 
-#ifdef ISO
-      deltaxtw0(:,:,:)= deltaxtw(:,:,:)
-      xte(:,:,:) = xte0(:,:,:)
-      dxtls(:,:,:) = 0.
-      d_xte(:,:,:) = 0.
-      d_deltaxtw(:,:,:) = 0. 
-      d_deltaxtw2(:,:,:)=0. 
-      xt1(:,:,:) = 0. 
-      xt2(:,:,:)=0.   
-      ! init non indispensable mais facilite verif iso
-      q1(:,:)=0.0
-      q2(:,:)=0.0
-#endif
-
-      IF (iflag_wk_act == 0) THEN
-        act(:) = 0.
-      ELSEIF (iflag_wk_act == 1) THEN
-        act(:) = 1.
-      ENDIF
-
-!!  DO i = 1, klon
-!!   sigmaw_in(i) = sigmaw(i)
-!!  END DO
-   sigmaw_in(:) = sigmaw(:)
-!>jyg
-
-  ! sigmaw1=sigmaw
-  ! IF (sigd_con.GT.sigmaw1) THEN
-  ! print*, 'sigmaw,sigd_con', sigmaw, sigd_con
-  ! ENDIF
-  IF (iflag_wk_pop_dyn >=1) THEN
-    DO i = 1, klon
-      wdens_targ = max(wdens(i),wdensmin)
-      d_wdens2(i) = wdens_targ - wdens(i)
-      wdens(i) = wdens_targ
-    END DO
-  ELSE
-    DO i = 1, klon
-      d_awdens2(i) = 0.
-      d_wdens2(i) = 0.
-    END DO
-  ENDIF  ! (iflag_wk_pop_dyn >=1)
-!
-  DO i = 1, klon
-    ! c      sigmaw(i) = amax1(sigmaw(i),sigd_con(i))
-!jyg<
-!!    sigmaw(i) = amax1(sigmaw(i), sigmad)
-!!    sigmaw(i) = amin1(sigmaw(i), 0.99)
-    sigmaw_targ = min(max(sigmaw(i), sigmad),0.99)
-    d_sigmaw2(i) = sigmaw_targ - sigmaw(i)
-    sigmaw(i) = sigmaw_targ
-!>jyg
-  END DO
-
-!
-  IF (iflag_wk_pop_dyn >= 1) THEN
-    awdens_in(:) = awdens(:)
-    wdens_in(:) = wdens(:)
-!!    wdens(:) = wdens(:) + wgen(:)*dtime
-!!    d_wdens2(:) = wgen(:)*dtime
-!!  ELSE
-  ENDIF  ! (iflag_wk_pop_dyn >= 1)
-
-  wape(:) = 0.
-  wape2(:) = 0.
-  d_sigmaw(:) = 0.
-  ktopw(:) = 0
-!
-!<jyg
-dth(:,:) = 0.
-tu(:,:) = 0.
-qu(:,:) = 0.
-dtke(:,:) = 0.
-dqke(:,:) = 0.
-spread(:,:) = 0.
-omgbdth(:,:) = 0.
-omg(:,:) = 0.
-dp_omgb(:,:) = 0.
-dp_deltomg(:,:) = 0.
-hw(:) = 0.
-wape(:) = 0.
-fip(:) = 0.
-gfl(:) = 0.
-cstar(:) = 0.
-ktopw(:) = 0
-!
-!  Vertical advection local variables
-omgbw(:,:) = 0.
-omgtop(:) = 0
-dp_omgbw(:,:) = 0.
-omgbdq(:,:) = 0.
-#ifdef ISO
-xtu(:,:,:) = 0.
-dxtke(:,:,:) = 0.
-omgbdxt(:,:,:) = 0.
-#endif
-!>jyg
-!
-  IF (prt_level>=10) THEN
-    PRINT *, 'wake-1, sigmaw(igout) ', sigmaw(igout)
-    PRINT *, 'wake-1, deltatw(igout,k) ', (k,deltatw(igout,k), k=1,klev)
-    PRINT *, 'wake-1, deltaqw(igout,k) ', (k,deltaqw(igout,k), k=1,klev)
-    PRINT *, 'wake-1, dowwdraughts, amdwn(igout,k) ', (k,amdwn(igout,k), k=1,klev)
-    PRINT *, 'wake-1, dowwdraughts, dtdwn(igout,k) ', (k,dtdwn(igout,k), k=1,klev)
-    PRINT *, 'wake-1, dowwdraughts, dqdwn(igout,k) ', (k,dqdwn(igout,k), k=1,klev)
-    PRINT *, 'wake-1, updraughts, amup(igout,k) ', (k,amup(igout,k), k=1,klev)
-    PRINT *, 'wake-1, updraughts, dta(igout,k) ', (k,dta(igout,k), k=1,klev)
-    PRINT *, 'wake-1, updraughts, dqa(igout,k) ', (k,dqa(igout,k), k=1,klev)
-  ENDIF
-
-  ! 2. - Prognostic part
-  ! --------------------
-
-
-  ! 2.1 - Undisturbed area and Wake integrals
-  ! ---------------------------------------------------------
-
-  DO i = 1, klon
-    z(i) = 0.
-    ktop(i) = 0
-    kupper(i) = 0
-    sum_thu(i) = 0.
-    sum_tu(i) = 0.
-    sum_qu(i) = 0.
-    sum_thvu(i) = 0.
-    sum_dth(i) = 0.
-    sum_dq(i) = 0.
-    sum_rho(i) = 0.
-    sum_dtdwn(i) = 0.
-    sum_dqdwn(i) = 0.
-
-    av_thu(i) = 0.
-    av_tu(i) = 0.
-    av_qu(i) = 0.
-    av_thvu(i) = 0.
-    av_dth(i) = 0.
-    av_dq(i) = 0.
-    av_rho(i) = 0.
-    av_dtdwn(i) = 0.
-    av_dqdwn(i) = 0.
-    ! pas besoin d'isos ici
-  END DO
-
-
-#ifdef ISOVERIF
-      ! TODO      
-#endif 
-
-  ! Distance between wakes
-  DO i = 1, klon
-    ll(i) = (1-sqrt(sigmaw(i)))/sqrt(wdens(i))
-  END DO
-  ! Potential temperatures and humidity
-  ! ----------------------------------------------------------
-  DO k = 1, klev
-    DO i = 1, klon
-      ! write(*,*)'wake 1',i,k,rd,te(i,k)
-      rho(i, k) = p(i, k)/(rd*te(i,k))
-      ! write(*,*)'wake 2',rho(i,k)
-      IF (k==1) THEN
-        ! write(*,*)'wake 3',i,k,rd,te(i,k)
-        rhoh(i, k) = ph(i, k)/(rd*te(i,k))
-        ! write(*,*)'wake 4',i,k,rd,te(i,k)
-        zhh(i, k) = 0
-      ELSE
-        ! write(*,*)'wake 5',rd,(te(i,k)+te(i,k-1))
-        rhoh(i, k) = ph(i, k)*2./(rd*(te(i,k)+te(i,k-1)))
-        ! write(*,*)'wake 6',(-rhoh(i,k)*RG)+zhh(i,k-1)
-        zhh(i, k) = (ph(i,k)-ph(i,k-1))/(-rhoh(i,k)*rg) + zhh(i, k-1)
-      END IF
-      ! write(*,*)'wake 7',ppi(i,k)
-      the(i, k) = te(i, k)/ppi(i, k)
-      thu(i, k) = (te(i,k)-deltatw(i,k)*sigmaw(i))/ppi(i, k)
-      tu(i, k) = te(i, k) - deltatw(i, k)*sigmaw(i)
-      qu(i, k) = qe(i, k) - deltaqw(i, k)*sigmaw(i)
-      ! write(*,*)'wake 8',(rd*(te(i,k)+deltatw(i,k)))
-      rhow(i, k) = p(i, k)/(rd*(te(i,k)+deltatw(i,k)))
-      dth(i, k) = deltatw(i, k)/ppi(i, k)
-#ifdef ISO
-        do ixt=1,ntraciso
-          xtu(ixt,i,k)  =  xte(ixt,i,k) - deltaxtw(ixt,i,k)*sigmaw(i)
-        enddo !do ixt=1,ntraciso
-#endif
-    END DO
-  END DO
-
-
-#ifdef ISO
-#ifdef ISOVERIF
-        ! TODO   
-#endif
-#endif
-
-  DO k = 1, klev - 1
-    DO i = 1, klon
-      IF (k==1) THEN
-        n2(i, k) = 0
-      ELSE
-        n2(i, k) = amax1(0., -rg**2/the(i,k)*rho(i,k)*(the(i,k+1)-the(i,k-1))/ &
-                             (p(i,k+1)-p(i,k-1)))
-      END IF
-      zh(i, k) = (zhh(i,k)+zhh(i,k+1))/2
-
-      cgw(i, k) = sqrt(n2(i,k))*zh(i, k)
-      tgw(i, k) = coefgw*cgw(i, k)/ll(i)
-    END DO
-  END DO
-
-  DO i = 1, klon
-    n2(i, klev) = 0
-    zh(i, klev) = 0
-    cgw(i, klev) = 0
-    tgw(i, klev) = 0
-  END DO
-
-  ! Calcul de la masse volumique moyenne de la colonne   (bdlmd)
-  ! -----------------------------------------------------------------
-
-  DO k = 1, klev
-    DO i = 1, klon
-      epaisseur1(i, k) = 0.
-      epaisseur2(i, k) = 0.
-    END DO
-  END DO
-
-  DO i = 1, klon
-    epaisseur1(i, 1) = -(ph(i,2)-ph(i,1))/(rho(i,1)*rg) + 1.
-    epaisseur2(i, 1) = -(ph(i,2)-ph(i,1))/(rho(i,1)*rg) + 1.
-    rhow_moyen(i, 1) = rhow(i, 1)
-  END DO
-
-  DO k = 2, klev
-    DO i = 1, klon
-      epaisseur1(i, k) = -(ph(i,k+1)-ph(i,k))/(rho(i,k)*rg) + 1.
-      epaisseur2(i, k) = epaisseur2(i, k-1) + epaisseur1(i, k)
-      rhow_moyen(i, k) = (rhow_moyen(i,k-1)*epaisseur2(i,k-1)+rhow(i,k)* &
-        epaisseur1(i,k))/epaisseur2(i, k)
-    END DO
-  END DO
-
-
-  ! Choose an integration bound well above wake top
-  ! -----------------------------------------------------------------
-
-  ! Pupper = 50000.  ! melting level
-  ! Pupper = 60000.
-  ! Pupper = 80000.  ! essais pour case_e
-  DO i = 1, klon
-    pupper(i) = 0.6*ph(i, 1)
-    pupper(i) = max(pupper(i), 45000.)
-    ! cc        Pupper(i) = 60000.
-  END DO
-
-
-  ! Determine Wake top pressure (Ptop) from buoyancy integral
-  ! --------------------------------------------------------
-
-  ! -1/ Pressure of the level where dth becomes less than delta_t_min.
-
-  DO i = 1, klon
-    ptop_provis(i) = ph(i, 1)
-  END DO
-  DO k = 2, klev
-    DO i = 1, klon
-
-      ! IM v3JYG; ptop_provis(i).LT. ph(i,1)
-
-      IF (dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min .AND. &
-          ptop_provis(i)==ph(i,1)) THEN
-        ptop_provis(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)- &
-                          (dth(i,k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
-      END IF
-    END DO
-  END DO
-
-  ! -2/ dth integral
-
-  DO i = 1, klon
-    sum_dth(i) = 0.
-    dthmin(i) = -delta_t_min
-    z(i) = 0.
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      dz(i) = -(amax1(ph(i,k+1),ptop_provis(i))-ph(i,k))/(rho(i,k)*rg)
-      IF (dz(i)>0) THEN
-        z(i) = z(i) + dz(i)
-        sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
-        dthmin(i) = amin1(dthmin(i), dth(i,k))
-      END IF
-    END DO
-  END DO
-
-  ! -3/ height of triangle with area= sum_dth and base = dthmin
-
-  DO i = 1, klon
-    hw0(i) = 2.*sum_dth(i)/amin1(dthmin(i), -0.5)
-    hw0(i) = amax1(hwmin, hw0(i))
-  END DO
-
-  ! -4/ now, get Ptop
-
-  DO i = 1, klon
-    z(i) = 0.
-    ptop(i) = ph(i, 1)
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      dz(i) = amin1(-(ph(i,k+1)-ph(i,k))/(rho(i,k)*rg), hw0(i)-z(i))
-      IF (dz(i)>0) THEN
-        z(i) = z(i) + dz(i)
-        ptop(i) = ph(i, k) - rho(i, k)*rg*dz(i)
-      END IF
-    END DO
-  END DO
-
-  IF (prt_level>=10) THEN
-    PRINT *, 'wake-2, ptop_provis(igout), ptop(igout) ', ptop_provis(igout), ptop(igout)
-  ENDIF
-
-
-  ! -5/ Determination de ktop et kupper
-
-  DO k = klev, 1, -1
-    DO i = 1, klon
-      IF (ph(i,k+1)<ptop(i)) ktop(i) = k
-      IF (ph(i,k+1)<pupper(i)) kupper(i) = k
-    END DO
-  END DO
-
-  ! On evite kupper = 1 et kupper = klev
-  DO i = 1, klon
-    kupper(i) = max(kupper(i), 2)
-    kupper(i) = min(kupper(i), klev-1)
-  END DO
-
-
-  ! -6/ Correct ktop and ptop
-
-  DO i = 1, klon
-    ptop_new(i) = ptop(i)
-  END DO
-  DO k = klev, 2, -1
-    DO i = 1, klon
-      IF (k<=ktop(i) .AND. ptop_new(i)==ptop(i) .AND. &
-          dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN
-        ptop_new(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)-(dth(i, &
-          k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    ptop(i) = ptop_new(i)
-  END DO
-
-  DO k = klev, 1, -1
-    DO i = 1, klon
-      IF (ph(i,k+1)<ptop(i)) ktop(i) = k
-    END DO
-  END DO
-
-  IF (prt_level>=10) THEN
-    PRINT *, 'wake-3, ktop(igout), kupper(igout) ', ktop(igout), kupper(igout)
-  ENDIF
-
-  ! -5/ Set deltatw & deltaqw to 0 above kupper
-
-  DO k = 1, klev
-    DO i = 1, klon
-      IF (k>=kupper(i)) THEN
-        deltatw(i, k) = 0.
-        deltaqw(i, k) = 0.
-        d_deltatw2(i,k) = -deltatw0(i,k)
-#ifdef ISO
-        do ixt=1,ntraciso
-        deltaxtw(ixt,i, k) = 0.
-        d_deltaxtw2(ixt,i,k) = -deltaxtw0(ixt,i,k)
-        enddo
-#endif
-      END IF
-    END DO
-  END DO
-
-
-  ! Vertical gradient of LS omega
-
-  DO k = 1, klev
-    DO i = 1, klon
-      IF (k<=kupper(i)) THEN
-        dp_omgb(i, k) = (omgb(i,k+1)-omgb(i,k))/(ph(i,k+1)-ph(i,k))
-      END IF
-    END DO
-  END DO
-
-  ! Integrals (and wake top level number)
-  ! --------------------------------------
-
-  ! Initialize sum_thvu to 1st level virt. pot. temp.
-
-  DO i = 1, klon
-    z(i) = 1.
-    dz(i) = 1.
-    sum_thvu(i) = thu(i, 1)*(1.+epsim1*qu(i,1))*dz(i)
-    sum_dth(i) = 0.
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      dz(i) = -(amax1(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*rg)
-      IF (dz(i)>0) THEN
-        z(i) = z(i) + dz(i)
-        sum_thu(i) = sum_thu(i) + thu(i, k)*dz(i)
-        sum_tu(i) = sum_tu(i) + tu(i, k)*dz(i)
-        sum_qu(i) = sum_qu(i) + qu(i, k)*dz(i)
-        sum_thvu(i) = sum_thvu(i) + thu(i, k)*(1.+epsim1*qu(i,k))*dz(i)
-        sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
-        sum_dq(i) = sum_dq(i) + deltaqw(i, k)*dz(i)
-        sum_rho(i) = sum_rho(i) + rhow(i, k)*dz(i)
-        sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i, k)*dz(i)
-        sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i, k)*dz(i)
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    hw0(i) = z(i)
-  END DO
-
-
-  ! 2.1 - WAPE and mean forcing computation
-  ! ---------------------------------------
-
-  ! ---------------------------------------
-
-  ! Means
-
-  DO i = 1, klon
-    av_thu(i) = sum_thu(i)/hw0(i)
-    av_tu(i) = sum_tu(i)/hw0(i)
-    av_qu(i) = sum_qu(i)/hw0(i)
-    av_thvu(i) = sum_thvu(i)/hw0(i)
-    ! av_thve = sum_thve/hw0
-    av_dth(i) = sum_dth(i)/hw0(i)
-    av_dq(i) = sum_dq(i)/hw0(i)
-    av_rho(i) = sum_rho(i)/hw0(i)
-    av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
-    av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
-
-    wape(i) = -rg*hw0(i)*(av_dth(i)+ &
-        epsim1*(av_thu(i)*av_dq(i)+av_dth(i)*av_qu(i)+av_dth(i)*av_dq(i)))/av_thvu(i)
-
-  END DO
-
-  ! 2.2 Prognostic variable update
-  ! ------------------------------
-
-  ! Filter out bad wakes
-
-  DO k = 1, klev
-    DO i = 1, klon
-      IF (wape(i)<0.) THEN
-        deltatw(i, k) = 0.
-        deltaqw(i, k) = 0.
-        dth(i, k) = 0.
-        d_deltatw2(i,k) = -deltatw0(i,k)
-        d_deltaqw2(i,k) = -deltaqw0(i,k)
-#ifdef ISO
-        do ixt=1,ntraciso
-        deltaxtw(ixt,i, k) = 0.
-        d_deltaxtw2(ixt,i,k) = -deltaxtw0(ixt,i,k)
-        enddo
-#endif
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    IF (wape(i)<0.) THEN
-      wape(i) = 0.
-      cstar(i) = 0.
-      hw(i) = hwmin
-!jyg<
-!!      sigmaw(i) = amax1(sigmad, sigd_con(i))
-      sigmaw_targ = max(sigmad, sigd_con(i))
-      d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
-      sigmaw(i) = sigmaw_targ
-!>jyg
-      fip(i) = 0.
-      gwake(i) = .FALSE.
-    ELSE
-      hw(i) = hw0(i)
-      cstar(i) = stark*sqrt(2.*wape(i))
-      gwake(i) = .TRUE.
-    END IF
-  END DO
-
-
-  ! Check qx and qw positivity
-  ! --------------------------
-  DO i = 1, klon
-    q0_min(i) = min((qe(i,1)-sigmaw(i)*deltaqw(i,1)),  &
-                    (qe(i,1)+(1.-sigmaw(i))*deltaqw(i,1)))
-  END DO
-  DO k = 2, klev
-    DO i = 1, klon
-      q1_min(i) = min((qe(i,k)-sigmaw(i)*deltaqw(i,k)), &
-                      (qe(i,k)+(1.-sigmaw(i))*deltaqw(i,k)))
-      IF (q1_min(i)<=q0_min(i)) THEN
-        q0_min(i) = q1_min(i)
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    ok_qx_qw(i) = q0_min(i) >= 0.
-    alpha(i) = 1.
-  END DO
-
-  IF (prt_level>=10) THEN
-    PRINT *, 'wake-4, sigmaw(igout), cstar(igout), wape(igout), ktop(igout) ', &
-                      sigmaw(igout), cstar(igout), wape(igout), ktop(igout)
-  ENDIF
-
-
-  ! C -----------------------------------------------------------------
-  ! Sub-time-stepping
-  ! -----------------
-
-  nsub = 10
-  dtimesub = dtime/nsub
-
-  ! ------------------------------------------------------------
-  DO isubstep = 1, nsub
-    ! ------------------------------------------------------------
-
-    ! wk_adv is the logical flag enabling wake evolution in the time advance
-    ! loop
-    DO i = 1, klon
-      wk_adv(i) = ok_qx_qw(i) .AND. alpha(i) >= 1.
-    END DO
-    IF (prt_level>=10) THEN
-      PRINT *, 'wake-4.1, isubstep,wk_adv(igout),cstar(igout),wape(igout), ptop(igout) ', &
-                          isubstep,wk_adv(igout),cstar(igout),wape(igout), ptop(igout)
-    ENDIF
-
-    ! cc nrlmd   Ajout d'un recalcul de wdens dans le cas d'un entrainement
-    ! négatif de ktop à kupper --------
-    ! cc           On calcule pour cela une densité wdens0 pour laquelle on
-    ! aurait un entrainement nul ---
-    !jyg<
-    ! Dans la configuration avec wdens prognostique, il s'agit d'un cas ou 
-    ! les poches sont insuffisantes pour accueillir tout le flux de masse 
-    ! des descentes unsaturees. Nous faisons alors l'hypothese que la 
-    ! convection profonde cree directement de nouvelles poches, sans passer 
-    ! par les thermiques. La nouvelle valeur de wdens est alors imposée.
-
-    DO i = 1, klon
-      ! c       print *,' isubstep,wk_adv(i),cstar(i),wape(i) ',
-      ! c     $           isubstep,wk_adv(i),cstar(i),wape(i)
-      IF (wk_adv(i) .AND. cstar(i)>0.01) THEN
-        omg(i, kupper(i)+1) = -rg*amdwn(i, kupper(i)+1)/sigmaw(i) + &
-                               rg*amup(i, kupper(i)+1)/(1.-sigmaw(i))
-        wdens0 = (sigmaw(i)/(4.*3.14))* &
-          ((1.-sigmaw(i))*omg(i,kupper(i)+1)/((ph(i,1)-pupper(i))*cstar(i)))**(2)
-        IF (prt_level >= 10) THEN
-             print*,'omg(i,kupper(i)+1),wdens0,wdens(i),cstar(i), ph(i,1)-pupper(i)', &
-                     omg(i,kupper(i)+1),wdens0,wdens(i),cstar(i), ph(i,1)-pupper(i)
-        ENDIF
-        IF (wdens(i)<=wdens0*1.1) THEN
-          IF (iflag_wk_pop_dyn >= 1) THEN
-             d_wdens2(i) = d_wdens2(i) + wdens0 - wdens(i)
-          ENDIF
-          wdens(i) = wdens0
-        END IF
-      END IF
-    END DO
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        gfl(i) = 2.*sqrt(3.14*wdens(i)*sigmaw(i))
-        rad_wk(i) = sqrt(sigmaw(i)/(3.14*wdens(i)))
-!jyg<
-!!        sigmaw(i) = amin1(sigmaw(i), sigmaw_max)
-        sigmaw_targ = min(sigmaw(i), sigmaw_max)
-        d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
-        sigmaw(i) = sigmaw_targ
-!>jyg
-      END IF
-    END DO
-
-    IF (iflag_wk_pop_dyn >= 1) THEN
-!    The variable "death_rate" is significant only when iflag_wk_pop_dyn = 0.
-!    Here, it has to be set to zero.
-      death_rate(:) = 0.
-
-      IF (iflag_wk_act ==2) THEN
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          wape1_act(i) = abs(cin(i))
-          wape2_act(i) = 2.*wape1_act(i) + 1.
-          act(i) = min(1., max(0., (wape(i)-wape1_act(i)) / (wape2_act(i)-wape1_act(i)) ))
-        ENDIF  ! (wk_adv(i))
-      ENDDO
-      ENDIF  ! (iflag_wk_act ==2)
-
-
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-!!          tau_wk(i) = max(rad_wk(i)/(3.*cstar(i))*((cstar(i)/cstart)**1.5 - 1), 100.)
-          tau_wk_inv(i) = max( (3.*cstar(i))/(rad_wk(i)*((cstar(i)/cstart)**1.5 - 1)), 0.)
-          tau_wk_inv_min = min(tau_wk_inv(i), 1./dtimesub)
-          drdt(i) = (cstar(i) - wgen(i)*(sigmaw(i)/wdens(i)-aa0)/gfl(i)) / &
-                    (1 + 2*f_shear(i)*(2.*sigmaw(i)-aa0*wdens(i)) - 2.*sigmaw(i))
-!!                    (1 - 2*sigmaw(i)*(1.-f_shear(i)))
-          drdt_pos=max(drdt(i),0.)
-
-!!          d_wdens(i) = ( wgen(i)*(1.+2.*(sigmaw(i)-sigmad)) &
-!!                     - wdens(i)*tau_wk_inv_min &
-!!                     - 2.*gfl(i)*wdens(i)*Cstar(i) )*dtimesub
-          d_awdens(i) = ( wgen(i) - (1./tau_cv)*(awdens(i) - act(i)*wdens(i)) )*dtimesub
-          d_wdens(i) = ( wgen(i) - (wdens(i)-awdens(i))*tau_wk_inv_min -  &
-                         2.*wdens(i)*gfl(i)*drdt_pos )*dtimesub
-          d_wdens(i) = max(d_wdens(i), wdensmin-wdens(i))
-
-!!          d_sigmaw(i) = ( (1.-2*f_shear(i)*sigmaw(i))*(gfl(i)*Cstar(i)+wgen(i)*sigmad/wdens(i)) &
-!!                      + 2.*f_shear(i)*wgen(i)*sigmaw(i)**2/wdens(i) &
-!!                      - sigmaw(i)*tau_wk_inv_min )*dtimesub
-          d_sig_gen(i) = wgen(i)*aa0
-          d_sig_death(i) = - sigmaw(i)*(1.-awdens(i)/wdens(i))*tau_wk_inv_min
-!!          d_sig_col(i) = - 2*f_shear(i)*sigmaw(i)*gfl(i)*drdt_pos
-          d_sig_col(i) = - 2*f_shear(i)*(2.*sigmaw(i)-wdens(i)*aa0)*gfl(i)*drdt_pos
-          d_sigmaw(i) = ( d_sig_gen(i) + d_sig_death(i) + d_sig_col(i) + gfl(i)*cstar(i) )*dtimesub
-          d_sigmaw(i) = max(d_sigmaw(i), sigmad-sigmaw(i))
-        ENDIF
-      ENDDO
-
-      IF (prt_level >= 10) THEN
-        print *,'wake, cstar(1), cstar(1)/cstart, rad_wk(1), tau_wk_inv(1), drdt(1) ', &
-                       cstar(1), cstar(1)/cstart, rad_wk(1), tau_wk_inv(1), drdt(1)
-        print *,'wake, wdens(1), awdens(1), act(1), d_awdens(1) ', &
-                       wdens(1), awdens(1), act(1), d_awdens(1)
-        print *,'wake, wgen, -(wdens-awdens)*tau_wk_inv, -2.*wdens*gfl*drdt_pos, d_wdens ', &
-                       wgen(1), -(wdens(1)-awdens(1))*tau_wk_inv(1), -2.*wdens(1)*gfl(1)*drdt_pos, d_wdens(1)
-        print *,'wake, d_sig_gen(1), d_sig_death(1), d_sig_col(1), d_sigmaw(1) ', &
-                       d_sig_gen(1), d_sig_death(1), d_sig_col(1), d_sigmaw(1)
-      ENDIF
-    
-    ELSE  !  (iflag_wk_pop_dyn >= 1)
-
-    ! cc nrlmd
-
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          ! cc nrlmd          Introduction du taux de mortalité des poches et
-          ! test sur sigmaw_max=0.4
-          ! cc         d_sigmaw(i) = gfl(i)*Cstar(i)*dtimesub
-          IF (sigmaw(i)>=sigmaw_max) THEN
-            death_rate(i) = gfl(i)*cstar(i)/sigmaw(i)
-          ELSE
-            death_rate(i) = 0.
-          END IF
-    
-          d_sigmaw(i) = gfl(i)*cstar(i)*dtimesub - death_rate(i)*sigmaw(i)* &
-            dtimesub
-          ! $              - nat_rate(i)*sigmaw(i)*dtimesub
-          ! c        print*, 'd_sigmaw(i),sigmaw(i),gfl(i),Cstar(i),wape(i),
-          ! c     $  death_rate(i),ktop(i),kupper(i)',
-          ! c     $	         d_sigmaw(i),sigmaw(i),gfl(i),Cstar(i),wape(i),
-          ! c     $  death_rate(i),ktop(i),kupper(i)
-    
-          ! sigmaw(i) =sigmaw(i) + gfl(i)*Cstar(i)*dtimesub
-          ! sigmaw(i) =min(sigmaw(i),0.99)     !!!!!!!!
-          ! wdens = wdens0/(10.*sigmaw)
-          ! sigmaw =max(sigmaw,sigd_con)
-          ! sigmaw =max(sigmaw,sigmad)
-        END IF
-      END DO
-
-    ENDIF   !  (iflag_wk_pop_dyn >= 1)
-
-
-    ! calcul de la difference de vitesse verticale poche - zone non perturbee
-    ! IM 060208 differences par rapport au code initial; init. a 0 dp_deltomg
-    ! IM 060208 et omg sur les niveaux de 1 a klev+1, alors que avant l'on definit
-    ! IM 060208 au niveau k=1..?
-    !JYG 161013 Correction : maintenant omg est dimensionne a klev.
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN !!! nrlmd
-          dp_deltomg(i, k) = 0.
-        END IF
-      END DO
-    END DO
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN !!! nrlmd
-          omg(i, k) = 0.
-        END IF
-      END DO
-    END DO
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        z(i) = 0.
-        omg(i, 1) = 0.
-        dp_deltomg(i, 1) = -(gfl(i)*cstar(i))/(sigmaw(i)*(1-sigmaw(i)))
-      END IF
-    END DO
-
-    DO k = 2, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=ktop(i)) THEN
-          dz(i) = -(ph(i,k)-ph(i,k-1))/(rho(i,k-1)*rg)
-          z(i) = z(i) + dz(i)
-          dp_deltomg(i, k) = dp_deltomg(i, 1)
-          omg(i, k) = dp_deltomg(i, 1)*z(i)
-        END IF
-      END DO
-    END DO
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        dztop(i) = -(ptop(i)-ph(i,ktop(i)))/(rho(i,ktop(i))*rg)
-        ztop(i) = z(i) + dztop(i)
-        omgtop(i) = dp_deltomg(i, 1)*ztop(i)
-      END IF
-    END DO
-
-    IF (prt_level>=10) THEN
-      PRINT *, 'wake-4.2, omg(igout,k) ', (k,omg(igout,k), k=1,klev)
-      PRINT *, 'wake-4.2, omgtop(igout), ptop(igout), ktop(igout) ', &
-                          omgtop(igout), ptop(igout), ktop(igout)
-    ENDIF
-
-    ! -----------------
-    ! From m/s to Pa/s
-    ! -----------------
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        omgtop(i) = -rho(i, ktop(i))*rg*omgtop(i)
-        dp_deltomg(i, 1) = omgtop(i)/(ptop(i)-ph(i,1))
-      END IF
-    END DO
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=ktop(i)) THEN
-          omg(i, k) = -rho(i, k)*rg*omg(i, k)
-          dp_deltomg(i, k) = dp_deltomg(i, 1)
-        END IF
-      END DO
-    END DO
-
-    ! raccordement lineaire de omg de ptop a pupper
-
-    DO i = 1, klon
-      IF (wk_adv(i) .AND. kupper(i)>ktop(i)) THEN
-        omg(i, kupper(i)+1) = -rg*amdwn(i, kupper(i)+1)/sigmaw(i) + &
-          rg*amup(i, kupper(i)+1)/(1.-sigmaw(i))
-        dp_deltomg(i, kupper(i)) = (omgtop(i)-omg(i,kupper(i)+1))/ &
-          (ptop(i)-pupper(i))
-      END IF
-    END DO
-
-    ! c      DO i=1,klon
-    ! c        print*,'Pente entre 0 et kupper (référence)'
-    ! c     $   	,omg(i,kupper(i)+1)/(pupper(i)-ph(i,1))
-    ! c        print*,'Pente entre ktop et kupper'
-    ! c     $  	,(omg(i,kupper(i)+1)-omgtop(i))/(pupper(i)-ptop(i))
-    ! c      ENDDO
-    ! c
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k>ktop(i) .AND. k<=kupper(i)) THEN
-          dp_deltomg(i, k) = dp_deltomg(i, kupper(i))
-          omg(i, k) = omgtop(i) + (ph(i,k)-ptop(i))*dp_deltomg(i, kupper(i))
-        END IF
-      END DO
-    END DO
-!!    print *,'omg(igout,k) ', (k,omg(igout,k),k=1,klev)
-    ! cc nrlmd
-    ! c      DO i=1,klon
-    ! c      print*,'deltaw_ktop,deltaw_conv',omgtop(i),omg(i,kupper(i)+1)
-    ! c      END DO
-    ! cc
-
-
-    ! --    Compute wake average vertical velocity omgbw
-
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          omgbw(i, k) = omgb(i, k) + (1.-sigmaw(i))*omg(i, k)
-        END IF
-      END DO
-    END DO
-    ! --    and its vertical gradient dp_omgbw
-
-    DO k = 1, klev-1
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          dp_omgbw(i, k) = (omgbw(i,k+1)-omgbw(i,k))/(ph(i,k+1)-ph(i,k))
-        END IF
-      END DO
-    END DO
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-          dp_omgbw(i, klev) = 0.
-      END IF
-    END DO
-
-    ! --    Upstream coefficients for omgb velocity
-    ! --    (alpha_up(k) is the coefficient of the value at level k)
-    ! --    (1-alpha_up(k) is the coefficient of the value at level k-1)
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          alpha_up(i, k) = 0.
-          IF (omgb(i,k)>0.) alpha_up(i, k) = 1.
-        END IF
-      END DO
-    END DO
-
-    ! Matrix expressing [The,deltatw] from  [Th1,Th2]
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        rre1(i) = 1. - sigmaw(i)
-        rre2(i) = sigmaw(i)
-      END IF
-    END DO
-    rrd1 = -1.
-    rrd2 = 1.
-
-    ! --    Get [Th1,Th2], dth and [q1,q2]
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=kupper(i)+1) THEN
-          dth(i, k) = deltatw(i, k)/ppi(i, k)
-          th1(i, k) = the(i, k) - sigmaw(i)*dth(i, k) ! undisturbed area
-          th2(i, k) = the(i, k) + (1.-sigmaw(i))*dth(i, k) ! wake
-          q1(i, k) = qe(i, k) - sigmaw(i)*deltaqw(i, k) ! undisturbed area
-          q2(i, k) = qe(i, k) + (1.-sigmaw(i))*deltaqw(i, k) ! wake
-#ifdef ISO
-          do ixt=1,ntraciso
-            xt1(ixt,i,k) = xte(ixt,i,k) -sigmaw(i)     *deltaxtw(ixt,i,k) ! undisturbed area
-            xt2(ixt,i,k) = xte(ixt,i,k) +(1.-sigmaw(i))*deltaxtw(ixt,i,k) ! wake
-          enddo
-#endif
-        END IF
-      END DO
-    END DO
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        d_th1(i, 1) = 0.
-        d_th2(i, 1) = 0.
-        d_dth(i, 1) = 0.
-        d_q1(i, 1) = 0.
-        d_q2(i, 1) = 0.
-        d_dq(i, 1) = 0.
-#ifdef ISO
-        do ixt=1,ntraciso
-          d_xt1(ixt,i,1) = 0.
-          d_xt2(ixt,i,1) = 0.
-          d_dxt(ixt,i,1) = 0.
-        enddo !do ixt=1,ntraciso
-#endif
-      END IF
-    END DO
-
-    DO k = 2, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=kupper(i)+1) THEN
-          d_th1(i, k) = th1(i, k-1) - th1(i, k)
-          d_th2(i, k) = th2(i, k-1) - th2(i, k)
-          d_dth(i, k) = dth(i, k-1) - dth(i, k)
-          d_q1(i, k) = q1(i, k-1) - q1(i, k)
-          d_q2(i, k) = q2(i, k-1) - q2(i, k)
-          d_dq(i, k) = deltaqw(i, k-1) - deltaqw(i, k)
-#ifdef ISO
-        do ixt=1,ntraciso
-          d_xt1(ixt,i,k) = xt1(ixt,i,k-1)-xt1(ixt,i,k)
-          d_xt2(ixt,i,k) = xt2(ixt,i,k-1)-xt2(ixt,i,k)
-          d_dxt(ixt,i,k) = deltaxtw(ixt,i,k-1)-deltaxtw(ixt,i,k)
-        enddo !do ixt=1,ntraciso
-#endif
-        END IF
-      END DO
-    END DO
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        omgbdth(i, 1) = 0.
-        omgbdq(i, 1) = 0.
-#ifdef ISO
-        do ixt=1,ntraciso
-         omgbdxt(ixt,i,1) = 0.
-        enddo !do ixt=1,ntraciso
-#endif
-      END IF
-    END DO
-
-    DO k = 2, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=kupper(i)+1) THEN !   loop on interfaces
-          omgbdth(i, k) = omgb(i, k)*(dth(i,k-1)-dth(i,k))
-          omgbdq(i, k) = omgb(i, k)*(deltaqw(i,k-1)-deltaqw(i,k))
-#ifdef ISO
-        do ixt=1,ntraciso
-          omgbdxt(ixt,i,k)  = omgb(i,k)*(deltaxtw(ixt,i,k-1) - deltaxtw(ixt,i,k))
-        enddo !do ixt=1,ntraciso
-#ifdef ISOVERIF
-      if (iso_eau.gt.0) then
-        call iso_verif_egalite(deltaqw(i,k-1),deltaxtw(iso_eau,i,k-1),'wake 1460a')
-        call iso_verif_egalite(deltaqw(i,k),deltaxtw(iso_eau,i,k),'wake 1460b')
-        call iso_verif_egalite(omgbdq(i,k),omgbdxt(iso_eau,i,k),'wake 1460c')
-      endif
-#endif
-#endif
-        END IF
-      END DO
-    END DO
-
-    IF (prt_level>=10) THEN
-      PRINT *, 'wake-4.3, th1(igout,k) ', (k,th1(igout,k), k=1,klev)
-      PRINT *, 'wake-4.3, th2(igout,k) ', (k,th2(igout,k), k=1,klev)
-      PRINT *, 'wake-4.3, dth(igout,k) ', (k,dth(igout,k), k=1,klev)
-      PRINT *, 'wake-4.3, omgbdth(igout,k) ', (k,omgbdth(igout,k), k=1,klev)
-    ENDIF
-
-    ! -----------------------------------------------------------------
-    DO k = 1, klev-1
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=kupper(i)-1) THEN
-          ! -----------------------------------------------------------------
-
-          ! Compute redistribution (advective) term
-
-          d_deltatw(i, k) = dtimesub/(ph(i,k)-ph(i,k+1))* &
-            (rrd1*omg(i,k)*sigmaw(i)*d_th1(i,k) - &
-             rrd2*omg(i,k+1)*(1.-sigmaw(i))*d_th2(i,k+1)- &
-             (1.-alpha_up(i,k))*omgbdth(i,k)- &
-             alpha_up(i,k+1)*omgbdth(i,k+1))*ppi(i, k)
-!           print*,'d_deltatw=', k, d_deltatw(i,k)
-
-          d_deltaqw(i, k) = dtimesub/(ph(i,k)-ph(i,k+1))* &
-            (rrd1*omg(i,k)*sigmaw(i)*d_q1(i,k)- &
-             rrd2*omg(i,k+1)*(1.-sigmaw(i))*d_q2(i,k+1)- &
-             (1.-alpha_up(i,k))*omgbdq(i,k)- &
-             alpha_up(i,k+1)*omgbdq(i,k+1))
-!           print*,'d_deltaqw=', k, d_deltaqw(i,k)
-#ifdef ISO
-        do ixt=1,ntraciso
-          d_deltaxtw(ixt,i,k) = dtimesub/(Ph(i,k)-Ph(i,k+1))* &
-            (rrd1*omg(i,k  )*sigmaw(i)     *d_xt1(ixt,i,k)- &
-            rrd2*omg(i,k+1)*(1.-sigmaw(i))*d_xt2(ixt,i,k+1)- &
-            (1.-alpha_up(i,k))*omgbdxt(ixt,i,k)- &
-            alpha_up(i,k+1)*omgbdxt(ixt,i,k+1))
-        enddo !do ixt=1,ntraciso
-#ifdef ISOVERIF
-      if (iso_eau.gt.0) then
-        call iso_verif_egalite(d_q1(i,k),d_xt1(iso_eau,i,k),'wake 1502a')
-        call iso_verif_egalite(d_q2(i,k),d_xt2(iso_eau,i,k),'wake 1502b')
-        call iso_verif_egalite(omgbdq(i,k),omgbdxt(iso_eau,i,k),'wake 1502c')
-        call iso_verif_egalite(omgbdq(i,k+1),omgbdxt(iso_eau,i,k+1),'wake 1502d')
-        call iso_verif_egalite(d_deltaqw(i,k),d_deltaxtw(iso_eau,i,k),'wake 1502e')
-      endif
-#endif
-#endif
-
-          ! and increment large scale tendencies
-
-
-
-
-          ! C
-          ! -----------------------------------------------------------------
-          d_te(i, k) = dtimesub*((rre1(i)*omg(i,k)*sigmaw(i)*d_th1(i,k)- &
-                                  rre2(i)*omg(i,k+1)*(1.-sigmaw(i))*d_th2(i,k+1))/ &
-                                 (ph(i,k)-ph(i,k+1)) &
-                                 -sigmaw(i)*(1.-sigmaw(i))*dth(i,k)*(omg(i,k)-omg(i,k+1))/ &
-                                 (ph(i,k)-ph(i,k+1)) )*ppi(i, k)
-
-          d_qe(i, k) = dtimesub*((rre1(i)*omg(i,k)*sigmaw(i)*d_q1(i,k)- &
-                                  rre2(i)*omg(i,k+1)*(1.-sigmaw(i))*d_q2(i,k+1))/ &
-                                 (ph(i,k)-ph(i,k+1)) &
-                                 -sigmaw(i)*(1.-sigmaw(i))*deltaqw(i,k)*(omg(i,k)-omg(i,k+1))/ &
-                                 (ph(i,k)-ph(i,k+1)) )
-#ifdef ISO
-        do ixt=1,ntraciso
-         d_xte(ixt,i,k) =  dtimesub*( &
-             ( rre1(i)*omg(i,k  )*sigmaw(i)     *d_xt1(ixt,i,k) &
-              -rre2(i)*omg(i,k+1)*(1.-sigmaw(i))*d_xt2(ixt,i,k+1) ) &
-                    /(Ph(i,k)-Ph(i,k+1)) &
-              -sigmaw(i)*(1.-sigmaw(i))*deltaxtw(ixt,i,k) &
-              *(omg(i,k)-omg(i,k+1))/(Ph(i,k)-Ph(i,k+1)) &
-              )
-        enddo !do ixt=1,ntraciso
-#endif 
-        ELSE IF (wk_adv(i) .AND. k==kupper(i)) THEN
-          d_te(i, k) = dtimesub*(rre1(i)*omg(i,k)*sigmaw(i)*d_th1(i,k)/(ph(i,k)-ph(i,k+1)))*ppi(i, k)
-
-          d_qe(i, k) = dtimesub*(rre1(i)*omg(i,k)*sigmaw(i)*d_q1(i,k)/(ph(i,k)-ph(i,k+1)))
-
-#ifdef ISO
-        do ixt=1,ntraciso
-         d_xte(ixt,i,k) =  dtimesub*( &
-            ( rre1(i)*omg(i,k  )*sigmaw(i)  *d_xt1(ixt,i,k)     &   
-             /(Ph(i,k)-Ph(i,k+1))) &
-                            )
-        enddo !do ixt=1,ntraciso
-#endif
-        END IF
-        ! cc
-      END DO
-    END DO
-    ! ------------------------------------------------------------------
-
-    IF (prt_level>=10) THEN
-      PRINT *, 'wake-4.3, d_deltatw(igout,k) ', (k,d_deltatw(igout,k), k=1,klev)
-      PRINT *, 'wake-4.3, d_deltaqw(igout,k) ', (k,d_deltaqw(igout,k), k=1,klev)
-    ENDIF
-
-    ! Increment state variables
-!jyg<
-    IF (iflag_wk_pop_dyn >= 1) THEN
-      DO k = 1, klev
-        DO i = 1, klon
-          IF (wk_adv(i) .AND. k<=kupper(i)) THEN
-            detr(i,k) = - d_sig_death(i) - d_sig_col(i)      
-            entr(i,k) = d_sig_gen(i)
-          ENDIF
-        ENDDO
-      ENDDO
-      ELSE  ! (iflag_wk_pop_dyn >= 1)
-      DO k = 1, klev
-        DO i = 1, klon
-          IF (wk_adv(i) .AND. k<=kupper(i)) THEN
-            detr(i, k) = 0.
-   
-            entr(i, k) = 0.
-          ENDIF
-        ENDDO
-      ENDDO
-    ENDIF  ! (iflag_wk_pop_dyn >= 1)
-
-    
-
-    DO k = 1, klev
-      DO i = 1, klon
-        ! cc nrlmd       IF( wk_adv(i) .AND. k .LE. kupper(i)-1) THEN
-        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
-          ! cc
-
-
-
-          ! Coefficient de répartition
-
-          crep(i, k) = crep_sol*(ph(i,kupper(i))-ph(i,k))/ &
-            (ph(i,kupper(i))-ph(i,1))
-          crep(i, k) = crep(i, k) + crep_upper*(ph(i,1)-ph(i,k))/ &
-            (p(i,1)-ph(i,kupper(i)))
-
-
-          ! Reintroduce compensating subsidence term.
-
-          ! dtKE(k)=(dtdwn(k)*Crep(k))/sigmaw
-          ! dtKE(k)=dtKE(k)-(dtdwn(k)*(1-Crep(k))+dta(k))
-          ! .                   /(1-sigmaw)
-          ! dqKE(k)=(dqdwn(k)*Crep(k))/sigmaw
-          ! dqKE(k)=dqKE(k)-(dqdwn(k)*(1-Crep(k))+dqa(k))
-          ! .                   /(1-sigmaw)
-
-          ! dtKE(k)=(dtdwn(k)*Crep(k)+(1-Crep(k))*dta(k))/sigmaw
-          ! dtKE(k)=dtKE(k)-(dtdwn(k)*(1-Crep(k))+dta(k)*Crep(k))
-          ! .                   /(1-sigmaw)
-          ! dqKE(k)=(dqdwn(k)*Crep(k)+(1-Crep(k))*dqa(k))/sigmaw
-          ! dqKE(k)=dqKE(k)-(dqdwn(k)*(1-Crep(k))+dqa(k)*Crep(k))
-          ! .                   /(1-sigmaw)
-
-          dtke(i, k) = (dtdwn(i,k)/sigmaw(i)-dta(i,k)/(1.-sigmaw(i)))
-          dqke(i, k) = (dqdwn(i,k)/sigmaw(i)-dqa(i,k)/(1.-sigmaw(i)))
-#ifdef ISO
-        do ixt=1,ntraciso
-          dxtke(ixt,i,k)=(dxtdwn(ixt,i,k)/sigmaw(i) - dxta(ixt,i,k) &
-               /(1.-sigmaw(i)))
-        enddo !do ixt=1,ntraciso
-#ifdef ISOVERIF
-      if (iso_eau.gt.0) then
-        call iso_verif_egalite(dqke(i,k),dxtKE(iso_eau,i,k),'wake 1621a')
-        call iso_verif_egalite(dqdwn(i,k),dxtdwn(iso_eau,i,k),'wake 1621b')
-        call iso_verif_egalite(dqa(i,k),dxta(iso_eau,i,k),'wake 1621c')
-        call iso_verif_egalite(d_deltaqw(i,k),d_deltaxtw(iso_eau,i,k),'wake 1621d')
-      endif
-#endif
-#endif
-          ! print*,'dtKE= ',dtKE(i,k),' dqKE= ',dqKE(i,k)
-
-!
-
-          ! cc nrlmd          Prise en compte du taux de mortalité
-          ! cc               Définitions de entr, detr
-!jyg<
-!!            detr(i, k) = 0.
-!!   
-!!            entr(i, k) = detr(i, k) + gfl(i)*cstar(i) + &
-!!              sigmaw(i)*(1.-sigmaw(i))*dp_deltomg(i, k)
-!!
-            entr(i, k) = entr(i,k) + gfl(i)*cstar(i) + &
-                         sigmaw(i)*(1.-sigmaw(i))*dp_deltomg(i, k)   
-!>jyg
-            spread(i, k) = (entr(i,k)-detr(i,k))/sigmaw(i)
-
-          ! cc        spread(i,k) =
-          ! (1.-sigmaw(i))*dp_deltomg(i,k)+gfl(i)*Cstar(i)/
-          ! cc     $  sigmaw(i)
-
-
-          ! ajout d'un effet onde de gravité -Tgw(k)*deltatw(k) 03/02/06 YU
-          ! Jingmei
-
-          ! write(lunout,*)'wake.F ',i,k, dtimesub,d_deltat_gw(i,k),
-          ! &  Tgw(i,k),deltatw(i,k)
-          d_deltat_gw(i, k) = d_deltat_gw(i, k) - tgw(i, k)*deltatw(i, k)* &
-            dtimesub
-          ! write(lunout,*)'wake.F ',i,k, dtimesub,d_deltatw(i,k)
-          ff(i) = d_deltatw(i, k)/dtimesub
-
-          ! Sans GW
-
-          ! deltatw(k)=deltatw(k)+dtimesub*(ff+dtKE(k)-spread(k)*deltatw(k))
-
-          ! GW formule 1
-
-          ! deltatw(k) = deltatw(k)+dtimesub*
-          ! $         (ff+dtKE(k) - spread(k)*deltatw(k)-Tgw(k)*deltatw(k))
-
-          ! GW formule 2
-
-          IF (dtimesub*tgw(i,k)<1.E-10) THEN
-            d_deltatw(i, k) = dtimesub*(ff(i)+dtke(i,k) - & 
-               entr(i,k)*deltatw(i,k)/sigmaw(i) - &
-               (death_rate(i)*sigmaw(i)+detr(i,k))*deltatw(i,k)/(1.-sigmaw(i)) - & ! cc
-               tgw(i,k)*deltatw(i,k) )
-          ELSE
-            d_deltatw(i, k) = 1/tgw(i, k)*(1-exp(-dtimesub*tgw(i,k)))* &
-               (ff(i)+dtke(i,k) - &
-                entr(i,k)*deltatw(i,k)/sigmaw(i) - &
-                (death_rate(i)*sigmaw(i)+detr(i,k))*deltatw(i,k)/(1.-sigmaw(i)) - &
-                tgw(i,k)*deltatw(i,k) )
-          END IF
-
-          dth(i, k) = deltatw(i, k)/ppi(i, k)
-
-          gg(i) = d_deltaqw(i, k)/dtimesub
-
-          d_deltaqw(i, k) = dtimesub*(gg(i)+dqke(i,k) - & 
-            entr(i,k)*deltaqw(i,k)/sigmaw(i) - &
-            (death_rate(i)*sigmaw(i)+detr(i,k))*deltaqw(i,k)/(1.-sigmaw(i)))
-#ifdef ISO
-        do ixt=1,ntraciso
-          gg(i)=d_deltaxtw(ixt,i,k)/dtimesub
-          d_deltaxtw(ixt,i,k) = dtimesub*(gg(i) + dxtKE(ixt,i,k) - &
-             entr(i,k)*deltaxtw(ixt,i,k)/sigmaw(i) - &
-             (death_rate(i)*sigmaw(i)+detr(i,k))*deltaxtw(ixt,i,k)/(1.-sigmaw(i)))
-        enddo !do ixt=1,ntraciso
-#ifdef ISOVERIF
-      if (iso_eau.gt.0) then
-        call iso_verif_egalite(dqke(i,k),dxtKE(iso_eau,i,k),'wake 1692a')
-        call iso_verif_egalite(deltaqw(i,k),deltaxtw(iso_eau,i,k),'wake 1692b')
-        call iso_verif_egalite(d_deltaqw(i,k),d_deltaxtw(iso_eau,i,k),'wake 1692c')
-      endif
-#endif
-#endif
-          ! cc
-
-          ! cc nrlmd
-          ! cc       d_deltatw2(i,k)=d_deltatw2(i,k)+d_deltatw(i,k)
-          ! cc       d_deltaqw2(i,k)=d_deltaqw2(i,k)+d_deltaqw(i,k)
-          ! cc
-        END IF
-      END DO
-    END DO
-
-#ifdef ISO
-#ifdef ISOVERIF
-      if (iso_eau.gt.0) then
-             call iso_verif_egalite_vect2D(d_deltaxtw,d_deltaqw, &
-                 'wake 1359',ntraciso,klon,klev)
-      endif      
-#endif         
-#endif  
-
-    ! Scale tendencies so that water vapour remains positive in w and x.
-
-    CALL wake_vec_modulation(klon, klev, wk_adv, epsilon, qe, d_qe, deltaqw, &
-      d_deltaqw, sigmaw, d_sigmaw, alpha)
-
-    ! cc nrlmd
-    ! c      print*,'alpha'
-    ! c      do i=1,klon
-    ! c         print*,alpha(i)
-    ! c      end do
-    ! cc
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
-          d_te(i, k) = alpha(i)*d_te(i, k)
-          d_qe(i, k) = alpha(i)*d_qe(i, k)
-          d_deltatw(i, k) = alpha(i)*d_deltatw(i, k)
-          d_deltaqw(i, k) = alpha(i)*d_deltaqw(i, k)
-          d_deltat_gw(i, k) = alpha(i)*d_deltat_gw(i, k)
-#ifdef ISO
-        do ixt=1,ntraciso
-          d_xte(ixt,i,k)=alpha(i)*d_xte(ixt,i,k)
-          d_deltaxtw(ixt,i,k)=alpha(i)*d_deltaxtw(ixt,i,k)
-        enddo !do ixt=1,ntraciso
-#endif
-        END IF
-      END DO
-    END DO
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        d_sigmaw(i) = alpha(i)*d_sigmaw(i)
-      END IF
-    END DO
-
-    ! Update large scale variables and wake variables
-    ! IM 060208 manque DO i + remplace DO k=1,kupper(i)
-    ! IM 060208     DO k = 1,kupper(i)
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
-          dtls(i, k) = dtls(i, k) + d_te(i, k)
-          dqls(i, k) = dqls(i, k) + d_qe(i, k)
-#ifdef ISO
-        do ixt=1,ntraciso
-          dxtls(ixt,i,k)=dxtls(ixt,i,k)+d_xte(ixt,i,k)
-        enddo !do ixt=1,ntraciso
-#endif
-          ! cc nrlmd
-          d_deltatw2(i, k) = d_deltatw2(i, k) + d_deltatw(i, k)
-          d_deltaqw2(i, k) = d_deltaqw2(i, k) + d_deltaqw(i, k)
-#ifdef ISO
-        do ixt=1,ntraciso
-          d_deltaxtw2(ixt,i,k)=d_deltaxtw2(ixt,i,k)+d_deltaxtw(ixt,i,k)
-        enddo !do ixt=1,ntraciso
-#endif
-          ! cc
-        END IF
-      END DO
-    END DO
-
-
-#ifdef ISO
-#ifdef ISOVERIF
-      if (iso_eau.gt.0) then
-        DO k= 1,klev 
-          DO i = 1,klon 
-              call iso_verif_egalite_choix(dxtls(iso_eau,i,k), &
-                dqls(i,k),'wake 1379',errmax,errmaxrel)
-          enddo ! DO i = 1,klon     
-        enddo ! DO k= 1,klev 
-      endif !if (iso_eau.gt.0) then
-#endif
-#endif
-
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k<=kupper(i)) THEN
-          te(i, k) = te0(i, k) + dtls(i, k)
-          qe(i, k) = qe0(i, k) + dqls(i, k)
-          the(i, k) = te(i, k)/ppi(i, k)
-          deltatw(i, k) = deltatw(i, k) + d_deltatw(i, k)
-          deltaqw(i, k) = deltaqw(i, k) + d_deltaqw(i, k)
-          dth(i, k) = deltatw(i, k)/ppi(i, k)
-          ! c      print*,'k,qx,qw',k,qe(i,k)-sigmaw(i)*deltaqw(i,k)
-          ! c     $        ,qe(i,k)+(1-sigmaw(i))*deltaqw(i,k)
-#ifdef ISO
-        do ixt=1,ntraciso
-          xte(ixt,i,k) = xte0(ixt,i,k) + dxtls(ixt,i,k)
-          deltaxtw(ixt,i,k) = deltaxtw(ixt,i,k)+d_deltaxtw(ixt,i,k)
-        enddo !do ixt=1,ntraciso
-#endif
-        END IF
-      END DO
-    END DO
-!
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        sigmaw(i) = sigmaw(i) + d_sigmaw(i)
-        d_sigmaw2(i) = d_sigmaw2(i) + d_sigmaw(i)
-      END IF
-    END DO
-
-#ifdef ISO
-#ifdef ISOVERIF
-      if (iso_eau.gt.0) then
-        DO k= 1,klev 
-          DO i = 1,klon 
-              call iso_verif_egalite_choix(xte(iso_eau,i,k), &
-                qe(i,k),'wake 1379',errmax,errmaxrel)
-          enddo ! DO i = 1,klon     
-        enddo ! DO k= 1,klev 
-      endif !if (iso_eau.gt.0) then     
-      if (iso_hdo.gt.0) then
-      call iso_verif_aberrant_enc_vect2D( &
-            xte,qe, &
-            'wake 1456, xte apres modifs',ntraciso,klon,klev)
-!      call iso_verif_aberrant_enc_vect2D_ns(
-!     :       deltaxtw,deltaqw,
-!     :       'wake 1518, deltaqw apres modifs',ntraciso,klon,klev)
-      endif
-#endif
-#endif 
-
-!jyg<
-    IF (iflag_wk_pop_dyn >= 1) THEN
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          awdens(i) = awdens(i) + d_awdens(i)
-          wdens(i) = wdens(i) + d_wdens(i)
-          d_awdens2(i) = d_awdens2(i) + d_awdens(i)
-          d_wdens2(i) = d_wdens2(i) + d_wdens(i)
-        END IF
-      END DO
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          wdens_targ = max(wdens(i),wdensmin)
-          d_wdens2(i) = d_wdens2(i) + wdens_targ - wdens(i)
-          wdens(i) = wdens_targ
-!
-          wdens_targ = min( max(awdens(i),0.), wdens(i) )
-          d_awdens2(i) = d_awdens2(i) + wdens_targ - awdens(i)
-          awdens(i) = wdens_targ
-        END IF
-      END DO
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          sigmaw_targ = max(sigmaw(i),sigmad)
-          d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
-          sigmaw(i) = sigmaw_targ
-        END IF
-      END DO
-    ENDIF  ! (iflag_wk_pop_dyn >= 1)
-!>jyg
-
-
-    ! Determine Ptop from buoyancy integral
-    ! ---------------------------------------
-
-    ! -     1/ Pressure of the level where dth changes sign.
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        ptop_provis(i) = ph(i, 1)
-      END IF
-    END DO
-
-    DO k = 2, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. ptop_provis(i)==ph(i,1) .AND. &
-            dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN
-          ptop_provis(i) = ((dth(i,k)+delta_t_min)*p(i,k-1) - &
-                            (dth(i,k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
-        END IF
-      END DO
-    END DO
-
-    ! -     2/ dth integral
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        sum_dth(i) = 0.
-        dthmin(i) = -delta_t_min
-        z(i) = 0.
-      END IF
-    END DO
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          dz(i) = -(amax1(ph(i,k+1),ptop_provis(i))-ph(i,k))/(rho(i,k)*rg)
-          IF (dz(i)>0) THEN
-            z(i) = z(i) + dz(i)
-            sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
-            dthmin(i) = amin1(dthmin(i), dth(i,k))
-          END IF
-        END IF
-      END DO
-    END DO
-
-    ! -     3/ height of triangle with area= sum_dth and base = dthmin
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        hw(i) = 2.*sum_dth(i)/amin1(dthmin(i), -0.5)
-        hw(i) = amax1(hwmin, hw(i))
-      END IF
-    END DO
-
-    ! -     4/ now, get Ptop
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        ktop(i) = 0
-        z(i) = 0.
-      END IF
-    END DO
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN
-          dz(i) = amin1(-(ph(i,k+1)-ph(i,k))/(rho(i,k)*rg), hw(i)-z(i))
-          IF (dz(i)>0) THEN
-            z(i) = z(i) + dz(i)
-            ptop(i) = ph(i, k) - rho(i, k)*rg*dz(i)
-            ktop(i) = k
-          END IF
-        END IF
-      END DO
-    END DO
-
-    ! 4.5/Correct ktop and ptop
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        ptop_new(i) = ptop(i)
-      END IF
-    END DO
-
-    DO k = klev, 2, -1
-      DO i = 1, klon
-        ! IM v3JYG; IF (k .GE. ktop(i)
-        IF (wk_adv(i) .AND. k<=ktop(i) .AND. ptop_new(i)==ptop(i) .AND. &
-            dth(i,k)>-delta_t_min .AND. dth(i,k-1)<-delta_t_min) THEN
-          ptop_new(i) = ((dth(i,k)+delta_t_min)*p(i,k-1) - &
-                         (dth(i,k-1)+delta_t_min)*p(i,k))/(dth(i,k)-dth(i,k-1))
-        END IF
-      END DO
-    END DO
-
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN
-        ptop(i) = ptop_new(i)
-      END IF
-    END DO
-
-    DO k = klev, 1, -1
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN !!! nrlmd
-          IF (ph(i,k+1)<ptop(i)) ktop(i) = k
-        END IF
-      END DO
-    END DO
-
-    ! 5/ Set deltatw & deltaqw to 0 above kupper
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i) .AND. k>=kupper(i)) THEN
-          deltatw(i, k) = 0.
-          deltaqw(i, k) = 0.
-          d_deltatw2(i,k) = -deltatw0(i,k)
-          d_deltaqw2(i,k) = -deltaqw0(i,k)
-#ifdef ISO
-        do ixt=1,ntraciso
-          deltaxtw(ixt,i,k) = 0.
-          d_deltaxtw2(ixt,i,k) = -deltaxtw0(ixt,i,k)
-        enddo !do ixt=1,ntraciso
-#endif
-        END IF
-      END DO
-    END DO
-
-
-    ! -------------Cstar computation---------------------------------
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        sum_thu(i) = 0.
-        sum_tu(i) = 0.
-        sum_qu(i) = 0.
-        sum_thvu(i) = 0.
-        sum_dth(i) = 0.
-        sum_dq(i) = 0.
-        sum_rho(i) = 0.
-        sum_dtdwn(i) = 0.
-        sum_dqdwn(i) = 0.
-
-        av_thu(i) = 0.
-        av_tu(i) = 0.
-        av_qu(i) = 0.
-        av_thvu(i) = 0.
-        av_dth(i) = 0.
-        av_dq(i) = 0.
-        av_rho(i) = 0.
-        av_dtdwn(i) = 0.
-        av_dqdwn(i) = 0.
-      END IF
-    END DO
-
-    ! Integrals (and wake top level number)
-    ! --------------------------------------
-
-    ! Initialize sum_thvu to 1st level virt. pot. temp.
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        z(i) = 1.
-        dz(i) = 1.
-        sum_thvu(i) = thu(i, 1)*(1.+epsim1*qu(i,1))*dz(i)
-        sum_dth(i) = 0.
-      END IF
-    END DO
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN !!! nrlmd
-          dz(i) = -(max(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*rg)
-          IF (dz(i)>0) THEN
-            z(i) = z(i) + dz(i)
-            sum_thu(i) = sum_thu(i) + thu(i, k)*dz(i)
-            sum_tu(i) = sum_tu(i) + tu(i, k)*dz(i)
-            sum_qu(i) = sum_qu(i) + qu(i, k)*dz(i)
-            sum_thvu(i) = sum_thvu(i) + thu(i, k)*(1.+epsim1*qu(i,k))*dz(i)
-            sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
-            sum_dq(i) = sum_dq(i) + deltaqw(i, k)*dz(i)
-            sum_rho(i) = sum_rho(i) + rhow(i, k)*dz(i)
-            sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i, k)*dz(i)
-            sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i, k)*dz(i)
-          END IF
-        END IF
-      END DO
-    END DO
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        hw0(i) = z(i)
-      END IF
-    END DO
-
-
-    ! - WAPE and mean forcing computation
-    ! ---------------------------------------
-
-    ! ---------------------------------------
-
-    ! Means
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        av_thu(i) = sum_thu(i)/hw0(i)
-        av_tu(i) = sum_tu(i)/hw0(i)
-        av_qu(i) = sum_qu(i)/hw0(i)
-        av_thvu(i) = sum_thvu(i)/hw0(i)
-        av_dth(i) = sum_dth(i)/hw0(i)
-        av_dq(i) = sum_dq(i)/hw0(i)
-        av_rho(i) = sum_rho(i)/hw0(i)
-        av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
-        av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
-
-        wape(i) = -rg*hw0(i)*(av_dth(i)+epsim1*(av_thu(i)*av_dq(i) + &
-                              av_dth(i)*av_qu(i)+av_dth(i)*av_dq(i)))/av_thvu(i)
-      END IF
-    END DO
-
-    ! Filter out bad wakes
-
-    DO k = 1, klev
-      DO i = 1, klon
-        IF (wk_adv(i)) THEN !!! nrlmd
-          IF (wape(i)<0.) THEN
-            deltatw(i, k) = 0.
-            deltaqw(i, k) = 0.
-            dth(i, k) = 0.
-            d_deltatw2(i,k) = -deltatw0(i,k)
-            d_deltaqw2(i,k) = -deltaqw0(i,k)
-#ifdef ISO
-        do ixt=1,ntraciso
-          deltaxtw(ixt,i,k) = 0.
-          d_deltaxtw2(ixt,i,k) = -deltaxtw0(ixt,i,k)
-        enddo !do ixt=1,ntraciso
-#endif
-          END IF
-        END IF
-      END DO
-    END DO
-
-    DO i = 1, klon
-      IF (wk_adv(i)) THEN !!! nrlmd
-        IF (wape(i)<0.) THEN
-          wape(i) = 0.
-          cstar(i) = 0.
-          hw(i) = hwmin
-!jyg<
-!!          sigmaw(i) = max(sigmad, sigd_con(i))
-          sigmaw_targ = max(sigmad, sigd_con(i))
-          d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
-          sigmaw(i) = sigmaw_targ
-!>jyg
-          fip(i) = 0.
-          gwake(i) = .FALSE.
-        ELSE
-          cstar(i) = stark*sqrt(2.*wape(i))
-          gwake(i) = .TRUE.
-        END IF
-      END IF
-    END DO
-
-  END DO ! end sub-timestep loop
-
-  IF (prt_level>=10) THEN
-    PRINT *, 'wake-5, sigmaw(igout), cstar(igout), wape(igout), ptop(igout) ', &
-                      sigmaw(igout), cstar(igout), wape(igout), ptop(igout)
-  ENDIF
-
-
-  ! ----------------------------------------------------------
-  ! Determine wake final state; recompute wape, cstar, ktop;
-  ! filter out bad wakes.
-  ! ----------------------------------------------------------
-
-  ! 2.1 - Undisturbed area and Wake integrals
-  ! ---------------------------------------------------------
-
-  DO i = 1, klon
-    ! cc nrlmd       if (wk_adv(i)) then !!! nrlmd
-    IF (ok_qx_qw(i)) THEN
-      ! cc
-      z(i) = 0.
-      sum_thu(i) = 0.
-      sum_tu(i) = 0.
-      sum_qu(i) = 0.
-      sum_thvu(i) = 0.
-      sum_dth(i) = 0.
-      sum_half_dth(i) = 0.
-      sum_dq(i) = 0.
-      sum_rho(i) = 0.
-      sum_dtdwn(i) = 0.
-      sum_dqdwn(i) = 0.
-
-      av_thu(i) = 0.
-      av_tu(i) = 0.
-      av_qu(i) = 0.
-      av_thvu(i) = 0.
-      av_dth(i) = 0.
-      av_dq(i) = 0.
-      av_rho(i) = 0.
-      av_dtdwn(i) = 0.
-      av_dqdwn(i) = 0.
-
-      dthmin(i) = -delta_t_min
-    END IF
-  END DO
-  ! Potential temperatures and humidity
-  ! ----------------------------------------------------------
-
-  DO k = 1, klev
-    DO i = 1, klon
-      ! cc nrlmd       IF ( wk_adv(i)) THEN
-      IF (ok_qx_qw(i)) THEN
-        ! cc
-        rho(i, k) = p(i, k)/(rd*te(i,k))
-        IF (k==1) THEN
-          rhoh(i, k) = ph(i, k)/(rd*te(i,k))
-          zhh(i, k) = 0
-        ELSE
-          rhoh(i, k) = ph(i, k)*2./(rd*(te(i,k)+te(i,k-1)))
-          zhh(i, k) = (ph(i,k)-ph(i,k-1))/(-rhoh(i,k)*rg) + zhh(i, k-1)
-        END IF
-        the(i, k) = te(i, k)/ppi(i, k)
-        thu(i, k) = (te(i,k)-deltatw(i,k)*sigmaw(i))/ppi(i, k)
-        tu(i, k) = te(i, k) - deltatw(i, k)*sigmaw(i)
-        qu(i, k) = qe(i, k) - deltaqw(i, k)*sigmaw(i)
-        rhow(i, k) = p(i, k)/(rd*(te(i,k)+deltatw(i,k)))
-        dth(i, k) = deltatw(i, k)/ppi(i, k)
-#ifdef ISO
-        do ixt=1,ntraciso
-          xtu(ixt,i,k)  =  xte(ixt,i,k) - deltaxtw(ixt,i,k)*sigmaw(i)
-        enddo !do ixt=1,ntraciso
-#endif
-      END IF
-    END DO
-  END DO
-
-#ifdef ISO
-#ifdef ISOVERIF
-      if (iso_hdo.gt.0) then
-      call iso_verif_aberrant_enc_vect2D( &
-              xtu,qu, &
-              'wake 1834, apres modifs',ntraciso,klon,klev)
-      endif   
-#endif
-#endif   
-
-  ! Integrals (and wake top level number)
-  ! -----------------------------------------------------------
-
-  ! Initialize sum_thvu to 1st level virt. pot. temp.
-
-  DO i = 1, klon
-    ! cc nrlmd       IF ( wk_adv(i)) THEN
-    IF (ok_qx_qw(i)) THEN
-      ! cc
-      z(i) = 1.
-      dz(i) = 1.
-      dz_half(i) = 1.
-      sum_thvu(i) = thu(i, 1)*(1.+epsim1*qu(i,1))*dz(i)
-      sum_dth(i) = 0.
-    END IF
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      ! cc nrlmd       IF ( wk_adv(i)) THEN
-      IF (ok_qx_qw(i)) THEN
-        ! cc
-        dz(i) = -(amax1(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*rg)
-        dz_half(i) = -(amax1(ph(i,k+1),0.5*(ptop(i)+ph(i,1)))-ph(i,k))/(rho(i,k)*rg)
-        IF (dz(i)>0) THEN
-          z(i) = z(i) + dz(i)
-          sum_thu(i) = sum_thu(i) + thu(i, k)*dz(i)
-          sum_tu(i) = sum_tu(i) + tu(i, k)*dz(i)
-          sum_qu(i) = sum_qu(i) + qu(i, k)*dz(i)
-          sum_thvu(i) = sum_thvu(i) + thu(i, k)*(1.+epsim1*qu(i,k))*dz(i)
-          sum_dth(i) = sum_dth(i) + dth(i, k)*dz(i)
-          sum_dq(i) = sum_dq(i) + deltaqw(i, k)*dz(i)
-          sum_rho(i) = sum_rho(i) + rhow(i, k)*dz(i)
-          sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i, k)*dz(i)
-          sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i, k)*dz(i)
-!
-          dthmin(i) = min(dthmin(i), dth(i,k))
-        END IF
-        IF (dz_half(i)>0) THEN
-          sum_half_dth(i) = sum_half_dth(i) + dth(i, k)*dz_half(i)
-        END IF
-      END IF
-    END DO
-  END DO
-
-  DO i = 1, klon
-    ! cc nrlmd       IF ( wk_adv(i)) THEN
-    IF (ok_qx_qw(i)) THEN
-      ! cc
-      hw0(i) = z(i)
-    END IF
-  END DO
-
-  ! - WAPE and mean forcing computation
-  ! -------------------------------------------------------------
-
-  ! Means
-
-  DO i = 1, klon
-    ! cc nrlmd       IF ( wk_adv(i)) THEN
-    IF (ok_qx_qw(i)) THEN
-      ! cc
-      av_thu(i) = sum_thu(i)/hw0(i)
-      av_tu(i) = sum_tu(i)/hw0(i)
-      av_qu(i) = sum_qu(i)/hw0(i)
-      av_thvu(i) = sum_thvu(i)/hw0(i)
-      av_dth(i) = sum_dth(i)/hw0(i)
-      av_dq(i) = sum_dq(i)/hw0(i)
-      av_rho(i) = sum_rho(i)/hw0(i)
-      av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
-      av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
-
-      wape2(i) = -rg*hw0(i)*(av_dth(i)+epsim1*(av_thu(i)*av_dq(i) + &
-                             av_dth(i)*av_qu(i)+av_dth(i)*av_dq(i)))/av_thvu(i)
-    END IF
-  END DO
-
-
-
-  ! Prognostic variable update
-  ! ------------------------------------------------------------
-
-  ! Filter out bad wakes
-
-  IF (iflag_wk_check_trgl>=1) THEN
-    ! Check triangular shape of dth profile
-    DO i = 1, klon
-      IF (ok_qx_qw(i)) THEN
-        !! print *,'wake, hw0(i), dthmin(i) ', hw0(i), dthmin(i)
-        !! print *,'wake, 2.*sum_dth(i)/(hw0(i)*dthmin(i)) ', &
-        !!                2.*sum_dth(i)/(hw0(i)*dthmin(i))
-        !! print *,'wake, sum_half_dth(i), sum_dth(i) ', &
-        !!                sum_half_dth(i), sum_dth(i)
-        IF ((hw0(i) < 1.) .or. (dthmin(i) >= -delta_t_min) ) THEN
-          wape2(i) = -1.
-          !! print *,'wake, rej 1'
-        ELSE IF (iflag_wk_check_trgl==1.AND.abs(2.*sum_dth(i)/(hw0(i)*dthmin(i)) - 1.) > 0.5) THEN
-          wape2(i) = -1.
-          !! print *,'wake, rej 2'
-        ELSE IF (abs(sum_half_dth(i)) < 0.5*abs(sum_dth(i)) ) THEN
-          wape2(i) = -1.
-          !! print *,'wake, rej 3'
-        END IF
-      END IF
-    END DO
-  END IF
-
-
-  DO k = 1, klev
-    DO i = 1, klon
-      ! cc nrlmd        IF ( wk_adv(i) .AND. wape2(i) .LT. 0.) THEN
-      IF (ok_qx_qw(i) .AND. wape2(i)<0.) THEN
-        ! cc
-        deltatw(i, k) = 0.
-        deltaqw(i, k) = 0.
-        dth(i, k) = 0.
-        d_deltatw2(i,k) = -deltatw0(i,k)
-        d_deltaqw2(i,k) = -deltaqw0(i,k)
-#ifdef ISO
-        do ixt=1,ntraciso
-          deltaxtw(ixt,i,k) = 0.
-          d_deltaxtw2(ixt,i,k) = -deltaxtw0(ixt,i,k)
-        enddo !do ixt=1,ntraciso
-#endif
-      END IF
-    END DO
-  END DO
-
-
-  DO i = 1, klon
-    ! cc nrlmd       IF ( wk_adv(i)) THEN
-    IF (ok_qx_qw(i)) THEN
-      ! cc
-      IF (wape2(i)<0.) THEN
-        wape2(i) = 0.
-        cstar2(i) = 0.
-        hw(i) = hwmin
-!jyg<
-!!      sigmaw(i) = amax1(sigmad, sigd_con(i))
-      sigmaw_targ = max(sigmad, sigd_con(i))
-      d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
-      sigmaw(i) = sigmaw_targ
-!>jyg
-        fip(i) = 0.
-        gwake(i) = .FALSE.
-      ELSE
-        IF (prt_level>=10) PRINT *, 'wape2>0'
-        cstar2(i) = stark*sqrt(2.*wape2(i))
-        gwake(i) = .TRUE.
-      END IF
-    END IF
-  END DO
-
-  DO i = 1, klon
-    ! cc nrlmd       IF ( wk_adv(i)) THEN
-    IF (ok_qx_qw(i)) THEN
-      ! cc
-      ktopw(i) = ktop(i)
-    END IF
-  END DO
-
-  DO i = 1, klon
-    ! cc nrlmd       IF ( wk_adv(i)) THEN
-    IF (ok_qx_qw(i)) THEN
-      ! cc
-      IF (ktopw(i)>0 .AND. gwake(i)) THEN
-
-        ! jyg1     Utilisation d'un h_efficace constant ( ~ feeding layer)
-        ! cc       heff = 600.
-        ! Utilisation de la hauteur hw
-        ! c       heff = 0.7*hw
-        heff(i) = hw(i)
-
-        fip(i) = 0.5*rho(i, ktopw(i))*cstar2(i)**3*heff(i)*2* &
-          sqrt(sigmaw(i)*wdens(i)*3.14)
-        fip(i) = alpk*fip(i)
-        ! jyg2
-      ELSE
-        fip(i) = 0.
-      END IF
-    END IF
-  END DO
-
-  ! Limitation de sigmaw
-
-  ! cc nrlmd
-  ! DO i=1,klon
-  ! IF (OK_qx_qw(i)) THEN
-  ! IF (sigmaw(i).GE.sigmaw_max) sigmaw(i)=sigmaw_max
-  ! ENDIF
-  ! ENDDO
-  ! cc
-
-  !jyg<
-  IF (iflag_wk_pop_dyn >= 1) THEN
-    DO i = 1, klon
-      kill_wake(i) = ((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
-          .NOT. ok_qx_qw(i) .OR. (wdens(i) < 2.*wdensmin)
-    ENDDO
-  ELSE  ! (iflag_wk_pop_dyn >= 1)
-    DO i = 1, klon
-      kill_wake(i) = ((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
-          .NOT. ok_qx_qw(i)
-    ENDDO
-  ENDIF  ! (iflag_wk_pop_dyn >= 1)
-  !>jyg
-
-  DO k = 1, klev
-    DO i = 1, klon
-!!jyg      IF (((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
-!!jyg          .NOT. ok_qx_qw(i)) THEN
-      IF (kill_wake(i)) THEN
-        ! cc
-        dtls(i, k) = 0.
-        dqls(i, k) = 0.
-        deltatw(i, k) = 0.
-        deltaqw(i, k) = 0.
-        d_deltatw2(i,k) = -deltatw0(i,k)
-        d_deltaqw2(i,k) = -deltaqw0(i,k)
-#ifdef ISO
-        do ixt=1,ntraciso
-          dxtls(ixt,i,k) = 0.
-          deltaxtw(ixt,i,k) = 0.
-          d_deltaxtw2(ixt,i,k) = -deltaxtw0(ixt,i,k)
-        enddo !do ixt=1,ntraciso
-#endif
-      END IF  ! (kill_wake(i))
-    END DO
-  END DO
-
-  DO i = 1, klon
-!!jyg    IF (((wape(i)>=wape2(i)) .AND. (wape2(i)<=wapecut)) .OR. (ktopw(i)<=2) .OR. &
-!!jyg        .NOT. ok_qx_qw(i)) THEN
-      IF (kill_wake(i)) THEN
-      ktopw(i) = 0
-      wape(i) = 0.
-      cstar(i) = 0.
-!!jyg   Outside subroutine "Wake" hw, wdens and sigmaw are zero when there are no wakes
-!!      hw(i) = hwmin                       !jyg
-!!      sigmaw(i) = sigmad                  !jyg
-      hw(i) = 0.                            !jyg
-      fip(i) = 0.
-!!      sigmaw(i) = 0.                        !jyg
-      sigmaw_targ = 0.
-      d_sigmaw2(i) = d_sigmaw2(i) + sigmaw_targ - sigmaw(i)
-      sigmaw(i) = sigmaw_targ
-      IF (iflag_wk_pop_dyn >= 1) THEN
-!!        awdens(i) = 0.
-!!        wdens(i) = 0.
-        wdens_targ = 0.
-        d_wdens2(i) = wdens_targ - wdens(i)
-        wdens(i) = wdens_targ
-        wdens_targ = 0.
-        d_awdens2(i) = wdens_targ - awdens(i)
-        awdens(i) = wdens_targ
-      ENDIF  ! (iflag_wk_pop_dyn >= 1)
-    ELSE  ! (kill_wake(i))
-      wape(i) = wape2(i)
-      cstar(i) = cstar2(i)
-    END IF  ! (kill_wake(i))
-    ! c        print*,'wape wape2 ktopw OK_qx_qw =',
-    ! c     $          wape(i),wape2(i),ktopw(i),OK_qx_qw(i)
-  END DO
-
-  IF (prt_level>=10) THEN
-    PRINT *, 'wake-6, wape wape2 ktopw OK_qx_qw =', &
-                      wape(igout),wape2(igout),ktopw(igout),OK_qx_qw(igout)
-  ENDIF
-
-
-  ! -----------------------------------------------------------------
-  ! Get back to tendencies per second
-
-  DO k = 1, klev
-    DO i = 1, klon
-
-      ! cc nrlmd        IF ( wk_adv(i) .AND. k .LE. kupper(i)) THEN
-!jyg<
-!!      IF (ok_qx_qw(i) .AND. k<=kupper(i)) THEN
-      IF (ok_qx_qw(i)) THEN
-!>jyg
-        ! cc
-        dtls(i, k) = dtls(i, k)/dtime
-        dqls(i, k) = dqls(i, k)/dtime
-        d_deltatw2(i, k) = d_deltatw2(i, k)/dtime
-        d_deltaqw2(i, k) = d_deltaqw2(i, k)/dtime
-        d_deltat_gw(i, k) = d_deltat_gw(i, k)/dtime
-        ! c      print*,'k,dqls,omg,entr,detr',k,dqls(i,k),omg(i,k),entr(i,k)
-        ! c     $         ,death_rate(i)*sigmaw(i)
-#ifdef ISO
-        do ixt=1,ntraciso
-          dxtls(ixt,i, k) = dxtls(ixt,i, k)/dtime
-          d_deltaxtw2(ixt,i, k) = d_deltaxtw2(ixt,i, k)/dtime
-        enddo
-#endif
-      END IF
-    END DO
-  END DO
-!jyg<
-  DO i = 1, klon
-    d_sigmaw2(i) = d_sigmaw2(i)/dtime
-    d_awdens2(i) = d_awdens2(i)/dtime
-    d_wdens2(i) = d_wdens2(i)/dtime
-  ENDDO
-!>jyg
-
-
-
-  RETURN
-END SUBROUTINE wake
-
-SUBROUTINE wake_vec_modulation(nlon, nl, wk_adv, epsilon, qe, d_qe, deltaqw, &
-    d_deltaqw, sigmaw, d_sigmaw, alpha)
-  ! ------------------------------------------------------
-  ! D\'etermination du coefficient alpha tel que les tendances
-  ! corriges alpha*d_G, pour toutes les grandeurs G, correspondent
-  ! a une humidite positive dans la zone (x) et dans la zone (w).
-  ! ------------------------------------------------------
-  IMPLICIT NONE
-
-  ! Input
-  REAL qe(nlon, nl), d_qe(nlon, nl)
-  REAL deltaqw(nlon, nl), d_deltaqw(nlon, nl)
-  REAL sigmaw(nlon), d_sigmaw(nlon)
-  LOGICAL wk_adv(nlon)
-  INTEGER nl, nlon
-  ! Output
-  REAL alpha(nlon)
-  ! Internal variables
-  REAL zeta(nlon, nl)
-  REAL alpha1(nlon)
-  REAL x, a, b, c, discrim
-  REAL epsilon
-  ! DATA epsilon/1.e-15/
-  INTEGER i,k
-
-  DO k = 1, nl
-    DO i = 1, nlon
-      IF (wk_adv(i)) THEN
-        IF ((deltaqw(i,k)+d_deltaqw(i,k))>=0.) THEN
-          zeta(i, k) = 0.
-        ELSE
-          zeta(i, k) = 1.
-        END IF
-      END IF
-    END DO
-    DO i = 1, nlon
-      IF (wk_adv(i)) THEN
-        x = qe(i, k) + (zeta(i,k)-sigmaw(i))*deltaqw(i, k) + d_qe(i, k) + &
-          (zeta(i,k)-sigmaw(i))*d_deltaqw(i, k) - d_sigmaw(i) * &
-          (deltaqw(i,k)+d_deltaqw(i,k))
-        a = -d_sigmaw(i)*d_deltaqw(i, k)
-        b = d_qe(i, k) + (zeta(i,k)-sigmaw(i))*d_deltaqw(i, k) - &
-          deltaqw(i, k)*d_sigmaw(i)
-        c = qe(i, k) + (zeta(i,k)-sigmaw(i))*deltaqw(i, k) + epsilon
-        discrim = b*b - 4.*a*c
-        ! print*, 'x, a, b, c, discrim', x, a, b, c, discrim
-        IF (a+b>=0.) THEN !! Condition suffisante pour la positivité de ovap
-          alpha1(i) = 1.
-        ELSE
-          IF (x>=0.) THEN
-            alpha1(i) = 1.
-          ELSE
-            IF (a>0.) THEN
-              alpha1(i) = 0.9*min( (2.*c)/(-b+sqrt(discrim)),  &
-                                   (-b+sqrt(discrim))/(2.*a) )
-            ELSE IF (a==0.) THEN
-              alpha1(i) = 0.9*(-c/b)
-            ELSE
-              ! print*,'a,b,c discrim',a,b,c discrim
-              alpha1(i) = 0.9*max( (2.*c)/(-b+sqrt(discrim)),  &
-                                   (-b+sqrt(discrim))/(2.*a))
-            END IF
-          END IF
-        END IF
-        alpha(i) = min(alpha(i), alpha1(i))
-      END IF
-    END DO
-  END DO
-
-  RETURN
-END SUBROUTINE wake_vec_modulation
-
-
-
-
Index: DZ6/branches/LMDZ_ECRad/libf/phylmdiso/wake_ini_mod.F90
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/libf/phylmdiso/wake_ini_mod.F90	(revision 4726)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/wake_ini_mod.F90
Index: /LMDZ6/branches/LMDZ_ECRad/makelmdz
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/makelmdz	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/makelmdz	(revision 4727)
@@ -17,4 +17,9 @@
 couple=false
 veget=false
+inlandsis=false
+rrtm=false
+rad="oldrad"
+dust=false
+strataer=false
 chimie=false
 parallel=none
@@ -27,9 +32,5 @@
 cosp2=false
 cospv2=false
-inlandsis=false
-rrtm=false
-rad=""
-dust=false
-strataer=false
+
 full=""
 
@@ -110,10 +111,10 @@
 [-p PHYS]                  : set of physical parametrizations (in libf/phyPHYS), (default: lmd)
 [-prod / -dev / -debug]    : compilation mode production (default) / developement / debug
-[-c false/MPI1/MPI2]       : coupling with ocean model : MPI1/MPI2/false (default: false)
+[-c false/MPI1/OMCT]       : coupling with ocean model : MPI1/OMCT/false (default: false)
 [-v false/orchideetrunk/orchidee2.1/orchidee2.0/orchidee1.9] : version of the vegetation model to include (default: false)
           false       : no vegetation model
           orchideetrunk : compile using ORCHIDEE trunk from revision 7757 or higher
           orchidee2.1 : compile using ORCHIDEE 2.1 until 4.1 included or until revision 7757 on the trunk
-          orchidee2.0 : compile using ORCHIDEE 2.0 (or more recent version)
+          orchidee2.0 : compile using ORCHIDEE 2.0
           orchidee1.9 : compile using ORCHIDEE up to the version including OpenMP in ORCHIDEE : tag 1.9-1.9.5(version AR5)-1.9.6
           true        : (obsolete; for backward compatibility) use ORCHIDEE tag 1.9-1.9.6
@@ -125,6 +126,6 @@
 [-rrtm true/false]    : compile with/without rrtm package (default: false)
 [-rad oldrad/rrtm/ecrad]    : compile with oldrad/rrtm/ecrad radiatif code (default: oldrad)
-[-dust true/false]    : compile with/without the dust package from Boucher et al. (default: false)
-[-strataer true/false]    : compile with/without the strat aer package from Boucher et al. (default: false)
+[-dust true/false]    : compile with/without the dust package by Boucher and co (default: false)
+[-strataer true/false]    : compile with/without the strat aer package by Boucher and co (default: false)
 [-parallel none/mpi/omp/mpi_omp] : parallelism (default: none) : mpi, openmp or mixted mpi_openmp
 [-g GRI]                   : grid configuration in dyn3d/GRI_xy.h  (default: reg, inclues a zoom)
@@ -135,6 +136,6 @@
 [-mem]                     : reduced memory dynamics (obsolete flag; always on in parallel mode)
 [-filtre NOMFILTRE]        : use filtre from libf/NOMFILTRE (default: filtrez)
-[-full]                    : Full (re)compilation (from scratch)
 [-link LINKS]              : additional links with other libraries
+[-full]                    : full recompiling 
 [-fcm_path path]           : path to the fcm tool (default: tools/fcm/bin)
 [-ext_src path]            : path to an additional set of routines to compile with the model
@@ -171,25 +172,4 @@
 	  veget="$2" ; shift ; shift ;;
 
-      "-chimie")
-	  chimie="$2" ; shift ; shift ;;
-
-      "-parallel")
-	  parallel="$2" ; shift ; shift ;;
-      
-      "-include")
-	  INCLUDE="$INCLUDE -I$2" ; shift ; shift ;;
-
-      "-cpp")
-	  CPP_KEY="$CPP_KEY $2" ; shift ; shift ;;
-
-      "-cosp")
-          cosp="$2" ; shift ; shift ;;
-
-      "-cosp2")
-          cosp2="$2" ; shift ; shift ;;
-
-      "-cosp2")
-          cospv2="$2" ; shift ; shift ;;
-      
       "-inlandsis")
           inlandsis="$2" ; shift ; shift ;;  
@@ -207,4 +187,25 @@
           strataer="$2" ; shift ; shift ;;
       
+      "-chimie")
+	  chimie="$2" ; shift ; shift ;;
+
+      "-parallel")
+	  parallel="$2" ; shift ; shift ;;
+      
+      "-include")
+	  INCLUDE="$INCLUDE -I$2" ; shift ; shift ;;
+
+      "-cpp")
+	  CPP_KEY="$CPP_KEY $2" ; shift ; shift ;;
+
+      "-cosp")
+          cosp="$2" ; shift ; shift ;;
+
+      "-cosp2")
+          cosp2="$2" ; shift ; shift ;;
+
+      "-cospv2")
+          cospv2="$2" ; shift ; shift ;;
+      
       "-mem")
           echo "option -mem is obsolete (now always on in parallel)"
@@ -214,15 +215,15 @@
 	  filtre=$2 ; shift ; shift ;;
 
+      "-link")
+	  LIB="$LIB $2" ; shift ; shift ;;
+
+      "-fcm_path")
+	  fcm_path=$2 ; shift ; shift ;;
+
+      "-ext_src")
+	  EXT_SRC=$2 ; src_dirs="$src_dirs $EXT_SRC" ; shift ; shift ;;
+
       "-full")
       full="full" ; shift ;;
-
-      "-link")
-	  LIB="$LIB $2" ; shift ; shift ;;
-
-      "-fcm_path")
-	  fcm_path=$2 ; shift ; shift ;;
-
-      "-ext_src")
-	  EXT_SRC=$2 ; src_dirs="$src_dirs $EXT_SRC" ; shift ; shift ;;
 
       "-arch")
@@ -364,8 +365,8 @@
    lib_phy='-lphy'"$physique"' -lphy_common'
    CPP_KEY="$CPP_KEY CPP_PHYS"
-   if [[ $phys_root == "lmd" ]]
-      then
-      #For lmd physics, default planet type is Earth
-      CPP_KEY="$CPP_KEY CPP_EARTH"
+   if [[ "${phys_root}" == "lmd" ]]
+   then
+   #For lmd physics, default planet type is Earth
+   CPP_KEY="$CPP_KEY CPP_EARTH"
    fi
 fi
@@ -475,7 +476,37 @@
 fi
 
+if [[ "$inlandsis" == "true" ]]
+then
+   CPP_KEY="$CPP_KEY CPP_INLANDSIS"
+   src_dirs="$src_dirs phy${physique}/inlandsis"
+fi
+
+
+if [[ "$rad" == "rrtm" ]]
+then
+   CPP_KEY="$CPP_KEY CPP_RRTM"
+   src_dirs="$src_dirs phy${physique}/rrtm"
+fi
+if [[ "$rad" == "ecrad" ]]
+then
+   CPP_KEY="$CPP_KEY CPP_ECRAD"
+   src_dirs="$src_dirs phy${physique}/ecrad"
+fi
+
+if [[ "$dust" == "true" ]]
+then
+   CPP_KEY="$CPP_KEY CPP_Dust"
+   src_dirs="$src_dirs phy${physique}/Dust"
+fi
+
+if [[ "$strataer" == "true" ]]
+then
+   CPP_KEY="$CPP_KEY CPP_StratAer"
+   src_dirs="$src_dirs phy${physique}/StratAer"
+fi
+
 #===============================================================================
-INCLUDE="$INCLUDE -I${NETCDF95_INCDIR}"
-LIB="$LIB -L${NETCDF95_LIBDIR} -l${LIBPREFIX}netcdf95"
+INCLUDE="$INCLUDE ${NETCDF95_INCDIR}"
+LIB="$LIB ${NETCDF95_LIBDIR} -l${LIBPREFIX}netcdf95"
 
 if [[ $io == ioipsl ]]
@@ -524,33 +555,4 @@
 
 
-if [[ "$inlandsis" == "true" ]]
-then
-   CPP_KEY="$CPP_KEY CPP_INLANDSIS"
-   src_dirs="$src_dirs phy${physique}/inlandsis"
-fi
-
-
-if [[ "$rad" == "rrtm" ]]
-then
-   CPP_KEY="$CPP_KEY CPP_RRTM"
-   src_dirs="$src_dirs phy${physique}/rrtm"
-fi
-if [[ "$rad" == "ecrad" ]]
-then
-   CPP_KEY="$CPP_KEY CPP_ECRAD"
-   src_dirs="$src_dirs phy${physique}/ecrad"
-fi
-
-if [[ "$dust" == "true" ]]
-then
-   CPP_KEY="$CPP_KEY CPP_Dust"
-   src_dirs="$src_dirs phy${physique}/Dust"
-fi
-
-if [[ "$strataer" == "true" ]]
-then
-   CPP_KEY="$CPP_KEY CPP_StratAer"
-   src_dirs="$src_dirs phy${physique}/StratAer"
-fi
 
 #add new ocean skin modelisation to source dir by default
@@ -804,39 +806,5 @@
 # Execution du make
 #################################################################
-echo $makecommand RANLIB=$ranlib -f $LMDGCM/makefile \
-OPTION_DEP="$opt_dep" OPTION_LINK="$LIB ${PARA_LD}" \
-OPTIM90="${COMPIL_FFLAGS} ${PARA_FFLAGS}" \
-OPTIMTRU90="${COMPIL_FFLAGS} ${PARA_FFLAGS}" \
-OPTIM="${COMPIL_FFLAGS} ${PARA_FFLAGS}" \
-INCLUDE="$INCLUDE" \
-$filtre \
-LIBO=${LIBOGCM}/${nomlib} \
-"PHYS=$physique" \
-LIBPHY=${LIBPHY} \
-LIBPHY_COMMON=${LIBPHY_COMMON} \
-LIBDYN_PHYS=${LIBDYN_PHYS} \
-DIM=$dimc \
-FLAG_PARA=$FLAG_PARA \
-L_PHY="$lib_phy" \
-L_DYN_PHY="$libdyn_phy" \
-L_ADJNT=$adjnt \
-L_COSP="$lcosp" \
-L_COSP2="$lcosp2" \
-L_COSPV2="$lcospv2" \
-L_CHIMIE="$libchimie" \
-LOCAL_DIR="$localdir"  \
-F77="$fcompiler" \
-F90="$fcompiler" \
-OPLINK="$LIB" \
-LINK="$linker" \
-GCM="$LMDGCM" \
-MOD_LOC_DIR=$mod_loc_dir \
-MOD_SUFFIX="mod" \
-AR=$arcommand \
-ARFLAGS="$arflags" \
-DIRMAIN=$dirmain \
-SOURCE=$source_code \
-PROG=$code
-
+set -v
 $makecommand RANLIB=$ranlib -f $LMDGCM/makefile \
 OPTION_DEP="$opt_dep" OPTION_LINK="$LIB ${PARA_LD}" \
@@ -874,4 +842,5 @@
 PROG=$code
 
+set +v
 
 if [[ -r $LIBFGCM/grid/dimensions.h ]]
Index: /LMDZ6/branches/LMDZ_ECRad/tools/compare_real.py
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/tools/compare_real.py	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/tools/compare_real.py	(revision 4727)
@@ -1,5 +1,6 @@
+#!/usr/bin/env python3
+
 """This script should be called by "diffdef.sh". It operates on
-different lines with common variables. It requires version 2.7 or
-higher of Python (it also works with Python 3).
+different lines with common variables.
 
 Author: Lionel GUEZ"""
Index: /LMDZ6/branches/LMDZ_ECRad/tools/diffdef.sh
===================================================================
--- /LMDZ6/branches/LMDZ_ECRad/tools/diffdef.sh	(revision 4726)
+++ /LMDZ6/branches/LMDZ_ECRad/tools/diffdef.sh	(revision 4727)
@@ -2,6 +2,6 @@
 # Author: Lionel GUEZ
 
-# This script compares files "*.def" other than "*traceur.def" and
-# "out.def" in two directories.
+# This script compares files "*.def" other than "traceur.def",
+# "tracer.def", "isotopes_params.def" and "out.def" in two directories.
 
 # This script uses GNU versions of the utilities cut, sort and uniq,
@@ -9,10 +9,10 @@
 
 # See guide:
-# http://lmdz.lmd.jussieu.fr/utilisateurs/outils/utilisation-de-lmdz#section-5
+# http://lmdz.lmd.jussieu.fr/utilisateurs/utilisation-de-lmdz#section-5
 
 USAGE="usage: `basename $0` directory_1 directory_2"
 
 if (($# != 2))
-    then
+then
     echo "$USAGE" >&2
     exit 1
@@ -20,13 +20,4 @@
 
 ##set -x
-
-type python3 >/dev/null 2>&1
-if (($? == 0))
-then
-    my_python=python3
-else
-    my_python=python
-fi
-
 set -e
 
@@ -40,42 +31,44 @@
 
 for my_directory in $*
-  do
-  cd $my_directory
-  rm -f all.def
-  echo "def files in $my_directory:"
-  ls !(*traceur|out).def
+do
+    cd $my_directory
+    rm -f all.def
+    echo "def files in $my_directory:"
+    ls !(traceur|tracer|out|isotopes_params).def
 
-  # Concatenate and format the def files:
-  cat !(*traceur|out).def | tr '\r' '\n' | tr -d " " \
-      | grep -v -E '(^#|^!|INCLUDEDEF|^$)' \
-      | tr '[:lower:]' '[:upper:]' | sed 's/=[NF]$/=FALSE/' \
-      | sed 's/=[YT]$/=TRUE/' | sort >all.def
+    # Concatenate and format the def files:
+    cat !(traceur|tracer|out|isotopes_params).def | tr -d " \t" \
+	| grep -v -E '(^#|^!|INCLUDEDEF|^$)' \
+	| tr '[:lower:]' '[:upper:]' | sed 's/=[NF]$/=FALSE/' \
+	| sed 's/=[YT]$/=TRUE/' | sort >all.def
 
-  # Check that no variable is repeated:
-  cut --fields=1 --delimiter="=" all.def | uniq --repeated >plouf_$$
-  if [[ -s plouf_$$ ]]
-      then
-      echo
-      echo "Error: a variable is repeated in directory \"$my_directory\"."
-      echo
-      echo "Here is the list of repeated variables in directory \"$my_directory\":"
-      echo
-      cat plouf_$$
-      rm plouf_$$
-      rm all.def
-      exit 1
-  fi
-  rm plouf_$$
-
-  cd - >/dev/null
+    # Check that no variable is repeated:
+    
+    cut --fields=1 --delimiter="=" all.def | uniq --repeated >plouf_$$
+    
+    if [[ -s plouf_$$ ]]
+    then
+	echo
+	echo "Error: a variable is repeated in directory \"$my_directory\"."
+	echo
+	echo "Here is the list of repeated variables in directory " \
+	     "\"$my_directory\":"
+	echo
+	cat plouf_$$
+	rm plouf_$$
+	rm all.def
+	exit 1
+    fi
+    
+    rm plouf_$$
+    cd - >/dev/null
 done
-
 
 sort $1/all.def $2/all.def | uniq --repeated >common_lines
 
 for my_directory in $*
-  do
-  sort $my_directory/all.def common_lines | uniq --unique \
-      >$my_directory/uniq_lines
+do
+    sort $my_directory/all.def common_lines | uniq --unique \
+						   >$my_directory/uniq_lines
 done
 
@@ -86,13 +79,13 @@
 
 for my_directory in $*
-  do
-  cd $my_directory
-  echo "Created file \"$my_directory/uniq_var\"."
-  sort uniq_lines uniq_var | uniq --unique >common_var
-  rm uniq_lines
-  cd - >/dev/null
+do
+    cd $my_directory
+    echo "Created file \"$my_directory/uniq_var\"."
+    sort uniq_lines uniq_var | uniq --unique >common_var
+    rm uniq_lines
+    cd - >/dev/null
 done
 
-$my_python $script_dir/compare_real.py $*
+$script_dir/compare_real.py $*
 sort common_lines --output=common_lines # was modified by the Python script
 echo "Created files \"./common_lines\" and \"./uniq_val\"."
@@ -100,5 +93,5 @@
 # Clean up:
 for my_directory in $*
-  do
+do
     rm $my_directory/common_var $my_directory/all.def
 done
