Index: /LMDZ6/branches/cirrus/DefLists/README
===================================================================
--- /LMDZ6/branches/cirrus/DefLists/README	(revision 5201)
+++ /LMDZ6/branches/cirrus/DefLists/README	(revision 5202)
@@ -16,2 +16,4 @@
 physiq.def_NPv6.4          NPv6.3 without 2 CM6A bugs
 physiq.def_LUDOBest2       Ludovic' physic tuned by Frederic 
+physiq.def_NPv7.0.1b       Physique Ludovic debuguee + condensation grande echelle epuree E.Vignon
+physiq.def_NPv7.0.1c       physiq.def_NPv7.0.1b + ok_bug_ajs_cv=n
Index: /LMDZ6/branches/cirrus/DefLists/context_input_lmdz_xios3.xml
===================================================================
--- /LMDZ6/branches/cirrus/DefLists/context_input_lmdz_xios3.xml	(revision 5201)
+++ /LMDZ6/branches/cirrus/DefLists/context_input_lmdz_xios3.xml	(revision 5202)
@@ -13,6 +13,6 @@
        <field id="landice"      field_ref="landice_reg" domain_ref="from_landiceref"  />
        <field id="mask"         field_ref="mask_reg"    domain_ref="from_relief" />
-       <field id="sic_limit"    field_ref="sic_reg"     domain_ref="from_limit_amip"  />
-       <field id="sst_limit"    field_ref="sst_reg"     domain_ref="from_limit_amip" />
+       <field id="sic_limit"    field_ref="sic_reg"     axis_ref="time_sic"  domain_ref="from_limit_amip"  />
+       <field id="sst_limit"    field_ref="sst_reg"     axis_ref="time_sst" domain_ref="from_limit_amip" />
        <field id="rugos_limit"  field_ref="rugos_reg"   domain_ref="from_limit" > exp(this) </field>
        <field id="albedo_limit" field_ref="albedo_reg"  domain_ref="from_limit"  />
@@ -59,9 +59,9 @@
 <!-- Case with amip files --> 
       <file id="amipbc_sic_1x1" name="amipbc_sic_1x1" >
-        <field id="sic_reg" name="sicbcs" domain_ref="domain_limit_amip" axis_ref="time_sic" operation="instant" freq_offset="1ts"/>
+        <field id="sic_reg" name="sicbcs" domain_ref="domain_limit_amip" axis_ref="time_sic_read" operation="instant" freq_offset="1ts"/>
       </file>
  
       <file id="amipbc_sst_1x1" name="amipbc_sst_1x1" >
-         <field id="sst_reg" name="tosbcs" domain_ref="domain_limit_amip" axis_ref="time_sst" operation="instant" freq_offset="1ts">this+273.15</field> 
+         <field id="sst_reg" name="tosbcs" domain_ref="domain_limit_amip" axis_ref="time_sst_read" operation="instant" freq_offset="1ts">this+273.15</field> 
       </file>
 
@@ -69,9 +69,9 @@
 <!--  
       <file id="siconc" name="hadisst_siconc" >
-        <field id="sic_reg" name="sicbcs" domain_ref="domain_limit_amip" axis_ref="time_sic" operation="instant" freq_offset="1ts"/>
+        <field id="sic_reg" name="sicbcs" domain_ref="domain_limit_amip" axis_ref="time_sic_read" operation="instant" freq_offset="1ts"/>
       </file>
  
       <file id="tos" name="hadisst_tos" >
-         <field id="sst_reg" name="tosbcs" domain_ref="domain_limit_amip" axis_ref="time_sst" operation="instant" freq_offset="1ts">this+273.15</field> 
+         <field id="sst_reg" name="tosbcs" domain_ref="domain_limit_amip" axis_ref="time_sst_read" operation="instant" freq_offset="1ts">this+273.15</field> 
       </file>
 -->
@@ -144,6 +144,8 @@
 
   <axis_definition>
-    <axis id="time_sic"/>
-    <axis id="time_sst"/>
+    <axis id="time_sic_read"/>
+    <axis id="time_sst_read"/>
+    <axis id="time_sic" axis_ref="sic_reg::"/>
+    <axis id="time_sst" axis_ref="sst_reg::"/>
   </axis_definition>
 
Index: /LMDZ6/branches/cirrus/DefLists/field_def_lmdz.xml
===================================================================
--- /LMDZ6/branches/cirrus/DefLists/field_def_lmdz.xml	(revision 5201)
+++ /LMDZ6/branches/cirrus/DefLists/field_def_lmdz.xml	(revision 5202)
@@ -210,5 +210,5 @@
         <field id="flat_x"    long_name="flat off-wake"    unit="W/m2" />
         <field id="flat_w"    long_name="flat within-wake"    unit="W/m2" />
-        <field id="delta_tsurf"    long_name="Temperature difference (w-x)"    unit="K" enabled="false" /> <!-- ym --field disabled-- delta_tsurf is not conform to the associated grid (the is an arry containing all sub_surface) --> 
+        <field id="delta_tsurf"    long_name="Temperature difference (w-x)"    unit="K" enabled="false" /> <!-- ym -field disabled- delta_tsurf is not conform to the associated grid (the is an arry containing all sub_surface) --> 
         <field id="cdragh_x"    long_name="cdragh off-wake"    unit="-" />
         <field id="cdragh_w"    long_name="cdragh within-wake"    unit="-" />
@@ -223,4 +223,5 @@
         <field id="fqfonte"    long_name="Land ice melt"    unit="kg/m2/s" />
         <field id="runofflic"  long_name="Land ice melt to ocean" unit="kg/m2/s" />
+        <field id="runoffland" long_name="Runoff to ocean" unit="kg/m2/s" />
         <field id="mrroli"  long_name="Runoff flux over land ice" unit="kg/m2/s" />
         <field id="taux"    long_name="Zonal wind stress"    unit="Pa" />
@@ -587,9 +588,71 @@
         <field id="taur" long_name="momentum flux due to rain" 	       unit="Pa" 	       detect_missing_value=".true." />
         <field id="SSS" long_name="bulk sea-surface salinity" unit="ppt" detect_missing_value=".true." />
-    </field_group>
+            <!-- Begin Added SN isotopes 2D fields 07 2023 -->
+            <!-- water oxygen H216O H217O H218O -->
+     <field_group id="iso2D_H216O" enabled="False" > <!-- H216O -->
+        <field id="precipH216O" long_name="Precip Totale liq+sol" unit="kg/(s*m2)" />
+        <field id="plulH216O"   long_name="Large-scale Precip."   unit="kg/(s*m2)" />
+        <field id="plucH216O"   long_name="Convective Precip."    unit="kg/(s*m2)" />
+        <field id="runofflandH216O" long_name="Runoff to ocean"   unit="kg/(s*m2)" /> 
+        <field id="evapH216O"   long_name="Evaporat."             unit="kg/(s*m2)" />
+        <field id="evap_terH216O"  long_name="evaporation at surface ter"    unit="kg/(s*m2)" />
+        <field id="evap_licH216O"  long_name="evaporation at surface lic"    unit="kg/(s*m2)" />
+        <field id="evap_oceH216O"  long_name="evaporation at surface oce"    unit="kg/(s*m2)" />
+        <field id="evap_sicH216O"  long_name="evaporation at surface sic"    unit="kg/(s*m2)" />
+     </field_group>
+     <field_group id="iso2D_H217O" enabled="False" > <!-- H217O -->
+        <field id="precipH217O" long_name="Precip Totale liq+sol" unit="kg/(s*m2)" />
+        <field id="plulH217O"   long_name="Large-scale Precip."   unit="kg/(s*m2)" />
+        <field id="plucH217O"   long_name="Convective Precip."    unit="kg/(s*m2)" />
+        <field id="runofflandH217O" long_name="Runoff to ocean"   unit="kg/(s*m2)" /> 
+        <field id="evapH217O"   long_name="Evaporat."             unit="kg/(s*m2)" />
+        <field id="evap_terH217O"  long_name="evaporation at surface ter"    unit="kg/(s*m2)" />
+        <field id="evap_licH217O"  long_name="evaporation at surface lic"    unit="kg/(s*m2)" />
+        <field id="evap_oceH217O"  long_name="evaporation at surface oce"    unit="kg/(s*m2)" />
+        <field id="evap_sicH217O"  long_name="evaporation at surface sic"    unit="kg/(s*m2)" />
+     </field_group>
+     <field_group id="iso2D_H218O" enabled="False" > <!-- H218O -->
+        <field id="precipH218O" long_name="Precip Totale liq+sol" unit="kg/(s*m2)" />
+        <field id="plulH218O"   long_name="Large-scale Precip."   unit="kg/(s*m2)" />
+        <field id="plucH218O"   long_name="Convective Precip."    unit="kg/(s*m2)" />
+        <field id="runofflandH218O" long_name="Runoff to ocean"   unit="kg/(s*m2)" />
+        <field id="evapH218O"   long_name="Evaporat."             unit="kg/(s*m2)" />
+        <field id="evap_terH218O"  long_name="evaporation at surface ter"    unit="kg/(s*m2)" />
+        <field id="evap_licH218O"  long_name="evaporation at surface lic"    unit="kg/(s*m2)" />
+        <field id="evap_oceH218O"  long_name="evaporation at surface oce"    unit="kg/(s*m2)" />
+        <field id="evap_sicH218O"  long_name="evaporation at surface sic"    unit="kg/(s*m2)" />
+    </field_group>
+            <!-- water hydrogen HDO HTO -->
+    <field_group id="iso2D_HDO" enabled="False" > <!-- HDO -->
+        <field id="precipHDO" long_name="Precip Totale liq+sol" unit="kg/(s*m2)" />
+        <field id="plulHDO"   long_name="Large-scale Precip."   unit="kg/(s*m2)" />
+        <field id="plucHDO"   long_name="Convective Precip."    unit="kg/(s*m2)" />
+        <field id="runofflandHDO" long_name="Runoff to ocean"   unit="kg/(s*m2)" />
+        <field id="evapHDO"   long_name="Evaporat."             unit="kg/(s*m2)" />
+        <field id="evap_terHDO"  long_name="evaporation at surface ter"    unit="kg/(s*m2)" />
+        <field id="evap_licHDO"  long_name="evaporation at surface lic"    unit="kg/(s*m2)" />
+        <field id="evap_oceHDO"  long_name="evaporation at surface oce"    unit="kg/(s*m2)" />
+        <field id="evap_sicHDO"  long_name="evaporation at surface sic"    unit="kg/(s*m2)" />
+    </field_group>
+    <field_group id="iso2D_HTO" enabled="False" > <!-- HTO -->
+        <field id="precipHTO" long_name="Precip Totale liq+sol" unit="kg/(s*m2)" />
+        <field id="plulHTO"   long_name="Large-scale Precip."   unit="kg/(s*m2)" />
+        <field id="plucHTO"   long_name="Convective Precip."    unit="kg/(s*m2)" />
+        <field id="runofflandHTO" long_name="Runoff to ocean"   unit="kg/(s*m2)" />
+        <field id="evapHTO"   long_name="Evaporat."             unit="kg/(s*m2)" />
+        <field id="evap_terHTO"  long_name="evaporation at surface ter"    unit="kg/(s*m2)" />
+        <field id="evap_licHTO"  long_name="evaporation at surface lic"    unit="kg/(s*m2)" />
+        <field id="evap_oceHTO"  long_name="evaporation at surface oce"    unit="kg/(s*m2)" />
+        <field id="evap_sicHTO"  long_name="evaporation at surface sic"    unit="kg/(s*m2)" />
+   </field_group>
+          <!-- end Added SN isotopes 2D fields 07 2023 -->
+   </field_group>
 
     <field_group id="fields_3D" grid_ref="grid_glo_presnivs" >
         <field id="tke"    long_name="TKE"    unit="m2/s2" />
 	<field id="tke_dissip" long_name="TKE DISSIPATION" unit="m2/s3" />
+	<field id="tke_buoy" long_name="TKE Buoyancy term" unit="m2/s3" />
+	<field id="tke_shear" long_name="TKE Shear term" unit="m2/s3" />
+    <field id="tke_trans" long_name="TKE Transport term" unit="m2/s3" />
         <field id="tke_ter"    long_name="Max Turb. Kinetic Energy ter"    unit="m2/s2" />
         <field id="tke_lic"    long_name="Max Turb. Kinetic Energy lic"    unit="m2/s2" />
@@ -600,5 +663,20 @@
         <field id="tke_max_oce"    long_name="Max Turb. Kinetic Energy oce"    unit="m2/s2" operation="maximum"/>
         <field id="tke_max_sic"    long_name="Max Turb. Kinetic Energy sic"    unit="m2/s2" operation="maximum"/>
-        <field id="l_mix_ter"    long_name="PBL mixing length ter"    unit="m" />
+	
+	<field id="qrain_lsc"    long_name="LS specific rain content"    unit="kg/kg" />
+	<field id="qsnow_lsc"    long_name="LS specific snow content"    unit="kg/kg" />
+	<field id="dqreva"    long_name="LS rain tendency due to evaporation"    unit="kg/kg/s" />
+	<field id="dqssub"    long_name="LS snow tendency due to sublimation"    unit="kg/kg/s" />
+	<field id="dqrauto"    long_name="LS rain tendency due to autoconversion"    unit="kg/kg/s" />
+	<field id="dqrcol"    long_name="LS rain tendency due to collection"    unit="kg/kg/s" />
+	<field id="dqrmelt"    long_name="LS rain tendency due to melting"    unit="kg/kg/s" />
+	<field id="dqrfreez"    long_name="LS rain tendency due to freezing"    unit="kg/kg/s" />
+	<field id="dqsauto"    long_name="LS snow tendency due to autoconversion"    unit="kg/kg/s" />
+	<field id="dqsagg"    long_name="LS snow tendency due to aggregation"    unit="kg/kg/s" />
+	<field id="dqsrim"    long_name="LS snow tendency due to riming"    unit="kg/kg/s" />
+	<field id="dqsmelt"    long_name="LS snow tendency due to melting"    unit="kg/kg/s" />
+	<field id="dqsfreez"    long_name="LS snow tendency due to freezing"    unit="kg/kg/s" />
+
+	<field id="l_mix_ter"    long_name="PBL mixing length ter"    unit="m" />
         <field id="l_mix_lic"    long_name="PBL mixing length lic"    unit="m" />
         <field id="l_mix_oce"    long_name="PBL mixing length oce"    unit="m" />
@@ -645,5 +723,8 @@
         <field id="zfull"    long_name="Altitude of full pressure levels"    unit="m" />
         <field id="zhalf"    long_name="Altitude of half pressure levels"    unit="m" />
-        <field id="rneb"    long_name="Cloud fraction"    unit="-" />
+	<field id="rneb"    long_name="Cloud fraction"    unit="-" />
+	<field id="cldfraliq"    long_name="Fraction of liquid cloud"    unit="-" />
+        <field id="sigma2_icefracturb"    long_name="Variance of the diagnostic supersaturation distribution (icefrac_turb)"    unit="-" />
+        <field id="mean_icefracturb"     long_name="Mean of the diagnostic supersaturation distribution (icefrac_turb)"    unit="-" />
         <field id="rnebcon"    long_name="Convective Cloud Fraction"    unit="-" />
         <field id="rnebls"    long_name="LS Cloud fraction"    unit="-" />
@@ -835,5 +916,74 @@
 	<field id="fluxt"     long_name="flux h"     unit="W/m2" />
         <field id="fluxq"     long_name="flux q"     unit="-" />
-    </field_group>
+             <!-- Begin Added SN isotopes 3D fields 07 2023 -->
+             <!-- water oxygen H216O H217O H218O -->
+     <field_group id="iso3D_H216O" enabled="False" > <!-- H216O -->       
+        <field id="ovapH216O"   long_name="Specific humidity" unit="kg/kg" />
+        <field id="oliqH216O"   long_name="Liquid water"      unit="kg/kg" />
+        <field id="ocondH216O"  long_name="Condensed water"   unit="kg/kg" />
+        <field id="dqdynH216O"  long_name="Dynamics dQ"       unit="(kg/kg)/s" />
+        <field id="dqldynH216O" long_name="Dynamics dQL"      unit="(kg/kg)/s" />
+        <field id="dqconH216O"  long_name="Convection dQ"     unit="(kg/kg)/s" />
+        <field id="dqlscH216O"  long_name="Condensation dQ"   unit="(kg/kg)/s" />
+        <field id="dqevaH216O"  long_name="Reevaporation dQ"  unit="(kg/kg)/s" />
+        <field id="dqvdfH216O"  long_name="Boundary-layer dQ" unit="(kg/kg)/s" />
+        <field id="dqajsH216O"  long_name="Dry adjust. dQ"    unit="(kg/kg)/s" />
+        <field id="dqtheH216O"  long_name="Thermal dQ"        unit="(kg/kg)/s" />
+     </field_group>
+     <field_group id="iso3D_H217O" enabled="False" > <!-- H217O -->
+        <field id="ovapH217O"   long_name="Specific humidity" unit="kg/kg" />
+        <field id="oliqH217O"   long_name="Liquid water"      unit="kg/kg" />
+        <field id="ocondH217O"  long_name="Condensed water"   unit="kg/kg" />
+        <field id="dqdynH217O"  long_name="Dynamics dQ"       unit="(kg/kg)/s" />
+        <field id="dqldynH217O" long_name="Dynamics dQL"      unit="(kg/kg)/s" />
+        <field id="dqconH217O"  long_name="Convection dQ"     unit="(kg/kg)/s" />
+        <field id="dqlscH217O"  long_name="Condensation dQ"   unit="(kg/kg)/s" />
+        <field id="dqevaH217O"  long_name="Reevaporation dQ"  unit="(kg/kg)/s" />
+        <field id="dqvdfH217O"  long_name="Boundary-layer dQ" unit="(kg/kg)/s" />
+        <field id="dqajsH217O"  long_name="Dry adjust. dQ"    unit="(kg/kg)/s" />
+        <field id="dqtheH217O"  long_name="Thermal dQ"        unit="(kg/kg)/s" />
+     </field_group>
+     <field_group id="iso3D_H218O" enabled="False" > <!-- H218O -->
+        <field id="ovapH218O"   long_name="Specific humidity" unit="kg/kg" />
+        <field id="oliqH218O"   long_name="Liquid water"      unit="kg/kg" />
+        <field id="ocondH218O"  long_name="Condensed water"   unit="kg/kg" />
+        <field id="dqdynH218O"  long_name="Dynamics dQ"       unit="(kg/kg)/s" />
+        <field id="dqldynH218O" long_name="Dynamics dQL"      unit="(kg/kg)/s" />
+        <field id="dqconH218O"  long_name="Convection dQ"     unit="(kg/kg)/s" />
+        <field id="dqlscH218O"  long_name="Condensation dQ"   unit="(kg/kg)/s" />
+        <field id="dqevaH218O"  long_name="Reevaporation dQ"  unit="(kg/kg)/s" />
+        <field id="dqvdfH218O"  long_name="Boundary-layer dQ" unit="(kg/kg)/s" />
+        <field id="dqajsH218O"  long_name="Dry adjust. dQ"    unit="(kg/kg)/s" />
+        <field id="dqtheH218O"  long_name="Thermal dQ"        unit="(kg/kg)/s" />
+     </field_group>
+            <!-- water hydrogen HDO HTO -->
+     <field_group id="iso3D_HDO" enabled="False" > <!-- HDO -->
+        <field id="ovapHDO"   long_name="Specific humidity" unit="kg/kg" />
+        <field id="oliqHDO"   long_name="Liquid water"      unit="kg/kg" />
+        <field id="ocondHDO"  long_name="Condensed water"   unit="kg/kg" />
+        <field id="dqdynHDO"  long_name="Dynamics dQ"       unit="(kg/kg)/s" />
+        <field id="dqldynHDO" long_name="Dynamics dQL"      unit="(kg/kg)/s" />
+        <field id="dqconHDO"  long_name="Convection dQ"     unit="(kg/kg)/s" />
+        <field id="dqlscHDO"  long_name="Condensation dQ"   unit="(kg/kg)/s" />
+        <field id="dqevaHDO"  long_name="Reevaporation dQ"  unit="(kg/kg)/s" />
+        <field id="dqvdfHDO"  long_name="Boundary-layer dQ" unit="(kg/kg)/s" />
+        <field id="dqajsHDO"  long_name="Dry adjust. dQ"    unit="(kg/kg)/s" />
+        <field id="dqtheHDO"  long_name="Thermal dQ"        unit="(kg/kg)/s" />
+     </field_group>
+     <field_group id="iso3D_HTO" enabled="False" > <!-- HTO -->
+        <field id="ovapHTO"   long_name="Specific humidity" unit="kg/kg" />
+        <field id="oliqHTO"   long_name="Liquid water"      unit="kg/kg" />
+        <field id="ocondHTO"  long_name="Condensed water"   unit="kg/kg" />
+        <field id="dqdynHTO"  long_name="Dynamics dQ"       unit="(kg/kg)/s" />
+        <field id="dqldynHTO" long_name="Dynamics dQL"      unit="(kg/kg)/s" />
+        <field id="dqconHTO"  long_name="Convection dQ"     unit="(kg/kg)/s" />
+        <field id="dqlscHTO"  long_name="Condensation dQ"   unit="(kg/kg)/s" />
+        <field id="dqevaHTO"  long_name="Reevaporation dQ"  unit="(kg/kg)/s" />
+        <field id="dqvdfHTO"  long_name="Boundary-layer dQ" unit="(kg/kg)/s" />
+        <field id="dqajsHTO"  long_name="Dry adjust. dQ"    unit="(kg/kg)/s" />
+        <field id="dqtheHTO"  long_name="Thermal dQ"        unit="(kg/kg)/s" />
+     </field_group>
+             <!-- End Added SN isotopes 3D fields 07 2023 -->
+   </field_group>
 
     <field_group id="fields_3Dkp1" grid_ref="grid_glo_presinter" >
@@ -886,4 +1036,7 @@
         <field id="budg_3D_backgr_so2"   long_name="SO2 background tendency"                               unit="kg(S)/m2/layer/s" />
         <field id="R2SO4"                long_name="H2SO4 mass fraction in aerosol"                        unit="%" />
+        <field id="SAD_sulfate"                long_name="SAD WET sulfate aerosols"                        unit="cm2/cm3" />
+        <field id="reff_sulfate"                long_name="Effective	radius of WET sulfate aerosols"              unit="cm" />
+        <field id="sulfMMR"                long_name="Sulfate aerosol concentration (dry mass mixing ratio)"                        unit="kg(H2SO4)/kg(air)" />
         <field id="OCS_lifetime"         long_name="OCS lifetime"                                          unit="s" />
         <field id="SO2_lifetime"         long_name="SO2 lifetime"                                          unit="s" />
@@ -927,4 +1080,79 @@
         <field id="BIN35" long_name="Sulfur aersol bin" unit="kg kg-1" />
         <field id="BIN36" long_name="Sulfur aersol bin" unit="kg kg-1" />
+	
+	<field id="BIN01_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN02_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN03_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN04_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN05_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN06_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN07_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN08_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN09_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN10_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN11_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN12_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN13_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN14_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN15_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN16_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN17_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN18_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN19_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN20_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN21_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN22_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN23_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN24_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN25_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN26_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN27_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN28_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN29_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN30_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN31_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN32_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN33_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN34_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN35_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+        <field id="BIN36_nd_mode" long_name="Sulfur aersol bin" unit="kg kg-1" />
+	
+	<field id="BIN01_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN02_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN03_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN04_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN05_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN06_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN07_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN08_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN09_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN10_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN11_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN12_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN13_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN14_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN15_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN16_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN17_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN18_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN19_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN20_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN21_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN22_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN23_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN24_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN25_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN26_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN27_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN28_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN29_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN30_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN31_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN32_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN33_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN34_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN35_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+        <field id="BIN36_sulfmmr_mode" long_name="Dry sulfate MMR in bin" unit="kg(H2SO4)/kg(air)" />
+	
 	<field id="GASOCS"  long_name="Carbonyl sulfide gas" unit="kg kg-1" />
 	<field id="GASSO2"  long_name="Sulfur dioxide gas" unit="kg kg-1" />
Index: /LMDZ6/branches/cirrus/DefLists/file_def_histday_lmdz.xml
===================================================================
--- /LMDZ6/branches/cirrus/DefLists/file_def_histday_lmdz.xml	(revision 5201)
+++ /LMDZ6/branches/cirrus/DefLists/file_def_histday_lmdz.xml	(revision 5202)
@@ -2,5 +2,5 @@
 <file_definition type="one_file">
     <file_group id="defile">
-        <file id="histday" name="histday" output_freq="1d" output_level="_AUTO_" enabled="_AUTO_" compression_level="2" sync_freq="1d">
+        <file id="histday" name="histday" output_freq="1d" output_level="1" enabled=".TRUE." compression_level="0" sync_freq="1d">
             
             <!-- VARS 1D -->
@@ -131,4 +131,5 @@
                 <field field_ref="mrroli" level="10" />
                 <field field_ref="runofflic" level="10" />
+                <field field_ref="runoffland" level="1" /> 
                 <field field_ref="taux" level="10" />
                 <field field_ref="tauy" level="10" />
@@ -450,4 +451,53 @@
                 <field field_ref="dqthe2d" level="10" />
                 <field field_ref="dqajs2d" level="10" />
+            <!-- Begin Added SN isotopes 2D fields 07 2023 -->
+            <!-- water oxygen H216O H217O H218O -->
+                <field field_ref="precipH216O"     level="1" />
+                <field field_ref="plulH216O"       level="1" />
+                <field field_ref="plucH216O"       level="1" />
+                <field field_ref="runofflandH216O" level="1" />
+                <field field_ref="evapH216O"       level="1" />
+                <field field_ref="evap_terH216O"   level="1" />
+                <field field_ref="evap_licH216O"   level="1" />
+                <field field_ref="evap_oceH216O"   level="1" />
+                <field field_ref="evap_sicH216O"   level="1" />
+                <field field_ref="precipH217O"     level="1" />
+                <field field_ref="plulH217O"       level="1" />
+                <field field_ref="plucH217O"       level="1" />
+                <field field_ref="runofflandH217O" level="1" />
+                <field field_ref="evapH217O"       level="1" />
+                <field field_ref="evap_terH217O"   level="1" />
+                <field field_ref="evap_licH217O"   level="1" />
+                <field field_ref="evap_oceH217O"   level="1" />
+                <field field_ref="evap_sicH217O"   level="1" />
+                <field field_ref="precipH218O"     level="1" />
+                <field field_ref="plulH218O"       level="1" />
+                <field field_ref="plucH218O"       level="1" />
+                <field field_ref="runofflandH218O" level="1" />
+                <field field_ref="evapH218O"       level="1" />
+                <field field_ref="evap_terH218O"   level="1" />
+                <field field_ref="evap_licH218O"   level="1" />
+                <field field_ref="evap_oceH218O"   level="1" />
+                <field field_ref="evap_sicH218O"   level="1" />
+            <!-- water hydrogen HDO HTO -->
+                <field field_ref="precipHDO"    level="1" />
+                <field field_ref="plulHDO"      level="1" />
+                <field field_ref="plucHDO"      level="1" />
+                <field field_ref="runofflandHDO" level="1" />
+                <field field_ref="evapHDO"      level="1" />
+                <field field_ref="evap_terHDO"  level="1" />
+                <field field_ref="evap_licHDO"  level="1" />
+                <field field_ref="evap_oceHDO"  level="1" />
+                <field field_ref="evap_sicHDO"  level="1" />
+                <field field_ref="plulHTO"      level="1" />
+                <field field_ref="precipHTO"    level="1" />
+                <field field_ref="plucHTO"      level="1" />
+                <field field_ref="runofflandHTO" level="1" />
+                <field field_ref="evapHTO"      level="1" />
+                <field field_ref="evap_terHTO"  level="1" />
+                <field field_ref="evap_licHTO"  level="1" />
+                <field field_ref="evap_oceHTO"  level="1" />
+                <field field_ref="evap_sicHTO"  level="1" />
+             <!-- end Added SN isotopes 2D fields 07 2023 -->
             </field_group>
 
@@ -625,4 +675,63 @@
                 <field field_ref="l_mixmin_sic" level="10" />
                 <field field_ref="ozone_daylight" level="10" />
+             <!-- Begin Added SN isotopes 3D fields 07 2023 -->
+             <!-- water oxygen H216O H217O H218O -->
+                <field field_ref="ovapH216O"   level="1" />
+                <field field_ref="oliqH216O"   level="1" />
+                <field field_ref="ocondH216O"  level="1" />
+                <field field_ref="dqdynH216O"  level="1" />
+                <field field_ref="dqldynH216O" level="1" />
+                <field field_ref="dqconH216O"  level="1" />
+                <field field_ref="dqlscH216O"  level="1" />
+                <field field_ref="dqevaH216O"  level="1" />
+                <field field_ref="dqvdfH216O"  level="1" />
+                <field field_ref="dqajsH216O"  level="1" />
+                <field field_ref="dqtheH216O"  level="1" />
+                <field field_ref="ovapH217O"   level="1" />
+                <field field_ref="oliqH217O"   level="1" />
+                <field field_ref="ocondH217O"  level="1" />
+                <field field_ref="dqdynH217O"  level="1" />
+                <field field_ref="dqldynH217O" level="1" />
+                <field field_ref="dqconH217O"  level="1" />
+                <field field_ref="dqlscH217O"  level="1" />
+                <field field_ref="dqevaH217O"  level="1" />
+                <field field_ref="dqvdfH217O"  level="1" />
+                <field field_ref="dqajsH217O"  level="1" />
+                <field field_ref="dqtheH217O"  level="1" />
+                <field field_ref="ovapH218O"   level="1" />
+                <field field_ref="oliqH218O"   level="1" />
+                <field field_ref="ocondH218O"  level="1" />
+                <field field_ref="dqdynH218O"  level="1" />
+                <field field_ref="dqldynH218O" level="1" />
+                <field field_ref="dqconH218O"  level="1" />
+                <field field_ref="dqlscH218O"  level="1" />
+                <field field_ref="dqevaH218O"  level="1" />
+                <field field_ref="dqvdfH218O"  level="1" />
+                <field field_ref="dqajsH218O"  level="1" />
+                <field field_ref="dqtheH218O"  level="1" />
+            <!-- water hydrogen HDO HTO -->
+                <field field_ref="ovapHDO"   level="1" />
+                <field field_ref="oliqHDO"   level="1" />
+                <field field_ref="ocondHDO"  level="1" />
+                <field field_ref="dqdynHDO"  level="1" />
+                <field field_ref="dqldynHDO" level="1" />
+                <field field_ref="dqconHDO"  level="1" />
+                <field field_ref="dqlscHDO"  level="1" />
+                <field field_ref="dqevaHDO"  level="1" />
+                <field field_ref="dqvdfHDO"  level="1" />
+                <field field_ref="dqajsHDO"  level="1" />
+                <field field_ref="dqtheHDO"  level="1" />
+                <field field_ref="ovapHTO"   level="1" />
+                <field field_ref="oliqHTO"   level="1" />
+                <field field_ref="ocondHTO"  level="1" />
+                <field field_ref="dqdynHTO"  level="1" />
+                <field field_ref="dqldynHTO" level="1" />
+                <field field_ref="dqconHTO"  level="1" />
+                <field field_ref="dqlscHTO"  level="1" />
+                <field field_ref="dqevaHTO"  level="1" />
+                <field field_ref="dqvdfHTO"  level="1" />
+                <field field_ref="dqajsHTO"  level="1" />
+                <field field_ref="dqtheHTO"  level="1" />
+             <!-- End Added SN isotopes 3D fields 07 2023 -->
             </field_group>
             <field_group operation="average" grid_ref="grid_out_presinter">
Index: /LMDZ6/branches/cirrus/DefLists/file_def_histdaystrataer_lmdz.xml
===================================================================
--- /LMDZ6/branches/cirrus/DefLists/file_def_histdaystrataer_lmdz.xml	(revision 5201)
+++ /LMDZ6/branches/cirrus/DefLists/file_def_histdaystrataer_lmdz.xml	(revision 5202)
@@ -38,4 +38,7 @@
 	<field field_ref="budg_3D_backgr_so2" level="10" />
 	<field field_ref="R2SO4" level="1" />
+	<field field_ref="SAD_sulfate" level="1" />
+        <field field_ref="reff_sulfate" level="5" />
+	<field field_ref="sulfMMR" level="1" />
 	<field field_ref="OCS_lifetime" level="10" />
 	<field field_ref="SO2_lifetime" level="10" />
@@ -87,4 +90,78 @@
         <field field_ref="BIN35" level="2" />
         <field field_ref="BIN36" level="2" />
+	
+        <field field_ref="BIN01_nd_mode" level="3" />
+        <field field_ref="BIN02_nd_mode" level="3" />
+        <field field_ref="BIN03_nd_mode" level="3" />
+        <field field_ref="BIN04_nd_mode" level="3" />
+        <field field_ref="BIN05_nd_mode" level="3" />
+        <field field_ref="BIN06_nd_mode" level="3" />
+        <field field_ref="BIN07_nd_mode" level="3" />
+        <field field_ref="BIN08_nd_mode" level="3" />
+        <field field_ref="BIN09_nd_mode" level="3" />
+        <field field_ref="BIN10_nd_mode" level="3" />
+        <field field_ref="BIN11_nd_mode" level="3" />
+        <field field_ref="BIN12_nd_mode" level="3" />
+        <field field_ref="BIN13_nd_mode" level="3" />
+        <field field_ref="BIN14_nd_mode" level="3" />
+        <field field_ref="BIN15_nd_mode" level="3" />
+        <field field_ref="BIN16_nd_mode" level="3" />
+        <field field_ref="BIN17_nd_mode" level="3" />
+        <field field_ref="BIN18_nd_mode" level="3" />
+        <field field_ref="BIN19_nd_mode" level="3" />
+        <field field_ref="BIN20_nd_mode" level="3" />
+        <field field_ref="BIN21_nd_mode" level="3" />
+        <field field_ref="BIN22_nd_mode" level="3" />
+        <field field_ref="BIN23_nd_mode" level="3" />
+        <field field_ref="BIN24_nd_mode" level="3" />
+        <field field_ref="BIN25_nd_mode" level="3" />
+        <field field_ref="BIN26_nd_mode" level="3" />
+        <field field_ref="BIN27_nd_mode" level="3" />
+        <field field_ref="BIN28_nd_mode" level="3" />
+        <field field_ref="BIN29_nd_mode" level="3" />
+        <field field_ref="BIN30_nd_mode" level="3" />
+        <field field_ref="BIN31_nd_mode" level="3" />
+        <field field_ref="BIN32_nd_mode" level="3" />
+        <field field_ref="BIN33_nd_mode" level="3" />
+        <field field_ref="BIN34_nd_mode" level="3" />
+        <field field_ref="BIN35_nd_mode" level="3" />
+        <field field_ref="BIN36_nd_mode" level="3" />
+	
+        <field field_ref="BIN01_sulfmmr_mode" level="3" />
+        <field field_ref="BIN02_sulfmmr_mode" level="3" />
+        <field field_ref="BIN03_sulfmmr_mode" level="3" />
+        <field field_ref="BIN04_sulfmmr_mode" level="3" />
+        <field field_ref="BIN05_sulfmmr_mode" level="3" />
+        <field field_ref="BIN06_sulfmmr_mode" level="3" />
+        <field field_ref="BIN07_sulfmmr_mode" level="3" />
+        <field field_ref="BIN08_sulfmmr_mode" level="3" />
+        <field field_ref="BIN09_sulfmmr_mode" level="3" />
+        <field field_ref="BIN10_sulfmmr_mode" level="3" />
+        <field field_ref="BIN11_sulfmmr_mode" level="3" />
+        <field field_ref="BIN12_sulfmmr_mode" level="3" />
+        <field field_ref="BIN13_sulfmmr_mode" level="3" />
+        <field field_ref="BIN14_sulfmmr_mode" level="3" />
+        <field field_ref="BIN15_sulfmmr_mode" level="3" />
+        <field field_ref="BIN16_sulfmmr_mode" level="3" />
+        <field field_ref="BIN17_sulfmmr_mode" level="3" />
+        <field field_ref="BIN18_sulfmmr_mode" level="3" />
+        <field field_ref="BIN19_sulfmmr_mode" level="3" />
+        <field field_ref="BIN20_sulfmmr_mode" level="3" />
+        <field field_ref="BIN21_sulfmmr_mode" level="3" />
+        <field field_ref="BIN22_sulfmmr_mode" level="3" />
+        <field field_ref="BIN23_sulfmmr_mode" level="3" />
+        <field field_ref="BIN24_sulfmmr_mode" level="3" />
+        <field field_ref="BIN25_sulfmmr_mode" level="3" />
+        <field field_ref="BIN26_sulfmmr_mode" level="3" />
+        <field field_ref="BIN27_sulfmmr_mode" level="3" />
+        <field field_ref="BIN28_sulfmmr_mode" level="3" />
+        <field field_ref="BIN29_sulfmmr_mode" level="3" />
+        <field field_ref="BIN30_sulfmmr_mode" level="3" />
+        <field field_ref="BIN31_sulfmmr_mode" level="3" />
+        <field field_ref="BIN32_sulfmmr_mode" level="3" />
+        <field field_ref="BIN33_sulfmmr_mode" level="3" />
+        <field field_ref="BIN34_sulfmmr_mode" level="3" />
+        <field field_ref="BIN35_sulfmmr_mode" level="3" />
+        <field field_ref="BIN36_sulfmmr_mode" level="3" />
       </field_group>
       
Index: /LMDZ6/branches/cirrus/DefLists/file_def_histmth_lmdz.xml
===================================================================
--- /LMDZ6/branches/cirrus/DefLists/file_def_histmth_lmdz.xml	(revision 5201)
+++ /LMDZ6/branches/cirrus/DefLists/file_def_histmth_lmdz.xml	(revision 5202)
@@ -2,5 +2,5 @@
 <file_definition>
         <file_group id="defile">
-        <file id="histmth" name="histmth" output_freq="1mo" output_level="_AUTO_"  enabled="_AUTO_" compression_level="2">
+        <file id="histmth" name="histmth" output_freq="1mo" output_level="1"  enabled=".TRUE." compression_level="0">
 
             <!-- VARS 1D -->
@@ -165,4 +165,5 @@
                 <field field_ref="mrroli" level="1" />
                 <field field_ref="runofflic" level="5" />
+                <field field_ref="runoffland" level="1" />
                 <field field_ref="taux" level="1" />
                 <field field_ref="tauy" level="1" />
@@ -499,4 +500,53 @@
                 <field field_ref="dqthe2d" level="4" />
                 <field field_ref="dqajs2d" level="4" />
+            <!-- Begin Added SN isotopes 2D fields 07 2023 -->
+            <!-- water oxygen H216O H217O H218O -->
+                <field field_ref="precipH216O"     level="1" />
+                <field field_ref="plulH216O"       level="1" />
+                <field field_ref="plucH216O"       level="1" />
+                <field field_ref="runofflandH216O" level="1" />
+                <field field_ref="evapH216O"       level="1" />
+                <field field_ref="evap_terH216O"   level="1" />
+                <field field_ref="evap_licH216O"   level="1" />
+                <field field_ref="evap_oceH216O"   level="1" />
+                <field field_ref="evap_sicH216O"   level="1" />
+                <field field_ref="precipH217O"     level="1" />
+                <field field_ref="plulH217O"       level="1" />
+                <field field_ref="plucH217O"       level="1" />
+                <field field_ref="runofflandH217O" level="1" />
+                <field field_ref="evapH217O"       level="1" />
+                <field field_ref="evap_terH217O"   level="1" />
+                <field field_ref="evap_licH217O"   level="1" />
+                <field field_ref="evap_oceH217O"   level="1" />
+                <field field_ref="evap_sicH217O"   level="1" />
+                <field field_ref="precipH218O"     level="1" />
+                <field field_ref="plulH218O"       level="1" />
+                <field field_ref="plucH218O"       level="1" />
+                <field field_ref="runofflandH218O" level="1" />
+                <field field_ref="evapH218O"       level="1" />
+                <field field_ref="evap_terH218O"   level="1" />
+                <field field_ref="evap_licH218O"   level="1" />
+                <field field_ref="evap_oceH218O"   level="1" />
+                <field field_ref="evap_sicH218O"   level="1" />
+            <!-- water hydrogen HDO HTO -->
+                <field field_ref="precipHDO"     level="1" />
+                <field field_ref="plulHDO"       level="1" />
+                <field field_ref="plucHDO"       level="1" />
+                <field field_ref="runofflandHDO" level="1" />
+                <field field_ref="evapHDO"       level="1" />
+                <field field_ref="evap_terHDO"   level="1" />
+                <field field_ref="evap_licHDO"   level="1" />
+                <field field_ref="evap_oceHDO"   level="1" />
+                <field field_ref="evap_sicHDO"   level="1" />
+                <field field_ref="plulHTO"       level="1" />
+                <field field_ref="precipHTO"     level="1" />
+                <field field_ref="plucHTO"       level="1" />
+                <field field_ref="runofflandHTO" level="1" />
+                <field field_ref="evapHTO"       level="1" />
+                <field field_ref="evap_terHTO"   level="1" />
+                <field field_ref="evap_licHTO"   level="1" />
+                <field field_ref="evap_oceHTO"   level="1" />
+                <field field_ref="evap_sicHTO"   level="1" />
+         <!-- end Added SN isotopes 2D fields 07 2023 -->
             </field_group>
 
@@ -680,4 +730,63 @@
                 <field field_ref="heat_volc" level="1" />
 		<field field_ref="dqch4"     level="10" />
+             <!-- Begin Added SN isotopes 3D fields 07 2023 -->
+             <!-- water oxygen H216O H217O H218O -->
+                <field field_ref="ovapH216O"   level="1" />
+                <field field_ref="oliqH216O"   level="1" />
+                <field field_ref="ocondH216O"  level="1" />
+                <field field_ref="dqdynH216O"  level="1" />
+                <field field_ref="dqldynH216O" level="1" />
+                <field field_ref="dqconH216O"  level="1" />
+                <field field_ref="dqlscH216O"  level="1" />
+                <field field_ref="dqevaH216O"  level="1" />
+                <field field_ref="dqvdfH216O"  level="1" />
+                <field field_ref="dqajsH216O"  level="1" />
+                <field field_ref="dqtheH216O"  level="1" />
+                <field field_ref="ovapH217O"   level="1" />
+                <field field_ref="oliqH217O"   level="1" />
+                <field field_ref="ocondH217O"  level="1" />
+                <field field_ref="dqdynH217O"  level="1" />
+                <field field_ref="dqldynH217O" level="1" />
+                <field field_ref="dqconH217O"  level="1" />
+                <field field_ref="dqlscH217O"  level="1" />
+                <field field_ref="dqevaH217O"  level="1" />
+                <field field_ref="dqvdfH217O"  level="1" />
+                <field field_ref="dqajsH217O"  level="1" />
+                <field field_ref="dqtheH217O"  level="1" />
+                <field field_ref="ovapH218O"   level="1" />
+                <field field_ref="oliqH218O"   level="1" />
+                <field field_ref="ocondH218O"  level="1" />
+                <field field_ref="dqdynH218O"  level="1" />
+                <field field_ref="dqldynH218O" level="1" />
+                <field field_ref="dqconH218O"  level="1" />
+                <field field_ref="dqlscH218O"  level="1" />
+                <field field_ref="dqevaH218O"  level="1" />
+                <field field_ref="dqvdfH218O"  level="1" />
+                <field field_ref="dqajsH218O"  level="1" />
+                <field field_ref="dqtheH218O"  level="1" />
+            <!-- water hydrogen HDO HTO -->
+                <field field_ref="ovapHDO"   level="1" />
+                <field field_ref="oliqHDO"   level="1" />
+                <field field_ref="ocondHDO"  level="1" />
+                <field field_ref="dqdynHDO"  level="1" />
+                <field field_ref="dqldynHDO" level="1" />
+                <field field_ref="dqconHDO"  level="1" />
+                <field field_ref="dqlscHDO"  level="1" />
+                <field field_ref="dqevaHDO"  level="1" />
+                <field field_ref="dqvdfHDO"  level="1" />
+                <field field_ref="dqajsHDO"  level="1" />
+                <field field_ref="dqtheHDO"  level="1" />
+                <field field_ref="ovapHTO"   level="1" />
+                <field field_ref="oliqHTO"   level="1" />
+                <field field_ref="ocondHTO"  level="1" />
+                <field field_ref="dqdynHTO"  level="1" />
+                <field field_ref="dqldynHTO" level="1" />
+                <field field_ref="dqconHTO"  level="1" />
+                <field field_ref="dqlscHTO"  level="1" />
+                <field field_ref="dqevaHTO"  level="1" />
+                <field field_ref="dqvdfHTO"  level="1" />
+                <field field_ref="dqajsHTO"  level="1" />
+                <field field_ref="dqtheHTO"  level="1" />
+             <!-- End Added SN isotopes 3D fields 07 2023 -->
             </field_group>
 
Index: /LMDZ6/branches/cirrus/DefLists/file_def_histstrataer_lmdz.xml
===================================================================
--- /LMDZ6/branches/cirrus/DefLists/file_def_histstrataer_lmdz.xml	(revision 5201)
+++ /LMDZ6/branches/cirrus/DefLists/file_def_histstrataer_lmdz.xml	(revision 5202)
@@ -41,4 +41,7 @@
 	  <field field_ref="budg_3D_backgr_so2" level="1" />
 	  <field field_ref="R2SO4" level="1" />
+	  <field field_ref="SAD_sulfate" level="1" />
+	  <field field_ref="reff_sulfate" level="1" />
+	  <field field_ref="sulfMMR" level="1" />
 	  <field field_ref="OCS_lifetime" level="1" />
 	  <field field_ref="SO2_lifetime" level="1" />
@@ -90,4 +93,78 @@
 	  <field field_ref="GASSO2"  level="1" />
 	  <field field_ref="GASH2SO4"  level="1" />
+	  
+          <field field_ref="BIN01_nd_mode" level="2" />
+          <field field_ref="BIN02_nd_mode" level="2" />
+          <field field_ref="BIN03_nd_mode" level="2" />
+          <field field_ref="BIN04_nd_mode" level="2" />
+          <field field_ref="BIN05_nd_mode" level="2" />
+          <field field_ref="BIN06_nd_mode" level="2" />
+          <field field_ref="BIN07_nd_mode" level="2" />
+          <field field_ref="BIN08_nd_mode" level="2" />
+          <field field_ref="BIN09_nd_mode" level="2" />
+          <field field_ref="BIN10_nd_mode" level="2" />
+          <field field_ref="BIN11_nd_mode" level="2" />
+          <field field_ref="BIN12_nd_mode" level="2" />
+          <field field_ref="BIN13_nd_mode" level="2" />
+          <field field_ref="BIN14_nd_mode" level="2" />
+          <field field_ref="BIN15_nd_mode" level="2" />
+          <field field_ref="BIN16_nd_mode" level="2" />
+          <field field_ref="BIN17_nd_mode" level="2" />
+          <field field_ref="BIN18_nd_mode" level="2" />
+          <field field_ref="BIN19_nd_mode" level="2" />
+          <field field_ref="BIN20_nd_mode" level="2" />
+          <field field_ref="BIN21_nd_mode" level="2" />
+          <field field_ref="BIN22_nd_mode" level="2" />
+          <field field_ref="BIN23_nd_mode" level="2" />
+          <field field_ref="BIN24_nd_mode" level="2" />
+          <field field_ref="BIN25_nd_mode" level="2" />
+          <field field_ref="BIN26_nd_mode" level="2" />
+          <field field_ref="BIN27_nd_mode" level="2" />
+          <field field_ref="BIN28_nd_mode" level="2" />
+          <field field_ref="BIN29_nd_mode" level="2" />
+          <field field_ref="BIN30_nd_mode" level="2" />
+          <field field_ref="BIN31_nd_mode" level="2" />
+          <field field_ref="BIN32_nd_mode" level="2" />
+          <field field_ref="BIN33_nd_mode" level="2" />
+          <field field_ref="BIN34_nd_mode" level="2" />
+          <field field_ref="BIN35_nd_mode" level="2" />
+          <field field_ref="BIN36_nd_mode" level="2" />
+	  
+          <field field_ref="BIN01_sulfmmr_mode" level="2" />
+          <field field_ref="BIN02_sulfmmr_mode" level="2" />
+          <field field_ref="BIN03_sulfmmr_mode" level="2" />
+          <field field_ref="BIN04_sulfmmr_mode" level="2" />
+          <field field_ref="BIN05_sulfmmr_mode" level="2" />
+          <field field_ref="BIN06_sulfmmr_mode" level="2" />
+          <field field_ref="BIN07_sulfmmr_mode" level="2" />
+          <field field_ref="BIN08_sulfmmr_mode" level="2" />
+          <field field_ref="BIN09_sulfmmr_mode" level="2" />
+          <field field_ref="BIN10_sulfmmr_mode" level="2" />
+          <field field_ref="BIN11_sulfmmr_mode" level="2" />
+          <field field_ref="BIN12_sulfmmr_mode" level="2" />
+          <field field_ref="BIN13_sulfmmr_mode" level="2" />
+          <field field_ref="BIN14_sulfmmr_mode" level="2" />
+          <field field_ref="BIN15_sulfmmr_mode" level="2" />
+          <field field_ref="BIN16_sulfmmr_mode" level="2" />
+          <field field_ref="BIN17_sulfmmr_mode" level="2" />
+          <field field_ref="BIN18_sulfmmr_mode" level="2" />
+          <field field_ref="BIN19_sulfmmr_mode" level="2" />
+          <field field_ref="BIN20_sulfmmr_mode" level="2" />
+          <field field_ref="BIN21_sulfmmr_mode" level="2" />
+          <field field_ref="BIN22_sulfmmr_mode" level="2" />
+          <field field_ref="BIN23_sulfmmr_mode" level="2" />
+          <field field_ref="BIN24_sulfmmr_mode" level="2" />
+          <field field_ref="BIN25_sulfmmr_mode" level="2" />
+          <field field_ref="BIN26_sulfmmr_mode" level="2" />
+          <field field_ref="BIN27_sulfmmr_mode" level="2" />
+          <field field_ref="BIN28_sulfmmr_mode" level="2" />
+          <field field_ref="BIN29_sulfmmr_mode" level="2" />
+          <field field_ref="BIN30_sulfmmr_mode" level="2" />
+          <field field_ref="BIN31_sulfmmr_mode" level="2" />
+          <field field_ref="BIN32_sulfmmr_mode" level="2" />
+          <field field_ref="BIN33_sulfmmr_mode" level="2" />
+          <field field_ref="BIN34_sulfmmr_mode" level="2" />
+          <field field_ref="BIN35_sulfmmr_mode" level="2" />
+          <field field_ref="BIN36_sulfmmr_mode" level="2" />
 	</field_group>
 	
Index: /LMDZ6/branches/cirrus/DefLists/gcm.def
===================================================================
--- /LMDZ6/branches/cirrus/DefLists/gcm.def	(revision 5201)
+++ /LMDZ6/branches/cirrus/DefLists/gcm.def	(revision 5202)
@@ -33,12 +33,8 @@
 ##  dans la dynamique)
 read_start=y
+## choix du qsat pour le test sur l humidite pour l advection de q: q advecte< qsat aval
+adv_qsat_liq=n
 ## periode de la physique (en pas dynamiques, n'a de sens que si iflag_phys=1)                                       
 iphysiq=10
-##  Avec ou sans strato
-ok_strato=y 
-#  Couche eponge dans les couches de pression plus faible que 100 fois la pression de la derniere couche
-iflag_top_bound=2
-#  Coefficient pour la couche eponge (valeur derniere couche)
-tau_top_bound=5.e-5
 ## longitude en degres du centre du zoom                                 
 clon=0.
Index: /LMDZ6/branches/cirrus/DefLists/gcm.def_144x142
===================================================================
--- /LMDZ6/branches/cirrus/DefLists/gcm.def_144x142	(revision 5201)
+++ /LMDZ6/branches/cirrus/DefLists/gcm.def_144x142	(revision 5202)
@@ -23,4 +23,6 @@
 ## choix du shema d'integration temporelle (Matsuno:y ou Matsuno-leapfrog:n) 
 purmats=n
+## choix du qsat pour le test sur l humidite pour l advection de q: q advecte< qsat aval
+adv_qsat_liq=n
 ## avec ou sans physique
 ## 0: pas de physique (e.g. en mode Shallow Water)
Index: /LMDZ6/branches/cirrus/DefLists/lmdz.xml
===================================================================
--- /LMDZ6/branches/cirrus/DefLists/lmdz.xml	(revision 5202)
+++ /LMDZ6/branches/cirrus/DefLists/lmdz.xml	(revision 5202)
@@ -0,0 +1,4 @@
+<context_group>
+  <context id="LMDZ" src="./context_lmdz.xml"/>
+  <context id="LMDZ" src="./context_input_lmdz.xml"/>
+</context_group>
Index: /LMDZ6/branches/cirrus/DefLists/physiq.def_NPv7.0.1c
===================================================================
--- /LMDZ6/branches/cirrus/DefLists/physiq.def_NPv7.0.1c	(revision 5202)
+++ /LMDZ6/branches/cirrus/DefLists/physiq.def_NPv7.0.1c	(revision 5202)
@@ -0,0 +1,632 @@
+#
+# $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
+
+          # To get back to the bug where tendencies of the dry adjustment
+          # (applied to (w) before calling convection) where added directly
+          # to wake_deltat and wake_deltaq :
+          # ok_bug_ajs_cv=y
+ok_bug_ajs_cv=n
+
+          #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
+          #Bug geopotentiel moyen dans pbl_surface (D:y) 
+ok_bug_zg_wk_pbl=n
+####################################################################
+#  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: /LMDZ6/branches/cirrus/DefLists/vert_L39.def
===================================================================
--- /LMDZ6/branches/cirrus/DefLists/vert_L39.def	(revision 5202)
+++ /LMDZ6/branches/cirrus/DefLists/vert_L39.def	(revision 5202)
@@ -0,0 +1,6 @@
+##  Avec ou sans strato
+ok_strato=y 
+#  Couche eponge dans les couches de pression plus faible que 100 fois la pression de la derniere couche
+iflag_top_bound=2
+#  Coefficient pour la couche eponge (valeur derniere couche)
+tau_top_bound=5.e-5
Index: /LMDZ6/branches/cirrus/arch/arch-X64_ADASTRA-GNU.env
===================================================================
--- /LMDZ6/branches/cirrus/arch/arch-X64_ADASTRA-GNU.env	(revision 5201)
+++ /LMDZ6/branches/cirrus/arch/arch-X64_ADASTRA-GNU.env	(revision 5202)
@@ -1,14 +1,19 @@
-# Compile and running environnement at Adastra
-set +e 
+#!/bin/bash
 module purge
-module load craype-x86-genoa
-module load craype-network-ofi
-module load libfabric/1.15.2.0
-module load PrgEnv-gnu/8.3.3
-module load cray-dsmml/0.2.2
-module load cray-libsci/23.02.1.1
-module load cray-mpich/8.1.21
-module load craype/2.7.19
-module load cray-hdf5-parallel/1.12.2.1
-module load cray-netcdf-hdf5parallel/4.9.0.1
-module load cray-fftw/3.3.10.3
+module load PrgEnv-gnu
+module load gcc/13.2.0  # required, see https://dci.dci-gitlab.cines.fr/webextranet/user_support/index.html#prgenv-and-compilers
+module load cray-hdf5-parallel
+module load netcdf-hdf5parallel/gnu/10.3
+
+# netcdf-hdf5parallel has weird naming conventions => hotfix...
+# Used in netcdf95 cmake compilation
+rm -rf netcdf-hdfparallel-hotfix
+mkdir -p netcdf-hdfparallel-hotfix
+cp -r /opt/cray/pe/netcdf-hdf5parallel/4.9.0.5/gnu/10.3/lib/pkgconfig/netcdf*_parallel.pc netcdf-hdfparallel-hotfix
+cd netcdf-hdfparallel-hotfix || exit 1
+mv netcdf-fortran_parallel.pc netcdf-fortran.pc
+PKG_CONFIG_PATH="$(readlink -f .):$PKG_CONFIG_PATH"
+# Another similar hotfix to find mpich.pc
+PKG_CONFIG_PATH="/opt/cray/pe/mpich/8.1.28/ofi/crayclang/16.0/lib/pkgconfig/:$PKG_CONFIG_PATH"
+export PKG_CONFIG_PATH
+cd - || exit 1
Index: /LMDZ6/branches/cirrus/arch/arch-X64_ADASTRA-GNU.fcm
===================================================================
--- /LMDZ6/branches/cirrus/arch/arch-X64_ADASTRA-GNU.fcm	(revision 5201)
+++ /LMDZ6/branches/cirrus/arch/arch-X64_ADASTRA-GNU.fcm	(revision 5202)
@@ -1,17 +1,31 @@
 %COMPILER            mpif90
+%CCOMPILER           mpicc  # xios
 %LINK                mpif90
+%FPP                 cpp
 %AR                  ar
-%ARFLAGS             rs
-%MAKE                gmake
-%FPP                 mpif90 -E
-%FPP_FLAGS           -P -traditional -I${FFTW_INC}
-%FPP_DEF             NC_DOUBLE FFT_FFTW
-%BASE_FFLAGS         -I${FFTW_INC} -march=znver1 -fcray-pointer -c -fdefault-real-8 -fdefault-double-8 -ffree-line-length-none -fallow-argument-mismatch -fno-align-commons 
+%ARFLAGS             rU
+%MAKE                make
+%FPP_FLAGS           -P -traditional
+%FPP_DEF             NC_DOUBLE
+
+%BASE_FFLAGS         -cpp -ffree-line-length-0 -fdefault-real-8 -DNC_DOUBLE -fallow-argument-mismatch -fimplicit-none -march=native -fPIC
+%BASE_CFLAGS         -w -std=c++11 -D__XIOS_EXCEPTION  # xios
+# /!\ LD must be written in Makefile syntax
+%BASE_LD             -Wl,-rpath=$(shell nf-config --prefix)/lib -lstdc++
+%BASE_INC            -D__NONE__  # xios
+
 %PROD_FFLAGS         -O3
-%DEV_FFLAGS          -g -O2
-%DEBUG_FFLAGS        
-%MPI_FFLAGS
-%OMP_FFLAGS          -fopenmp
-%BASE_LD             -L${FFTW_DIR} -lfftw3
-%MPI_LD
+%PROD_CFLAGS         -O3 -DBOOST_DISABLE_ASSERTS  # xios
+
+%DEV_FFLAGS          -Wall -fbounds-check -fallow-argument-mismatch
+%DEV_CFLAGS          -g -O2  # xios
+
+%DEBUG_FFLAGS        -g3 -Wall -fbounds-check -ffpe-trap=invalid,zero,overflow -O0 -fstack-protector-all -fbacktrace -finit-real=snan -fallow-argument-mismatch
+%DEBUG_CFLAGS        -g -DBZ_DEBUG # xios
+
+%MPI_FFLAGS          -fcray-pointer
+%MPI_LD              -L$(shell dirname $(shell readlink -f "$(shell which mpif90)"))/../lib -lmpi
 %OMP_LD              -fopenmp
+%OMP_FFLAGS          -fopenmp -fcray-pointer
+
+%CPP                 cpp  # xios
Index: /LMDZ6/branches/cirrus/arch/arch-X64_ADASTRA-GNU.path
===================================================================
--- /LMDZ6/branches/cirrus/arch/arch-X64_ADASTRA-GNU.path	(revision 5201)
+++ /LMDZ6/branches/cirrus/arch/arch-X64_ADASTRA-GNU.path	(revision 5202)
@@ -1,22 +1,21 @@
-NETCDF_INCDIR="-I ${NETCDF_DIR}/include"
-NETCDF_LIBDIR="-L ${NETCDF_DIR}/lib"
-NETCDF_LIB="-lnetcdf -lnetcdff"
+NETCDF_INCDIR="-I$(nf-config --includedir) -I$(nc-config --includedir)"
+# Ugly hack for orchidee <=2.0
+NETCDF_LIBDIR="-L${NETCDF_DIR}/lib" # for some reason on adastra `nf-config --flibs` is empty
+NETCDF_LIB="-lnetcdf -lnetcdff"  # same as above
+NETCDF95_INCDIR="-I$(pwd)/../../include"
+NETCDF95_LIBDIR="-L$(pwd)/../../lib"
+NETCDF95_LIB="-lnetcdf95"
 
-IOIPSL_INCDIR="-I$LMDGCM/../../lib -I$LMDGCM/../IOIPSL/inc"
-IOIPSL_LIBDIR="-L$LMDGCM/../../lib -L$LMDGCM/../IOIPSL/lib"
+# Exported
+IOIPSL_INCDIR="-I$(pwd)/../IOIPSL/inc -I$(pwd)/../IOIPSL/lib"
+IOIPSL_LIBDIR="-L$(pwd)/../IOIPSL/inc -L$(pwd)/../IOIPSL/lib"
 IOIPSL_LIB="-lioipsl"
 
-XIOS_INCDIR="-I$LMDGCM/../XIOS/inc"
-XIOS_LIBDIR="-L$LMDGCM/../XIOS/lib"
+# Exported
+XIOS_INCDIR="-I$(pwd)/../XIOS/inc"
+XIOS_LIBDIR="-L$(pwd)/../XIOS/lib"
 XIOS_LIB="-lxios -lstdc++"
 
-ORCH_INCDIR="-I$LMDGCM/../../lib"
-ORCH_LIBDIR="-L$LMDGCM/../../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"
+# Exported
+ORCH_INCDIR="-I$(pwd)/../ORCHIDEE/inc -I$(pwd)/../ORCHIDEE/lib"
+ORCH_LIBDIR="-L$(pwd)/../ORCHIDEE/inc -L$(pwd)/../ORCHIDEE/lib"
Index: /LMDZ6/branches/cirrus/arch/arch-X64_JEANZAY.env
===================================================================
--- /LMDZ6/branches/cirrus/arch/arch-X64_JEANZAY.env	(revision 5201)
+++ /LMDZ6/branches/cirrus/arch/arch-X64_JEANZAY.env	(revision 5202)
@@ -1,8 +1,13 @@
 module purge
-module load intel-all/19.0.4
+module load intel-compilers/19.0.4
+module load intel-mkl/19.0.4
 module load hdf5/1.10.5-mpi
 module load netcdf/4.7.2-mpi
 module load netcdf-fortran/4.5.2-mpi
 module load netcdf95
+module load subversion/1.9.7
+module load cmake
 
-module load gcc/6.5.0
+export FC=mpiifort
+export CPP="icc -E"
+export CC=icc
Index: /LMDZ6/branches/cirrus/arch/arch-X64_JEANZAY.path
===================================================================
--- /LMDZ6/branches/cirrus/arch/arch-X64_JEANZAY.path	(revision 5201)
+++ /LMDZ6/branches/cirrus/arch/arch-X64_JEANZAY.path	(revision 5202)
@@ -1,30 +1,21 @@
-# $Id$
-#NETCDF_LIBDIR="-L$NETCDFFORTRAN_LIBDIR -L$NETCDF_LIBDIR -lnetcdf -lnetcdff"
-#NETCDF_INCDIR=-I$NETCDFFORTRAN_INCDIR
-NETCDF_INCDIR=""
-NETCDF_LIBDIR=""
+NETCDF_INCDIR="-I$(nf-config --includedir) -I$(nc-config --includedir)"  # nc required for xios
+# Ugly hack for orchidee <=2.0
+NETCDF_LIBDIR="-L$(nf-config --flibs | sed -e "s/-L//")"
 NETCDF_LIB="-lnetcdff -lnetcdf"
+NETCDF95_INCDIR="-I$(pwd)/../../include"
+NETCDF95_LIBDIR="-L$(pwd)/../../lib"
+NETCDF95_LIB="-lnetcdf95"
 
-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"
+# Exported
+IOIPSL_INCDIR="-I$(pwd)/../IOIPSL/inc -I$(pwd)/../IOIPSL/lib"
+IOIPSL_LIBDIR="-L$(pwd)/../IOIPSL/inc -L$(pwd)/../IOIPSL/lib"
 IOIPSL_LIB="-lioipsl"
 
-XIOS_INCDIR="-I$LMDGCM/../XIOS/inc"
-XIOS_LIBDIR="-L$LMDGCM/../XIOS/lib"
+# Exported
+XIOS_INCDIR="-I$(pwd)/../XIOS/inc"
+XIOS_LIBDIR="-L$(pwd)/../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"
+# Exported
+ORCH_INCDIR="-I$(pwd)/../ORCHIDEE/inc -I$(pwd)/../ORCHIDEE/lib"
+ORCH_LIBDIR="-L$(pwd)/../ORCHIDEE/inc -L$(pwd)/../ORCHIDEE/lib"
Index: /LMDZ6/branches/cirrus/arch/arch-X64_MESOIPSL-GNU.env
===================================================================
--- /LMDZ6/branches/cirrus/arch/arch-X64_MESOIPSL-GNU.env	(revision 5202)
+++ /LMDZ6/branches/cirrus/arch/arch-X64_MESOIPSL-GNU.env	(revision 5202)
@@ -0,0 +1,8 @@
+module purge
+module load subversion/1.13.0
+module load gcc/11.2.0
+module load openmpi/4.0.7
+module load hdf5/1.10.7-mpi
+module load netcdf-fortran/4.5.3-mpi
+module load netcdf-c/4.7.4-mpi
+module load netcdf95
Index: /LMDZ6/branches/cirrus/arch/arch-X64_MESOIPSL-GNU.fcm
===================================================================
--- /LMDZ6/branches/cirrus/arch/arch-X64_MESOIPSL-GNU.fcm	(revision 5202)
+++ /LMDZ6/branches/cirrus/arch/arch-X64_MESOIPSL-GNU.fcm	(revision 5202)
@@ -0,0 +1,35 @@
+%COMPILER            mpif90
+%CCOMPILER           mpicc  # xios
+%LINK                mpif90
+%FPP                 cpp
+%AR                  ar
+%ARFLAGS             rU
+%MAKE                make
+%FPP_FLAGS           -P -traditional
+%FPP_DEF             NC_DOUBLE
+
+%BASE_FFLAGS         -cpp -ffree-line-length-0 -fdefault-real-8 -DNC_DOUBLE -fallow-argument-mismatch
+%BASE_CFLAGS         -w -std=c++11 -D__XIOS_EXCEPTION  # xios
+# /!\ LD must be written in Makefile syntax
+%BASE_LD             -Wl,-rpath=$(shell nf-config --prefix)/lib -lstdc++
+%BASE_INC            -D__NONE__  # xios
+
+%PROD_FFLAGS         -O3 -march=native
+%PROD_CFLAGS         -O3 -DBOOST_DISABLE_ASSERTS  # xios
+
+%DEV_FFLAGS          -Wall -fbounds-check
+%DEV_CFLAGS          -g -O2  # xios
+
+%DEBUG_FFLAGS        -g3 -Wall -fbounds-check -ffpe-trap=invalid,zero,overflow -O0 -fstack-protector-all -fbacktrace -finit-real=snan
+%DEBUG_CFLAGS        -g -DBZ_DEBUG # xios
+
+%MPI_FFLAGS          -fcray-pointer
+%MPI_LD              -L$(shell dirname $(shell readlink -f "$(shell which mpif90)"))/../lib -lmpi
+%OMP_LD              -fopenmp
+%OMP_FFLAGS          -fopenmp -fcray-pointer
+
+%CPP                 cpp  # xios
+%FPP                 cpp -P  # xios
+%MAKE                make  # xios
+
+
Index: /LMDZ6/branches/cirrus/arch/arch-X64_MESOIPSL-GNU.path
===================================================================
--- /LMDZ6/branches/cirrus/arch/arch-X64_MESOIPSL-GNU.path	(revision 5202)
+++ /LMDZ6/branches/cirrus/arch/arch-X64_MESOIPSL-GNU.path	(revision 5202)
@@ -0,0 +1,21 @@
+NETCDF_INCDIR="-I$(nf-config --includedir) -I$(nc-config --includedir)"  # nc required for xios
+# Ugly hack for orchidee <=2.0
+NETCDF_LIBDIR="-L$(nf-config --flibs | sed -e "s/-L//")"
+NETCDF_LIB="-lnetcdff -lnetcdf"
+NETCDF95_INCDIR="-I$(pwd)/../../include"
+NETCDF95_LIBDIR="-L$(pwd)/../../lib"
+NETCDF95_LIB="-lnetcdf95"
+
+# Exported
+IOIPSL_INCDIR="-I$(pwd)/../IOIPSL/inc -I$(pwd)/../IOIPSL/lib"
+IOIPSL_LIBDIR="-L$(pwd)/../IOIPSL/inc -L$(pwd)/../IOIPSL/lib"
+IOIPSL_LIB="-lioipsl"
+
+# Exported
+XIOS_INCDIR="-I$(pwd)/../XIOS/inc"
+XIOS_LIBDIR="-L$(pwd)/../XIOS/lib"
+XIOS_LIB="-lxios -lstdc++"
+
+# Exported
+ORCH_INCDIR="-I$(pwd)/../ORCHIDEE/inc -I$(pwd)/../ORCHIDEE/lib"
+ORCH_LIBDIR="-L$(pwd)/../ORCHIDEE/inc -L$(pwd)/../ORCHIDEE/lib"
Index: /LMDZ6/branches/cirrus/arch/arch-local-gfortran-parallel.env
===================================================================
--- /LMDZ6/branches/cirrus/arch/arch-local-gfortran-parallel.env	(revision 5202)
+++ /LMDZ6/branches/cirrus/arch/arch-local-gfortran-parallel.env	(revision 5202)
@@ -0,0 +1,1 @@
+# empty
Index: /LMDZ6/branches/cirrus/arch/arch-local-gfortran-parallel.fcm
===================================================================
--- /LMDZ6/branches/cirrus/arch/arch-local-gfortran-parallel.fcm	(revision 5202)
+++ /LMDZ6/branches/cirrus/arch/arch-local-gfortran-parallel.fcm	(revision 5202)
@@ -0,0 +1,33 @@
+%COMPILER            mpif90
+%CCOMPILER           mpicc  # xios
+%LINK                mpif90
+%FPP                 cpp
+%AR                  ar
+%ARFLAGS             rU
+%MAKE                make
+%FPP_FLAGS           -P -traditional
+%FPP_DEF             NC_DOUBLE
+
+%BASE_FFLAGS         -cpp -ffree-line-length-0 -fdefault-real-8 -DNC_DOUBLE -fallow-argument-mismatch -fimplicit-none
+%BASE_CFLAGS         -w -std=c++11 -D__XIOS_EXCEPTION  # xios
+# /!\ LD must be written in Makefile syntax
+%BASE_LD             -Wl,-rpath=$(shell nf-config --prefix)/lib -lstdc++
+%BASE_INC            -D__NONE__  # xios
+
+%PROD_FFLAGS         -O3 -march=native
+%PROD_CFLAGS         -O3 -DBOOST_DISABLE_ASSERTS  # xios
+
+%DEV_FFLAGS          -Wall -fbounds-check
+%DEV_CFLAGS          -g -O2  # xios
+
+%DEBUG_FFLAGS        -g3 -Wall -fbounds-check -ffpe-trap=invalid,zero,overflow -O0 -fstack-protector-all -fbacktrace -finit-real=snan
+%DEBUG_CFLAGS        -g -DBZ_DEBUG # xios
+
+%MPI_FFLAGS          -fcray-pointer
+%MPI_LD              -L$(shell dirname $(shell readlink -f "$(shell which mpif90)"))/../lib -lmpi
+%OMP_LD              -fopenmp
+%OMP_FFLAGS          -fopenmp -fcray-pointer
+
+%CPP                 cpp  # xios
+
+
Index: /LMDZ6/branches/cirrus/arch/arch-local-gfortran-parallel.path
===================================================================
--- /LMDZ6/branches/cirrus/arch/arch-local-gfortran-parallel.path	(revision 5202)
+++ /LMDZ6/branches/cirrus/arch/arch-local-gfortran-parallel.path	(revision 5202)
@@ -0,0 +1,21 @@
+NETCDF_INCDIR="-I$(nf-config --includedir) -I$(nc-config --includedir)"  # nc required for xios
+# Ugly hack for orchidee <=2.0
+NETCDF_LIBDIR="-L$(nf-config --flibs | sed -e "s/-L//")"
+NETCDF_LIB="-lnetcdff -lnetcdf"
+NETCDF95_INCDIR="-I$(pwd)/../../include"
+NETCDF95_LIBDIR="-L$(pwd)/../../lib"
+NETCDF95_LIB="-lnetcdf95"
+
+# Exported
+IOIPSL_INCDIR="-I$(pwd)/../IOIPSL/inc -I$(pwd)/../IOIPSL/lib"
+IOIPSL_LIBDIR="-L$(pwd)/../IOIPSL/inc -L$(pwd)/../IOIPSL/lib"
+IOIPSL_LIB="-lioipsl"
+
+# Exported
+XIOS_INCDIR="-I$(pwd)/../XIOS/inc"
+XIOS_LIBDIR="-L$(pwd)/../XIOS/lib"
+XIOS_LIB="-lxios -lstdc++"
+
+# Exported
+ORCH_INCDIR="-I$(pwd)/../ORCHIDEE/inc -I$(pwd)/../ORCHIDEE/lib"
+ORCH_LIBDIR="-L$(pwd)/../ORCHIDEE/inc -L$(pwd)/../ORCHIDEE/lib"
Index: /LMDZ6/branches/cirrus/arch/arch-local-gfortran.env
===================================================================
--- /LMDZ6/branches/cirrus/arch/arch-local-gfortran.env	(revision 5202)
+++ /LMDZ6/branches/cirrus/arch/arch-local-gfortran.env	(revision 5202)
@@ -0,0 +1,1 @@
+# empty
Index: /LMDZ6/branches/cirrus/arch/arch-local-gfortran.fcm
===================================================================
--- /LMDZ6/branches/cirrus/arch/arch-local-gfortran.fcm	(revision 5202)
+++ /LMDZ6/branches/cirrus/arch/arch-local-gfortran.fcm	(revision 5202)
@@ -0,0 +1,18 @@
+%COMPILER            gfortran
+%LINK                gfortran
+%FPP                 cpp
+%AR                  ar
+%ARFLAGS             rU
+%MAKE                make
+%FPP_FLAGS           -P -traditional
+%FPP_DEF             NC_DOUBLE
+%BASE_FFLAGS         -cpp -ffree-line-length-0 -fdefault-real-8 -DNC_DOUBLE -fallow-argument-mismatch -fimplicit-none
+%PROD_FFLAGS         -O3 -march=native
+%DEV_FFLAGS          -Wall -fbounds-check
+%DEBUG_FFLAGS        -g3 -Wall -fbounds-check -ffpe-trap=invalid,zero,overflow -O0 -fstack-protector-all -fbacktrace -finit-real=snan
+%MPI_FFLAGS
+%OMP_FFLAGS
+# /!\ LD must be written in Makefile syntax
+%BASE_LD             -Wl,-rpath=$(shell nf-config --prefix)/lib
+%MPI_LD
+%OMP_LD
Index: /LMDZ6/branches/cirrus/arch/arch-local-gfortran.path
===================================================================
--- /LMDZ6/branches/cirrus/arch/arch-local-gfortran.path	(revision 5202)
+++ /LMDZ6/branches/cirrus/arch/arch-local-gfortran.path	(revision 5202)
@@ -0,0 +1,21 @@
+NETCDF_INCDIR="-I$(nf-config --includedir) -I$(nc-config --includedir)"  # nc required for xios
+# Ugly hack for orchidee <=2.0
+NETCDF_LIBDIR="-L$(nf-config --flibs | sed -e "s/-L//")"
+NETCDF_LIB="-lnetcdff -lnetcdf"
+NETCDF95_INCDIR="-I$(pwd)/../../include"
+NETCDF95_LIBDIR="-L$(pwd)/../../lib"
+NETCDF95_LIB="-lnetcdf95"
+
+# Exported
+IOIPSL_INCDIR="-I$(pwd)/../IOIPSL/inc -I$(pwd)/../IOIPSL/lib"
+IOIPSL_LIBDIR="-L$(pwd)/../IOIPSL/inc -L$(pwd)/../IOIPSL/lib"
+IOIPSL_LIB="-lioipsl"
+
+# Exported
+XIOS_INCDIR="-I$(pwd)/../XIOS/inc"
+XIOS_LIBDIR="-L$(pwd)/../XIOS/lib"
+XIOS_LIB="-lxios -lstdc++"
+
+# Exported
+ORCH_INCDIR="-I$(pwd)/../ORCHIDEE/inc -I$(pwd)/../ORCHIDEE/lib"
+ORCH_LIBDIR="-L$(pwd)/../ORCHIDEE/inc -L$(pwd)/../ORCHIDEE/lib"
Index: /LMDZ6/branches/cirrus/libf/dyn3d/check_isotopes.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3d/check_isotopes.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3d/check_isotopes.F90	(revision 5202)
@@ -23,4 +23,5 @@
                              iso_O17, iso_HTO
    LOGICAL, SAVE :: first=.TRUE.
+   LOGICAL, PARAMETER :: tnat1=.TRUE.
 
    modname='check_isotopes'
@@ -34,5 +35,9 @@
       iso_O17 = strIdx(isoName,'H217O')
       iso_HTO = strIdx(isoName,'HTO')
-      IF(getKey('tnat', tnat)) CALL abort_gcm(modname, 'missing isotopic parameter', 1)
+      if (tnat1) then
+              tnat(:)=1.0
+      else
+         IF(getKey('tnat', tnat)) CALL abort_gcm(modname, 'missing isotopic parameter', 1)
+      endif
       first = .FALSE.
    END IF
Index: /LMDZ6/branches/cirrus/libf/dyn3d/conf_gcm.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3d/conf_gcm.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3d/conf_gcm.F90	(revision 5202)
@@ -18,5 +18,5 @@
   USE logic_mod, ONLY: fxyhypb, iflag_phys, ok_etat0, ok_gradsfile, &
                        ok_guide, ok_limit, ok_strato, purmats, read_start, &
-                       ysinus, read_orop
+                       ysinus, read_orop, adv_qsat_liq
   USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, &
                        alphax,alphay,taux,tauy
@@ -606,4 +606,13 @@
      type_trac = 'lmdz'
      CALL getin('type_trac',type_trac)
+
+
+     !Config  Key  = adv_qsat_liq
+     !Config  Desc = option for qsat calculation in the dynamics
+     !Config  Def  = n 
+     !Config  Help = controls which phase is considered for qsat calculation 
+     !Config          
+     adv_qsat_liq = .FALSE.
+     CALL getin('adv_qsat_liq',adv_qsat_liq)
 
      !Config  Key  = ok_dynzon 
@@ -672,4 +681,5 @@
      write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins 
      write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave 
+     write(lunout,*)' adv_qsat_liq = ', adv_qsat_liq
   ELSE
      !Config  Key  = clon
Index: /LMDZ6/branches/cirrus/libf/dyn3d/dynetat0.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3d/dynetat0.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3d/dynetat0.F90	(revision 5202)
@@ -43,4 +43,5 @@
   REAL    :: time, tnat, alpha_ideal, tab_cntrl(length)    !--- RUN PARAMS TABLE
   LOGICAL :: lSkip, ll
+  LOGICAL,PARAMETER :: tnat1=.TRUE.
 !-------------------------------------------------------------------------------
   modname="dynetat0"
@@ -155,6 +156,12 @@
       iqParent = tracers(iq)%iqParent
       IF(tracers(iq)%iso_iZone == 0) THEN
-         IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
+         if (tnat1) then
+                 tnat=1.0
+                 alpha_ideal=1.0
+                 write(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1'
+         else
+          IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
             CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
+         endif
          CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized with a simplified Rayleigh distillation law.', modname)
          q(:,:,:,iq) = q(:,:,:,iqParent)*tnat*(q(:,:,:,iqParent)/30.e-3)**(alpha_ideal-1.)
Index: /LMDZ6/branches/cirrus/libf/dyn3d/dynredem_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3d/dynredem_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3d/dynredem_mod.F90	(revision 5202)
@@ -4,5 +4,5 @@
   PRIVATE
   PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
-  PUBLIC :: cre_var, get_var1, put_var1, put_var2, fil, modname, msg
+  PUBLIC :: cre_var, put_var1, put_var2, fil, modname, msg
   include "dimensions.h"
   include "paramet.h"
Index: /LMDZ6/branches/cirrus/libf/dyn3d/iniacademic.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3d/iniacademic.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3d/iniacademic.F90	(revision 5202)
@@ -80,4 +80,5 @@
 
   REAL zdtvr, tnat, alpha_ideal
+  LOGICAL,PARAMETER :: tnat1=.true.
   
   character(len=*),parameter :: modname="iniacademic"
@@ -321,10 +322,22 @@
               iqParent = tracers(iq)%iqParent
               IF(tracers(iq)%iso_iZone == 0) THEN
-                 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
+                 if (tnat1) then
+                         tnat=1.0
+                         alpha_ideal=1.0
+                         write(*,*) 'Attention dans iniacademic: alpha_ideal=1'
+                 else
+                    IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
                     CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
+                 endif
                  q(:,:,iq) = q(:,:,iqParent)*tnat*(q(:,:,iqParent)/30.e-3)**(alpha_ideal-1.)
-              ELSE
-                 q(:,:,iq) = q(:,:,iqIsoPha(iName,iPhase))
-              END IF
+              ELSE !IF(tracers(iq)%iso_iZone == 0) THEN
+                 IF(tracers(iq)%iso_iZone == 1) THEN
+                    ! correction le 14 mai 2024 pour que tous les traceurs soient de la couleur 1.
+                    ! Sinon, on va avoir des porblèmes de conservation de masse de traceurs.
+                    q(:,:,iq) = q(:,:,iqIsoPha(iName,iPhase))
+                 else !IF(tracers(iq)%iso_iZone == 1) THEN
+                    q(:,:,iq) = 0.
+                 endif !IF(tracers(iq)%iso_iZone == 1) THEN
+              END IF !IF(tracers(iq)%iso_iZone == 0) THEN
            enddo
         else
Index: /LMDZ6/branches/cirrus/libf/dyn3d/logic_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3d/logic_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3d/logic_mod.F90	(revision 5202)
@@ -30,4 +30,6 @@
   LOGICAL hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
                  ! (only used if disvert_type==2)
+  LOGICAL adv_qsat_liq ! true if qsat is calculated alwats wrt liquid for
+                       ! adapted Van Leer advection scheme
   INTEGER iflag_phys ! type of physics to call: 0 none, 1: phy*** package,
                      ! 2: Held & Suarez, 101-200: aquaplanets & terraplanets
Index: /LMDZ6/branches/cirrus/libf/dyn3d/qminimum.F
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3d/qminimum.F	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3d/qminimum.F	(revision 5202)
@@ -28,4 +28,7 @@
 c     .................................................................
 c
+cDC iq_val and iq_liq are usable for q only, NOT for q_follow
+c   and zx_defau_diag (crash if iq_val/liq==3) => vapor/liquid
+c   water at hardcoded indices 1/2 in these variables
       INTEGER i, k, iq
       REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
@@ -58,37 +61,38 @@
 
       zx_defau_diag(:,:,:)=0.0
-      q_follow(:,:,1:2)=q(:,:,1:2)  
-      DO 1000 k = 1, llm
-        DO 1040 i = 1, ip1jmp1
+      q_follow(:,:,1)=q(:,:,iq_vap)  
+      q_follow(:,:,2)=q(:,:,iq_liq)  
+      DO k = 1, llm
+        DO i = 1, ip1jmp1
           if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
 
-              if (niso > 0) zx_defau_diag(i,k,iq_liq)=AMAX1
+            if (niso > 0) zx_defau_diag(i,k,2)=AMAX1
      :               ( seuil_liq - q(i,k,iq_liq), 0.0 )
 
-             q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
-             q(i,k,iq_liq) = seuil_liq
-           endif
- 1040   CONTINUE
- 1000 CONTINUE
+            q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
+            q(i,k,iq_liq) = seuil_liq
+          endif
+        ENDDO
+      ENDDO
 c
 c Quand l'eau vapeur est trop faible (ou negative), on complete
 c le defaut en prennant de l'eau vapeur de la couche au-dessous.
 c
-      iq = iq_vap
-c
       DO k = llm, 2, -1
 ccc      zx_abc = dpres(k) / dpres(k-1)
         DO i = 1, ip1jmp1
-          if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
+          if ( seuil_vap - q(i,k,iq_vap) .gt. 0.d0 ) then
 
-            if (niso > 0)
-     &        zx_defau_diag(i,k,iq)=AMAX1( seuil_vap - q(i,k,iq), 0.0 )
+            if (niso > 0) zx_defau_diag(i,k,1)
+     &           = AMAX1( seuil_vap - q(i,k,iq_vap), 0.0 )
 
-            q(i,k-1,iq) =  q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *
-     &                     deltap(i,k) / deltap(i,k-1)
-            q(i,k,iq)   =  seuil_vap  
+            q(i,k-1,iq_vap) = q(i,k-1,iq_vap) - (seuil_vap
+     &           -q(i,k,iq_vap)) * deltap(i,k)/deltap(i,k-1)
+            q(i,k,iq_vap)   =  seuil_vap  
+
           endif
         ENDDO
       ENDDO
+
 c
 c Quand il s'agit de la premiere couche au-dessus du sol, on
@@ -96,6 +100,6 @@
 c
       DO i = 1, ip1jmp1
-         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) )
-         q(i,1,iq)  = AMAX1( q(i,1,iq), seuil_vap )
+         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq_vap) )
+         q(i,1,iq_vap)  = AMAX1( q(i,1,iq_vap), seuil_vap )
       ENDDO
       pompe = SSUM(ip1jmp1,zx_pump,1)
@@ -121,5 +125,5 @@
       DO i = 1,ip1jmp1
         if (zx_pump(i).gt.0.0) then
-          q_follow(i,1,iq_vap)=q_follow(i,1,iq_vap)+zx_pump(i)
+          q_follow(i,1,1)=q_follow(i,1,1)+zx_pump(i)
         endif !if (zx_pump(i).gt.0.0) then
       enddo !DO i = 1,ip1jmp1
@@ -129,26 +133,26 @@
       do k=2,llm
         DO i = 1,ip1jmp1
-          if (zx_defau_diag(i,k,iq_vap).gt.0.0) then             
+          if (zx_defau_diag(i,k,1).gt.0.0) then             
               ! on ajoute la vapeur en k              
               do ixt=1,ntiso
                q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
-     :           +zx_defau_diag(i,k,iq_vap)
-     :           *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
+     :           +zx_defau_diag(i,k,1)
+     :           *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,1)
                 
               ! et on la retranche en k-1
                q(i,k-1,iqIsoPha(ixt,iq_vap))=
      :            q(i,k-1,iqIsoPha(ixt,iq_vap))
-     :              -zx_defau_diag(i,k,iq_vap)
+     :              -zx_defau_diag(i,k,1)
      :              *deltap(i,k)/deltap(i,k-1)
      :              *q(i,k-1,iqIsoPha(ixt,iq_vap))
-     :              /q_follow(i,k-1,iq_vap)
+     :              /q_follow(i,k-1,1)
 
               enddo !do ixt=1,niso
-              q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
-     :               +zx_defau_diag(i,k,iq_vap)
-              q_follow(i,k-1,iq_vap)=   q_follow(i,k-1,iq_vap)
-     :               -zx_defau_diag(i,k,iq_vap)
+              q_follow(i,k,1)=   q_follow(i,k,1)
+     :               +zx_defau_diag(i,k,1)
+              q_follow(i,k-1,1)=   q_follow(i,k-1,1)
+     :               -zx_defau_diag(i,k,1)
      :              *deltap(i,k)/deltap(i,k-1)
-          endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
+          endif !if (zx_defau_diag(i,k,1).gt.0.0) then
         enddo !DO i = 1, ip1jmp1        
        enddo !do k=2,llm
@@ -161,21 +165,21 @@
         do k=1,llm
         DO i = 1,ip1jmp1
-          if (zx_defau_diag(i,k,iq_liq).gt.0.0) then
+          if (zx_defau_diag(i,k,2).gt.0.0) then
 
               ! on ajoute eau liquide en k en k              
               do ixt=1,ntiso
                q(i,k,iqIsoPha(ixt,iq_liq))=q(i,k,iqIsoPha(ixt,iq_liq))
-     :              +zx_defau_diag(i,k,iq_liq)
-     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap)
+     :              +zx_defau_diag(i,k,2)
+     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1)
               ! et on la retranche à la vapeur en k
                q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
-     :              -zx_defau_diag(i,k,iq_liq)
-     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap)   
+     :              -zx_defau_diag(i,k,2)
+     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1)   
               enddo !do ixt=1,niso
-              q_follow(i,k,iq_liq)=   q_follow(i,k,iq_liq)
-     :               +zx_defau_diag(i,k,iq_liq)
-              q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
-     :               -zx_defau_diag(i,k,iq_liq)
-          endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
+              q_follow(i,k,2)=   q_follow(i,k,2)
+     :               +zx_defau_diag(i,k,2)
+              q_follow(i,k,1)=   q_follow(i,k,1)
+     :               -zx_defau_diag(i,k,2)
+          endif !if (zx_defau_diag(i,k,1).gt.0.0) then
         enddo !DO i = 1, ip1jmp1
        enddo !do k=2,llm  
Index: /LMDZ6/branches/cirrus/libf/dyn3d/vlspltqs.F
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3d/vlspltqs.F	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3d/vlspltqs.F	(revision 5202)
@@ -25,5 +25,5 @@
       
       USE comconst_mod, ONLY: cpp
-      
+      USE logic_mod, ONLY: adv_qsat_liq 
       IMPLICIT NONE
 c
@@ -92,5 +92,9 @@
          ENDDO
          DO ij = 1, ip1jmp1
-          zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
+          IF (adv_qsat_liq) THEN
+             zdelta = 0.
+          ELSE
+             zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
+          ENDIF
           play   = 0.5*(p(ij,l)+p(ij,l+1))
           qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij),zdelta) / play )
Index: /LMDZ6/branches/cirrus/libf/dyn3d_common/infotrac.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3d_common/infotrac.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3d_common/infotrac.F90	(revision 5202)
@@ -5,6 +5,6 @@
    USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse
    USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
-        delPhase, niso, getKey, isot_type, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
-        addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,   isoCheck, nbIso, ntiso, isoName
+        delPhase, niso, getKey, isot_type, processIsotopes,  isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
+        addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,  iqWIsoPha, nbIso, ntiso, isoName, isoCheck
    IMPLICIT NONE
 
@@ -36,5 +36,5 @@
 !  |--------------------+-----------------------+-----------------+---------------+----------------------------|
 !  | water in different |    water tagging      |  water isotopes | other tracers | additional tracers moments |
-!  | phases: H2O_[glsb] |      isotopes         |                 |               |  for higher order schemes  |
+!  | phases: H2O_[gls]  |      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 / "b"lowing) | /           | [g][l][s][b]           |
+!  | phase       | Phases list ("g"as / "l"iquid / "s"olid)             | /           | [g][l][s]              |
 !  | 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][b],1:4 |
+!  | phase  | nphas  | Phases                     list + number         |                    | [g][l][s], 1:3  |
 !  | 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         |
@@ -156,10 +156,8 @@
    INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)
    INTEGER :: iad                                                    !--- Advection scheme number
-   INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k                      !--- Indexes and temporary variables
+   INTEGER :: iq, jq, nt, im, nm                                     !--- Indexes and temporary variables
    LOGICAL :: lerr, ll
-   CHARACTER(LEN=1) :: p
    TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
    TYPE(trac_type), POINTER             :: t1, t(:)
-   INTEGER :: ierr
    CHARACTER(LEN=maxlen),   ALLOCATABLE :: types_trac(:)  !--- Keyword for tracers type(s), parsed version
 
@@ -225,5 +223,5 @@
    ttp = type_trac; IF(fType /= 1) ttp = texp
 
-   IF(readTracersFiles(ttp, type_trac == 'repr'))     CALL abort_gcm(modname, 'problem with tracers file(s)',1)
+   IF(readTracersFiles(ttp, lRepr=type_trac=='repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
    !---------------------------------------------------------------------------------------------------------------------------
    IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
@@ -236,5 +234,5 @@
       nbtr = nqINCA + nqCO2                                          !--- Number of tracers passed to phytrac
       nqtrue = nbtr + nqo                                            !--- Total number of "true" tracers
-      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)
+      IF(ALL([2,3] /= nqo)) CALL abort_gcm(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))
@@ -245,5 +243,5 @@
       ttr(1+nqo:nqCO2+nqo   )%component = 'co2i'
       ttr(1+nqo+nqCO2:nqtrue)%component = 'inca'
-      ttr(1+nqo      :nqtrue)%name      = [('CO2     ', k=1, nqCO2), solsym_inca]
+      ttr(1+nqo      :nqtrue)%name      = [('CO2     ', iq=1, nqCO2), solsym_inca]
       ttr(1+nqo+nqCO2:nqtrue)%parent    = tran0
       ttr(1+nqo+nqCO2:nqtrue)%phase     = 'g'
@@ -348,9 +346,9 @@
       IF(nm == 0) CYCLE                                              !--- No higher moments
       ttr(jq+1:jq+nm)             = t1
-      ttr(jq+1:jq+nm)%name        = [(TRIM(t1%name)    //'-'//TRIM(suff(im)), im=1, nm) ]
-      ttr(jq+1:jq+nm)%parent      = [(TRIM(t1%parent)  //'-'//TRIM(suff(im)), im=1, nm) ]
-      ttr(jq+1:jq+nm)%longName    = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
-      ttr(jq+1:jq+nm)%iadv        = [(-iad,    im=1, nm) ]
-      ttr(jq+1:jq+nm)%isAdvected  = [(.FALSE., im=1, nm) ]
+      ttr(jq+1:jq+nm)%name        = [ (TRIM(t1%name)    //'-'//TRIM(suff(im)), im=1, nm) ]
+      ttr(jq+1:jq+nm)%parent      = [ (TRIM(t1%parent)  //'-'//TRIM(suff(im)), im=1, nm) ]
+      ttr(jq+1:jq+nm)%longName    = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
+      ttr(jq+1:jq+nm)%iadv        = [ (-iad,    im=1, nm) ]
+      ttr(jq+1:jq+nm)%isAdvected  = [ (.FALSE., im=1, nm) ]
       jq = jq + nm
    END DO
@@ -359,5 +357,5 @@
 
    !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
-   CALL indexUpdate(tracers)
+   IF(indexUpdate(tracers)) CALL abort_gcm(modname, 'problem with tracers indices update', 1)
 
    !=== TEST ADVECTION SCHEME
@@ -384,5 +382,5 @@
    !=== READ PHYSICAL PARAMETERS FOR ISOTOPES ; DONE HERE BECAUSE dynetat0 AND iniacademic NEED "tnat" AND "alpha_ideal"
    niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
-   IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1)
+   IF(processIsotopes()) CALL abort_gcm(modname, 'problem when processing isotopes parameters', 1)
 
    !--- Convection / boundary layer activation for all tracers
@@ -393,5 +391,5 @@
    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_gcm(modname, 'problem with the computation of nqtottr', 1)
 
    !=== DISPLAY THE RESULTS
@@ -408,7 +406,7 @@
    t => tracers
    CALL msg('Information stored in infotrac :', modname)
-   IF(dispTable('isssssssssiiiiiiiii', &
-      ['iq    ', 'name  ', 'lName ', 'gen0N ', 'parent', 'type  ', 'phase ', 'compon', 'isPhy ', 'isAdv ', &
-       'iadv  ', 'iGen  ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'],          &
+
+   IF(dispTable('isssssssssiiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp',    &
+                'isPh', 'isAd', 'iadv', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'],   &
       cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics), &
                                                                                   bool2str(t%isAdvected)), &
Index: /LMDZ6/branches/cirrus/libf/dyn3dmem/check_isotopes_loc.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3dmem/check_isotopes_loc.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3dmem/check_isotopes_loc.F90	(revision 5202)
@@ -24,4 +24,5 @@
                              iso_O17, iso_HTO
    LOGICAL, SAVE :: first=.TRUE.
+   LOGICAL, PARAMETER :: tnat1=.TRUE.
 !$OMP THREADPRIVATE(first)
 
@@ -37,5 +38,9 @@
       iso_O17 = strIdx(isoName,'H217O')
       iso_HTO = strIdx(isoName,'HTO')
-      IF(getKey('tnat', tnat)) CALL abort_gcm(modname, 'missing isotopic parameter', 1)
+      if (tnat1) then
+              tnat(:)=1.0
+      else
+         IF(getKey('tnat', tnat)) CALL abort_gcm(modname, 'missing isotopic parameter', 1)
+      endif
 !$OMP END MASTER
 !$OMP BARRIER
Index: /LMDZ6/branches/cirrus/libf/dyn3dmem/conf_gcm.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3dmem/conf_gcm.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3dmem/conf_gcm.F90	(revision 5202)
@@ -22,5 +22,5 @@
   USE logic_mod, ONLY: fxyhypb, iflag_phys, ok_etat0, ok_gradsfile, &
                        ok_guide, ok_limit, ok_strato, purmats, read_start, &
-                       ysinus, read_orop
+                       ysinus, read_orop, adv_qsat_liq
   USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, &
                        alphax,alphay,taux,tauy
@@ -660,4 +660,13 @@
      type_trac = 'lmdz'
      CALL getin('type_trac',type_trac)
+
+
+     !Config  Key  = adv_qsat_liq
+     !Config  Desc = option for qsat calculation in the dynamics
+     !Config  Def  = n 
+     !Config  Help = controls which phase is considered for qsat calculation 
+     !Config          
+     adv_qsat_liq = .FALSE.
+     CALL getin('adv_qsat_liq',adv_qsat_liq)
 
      !Config  Key  = ok_dynzon 
@@ -736,4 +745,5 @@
      write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave 
      write(lunout,*)' ok_dyn_xios = ', ok_dyn_xios 
+     write(lunout,*)' adv_qsat_liq = ', adv_qsat_liq
   else
      !Config  Key  = clon
Index: /LMDZ6/branches/cirrus/libf/dyn3dmem/dynetat0_loc.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3dmem/dynetat0_loc.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3dmem/dynetat0_loc.F90	(revision 5202)
@@ -42,9 +42,11 @@
   INTEGER, PARAMETER :: length=100
   INTEGER :: iq, fID, vID, idecal, ierr, iqParent, iName, iZone, iPhase, ix
-  REAL    :: time, tnat, alpha_ideal, tab_cntrl(length)    !--- RUN PARAMS TABLE
+  REAL    :: time,tab_cntrl(length)    !--- RUN PARAMS TABLE
+  REAL    :: tnat, alpha_ideal
   REAL,             ALLOCATABLE :: vcov_glo(:,:),masse_glo(:,:),   ps_glo(:)
   REAL,             ALLOCATABLE :: ucov_glo(:,:),    q_glo(:,:), phis_glo(:)
   REAL,             ALLOCATABLE :: teta_glo(:,:)
   LOGICAL :: lSkip, ll
+  LOGICAL,PARAMETER :: tnat1=.TRUE.
 !-------------------------------------------------------------------------------
   modname="dynetat0_loc"
@@ -179,6 +181,12 @@
       iqParent = tracers(iq)%iqParent
       IF(tracers(iq)%iso_iZone == 0) THEN
-         IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
+         if (tnat1) then
+                 tnat=1.0
+                 alpha_ideal=1.0
+                 write(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1'
+         else
+          IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
             CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
+         endif
          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.)
@@ -193,5 +201,5 @@
          ! 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))
+           q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase))
          ELSE
            q(ijb_u:ije_u,:,iq) =  0.
Index: /LMDZ6/branches/cirrus/libf/dyn3dmem/dynredem_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3dmem/dynredem_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3dmem/dynredem_mod.F90	(revision 5202)
@@ -7,5 +7,5 @@
   PRIVATE
   PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
-  PUBLIC :: cre_var, get_var1, put_var, fil, modname, msg
+  PUBLIC :: cre_var, put_var, fil, modname, msg
   CHARACTER(LEN=256), SAVE :: fil, modname
   INTEGER,            SAVE :: nvarid
Index: DZ6/branches/cirrus/libf/dyn3dmem/filtreg_p.F
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3dmem/filtreg_p.F	(revision 5201)
+++ 	(revision )
@@ -1,432 +1,0 @@
-
-
-      SUBROUTINE filtreg_p ( champ, ibeg, iend, nlat, nbniv, 
-     &     ifiltre, iaire, griscal ,iter)
-      USE parallel_lmdz, only : OMP_CHUNK
-      USE mod_filtre_fft
-      USE timer_filtre
-      
-      USE filtreg_mod
-      
-      IMPLICIT NONE
-      
-c=======================================================================
-c
-c   Auteur: P. Le Van        07/10/97
-c   ------
-c
-c   Objet: filtre matriciel longitudinal ,avec les matrices precalculees
-c                     pour l'operateur  Filtre    .
-c   ------
-c
-c   Arguments:
-c   ----------
-c
-c      
-c      ibeg..iend            lattitude a filtrer
-c      nlat                  nombre de latitudes du champ
-c      nbniv                 nombre de niveaux verticaux a filtrer
-c      champ(iip1,nblat,nbniv)  en entree : champ a filtrer
-c                            en sortie : champ filtre
-c      ifiltre               +1  Transformee directe
-c                            -1  Transformee inverse
-c                            +2  Filtre directe
-c                            -2  Filtre inverse
-c
-c      iaire                 1   si champ intensif
-c                            2   si champ extensif (pondere par les aires)
-c
-c      iter                  1   filtre simple
-c
-c=======================================================================
-c
-c
-c                      Variable Intensive
-c                ifiltre = 1     filtre directe
-c                ifiltre =-1     filtre inverse
-c
-c                      Variable Extensive
-c                ifiltre = 2     filtre directe
-c                ifiltre =-2     filtre inverse
-c
-c
-      INCLUDE "dimensions.h"
-      INCLUDE "paramet.h"
-      INCLUDE "coefils.h"
-c
-      INTEGER ibeg,iend,nlat,nbniv,ifiltre,iter
-      INTEGER i,j,l,k
-      INTEGER iim2,immjm
-      INTEGER jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
-      
-      REAL  champ( iip1,nlat,nbniv)
-      
-      LOGICAL    griscal
-      INTEGER    hemisph, iaire
-      
-      REAL :: champ_fft(iip1,nlat,nbniv)
-      REAL :: champ_in(iip1,nlat,nbniv)
-      
-      LOGICAL,SAVE     :: first=.TRUE.
-c$OMP THREADPRIVATE(first) 
-
-      REAL, DIMENSION(iip1,nlat,nbniv) :: champ_loc
-      INTEGER :: ll_nb, nbniv_loc
-      REAL, SAVE :: sdd12(iim,4)
-c$OMP THREADPRIVATE(sdd12) 
-
-      INTEGER, PARAMETER :: type_sddu=1
-      INTEGER, PARAMETER :: type_sddv=2
-      INTEGER, PARAMETER :: type_unsddu=3
-      INTEGER, PARAMETER :: type_unsddv=4
-
-      INTEGER :: sdd1_type, sdd2_type
-
-      IF (first) THEN
-         sdd12(1:iim,type_sddu) = sddu(1:iim)
-         sdd12(1:iim,type_sddv) = sddv(1:iim)
-         sdd12(1:iim,type_unsddu) = unsddu(1:iim)
-         sdd12(1:iim,type_unsddv) = unsddv(1:iim)
-
-         CALL Init_timer
-         first=.FALSE.
-      ENDIF
-
-c$OMP MASTER      
-      CALL start_timer
-c$OMP END MASTER
-
-c-------------------------------------------------------c
-
-      IF(ifiltre.EQ.1.or.ifiltre.EQ.-1)
-     & CALL abort_gcm("fitreg_p","Pas de transformee simple 
-     &dans cette version",1)
-      
-      IF( iter.EQ. 2 )  THEN
-         PRINT *,' Pas d iteration du filtre dans cette version !'
-     &        , ' Utiliser old_filtreg et repasser !'
-         CALL abort_gcm("fitreg_p","stopped",1)
-      ENDIF
-
-      IF( ifiltre.EQ. -2 .AND..NOT.griscal )     THEN
-         PRINT *,' Cette routine ne calcule le filtre inverse que '
-     &        , ' sur la grille des scalaires !'
-         CALL abort_gcm("fitreg_p","stopped",1)
-      ENDIF
-
-      IF( ifiltre.NE.2 .AND.ifiltre.NE. - 2 )  THEN
-         PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
-     &        , ' corriger et repasser !'
-         CALL abort_gcm("fitreg_p","stopped",1)
-       ENDIF
-c
-
-      iim2   = iim * iim
-      immjm  = iim * jjm
-c
-c
-      IF( griscal )   THEN
-         IF( nlat. NE. jjp1 )  THEN
-            CALL abort_gcm("fitreg_p","nlat. NE. jjp1",1)
-         ELSE
-c     
-            IF( iaire.EQ.1 )  THEN
-               sdd1_type = type_sddv
-               sdd2_type = type_unsddv
-            ELSE
-               sdd1_type = type_unsddv
-               sdd2_type = type_sddv
-            ENDIF
-c
-            jdfil1 = 2
-            jffil1 = jfiltnu
-            jdfil2 = jfiltsu
-            jffil2 = jjm
-         ENDIF
-      ELSE
-         IF( nlat.NE.jjm )  THEN
-            CALL abort_gcm("fitreg_p","nlat. NE. jjm",1)
-         ELSE
-c
-            IF( iaire.EQ.1 )  THEN
-               sdd1_type = type_sddu
-               sdd2_type = type_unsddu
-            ELSE
-               sdd1_type = type_unsddu
-               sdd2_type = type_sddu
-            ENDIF
-c     
-            jdfil1 = 1
-            jffil1 = jfiltnv
-            jdfil2 = jfiltsv
-            jffil2 = jjm
-         ENDIF
-      ENDIF
-c      
-      DO hemisph = 1, 2
-c     
-         IF ( hemisph.EQ.1 )  THEN
-cym
-            jdfil = max(jdfil1,ibeg)
-            jffil = min(jffil1,iend)
-         ELSE
-cym
-            jdfil = max(jdfil2,ibeg)
-            jffil = min(jffil2,iend)
-         ENDIF
-
-
-cccccccccccccccccccccccccccccccccccccccccccc
-c Utilisation du filtre classique
-cccccccccccccccccccccccccccccccccccccccccccc
-
-         IF (.NOT. use_filtre_fft) THEN
-      
-c     !---------------------------------!
-c     ! Agregation des niveau verticaux !
-c     ! uniquement necessaire pour une  !
-c     ! execution OpenMP                !
-c     !---------------------------------!
-            ll_nb = 0
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-            DO l = 1, nbniv
-               ll_nb = ll_nb+1
-               DO j = jdfil,jffil
-                  DO i = 1, iim
-                     champ_loc(i,j,ll_nb) = 
-     &                    champ(i,j,l) * sdd12(i,sdd1_type)
-                  ENDDO
-               ENDDO
-            ENDDO
-c$OMP END DO NOWAIT
-
-            nbniv_loc = ll_nb
-
-            IF( hemisph.EQ.1 )      THEN
-               
-               IF( ifiltre.EQ.-2 )   THEN
-                  DO j = jdfil,jffil
-#ifdef BLAS
-                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
-     &                    matrinvn(1,1,j), iim, 
-     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
-     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
-#else
-                     champ_fft(:iim,j-jdfil+1,:)
-     &                    =matmul(matrinvn(:,:,j),champ_loc(:iim,j,:))
-#endif
-                  ENDDO
-                  
-               ELSE IF ( griscal )     THEN
-                  DO j = jdfil,jffil
-#ifdef BLAS
-                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
-     &                    matriceun(1,1,j), iim, 
-     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
-     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
-#else
-                     champ_fft(:iim,j-jdfil+1,:)
-     &                    =matmul(matriceun(:,:,j),champ_loc(:iim,j,:))
-#endif
-                  ENDDO
-                  
-               ELSE 
-                  DO j = jdfil,jffil
-#ifdef BLAS
-                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
-     &                    matricevn(1,1,j), iim, 
-     &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
-     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
-#else
-                     champ_fft(:iim,j-jdfil+1,:)
-     &                    =matmul(matricevn(:,:,j),champ_loc(:iim,j,:))
-#endif
-                  ENDDO
-                  
-               ENDIF
-               
-            ELSE
-               
-               IF( ifiltre.EQ.-2 )   THEN
-                  DO j = jdfil,jffil
-#ifdef BLAS
-                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
-     &                    matrinvs(1,1,j-jfiltsu+1), iim, 
-     &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
-     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
-#else
-                     champ_fft(:iim,j-jdfil+1,:)
-     &                    =matmul(matrinvs(:,:,j-jfiltsu+1),
-     &                            champ_loc(:iim,j,:))
-#endif
-                  ENDDO
-                  
-               ELSE IF ( griscal )     THEN
-                  
-                  DO j = jdfil,jffil
-#ifdef BLAS
-                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
-     &                    matriceus(1,1,j-jfiltsu+1), iim, 
-     &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
-     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
-#else
-                     champ_fft(:iim,j-jdfil+1,:)
-     &                    =matmul(matriceus(:,:,j-jfiltsu+1),
-     &                            champ_loc(:iim,j,:))
-#endif
-                  ENDDO
-                  
-               ELSE 
-                  
-                  DO j = jdfil,jffil
-#ifdef BLAS
-                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
-     &                    matricevs(1,1,j-jfiltsv+1), iim, 
-     &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
-     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
-#else
-                     champ_fft(:iim,j-jdfil+1,:)
-     &                    =matmul(matricevs(:,:,j-jfiltsv+1),
-     &                            champ_loc(:iim,j,:))
-#endif
-                  ENDDO
-                  
-               ENDIF
-               
-            ENDIF
-!     c     
-            IF( ifiltre.EQ.2 )  THEN
-               
-c     !-------------------------------------!
-c     ! Dés-agregation des niveau verticaux !
-c     ! uniquement necessaire pour une      !
-c     ! execution OpenMP                    !
-c     !-------------------------------------!
-               ll_nb = 0
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-               DO l = 1, nbniv
-                  ll_nb = ll_nb + 1
-                  DO j = jdfil,jffil
-                     DO i = 1, iim
-                        champ( i,j,l ) = (champ_loc(i,j,ll_nb) 
-     &                       + champ_fft(i,j-jdfil+1,ll_nb))
-     &                       * sdd12(i,sdd2_type)
-                     ENDDO
-                  ENDDO
-               ENDDO
-c$OMP END DO NOWAIT
-               
-            ELSE
-               
-               ll_nb = 0
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-               DO l = 1, nbniv_loc
-                  ll_nb = ll_nb + 1
-                  DO j = jdfil,jffil
-                     DO i = 1, iim
-                        champ( i,j,l ) = (champ_loc(i,j,ll_nb) 
-     &                       - champ_fft(i,j-jdfil+1,ll_nb))
-     &                       * sdd12(i,sdd2_type)
-                     ENDDO
-                  ENDDO
-               ENDDO
-c$OMP END DO NOWAIT
-               
-            ENDIF
-            
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-            DO l = 1, nbniv
-               DO j = jdfil,jffil
-                  champ( iip1,j,l ) = champ( 1,j,l )
-               ENDDO
-            ENDDO
-c$OMP END DO NOWAIT
-            
-ccccccccccccccccccccccccccccccccccccccccccccc
-c Utilisation du filtre FFT
-ccccccccccccccccccccccccccccccccccccccccccccc
-        
-         ELSE
-       
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-            DO l=1,nbniv
-               DO j=jdfil,jffil
-                  DO  i = 1, iim
-                     champ( i,j,l)= champ(i,j,l)*sdd12(i,sdd1_type)
-                     champ_fft( i,j,l) = champ(i,j,l)
-                  ENDDO
-               ENDDO
-            ENDDO
-c$OMP END DO NOWAIT
-
-            IF (jdfil<=jffil) THEN
-               IF( ifiltre. EQ. -2 )   THEN
-                  CALL Filtre_inv_fft(champ_fft,nlat,jdfil,jffil,nbniv) 
-               ELSE IF ( griscal )     THEN
-                  CALL Filtre_u_fft(champ_fft,nlat,jdfil,jffil,nbniv)
-               ELSE
-                  CALL Filtre_v_fft(champ_fft,nlat,jdfil,jffil,nbniv)
-               ENDIF
-            ENDIF
-
-
-            IF( ifiltre.EQ. 2 )  THEN
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)          
-               DO l=1,nbniv
-                  DO j=jdfil,jffil
-                     DO  i = 1, iim
-                        champ( i,j,l)=(champ(i,j,l)+champ_fft(i,j,l))
-     &                       *sdd12(i,sdd2_type)
-                     ENDDO
-                  ENDDO
-               ENDDO
-c$OMP END DO NOWAIT	  
-            ELSE
-        
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)  
-               DO l=1,nbniv
-                  DO j=jdfil,jffil
-                     DO  i = 1, iim
-                        champ(i,j,l)=(champ(i,j,l)-champ_fft(i,j,l))
-     &                       *sdd12(i,sdd2_type)
-                     ENDDO
-                  ENDDO
-               ENDDO
-c$OMP END DO NOWAIT          
-            ENDIF
-c
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
-            DO l=1,nbniv
-               DO j=jdfil,jffil
-!            champ_FFT( iip1,j,l ) = champ_FFT( 1,j,l )
-                  champ( iip1,j,l ) = champ( 1,j,l )
-               ENDDO
-            ENDDO
-c$OMP END DO NOWAIT          	
-         ENDIF 
-c Fin de la zone de filtrage
-
-	
-      ENDDO
-
-!      DO j=1,nlat
-!     
-!          PRINT *,"check FFT ----> Delta(",j,")=",
-!     &            sum(champ(:,j,:)-champ_fft(:,j,:))/sum(champ(:,j,:)),
-!     &            sum(champ(:,j,:)-champ_in(:,j,:))/sum(champ(:,j,:)) 
-!      ENDDO
-      
-!          PRINT *,"check FFT ----> Delta(",j,")=",
-!     &            sum(champ-champ_fft)/sum(champ)
-!      
-      
-c
- 1111 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a 
-     &     filtrer, sur la grille des scalaires'/)
- 2222 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a fi
-     &     ltrer, sur la grille de V ou de Z'/)
-c$OMP MASTER      
-      CALL stop_timer
-c$OMP END MASTER
-      RETURN
-      END
Index: /LMDZ6/branches/cirrus/libf/dyn3dmem/gcm.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3dmem/gcm.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3dmem/gcm.F90	(revision 5202)
@@ -480,5 +480,5 @@
   !$OMP COPYIN(saison,ecripar,fxyhypb,ysinus,read_start,ok_guide) &
   !$OMP COPYIN(ok_strato,ok_gradsfile,ok_limit,ok_etat0) &
-  !$OMP COPYIN(iflag_phys,iflag_trac)
+  !$OMP COPYIN(iflag_phys,iflag_trac,adv_qsat_liq)
   CALL leapfrog_loc(ucov,vcov,teta,ps,masse,phis,q,time_0)
   !$OMP END PARALLEL
Index: /LMDZ6/branches/cirrus/libf/dyn3dmem/iniacademic_loc.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3dmem/iniacademic_loc.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3dmem/iniacademic_loc.F90	(revision 5202)
@@ -85,4 +85,5 @@
 
   REAL zdtvr, tnat, alpha_ideal
+  LOGICAL,PARAMETER :: tnat1=.true.
   
   character(len=*),parameter :: modname="iniacademic"
@@ -323,10 +324,22 @@
               iqParent = tracers(iq)%iqParent
               IF(tracers(iq)%iso_iZone == 0) THEN
-                 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
+                 if (tnat1) then
+                         tnat=1.0
+                         alpha_ideal=1.0
+                         write(*,*) 'Attention dans iniacademic: alpha_ideal=1'
+                 else
+                    IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
                     CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
+                 endif
                  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.)
-              ELSE
-                 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase))
-              END IF
+              ELSE !IF(tracers(iq)%iso_iZone == 0) THEN
+                 IF(tracers(iq)%iso_iZone == 1) THEN ! a verifier.
+                    ! correction le 14 mai 2024 pour que tous les traceurs soient de la couleur 1.
+                    ! Sinon, on va avoir des porblèmes de conservation de masse de traceurs.
+                    q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase))
+                 else !IF(tracers(iq)%iso_iZone == 1) THEN
+                    q(ijb_u:ije_u,:,iq) = 0.0
+                 endif !IF(tracers(iq)%iso_iZone == 1) THEN
+              END IF !IF(tracers(iq)%iso_iZone == 0) THEN
            enddo
         else
Index: /LMDZ6/branches/cirrus/libf/dyn3dmem/logic_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3dmem/logic_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3dmem/logic_mod.F90	(revision 5202)
@@ -30,4 +30,6 @@
   LOGICAL hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
                  ! (only used if disvert_type==2)
+  LOGICAL adv_qsat_liq ! true if qsat is calculated alwats wrt liquid for
+                       ! adapted Van Leer advection scheme
   INTEGER iflag_phys ! type of physics to call: 0 none, 1: phy*** package,
                      ! 2: Held & Suarez, 101-200: aquaplanets & terraplanets
@@ -37,5 +39,5 @@
 !$OMP     apdiss,apdelq,saison,ecripar,fxyhypb,ysinus, &
 !$OMP     read_start,ok_guide,ok_strato,ok_gradsfile, &
-!$OMP     ok_limit,ok_etat0,hybrid)
+!$OMP     ok_limit,ok_etat0,hybrid, adv_qsat_liq)
 !$OMP THREADPRIVATE(iflag_phys,iflag_trac)
 
Index: /LMDZ6/branches/cirrus/libf/dyn3dmem/qminimum_loc.F
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3dmem/qminimum_loc.F	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3dmem/qminimum_loc.F	(revision 5202)
@@ -31,4 +31,7 @@
 c     .................................................................
 c
+cDC iq_val and iq_liq are usable for q only, NOT for q_follow
+c   and zx_defau_diag (crash if iq_val/liq==3) => vapor/liquid
+c   water at hardcoded indices 1/2 in these variables
       INTEGER i, k, iq
       REAL zx_defau, zx_abc, zx_pump(ijb_u:ije_u), pompe
@@ -49,9 +52,4 @@
       INTEGER ixt
       INTEGER iso_verif_noNaN_nostop
-c
-c Quand l'eau liquide est trop petite (ou negative), on prend
-c l'eau vapeur de la meme couche et la convertit en eau liquide
-c (sans changer la temperature !)
-c
 
 c$OMP BARRIER
@@ -63,4 +61,10 @@
          first = .FALSE.
       END IF
+c
+c Quand l'eau liquide est trop petite (ou negative), on prend
+c l'eau vapeur de la meme couche et la convertit en eau liquide
+c (sans changer la temperature !)
+c
+
       call check_isotopes(q,ij_begin,ij_end,'qminimum 52')   
 
@@ -73,6 +77,6 @@
           zx_defau_diag(i,k,1)=0.0
           zx_defau_diag(i,k,2)=0.0
-          q_follow(i,k,1)=q(i,k,1)
-          q_follow(i,k,2)=q(i,k,2)
+          q_follow(i,k,1)=q(i,k,iq_vap)
+          q_follow(i,k,2)=q(i,k,iq_liq)
         ENDDO
 c$OMP END DO NOWAIT
@@ -80,18 +84,18 @@
 
       !write(lunout,*) 'qminimum 57'
-      DO 1000 k = 1, llm
+      DO k = 1, llm
 c$OMP DO SCHEDULE(STATIC)       
-      DO 1040 i = ijb, ije
-            if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
-
-              if (niso > 0) zx_defau_diag(i,k,iq_liq)=AMAX1
+        DO i = ijb, ije
+          if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
+
+            if (niso > 0) zx_defau_diag(i,k,2)=AMAX1
      :               ( seuil_liq - q(i,k,iq_liq), 0.0 )
 
-               q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
-               q(i,k,iq_liq) = seuil_liq
-            endif
- 1040 CONTINUE
-c$OMP END DO NOWAIT
- 1000 CONTINUE
+            q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
+            q(i,k,iq_liq) = seuil_liq
+          endif
+        END DO
+c$OMP END DO NOWAIT
+      END DO
 
 c
@@ -100,22 +104,20 @@
 c
       !write(lunout,*) 'qminimum 81'
-      iq = iq_vap
-c
       DO k = llm, 2, -1
 ccc      zx_abc = dpres(k) / dpres(k-1)
 c$OMP DO SCHEDULE(STATIC)
-      DO i = ijb, ije
-
-         if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
-
-            if (niso > 0)
-     &        zx_defau_diag(i,k,iq)=AMAX1( seuil_vap - q(i,k,iq), 0.0 )
-
-            q(i,k-1,iq) =  q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *
-     &           deltap(i,k) / deltap(i,k-1)
-            q(i,k,iq)   =  seuil_vap  
-
-         endif
-      ENDDO
+        DO i = ijb, ije
+
+          if ( seuil_vap - q(i,k,iq_vap) .gt. 0.d0 ) then
+
+            if (niso > 0) zx_defau_diag(i,k,1)
+     &           = AMAX1( seuil_vap - q(i,k,iq_vap), 0.0 )
+
+            q(i,k-1,iq_vap) = q(i,k-1,iq_vap) - (seuil_vap
+     &           -q(i,k,iq_vap)) * deltap(i,k)/deltap(i,k-1)
+            q(i,k,iq_vap)   =  seuil_vap  
+
+          endif
+        ENDDO
 c$OMP END DO NOWAIT
       ENDDO
@@ -129,6 +131,6 @@
 c$OMP DO SCHEDULE(STATIC)
       DO i = ijb, ije
-         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) )
-         q(i,1,iq)  = AMAX1( q(i,1,iq), seuil_vap )
+         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq_vap) )
+         q(i,1,iq_vap)  = AMAX1( q(i,1,iq_vap), seuil_vap )
          IF (zx_pump(i) > 0.0) THEN
             nb_pump = nb_pump+1
@@ -165,5 +167,5 @@
       DO i = ijb, ije
         if (zx_pump(i).gt.0.0) then
-          q_follow(i,1,iq_vap)=q_follow(i,1,iq_vap)+zx_pump(i)
+          q_follow(i,1,1)=q_follow(i,1,1)+zx_pump(i)
         endif !if (zx_pump(i).gt.0.0) then
       enddo !DO i = ijb, ije  
@@ -175,13 +177,13 @@
 c$OMP DO SCHEDULE(STATIC)      
         DO i = ijb, ije
-          if (zx_defau_diag(i,k,iq_vap).gt.0.0) then             
+          if (zx_defau_diag(i,k,1).gt.0.0) then             
               ! on ajoute la vapeur en k     
-!              write(lunout,*) 'i,k,q_follow(i,k-1,iq_vap)=',
-!     :                 i,k,q_follow(i,k-1,iq_vap)          
-              if (q_follow(i,k-1,iq_vap).lt.min_qParent) then
+!              write(lunout,*) 'i,k,q_follow(i,k-1,ivap)=',
+!     :                 i,k,q_follow(i,k-1,1)          
+              if (q_follow(i,k-1,1).lt.min_qParent) then
                 write(lunout,*) 'tmp qmin: on stoppe'
                 write(lunout,*) 'zx_pump(i)=',zx_pump(i)
-                write(lunout,*) 'q_follow(i,:,iq_vap)=',
-     :                   q_follow(i,:,iq_vap)
+                write(lunout,*) 'q_follow(i,:,ivap)=',
+     :                   q_follow(i,:,1)
                 write(lunout,*) 'k=',k
                 call abort_gcm("qminimum","not enough vapor",1)
@@ -189,14 +191,14 @@
             do ixt=1,ntiso
 !                write(lunout,*) 'qmin 168: ixt=',ixt
-!                write(lunout,*) 'q(i,k,iqIsoPha(ixt,iq_vap)=',
+!                write(lunout,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=',
 !     :             q(i,k,iqIsoPha(ixt,iq_vap))
-!                write(lunout,*) 'zx_defau_diag(i,k,iq_vap)=',
-!     :                  zx_defau_diag(i,k,iq_vap)
-!                write(lunout,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap)=',
+!                write(lunout,*) 'zx_defau_diag(i,k,ivap)=',
+!     :                  zx_defau_diag(i,k,1)
+!                write(lunout,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=',
 !     :                   q(i,k-1,iqIsoPha(ixt,iq_vap))     
 
                q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
-     :           +zx_defau_diag(i,k,iq_vap)
-     :           *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
+     :           +zx_defau_diag(i,k,1)
+     :           *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,1)
                 
               if (isoCheck) then
@@ -204,10 +206,10 @@
      :                   'qminimum 155').eq.1) then
                    write(*,*) 'i,k,ixt=',i,k,ixt
-                   write(*,*) 'q_follow(i,k-1,iq_vap)=',
-     :                   q_follow(i,k-1,iq_vap)
+                   write(*,*) 'q_follow(i,k-1,ivap)=',
+     :                   q_follow(i,k-1,1)
                    write(*,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=',
      :                   q(i,k,iqIsoPha(ixt,iq_vap))
-                   write(*,*) 'zx_defau_diag(i,k,iq_vap)=',
-     :                   zx_defau_diag(i,k,iq_vap)
+                   write(*,*) 'zx_defau_diag(i,k,ivap)=',
+     :                   zx_defau_diag(i,k,1)
                    write(*,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=',
      :                   q(i,k-1,iqIsoPha(ixt,iq_vap))
@@ -219,8 +221,8 @@
                q(i,k-1,iqIsoPha(ixt,iq_vap)) =
      :            q(i,k-1,iqIsoPha(ixt,iq_vap))
-     :              -zx_defau_diag(i,k,iq_vap)
+     :              -zx_defau_diag(i,k,1)
      :              *deltap(i,k)/deltap(i,k-1)
      :              *q(i,k-1,iqIsoPha(ixt,iq_vap))
-     :              /q_follow(i,k-1,iq_vap)
+     :              /q_follow(i,k-1,1)
 
                if (isoCheck) then
@@ -229,10 +231,10 @@
      :                   'qminimum 175').eq.1) then
                    write(*,*) 'k,i,ixt=',k,i,ixt
-                   write(*,*) 'q_follow(i,k-1,iq_vap)=',
-     :                   q_follow(i,k-1,iq_vap)
+                   write(*,*) 'q_follow(i,k-1,ivap)=',
+     :                   q_follow(i,k-1,1)
                    write(*,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=',
      :                   q(i,k,iqIsoPha(ixt,iq_vap))
-                   write(*,*) 'zx_defau_diag(i,k,iq_vap)=',
-     :                   zx_defau_diag(i,k,iq_vap)
+                   write(*,*) 'zx_defau_diag(i,k,ivap)=',
+     :                   zx_defau_diag(i,k,1)
                    write(*,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=',
      :                   q(i,k-1,iqIsoPha(ixt,iq_vap))
@@ -242,10 +244,10 @@
 
               enddo !do ixt=1,niso
-              q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
-     :               +zx_defau_diag(i,k,iq_vap)
-              q_follow(i,k-1,iq_vap)=   q_follow(i,k-1,iq_vap)
-     :               -zx_defau_diag(i,k,iq_vap)
+              q_follow(i,k,1)=   q_follow(i,k,1)
+     :               +zx_defau_diag(i,k,1)
+              q_follow(i,k-1,1)=   q_follow(i,k-1,1)
+     :               -zx_defau_diag(i,k,1)
      :              *deltap(i,k)/deltap(i,k-1)
-          endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
+          endif !if (zx_defau_diag(i,k,1).gt.0.0) then
         enddo !DO i = 1, ip1jmp1        
 c$OMP END DO NOWAIT
@@ -260,21 +262,21 @@
 c$OMP DO SCHEDULE(STATIC)
         DO i = ijb, ije
-          if (zx_defau_diag(i,k,iq_liq).gt.0.0) then
+          if (zx_defau_diag(i,k,2).gt.0.0) then
 
               ! on ajoute eau liquide en k en k              
               do ixt=1,ntiso
                q(i,k,iqIsoPha(ixt,iq_liq))=q(i,k,iqIsoPha(ixt,iq_liq))
-     :              +zx_defau_diag(i,k,iq_liq)
-     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap)
+     :              +zx_defau_diag(i,k,2)
+     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1)
               ! et on la retranche à la vapeur en k
                q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
-     :              -zx_defau_diag(i,k,iq_liq)
-     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap)   
+     :              -zx_defau_diag(i,k,2)
+     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1)   
               enddo !do ixt=1,niso
-              q_follow(i,k,iq_liq)=   q_follow(i,k,iq_liq)
-     :               +zx_defau_diag(i,k,iq_liq)
-              q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
-     :               -zx_defau_diag(i,k,iq_liq)
-          endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
+              q_follow(i,k,2)=   q_follow(i,k,2)
+     :               +zx_defau_diag(i,k,2)
+              q_follow(i,k,1)=   q_follow(i,k,1)
+     :               -zx_defau_diag(i,k,2)
+          endif !if (zx_defau_diag(i,k,1).gt.0.0) then
         enddo !DO i = ijb, ije
 c$OMP END DO NOWAIT       
Index: /LMDZ6/branches/cirrus/libf/dyn3dmem/vlspltgen_loc.F
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3dmem/vlspltgen_loc.F	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3dmem/vlspltgen_loc.F	(revision 5202)
@@ -10,5 +10,5 @@
 c
 c    ********************************************************************
-c          Shema  d'advection " pseudo amont " .
+c          Schema  d'advection " pseudo amont " .
 c      + test sur humidite specifique: Q advecte< Qsat aval
 c                   (F. Codron, 10/99)
@@ -32,4 +32,5 @@
       USE vlspltgen_mod
       USE comconst_mod, ONLY: cpp
+      USE logic_mod, ONLY: adv_qsat_liq
       IMPLICIT NONE
 
@@ -108,5 +109,9 @@
          ENDDO
          DO ij = ijb, ije
-          zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
+          IF (adv_qsat_liq) THEN
+             zdelta = 0.
+          ELSE
+             zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
+          ENDIF
           play   = 0.5*(p(ij,l)+p(ij,l+1))
           qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij),zdelta) / play )
Index: /LMDZ6/branches/cirrus/libf/dyn3dmem/vlspltqs_loc.F
===================================================================
--- /LMDZ6/branches/cirrus/libf/dyn3dmem/vlspltqs_loc.F	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/dyn3dmem/vlspltqs_loc.F	(revision 5202)
@@ -806,5 +806,5 @@
          IF (pole_sud) THEN
          
-           convps  = -SSUM(iim,qbyv(ip1jm-iim,l,iq),iq,1)/apols
+           convps  = -SSUM(iim,qbyv(ip1jm-iim,l,iq),1)/apols
            convmps = -SSUM(iim,masse_adv_v(ip1jm-iim,l),1)/apols
            DO ij = ip1jm+1,ip1jmp1
Index: /LMDZ6/branches/cirrus/libf/misc/readTracFiles_mod.f90
===================================================================
--- /LMDZ6/branches/cirrus/libf/misc/readTracFiles_mod.f90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/misc/readTracFiles_mod.f90	(revision 5202)
@@ -1,6 +1,7 @@
 MODULE readTracFiles_mod
 
-  USE strings_mod,    ONLY: msg, find, get_in, str2int, dispTable, strHead,  strReduce,  strFind, strStack, strIdx, &
-       test, removeComment, cat, fmsg, maxlen, int2str, checkList, strParse, strReplace, strTail, strCount, reduceExpr
+  USE strings_mod,    ONLY: msg, find, get_in, dispTable, strHead,  strReduce,  strFind, strStack, strIdx, &
+             removeComment, cat, fmsg, maxlen, checkList, strParse, strReplace, strTail, strCount, reduceExpr, &
+             int2str, str2int, real2str, str2real, bool2str, str2bool
 
   IMPLICIT NONE
@@ -9,21 +10,19 @@
 
   PUBLIC :: maxlen                                              !--- PARAMETER FOR CASUAL STRING LENGTH
-  PUBLIC :: tracers                                             !--- TRACERS  DESCRIPTION DATABASE
-  PUBLIC :: trac_type, setGeneration, indexUpdate               !--- TRACERS  DESCRIPTION ASSOCIATED TOOLS
+  PUBLIC :: trac_type, tracers, setGeneration, indexUpdate      !--- TRACERS  DESCRIPTION DATABASE + ASSOCIATED TOOLS
   PUBLIC :: testTracersFiles, readTracersFiles                  !--- TRACERS FILES READING ROUTINES
-  PUBLIC :: getKey, fGetKey, fGetKeys, addKey, setDirectKeys    !--- TOOLS TO GET/SET KEYS FROM/TO  tracers & isotopes
-  PUBLIC :: getKeysDBase,    setKeysDBase                       !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
-
-  PUBLIC :: addPhase, getiPhase,  old_phases, phases_sep, &     !--- FUNCTIONS RELATED TO THE PHASES
-   nphases, delPhase, getPhase, known_phases, phases_names      !--- + ASSOCIATED VARIABLES
+  PUBLIC :: getKeysDBase, setKeysDBase                          !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
+  PUBLIC :: addTracer, delTracer                                !--- ADD/REMOVE A TRACER FROM
+  PUBLIC :: addKey,    delKey,    getKey,    keys_type          !--- TOOLS TO SET/DEL/GET KEYS FROM/TO  tracers & isotopes
+  PUBLIC :: addPhase,  delPhase,  getPhase,  getiPhase,  &      !--- FUNCTIONS RELATED TO THE PHASES
+   nphases, old_phases, phases_sep, known_phases, phases_names  !--- + ASSOCIATED VARIABLES
 
   PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O        !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
   PUBLIC :: oldHNO3,   newHNO3                                  !--- HNO3 REPRO   BACKWARD COMPATIBILITY (OLD start.nc)
 
-  PUBLIC :: tran0, idxAncestor, ancestor                        !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
+  PUBLIC :: tran0                                               !--- TRANSPORTING FLUID (USUALLY air)
 
   !=== FOR ISOTOPES: GENERAL
-  PUBLIC :: isot_type, readIsotopesFile, isoSelect              !--- ISOTOPES DESCRIPTION TYPE + READING ROUTINE
-  PUBLIC :: ixIso, nbIso                                        !--- INDEX OF SELECTED ISOTOPES CLASS + NUMBER OF CLASSES
+  PUBLIC :: isot_type, processIsotopes, isoSelect, ixIso, nbIso !--- PROCESS [AND READ] & SELECT ISOTOPES + CLASS IDX & NUMBER
 
   !=== FOR ISOTOPES: H2O FAMILY ONLY
@@ -36,75 +35,84 @@
   PUBLIC :: itZonIso                                            !--- Idx IN isoName(1:niso) = f(tagging idx, isotope idx)
   PUBLIC :: iqIsoPha                                            !--- Idx IN qx(1:nqtot)     = f(isotope idx,   phase idx)
+  PUBLIC :: iqWIsoPha                                           !--- Idx IN qx(1:nqtot)     = f(isotope idx,   phase idx) but with normal water first
   PUBLIC :: isoCheck                                            !--- FLAG TO RUN ISOTOPES CHECKING ROUTINES
 
   PUBLIC :: maxTableWidth
 !------------------------------------------------------------------------------------------------------------------------------
-  TYPE :: keys_type                                        !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
-    CHARACTER(LEN=maxlen)              :: name             !--- Tracer name
-    CHARACTER(LEN=maxlen), ALLOCATABLE :: key(:)           !--- Keys string list
-    CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)           !--- Corresponding values string list
+  TYPE :: keys_type                                             !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
+    CHARACTER(LEN=maxlen)              :: name                  !--- Tracer name
+    CHARACTER(LEN=maxlen), ALLOCATABLE :: key(:)                !--- Keys string list
+    CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)                !--- Corresponding values string list
   END TYPE keys_type
 !------------------------------------------------------------------------------------------------------------------------------
-  TYPE :: trac_type                                        !=== TYPE FOR A SINGLE TRACER NAMED "name"
-    CHARACTER(LEN=maxlen) :: name        = ''              !--- Name of the tracer
-    CHARACTER(LEN=maxlen) :: gen0Name    = ''              !--- First generation ancestor name
-    CHARACTER(LEN=maxlen) :: parent      = ''              !--- Parent name
-    CHARACTER(LEN=maxlen) :: longName    = ''              !--- Long name (with advection scheme suffix)
-    CHARACTER(LEN=maxlen) :: type        = 'tracer'        !--- Type  (so far: 'tracer' / 'tag')
-    CHARACTER(LEN=maxlen) :: phase       = 'g'             !--- Phase ('g'as / 'l'iquid / 's'olid)
-    CHARACTER(LEN=maxlen) :: component   = ''              !--- Coma-separated list of components (Ex: lmdz,inca)
-    INTEGER               :: iGeneration = -1              !--- Generation number (>=0)
-    INTEGER               :: iqParent    = 0               !--- Parent index
-    INTEGER,  ALLOCATABLE :: iqDescen(:)                   !--- Descendants index (in growing generation order)
-    INTEGER               :: nqDescen    = 0               !--- Number of descendants (all generations)
-    INTEGER               :: nqChildren  = 0               !--- Number of children  (first generation)
-    TYPE(keys_type)       :: keys                          !--- <key>=<val> pairs vector
-    INTEGER               :: iadv        = 10              !--- Advection scheme used
-    LOGICAL               :: isAdvected  = .FALSE.         !--- "true" tracers: iadv > 0.   COUNT(isAdvected )=nqtrue
-    LOGICAL               :: isInPhysics = .TRUE.          !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
-    INTEGER               :: iso_iGroup  = 0               !--- Isotopes group index in isotopes(:)
-    INTEGER               :: iso_iName   = 0               !--- Isotope  name  index in isotopes(iso_iGroup)%trac(:)
-    INTEGER               :: iso_iZone   = 0               !--- Isotope  zone  index in isotopes(iso_iGroup)%zone(:)
-    INTEGER               :: iso_iPhase  = 0               !--- Isotope  phase index in isotopes(iso_iGroup)%phase
+  TYPE :: trac_type                                             !=== TYPE FOR A SINGLE TRACER NAMED "name"
+    CHARACTER(LEN=maxlen) :: name        = ''                   !--- Name of the tracer
+    TYPE(keys_type)       :: keys                               !--- <key>=<val> pairs vector
+    CHARACTER(LEN=maxlen) :: gen0Name    = ''                   !--- First generation ancestor name
+    CHARACTER(LEN=maxlen) :: parent      = ''                   !--- Parent name
+    CHARACTER(LEN=maxlen) :: longName    = ''                   !--- Long name (with advection scheme suffix)
+    CHARACTER(LEN=maxlen) :: type        = 'tracer'             !--- Type  (so far: 'tracer' / 'tag')
+    CHARACTER(LEN=maxlen) :: phase       = 'g'                  !--- Phase ('g'as / 'l'iquid / 's'olid)
+    CHARACTER(LEN=maxlen) :: component   = ''                   !--- Coma-separated list of components (Ex: lmdz,inca)
+    INTEGER               :: iGeneration = -1                   !--- Generation number (>=0)
+    INTEGER               :: iqParent    = 0                    !--- Parent index
+    INTEGER,  ALLOCATABLE :: iqDescen(:)                        !--- Descendants index (in growing generation order)
+    INTEGER               :: nqDescen    = 0                    !--- Number of descendants (all generations)
+    INTEGER               :: nqChildren  = 0                    !--- Number of children  (first generation)
+    INTEGER               :: iadv        = 10                   !--- Advection scheme used
+    LOGICAL               :: isAdvected  = .FALSE.              !--- "true" tracers: iadv > 0.   COUNT(isAdvected )=nqtrue
+    LOGICAL               :: isInPhysics = .TRUE.               !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
+    INTEGER               :: iso_iGroup  = 0                    !--- Isotopes group index in isotopes(:)
+    INTEGER               :: iso_iName   = 0                    !--- Isotope  name  index in isotopes(iso_iGroup)%trac(:)
+    INTEGER               :: iso_iZone   = 0                    !--- Isotope  zone  index in isotopes(iso_iGroup)%zone(:)
+    INTEGER               :: iso_iPhase  = 0                    !--- Isotope  phase index in isotopes(iso_iGroup)%phase
   END TYPE trac_type
 !------------------------------------------------------------------------------------------------------------------------------
-  TYPE :: isot_type                                        !=== TYPE FOR AN ISOTOPES FAMILY DESCENDING ON TRACER "parent"
-    CHARACTER(LEN=maxlen)              :: parent           !--- Isotopes family name (parent tracer name ; ex: H2O)
-    LOGICAL                            :: check=.FALSE.    !--- Triggering of the checking routines
-    TYPE(keys_type),       ALLOCATABLE :: keys(:)          !--- Isotopes keys/values pairs list     (length: niso)
-    CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:)          !--- Isotopes + tagging tracers list     (length: ntiso)
-    CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:)          !--- Geographic tagging zones names list (length: nzone)
-    CHARACTER(LEN=maxlen)              :: phase = 'g'      !--- Phases list: [g][l][s]              (length: nphas)
-    INTEGER                            :: niso  = 0        !--- Number of isotopes, excluding tagging tracers
-    INTEGER                            :: nzone = 0        !--- Number of geographic tagging zones
-    INTEGER                            :: ntiso = 0        !--- Number of isotopes, including tagging tracers
-    INTEGER                            :: nphas = 0        !--- Number phases
-    INTEGER,               ALLOCATABLE :: iqIsoPha(:,:)    !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
-                                                           !---        "iqIsoPha" former name: "iqiso"
-    INTEGER,               ALLOCATABLE :: itZonIso(:,:)    !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
-                                                           !---        "itZonIso" former name: "index_trac"
-  END TYPE isot_type
+  TYPE :: isot_type                                             !=== TYPE FOR AN ISOTOPES FAMILY DESCENDING ON TRACER "parent"
+    CHARACTER(LEN=maxlen)              :: parent                !--- Isotopes family name (parent tracer name ; ex: H2O)
+    TYPE(keys_type),       ALLOCATABLE :: keys(:)               !--- Isotopes keys/values pairs list     (length: niso)
+    LOGICAL                            :: check=.FALSE.         !--- Flag for checking routines triggering
+    CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:)               !--- Isotopes + tagging tracers list     (length: ntiso)
+    CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:)               !--- Geographic tagging zones names list (length: nzone)
+    CHARACTER(LEN=maxlen)              :: phase = 'g'           !--- Phases list: [g][l][s]              (length: nphas)
+    INTEGER                            :: niso  = 0             !--- Number of isotopes, excluding tagging tracers
+    INTEGER                            :: ntiso = 0             !--- Number of isotopes, including tagging tracers
+    INTEGER                            :: nzone = 0             !--- Number of geographic tagging zones
+    INTEGER                            :: nphas = 0             !--- Number of phases
+    INTEGER,               ALLOCATABLE :: iqIsoPha(:,:)         !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso),phas)
+                                                                !---        (former name: "iqiso"
+    INTEGER,               ALLOCATABLE :: iqWIsoPha(:,:)        !--- Idx in "tracers(1:nqtot)" = f([H2O,name(1:ntiso)],phas)
+    INTEGER,               ALLOCATABLE :: itZonIso(:,:)         !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
+  END TYPE isot_type                                            !---        (former name: "index_trac")
 !------------------------------------------------------------------------------------------------------------------------------
   TYPE :: dataBase_type                                         !=== TYPE FOR TRACERS SECTION
-    CHARACTER(LEN=maxlen)  :: name                              !--- Section name
+    CHARACTER(LEN=maxlen) :: name                               !--- Section name
     TYPE(trac_type), ALLOCATABLE :: trac(:)                     !--- Tracers descriptors
   END TYPE dataBase_type
 !------------------------------------------------------------------------------------------------------------------------------
   INTERFACE getKey
-    MODULE PROCEDURE getKeyByName_s1, getKeyByName_s1m, getKeyByName_sm, getKey_sm, &
-                     getKeyByName_i1, getKeyByName_i1m, getKeyByName_im, getKey_im, &
-                     getKeyByName_r1, getKeyByName_r1m, getKeyByName_rm, getKey_rm, &
-                     getKeyByName_l1, getKeyByName_l1m, getKeyByName_lm, getKey_lm
+    MODULE PROCEDURE &
+       getKeyByIndex_s111, getKeyByIndex_sm11, getKeyByIndex_s1m1, getKeyByIndex_smm1, getKeyByIndex_s1mm, getKeyByIndex_smmm, &
+       getKeyByIndex_i111, getKeyByIndex_im11, getKeyByIndex_i1m1, getKeyByIndex_imm1, getKeyByIndex_i1mm, getKeyByIndex_immm, &
+       getKeyByIndex_r111, getKeyByIndex_rm11, getKeyByIndex_r1m1, getKeyByIndex_rmm1, getKeyByIndex_r1mm, getKeyByIndex_rmmm, &
+       getKeyByIndex_l111, getKeyByIndex_lm11, getKeyByIndex_l1m1, getKeyByIndex_lmm1, getKeyByIndex_l1mm, getKeyByIndex_lmmm, &
+        getKeyByName_s111,  getKeyByName_sm11,  getKeyByName_s1m1,  getKeyByName_smm1,  getKeyByName_s1mm,  getKeyByName_smmm, &
+        getKeyByName_i111,  getKeyByName_im11,  getKeyByName_i1m1,  getKeyByName_imm1,  getKeyByName_i1mm,  getKeyByName_immm, &
+        getKeyByName_r111,  getKeyByName_rm11,  getKeyByName_r1m1,  getKeyByName_rmm1,  getKeyByName_r1mm,  getKeyByName_rmmm, &
+        getKeyByName_l111,  getKeyByName_lm11,  getKeyByName_l1m1,  getKeyByName_lmm1,  getKeyByName_l1mm,  getKeyByName_lmmm
   END INTERFACE getKey
 !------------------------------------------------------------------------------------------------------------------------------
-  INTERFACE    isoSelect;  MODULE PROCEDURE  isoSelectByIndex,  isoSelectByName; END INTERFACE isoSelect
-  INTERFACE  old2newH2O;   MODULE PROCEDURE  old2newH2O_1,  old2newH2O_m;        END INTERFACE old2newH2O
-  INTERFACE  new2oldH2O;   MODULE PROCEDURE  new2oldH2O_1,  new2oldH2O_m;        END INTERFACE new2oldH2O
-  INTERFACE fGetKey;       MODULE PROCEDURE fgetKeyIdx_s1, fgetKeyNam_s1;        END INTERFACE fGetKey
-  INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset
-  INTERFACE idxAncestor;   MODULE PROCEDURE idxAncestor_1, idxAncestor_m, idxAncestor_mt;    END INTERFACE idxAncestor
-  INTERFACE    ancestor;   MODULE PROCEDURE    ancestor_1,    ancestor_m,    ancestor_mt;    END INTERFACE    ancestor
-  INTERFACE      addKey;   MODULE PROCEDURE      addKey_1; END INTERFACE addKey!,      addKey_m,     addKey_mm;     END INTERFACE addKey
-  INTERFACE    addPhase;   MODULE PROCEDURE   addPhase_s1,   addPhase_sm,   addPhase_i1,   addPhase_im; END INTERFACE addPhase
+  INTERFACE addKey
+    MODULE PROCEDURE addKey_s11, addKey_s1m, addKey_smm, addKey_i11, addKey_i1m, addKey_imm, &
+                     addKey_r11, addKey_r1m, addKey_rmm, addKey_l11, addKey_l1m, addKey_lmm
+  END INTERFACE addKey
+!------------------------------------------------------------------------------------------------------------------------------
+  INTERFACE     isoSelect; MODULE PROCEDURE  isoSelectByIndex,  isoSelectByName; END INTERFACE isoSelect
+  INTERFACE    old2newH2O; MODULE PROCEDURE  old2newH2O_1,  old2newH2O_m;        END INTERFACE old2newH2O
+  INTERFACE    new2oldH2O; MODULE PROCEDURE  new2oldH2O_1,  new2oldH2O_m;        END INTERFACE new2oldH2O
+  INTERFACE     addTracer; MODULE PROCEDURE   addTracer_1, addTracer_1def;       END INTERFACE addTracer
+  INTERFACE     delTracer; MODULE PROCEDURE   delTracer_1, delTracer_1def;       END INTERFACE delTracer
+  INTERFACE      addPhase; MODULE PROCEDURE   addPhase_s1,  addPhase_sm,  addPhase_i1,  addPhase_im; END INTERFACE addPhase
+  INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx,     trSubset_Name,     trSubset_gen0Name; END INTERFACE tracersSubset
 !------------------------------------------------------------------------------------------------------------------------------
 
@@ -114,12 +122,10 @@
   !--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
   CHARACTER(LEN=maxlen), SAVE      :: tran0        = 'air'      !--- Default transporting fluid
-  CHARACTER(LEN=maxlen), PARAMETER :: old_phases   = 'vlifbc'     !--- Old phases for water (no separator)
-  CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsfbc'     !--- 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  ', 'fracld ', 'blosnow', 'cldvapr']
-  CHARACTER(LEN=1), SAVE :: phases_sep  =  '_'                  !--- Phase separator
-  LOGICAL,          SAVE :: tracs_merge = .TRUE.                !--- Merge/stack tracers lists
-  LOGICAL,          SAVE :: lSortByGen  = .TRUE.                !--- Sort by growing generation
+                                = ['gaseous  ', 'liquid   ', 'solid    ', 'cloud    ','blownSnow']
+  CHARACTER(LEN=1),      SAVE :: phases_sep  =  '_'             !--- Phase separator
   CHARACTER(LEN=maxlen), SAVE :: isoFile = 'isotopes_params.def'!--- Name of the isotopes parameters file
 
@@ -128,5 +134,5 @@
   CHARACTER(LEN=maxlen), SAVE :: newH2OIso(5) = ['H216O', 'HDO  ', 'H218O', 'H217O', 'HTO  ']
 
-  !--- CORRESPONDANCE BETWEEN OLD AND NEW HNO3 RELATED SPECIES NAMES
+  !--- CORRESPONDANCE BETWEEN OLD AND NEW HNO3 RELATED SPECIES NAMES (FOR REPROBUS)
   CHARACTER(LEN=maxlen), SAVE ::   oldHNO3(2) = ['HNO3_g ', 'HNO3   ']
   CHARACTER(LEN=maxlen), SAVE ::   newHNO3(2) = ['HNO3   ', 'HNO3tot']
@@ -138,5 +144,5 @@
   !=== ALIASES OF VARIABLES FROM SELECTED ISOTOPES FAMILY EMBEDDED IN "isotope" (isotopes(ixIso))
   TYPE(isot_type),         SAVE, POINTER :: isotope             !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
-  INTEGER,                 SAVE          :: ixIso, iH2O         !--- Index of the selected isotopes family and H2O family
+  INTEGER,                 SAVE          :: ixIso, iH2O=0       !--- Index of the selected isotopes family and H2O family
   INTEGER,                 SAVE          :: nbIso               !--- Number of isotopes classes
   LOGICAL,                 SAVE          :: isoCheck            !--- Flag to trigger the checking routines
@@ -148,5 +154,10 @@
                                             nphas, ntiso        !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
   INTEGER,                 SAVE, POINTER ::itZonIso(:,:), &     !--- INDEX IN "isoTrac" AS f(tagging zone idx,  isotope idx)
-                                           iqIsoPha(:,:)        !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
+                                           iqIsoPha(:,:), &     !--- INDEX IN "qx" AS f(isotopic tracer idx, phase idx)
+                                           iqWIsoPha(:,:)       !--- INDEX IN "qx" AS f(H2O + isotopic tracer idx, phase idx)
+
+  !=== PARAMETERS FOR DEFAULT BEHAVIOUR
+  LOGICAL, PARAMETER :: lTracsMerge = .FALSE.                   !--- Merge/stack tracers lists
+  LOGICAL, PARAMETER :: lSortByGen  = .TRUE.                    !--- Sort by growing generation
 
   INTEGER,    PARAMETER :: maxTableWidth = 192                  !--- Maximum width of a table displayed with "dispTable"
@@ -179,11 +190,13 @@
 !     * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
 !==============================================================================================================================
-LOGICAL FUNCTION readTracersFiles(type_trac, lRepr) RESULT(lerr)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=*),  INTENT(IN)  :: type_trac                        !--- List of components used
-  LOGICAL, OPTIONAL, INTENT(IN)  :: lRepr                            !--- Activate the HNNO3 exceptions for REPROBUS
+LOGICAL FUNCTION readTracersFiles(type_trac, tracs, lRepr) RESULT(lerr)
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=*),                               INTENT(IN)  :: type_trac     !--- List of components used
+  TYPE(trac_type), ALLOCATABLE, TARGET, OPTIONAL, INTENT(OUT) :: tracs(:)      !--- Tracers descriptor for external storage
+  LOGICAL,                              OPTIONAL, INTENT(IN)  :: lRepr         !--- Activate the HNO3 exceptions for REPROBUS
   CHARACTER(LEN=maxlen),  ALLOCATABLE :: s(:), sections(:), trac_files(:)
   CHARACTER(LEN=maxlen) :: str, fname, tname, pname, cname
   INTEGER               :: nsec, ierr, it, ntrac, ns, ip, ix, fType
+  INTEGER, ALLOCATABLE  :: iGen(:)
   LOGICAL :: lRep
   TYPE(keys_type), POINTER :: k
@@ -195,26 +208,25 @@
 
   !--- Required sections + corresponding files names (new style single section case) for tests
-  IF(test(testTracersFiles(modname, type_trac, fType, .FALSE., trac_files, sections), lerr)) RETURN
+  lerr = testTracersFiles(modname, type_trac, fType, .FALSE., trac_files, sections); IF(lerr) RETURN
   nsec = SIZE(sections)
 
   !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  SELECT CASE(fType)                         !--- Set %name, %genOName, %parent, %type, %phase, %component, %iGeneration, %keys
+  SELECT CASE(fType)                         !--- Set name, component, parent, phase, iGeneration, gen0Name, type
   !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     CASE(1)                                                          !=== OLD FORMAT "traceur.def"
     !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
       !--- OPEN THE "traceur.def" FILE
-      OPEN(90, FILE="traceur.def", FORM='formatted', STATUS='old', IOSTAT=ierr)
+      OPEN(90, FILE="traceur.def", FORM='formatted', STATUS='old', POSITION='REWIND', IOSTAT=ierr)
 
       !--- GET THE TRACERS NUMBER
       READ(90,'(i3)',IOSTAT=ierr)ntrac                               !--- Number of lines/tracers
-      IF(test(fmsg('Invalid format for "'//TRIM(fname)//'"', modname, ierr /= 0), lerr)) RETURN
+      lerr = ierr/=0; IF(fmsg('Invalid format for "'//TRIM(fname)//'"', modname, lerr)) RETURN
 
       !--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
-      IF(ALLOCATED(tracers)) DEALLOCATE(tracers)
       ALLOCATE(tracers(ntrac))
-      DO it=1,ntrac                                                  !=== READ RAW DATA: loop on the line/tracer number
+      DO it = 1, ntrac                                               !=== READ RAW DATA: loop on the line/tracer number
         READ(90,'(a)',IOSTAT=ierr) str
-        IF(test(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, ierr>0), lerr)) RETURN
-        IF(test(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, ierr<0), lerr)) RETURN
+        lerr = ierr>0; IF(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, lerr)) RETURN
+        lerr = ierr<0; IF(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, lerr)) RETURN
         lerr = strParse(str, ' ', s, ns)
         CALL msg('This file is for air tracers only',           modname, ns == 3 .AND. it == 1)
@@ -226,6 +238,6 @@
         ix = strIdx(oldHNO3, s(3))
         IF(ix /= 0 .AND. lRep) tname = newHNO3(ix)                   !--- Exception for HNO3 (REPROBUS ONLY)
-        tracers(it)%name = tname                                     !--- Set %name
-        CALL addKey_1('name', tname, k)                              !--- Set the name of the tracer
+        tracers(it)%name = tname                                     !--- Set the name of the tracer
+        CALL addKey('name', tname, k)                                !--- Set the name of the tracer
         tracers(it)%keys%name = tname                                !--- Copy tracers names in keys components
 
@@ -233,6 +245,6 @@
         cname = type_trac                                            !--- Name of the model component
         IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
-        tracers(it)%component = cname                                !--- Set %component
-        CALL addKey_1('component', cname, k)                         !--- Set the name of the model component
+        tracers(it)%component = cname                                !--- Set component
+        CALL addKey('component', cname, k)                           !--- Set the name of the model component
 
         !=== NAME OF THE PARENT
@@ -243,41 +255,41 @@
           IF(ix /= 0 .AND. lRep) pname = newHNO3(ix)                 !--- Exception for HNO3 (REPROBUS ONLY)
         END IF
-        tracers(it)%parent = pname                                   !--- Set %parent
-        CALL addKey_1('parent', pname, k)
+        tracers(it)%parent = pname                                   !--- Set the parent name
+        CALL addKey('parent', pname, k)
 
         !=== PHASE AND ADVECTION SCHEMES NUMBERS
-        tracers(it)%phase = known_phases(ip:ip)                      !--- Set %phase:  tracer phase (default: "g"azeous)
-        CALL addKey_1('phase', known_phases(ip:ip), k)               !--- Set the phase  of the tracer (default: "g"azeous)
-        CALL addKey_1('hadv', s(1),  k)                              !--- Set the horizontal advection schemes number
-        CALL addKey_1('vadv', s(2),  k)                              !--- Set the vertical   advection schemes number
+        tracers(it)%phase = known_phases(ip:ip)                      !--- Set the phase of the tracer (default: "g"azeous)
+        CALL addKey('phase', known_phases(ip:ip), k)                 !--- Set the phase of the tracer (default: "g"azeous)
+        CALL addKey('hadv', s(1),  k)                                !--- Set the horizontal advection schemes number
+        CALL addKey('vadv', s(2),  k)                                !--- Set the vertical   advection schemes number
       END DO
       CLOSE(90)
-      IF(test(setGeneration(tracers), lerr)) RETURN                  !--- Set %iGeneration and %gen0Name
-      WHERE(tracers%iGeneration == 2) tracers(:)%type = 'tag'        !--- Set %type:        'tracer' or 'tag'
-      DO it=1,ntrac
-        CALL addKey_1('type', tracers(it)%type, tracers(it)%keys)    !--- Set the type of tracer
+      lerr = setGeneration(tracers); IF(lerr) RETURN                 !--- Set iGeneration and gen0Name
+      lerr = getKey('iGeneration', iGen, tracers(:)%keys)            !--- Generation number
+      WHERE(iGen == 2) tracers(:)%type = 'tag'                       !--- Set type:      'tracer' or 'tag'
+      DO it = 1, ntrac
+        CALL addKey('type', tracers(it)%type, tracers(it)%keys)      !--- Set the type of tracer
       END DO
-      IF(test(checkTracers(tracers, fname, fname), lerr)) RETURN     !--- Detect orphans and check phases
-      IF(test(checkUnique (tracers, fname, fname), lerr)) RETURN     !--- Detect repeated tracers
-      CALL sortTracers    (tracers)                                  !--- Sort the tracers
+      lerr = checkTracers(tracers, fname, fname); IF(lerr) RETURN    !--- Detect orphans and check phases
+      lerr = checkUnique (tracers, fname, fname); IF(lerr) RETURN    !--- Detect repeated tracers
+      CALL sortTracers   (tracers)                                   !--- Sort the tracers
     !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-    CASE(2); IF(test(feedDBase(["tracer.def"], [type_trac], modname), lerr)) RETURN !=== SINGLE   FILE, MULTIPLE SECTIONS
+    CASE(2); lerr=feedDBase(["tracer.def"], [type_trac], modname); IF(lerr) RETURN  !=== SINGLE   FILE, MULTIPLE SECTIONS
     !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-    CASE(3); IF(test(feedDBase(  trac_files  ,  sections,   modname), lerr)) RETURN !=== MULTIPLE FILES, SINGLE  SECTION
+    CASE(3); lerr=feedDBase(  trac_files  ,  sections,   modname); IF(lerr) RETURN  !=== MULTIPLE FILES, SINGLE  SECTION
   !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   END SELECT
   !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   IF(ALL([2,3] /= fType)) RETURN
-
-  IF(nsec  == 1) THEN; 
-    tracers = dBase(1)%trac
-  ELSE IF(tracs_merge) THEN
-    CALL msg('The multiple required sections will be MERGED.',    modname)
-    IF(test(mergeTracers(dBase, tracers), lerr)) RETURN
-  ELSE
-    CALL msg('The multiple required sections will be CUMULATED.', modname)
-    IF(test(cumulTracers(dBase, tracers), lerr)) RETURN
+  IF(nsec == 1) tracers = dBase(1)%trac
+  IF(nsec /= 1) THEN
+    CALL msg('Multiple sections are MERGED',    modname,      lTracsMerge)
+    CALL msg('Multiple sections are CUMULATED', modname, .NOT.lTracsMerge)
+    IF(     lTracsMerge) lerr = cumulTracers(dBase, tracers)
+    IF(.NOT.lTracsMerge) lerr = cumulTracers(dBase, tracers)
+    IF(lerr) RETURN
   END IF
-  CALL setDirectKeys(tracers)                                        !--- Set %iqParent, %iqDescen, %nqDescen, %nqChildren
+  lerr = indexUpdate(tracers); IF(lerr) RETURN                       !--- Set iqParent, iqDescen, nqDescen, nqChildren
+  IF(PRESENT(tracs)) CALL MOVE_ALLOC(FROM=tracers, TO=tracs)
 END FUNCTION readTracersFiles
 !==============================================================================================================================
@@ -299,5 +311,5 @@
   !--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINGLE SECTION PER FILE)
   !--- If type_trac is a scalar (case 1), "sections" and "trac_files" are not usable, but are meaningless for case 1 anyway.
-  IF(test(strParse(type_trac, '|', sections,  n=nsec), lerr)) RETURN !--- Parse "type_trac" list
+  lerr = strParse(type_trac, '|', sections, n=nsec); IF(lerr) RETURN !--- Parse "type_trac" list
   IF(PRESENT(sects)) sects = sections
   ALLOCATE(trac_files(nsec), ll(nsec))
@@ -313,5 +325,5 @@
   IF(.NOT.lD) RETURN                                                 !--- NO CHECKING/DISPLAY NEEDED: JUST GET type_trac,fType
   IF(ANY(ll) .AND. fType/=3) THEN                                    !--- MISSING FILES
-    IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
+    lerr = checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'); IF(lerr) RETURN
   END IF
 
@@ -344,6 +356,6 @@
   ll = strCount(snames, '|', ndb)                                    !--- Number of sections for each file
   ALLOCATE(ixf(SUM(ndb)))
-  DO i=1, SIZE(fnames)                                               !--- Set %name, %keys
-    IF(test(readSections(fnames(i), snames(i), 'default'), lerr)) RETURN
+  DO i=1, SIZE(fnames)                                               !--- Set name, keys
+    lerr = readSections(fnames(i), snames(i), 'default'); IF(lerr) RETURN
     ixf(1+SUM(ndb(1:i-1)):SUM(ndb(1:i))) = i                         !--- File index for each section of the expanded list
   END DO
@@ -353,10 +365,10 @@
     fnm = fnames(ixf(idb)); snm = dBase(idb)%name                    !--- FILE AND SECTION NAMES
     lerr = ANY([(dispTraSection('RAW CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
-    IF(test(expandSection(dBase(idb)%trac, snm, fnm), lerr)) RETURN  !--- EXPAND NAMES ;  set %parent, %type, %component
-    IF(test(setGeneration(dBase(idb)%trac),           lerr)) RETURN  !---                 set %iGeneration,   %genOName
-    IF(test(checkTracers (dBase(idb)%trac, snm, fnm), lerr)) RETURN  !--- CHECK ORPHANS AND PHASES
-    IF(test(checkUnique  (dBase(idb)%trac, snm, fnm), lerr)) RETURN  !--- CHECK TRACERS UNIQUENESS
-    CALL expandPhases    (dBase(idb)%trac)                           !--- EXPAND PHASES ; set %phase
-    CALL sortTracers     (dBase(idb)%trac)                           !--- SORT TRACERS
+    lerr = expandSection(dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- EXPAND NAMES ;  SET parent, type, component
+    lerr = setGeneration(dBase(idb)%trac);           IF(lerr) RETURN !---                 SET iGeneration,  genOName
+    lerr = checkTracers (dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- CHECK ORPHANS AND PHASES
+    lerr = checkUnique  (dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- CHECK TRACERS UNIQUENESS
+    lerr = expandPhases (dBase(idb)%trac);           IF(lerr) RETURN !--- EXPAND PHASES ; set phase
+    CALL sortTracers    (dBase(idb)%trac)                            !--- SORT TRACERS
     lerr = ANY([(dispTraSection('EXPANDED CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
   !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@@ -387,5 +399,5 @@
   ll = strParse(snam, '|', keys = sec)                               !--- Requested sections names
   ix = strIdx(dBase(:)%name, sec(:))                                 !--- Indexes of requested sections in database
-  IF(test(checkList(sec, ix == 0, 'In file "'//TRIM(fnam)//'"','section(s)', 'missing'), lerr)) RETURN
+  lerr = checkList(sec, ix == 0, 'In file "'//TRIM(fnam)//'"','section(s)', 'missing'); IF(lerr) RETURN
   tdb = dBase(:); dBase = [tdb(1:n0-1),tdb(PACK(ix, MASK=ix/=0))]    !--- Keep requested sections only
 
@@ -403,5 +415,5 @@
 !------------------------------------------------------------------------------------------------------------------------------
   IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
-  OPEN(90, FILE=fnam, FORM='formatted', STATUS='old')
+  OPEN(90, FILE=fnam, FORM='formatted', POSITION='REWIND', STATUS='old')
   DO; str=''
     DO
@@ -416,4 +428,5 @@
     IF(str(1:1)=='#') CYCLE                                          !--- Skip comments lines
     CALL removeComment(str)                                          !--- Skip comments at the end of a line
+    IF(LEN_TRIM(str) == 0) CYCLE                                     !--- Empty line (probably end of file)
     IF(str     == '') CYCLE                                          !--- Skip empty line (probably at the end of the file)
     IF(str(1:1)=='&') THEN                                           !=== SECTION HEADER LINE
@@ -431,8 +444,8 @@
       ll = strParse(str,' ', s, n, v)                                !--- Parse <key>=<val> pairs
       tt = dBase(ndb)%trac(:)
-      tmp%name = s(1); tmp%keys = keys_type(s(1), s(2:n), v(2:n))    !--- Set %name and %keys
+      v(1) = s(1); s(1) = 'name'                                     !--- Convert "name" into a regular key
+      tmp%name = v(1); tmp%keys = keys_type(v(1), s(:), v(:))        !--- Set %name and %keys
       dBase(ndb)%trac = [tt(:), tmp]
-      DEALLOCATE(tt)
-!      dBase(ndb)%trac = [dBase(ndb)%trac(:), tra(name=s(1), keys=keys_type(s(1), s(2:n), v(2:n)))]
+      DEALLOCATE(tt, tmp%keys%key, tmp%keys%val)
     END IF
   END DO
@@ -460,6 +473,6 @@
   ky => t(jd)%keys
   DO k = 1, SIZE(ky%key)                                             !--- Loop on the keys of the tracer named "defName"
-!   CALL addKey_m(ky%key(k), ky%val(k), t(:)%keys, .FALSE.)           !--- Add key to all the tracers (no overwriting)
-    DO it = 1, SIZE(t); CALL addKey_1(ky%key(k), ky%val(k), t(it)%keys, .FALSE.); END DO
+!   CALL addKey(ky%key(k), ky%val(k), t(:)%keys, .FALSE.)            !--- Add key to all the tracers (no overwriting)
+    DO it = 1, SIZE(t); CALL addKey(ky%key(k), ky%val(k), t(it)%keys, .FALSE.); END DO
   END DO
   tt = [t(1:jd-1),t(jd+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t)   !--- Remove the virtual tracer named "defName"
@@ -506,8 +519,8 @@
 !------------------------------------------------------------------------------------------------------------------------------
   TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:)                 !--- Tracer derived type vector
-  CHARACTER(LEN=*),             INTENT(IN)    :: sname
-  CHARACTER(LEN=*), OPTIONAL,   INTENT(IN)    :: fname
+  CHARACTER(LEN=*),             INTENT(IN)    :: sname                 !--- Current section name
+  CHARACTER(LEN=*), OPTIONAL,   INTENT(IN)    :: fname                 !--- Tracers description file name
   TYPE(trac_type),       ALLOCATABLE :: ttr(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:), tname(:), parent(:), dType(:)
   CHARACTER(LEN=maxlen) :: msg1, modname
   INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr
@@ -516,4 +529,7 @@
   lerr = .FALSE.
   nt = SIZE(tr)
+  lerr = getKey('name',   tname,  tr(:)%keys);                 IF(lerr) RETURN
+  lerr = getKey('parent', parent, tr(:)%keys, def = tran0);    IF(lerr) RETURN
+  lerr = getKey('type',   dType,  tr(:)%keys, def = 'tracer'); IF(lerr) RETURN
   nq = 0
   !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@@ -521,19 +537,17 @@
   !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     !--- Extract useful keys: parent name, type, component name
-    tr(it)%parent    = fgetKey(it, 'parent', tr(:)%keys,  tran0  )
-    tr(it)%type      = fgetKey(it, 'type'  , tr(:)%keys, 'tracer')
     tr(it)%component = sname
-!   CALL addKey_m('component', sname, tr(:)%keys)
-    DO iq=1,SIZE(tr); CALL addKey_1('component', sname, tr(iq)%keys); END DO
+    CALL addKey('component', sname,  tr(it)%keys)
 
     !--- Determine the number of tracers and parents ; coherence checking
-    ll = strCount(tr(it)%name,   ',', ntr)
-    ll = strCount(tr(it)%parent, ',', npr)
+    ll = strCount( tname(it), ',', ntr)
+    ll = strCount(parent(it), ',', npr)
 
     !--- Tagging tracers only can have multiple parents
-    IF(test(npr/=1 .AND. TRIM(tr(it)%type)/='tag', lerr)) THEN
+    lerr = npr /=1 .AND. TRIM(dType(it)) /= 'tag'
+    IF(lerr) THEN
       msg1 = 'Check section "'//TRIM(sname)//'"'
-      IF(PRESENT(fname)) msg1=TRIM(msg1)//' in file "'//TRIM(fname)//'"'
-      CALL msg(TRIM(msg1)//': "'//TRIM(tr(it)%name)//'" has several parents but is not a tag', modname); RETURN
+      IF(PRESENT(fname)) msg1 = TRIM(msg1)//' in file "'//TRIM(fname)//'"'
+      CALL msg(TRIM(msg1)//': "'//TRIM(tname(it))//'" has several parents but is not a tag', modname); RETURN
     END IF
     nq = nq + ntr*npr                 
@@ -547,16 +561,20 @@
   DO it = 1, nt                                                      !=== EXPAND TRACERS AND PARENTS NAMES LISTS
   !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-    ll = strParse(tr(it)%name,   ',', ta, ntr)                       !--- Number of tracers
-    ll = strParse(tr(it)%parent, ',', pa, npr)                       !--- Number of parents
-    DO ipr=1,npr                                                     !--- Loop on parents list elts
-      DO itr=1,ntr                                                   !--- Loop on tracers list elts
+    ll = strParse( tname(it), ',', ta, ntr)                          !--- Number of tracers
+    ll = strParse(parent(it), ',', pa, npr)                          !--- Number of parents
+    DO ipr = 1, npr                                                  !--- Loop on parents list elts
+      DO itr = 1, ntr                                                !--- Loop on tracers list elts
+        ttr(iq)%keys%name = TRIM(ta(itr))
         ttr(iq)%keys%key  = tr(it)%keys%key
         ttr(iq)%keys%val  = tr(it)%keys%val
-        ttr(iq)%keys%name = ta(itr)
-        ttr(iq)%name      = TRIM(ta(itr));    CALL addKey_1('name',      ta(itr),          ttr(iq)%keys)
-        ttr(iq)%parent    = TRIM(pa(ipr));    CALL addKey_1('parent',    pa(ipr),          ttr(iq)%keys)
-        ttr(iq)%type      = tr(it)%type;      CALL addKey_1('type',      tr(it)%type,      ttr(iq)%keys)
-        ttr(iq)%component = tr(it)%component; CALL addKey_1('component', tr(it)%component, ttr(iq)%keys)
-        iq = iq+1
+        ttr(iq)%name      = TRIM(ta(itr))
+        ttr(iq)%parent    = TRIM(pa(ipr))
+        ttr(iq)%type      = dType(it)
+        ttr(iq)%component = sname
+        CALL addKey('name',      ta(itr),   ttr(iq)%keys)
+        CALL addKey('parent',    pa(ipr),   ttr(iq)%keys)
+        CALL addKey('type',      dType(it), ttr(iq)%keys)
+        CALL addKey('component', sname,     ttr(iq)%keys)
+        iq = iq + 1
       END DO
     END DO
@@ -575,24 +593,28 @@
 !------------------------------------------------------------------------------------------------------------------------------
 ! Purpose: Determine, for each tracer of "tr(:)":
-!   * %iGeneration: the generation number 
-!   * %gen0Name:    the generation 0 ancestor name
-!          Check also for orphan tracers (tracers not descending on "tran0").
+!   * iGeneration: the generation number 
+!   * gen0Name:    the generation 0 ancestor name
+!          Check also for orphan tracers (tracers without parent).
 !------------------------------------------------------------------------------------------------------------------------------
   TYPE(trac_type),     INTENT(INOUT) :: tr(:)                        !--- Tracer derived type vector
   INTEGER                            :: iq, jq, ig
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:), tname(:)
 !------------------------------------------------------------------------------------------------------------------------------
   CHARACTER(LEN=maxlen) :: modname
   modname = 'setGeneration'
-  IF(test(fmsg('missing "parent" attribute', modname, getKey('parent', parent, ky=tr(:)%keys)), lerr)) RETURN
+  lerr = getKey('name',   tname,  ky=tr(:)%keys); IF(lerr) RETURN
+  lerr = getKey('parent', parent, ky=tr(:)%keys); IF(lerr) RETURN
   DO iq = 1, SIZE(tr)
     jq = iq; ig = 0
     DO WHILE(parent(jq) /= tran0)
-      jq = strIdx(tr(:)%name, parent(jq))
-      IF(test(fmsg('Orphan tracer "'//TRIM(tr(iq)%name)//'"', modname, jq == 0), lerr)) RETURN
+      jq = strIdx(tname(:), parent(jq))
+      lerr = jq == 0
+      IF(fmsg('Orphan tracer "'//TRIM(tname(iq))//'"', modname, lerr)) RETURN
       ig = ig + 1
     END DO
-    tr(iq)%gen0Name = tr(jq)%name; CALL addKey_1('gen0Name',    tr(iq)%gen0Name,   tr(iq)%keys)
-    tr(iq)%iGeneration = ig;       CALL addKey_1('iGeneration', TRIM(int2str(ig)), tr(iq)%keys)
+    tr(iq)%gen0Name = tname(jq)
+    tr(iq)%iGeneration = ig
+    CALL addKey('iGeneration',   ig,  tr(iq)%keys)
+    CALL addKey('gen0Name', tname(jq), tr(iq)%keys)
   END DO
 END FUNCTION setGeneration
@@ -604,30 +626,36 @@
 !------------------------------------------------------------------------------------------------------------------------------
 ! Purpose:
-!   * check for orphan tracers (without known parent)
-!   * check wether the phases are known or not ("g"aseous, "l"iquid or "s"olid so far)
+!   * check for orphan tracers (without parent)
+!   * check wether the phases are known or not (elements of "known_phases")
 !------------------------------------------------------------------------------------------------------------------------------
   TYPE(trac_type),            INTENT(IN) :: tr(:)                    !--- Tracer derived type vector
   CHARACTER(LEN=*),           INTENT(IN) :: sname                    !--- Section name
   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname                    !--- File name
+  CHARACTER(LEN=1) :: p
   CHARACTER(LEN=maxlen) :: mesg
   CHARACTER(LEN=maxlen) :: bp(SIZE(tr, DIM=1)), pha                  !--- Bad phases list, phases of current tracer
-  CHARACTER(LEN=1) :: p
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
+  INTEGER,               ALLOCATABLE ::  iGen(:)
   INTEGER :: ip, np, iq, nq
 !------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: modname
+  modname = 'checkTracers'
   nq = SIZE(tr,DIM=1)                                                !--- Number of tracers lines
   mesg = 'Check section "'//TRIM(sname)//'"'
   IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
+  lerr = getKey('iGeneration', iGen, tr(:)%keys);               IF(lerr) RETURN
+  lerr = getKey('name',       tname, tr(:)%keys);               IF(lerr) RETURN
 
   !=== CHECK FOR ORPHAN TRACERS
-  IF(test(checkList(tr%name, tr%iGeneration==-1, mesg, 'tracers', 'orphan'), lerr)) RETURN
+  lerr = checkList(tname, iGen==-1, mesg, 'tracers', 'orphan'); IF(lerr) RETURN
 
   !=== CHECK PHASES
-  DO iq=1,nq; IF(tr(iq)%iGeneration/=0) CYCLE                        !--- Generation O only is checked
-    pha = fgetKey(iq, 'phases', tr(:)%keys, 'g')                     !--- Phases
+  DO iq = 1, nq; IF(iGen(iq) /= 0) CYCLE                             !--- Generation O only is checked
+    IF(getKey(['phases','phase '], pha, iq, tr(:)%keys, lDisp=.FALSE.)) pha = 'g'   !--- Phase
     np = LEN_TRIM(pha); bp(iq)=' '
-    DO ip=1,np; p = pha(ip:ip); IF(INDEX(known_phases,p)==0) bp(iq) = TRIM(bp(iq))//p; END DO
-    IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tr(iq)%name)//': '//TRIM(bp(iq))
+    DO ip = 1, np; p = pha(ip:ip); IF(INDEX(known_phases, p) == 0) bp(iq) = TRIM(bp(iq))//p; END DO
+    IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tname(iq))//': '//TRIM(bp(iq))
   END DO
-  lerr = checkList(bp, tr%iGeneration==0 .AND. bp/='', mesg, 'tracers phases', 'unknown')
+  lerr = checkList(bp, iGen == 0 .AND. bp /= '', mesg, 'tracers phases', 'unknown')
 END FUNCTION checkTracers
 !==============================================================================================================================
@@ -645,27 +673,38 @@
   INTEGER :: ip, np, iq, nq, k
   LOGICAL, ALLOCATABLE  :: ll(:)
-  CHARACTER(LEN=maxlen) :: mesg, tnam, tdup(SIZE(tr,DIM=1))
-  CHARACTER(LEN=1)      :: p
-!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: mesg, phase, tdup(SIZE(tr,DIM=1))
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), dType(:)
+  INTEGER,               ALLOCATABLE :: iGen(:)
+  CHARACTER(LEN=1) :: p
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: modname
+  modname = 'checkUnique'
   mesg = 'Check section "'//TRIM(sname)//'"'
   IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
   nq=SIZE(tr,DIM=1); lerr=.FALSE.                                    !--- Number of lines ; error flag
   tdup(:) = ''
-  DO iq=1,nq; IF(tr(iq)%type == 'tag') CYCLE                         !--- Tags can be repeated
-    tnam = TRIM(tr(iq)%name)
-    ll = tr(:)%name==TRIM(tnam)                                      !--- Mask for current tracer name
-    IF(COUNT(ll)==1 ) CYCLE                                          !--- Tracer is not repeated
-    IF(tr(iq)%iGeneration>0) THEN
-      tdup(iq) = tnam                                                !--- gen>0: MUST be unique
+  lerr = getKey('name',       tname, tr%keys); IF(lerr) RETURN
+  lerr = getKey('type',       dType, tr%keys); IF(lerr) RETURN
+  lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN
+  DO iq = 1, nq
+    IF(dType(iq) == 'tag') CYCLE                                     !--- Tags can be repeated
+    ll = tname==TRIM(tname(iq))                                      !--- Mask for current tracer name
+    IF(COUNT(ll) == 1) CYCLE                                         !--- Tracer is not repeated
+    IF(iGen(iq) > 0) THEN
+      tdup(iq) = tname(iq)                                           !--- gen>0: MUST be unique
     ELSE
-      DO ip=1,nphases; p=known_phases(ip:ip)                         !--- Loop on known phases
-        !--- Number of appearances of the current tracer with known phase "p"
-        np = COUNT( PACK( [(INDEX(fgetKey(k, 'phases', tr(:)%keys, 'g'),p), k=1, nq)] /=0 , MASK=ll ) )
-        IF(np <=1) CYCLE
-        tdup(iq) = TRIM(tdup(iq))//TRIM(phases_names(ip))
+      DO ip = 1, nphases; p = known_phases(ip:ip)                    !--- Loop on known phases
+        np = 0
+        DO k = 1, nq
+          IF(.NOT.ll(k)) CYCLE                                       !--- Skip tracers different from current one
+          IF(getKey(['phases','phase '], phase, k, tr%keys, lDisp=.FALSE.)) phase='g'!--- Get current phases
+          IF(INDEX(phase, p) /= 0) np = np + 1                       !--- One more appearance of current tracer with phase "p"
+        END DO
+        IF(np <= 1) CYCLE                                            !--- Regular case: no or a single appearance
+        tdup(iq) = TRIM(tdup(iq))//TRIM(phases_names(ip))            !--- Repeated phase
         IF(ANY(tdup(1:iq-1) == tdup(iq))) tdup(iq)=''                !--- Avoid repeating same messages
       END DO
     END IF
-    IF(tdup(iq) /= '') tdup(iq)=TRIM(tnam)//' in '//TRIM(tdup(iq))//' phase(s)'
+    IF(tdup(iq) /= '') tdup(iq)=TRIM(tname(iq))//' in '//TRIM(tdup(iq))//' phase(s)'
   END DO
   lerr = checkList(tdup, tdup/='', mesg, 'tracers', 'duplicated')
@@ -675,5 +714,5 @@
 
 !==============================================================================================================================
-SUBROUTINE expandPhases(tr)
+LOGICAL FUNCTION expandPhases(tr) RESULT(lerr)
 !------------------------------------------------------------------------------------------------------------------------------
 ! Purpose: Expand the phases in the tracers descriptor "tr". Phases are not repeated for a tracer, thanks to "checkUnique".
@@ -681,18 +720,26 @@
   TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:)               !--- Tracer derived type vector
 !------------------------------------------------------------------------------------------------------------------------------
-  TYPE(trac_type), ALLOCATABLE :: ttr(:)
-  INTEGER,   ALLOCATABLE ::  i0(:)
-  CHARACTER(LEN=maxlen)  :: nam, pha, tname
+  TYPE(trac_type),       ALLOCATABLE :: ttr(:)
+  INTEGER,               ALLOCATABLE ::  i0(:), iGen(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), gen0N(:), phase(:), parents(:), dType(:)
+  CHARACTER(LEN=maxlen)              ::  nam,     gen0Nm,   pha,      parent
   CHARACTER(LEN=1) :: p
   INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
   LOGICAL :: lTag, lExt
 !------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: modname
+  modname = 'expandPhases'
   nq = SIZE(tr, DIM=1)
   nt = 0
+  lerr = getKey('name',       tname, tr%keys); IF(lerr) RETURN       !--- Names of the tracers
+  lerr = getKey('gen0Name',   gen0N, tr%keys); IF(lerr) RETURN       !--- Names of the tracers of first generation
+  lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN       !--- Generation number
+  lerr = getKey('phases',     phase, tr%keys); IF(lerr) RETURN       !--- Phases names
+  lerr = getKey('parent',   parents, tr%keys); IF(lerr) RETURN       !--- Parents names
+  lerr = getKey('type',       dType, tr%keys); IF(lerr) RETURN       !--- Tracers types ('tracer' or 'tag')
   DO iq = 1, nq                                                      !--- GET THE NUMBER OF TRACERS
-    IF(tr(iq)%iGeneration /= 0) CYCLE                                !--- Only deal with generation 0 tracers
-    nc = COUNT(tr(:)%gen0Name==tr(iq)%name .AND. tr%iGeneration/=0)  !--- Number of children of tr(iq)
-    tr(iq)%phase = fgetKey(iq, 'phases', tr(:)%keys)                 !--- Phases list        of tr(iq)
-    np = LEN_TRIM(tr(iq)%phase)                                      !--- Number of phases   of tr(iq)
+    IF(iGen(iq) /= 0) CYCLE                                          !--- Only deal with generation 0 tracers
+    nc = COUNT(gen0N == tname(iq) .AND. iGen /= 0)                   !--- Number of children of tr(iq)
+    np = LEN_TRIM(phase(iq))                                         !--- Number of phases   of tr(iq)
     nt = nt + (1+nc) * np                                            !--- Number of tracers after expansion
   END DO
@@ -700,34 +747,36 @@
   it = 1                                                             !--- Current "ttr(:)" index
   DO iq = 1, nq                                                      !--- Loop on "tr(:)" indexes
-    lTag = tr(iq)%type=='tag'                                        !--- Current tracer is a tag
-    i0 = strFind(tr(:)%name, TRIM(tr(iq)%gen0Name), n)               !--- Indexes of first generation ancestor copies
-    np = SUM([( LEN_TRIM(tr(i0(i))%phase),i=1,n )], 1)               !--- Number of phases for current tracer tr(iq)
-    lExt = np>1                                                      !--- Phase suffix only required if phases number is > 1
-    IF(lTag) lExt = lExt .AND. tr(iq)%iGeneration>0                  !--- No phase suffix for generation 0 tags
-    DO i=1,n                                                         !=== LOOP ON GENERATION 0 ANCESTORS
+    lTag = dType(iq)=='tag'                                          !--- Current tracer is a tag
+    i0 = strFind(tname, TRIM(gen0N(iq)), n)                          !--- Indexes of first generation ancestor copies
+    np = SUM([( LEN_TRIM(phase(i0(i))), i = 1, n )], 1)              !--- Number of phases for current tracer tr(iq)
+    lExt = np > 1                                                    !--- Phase suffix only required if phases number is > 1
+    IF(lTag) lExt = lExt .AND. iGen(iq) > 0                          !--- No phase suffix for generation 0 tags
+    DO i = 1, n                                                      !=== LOOP ON GENERATION 0 ANCESTORS
       jq = i0(i)                                                     !--- tr(jq): ith tracer with same gen 0 ancestor as tr(iq)
-      IF(tr(iq)%iGeneration==0) jq=iq                                !--- Generation 0: count the current tracer phases only
-      pha = tr(jq)%phase                                             !--- Phases list for tr(jq)
+      IF(iGen(iq) == 0) jq = iq                                      !--- Generation 0: count the current tracer phases only
+      pha = phase(jq)                                                !--- Phases list for tr(jq)
       DO ip = 1, LEN_TRIM(pha)                                       !=== LOOP ON PHASES LISTS
         p = pha(ip:ip)
-        tname = TRIM(tr(iq)%name); nam = tname                       !--- Tracer name (regular case)
-        IF(lTag) nam = TRIM(tr(iq)%parent)                           !--- Parent name (tagging case)
+        nam = tname(iq)                                              !--- Tracer name (regular case)
+        IF(lTag) nam = TRIM(parents(iq))                             !--- Parent name (tagging case)
         IF(lExt) nam = addPhase(nam, p )                             !--- Phase extension needed
-        IF(lTag) nam = TRIM(nam)//'_'//TRIM(tname)                   !--- <parent>_<name> for tags
+        IF(lTag) nam = TRIM(nam)//'_'//TRIM(tname(iq))               !--- <parent>_<name> for tags
         ttr(it) = tr(iq)                                             !--- Same <key>=<val> pairs
         ttr(it)%name      = TRIM(nam)                                !--- Name with possibly phase suffix
         ttr(it)%keys%name = TRIM(nam)                                !--- Name inside the keys decriptor
         ttr(it)%phase     = p                                        !--- Single phase entry
-        CALL addKey_1('name', nam, ttr(it)%keys)
-        CALL addKey_1('phase', p,  ttr(it)%keys)
-        IF(lExt .AND. tr(iq)%iGeneration>0) THEN
-          ttr(it)%parent   = addPhase(tr(iq)%parent,   p)
-          ttr(it)%gen0Name = addPhase(tr(iq)%gen0Name, p)
-          CALL addKey_1('parent',   ttr(it)%parent,   ttr(it)%keys)
-          CALL addKey_1('gen0Name', ttr(it)%gen0Name, ttr(it)%keys)
+        CALL addKey('name', nam, ttr(it)%keys)
+        CALL addKey('phase', p,  ttr(it)%keys)
+        IF(lExt) THEN
+          parent = parents(iq); IF(iGen(iq) > 0) parent = addPhase(parent, p)
+          gen0Nm =   gen0N(iq); IF(iGen(iq) > 0) gen0Nm = addPhase(gen0Nm, p)
+          ttr(it)%parent   = parent
+          ttr(it)%gen0Name = gen0Nm
+          CALL addKey('parent',   parent, ttr(it)%keys)
+          CALL addKey('gen0Name', gen0Nm, ttr(it)%keys)
         END IF
         it = it+1
       END DO
-      IF(tr(iq)%iGeneration==0) EXIT                                 !--- Break phase loop for gen 0
+      IF(iGen(iq) == 0) EXIT                                         !--- Break phase loop for gen 0
     END DO
   END DO
@@ -735,5 +784,5 @@
   CALL delKey(['phases'],tr)                                         !--- Remove few keys entries
 
-END SUBROUTINE expandPhases
+END FUNCTION expandPhases
 !==============================================================================================================================
 
@@ -748,14 +797,19 @@
 !   TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
 !------------------------------------------------------------------------------------------------------------------------------
-  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:)         !--- Tracer derived type vector
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE(trac_type), ALLOCATABLE        :: tr2(:)
-  INTEGER,         ALLOCATABLE        :: iy(:), iz(:)
-  INTEGER                             :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
+  TYPE(trac_type), INTENT(INOUT) :: tr(:)                            !--- Tracer derived type vector
+!------------------------------------------------------------------------------------------------------------------------------
+  TYPE(trac_type),       ALLOCATABLE :: tr2(:)
+  INTEGER,               ALLOCATABLE :: iy(:), iz(:)
+  INTEGER,               ALLOCATABLE ::  iGen(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), gen0N(:)
+  INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
+  LOGICAL :: lerr
 !  tr2 is introduced in order to cope with a bug in gfortran 4.8.5 compiler
 !------------------------------------------------------------------------------------------------------------------------------
+  lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN       !--- Generation number
   nq = SIZE(tr)
   DO ip = nphases, 1, -1
-    iq = strIdx(tr(:)%name, addPhase('H2O', ip))
+    lerr = getKey('name',     tname, tr%keys); IF(lerr) RETURN       !--- Names of the tracers of first generation
+    iq = strIdx(tname, addPhase('H2O', ip))
     IF(iq == 0) CYCLE
     tr2 = tr(:)
@@ -764,7 +818,7 @@
   IF(lSortByGen) THEN
     iq = 1
-    ng = MAXVAL(tr(:)%iGeneration, MASK=.TRUE., DIM=1)               !--- Number of generations
+    ng = MAXVAL(iGen, MASK=.TRUE., DIM=1)                            !--- Number of generations
     DO ig = 0, ng                                                    !--- Loop on generations
-      iy = PACK([(k, k=1, nq)], MASK=tr(:)%iGeneration==ig)          !--- Generation ig tracers indexes
+      iy = PACK([(k, k=1, nq)], MASK=iGen(:) == ig)                  !--- Generation ig tracers indexes
       n = SIZE(iy)
       ix(iq:iq+n-1) = iy                                             !--- Stack growing generations idxs
@@ -772,13 +826,13 @@
     END DO
   ELSE
-    iq = 1
+    lerr = getKey('gen0Name',   gen0N, tr%keys); IF(lerr) RETURN     !--- Names of the tracers    iq = 1
     DO jq = 1, nq                                                    !--- Loop on generation 0 tracers
-      IF(tr(jq)%iGeneration /= 0) CYCLE                              !--- Skip generations /= 0
+      IF(iGen(jq) /= 0) CYCLE                                        !--- Skip generations /= 0
       ix(iq) = jq                                                    !--- Generation 0 ancestor index first
       iq = iq + 1                                                    !--- Next "iq" for next generations tracers
-      iy = strFind(tr(:)%gen0Name, TRIM(tr(jq)%name))                !--- Indexes of "tr(jq)" children in "tr(:)"
-      ng = MAXVAL(tr(iy)%iGeneration, MASK=.TRUE., DIM=1)            !--- Number of generations of the "tr(jq)" family
+      iy = strFind(gen0N(:), TRIM(tname(jq)))                        !--- Indices of "tr(jq)" children in "tr(:)"
+      ng = MAXVAL(iGen(iy), MASK=.TRUE., DIM=1)                      !--- Number of generations of the "tr(jq)" family
       DO ig = 1, ng                                                  !--- Loop   on generations of the "tr(jq)" family
-        iz = find(tr(iy)%iGeneration, ig, n)                         !--- Indexes of the tracers "tr(iy(:))" of generation "ig"
+        iz = find(iGen(iy), ig, n)                                   !--- Indices of the tracers "tr(iy(:))" of generation "ig"
         ix(iq:iq+n-1) = iy(iz)                                       !--- Same indexes in "tr(:)"
         iq = iq + n
@@ -796,10 +850,14 @@
   TYPE(trac_type), ALLOCATABLE, INTENT(OUT) ::       tr(:)
   TYPE(trac_type), POINTER ::   t1(:),   t2(:)
+  TYPE(keys_type), POINTER ::   k1(:),   k2(:)
   INTEGER,     ALLOCATABLE :: ixct(:), ixck(:)
-  INTEGER :: is, k1, k2, nk2, i1, i2, nt2
+  INTEGER :: is, ik, ik1, ik2, nk2, i1, i2, nt2
   CHARACTER(LEN=maxlen) :: s1, v1, v2, tnam, knam, modname
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: keys(:), n1(:), n2(:)
   modname = 'mergeTracers'
   lerr = .FALSE.
-  t1 => sections(1)%trac(:)                                          !--- Alias: first tracers section
+  keys = ['parent     ', 'type       ', 'iGeneration']               !--- Mandatory keys
+  t1 => sections(1)%trac(:); k1 => t1(:)%keys                        !--- Alias: first tracers section, corresponding keys
+  lerr = getKey('name', n1, k1); IF(lerr) RETURN                     !--- Names of the tracers
   tr = t1
   !----------------------------------------------------------------------------------------------------------------------------
@@ -807,10 +865,12 @@
   !----------------------------------------------------------------------------------------------------------------------------
     t2  => sections(is)%trac(:)                                      !--- Alias: current tracers section
+    k2  => t2(:)%keys
+    lerr = getKey('name', n2, k2); IF(lerr) RETURN                   !--- Names of the tracers
     nt2  = SIZE(t2(:), DIM=1)                                        !--- Number of tracers in section
-    ixct = strIdx(t1(:)%name, t2(:)%name)                            !--- Indexes of common tracers
+    ixct = strIdx(n1(:), n2(:))                                      !--- Indexes of common tracers
     tr = [tr, PACK(t2, MASK= ixct==0)]                               !--- Append with new tracers
     IF( ALL(ixct == 0) ) CYCLE                                       !--- No common tracers => done
     CALL msg('Tracers defined in previous sections and duplicated in "'//TRIM(sections(is)%name)//'":', modname)
-    CALL msg(t1(PACK(ixct, MASK = ixct/=0))%name, modname, nmax=128) !--- Display duplicates (the 128 first at most)
+    CALL msg(n1(PACK(ixct, MASK = ixct/=0)), modname, nmax=128)      !--- Display duplicates (the 128 first at most)
     !--------------------------------------------------------------------------------------------------------------------------
     DO i2=1,nt2; tnam = TRIM(t2(i2)%name)                            !=== LOOP ON COMMON TRACERS
@@ -820,34 +880,35 @@
       !=== CHECK WETHER ESSENTIAL KEYS ARE IDENTICAL OR NOT
       s1=' of "'//TRIM(tnam)//'" in "'//TRIM(sections(is)%name)//'" not matching previous value'
-      
-      IF(test(fmsg('Parent name'//TRIM(s1), modname, t1(i1)%parent      /= t2(i2)%parent),      lerr)) RETURN
-      IF(test(fmsg('Type'       //TRIM(s1), modname, t1(i1)%type        /= t2(i2)%type),        lerr)) RETURN
-      IF(test(fmsg('Generation' //TRIM(s1), modname, t1(i1)%iGeneration /= t2(i2)%iGeneration), lerr)) RETURN
-
-      !=== APPEND <key>=<val> PAIRS NOT PREVIOULSLY DEFINED
-      nk2  = SIZE(t2(i2)%keys%key(:))                                !--- Keys number in current section
-      ixck = strIdx(t1(i1)%keys%key(:), t2(i2)%keys%key(:))          !--- Common keys indexes
-
-      !=== APPEND NEW KEYS
+      DO ik = 1, SIZE(keys)
+        lerr = getKey(keys(ik), v1, i1, k1)
+        lerr = getKey(keys(ik), v2, i2, k2)
+        lerr = v1 /= v2; IF(fmsg(TRIM(keys(ik))//TRIM(s1), modname, lerr)) RETURN
+      END DO
+
+      !=== GET THE INDICES IN tr(i2)%keys%key(:) OF THE KEYS ALSO PRESENT IN tr(i1)%keys%key(:)
+      nk2  =   SIZE(k2(i2)%key(:))                                   !--- Keys number in current section
+      ixck = strIdx(k1(i1)%key(:), k2(i2)%key(:))                    !--- Common keys indexes
+      !--- APPEND THE NEW KEYS PAIRS IN tr(i1)%keys%key(:)
       tr(i1)%keys%key = [ tr(i1)%keys%key, PACK(tr(i2)%keys%key, MASK = ixck==0)]
       tr(i1)%keys%val = [ tr(i1)%keys%val, PACK(tr(i2)%keys%val, MASK = ixck==0)]
 
-      !--- KEEP TRACK OF THE COMPONENTS NAMES
-      tr(i1)%component = TRIM(tr(i1)%component)//','//TRIM(tr(i2)%component)
-
-      !--- SELECT COMMON TRACERS WITH DIFFERING KEYS VALUES (PREVIOUS VALUE IS KEPT)
-      DO k2=1,nk2
-        k1 = ixck(k2); IF(k1 == 0) CYCLE
-        IF(t1(i1)%keys%val(k1) == t2(i2)%keys%val(k2)) ixck(k2)=0
+      !=== KEEP TRACK OF THE COMPONENTS NAMES: COMA-SEPARATED LIST
+      lerr = getKey('component', v1, i1, k1)
+      lerr = getKey('component', v2, i2, k2)
+      tr(i1)%component = TRIM(v1)//','//TRIM(v2)
+      CALL addKey('component', TRIM(v1)//','//TRIM(v2), tr(i1)%keys)
+
+      !=== FOR TRACERS COMMON TO PREVIOUS AND CURRENT SECTIONS: CHECK WETHER SOME KEYS HAVE DIFFERENT VALUES ; KEEP OLD ONE
+      DO ik2 = 1, nk2                                                !--- Collect the corresponding indices
+        ik1 = ixck(ik2); IF(ik1 == 0) CYCLE
+        IF(k1(i1)%val(ik1) == k2(i2)%val(ik2)) ixck(ik2)=0
       END DO
-      IF(ALL(ixck==0)) CYCLE                                         !--- No identical keys with /=values
-
-      !--- DISPLAY INFORMATION: OLD VALUES ARE KEPT FOR THE KEYS FOUND IN PREVIOUS AND CURRENT SECTIONS
-      CALL msg('Key(s)'//TRIM(s1), modname)
-      DO k2 = 1, nk2                                                 !--- Loop on keys found in both t1(:) and t2(:)
-        knam = t2(i2)%keys%key(k2)                                   !--- Name of the current key
-        k1 = ixck(k2)                                                !--- Corresponding index in t1(:)
-        IF(k1 == 0) CYCLE                                            !--- New keys are skipped
-        v1 = t1(i1)%keys%val(k1); v2 = t2(i2)%keys%val(k2)           !--- Key values in t1(:) and t2(:)
+      IF(ALL(ixck==0)) CYCLE                                         !--- No identical keys with /=values => nothing to display
+      CALL msg('Key(s)'//TRIM(s1), modname)                          !--- Display the  keys with /=values (names list)
+      DO ik2 = 1, nk2                                                !--- Loop on keys found in both t1(:) and t2(:)
+        knam = k2(i2)%key(ik2)                                       !--- Name of the current key
+        ik1 = ixck(ik2)                                              !--- Corresponding index in t1(:)
+        IF(ik1 == 0) CYCLE                                           !--- New keys are skipped
+        v1 = k1(i1)%val(ik1); v2 = k2(i2)%val(ik2)                   !--- Key values in t1(:) and t2(:)
         CALL msg(' * '//TRIM(knam)//'='//TRIM(v2)//' ; previous value kept:'//TRIM(v1), modname)
       END DO
@@ -862,29 +923,29 @@
 
 !==============================================================================================================================
-LOGICAL FUNCTION cumulTracers(sections, tr) RESULT(lerr)
+LOGICAL FUNCTION cumulTracers(sections, tr, lRename) RESULT(lerr)
   TYPE(dataBase_type),  TARGET, INTENT(IN)  :: sections(:)
   TYPE(trac_type), ALLOCATABLE, INTENT(OUT) ::       tr(:)
-  TYPE(trac_type), POINTER     :: t(:)
-  INTEGER,   ALLOCATABLE :: nt(:)
-  CHARACTER(LEN=maxlen)  :: tnam, tnam_new
-  INTEGER :: iq, nq, is, ns, nsec
-  lerr = .FALSE.                                                     !--- Can't fail ; kept to match "mergeTracer" interface.
-  nsec =  SIZE(sections)
-  tr = [(      sections(is)%trac(:) , is=1, nsec )]                  !--- Concatenated tracers vector
-  nt = [( SIZE(sections(is)%trac(:)), is=1, nsec )]                  !--- Number of tracers in each section
+  LOGICAL,            OPTIONAL, INTENT(IN)  :: lRename               !--- .TRUE.: add a section suffix to identical names
+  CHARACTER(LEN=maxlen)  :: tnam_new, modname
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), parent(:), comp(:)
+  INTEGER :: iq, jq, is
+  modname = 'cumulTracers'
+  lerr = .FALSE.
+  tr = [( sections(is)%trac(:), is = 1, SIZE(sections) )]            !--- Concatenated tracers vector
+  IF(PRESENT(lRename)) THEN; IF(lRename) RETURN; END IF              !--- No renaming: finished
+  lerr = getKey('name',     tname, tr%keys); IF(lerr) RETURN         !--- Names
+  lerr = getKey('parent',  parent, tr%keys); IF(lerr) RETURN         !--- Parents
+  lerr = getKey('component', comp, tr%keys); IF(lerr) RETURN         !--- Component name
   !----------------------------------------------------------------------------------------------------------------------------
-  DO is=1, nsec                                                      !=== LOOP ON SECTIONS
+  DO iq = 1, SIZE(tr); IF(COUNT(tname == tname(iq)) == 1) CYCLE      !=== LOOP ON TRACERS
   !----------------------------------------------------------------------------------------------------------------------------
-    t => sections(is)%trac(:)
+    tnam_new = TRIM(tname(iq))//'_'//TRIM(comp(iq))                  !--- Same with section extension
+    CALL addKey('name', tnam_new, tr(iq)%keys)                       !--- Modify tracer name
+    tr(iq)%name = TRIM(tnam_new)                                     !--- Modify tracer name
     !--------------------------------------------------------------------------------------------------------------------------
-    DO iq=1, nt(is)                                                  !=== LOOP ON TRACERS
+    DO jq = 1, SIZE(tr); IF(parent(jq) /= tname(iq)) CYCLE           !=== LOOP ON TRACERS PARENTS
     !--------------------------------------------------------------------------------------------------------------------------
-      tnam = TRIM(t(iq)%name)                                        !--- Original name
-      IF(COUNT(t%name == tnam) == 1) CYCLE                           !--- Current tracer is not duplicated: finished
-      tnam_new = TRIM(tnam)//'_'//TRIM(sections(is)%name)            !--- Same with section extension
-      nq = SUM(nt(1:is-1))                                           !--- Number of tracers in previous sections
-      ns = nt(is)                                                    !--- Number of tracers in the current section
-      tr(iq + nq)%name = TRIM(tnam_new)                              !--- Modify tracer name
-      WHERE(tr(1+nq:ns+nq)%parent==tnam) tr(1+nq:ns+nq)%parent=tnam_new  !--- Modify parent name
+      CALL addKey('parent', tnam_new, tr(jq)%keys)                   !--- Modify tracer name
+      tr(jq)%parent = TRIM(tnam_new)                                 !--- Modify tracer name
     !--------------------------------------------------------------------------------------------------------------------------
     END DO
@@ -896,124 +957,138 @@
 !==============================================================================================================================
 
-!==============================================================================================================================
-SUBROUTINE setDirectKeys(tr)
+
+!==============================================================================================================================
+LOGICAL  FUNCTION  dispTraSection(message, sname, modname) RESULT(lerr)
+  CHARACTER(LEN=*), INTENT(IN) :: message, sname, modname
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:,:), n(:), tmp(:)
+  CHARACTER(LEN=maxlen) :: p
+  INTEGER :: idb, iq, nq
+  idb = strIdx(dBase(:)%name, sname); IF(idb == 0) RETURN
+  nq = SIZE(dBase(idb)%trac)
+  p = ''
+  CALL append(['iq'],     .TRUE. ); IF(lerr) RETURN
+  CALL append(['name'],   .TRUE. ); IF(lerr) RETURN
+  CALL append(['phases','phase '], .FALSE., 'pha'); IF(lerr) RETURN
+  CALL append(['hadv'],   .TRUE. ); IF(lerr) RETURN
+  CALL append(['vadv'],   .TRUE. ); IF(lerr) RETURN
+  CALL append(['parent'], .FALSE.); IF(lerr) RETURN
+  CALL append(['iGen'],   .FALSE.); IF(lerr) RETURN
+  CALL msg(TRIM(message)//':', modname)
+  lerr = dispTable(p, n, s, nColMax=maxTableWidth, nHead=2, sub=modname); IF(lerr) RETURN
+
+CONTAINS
+
+SUBROUTINE append(nam, lMandatory, snam)
+! Test whether key named "nam(:)" is available.
+!  * yes: - get its value for all species in "tmp(:)" and append table "s(:,:)" with it
+!         - append titles list with "nam(1)" (or, if specified, "snam", usually a short name).
+!  * no:  return to calling routine with an error flag if the required key is mandatory
+  CHARACTER(LEN=*),           INTENT(IN) :: nam(:)
+  LOGICAL,                    INTENT(IN) :: lMandatory
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: snam
+  INTEGER :: m
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: n0(:)
+  CHARACTER(LEN=maxlen) :: nm
+  lerr = .FALSE.
+  IF(nam(1) == 'iq') THEN
+    tmp = int2str([(iq, iq=1, nq)])
+  ELSE
+    lerr = getKey(nam, tmp, dBase(idb)%trac(:)%keys, lDisp=lMandatory)
+  END IF
+  IF(lerr) THEN; lerr = lMandatory; RETURN; END IF
+  nm = nam(1); IF(PRESENT(snam)) nm = snam
+  p = TRIM(p)//'s'
+  IF(ALLOCATED(s)) THEN; s = cat(s, tmp); ELSE; ALLOCATE(s(nq,1)); s(:,1) = tmp; END IF
+  IF(ALLOCATED(n)) THEN; m = SIZE(n); ALLOCATE(n0(m+1)); n0(1:m)=n; n0(m+1)=nm; CALL MOVE_ALLOC(FROM=n0, TO=n)
+  ELSE; n=nam(1:1); END IF
+END SUBROUTINE append
+
+END FUNCTION dispTraSection
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== CREATE TRACER(S) ALIAS: SCALAR/VECTOR FROM NAME(S) OR INDICE(S) ==========================================================
+!==============================================================================================================================
+LOGICAL FUNCTION aliasTracer(tname, trac, alias) RESULT(lerr)                  !=== TRACER NAMED "tname" - SCALAR
+  CHARACTER(LEN=*),         INTENT(IN)  :: tname
+  TYPE(trac_type), TARGET,  INTENT(IN)  :: trac(:)
+  TYPE(trac_type), POINTER, INTENT(OUT) :: alias
+  INTEGER :: it
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
+  alias => NULL()
+  lerr = getKey('name', tnames, trac(:)%keys)
+  it = strIdx(tnames, tname)
+  lerr = it /= 0; IF(.NOT.lerr) alias => trac(it)
+END FUNCTION aliasTracer
+!==============================================================================================================================
+LOGICAL FUNCTION trSubset_Indx(trac, idx, alias) RESULT(lerr)                  !=== TRACERS WITH INDICES "idx(:)" - VECTOR
+  TYPE(trac_type), ALLOCATABLE, INTENT(IN)  ::  trac(:)
+  INTEGER,                      INTENT(IN)  ::   idx(:)
+  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
+  alias = trac(idx)
+  lerr = indexUpdate(alias)
+END FUNCTION trSubset_Indx
+!------------------------------------------------------------------------------------------------------------------------------
+LOGICAL FUNCTION trSubset_Name(trac, tname, alias) RESULT(lerr)                !=== TRACERS NAMED "tname(:)" - VECTOR
+  TYPE(trac_type), ALLOCATABLE, INTENT(IN)  ::  trac(:)
+  CHARACTER(LEN=*),             INTENT(IN)  :: tname(:)
+  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
+  lerr = getKey('name', tnames, trac(:)%keys)
+  alias = trac(strIdx(tnames, tname))
+  lerr = indexUpdate(alias)
+END FUNCTION trSubset_Name
+!==============================================================================================================================
+LOGICAL FUNCTION trSubset_gen0Name(trac, gen0Nm, alias) RESULT(lerr)           !=== TRACERS OF COMMON 1st GENERATION ANCESTOR
+  TYPE(trac_type), ALLOCATABLE, INTENT(IN)  :: trac(:)
+  CHARACTER(LEN=*),             INTENT(IN)  :: gen0Nm
+  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: gen0N(:)
+  lerr = getKey('gen0Name', gen0N, trac(:)%keys)
+  alias = trac(strFind(delPhase(gen0N), gen0Nm))
+  lerr = indexUpdate(alias)
+END FUNCTION trSubset_gen0Name
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== UPDATE THE INDEXES iqParent, iqDescend AND iGeneration IN THE TRACERS DESCRIPTOR LIST "tr" (USEFULL FOR SUBSETS) =========
+!==============================================================================================================================
+LOGICAL FUNCTION indexUpdate(tr) RESULT(lerr)
   TYPE(trac_type), INTENT(INOUT) :: tr(:)
-
-  !--- Update %iqParent, %iqDescen, %nqDescen, %nqChildren
-  CALL indexUpdate(tr)
-
-  !--- Extract some direct-access keys
-!  DO iq = 1, SIZE(tr)
-!    tr(iq)%keys%<key> = getKey_prv(it, "<key>", tr%keys, <default_value> )
-!  END DO
-END SUBROUTINE setDirectKeys
-!==============================================================================================================================
-
-!==============================================================================================================================
-LOGICAL FUNCTION dispTraSection(message, sname, modname) RESULT(lerr)
-  CHARACTER(LEN=*), INTENT(IN) :: message, sname, modname
-  INTEGER :: idb, iq, nq
-  INTEGER, ALLOCATABLE :: hadv(:), vadv(:)
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: phas(:), prnt(:)
-  TYPE(trac_type), POINTER :: tm(:)
-  lerr = .FALSE.
-  idb = strIdx(dBase(:)%name, sname); IF(idb == 0) RETURN
-  tm => dBase(idb)%trac
-  nq = SIZE(tm)
-  !--- BEWARE ! Can't use the "getKeyByName" functions yet.
-  !             Names must first include the phases for tracers defined on multiple lines.
-  hadv = str2int(fgetKeys('hadv',  tm(:)%keys, '10'))
-  vadv = str2int(fgetKeys('vadv',  tm(:)%keys, '10'))
-  prnt =         fgetKeys('parent',tm(:)%keys,  '' )
-  IF(getKey('phases', phas, ky=tm(:)%keys)) phas = fGetKeys('phase', tm(:)%keys, 'g')
-  CALL msg(TRIM(message)//':', modname)
-  IF(ALL(prnt == 'air')) THEN
-    IF(test(dispTable('iiiss',   ['iq    ','hadv  ','vadv  ','name  ','phase '],                   cat(tm%name,       phas),  &
-                 cat([(iq, iq=1, nq)], hadv, vadv),                 nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
-  ELSE IF(ALL(tm%iGeneration == -1)) THEN
-    IF(test(dispTable('iiisss', ['iq    ','hadv  ','vadv  ','name  ','parent','phase '],           cat(tm%name, prnt, phas),  &
-                 cat([(iq, iq=1, nq)], hadv, vadv),                 nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
-  ELSE
-    IF(test(dispTable('iiissis', ['iq    ','hadv  ','vadv  ','name  ','parent','igen  ','phase '], cat(tm%name, prnt, phas),  &
-                 cat([(iq, iq=1, nq)], hadv, vadv, tm%iGeneration), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
-  END IF
-END FUNCTION dispTraSection
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!== CREATE A SCALAR ALIAS OF THE COMPONENT OF THE TRACERS DESCRIPTOR "t" NAMED "tname" ========================================
-!==============================================================================================================================
-FUNCTION aliasTracer(tname, t) RESULT(out)
-  TYPE(trac_type),         POINTER    :: out
-  CHARACTER(LEN=*),        INTENT(IN) :: tname
-  TYPE(trac_type), TARGET, INTENT(IN) :: t(:)
-  INTEGER :: it
-  it = strIdx(t(:)%name, tname)
-  out => NULL(); IF(it /= 0) out => t(it)
-END FUNCTION aliasTracer
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== FROM A LIST OF INDEXES OR NAMES, CREATE A SUBSET OF THE TRACERS DESCRIPTORS LIST "trac" ==================================
-!==============================================================================================================================
-FUNCTION trSubset_Indx(trac,idx) RESULT(out)
-  TYPE(trac_type), ALLOCATABLE             ::  out(:)
-  TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
-  INTEGER,                      INTENT(IN) ::  idx(:)
-  out = trac(idx)
-  CALL indexUpdate(out)
-END FUNCTION trSubset_Indx
-!------------------------------------------------------------------------------------------------------------------------------
-FUNCTION trSubset_Name(trac,nam) RESULT(out)
-  TYPE(trac_type), ALLOCATABLE             ::  out(:)
-  TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
-  CHARACTER(LEN=*),             INTENT(IN) ::  nam(:)
-  out = trac(strIdx(trac(:)%name, nam))
-  CALL indexUpdate(out)
-END FUNCTION trSubset_Name
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== CREATE THE SUBSET OF THE TRACERS DESCRIPTORS LIST "trac" HAVING THE FIRST GENERATION ANCESTOR NAMED "nam" ================
-!==============================================================================================================================
-FUNCTION trSubset_gen0Name(trac,nam) RESULT(out)
-  TYPE(trac_type), ALLOCATABLE             ::  out(:)
-  TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
-  CHARACTER(LEN=*),             INTENT(IN) ::  nam
-  out = trac(strFind(delPhase(trac(:)%gen0Name), nam))
-  CALL indexUpdate(out)
-END FUNCTION trSubset_gen0Name
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== UPDATE THE INDEXES iqParent, iqDescend AND iGeneration IN THE TRACERS DESCRIPTOR LIST "tr" (USEFULL FOR SUBSETS) =========
-!==============================================================================================================================
-SUBROUTINE indexUpdate(tr)
-  TYPE(trac_type), INTENT(INOUT) :: tr(:)
-  INTEGER :: iq, ig, igen, ngen, ix(SIZE(tr))
-  tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent )                !--- Parent index
-  DO iq = 1, SIZE(tr); CALL addKey_1('iqParent', int2str(tr(iq)%iqParent), tr(iq)%keys); END DO
-  ngen = MAXVAL(tr(:)%iGeneration, MASK=.TRUE.)
-  DO iq = 1, SIZE(tr)
-    ig = tr(iq)%iGeneration
-    IF(ALLOCATED(tr(iq)%iqDescen)) DEALLOCATE(tr(iq)%iqDescen)
-    ALLOCATE(tr(iq)%iqDescen(0))
-    CALL idxAncestor(tr, ix, ig)                                     !--- Ancestor of generation "ng" for each tr
-    DO igen = ig+1, ngen
-      tr(iq)%iqDescen = [tr(iq)%iqDescen, find(ix==iq .AND. tr%iGeneration==igen)]
-      tr(iq)%nqDescen = SIZE(tr(iq)%iqDescen)
-      IF(igen == ig+1) THEN
-        tr(iq)%nqChildren = tr(iq)%nqDescen
-        CALL addKey_1('nqChildren', int2str(tr(iq)%nqChildren), tr(iq)%keys)
-      END IF
+  INTEGER :: iq, jq, nq, ig, nGen
+  INTEGER,               ALLOCATABLE :: iqDescen(:), ix(:), iy(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:), parent(:)
+  INTEGER,       DIMENSION(SIZE(tr)) :: iqParent, iGen
+  lerr = getKey('name',   tnames, tr%keys); IF(lerr) RETURN          !--- Names
+  lerr = getKey('parent', parent, tr%keys); IF(lerr) RETURN          !--- Parents
+  nq = SIZE(tr)
+
+  !=== iqParent, iGeneration
+  DO iq = 1, nq; iGen(iq) = 0; jq = iq
+    iqParent(iq) = strIdx(tnames, parent(iq))
+    DO; jq = strIdx(tnames, parent(jq)); IF(jq == 0) EXIT; iGen(iq) = iGen(iq) + 1; END DO
+    CALL addKey('iqParent',   parent(iq), tr(iq)%keys)
+    CALL addKey('iqGeneration', iGen(iq), tr(iq)%keys)
+  END DO
+
+  !=== nqChildren, iqDescen, nqDescen
+  nGen = MAXVAL(iGen, MASK=.TRUE.)
+  DO iq = 1, nq
+    ix = [iq]; ALLOCATE(iqDescen(0))
+    DO ig = iGen(iq)+1, nGen
+      iy = find(iqParent, ix); iqDescen = [iqDescen, iy]; ix = iy
+      IF(ig /= iGen(iq)+1) CYCLE
+      CALL addKey('nqChildren', SIZE(iqDescen), tr(iq)%keys)
+      tr(iq)%nqChildren = SIZE(iqDescen)
     END DO
-    CALL addKey_1('iqDescen', strStack(int2str(tr(iq)%iqDescen)), tr(iq)%keys)
-    CALL addKey_1('nqDescen',          int2str(tr(iq)%nqDescen) , tr(iq)%keys)
+    CALL addKey('iqDescen', strStack(int2str(iqDescen)), tr(iq)%keys)
+    CALL addKey('nqDescen',             SIZE(iqDescen),  tr(iq)%keys)
+    tr(iq)%iqDescen =      iqDescen
+    tr(iq)%nqDescen = SIZE(iqDescen)
+    DEALLOCATE(iqDescen)
   END DO
-END SUBROUTINE indexUpdate
+END FUNCTION indexUpdate
 !==============================================================================================================================
   
@@ -1024,5 +1099,5 @@
 !===  * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot"        ====
 !=== NOTES:                                                                                                                ====
-!===  * Most of the "isot" components have been defined in the calling routine (readIsotopes):                             ====
+!===  * Most of the "isot" components have been defined in the calling routine (processIsotopes):                          ====
 !===      parent,  nzone, zone(:),  niso, keys(:)%name,  ntiso, trac(:),  nphas, phas,  iqIsoPha(:,:),  itZonPhi(:,:)      ====
 !===  * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes       ====
@@ -1032,5 +1107,5 @@
 !===  * The routine gives an error if a required isotope is not available in the database stored in "fnam"                 ====
 !==============================================================================================================================
-LOGICAL FUNCTION readIsotopesFile_prv(fnam, isot) RESULT(lerr)
+LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
   CHARACTER(LEN=*),        INTENT(IN)    :: fnam                     !--- Input file name
   TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:)                  !--- Isotopes descriptors (field %parent must be defined!)
@@ -1049,5 +1124,5 @@
   !--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER
   nb0 = SIZE(dBase, DIM=1)+1                                         !--- Next database element index
-  IF(test(readSections(fnam,strStack(isot(:)%parent,'|')),lerr)) RETURN !--- Read sections, one each parent tracer
+  lerr = readSections(fnam,strStack(isot(:)%parent,'|')); IF(lerr) RETURN !--- Read sections, one each parent tracer
   ndb = SIZE(dBase, DIM=1)                                           !--- Current database size
   DO idb = nb0, ndb
@@ -1067,5 +1142,5 @@
       is = strIdx(isot(iis)%keys(:)%name, t%name)                    !--- Index in "isot(iis)%keys(:)%name" of isotope "t%name"
       IF(is == 0) CYCLE
-      IF(test(ANY(reduceExpr(t%keys%val, vals)), lerr)) RETURN       !--- Reduce expressions ; detect non-numerical elements
+      lerr = ANY(reduceExpr(t%keys%val, vals)); IF(lerr) RETURN      !--- Reduce expressions ; detect non-numerical elements
       isot(iis)%keys(is)%key = t%keys%key
       isot(iis)%keys(is)%val = vals
@@ -1073,6 +1148,7 @@
 
     !--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
-    IF(test(checkList(isot(iis)%keys(:)%name, .NOT.[( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )], &
-      'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'), lerr)) RETURN
+    lerr = checkList(isot(iis)%keys(:)%name, .NOT.[( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )], &
+                     'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing')
+    IF(lerr) RETURN
   END DO
 
@@ -1109,6 +1185,6 @@
       END DO
     END DO
-    IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, &
-            cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)), lerr)) RETURN
+    lerr = dispTable(prf, ttl, val, cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)
+    IF(fmsg('Problem with the table content', modname, lerr)) RETURN
     DEALLOCATE(ttl, val)
   END DO        
@@ -1116,5 +1192,5 @@
 !------------------------------------------------------------------------------------------------------------------------------
 
-END FUNCTION readIsotopesFile_prv
+END FUNCTION readIsotopesFile
 !==============================================================================================================================
 
@@ -1124,16 +1200,19 @@
 !===    * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS).                                                       ===
 !===    * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS                                                                  ===
-!===    * CALL readIsotopesFile_prv TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS)                                          ===
+!===    * CALL readIsotopesFile TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS)                                              ===
 !===      NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS.  ===
 !==============================================================================================================================
-LOGICAL FUNCTION readIsotopesFile(iNames) RESULT(lerr)
+LOGICAL FUNCTION processIsotopes(iNames) RESULT(lerr)
   CHARACTER(LEN=maxlen), TARGET, OPTIONAL, INTENT(IN)  :: iNames(:)
   CHARACTER(LEN=maxlen), ALLOCATABLE :: p(:), str(:)                 !--- Temporary storage
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), parent(:), dType(:), phase(:), gen0N(:)
   CHARACTER(LEN=maxlen) :: iName, modname
   CHARACTER(LEN=1)   :: ph                                           !--- Phase
+  INTEGER, ALLOCATABLE ::  iGen(:)
   INTEGER :: ic, ip, iq, it, iz
   LOGICAL, ALLOCATABLE :: ll(:)                                      !--- Mask
   TYPE(trac_type), POINTER   ::  t(:), t1
   TYPE(isot_type), POINTER   ::  i
+
   lerr = .FALSE.
   modname = 'readIsotopesFile'
@@ -1141,6 +1220,13 @@
   t => tracers
 
+  lerr = getKey('name',       tname, t%keys); IF(lerr) RETURN       !--- Names
+  lerr = getKey('parent',    parent, t%keys); IF(lerr) RETURN       !--- Parents
+  lerr = getKey('type',       dType, t%keys); IF(lerr) RETURN       !--- Tracer type
+  lerr = getKey('phase',      phase, t%keys); IF(lerr) RETURN       !--- Phase
+  lerr = getKey('gen0Name',   gen0N, t%keys); IF(lerr) RETURN       !--- 1st generation ancestor name
+  lerr = getKey('iGeneration', iGen, t%keys); IF(lerr) RETURN       !--- Generation number
+
   !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
-  p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==1)
+  p = PACK(delPhase(parent), MASK = dType=='tracer' .AND. iGen==1)
   CALL strReduce(p, nbIso)
 
@@ -1148,5 +1234,6 @@
   IF(PRESENT(iNames)) THEN
     DO it = 1, SIZE(iNames)
-      IF(test(fmsg('No isotopes class "'//TRIM(iNames(it))//'" found among tracers', modname, ALL(p /= iNames(it))), lerr)) RETURN
+      lerr = ALL(p /= iNames(it))
+      IF(fmsg('No isotopes class "'//TRIM(iNames(it))//'" found among tracers', modname, lerr)) RETURN
     END DO
     p = iNames; nbIso = SIZE(p)
@@ -1164,6 +1251,6 @@
 
     !=== Isotopes children of tracer "iname": mask, names, number (same for each phase of "iname")
-    ll = t(:)%type=='tracer' .AND. delPhase(t(:)%parent) == iname .AND. t(:)%phase == 'g'
-    str = PACK(delPhase(t(:)%name), MASK = ll)                       !--- Effectively found isotopes of "iname"
+    ll = dType=='tracer' .AND. delPhase(parent) == iname .AND. phase == 'g'
+    str = PACK(delPhase(tname), MASK = ll)                           !--- Effectively found isotopes of "iname"
     i%niso = SIZE(str)                                               !--- Number of "effectively found isotopes of "iname"
     ALLOCATE(i%keys(i%niso))
@@ -1171,6 +1258,6 @@
 
     !=== Geographic tagging tracers descending on tracer "iname": mask, names, number
-    ll = t(:)%type=='tag'    .AND. delPhase(t(:)%gen0Name) == iname .AND. t(:)%iGeneration == 2
-    i%zone = PACK(strTail(t(:)%name,'_',.TRUE.), MASK = ll)          !--- Tagging zones names  for isotopes category "iname"
+    ll = dType=='tag'    .AND. delPhase(gen0N) == iname .AND. iGen == 2
+    i%zone = PACK(strTail(tname,'_',.TRUE.), MASK = ll)              !--- Tagging zones names  for isotopes category "iname"
     CALL strReduce(i%zone)
     i%nzone = SIZE(i%zone)                                           !--- Tagging zones number for isotopes category "iname"
@@ -1178,5 +1265,5 @@
     !=== Geographic tracers of the isotopes children of tracer "iname" (same for each phase of "iname")
     !    NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
-    str = PACK(delPhase(t(:)%name), MASK=ll)
+    str = PACK(delPhase(tname), MASK=ll)
     CALL strReduce(str)
     i%ntiso = i%niso + SIZE(str)                                     !--- Number of isotopes + their geographic tracers [ntiso]
@@ -1205,4 +1292,8 @@
     i%iqIsoPha = RESHAPE( [( (strIdx(t%name,  addPhase(i%trac(it),i%phase(ip:ip))),       it=1, i%ntiso), ip=1, i%nphas)], &
                          [i%ntiso, i%nphas] )
+    !=== Table used to get iq (index in dyn array, size nqtot) from the water and isotope and phase indexes ; the full isotopes list
+    !    (including tagging tracers) is sorted this way:  iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
+    i%iqWIsoPha = RESHAPE( [( [strIdx(t%name,   addPhase('H2O',i%phase(ip:ip))), i%iqIsoPha(:,ip)], ip=1,i%nphas)], &
+                         [1+i%ntiso, i%nphas] )
     !=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
     i%itZonIso = RESHAPE( [( (strIdx(i%trac(:), TRIM(i%trac(it))//'_'//TRIM(i%zone(iz))), iz=1, i%nzone), it=1, i%niso )], &
@@ -1211,11 +1302,14 @@
 
   !=== READ PHYSICAL PARAMETERS FROM isoFile FILE
-  IF(test(readIsotopesFile_prv(isoFile, isotopes), lerr)) RETURN
+!  lerr = readIsotopesFile(isoFile, isotopes); IF(lerr) RETURN! on commente pour ne pas chercher isotopes_params.def
+
+  !--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
+  CALL get_in('ok_iso_verif', isoCheck, .TRUE.)
 
   !=== CHECK CONSISTENCY
-  IF(test(testIsotopes(), lerr)) RETURN
-
-  !=== SELECT FIRST ISOTOPES CLASS OR, IF POSSIBLE, WATER CLASS
-  IF(.NOT.test(isoSelect(1, .TRUE.), lerr)) THEN; IF(isotope%parent == 'H2O') iH2O = ixIso; END IF
+  lerr = testIsotopes(); IF(lerr) RETURN
+
+  !=== SELECT WATER ISOTOPES CLASS OR, IF UNFOUND, THE FIRST ISOTOPES CLASS
+  IF(isoSelect('H2O', .TRUE.)) THEN; iH2O = ixIso; ELSE; lerr = isoSelect(1, .TRUE.); END IF
 
 CONTAINS
@@ -1224,18 +1318,20 @@
 LOGICAL FUNCTION testIsotopes() RESULT(lerr)     !--- MAKE SURE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
 !------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ix, it, ip, np, iz, nz
+  INTEGER :: ix, it, ip, np, iz, nz, npha, nzon
   TYPE(isot_type), POINTER :: i
   DO ix = 1, nbIso
     i => isotopes(ix)
     !--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
-    DO it = 1, i%ntiso
-      np = SUM([(COUNT(tracers(:)%name == addPhase(i%trac(it), i%phase(ip:ip))), ip=1, i%nphas)])
-      IF(test(fmsg(TRIM(int2str(np))//' phases instead of '//TRIM(int2str(i%nphas))//' for '//TRIM(i%trac(it)), &
-        modname, np /= i%nphas), lerr)) RETURN
+    DO it = 1, i%ntiso; npha = i%nphas
+      np = SUM([(COUNT(tracers(:)%name == addPhase(i%trac(it), i%phase(ip:ip))), ip=1, npha)])
+      lerr = np /= npha
+      CALL msg(TRIM(int2str(np))//' phases instead of '//TRIM(int2str(npha))//' for '//TRIM(i%trac(it)), modname, lerr)
+      IF(lerr) RETURN
     END DO
-    DO it = 1, i%niso
-      nz = SUM([(COUNT(i%trac == TRIM(i%trac(it))//'_'//i%zone(iz)), iz=1, i%nzone)])
-      IF(test(fmsg(TRIM(int2str(nz))//' tagging zones instead of '//TRIM(int2str(i%nzone))//' for '//TRIM(i%trac(it)), &
-        modname, nz /= i%nzone), lerr)) RETURN
+    DO it = 1, i%niso; nzon = i%nzone
+      nz = SUM([(COUNT(i%trac == TRIM(i%trac(it))//'_'//i%zone(iz)), iz=1, nzon)])
+      lerr = nz /= nzon
+      CALL msg(TRIM(int2str(nz))//' tagging zones instead of '//TRIM(int2str(nzon))//' for '//TRIM(i%trac(it)), modname, lerr)
+      IF(lerr) RETURN
     END DO
   END DO
@@ -1243,5 +1339,5 @@
 !------------------------------------------------------------------------------------------------------------------------------
 
-END FUNCTION readIsotopesFile
+END FUNCTION processIsotopes
 !==============================================================================================================================
 
@@ -1259,5 +1355,6 @@
    lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
    iIso = strIdx(isotopes(:)%parent, iName)
-   IF(test(iIso == 0, lerr)) THEN
+   lerr = iIso == 0
+   IF(lerr) THEN
       niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck=.FALSE.
       CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV)
@@ -1287,4 +1384,5 @@
    itZonIso => isotope%itZonIso; isoCheck = isotope%check
    iqIsoPha => isotope%iqIsoPha
+   iqWIsoPha => isotope%iqWIsoPha
 END FUNCTION isoSelectByIndex
 !==============================================================================================================================
@@ -1294,6 +1392,6 @@
 !=== ADD THE <key>=<val> PAIR TO THE "ky[(:)]" KEY[S] DESCRIPTOR[S] OR THE <key>=<val(:)> PAIRS TO THE "ky(:)" KEYS DESCRIPTORS
 !==============================================================================================================================
-SUBROUTINE addKey_1(key, val, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key, val
+SUBROUTINE addKey_s11(key, sval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key, sval
   TYPE(keys_type),   INTENT(INOUT) :: ky
   LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
@@ -1305,5 +1403,5 @@
   IF(.NOT.ALLOCATED(ky%key)) THEN
     ALLOCATE(ky%key(1)); ky%key(1)=key
-    ALLOCATE(ky%val(1)); ky%val(1)=val
+    ALLOCATE(ky%val(1)); ky%val(1)=sval
     RETURN
   END IF
@@ -1311,30 +1409,117 @@
   IF(iky == 0) THEN
     nky = SIZE(ky%key)
-    ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key; ky%key = k
-    ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = val; ky%val = v
+    ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key;  ky%key = k
+    ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = sval; ky%val = v
   ELSE IF(lo) THEN
-    ky%key(iky) = key; ky%val(iky) = val
+    ky%key(iky) = key; ky%val(iky) = sval
   END IF
-END SUBROUTINE addKey_1
-!==============================================================================================================================
-SUBROUTINE addKey_m(key, val, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key, val
+END SUBROUTINE addKey_s11
+!==============================================================================================================================
+SUBROUTINE addKey_i11(key, ival, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  INTEGER,           INTENT(IN)    :: ival
+  TYPE(keys_type),   INTENT(INOUT) :: ky
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  CALL addKey_s11(key, int2str(ival), ky, lOverWrite)
+END SUBROUTINE addKey_i11
+!==============================================================================================================================
+SUBROUTINE addKey_r11(key, rval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  REAL,              INTENT(IN)    :: rval
+  TYPE(keys_type),   INTENT(INOUT) :: ky
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  CALL addKey_s11(key, real2str(rval), ky, lOverWrite)
+END SUBROUTINE addKey_r11
+!==============================================================================================================================
+SUBROUTINE addKey_l11(key, lval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  LOGICAL,           INTENT(IN)    :: lval
+  TYPE(keys_type),   INTENT(INOUT) :: ky
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  CALL addKey_s11(key, bool2str(lval), ky, lOverWrite)
+END SUBROUTINE addKey_l11
+!==============================================================================================================================
+!==============================================================================================================================
+SUBROUTINE addKey_s1m(key, sval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key, sval
   TYPE(keys_type),   INTENT(INOUT) :: ky(:)
   LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
 !------------------------------------------------------------------------------------------------------------------------------
   INTEGER :: itr
-  DO itr = 1, SIZE(ky)
-    CALL addKey_1(key, val, ky(itr), lOverWrite)
-  END DO
-END SUBROUTINE addKey_m
-!==============================================================================================================================
-SUBROUTINE addKey_mm(key, val, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key, val(:)
+  DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval, ky(itr), lOverWrite); END DO
+END SUBROUTINE addKey_s1m
+!==============================================================================================================================
+SUBROUTINE addKey_i1m(key, ival, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  INTEGER,           INTENT(IN)    :: ival
   TYPE(keys_type),   INTENT(INOUT) :: ky(:)
   LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
 !------------------------------------------------------------------------------------------------------------------------------
   INTEGER :: itr
-  DO itr = 1, SIZE(ky); CALL addKey_1(key, val(itr), ky(itr), lOverWrite); END DO
-END SUBROUTINE addKey_mm
+  DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival), ky(itr), lOverWrite); END DO
+END SUBROUTINE addKey_i1m
+!==============================================================================================================================
+SUBROUTINE addKey_r1m(key, rval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  REAL,              INTENT(IN)    :: rval
+  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: itr
+  DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval), ky(itr), lOverWrite); END DO
+END SUBROUTINE addKey_r1m
+!==============================================================================================================================
+SUBROUTINE addKey_l1m(key, lval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  LOGICAL,           INTENT(IN)    :: lval
+  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: itr
+  DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval), ky(itr), lOverWrite); END DO
+END SUBROUTINE addKey_l1m
+!==============================================================================================================================
+!==============================================================================================================================
+SUBROUTINE addKey_smm(key, sval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key, sval(:)
+  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: itr
+  DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval(itr), ky(itr), lOverWrite); END DO
+END SUBROUTINE addKey_smm
+!==============================================================================================================================
+SUBROUTINE addKey_imm(key, ival, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  INTEGER,           INTENT(IN)    :: ival(:)
+  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: itr
+  DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival(itr)), ky(itr), lOverWrite); END DO
+END SUBROUTINE addKey_imm
+!==============================================================================================================================
+SUBROUTINE addKey_rmm(key, rval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  REAL,              INTENT(IN)    :: rval(:)
+  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: itr
+  DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval(itr)), ky(itr), lOverWrite); END DO
+END SUBROUTINE addKey_rmm
+!==============================================================================================================================
+SUBROUTINE addKey_lmm(key, lval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  LOGICAL,           INTENT(IN)    :: lval(:)
+  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: itr
+  DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval(itr)), ky(itr), lOverWrite); END DO
+END SUBROUTINE addKey_lmm
 !==============================================================================================================================
 
@@ -1353,5 +1538,5 @@
   DO ik = 1, SIZE(t(jd)%keys%key)
     CALL get_in(t(jd)%keys%key(ik), val, '*none*')
-    IF(val /= '*none*') CALL addKey_1(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
+    IF(val /= '*none*') CALL addKey(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
   END DO
 END SUBROUTINE addKeysFromDef
@@ -1387,324 +1572,927 @@
 
 !==============================================================================================================================
-!================ GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RESULT IS THE RETURNED VALUE ===================
-!==============================================================================================================================
-CHARACTER(LEN=maxlen) FUNCTION fgetKeyIdx_s1(itr, keyn, ky, def_val, lerr) RESULT(val)
+!===   INTERNAL FUNCTION: GET THE VALUE OF A KEY FOR "itr"th TRACER FROM A "keys_type" DERIVED TYPE AND RETURN THE RESULT   ===
+!===   IF keyn CONTAINS SEVERAL ELEMENTS, TRY WITH EACH ELEMENT ONE AFTER THE OTHER                                         ===
+!==============================================================================================================================
+CHARACTER(LEN=maxlen) FUNCTION fgetKeyIdx(itr, keyn, ky, lerr) RESULT(val)
   INTEGER,                    INTENT(IN)  :: itr
-  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
+  CHARACTER(LEN=*),           INTENT(IN)  :: keyn(:)
   TYPE(keys_type),            INTENT(IN)  :: ky(:)
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: def_val
   LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
 !------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: ik
+  LOGICAL :: ler
+  ler = .TRUE.
+  DO ik = 1, SIZE(keyn)
+    CALL getKeyIdx(keyn(ik)); IF(.NOT.ler) EXIT
+  END DO
+  IF(PRESENT(lerr)) lerr = ler
+
+CONTAINS
+
+SUBROUTINE getKeyIdx(keyn)
+  CHARACTER(LEN=*), INTENT(IN) :: keyn
+!------------------------------------------------------------------------------------------------------------------------------
   INTEGER :: iky
-  LOGICAL :: ler
   iky = 0; val = ''
-  IF(.NOT.test(itr <= 0 .OR. itr > SIZE(ky), ler)) iky = strIdx(ky(itr)%key(:), keyn)    !--- Correct index
-  IF(.NOT.test(iky == 0, ler))                     val = ky(itr)%val(iky)                !--- Found key
-  IF(iky == 0) THEN
-    IF(.NOT.test(.NOT.PRESENT(def_val), ler))      val = def_val                         !--- Default value
-  END IF
-  IF(PRESENT(lerr)) lerr = ler
-END FUNCTION fgetKeyIdx_s1
-!==============================================================================================================================
-CHARACTER(LEN=maxlen) FUNCTION fgetKeyNam_s1(tname, keyn, ky, def_val, lerr) RESULT(val)
-  CHARACTER(LEN=*),           INTENT(IN)  :: tname, keyn
-  TYPE(keys_type),            INTENT(IN)  :: ky(:)
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: def_val
-  LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
-!------------------------------------------------------------------------------------------------------------------------------
-  val = fgetKeyIdx_s1(strIdx(ky(:)%name, tname), keyn, ky, def_val, lerr)
-END FUNCTION fgetKeyNam_s1
-!==============================================================================================================================
-FUNCTION fgetKeys(keyn, ky, def_val, lerr) RESULT(val)
-CHARACTER(LEN=maxlen),        ALLOCATABLE :: val(:)
-  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
-  TYPE(keys_type),            INTENT(IN)  :: ky(:)
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: def_val
-  LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
-!------------------------------------------------------------------------------------------------------------------------------
-  LOGICAL :: ler(SIZE(ky))
-  INTEGER :: it
-  val = [(fgetKeyIdx_s1(it, keyn, ky, def_val, ler(it)), it = 1, SIZE(ky))]
-  IF(PRESENT(lerr)) lerr = ANY(ler)
-END FUNCTION fgetKeys
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!========== GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RETURNED VALUE IS THE ERROR CODE        ==============
-!==========  The key "keyn" is searched in: 1)           "ky(:)%name" (if given)                                 ==============
-!==========                                 2)      "tracers(:)%name"                                            ==============
-!==========                                 3) "isotope%keys(:)%name"                                            ==============
-!==========  for the tracer[s] "tname[(:)]" (if given) or all the available tracers from the used set otherwise. ==============
-!==========  The type of the returned value(s) can be string, integer or real, scalar or vector                  ==============
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_s1(keyn, val, tname, ky) RESULT(lerr)
+  ler = itr <= 0 .OR. itr > SIZE(ky); IF(ler) RETURN
+  iky = strIdx(ky(itr)%key(:), keyn)
+  ler = iky == 0;                     IF(ler) RETURN
+  val = ky(itr)%val(iky)
+END SUBROUTINE getKeyIdx
+
+END FUNCTION fgetKeyIdx
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!===                                          GET KEYS VALUES FROM TRACERS INDICES                                          ===
+!==============================================================================================================================
+!=== TRY TO GET THE KEY NAMED "key" FOR THE "itr"th TRACER IN:                                                              ===
+!===  * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE:                                                                    ===
+!===  * IN INTERNAL TRACERS DATABASE "tracers(:)%keys" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)")        ===
+!=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER:                                            ===
+!===  * A SCALAR                                                                                                            ===
+!===  * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR ","                                                    ===
+!===                                                                                                                        ===
+!=== SYNTAX:       lerr = getKeyByIndex_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], itr[, ky(:)]          [, def][, lDisp])        ===
+!==============================================================================================================================
+!=== IF "itr" IS NOT PRESENT, VALUES FOR ALL THE TRACERS OF THE SELECTED DATABASE ARE STORED IN THE VECTOR "val(:)"         ===
+!=== THE NAME OF THE TRACERS FOUND IN THE EFFECTIVELY USED DATABASE CAN BE RETURNED OPTIONALLY IN "nam(:)"                  ===
+!=== SYNTAX        lerr = getKeyByIndex_{sirl}{1m}mm   (keyn[(:)], val (:)      [, ky(:)][, nam(:)][, def][, lDisp])        ===
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_s111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
   CHARACTER(LEN=*),          INTENT(IN)  :: keyn
   CHARACTER(LEN=maxlen),     INTENT(OUT) :: val
-  CHARACTER(LEN=*),          INTENT(IN)  :: tname
+  INTEGER,                   INTENT(IN)  :: itr
   TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: tnam
-  tnam = strHead(delPhase(tname),'_',.TRUE.)                                             !--- Remove phase and tag
-  IF(PRESENT(ky)) THEN                                                                   !=== KEY FROM "ky"
-               val = fgetKeyNam_s1(tname, keyn, ky,           lerr=lerr)                 !--- "ky" and "tname"
-    IF( lerr ) val = fgetKeyNam_s1(tnam,  keyn, ky,           lerr=lerr)                 !--- "ky" and "tnam"
-  ELSE
-    IF(         .NOT.test(.NOT.ALLOCATED(tracers ), lerr)) lerr = SIZE(tracers ) == 0    !=== KEY FROM "tracers"
-    IF(.NOT.lerr) THEN
-               val = fgetKeyNam_s1(tname, keyn, tracers%keys, lerr=lerr)                 !--- "ky" and "tname"
-      IF(lerr) val = fgetKeyNam_s1(tnam,  keyn, tracers%keys, lerr=lerr)                 !--- "ky" and "tnam"
-    END IF
-    IF(lerr.AND..NOT.test(.NOT.ALLOCATED(isotopes), lerr)) lerr = SIZE(isotopes) == 0    !=== KEY FROM "isotope"
-    IF(.NOT.lerr) THEN
-               val = fgetKeyNam_s1(tname, keyn, isotope%keys, lerr=lerr)                 !--- "ky" and "tname"
-      IF(lerr) val = fgetKeyNam_s1(tnam,  keyn, isotope%keys, lerr=lerr)                 !--- "ky" and "tnam"
-    END IF
+  CHARACTER(LEN=*),OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+  lerr = getKeyByIndex_sm11([keyn], val, itr, ky, def, lDisp)
+END FUNCTION getKeyByIndex_s111
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_i111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
+  INTEGER,                   INTENT(OUT) :: val
+  INTEGER,                   INTENT(IN)  :: itr
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  INTEGER,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+  lerr = getKeyByIndex_im11([keyn], val, itr, ky, def, lDisp)
+END FUNCTION getKeyByIndex_i111
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_r111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
+  REAL   ,                   INTENT(OUT) :: val
+  INTEGER,                   INTENT(IN)  :: itr
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  REAL,            OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+  lerr = getKeyByIndex_rm11([keyn], val, itr, ky, def, lDisp)
+END FUNCTION getKeyByIndex_r111
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_l111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
+  LOGICAL,                   INTENT(OUT) :: val
+  INTEGER,                   INTENT(IN)  :: itr
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+  lerr = getKeyByIndex_lm11([keyn], val, itr, ky, def, lDisp)
+END FUNCTION getKeyByIndex_l111
+!==============================================================================================================================
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_sm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
+  CHARACTER(LEN=maxlen),     INTENT(OUT) :: val
+  INTEGER,                   INTENT(IN)  :: itr
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  CHARACTER(LEN=*),OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: s
+  LOGICAL :: lD
+  lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" for tracer nr. '//TRIM(int2str(itr))
+  lerr = .TRUE.
+  IF(lerr .AND. PRESENT(ky))         val = fgetKey(ky)                                   !--- "ky"
+  IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)%keys)                      !--- "tracers"
+  IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                      !--- "isotope"
+  IF(lerr .AND. PRESENT(def)) THEN
+     val = def; lerr = .NOT.PRESENT(def)
+     CALL msg('Using defaut value of '//TRIM(s)//': '//TRIM(def), modname, lD)
   END IF
-END FUNCTION getKeyByName_s1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_s1m(keyn, val, tname, ky) RESULT(lerr)
+  CALL msg('No '//TRIM(s)//' or out of bounds index', modname, lD .AND. lerr)
+
+CONTAINS
+
+CHARACTER(LEN=maxlen) FUNCTION fgetKey(ky) RESULT(val)
+  TYPE(keys_type),  INTENT(IN)  :: ky(:)
+  lerr = SIZE(ky) == 0; IF(lerr) RETURN
+  val = fgetKeyIdx(itr, keyn(:), ky, lerr)
+END FUNCTION fgetKey
+
+END FUNCTION getKeyByIndex_sm11
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_im11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
+  INTEGER,                   INTENT(OUT) :: val
+  INTEGER,                   INTENT(IN)  :: itr
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  INTEGER,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: sval, s
+  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, int2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  val = str2int(sval)
+  lerr = val == -HUGE(1)
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
+  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
+END FUNCTION getKeyByIndex_im11
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_rm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
+  REAL   ,                   INTENT(OUT) :: val
+  INTEGER,                   INTENT(IN)  :: itr
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  REAL,            OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: sval, s
+  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, real2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  val = str2real(sval)
+  lerr = val == -HUGE(1.)
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
+  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
+END FUNCTION getKeyByIndex_rm11
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_lm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
+  LOGICAL,                   INTENT(OUT) :: val
+  INTEGER,                   INTENT(IN)  :: itr
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: sval, s
+  INTEGER               :: ival
+  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, bool2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  ival = str2bool(sval)
+  lerr = ival == -1
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
+  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
+  IF(.NOT.lerr) val = ival == 1
+END FUNCTION getKeyByIndex_lm11
+!==============================================================================================================================
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_s1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
   CHARACTER(LEN=*),                   INTENT(IN)  :: keyn
   CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
-  CHARACTER(LEN=*),                   INTENT(IN)  :: tname
+  INTEGER,                            INTENT(IN)  :: itr
   TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
+  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,                  OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: sval
+  lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, def, lDisp); IF(lerr) RETURN
+  lerr = strParse(sval, ',', val)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+END FUNCTION getKeyByIndex_s1m1
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_i1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
+  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
+  INTEGER,                   INTENT(IN)  :: itr
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  INTEGER,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: sval, s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, int2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  lerr = strParse(sval, ',', svals)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+  val = str2int(svals)
+  lerr = ANY(val == -HUGE(1))
+  s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
+  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
+END FUNCTION getKeyByIndex_i1m1
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_r1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
+  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
+  INTEGER,                   INTENT(IN)  :: itr
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  REAL,            OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: sval, s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, real2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
+  lerr = strParse(sval, ',', svals)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+  val = str2real(svals)
+  lerr = ANY(val == -HUGE(1.))
+  s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
+  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
+END FUNCTION getKeyByIndex_r1m1
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_l1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
+  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
+  INTEGER,                   INTENT(IN)  :: itr
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: sval, s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  INTEGER,               ALLOCATABLE :: ivals(:)
+  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, bool2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
+  lerr = strParse(sval, ',', svals)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+  ivals = str2bool(svals)
+  lerr = ANY(ivals == -1)
+  s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
+  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
+  IF(.NOT.lerr) val = ivals == 1
+END FUNCTION getKeyByIndex_l1m1
+!==============================================================================================================================
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_smm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
+  INTEGER,                            INTENT(IN)  :: itr
+  TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
+  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,                  OPTIONAL, INTENT(IN)  :: lDisp
 !------------------------------------------------------------------------------------------------------------------------------
   CHARACTER(LEN=maxlen) :: sval
-  lerr = getKeyByName_s1(keyn, sval, tname, ky)
-  IF(test(fmsg('missing key "'//TRIM(keyn)//'" for tracer "'//TRIM(tname)//'"', modname, lerr), lerr)) RETURN
+  lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, def, lDisp); IF(lerr) RETURN
   lerr = strParse(sval, ',', val)
-END FUNCTION getKeyByName_s1m
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky, nam) RESULT(lerr)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+END FUNCTION getKeyByIndex_smm1
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_imm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
+  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
+  INTEGER,                   INTENT(IN)  :: itr
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  INTEGER,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: sval, s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, int2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  lerr = strParse(sval, ',', svals)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+  val = str2int(svals)
+  lerr = ANY(val == -HUGE(1))
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
+  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
+END FUNCTION getKeyByIndex_imm1
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_rmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
+  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
+  INTEGER,                   INTENT(IN)  :: itr
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  REAL,            OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: sval, s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, real2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  lerr = strParse(sval, ',', svals)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+  val = str2real(svals)
+  lerr = ANY(val == -HUGE(1.))
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
+  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
+END FUNCTION getKeyByIndex_rmm1
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_lmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
+  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
+  INTEGER,                   INTENT(IN)  :: itr
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: sval, s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  INTEGER,               ALLOCATABLE :: ivals(:)
+  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, bool2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  lerr = strParse(sval, ',', svals)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+  ivals = str2bool(svals)
+  lerr = ANY(ivals == -1)
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
+  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
+  IF(.NOT.lerr) val = ivals == 1
+END FUNCTION getKeyByIndex_lmm1
+!==============================================================================================================================
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_s1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
   CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
   CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: val(:)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
-  TYPE(keys_type),       OPTIONAL, TARGET,      INTENT(IN)  :: ky(:)
+  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::  ky(:)
   CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  TYPE(keys_type), POINTER ::  keys(:)
-  LOGICAL :: lk, lt, li
-  INTEGER :: iq, nq
-
-  !--- DETERMINE THE DATABASE TO BE USED (ky, tracers or isotope)
-  lk = PRESENT(ky)
-  lt = .NOT.lk .AND. ALLOCATED(tracers);  IF(lt) lt = SIZE(tracers)  /= 0; IF(lt) lt = ANY(tracers(1)%keys%key(:) == keyn)
-  li = .NOT.lt .AND. ALLOCATED(isotopes); IF(li) li = SIZE(isotopes) /= 0; IF(li) li = ANY(isotope%keys(1)%key(:) == keyn)
-
-  !--- LINK "keys" TO THE RIGHT DATABASE
-  IF(test(.NOT.ANY([lk,lt,li]), lerr)) RETURN
-  IF(lk) keys => ky(:)
-  IF(lt) keys => tracers(:)%keys
-  IF(li) keys => isotope%keys(:)
-
-  !--- GET THE DATA
-  nq = SIZE(tname)
-  ALLOCATE(val(nq))
-  lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq), keys(:)), iq=1, nq)])
-  IF(PRESENT(nam)) nam = tname(:)
-
-END FUNCTION getKeyByName_sm
-!==============================================================================================================================
-LOGICAL FUNCTION getKey_sm(keyn, val, ky, nam) RESULT(lerr)
+  CHARACTER(LEN=*),      OPTIONAL,              INTENT(IN)  :: def
+  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
+  lerr = getKeyByIndex_smmm([keyn], val, ky, nam, def, lDisp)
+END FUNCTION getKeyByIndex_s1mm
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_i1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
   CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
-  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: val(:)
-  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  :: ky(:)
+  INTEGER,                         ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::  ky(:)
   CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
-!------------------------------------------------------------------------------------------------------------------------------
-! Note: if names are repeated, getKeyByName_sm can't be used ; this routine, using indexes, must be used instead.
-  IF(PRESENT(ky)) THEN                                                                   !=== KEY FROM "ky"
-    val = fgetKeys(keyn, ky, lerr=lerr)
-    IF(PRESENT(nam)) nam = ky(:)%name
-  ELSE
-    IF(         .NOT.test(.NOT.ALLOCATED(tracers ), lerr)) lerr = SIZE(tracers ) == 0    !=== KEY FROM "tracers"
-    IF(.NOT.lerr) val = fgetKeys(keyn, tracers%keys, lerr=lerr)
-    IF(.NOT.lerr.AND.PRESENT(nam)) nam = tracers(:)%keys%name
-    IF(lerr.AND..NOT.test(.NOT.ALLOCATED(isotopes), lerr)) lerr = SIZE(isotopes) == 0    !=== KEY FROM "isotope"
-    IF(.NOT.lerr) val = fgetKeys(keyn, isotope%keys, lerr=lerr)
-    IF(.NOT.lerr.AND.PRESENT(nam)) nam = isotope%keys(:)%name
+  INTEGER,               OPTIONAL,              INTENT(IN)  :: def
+  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
+  lerr = getKeyByIndex_immm([keyn], val, ky, nam, def, lDisp)
+END FUNCTION getKeyByIndex_i1mm
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_r1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
+  REAL,                            ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::  ky(:)
+  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
+  REAL,                  OPTIONAL,              INTENT(IN)  :: def
+  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
+  lerr = getKeyByIndex_rmmm([keyn], val, ky, nam, def, lDisp)
+END FUNCTION getKeyByIndex_r1mm
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_l1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
+  LOGICAL,                         ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::  ky(:)
+  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
+  LOGICAL,               OPTIONAL,              INTENT(IN)  :: def
+  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
+  lerr = getKeyByIndex_lmmm([keyn], val, ky, nam, def, lDisp)
+END FUNCTION getKeyByIndex_l1mm
+!==============================================================================================================================
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_smmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn(:)
+  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) ::  val(:)
+  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
+  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
+  CHARACTER(LEN=*),      OPTIONAL,              INTENT(IN)  ::  def
+  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
+  INTEGER :: iq, nq(3), k
+  LOGICAL :: lD, l(3)
+  lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'"'
+  lerr = .TRUE.
+  IF(PRESENT(ky)) THEN;                 val = fgetKey(ky)                                !--- "ky"
+  ELSE IF(ALLOCATED(tracers)) THEN;     val = fgetKey(tracers(:)%keys)                   !--- "tracers"
+     IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                   !--- "isotope"
   END IF
-END FUNCTION getKey_sm
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_i1(keyn, val, tname, ky) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
-  INTEGER,                   INTENT(OUT) :: val
-  CHARACTER(LEN=*),          INTENT(IN)  :: tname
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: sval
-  INTEGER :: ierr
-  lerr = getKeyByName_s1(keyn, sval, tname, ky)
-  IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
-  READ(sval, *, IOSTAT=ierr) val
-  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, ierr/=0), lerr)) RETURN
-END FUNCTION getKeyByName_i1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_i1m(keyn, val, tname, ky) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
-  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
-  CHARACTER(LEN=*),          INTENT(IN)  :: tname
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::  ky(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
-  INTEGER :: ierr, iq, nq
-  IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
-  nq = SIZE(sval); ALLOCATE(val(nq))
-  lerr = .FALSE.; DO iq=1, nq; READ(sval(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
-  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, lerr), lerr)) RETURN
-END FUNCTION getKeyByName_i1m
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky, nam) RESULT(lerr)
-  CHARACTER(LEN=*),                             INTENT(IN)  ::  keyn
-  INTEGER,                         ALLOCATABLE, INTENT(OUT) ::   val(:)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
-  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::    ky(:)
-  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::   nam(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
-  INTEGER :: ierr, iq, nq
-  IF(test(getKeyByName_sm(keyn, sval, tname, ky, names), lerr)) RETURN
-  nq = SIZE(sval); ALLOCATE(val(nq))
-  DO iq = 1, nq                                                      !--- CONVERT THE KEYS TO INTEGERS
-    READ(sval(iq), *, IOSTAT=ierr) val(iq)
-    IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
-  END DO
-  IF(PRESENT(nam)) nam = names(:)
-END FUNCTION getKeyByName_im
-!==============================================================================================================================
-LOGICAL FUNCTION getKey_im(keyn, val, ky, nam) RESULT(lerr)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
+  IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN; END IF
+  IF(.NOT.PRESENT(def)) THEN; CALL msg('No '//TRIM(s)//' found', modname, lD); RETURN; END IF
+
+  !--- DEFAULT VALUE
+  l = [PRESENT(ky), ALLOCATED(tracers), ASSOCIATED(isotope)]; nq(:) = 0
+  IF(l(1)) nq(1) = SIZE(ky)
+  IF(l(2)) nq(2) = SIZE(tracers)
+  IF(l(3)) nq(3) = SIZE(isotope%keys)
+  DO k = 1, 3; IF(l(k) .AND. nq(k) /= 0) THEN; val = [(def, iq = 1, nq(k))]; EXIT; END IF; END DO
+  lerr = k == 4
+  CALL msg('Using defaut value for '//TRIM(s)//': '//TRIM(def), modname, lD .AND. .NOT.lerr)
+  CALL msg('No '//TRIM(s), modname, lD .AND. lerr)
+
+CONTAINS
+
+FUNCTION fgetKey(ky) RESULT(val)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)
+  TYPE(keys_type),       INTENT(IN)  :: ky(:)
+  LOGICAL :: ler(SIZE(ky))
+  INTEGER :: iq
+  lerr = SIZE(ky) == 0; IF(lerr) RETURN
+  tname = ky%name
+  val = [(fgetKeyIdx(iq, keyn(:), ky, ler(iq)), iq = 1, SIZE(ky))]
+  lerr = ANY(ler)
+END FUNCTION fgetKey
+
+END FUNCTION getKeyByIndex_smmm
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_immm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn(:)
   INTEGER,                         ALLOCATABLE, INTENT(OUT) ::  val(:)
   TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
   CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
-  INTEGER :: ierr, iq, nq
-  IF(test(getKey_sm(keyn, sval, ky, names), lerr)) RETURN
-  nq = SIZE(sval); ALLOCATE(val(nq))
-  DO iq = 1, nq
-    READ(sval(iq), *, IOSTAT=ierr) val(iq)
-    IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
-  END DO
-  IF(PRESENT(nam)) nam = names
-END FUNCTION getKey_im
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_r1(keyn, val, tname, ky) RESULT(lerr)
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
-  REAL,                      INTENT(OUT) :: val
-  CHARACTER(LEN=*),          INTENT(IN)  :: tname
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: sval
-  INTEGER :: ierr
-  lerr = getKeyByName_s1(keyn, sval, tname, ky)
-  IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing',    modname, lerr), lerr)) RETURN
-  READ(sval, *, IOSTAT=ierr) val
-  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, ierr/=0), lerr)) RETURN
-END FUNCTION getKeyByName_r1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_r1m(keyn, val, tname, ky) RESULT(lerr)
-  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
-  REAL,          ALLOCATABLE, INTENT(OUT) :: val(:)
-  CHARACTER(LEN=*),           INTENT(IN)  :: tname
-  TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::  ky(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
-  INTEGER :: ierr, iq, nq
-  IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
-  nq = SIZE(sval); ALLOCATE(val(nq))
-  lerr = .FALSE.; DO iq=1, nq; READ(sval(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
-  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a vector of reals', modname, lerr), lerr)) RETURN
-END FUNCTION getKeyByName_r1m
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_rm(keyn, val, tname, ky, nam) RESULT(lerr)
-  CHARACTER(LEN=*),                             INTENT(IN)  ::  keyn
-  REAL,                            ALLOCATABLE, INTENT(OUT) ::   val(:)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
-  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::    ky(:)
-  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::   nam(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
-  INTEGER :: ierr, iq, nq
-  IF(test(getKeyByName_sm(keyn, sval, tname, ky, names), lerr)) RETURN
-  nq = SIZE(sval); ALLOCATE(val(nq))
-  DO iq = 1, nq                                                      !--- CONVERT THE KEYS TO INTEGERS
-    READ(sval(iq), *, IOSTAT=ierr) val(iq)
-    IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
-  END DO
-  IF(PRESENT(nam)) nam = names
-END FUNCTION getKeyByName_rm
-!==============================================================================================================================
-LOGICAL FUNCTION getKey_rm(keyn, val, ky, nam) RESULT(lerr)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
+  INTEGER,               OPTIONAL,              INTENT(IN)  ::  def
+  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
+  LOGICAL,               ALLOCATABLE ::    ll(:)
+  IF(     PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, int2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp=lDisp)
+  IF(lerr) RETURN
+  val = str2int(svals)
+  ll = val == -HUGE(1)
+  lerr = ANY(ll); IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN; END IF
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(PACK(tname, MASK=ll)))//' is not'
+  CALL msg(TRIM(s)//' an integer: '//TRIM(strStack(svals, MASK=ll)), modname, lerr)
+  IF(.NOT.lerr .AND. PRESENT(nam)) nam = tname
+END FUNCTION getKeyByIndex_immm
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_rmmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn(:)
   REAL,                            ALLOCATABLE, INTENT(OUT) ::  val(:)
   TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
   CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
-  INTEGER :: ierr, iq, nq
-  IF(test(getKey_sm(keyn, sval, ky, names), lerr)) RETURN
-  nq = SIZE(sval); ALLOCATE(val(nq))
-  DO iq = 1, nq                                                      !--- CONVERT THE KEYS TO INTEGERS
-    READ(sval(iq), *, IOSTAT=ierr) val(iq)
-    IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
-  END DO
-  IF(PRESENT(nam)) nam = names
-END FUNCTION getKey_rm
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_l1(keyn, val, tname, ky) RESULT(lerr)
-  USE strings_mod, ONLY: str2bool
-  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
-  LOGICAL,                   INTENT(OUT) :: val
-  CHARACTER(LEN=*),          INTENT(IN)  :: tname
-  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen) :: sval
-  lerr = getKeyByName_s1(keyn, sval, tname, ky)
-  IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
-  val = str2bool(sval)
-END FUNCTION getKeyByName_l1
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_l1m(keyn, val, tname, ky) RESULT(lerr)
-  USE strings_mod, ONLY: str2bool
-  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
-  LOGICAL,       ALLOCATABLE, INTENT(OUT) :: val(:)
-  CHARACTER(LEN=*),           INTENT(IN)  :: tname
-  TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::  ky(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
-  INTEGER :: iq, nq
-  IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
-  nq = SIZE(sval); ALLOCATE(val(nq))
-  lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
-END FUNCTION getKeyByName_l1m
-!==============================================================================================================================
-LOGICAL FUNCTION getKeyByName_lm(keyn, val, tname, ky, nam) RESULT(lerr)
-  USE strings_mod, ONLY: str2bool
-  CHARACTER(LEN=*),                             INTENT(IN)  ::  keyn
-  LOGICAL,                         ALLOCATABLE, INTENT(OUT) ::   val(:)
-  CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
-  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::    ky(:)
-  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::   nam(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
-  INTEGER :: iq, nq
-  IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN
-  nq = SIZE(sval); ALLOCATE(val(nq))
-  lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
-END FUNCTION getKeyByName_lm
-!==============================================================================================================================
-LOGICAL FUNCTION getKey_lm(keyn, val, ky, nam) RESULT(lerr)
-  USE strings_mod, ONLY: str2bool
-  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
+  REAL,                  OPTIONAL,              INTENT(IN)  ::  def
+  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
+  LOGICAL,               ALLOCATABLE ::    ll(:)
+  IF(     PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, real2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp=lDisp)
+  IF(lerr) RETURN
+  val = str2real(svals)
+  ll = val == -HUGE(1.)
+  lerr = ANY(ll); IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN; END IF
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(PACK(tname, MASK=ll)))//' is not a'
+  CALL msg(TRIM(s)//' a real: '//TRIM(strStack(svals, MASK=ll)), modname)
+END FUNCTION getKeyByIndex_rmmm
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByIndex_lmmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn(:)
   LOGICAL,                         ALLOCATABLE, INTENT(OUT) ::  val(:)
   TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
   CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
+  LOGICAL,               OPTIONAL,              INTENT(IN)  ::  def
+  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
+  LOGICAL,               ALLOCATABLE ::    ll(:)
+  INTEGER,               ALLOCATABLE :: ivals(:)
+  IF(     PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, bool2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp=lDisp)
+  IF(lerr) RETURN
+  ivals = str2bool(svals)
+  ll = ivals == -1
+  lerr = ANY(ll); IF(.NOT.lerr) THEN; val = ivals == 1; IF(PRESENT(nam)) nam = tname; RETURN; END IF
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
+  CALL msg(TRIM(s)//' a boolean: '//TRIM(strStack(svals, MASK=ll)), modname)
+END FUNCTION getKeyByIndex_lmmm
+!==============================================================================================================================
+
+
+
+!==============================================================================================================================
+!===                                           GET KEYS VALUES FROM TRACERS NAMES                                           ===
+!==============================================================================================================================
+!=== TRY TO GET THE KEY NAMED "key" FOR THE TRACER NAMED "tname" IN:                                                        ===
+!===  * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE:                                                                    ===
+!===  * IN INTERNAL TRACERS DATABASE "tracers(:)%keys" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)")        ===
+!=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER:                                            ===
+!===  * A SCALAR                                                                                                            ===
+!===  * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR ","                                                    ===
+!===                                                                                                                        ===
+!=== SYNTAX:       lerr = getKeyByName_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], tname  [, ky(:)][, def][, lDisp])               ===
+!==============================================================================================================================
+!=== IF "tname(:)" IS A VECTOR, THE RETURNED VALUES (ONE EACH "tname(:)" ELEMENT) ARE STORED IN THE VECTOR "val(:)"         ===
+!===                                                                                                                        ===
+!=== SYNTAX        lerr = getKeyByName_{sirl}{1m}mm   (keyn[(:)], val (:), tname(:)[, ky(:)][, def][, lDisp])               ===
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_s111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
+  CHARACTER(LEN=maxlen),     INTENT(OUT) :: val
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  CHARACTER(LEN=*),OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+  lerr = getKeyByName_sm11([keyn], val, tname, ky, def, lDisp)
+END FUNCTION getKeyByName_s111
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_i111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
+  INTEGER,                   INTENT(OUT) :: val
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  INTEGER,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+  lerr = getKeyByName_im11([keyn], val, tname, ky, def, lDisp)
+END FUNCTION getKeyByName_i111
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_r111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
+  REAL   ,                   INTENT(OUT) :: val
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  REAL,            OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+  lerr = getKeyByName_rm11([keyn], val, tname, ky, def, lDisp)
+END FUNCTION getKeyByName_r111
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_l111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
+  LOGICAL,                   INTENT(OUT) :: val
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+  lerr = getKeyByName_lm11([keyn], val, tname, ky, def, lDisp)
+END FUNCTION getKeyByName_l111
+!==============================================================================================================================
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_sm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
+  CHARACTER(LEN=maxlen),     INTENT(OUT) :: val
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  CHARACTER(LEN=*),OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: s, tnam
+  LOGICAL :: lD
+  lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" for "'//TRIM(tname)//'"'
+  lerr = .TRUE.
+  tnam = strHead(delPhase(tname),'_',.TRUE.)                                             !--- Remove phase and tag
+  IF(lerr .AND. PRESENT(ky))         val = fgetKey(ky)                                   !--- "ky"
+  IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)%keys)                      !--- "tracers"
+  IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                      !--- "isotope"
+  IF(lerr .AND. PRESENT(def)) THEN
+     val = def; lerr = .NOT.PRESENT(def)
+     CALL msg('Using defaut value of '//TRIM(s)//': '//TRIM(def), modname, lD)
+  END IF
+  CALL msg('No '//TRIM(s)//' or out of bounds index', modname, lD .AND. lerr)
+
+CONTAINS
+
+ CHARACTER(LEN=maxlen) FUNCTION fgetKey(ky) RESULT(val)
+  TYPE(keys_type),  INTENT(IN)  :: ky(:)
+  lerr = SIZE(ky) == 0
+  IF(lerr) RETURN
+           val = fgetKeyIdx(strIdx(ky%name, tname), [keyn], ky, lerr)
+  IF(lerr) val = fgetKeyIdx(strIdx(ky%name, tnam ), [keyn], ky, lerr)
+
+END FUNCTION fgetKey
+
+END FUNCTION getKeyByName_sm11
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_im11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
+  INTEGER,                   INTENT(OUT) :: val
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  INTEGER,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: sval, s
+  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, int2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  val = str2int(sval)
+  lerr = val == -HUGE(1)
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
+  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
+END FUNCTION getKeyByName_im11
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_rm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
+  REAL   ,                   INTENT(OUT) :: val
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  REAL,            OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: sval, s
+  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, real2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  val = str2real(sval)
+  lerr = val == -HUGE(1.)
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
+  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
+END FUNCTION getKeyByName_rm11
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_lm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
+  LOGICAL,                   INTENT(OUT) :: val
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: sval, s
+  INTEGER               :: ival
+  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, bool2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  ival = str2bool(sval)
+  lerr = ival == -1
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
+  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
+  IF(.NOT.lerr) val = ival == 1
+END FUNCTION getKeyByName_lm11
+!==============================================================================================================================
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_s1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn, tname
+  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
+  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,                  OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: sval
+  lerr = getKeyByName_sm11([keyn], sval, tname, ky, def, lDisp); IF(lerr) RETURN
+  lerr = strParse(sval, ',', val)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+END FUNCTION getKeyByName_s1m1
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_i1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
+  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  INTEGER,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: sval, s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  IF(     PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, int2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  lerr = strParse(sval, ',', svals)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+  val = str2int(svals)
+  lerr = ANY(val == -HUGE(1))
+  s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
+  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
+END FUNCTION getKeyByName_i1m1
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_r1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
+  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  REAL,            OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: sval, s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  IF(     PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, real2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  lerr = strParse(sval, ',', svals)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+  val = str2real(svals)
+  lerr = ANY(val == -HUGE(1.))
+  s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
+  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
+END FUNCTION getKeyByName_r1m1
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_l1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
+  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: sval, s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  INTEGER,               ALLOCATABLE :: ivals(:)
+  IF(     PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, bool2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  lerr = strParse(sval, ',', svals)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+  ivals = str2bool(svals)
+  lerr = ANY(ivals == -1)
+  s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
+  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
+  IF(.NOT.lerr) val = ivals == 1
+END FUNCTION getKeyByName_l1m1
+!==============================================================================================================================
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_smm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn(:), tname
+  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
+  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,                  OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: sval
+  lerr = getKeyByName_sm11(keyn, sval, tname, ky, def, lDisp); IF(lerr) RETURN
+  lerr = strParse(sval, ',', val)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+END FUNCTION getKeyByName_smm1
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_imm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
+  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  INTEGER,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: sval, s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, int2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  lerr = strParse(sval, ',', svals)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+  val = str2int(svals)
+  lerr = ANY(val == -HUGE(1))
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
+  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
+END FUNCTION getKeyByName_imm1
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_rmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
+  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  REAL,            OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: sval, s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, real2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  lerr = strParse(sval, ',', svals)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+  val = str2real(svals)
+  lerr = ANY(val == -HUGE(1.))
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
+  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
+END FUNCTION getKeyByName_rmm1
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_lmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
+  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen)              :: sval, s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  INTEGER,               ALLOCATABLE :: ivals(:)
+  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, bool2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  lerr = strParse(sval, ',', svals)
+  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
+  ivals = str2bool(svals)
+  lerr = ANY(ivals == -1)
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
+  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
+  IF(.NOT.lerr) val = ivals == 1
+END FUNCTION getKeyByName_lmm1
+!==============================================================================================================================
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_s1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn, tname(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type),       OPTIONAL,    INTENT(IN)  ::  ky(:)
+  CHARACTER(LEN=*),      OPTIONAL,    INTENT(IN)  :: def
+  LOGICAL,               OPTIONAL,    INTENT(IN)  :: lDisp
+  lerr = getKeyByName_smmm([keyn], val, tname, ky, def, lDisp)
+END FUNCTION getKeyByName_s1mm
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_i1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname(:)
+  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::  ky(:)
+  INTEGER,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+  lerr = getKeyByName_immm([keyn], val, tname, ky, def, lDisp)
+END FUNCTION getKeyByName_i1mm
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_r1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname(:)
+  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::  ky(:)
+  REAL,            OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+  lerr = getKeyByName_rmmm([keyn], val, tname, ky, def, lDisp)
+END FUNCTION getKeyByName_r1mm
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_l1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname(:)
+  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::  ky(:)
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+  lerr = getKeyByName_lmmm([keyn], val, tname, ky, def, lDisp)
+END FUNCTION getKeyByName_l1mm
+!==============================================================================================================================
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_smmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn(:), tname(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) ::  val(:)
+  TYPE(keys_type),       OPTIONAL,    INTENT(IN)  ::   ky(:)
+  CHARACTER(LEN=*),      OPTIONAL,    INTENT(IN)  ::   def
+  LOGICAL,               OPTIONAL,    INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: s
   INTEGER :: iq, nq
-  IF(test(getKey_sm(keyn, sval, ky, nam), lerr)) RETURN
-  nq = SIZE(sval); ALLOCATE(val(nq))
-  lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
-END FUNCTION getKey_lm
+  LOGICAL :: lD
+  nq = SIZE(tname); ALLOCATE(val(nq))
+  lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'"'
+  lerr = .TRUE.
+  IF(PRESENT(ky)) THEN;                 val = fgetKey(ky)                                !--- "ky"
+  ELSE IF(ALLOCATED(tracers)) THEN;     val = fgetKey(tracers(:)%keys)                   !--- "tracers"
+     IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                   !--- "isotope"
+  END IF
+  IF(.NOT.PRESENT(def)) THEN; CALL msg('No '//TRIM(s)//' found', modname, lD); RETURN; END IF
+
+  !--- DEFAULT VALUE
+  val = [(def, iq = 1, SIZE(tname))]
+  CALL msg('Using defaut value for '//TRIM(s)//': '//TRIM(def), modname, lD)
+
+CONTAINS
+
+FUNCTION fgetKey(ky) RESULT(val)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)
+  TYPE(keys_type),       INTENT(IN)  :: ky(:)
+  LOGICAL,               ALLOCATABLE :: ler(:)
+  lerr = SIZE(ky) == 0; IF(lerr) RETURN
+  ALLOCATE(ler(SIZE(tname)))
+  val = [(fgetKeyIdx(strIdx(ky(:)%name, tname(iq)), keyn, ky, ler(iq)), iq = 1, SIZE(tname))]
+  lerr = ANY(ler)
+END FUNCTION fgetKey
+
+END FUNCTION getKeyByName_smmm
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_immm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname(:)
+  INTEGER,      ALLOCATABLE, INTENT(OUT) ::  val(:)
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::   ky(:)
+  INTEGER,         OPTIONAL, INTENT(IN)  ::  def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  LOGICAL,               ALLOCATABLE ::    ll(:)
+  IF(     PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, int2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  val = str2int(svals)
+  ll = val == -HUGE(1)
+  lerr = ANY(ll); IF(.NOT.lerr) RETURN
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
+  CALL msg(TRIM(s)//' an integer: '//TRIM(strStack(svals, MASK=ll)), modname)
+END FUNCTION getKeyByName_immm
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_rmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname(:)
+  REAL,         ALLOCATABLE, INTENT(OUT) ::  val(:)
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::   ky(:)
+  REAL,            OPTIONAL, INTENT(IN)  ::  def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  LOGICAL,               ALLOCATABLE ::    ll(:)
+  IF(     PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, real2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  val = str2real(svals)
+  ll = val == -HUGE(1.)
+  lerr = ANY(ll); IF(.NOT.lerr) RETURN
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
+  CALL msg(TRIM(s)//' a real: '//TRIM(strStack(svals, MASK=ll)), modname)
+END FUNCTION getKeyByName_rmmm
+!==============================================================================================================================
+LOGICAL FUNCTION getKeyByName_lmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
+  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname(:)
+  LOGICAL,      ALLOCATABLE, INTENT(OUT) ::  val(:)
+  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::   ky(:)
+  LOGICAL,         OPTIONAL, INTENT(IN)  ::  def
+  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: s
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
+  LOGICAL,               ALLOCATABLE ::    ll(:)
+  INTEGER,               ALLOCATABLE :: ivals(:)
+  IF(     PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, bool2str(def), lDisp)
+  IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
+  IF(lerr) RETURN
+  ivals = str2bool(svals)
+  ll = ivals == -1
+  lerr = ANY(ll); IF(.NOT.lerr) THEN; val = ivals == 1; RETURN; END IF
+  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
+  CALL msg(TRIM(s)//' a boolean: '//TRIM(strStack(svals, MASK=ll)), modname)
+END FUNCTION getKeyByName_lmmm
 !==============================================================================================================================
 
@@ -1808,4 +2596,67 @@
   IF(.NOT.PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, known_phases), k=1, SIZE(s) )]
 END FUNCTION addPhase_im
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+!=== APPEND TRACERS DATABASE "tracs" WITH TRACERS/KEYS "tname"/"keys" ; SAME FOR INTERNAL DATABASE "tracers" ==================
+!==============================================================================================================================
+LOGICAL FUNCTION addTracer_1(tname, keys, tracs) RESULT(lerr)
+  CHARACTER(LEN=*),             INTENT(IN)    :: tname
+  TYPE(keys_type),              INTENT(IN)    ::  keys
+  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tracs(:)
+  TYPE(trac_type), ALLOCATABLE :: tr(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
+  INTEGER :: nt, ix
+  IF(ALLOCATED(tracs)) THEN
+     lerr = getKey('name', tnames, ky=tracs(:)%keys); IF(lerr) RETURN
+     nt = SIZE(tracs)
+     ix = strIdx(tnames, tname)
+     CALL msg('Modifying existing tracer "'//TRIM(tname)//'"', modname, ix /= 0)
+     CALL msg('Appending with tracer "'    //TRIM(tname)//'"', modname, ix == 0)
+     IF(ix == 0) THEN
+        ix = nt+1; ALLOCATE(tr(nt+1)); tr(1:nt) = tracs(1:nt); CALL MOVE_ALLOC(FROM=tr, TO=tracs)
+     END IF
+  ELSE
+     CALL msg('Creating a tracer descriptor with tracer "'//TRIM(tname)//'"', modname)
+     ix = 1; ALLOCATE(tracs(1))
+  END IF
+  CALL addKey('name', tname, tracs(ix)%keys)
+  tracs(ix)%name = tname
+  tracs(ix)%keys = keys
+
+END FUNCTION addTracer_1
+!==============================================================================================================================
+LOGICAL FUNCTION addTracer_1def(tname, keys) RESULT(lerr)
+  CHARACTER(LEN=*),             INTENT(IN)    :: tname
+  TYPE(keys_type),              INTENT(IN)    ::  keys
+  lerr = addTracer_1(tname, keys, tracers)
+END FUNCTION addTracer_1def
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+LOGICAL FUNCTION delTracer_1(tname, tracs) RESULT(lerr)
+  CHARACTER(LEN=*),                     INTENT(IN)    :: tname
+  TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: tracs(:)
+  TYPE(trac_type), ALLOCATABLE :: tr(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
+  INTEGER :: nt, ix
+  lerr = .NOT.ALLOCATED(tracs)
+  IF(fmsg('Can''t remove tracer "'//TRIM(tname)//'" from an empty tracers descriptor', modname, lerr)) RETURN
+  nt = SIZE(tracs)
+  lerr = getKey('name', tnames, ky=tracs(:)%keys); IF(lerr) RETURN
+  ix = strIdx(tnames, tname)
+  CALL msg('Removing tracer "'             //TRIM(tname)//'"', modname, ix /= 0)
+  CALL msg('Can''t remove unknown tracer "'//TRIM(tname)//'"', modname, ix == 0)
+  IF(ix /= 0) THEN
+     ALLOCATE(tr(nt-1)); tr(1:ix-1) = tracs(1:ix-1); tr(ix:nt-1) = tracs(ix+1:nt); CALL MOVE_ALLOC(FROM=tr, TO=tracs)
+  END IF
+END FUNCTION delTracer_1
+!==============================================================================================================================
+LOGICAL FUNCTION delTracer_1def(tname) RESULT(lerr)
+  CHARACTER(LEN=*), INTENT(IN) :: tname
+  lerr = delTracer(tname, tracers)
+END FUNCTION delTracer_1def
 !==============================================================================================================================
 
@@ -1908,76 +2759,3 @@
 !==============================================================================================================================
 
-
-!==============================================================================================================================
-!=== GET THE NAME(S) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen"  IN THE TRACERS DESCRIPTORS LIST "tr" =======
-!==============================================================================================================================
-SUBROUTINE ancestor_1(t, out, tname, igen)
-  TYPE(trac_type),       INTENT(IN)  :: t(:)
-  CHARACTER(LEN=maxlen), INTENT(OUT) :: out
-  CHARACTER(LEN=*),      INTENT(IN)  :: tname
-  INTEGER,     OPTIONAL, INTENT(IN)  :: igen
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ix
-  CALL idxAncestor_1(t, ix, tname, igen)
-  out = ''; IF(ix /= 0) out = t(ix)%name
-END SUBROUTINE ancestor_1
-!==============================================================================================================================
-SUBROUTINE ancestor_mt(t, out, tname, igen)
-  TYPE(trac_type),       INTENT(IN)  :: t(:)
-  CHARACTER(LEN=*),      INTENT(IN)  :: tname(:)
-  CHARACTER(LEN=maxlen), INTENT(OUT) :: out(SIZE(tname))
-  INTEGER,     OPTIONAL, INTENT(IN)  :: igen
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ix(SIZE(tname))
-  CALL idxAncestor_mt(t, ix, tname, igen)
-  out(:) = ''; WHERE(ix /= 0) out = t(ix)%name
-END SUBROUTINE ancestor_mt
-!==============================================================================================================================
-SUBROUTINE ancestor_m(t, out, igen)
-  TYPE(trac_type),       INTENT(IN)  :: t(:)
-  CHARACTER(LEN=maxlen), INTENT(OUT) :: out(SIZE(t))
-  INTEGER,     OPTIONAL, INTENT(IN)  :: igen
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ix(SIZE(t))
-  CALL idxAncestor_m(t, ix, igen)
-  out(:) = ''; WHERE(ix /= 0) out = t(ix)%name
-END SUBROUTINE ancestor_m
-!==============================================================================================================================
-
-
-!==============================================================================================================================
-!=== GET THE INDEX(ES) OF THE GENERATION "igen" ANCESTOR(S) OF "tname" (t%name IF UNSPECIFIED) IN THE "t" LIST ================
-!==============================================================================================================================
-SUBROUTINE idxAncestor_1(t, idx, tname, igen)
-  TYPE(trac_type),   INTENT(IN)  :: t(:)
-  INTEGER,           INTENT(OUT) :: idx
-  CHARACTER(LEN=*),  INTENT(IN)  :: tname
-  INTEGER, OPTIONAL, INTENT(IN)  :: igen
-  INTEGER :: ig
-  ig = 0; IF(PRESENT(igen)) ig = igen
-  idx = strIdx(t(:)%name, tname)
-  IF(idx == 0)                 RETURN            !--- Tracer not found
-  IF(t(idx)%iGeneration <= ig) RETURN            !--- Tracer has a lower generation number than asked generation 'igen"
-  DO WHILE(t(idx)%iGeneration > ig); idx = strIdx(t(:)%name, t(idx)%parent); END DO
-END SUBROUTINE idxAncestor_1
-!------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE idxAncestor_mt(t, idx, tname, igen)
-  TYPE(trac_type),   INTENT(IN)  :: t(:)
-  CHARACTER(LEN=*),  INTENT(IN)  :: tname(:)
-  INTEGER,           INTENT(OUT) :: idx(SIZE(tname))
-  INTEGER, OPTIONAL, INTENT(IN)  :: igen
-  INTEGER :: ix
-  DO ix = 1, SIZE(tname); CALL idxAncestor_1(t, idx(ix), tname(ix), igen); END DO
-END SUBROUTINE idxAncestor_mt
-!------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE idxAncestor_m(t, idx, igen)
-  TYPE(trac_type),   INTENT(IN)  :: t(:)
-  INTEGER,           INTENT(OUT) :: idx(SIZE(t))
-  INTEGER, OPTIONAL, INTENT(IN)  :: igen
-  INTEGER :: ix
-  DO ix = 1, SIZE(t); CALL idxAncestor_1(t, idx(ix), t(ix)%name, igen); END DO
-END SUBROUTINE idxAncestor_m
-!==============================================================================================================================
-
-
 END MODULE readTracFiles_mod
Index: /LMDZ6/branches/cirrus/libf/misc/strings_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/misc/strings_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/misc/strings_mod.F90	(revision 5202)
@@ -10,5 +10,5 @@
   PUBLIC :: is_numeric, bool2str, int2str, real2str, dble2str
   PUBLIC :: reduceExpr, str2bool, str2int, str2real, str2dble
-  PUBLIC :: addQuotes, checkList, removeComment, test
+  PUBLIC :: addQuotes, checkList, removeComment
 
   INTERFACE get_in;     MODULE PROCEDURE getin_s,  getin_i,  getin_r,  getin_l;  END INTERFACE get_in
@@ -22,8 +22,10 @@
   INTERFACE strCount;   MODULE PROCEDURE  strCount_m1, strCount_11, strCount_1m; END INTERFACE strCount
   INTERFACE strReplace; MODULE PROCEDURE strReplace_1,             strReplace_m; END INTERFACE strReplace
-  INTERFACE cat;        MODULE PROCEDURE   horzcat_s1,  horzcat_i1,  horzcat_r1, &
-!                 horzcat_d1,  horzcat_dm,
-                                           horzcat_sm,  horzcat_im,  horzcat_rm; END INTERFACE cat
-  INTERFACE find;         MODULE PROCEDURE    strFind,    find_int,    find_boo; END INTERFACE find
+  INTERFACE cat;        MODULE PROCEDURE  horzcat_s00, horzcat_i00, horzcat_r00,  & !horzcat_d00, &
+                                          horzcat_s10, horzcat_i10, horzcat_r10,  & !horzcat_d10, &
+                                          horzcat_s11, horzcat_i11, horzcat_r11,  & !horzcat_d11, &
+                                          horzcat_s21, horzcat_i21, horzcat_r21; END INTERFACE cat !horzcat_d21
+  INTERFACE strFind;      MODULE PROCEDURE strFind_1, strFind_m;                 END INTERFACE strFind
+  INTERFACE find;         MODULE PROCEDURE strFind_1, strFind_m, intFind_1, intFind_m, booFind; END INTERFACE find
   INTERFACE dispOutliers; MODULE PROCEDURE dispOutliers_1, dispOutliers_2; END INTERFACE dispOutliers
   INTERFACE reduceExpr;   MODULE PROCEDURE   reduceExpr_1,   reduceExpr_m; END INTERFACE reduceExpr
@@ -36,15 +38,8 @@
 CONTAINS
 
-!==============================================================================================================================
-LOGICAL FUNCTION test(lcond, lout) RESULT(lerr)
-  LOGICAL, INTENT(IN)  :: lcond
-  LOGICAL, INTENT(OUT) :: lout
-  lerr = lcond; lout = lcond
-END FUNCTION test
-!==============================================================================================================================
-
 
 !==============================================================================================================================
 SUBROUTINE init_printout(lunout_, prt_level_)
+  IMPLICIT NONE
   INTEGER, INTENT(IN) :: lunout_, prt_level_
   lunout    = lunout_
@@ -58,5 +53,6 @@
 !==============================================================================================================================
 SUBROUTINE getin_s(nam, val, def)
-USE ioipsl_getincom, ONLY: getin
+  USE ioipsl_getincom, ONLY: getin
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN)    :: nam
   CHARACTER(LEN=*), INTENT(INOUT) :: val
@@ -67,5 +63,6 @@
 !==============================================================================================================================
 SUBROUTINE getin_i(nam, val, def)
-USE ioipsl_getincom, ONLY: getin
+  USE ioipsl_getincom, ONLY: getin
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN)    :: nam
   INTEGER,          INTENT(INOUT) :: val
@@ -76,5 +73,6 @@
 !==============================================================================================================================
 SUBROUTINE getin_r(nam, val, def)
-USE ioipsl_getincom, ONLY: getin
+  USE ioipsl_getincom, ONLY: getin
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN)    :: nam
   REAL,             INTENT(INOUT) :: val
@@ -85,5 +83,6 @@
 !==============================================================================================================================
 SUBROUTINE getin_l(nam, val, def)
-USE ioipsl_getincom, ONLY: getin
+  USE ioipsl_getincom, ONLY: getin
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN)    :: nam
   LOGICAL,          INTENT(INOUT) :: val
@@ -99,4 +98,5 @@
 !==============================================================================================================================
 SUBROUTINE msg_1(str, modname, ll, unit)
+  IMPLICIT NONE
   !--- Display a simple message "str". Optional parameters:
   !    * "modname": module name, displayed in front of the message (with ": " separator) if present.
@@ -118,4 +118,5 @@
 !==============================================================================================================================
 SUBROUTINE msg_m(str, modname, ll, unit, nmax)
+  IMPLICIT NONE
   !--- Same as msg_1 with multiple strings that are stacked (separator: coma) on up to "nmax" full lines.
   CHARACTER(LEN=*),           INTENT(IN) :: str(:)
@@ -138,4 +139,5 @@
 !==============================================================================================================================
 LOGICAL FUNCTION fmsg_1(str, modname, ll, unit) RESULT(l)
+  IMPLICIT NONE
   CHARACTER(LEN=*),           INTENT(IN) :: str
   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
@@ -152,4 +154,5 @@
 !==============================================================================================================================
 LOGICAL FUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l)
+  IMPLICIT NONE
   CHARACTER(LEN=*),           INTENT(IN)  :: str(:)
   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
@@ -173,4 +176,5 @@
 !==============================================================================================================================
 ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strLower(str) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN) :: str
   INTEGER :: k
@@ -182,4 +186,5 @@
 !==============================================================================================================================
 ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strUpper(str) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN) :: str
   INTEGER :: k
@@ -199,4 +204,5 @@
 !==============================================================================================================================
 CHARACTER(LEN=maxlen) FUNCTION strHead_1(str, sep, lBackward) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=*),           INTENT(IN) :: str
   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
@@ -214,4 +220,5 @@
 !==============================================================================================================================
 FUNCTION strHead_m(str, sep, lBackward) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
   CHARACTER(LEN=*),           INTENT(IN) :: str(:)
@@ -235,4 +242,5 @@
 !==============================================================================================================================
 CHARACTER(LEN=maxlen) FUNCTION strTail_1(str, sep, lBackWard) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=*),           INTENT(IN) :: str
   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
@@ -250,4 +258,5 @@
 !==============================================================================================================================
 FUNCTION strTail_m(str, sep, lBackWard) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
   CHARACTER(LEN=*),           INTENT(IN) :: str(:)
@@ -271,4 +280,5 @@
 !==============================================================================================================================
 FUNCTION strStack(str, sep, mask) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=:),          ALLOCATABLE :: out
   CHARACTER(LEN=*),           INTENT(IN) :: str(:)
@@ -292,4 +302,5 @@
 !==============================================================================================================================
 FUNCTION strStackm(str, sep, nmax) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
   CHARACTER(LEN=*),           INTENT(IN) :: str(:)
@@ -324,4 +335,5 @@
 !==============================================================================================================================
 SUBROUTINE strClean_1(str)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(INOUT) :: str
   INTEGER :: k, n, m
@@ -337,4 +349,5 @@
 !==============================================================================================================================
 SUBROUTINE strClean_m(str)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(INOUT) :: str(:)
   INTEGER :: k
@@ -349,4 +362,5 @@
 !==============================================================================================================================
 SUBROUTINE strReduce_1(str, nb)
+  IMPLICIT NONE
   CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
   INTEGER,          OPTIONAL,    INTENT(OUT)   :: nb
@@ -366,4 +380,5 @@
 !==============================================================================================================================
 SUBROUTINE strReduce_2(str1, str2)
+  IMPLICIT NONE
   CHARACTER(LEN=*),   ALLOCATABLE, INTENT(INOUT) :: str1(:)
   CHARACTER(LEN=*),                INTENT(IN)    :: str2(:)
@@ -392,4 +407,5 @@
 !==============================================================================================================================
 INTEGER FUNCTION strIdx_1(str, s) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN) :: str(:), s
   DO out = 1, SIZE(str); IF(str(out) == s) EXIT; END DO
@@ -398,4 +414,5 @@
 !==============================================================================================================================
 FUNCTION strIdx_m(str, s, n) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
   INTEGER, OPTIONAL, INTENT(OUT) :: n
@@ -412,5 +429,6 @@
 !=== GET THE INDEX LIST OF THE ELEMENTS OF "str(:)" EQUAL TO "s" AND OPTIONALY, ITS LENGTH "n" ================================
 !==============================================================================================================================
-FUNCTION strFind(str, s, n) RESULT(out)
+FUNCTION strFind_1(str, s, n) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s
   INTEGER, OPTIONAL, INTENT(OUT) :: n
@@ -420,7 +438,19 @@
   out = PACK( [(k, k=1, SIZE(str(:), DIM=1))], MASK = str(:) == s )
   IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
-END FUNCTION strFind
-!==============================================================================================================================
-FUNCTION find_int(i,j,n) RESULT(out)
+END FUNCTION strFind_1
+!==============================================================================================================================
+FUNCTION strFind_m(str, s, n) RESULT(out)
+  IMPLICIT NONE
+  CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
+  INTEGER, OPTIONAL, INTENT(OUT) :: n
+  INTEGER,           ALLOCATABLE :: out(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: k
+  out = [(strFind_1(str, s(k)), k=1, SIZE(s))]
+  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
+END FUNCTION strFind_m
+!==============================================================================================================================
+FUNCTION intFind_1(i,j,n) RESULT(out)
+  IMPLICIT NONE
   INTEGER,           INTENT(IN)  :: i(:), j
   INTEGER, OPTIONAL, INTENT(OUT) :: n
@@ -430,8 +460,20 @@
   out = PACK( [(k, k=1, SIZE(i(:), DIM=1))], MASK = i(:) == j )
   IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
-END FUNCTION find_int
-!==============================================================================================================================
-FUNCTION find_boo(l,n) RESULT(out)
-  LOGICAL,           INTENT(IN)  :: l(:)
+END FUNCTION intFind_1
+!==============================================================================================================================
+FUNCTION intFind_m(i,j,n) RESULT(out)
+  IMPLICIT NONE
+  INTEGER,           INTENT(IN)  :: i(:), j(:)
+  INTEGER, OPTIONAL, INTENT(OUT) :: n
+  INTEGER,           ALLOCATABLE :: out(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: k
+  out = [(intFind_1(i, j(k)), k=1, SIZE(j))]
+  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
+END FUNCTION intFind_m
+!==============================================================================================================================
+FUNCTION booFind(l,n) RESULT(out)
+   IMPLICIT NONE
+ LOGICAL,           INTENT(IN)  :: l(:)
   INTEGER, OPTIONAL, INTENT(OUT) :: n
   INTEGER,           ALLOCATABLE :: out(:)
@@ -440,5 +482,5 @@
   out = PACK( [(k, k=1, SIZE(l(:), DIM=1))], MASK = l(:) )
   IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
-END FUNCTION find_boo
+END FUNCTION booFind
 !==============================================================================================================================
 
@@ -450,4 +492,5 @@
 !==============================================================================================================================
 LOGICAL FUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr)
+  IMPLICIT NONE
   CHARACTER(LEN=*),  INTENT(IN)  :: rawList                          !--- String in which delimiters have to be identified
   CHARACTER(LEN=*),  INTENT(IN)  :: del(:)                           !--- List of delimiters
@@ -469,6 +512,6 @@
   END IF
 
-  IF(test(idx == 1 .AND. INDEX('+-',del(idel)) /= 0, lerr)) RETURN   !--- The front delimiter is different from +/-: error
-  IF(     idx /= 1 .AND. is_numeric(rawList(ibeg:idx-1)))   RETURN   !--- The input string head is a valid number
+  lerr = idx == 1 .AND. INDEX('+-',del(idel)) /= 0; IF(lerr) RETURN  !--- The front delimiter is different from +/-: error
+  IF(    idx /= 1 .AND. is_numeric(rawList(ibeg:idx-1)))     RETURN  !--- The input string head is a valid number
 
   !=== The string part in front of the 1st delimiter is not a valid number: search for next delimiter index "idx"
@@ -503,4 +546,5 @@
 !==============================================================================================================================
 LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)
+  IMPLICIT NONE
   CHARACTER(LEN=*),  INTENT(IN)  :: rawList
   CHARACTER(LEN=*),  INTENT(IN)  :: delimiter
@@ -514,4 +558,5 @@
 !==============================================================================================================================
 LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)
+  IMPLICIT NONE
   CHARACTER(LEN=*),     INTENT(IN)  :: rawList(:)
   CHARACTER(LEN=*),     INTENT(IN)  :: delimiter
@@ -530,4 +575,5 @@
 !==============================================================================================================================
 LOGICAL FUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr)
+  IMPLICIT NONE
   CHARACTER(LEN=*),  INTENT(IN)  :: rawList
   CHARACTER(LEN=*),  INTENT(IN)  :: delimiter(:)
@@ -560,4 +606,5 @@
 !==============================================================================================================================
 LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
+  IMPLICIT NONE
   CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter
   CHARACTER(LEN=maxlen), ALLOCATABLE,           INTENT(OUT) :: keys(:)
@@ -570,53 +617,69 @@
   r  = TRIM(ADJUSTL(rawList))
   nr = LEN_TRIM(r); IF(nr == 0) THEN; keys = ['']; RETURN; END IF
-  CALL strParse_prv(nk)                                              !--- COUNT THE ELEMENTS
-  ALLOCATE(keys(nk))
-  IF(PRESENT(vals)) THEN
-    ALLOCATE(vals(nk)); CALL strParse_prv(nk, keys, vals)            !--- PARSE THE KEYS
-  ELSE
-    CALL strParse_prv(nk, keys)                                      !--- PARSE THE KEYS
-  END IF
-  IF(PRESENT(n)) n = nk
+  nk = countK()                                                      !--- COUNT THE ELEMENTS
+  CALL parseK(keys)                                                  !--- PARSE THE KEYS
+  IF(PRESENT(vals)) CALL parseV(vals)                                !--- PARSE <key>=<val> PAIRS
+  IF(PRESENT(n)) n = nk                                              !--- RETURN THE NUMBER OF KEYS
 
 CONTAINS
 
 !------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE strParse_prv(nkeys, keys, vals)
-!--- * Get the number of elements after parsing ("nkeys" only is present)
-!--- * Parse the <key>=<val> pairs and store result in "keys" and "vals" (already allocated)
-  IMPLICIT NONE
-  INTEGER,                         INTENT(OUT) :: nkeys
-  CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: keys(:)
-  CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: vals(:)
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ib, ie
-  nkeys = 1; ib = 1
+INTEGER FUNCTION countK() RESULT(nkeys)
+!--- Get the number of elements after parsing.
+  IMPLICIT NONE
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: ib, ie, nl
+  nkeys = 1; ib = 1; nl = LEN(delimiter)
   DO
     ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
     IF(ie == ib-1) EXIT
-    IF(PRESENT(keys)) keys(nkeys) = r(ib:ie-1)                       !--- Get the ikth key
-    IF(PRESENT(vals)) CALL parseKeys(keys(nkeys), vals(nkeys))       !--- Parse the ikth <key>=<val> pair
+    ib = ie + nl
+    DO WHILE(ANY([0, 9, 32] == IACHAR(r(ib:ib))) .AND. ib < nr)      !--- Skip blanks (ascii): NULL (0), TAB (9), SPACE (32)
+      ib = ib + 1
+    END DO     !--- Skip spaces before next chain
+    nkeys = nkeys+1
+  END DO
+END FUNCTION countK
+
+!------------------------------------------------------------------------------------------------------------------------------
+SUBROUTINE parseK(keys)
+!--- Parse the string separated by "delimiter" from "rawList" into "keys(:)"
+  IMPLICIT NONE
+  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: ib, ie, ik
+  ALLOCATE(keys(nk))
+  ib = 1
+  DO ik = 1, nk
+    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
+    IF(ie == ib-1) EXIT
+    keys(ik) = r(ib:ie-1)                                            !--- Get the ikth key
     ib = ie + LEN(delimiter)
     DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
-    nkeys = nkeys+1
-  END DO
-  IF(PRESENT(keys)) keys(nkeys) = r(ib:nr)                           !--- Get the last key
-  IF(PRESENT(vals)) CALL parseKeys(keys(nkeys), vals(nkeys))         !--- Parse the last <key>=<val> pair
-END SUBROUTINE strParse_prv
-
-!------------------------------------------------------------------------------------------------------------------------------
-SUBROUTINE parseKeys(key, val)
-  CHARACTER(LEN=*), INTENT(INOUT) :: key
-  CHARACTER(LEN=*), INTENT(OUT)   :: val
-!------------------------------------------------------------------------------------------------------------------------------
-  INTEGER :: ix
-  ix = INDEX(key, '='); IF(ix == 0) RETURN                           !--- First "=" index in "key"
-  val = ADJUSTL(key(ix+1:LEN_TRIM(key)))
-  key = ADJUSTL(key(1:ix-1))
-END SUBROUTINE parseKeys
+  END DO
+  keys(ik) = r(ib:nr)                                                !--- Get the last key
+END SUBROUTINE parseK
+
+!------------------------------------------------------------------------------------------------------------------------------
+SUBROUTINE parseV(vals)
+!--- Parse the <key>=<val> pairs in "keys(:)" into "keys" and "vals"
+  IMPLICIT NONE
+  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: vals(:)
+!------------------------------------------------------------------------------------------------------------------------------
+  CHARACTER(LEN=maxlen) :: key
+  INTEGER :: ik, ix
+  ALLOCATE(vals(nk))
+  DO ik = 1, nk; key = keys(ik)
+    vals(ik) = ''
+    ix = INDEX(key, '='); IF(ix == 0) CYCLE                          !--- First "=" index in "key"
+    vals(ik) = ADJUSTL(key(ix+1:LEN_TRIM(key)))
+    keys(ik) = ADJUSTL(key(1:ix-1))
+  END DO
+END SUBROUTINE parseV
 
 END FUNCTION strParse
 !==============================================================================================================================
 LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
+  IMPLICIT NONE
   CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter(:)
   CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: keys(:)  !--- Parsed keys vector
@@ -630,5 +693,6 @@
   LOGICAL :: ll
   ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
-  IF(test(fmsg("Couldn't parse list: non-numerical strings were found", ll=strCount_1m(rawList, delimiter, nk, ll)),lerr)) RETURN
+  lerr = strCount_1m(rawList, delimiter, nk, ll)
+  CALL msg("Couldn't parse list: non-numerical strings were found", ll=lerr); IF(lerr) RETURN
 
   !--- FEW ALLOCATIONS
@@ -643,5 +707,6 @@
   ib = 1
   DO ik = 1, nk-1
-    IF(test(fmsg('Non-numeric values found', ll=strIdx_prv(r, delimiter, ib, ie, jd, ll)),lerr)) RETURN
+    lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
+    CALL msg('Non-numeric values found', ll=lerr); IF(lerr) RETURN
     keys(ik) = r(ib:ie-1)
     IF(PRESENT(vals)) CALL parseKeys(keys(ik), vals(ik))             !--- Parse a <key>=<val> pair
@@ -657,4 +722,5 @@
 !------------------------------------------------------------------------------------------------------------------------------
 SUBROUTINE parseKeys(key, val)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(INOUT) :: key
   CHARACTER(LEN=*), INTENT(OUT)   :: val
@@ -674,4 +740,5 @@
 !==============================================================================================================================
 SUBROUTINE strReplace_1(str, key, val, lsurr)
+  IMPLICIT NONE
   CHARACTER(LEN=*),  INTENT(INOUT) :: str        !--- Main string
   CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
@@ -700,4 +767,5 @@
 !==============================================================================================================================
 SUBROUTINE strReplace_m(str, key, val, lsurr)
+  IMPLICIT NONE
   CHARACTER(LEN=*),  INTENT(INOUT) :: str(:)     !--- Main strings vector
   CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
@@ -714,175 +782,286 @@
 !=== Contatenate horizontally scalars/vectors of strings/integers/reals into a vector/array ===================================
 !==============================================================================================================================
-FUNCTION horzcat_s1(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
-  CHARACTER(LEN=*),           TARGET, INTENT(IN) :: s0
+FUNCTION horzcat_s00(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
+  IMPLICIT NONE
+  CHARACTER(LEN=*),                   INTENT(IN) :: s0
   CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
   CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
-!------------------------------------------------------------------------------------------------------------------------------
   CHARACTER(LEN=maxlen), POINTER     :: s
-  LOGICAL :: lv(10)
-  INTEGER :: iv
-  lv = [   .TRUE.   , PRESENT(s1), PRESENT(s2), PRESENT(s3), PRESENT(s4) , &
-         PRESENT(s5), PRESENT(s6), PRESENT(s7), PRESENT(s8), PRESENT(s9) ]
-  ALLOCATE(out(COUNT(lv)))
-  DO iv=1, COUNT(lv)
-    SELECT CASE(iv)
-      CASE(1); s=> s0; CASE(2); s=> s1; CASE(3); s=> s2; CASE(4); s=> s3; CASE(5); s=> s4
-      CASE(6); s=> s5; CASE(7); s=> s6; CASE(8); s=> s7; CASE(9); s=> s8; CASE(10);s=> s9
+  INTEGER                            :: nrow, iv
+  LOGICAL                            :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  pre(:) = [PRESENT(s1),PRESENT(s2),PRESENT(s3),PRESENT(s4),PRESENT(s5),PRESENT(s6),PRESENT(s7),PRESENT(s8),PRESENT(s9)]
+  nrow = 1+COUNT(pre)
+  ALLOCATE(out(nrow))
+  out(1) = s0
+  DO iv = 2, nrow; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); s=> s1; CASE(2); s=> s2; CASE(3); s=> s3; CASE(4); s=> s4; CASE(5); s=> s5
+      CASE(6); s=> s6; CASE(7); s=> s7; CASE(8); s=> s8; CASE(9); s=> s9
     END SELECT
     out(iv) = s
   END DO
-END FUNCTION horzcat_s1
-!==============================================================================================================================
-FUNCTION horzcat_sm(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
-  CHARACTER(LEN=*),           TARGET, DIMENSION(:), INTENT(IN) :: s0
-  CHARACTER(LEN=*), OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
+END FUNCTION horzcat_s00
+!==============================================================================================================================
+FUNCTION horzcat_s10(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
+  IMPLICIT NONE
+  CHARACTER(LEN=*),           INTENT(IN) :: s0(:), s1
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2, s3, s4, s5, s6, s7, s8, s9
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:), tmp(:)
+  INTEGER :: nc
+  nc = SIZE(s0)
+  tmp = horzcat_s00(s0(nc), s1, s2, s3, s4, s5, s6, s7, s8, s9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = [s0(1:nc-1), tmp]
+END FUNCTION horzcat_s10
+!==============================================================================================================================
+FUNCTION horzcat_s11(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
+  IMPLICIT NONE
+  CHARACTER(LEN=*),                   INTENT(IN) :: s0(:)
+  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1(:), s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:)
   CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:)
-!------------------------------------------------------------------------------------------------------------------------------
   CHARACTER(LEN=maxlen), POINTER     :: s(:)
-  LOGICAL :: lv(10)
-  INTEGER :: nrow, ncol, iv, n
-  lv = [   .TRUE.   , PRESENT(s1), PRESENT(s2), PRESENT(s3), PRESENT(s4) , &
-         PRESENT(s5), PRESENT(s6), PRESENT(s7), PRESENT(s8), PRESENT(s9) ]
-  nrow = SIZE(s0); ncol=COUNT(lv)
+  INTEGER                            :: nrow, ncol, iv, n
+  LOGICAL                            :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  pre(:) = [PRESENT(s1),PRESENT(s2),PRESENT(s3),PRESENT(s4),PRESENT(s5),PRESENT(s6),PRESENT(s7),PRESENT(s8),PRESENT(s9)]
+  nrow = SIZE(s0)
+  ncol = 1+COUNT(pre)
   ALLOCATE(out(nrow, ncol))
-  DO iv=1, ncol
-    SELECT CASE(iv)
-      CASE(1); s=> s0; CASE(2); s=> s1; CASE(3); s=> s2; CASE(4); s=> s3; CASE(5); s=> s4
-      CASE(6); s=> s5; CASE(7); s=> s6; CASE(8); s=> s7; CASE(9); s=> s8; CASE(10);s=> s9
+  out(:,1) = s0
+  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); s=> s1; CASE(2); s=> s2; CASE(3); s=> s3; CASE(4); s=> s4; CASE(5); s=> s5
+      CASE(6); s=> s6; CASE(7); s=> s7; CASE(8); s=> s8; CASE(9); s=> s9
     END SELECT
     n = SIZE(s, DIM=1)
-    IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
+    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     out(:,iv) = s(:)
   END DO
-END FUNCTION horzcat_sm
-!==============================================================================================================================
-FUNCTION horzcat_i1(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
-  INTEGER,           TARGET, INTENT(IN) :: i0
+END FUNCTION horzcat_s11
+!==============================================================================================================================
+FUNCTION horzcat_s21(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
+  IMPLICIT NONE
+  CHARACTER(LEN=*),           INTENT(IN) :: s0(:,:), s1(:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:)
+  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), tmp(:,:)
+  INTEGER :: nc
+  nc  = SIZE(s0, 2)
+  tmp = horzcat_s11(s0(:,nc), s1, s2, s3, s4, s5, s6, s7, s8, s9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = RESHAPE([PACK(s0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(s0, 1), nc + SIZE(tmp, 2)-1])
+END FUNCTION horzcat_s21
+!==============================================================================================================================
+FUNCTION horzcat_i00(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
+  IMPLICIT NONE
+  INTEGER,                   INTENT(IN) :: i0
   INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
   INTEGER, ALLOCATABLE :: out(:)
-!------------------------------------------------------------------------------------------------------------------------------
   INTEGER, POINTER     :: i
-  LOGICAL :: lv(10)
-  INTEGER :: iv
-  lv = [   .TRUE.   , PRESENT(i1), PRESENT(i2), PRESENT(i3), PRESENT(i4) , &
-         PRESENT(i5), PRESENT(i6), PRESENT(i7), PRESENT(i8), PRESENT(i9) ]
-  ALLOCATE(out(COUNT(lv)))
-  DO iv=1, COUNT(lv)
-    SELECT CASE(iv)
-      CASE(1); i=> i0; CASE(2); i=> i1; CASE(3); i=> i2; CASE(4); i=> i3; CASE(5); i=> i4
-      CASE(6); i=> i5; CASE(7); i=> i6; CASE(8); i=> i7; CASE(9); i=> i8; CASE(10);i=> i9
+  INTEGER              :: ncol, iv
+  LOGICAL              :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  pre(:) = [PRESENT(i1),PRESENT(i2),PRESENT(i3),PRESENT(i4),PRESENT(i5),PRESENT(i6),PRESENT(i7),PRESENT(i8),PRESENT(i9)]
+  ncol = SIZE(pre)
+  ALLOCATE(out(ncol))
+  out(1) = i0
+  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); i=> i1; CASE(2); i=> i2; CASE(3); i=> i3; CASE(4); i=> i4; CASE(5); i=> i5
+      CASE(6); i=> i6; CASE(7); i=> i7; CASE(8); i=> i8; CASE(9); i=> i9
     END SELECT
     out(iv) = i
   END DO
-END FUNCTION horzcat_i1
-!==============================================================================================================================
-FUNCTION horzcat_im(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
-  INTEGER,           TARGET, DIMENSION(:), INTENT(IN) :: i0
-  INTEGER, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
+END FUNCTION horzcat_i00
+!==============================================================================================================================
+FUNCTION horzcat_i10(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
+  IMPLICIT NONE
+  INTEGER,           INTENT(IN) :: i0(:), i1
+  INTEGER, OPTIONAL, INTENT(IN) :: i2, i3, i4, i5, i6, i7, i8, i9
+  INTEGER, ALLOCATABLE :: out(:), tmp(:)
+  INTEGER :: nc
+  nc = SIZE(i0)
+  tmp = horzcat_i00(i0(nc), i1, i2, i3, i4, i5, i6, i7, i8, i9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = [i0(1:nc-1), tmp]
+END FUNCTION horzcat_i10
+!==============================================================================================================================
+FUNCTION horzcat_i11(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
+  IMPLICIT NONE
+  INTEGER,                   INTENT(IN) :: i0(:)
+  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1(:), i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:)
   INTEGER, ALLOCATABLE :: out(:,:)
-!------------------------------------------------------------------------------------------------------------------------------
   INTEGER, POINTER     :: i(:)
-  LOGICAL :: lv(10)
-  INTEGER :: nrow, ncol, iv, n
-  lv = [   .TRUE.   , PRESENT(i1), PRESENT(i2), PRESENT(i3), PRESENT(i4) , &
-         PRESENT(i5), PRESENT(i6), PRESENT(i7), PRESENT(i8), PRESENT(i9) ]
-  nrow = SIZE(i0); ncol=COUNT(lv)
+  INTEGER              :: nrow, ncol, iv, n
+  LOGICAL              :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  pre(:) = [PRESENT(i1),PRESENT(i2),PRESENT(i3),PRESENT(i4),PRESENT(i5),PRESENT(i6),PRESENT(i7),PRESENT(i8),PRESENT(i9)]
+  nrow = SIZE(i0)
+  ncol = 1+COUNT(pre)
   ALLOCATE(out(nrow, ncol))
-  DO iv=1, ncol
-    SELECT CASE(iv)
-      CASE(1); i=> i0; CASE(2); i=> i1; CASE(3); i=> i2; CASE(4); i=> i3; CASE(5); i=> i4
-      CASE(6); i=> i5; CASE(7); i=> i6; CASE(8); i=> i7; CASE(9); i=> i8; CASE(10);i=> i9
+  out(:,1) = i0
+  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); i=> i1; CASE(2); i=> i2; CASE(3); i=> i3; CASE(4); i=> i4; CASE(5); i=> i5
+      CASE(6); i=> i6; CASE(7); i=> i7; CASE(8); i=> i8; CASE(9); i=> i9
     END SELECT
     n = SIZE(i, DIM=1)
-    IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
+    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     out(:,iv) = i(:)
   END DO
-END FUNCTION horzcat_im
-!==============================================================================================================================
-FUNCTION horzcat_r1(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
-  REAL,           TARGET, INTENT(IN) :: r0
+END FUNCTION horzcat_i11
+!==============================================================================================================================
+FUNCTION horzcat_i21(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
+  IMPLICIT NONE
+  INTEGER,           INTENT(IN) :: i0(:,:), i1(:)
+  INTEGER, OPTIONAL, INTENT(IN) :: i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:)
+  INTEGER, ALLOCATABLE :: out(:,:), tmp(:,:)
+  INTEGER :: nc
+  nc  = SIZE(i0, 2)
+  tmp = horzcat_i11(i0(:,nc), i1, i2, i3, i4, i5, i6, i7, i8, i9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = RESHAPE([PACK(i0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(i0, 1), nc + SIZE(tmp, 2)-1])
+END FUNCTION horzcat_i21
+!==============================================================================================================================
+FUNCTION horzcat_r00(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
+  IMPLICIT NONE
+  REAL,                   INTENT(IN) :: r0
   REAL, OPTIONAL, TARGET, INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
   REAL, ALLOCATABLE :: out(:)
-!------------------------------------------------------------------------------------------------------------------------------
   REAL, POINTER     :: r
-  LOGICAL :: lv(10)
-  INTEGER :: iv
-  lv = [   .TRUE.   , PRESENT(r1), PRESENT(r2), PRESENT(r3), PRESENT(r4) , &
-         PRESENT(r5), PRESENT(r6), PRESENT(r7), PRESENT(r8), PRESENT(r9) ]
-  ALLOCATE(out(COUNT(lv)))
-  DO iv=1, COUNT(lv)
-    SELECT CASE(iv)
-      CASE(1); r=> r0; CASE(2); r=> r1; CASE(3); r=> r2; CASE(4); r=> r3; CASE(5); r=> r4
-      CASE(6); r=> r5; CASE(7); r=> r6; CASE(8); r=> r7; CASE(9); r=> r8; CASE(10);r=> r9
+  INTEGER           :: ncol, iv
+  LOGICAL           :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)]
+  ncol = 1+COUNT(pre)
+  ALLOCATE(out(ncol))
+  out(1) = r0
+  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); r=> r1; CASE(2); r=> r2; CASE(3); r=> r3; CASE(4); r=> r4; CASE(5); r=> r5
+      CASE(6); r=> r6; CASE(7); r=> r7; CASE(8); r=> r8; CASE(9); r=> r9
     END SELECT
     out(iv) = r
   END DO
-END FUNCTION horzcat_r1
-!==============================================================================================================================
-FUNCTION horzcat_rm(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
-  REAL,           TARGET, DIMENSION(:), INTENT(IN) :: r0
-  REAL, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
+END FUNCTION horzcat_r00
+!==============================================================================================================================
+FUNCTION horzcat_r10(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
+  IMPLICIT NONE
+  REAL,           INTENT(IN) :: r0(:), r1
+  REAL, OPTIONAL, INTENT(IN) :: r2, r3, r4, r5, r6, r7, r8, r9
+  REAL, ALLOCATABLE :: out(:), tmp(:)
+  INTEGER :: nc
+  nc  = SIZE(r0)
+  tmp = horzcat_r00(r0(nc), r1, r2, r3, r4, r5, r6, r7, r8, r9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = [r0(1:nc-1), tmp]
+END FUNCTION horzcat_r10
+!==============================================================================================================================
+FUNCTION horzcat_r11(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
+  IMPLICIT NONE
+  REAL,                   INTENT(IN) :: r0(:)
+  REAL, OPTIONAL, TARGET, INTENT(IN) :: r1(:), r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
   REAL, ALLOCATABLE :: out(:,:)
-!------------------------------------------------------------------------------------------------------------------------------
   REAL, POINTER     :: r(:)
-  LOGICAL :: lv(10)
-  INTEGER :: nrow, ncol, iv, n
-  lv = [   .TRUE.   , PRESENT(r1), PRESENT(r2), PRESENT(r3), PRESENT(r4) , &
-         PRESENT(r5), PRESENT(r6), PRESENT(r7), PRESENT(r8), PRESENT(r9) ]
-  nrow = SIZE(r0); ncol=COUNT(lv)
+  INTEGER           :: nrow, ncol, iv, n
+  LOGICAL           :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)]
+  nrow = SIZE(r0)
+  ncol = 1+COUNT(pre)
   ALLOCATE(out(nrow, ncol))
-  DO iv=1, ncol
-    SELECT CASE(iv)
-      CASE(1); r=> r0; CASE(2); r=> r1; CASE(3); r=> r2; CASE(4); r=> r3; CASE(5); r=> r4
-      CASE(6); r=> r5; CASE(7); r=> r6; CASE(8); r=> r7; CASE(9); r=> r8; CASE(10);r=> r9
+  out(:,1) = r0
+  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); r=> r1; CASE(2); r=> r2; CASE(3); r=> r3; CASE(4); r=> r4; CASE(5); r=> r5
+      CASE(6); r=> r5; CASE(7); r=> r7; CASE(8); r=> r8; CASE(9); r=> r9
     END SELECT
     n = SIZE(r, DIM=1)
-    IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
+    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     out(:,iv) = r(:)
   END DO
-END FUNCTION horzcat_rm
-!==============================================================================================================================
-FUNCTION horzcat_d1(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
-  DOUBLE PRECISION,           TARGET, INTENT(IN) :: d0
+END FUNCTION horzcat_r11
+!==============================================================================================================================
+FUNCTION horzcat_r21(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
+  IMPLICIT NONE
+  REAL,           INTENT(IN) :: r0(:,:), r1(:)
+  REAL, OPTIONAL, INTENT(IN) :: r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
+  REAL, ALLOCATABLE :: out(:,:), tmp(:,:)
+  INTEGER :: nc
+  nc  = SIZE(r0, 2)
+  tmp = horzcat_r11(r0(:,nc), r1, r2, r3, r4, r5, r6, r7, r8, r9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = RESHAPE([PACK(r0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(r0, 1), nc + SIZE(tmp, 2)-1])
+END FUNCTION horzcat_r21
+!==============================================================================================================================
+FUNCTION horzcat_d00(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
+  IMPLICIT NONE
+  DOUBLE PRECISION,                   INTENT(IN) :: d0
   DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
   DOUBLE PRECISION, ALLOCATABLE :: out(:)
-!------------------------------------------------------------------------------------------------------------------------------
   DOUBLE PRECISION, POINTER     :: d
-  LOGICAL :: lv(10)
-  INTEGER :: iv
-  lv = [   .TRUE.   , PRESENT(d1), PRESENT(d2), PRESENT(d3), PRESENT(d4) , &
-         PRESENT(d5), PRESENT(d6), PRESENT(d7), PRESENT(d8), PRESENT(d9) ]
-  ALLOCATE(out(COUNT(lv)))
-  DO iv=1, COUNT(lv)
-    SELECT CASE(iv)
-      CASE(1); d=> d0; CASE(2); d=> d1; CASE(3); d=> d2; CASE(4); d=> d3; CASE(5); d=> d4
-      CASE(6); d=> d5; CASE(7); d=> d6; CASE(8); d=> d7; CASE(9); d=> d8; CASE(10);d=> d9
+  INTEGER                       :: ncol, iv
+  LOGICAL                       :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  pre(:) = [PRESENT(d1),PRESENT(d2),PRESENT(d3),PRESENT(d4),PRESENT(d5),PRESENT(d6),PRESENT(d7),PRESENT(d8),PRESENT(d9)]
+  ncol = 1+COUNT(pre)
+  ALLOCATE(out(ncol))
+  out(1) = d0
+  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); d=> d1; CASE(2); d=> d2; CASE(3); d=> d3; CASE(4); d=> d4; CASE(5); d=> d5
+      CASE(6); d=> d6; CASE(7); d=> d7; CASE(8); d=> d8; CASE(9); d=> d9
     END SELECT
     out(iv) = d
   END DO
-END FUNCTION horzcat_d1
-!==============================================================================================================================
-FUNCTION horzcat_dm(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
-  DOUBLE PRECISION,           TARGET, DIMENSION(:), INTENT(IN) :: d0
-  DOUBLE PRECISION, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
+END FUNCTION horzcat_d00
+!==============================================================================================================================
+FUNCTION horzcat_d10(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
+  IMPLICIT NONE
+  DOUBLE PRECISION,           INTENT(IN) :: d0(:), d1
+  DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: d2, d3, d4, d5, d6, d7, d8, d9
+  DOUBLE PRECISION, ALLOCATABLE :: out(:), tmp(:)
+  INTEGER :: nc
+  nc = SIZE(d0)
+  tmp = horzcat_d00(d0(nc), d1, d2, d3, d4, d5, d6, d7, d8, d9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = [d0(1:nc-1), tmp]
+END FUNCTION horzcat_d10
+!==============================================================================================================================
+FUNCTION horzcat_d11(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
+  IMPLICIT NONE
+  DOUBLE PRECISION,                   INTENT(IN) :: d0(:)
+  DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1(:), d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
   DOUBLE PRECISION, ALLOCATABLE :: out(:,:)
-!------------------------------------------------------------------------------------------------------------------------------
   DOUBLE PRECISION, POINTER     :: d(:)
-  LOGICAL :: lv(10)
-  INTEGER :: nrow, ncol, iv, n
-  lv = [   .TRUE.   , PRESENT(d1), PRESENT(d2), PRESENT(d3), PRESENT(d4) , &
-         PRESENT(d5), PRESENT(d6), PRESENT(d7), PRESENT(d8), PRESENT(d9) ]
-  nrow = SIZE(d0); ncol=COUNT(lv)
+  INTEGER                       :: nrow, ncol, iv, n
+  LOGICAL                       :: pre(9)
+!------------------------------------------------------------------------------------------------------------------------------
+  nrow = SIZE(d0)
+  pre(:) = [PRESENT(d1),PRESENT(d2),PRESENT(d3),PRESENT(d4),PRESENT(d5),PRESENT(d6),PRESENT(d7),PRESENT(d8),PRESENT(d9)]
+  ncol = 1+COUNT(pre)
   ALLOCATE(out(nrow, ncol))
-  DO iv=1, ncol
-    SELECT CASE(iv)
-      CASE(1); d=> d0; CASE(2); d=> d1; CASE(3); d=> d2; CASE(4); d=> d3; CASE(5); d=> d4
-      CASE(6); d=> d5; CASE(7); d=> d6; CASE(8); d=> d7; CASE(9); d=> d8; CASE(10);d=> d9
+  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
+    SELECT CASE(iv-1)
+      CASE(1); d=> d1; CASE(2); d=> d2; CASE(3); d=> d3; CASE(4); d=> d4; CASE(5); d=> d5
+      CASE(6); d=> d6; CASE(7); d=> d7; CASE(8); d=> d8; CASE(9); d=> d9
     END SELECT
     n = SIZE(d, DIM=1)
-    IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
+    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     out(:,iv) = d(:)
   END DO
-END FUNCTION horzcat_dm
+END FUNCTION horzcat_d11
+!==============================================================================================================================
+FUNCTION horzcat_d21(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
+  IMPLICIT NONE
+  DOUBLE PRECISION,           INTENT(IN) :: d0(:,:), d1(:)
+  DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
+  DOUBLE PRECISION, ALLOCATABLE :: out(:,:), tmp(:,:)
+  INTEGER :: nc
+  nc  = SIZE(d0, 2)
+  tmp = horzcat_d11(d0(:,nc), d1, d2, d3, d4, d5, d6, d7, d8, d9)
+  IF(nc == 1) out = tmp
+  IF(nc /= 1) out = RESHAPE([PACK(d0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(d0, 1), nc + SIZE(tmp, 2)-1])
+END FUNCTION horzcat_d21
 !==============================================================================================================================
 
@@ -896,4 +1075,5 @@
 !==============================================================================================================================
 LOGICAL FUNCTION dispTable(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)
+  IMPLICIT NONE
   CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
   CHARACTER(LEN=*),           INTENT(IN)  :: titles(:)     !--- TITLES (ONE EACH COLUMN)
@@ -1004,4 +1184,5 @@
 !==============================================================================================================================
 LOGICAL FUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr)
+  IMPLICIT NONE
   INTEGER,                    INTENT(IN)  :: unt           !--- Output unit
   CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
@@ -1086,4 +1267,5 @@
 !==============================================================================================================================
 LOGICAL FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr)
+  IMPLICIT NONE
 ! Display outliers list in tables
 ! If "nam" is supplied, it means the last index is for tracers => one table each tracer for rank > 2.
@@ -1115,7 +1297,7 @@
 
   rk = SIZE(n); nv = SIZE(vnm)
-  IF(test(fmsg('SIZE(nam) /= 1 and /= last "n" element', sub, nv /= 1 .AND. nv /= n(rk), unt),lerr)) RETURN
-  IF(test(fmsg('ll" and "a" sizes mismatch',             sub, SIZE(a) /= SIZE(ll),       unt),lerr)) RETURN
-  IF(test(fmsg('profile "n" does not match "a" and "ll', sub, SIZE(a) /= PRODUCT(n),     unt),lerr)) RETURN
+  lerr = nv/=1 .AND. nv/=n(rk); CALL msg('SIZE(nam) /= 1 and /= last "n" element', sub, lerr); IF(lerr) RETURN
+  lerr = SIZE(a) /=   SIZE(ll); CALL msg('ll" and "a" sizes mismatch',             sub, lerr); IF(lerr) RETURN
+  lerr = SIZE(a) /= PRODUCT(n); CALL msg('profile "n" does not match "a" and "ll', sub, lerr); IF(lerr) RETURN
   CALL msg(mes, sub, unit=unt)
 
@@ -1164,4 +1346,5 @@
 !==============================================================================================================================
 LOGICAL FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr)
+  IMPLICIT NONE
 ! Display outliers list in tables
 ! If "nam" is supplied and, it means the last index is for tracers => one table each tracer for rank > 2.
@@ -1221,4 +1404,5 @@
 !==============================================================================================================================
 LOGICAL FUNCTION reduceExpr_1(str, val) RESULT(lerr)
+  IMPLICIT NONE
   CHARACTER(LEN=*),      INTENT(IN)  :: str
   CHARACTER(LEN=maxlen), INTENT(OUT) :: val
@@ -1254,5 +1438,5 @@
   DO WHILE(nl > 1)
     i = 1; DO WHILE(ip(i) /= 1 .OR. ip(i+1) /= 2); i = i + 1; END DO !IF(i > SIZE(ip)+1) EXIT;END DO
-    IF(test(reduceExpr_basic(vl(i+1), v), lerr)) RETURN
+    lerr = reduceExpr_basic(vl(i+1), v); IF(lerr) RETURN
     v = TRIM(vl(i))//TRIM(v); IF(i+2<=nl) v=TRIM(v)//TRIM(vl(i+2))
     vv = v//REPEAT(' ',768)
@@ -1270,4 +1454,5 @@
 !==============================================================================================================================
 LOGICAL FUNCTION reduceExpr_basic(str, val) RESULT(lerr)
+  IMPLICIT NONE
   CHARACTER(LEN=*),      INTENT(IN)  :: str
   CHARACTER(LEN=*),      INTENT(OUT) :: val
@@ -1284,8 +1469,10 @@
   op = ['^','/','*','+','-']                                                   !--- List of recognized operations
   s = str
-  IF(test(strParse_m(s, op, ky, lSc=.TRUE., id = id), lerr)) RETURN            !--- Parse the values
+  lerr = strParse_m(s, op, ky, lSc=.TRUE., id = id)                            !--- Parse the values
+  IF(lerr) RETURN                                                              !--- Problem with the parsing
   vl = str2dble(ky)                                                            !--- Conversion to doubles
   lerr = ANY(vl >= HUGE(1.d0))
-  IF(fmsg('Some values are non-numeric in: '//TRIM(s), ll=lerr)) RETURN        !--- Non-numerical values found
+  CALL msg('Some values are non-numeric in: '//TRIM(s), ll=lerr)
+  IF(lerr) RETURN                                                              !--- Non-numerical values found
   DO io = 1, SIZE(op)                                                          !--- Loop on known operators (order matters !)
     DO i = SIZE(id), 1, -1                                                     !--- Loop on found operators
@@ -1293,5 +1480,5 @@
       IF(id(i) /= io) CYCLE                                                    !--- Current found operator is not op(io)
       vm = vl(i); vp = vl(i+1)                                                 !--- Couple of values used for current operation
-      SELECT CASE(op(io))                                                          !--- Perform operation on the two values
+      SELECT CASE(op(io))                                                      !--- Perform operation on the two values
         CASE('^'); v = vm**vp
         CASE('/'); v = vm/vp
@@ -1311,4 +1498,5 @@
 !==============================================================================================================================
 FUNCTION reduceExpr_m(str, val) RESULT(lerr)
+  IMPLICIT NONE
   LOGICAL,               ALLOCATABLE              :: lerr(:)
   CHARACTER(LEN=*),                   INTENT(IN)  :: str(:)
@@ -1326,4 +1514,5 @@
 !==============================================================================================================================
 ELEMENTAL LOGICAL FUNCTION is_numeric(str) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN) :: str
   REAL    :: x
@@ -1341,13 +1530,21 @@
 !=== Convert a string into a logical/integer integer or an integer/real into a string =========================================
 !==============================================================================================================================
-ELEMENTAL LOGICAL FUNCTION str2bool(str) RESULT(out)
+ELEMENTAL INTEGER FUNCTION str2bool(str) RESULT(out)  !--- Result: 0/1 for .FALSE./.TRUE., -1 if not a valid boolean
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN) :: str
   INTEGER :: ierr
-  READ(str,*,IOSTAT=ierr) out
-  IF(ierr==0) RETURN
-  out = ANY(['t     ','true  ','.true.','y     ','yes   ']==strLower(str))
+  LOGICAL :: lout
+  READ(str,*,IOSTAT=ierr) lout
+  out = -HUGE(1)
+  IF(ierr /= 0) THEN
+    IF(ANY(['.false.', 'false  ', 'no     ', 'f      ', 'n      '] == strLower(str))) out = 0
+    IF(ANY(['.true. ', 'true   ', 'yes    ', 't      ', 'y      '] == strLower(str))) out = 1
+  ELSE
+    out = 0; IF(lout) out = 1
+  END IF
 END FUNCTION str2bool
 !==============================================================================================================================
 ELEMENTAL INTEGER FUNCTION str2int(str) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN) :: str
   INTEGER :: ierr
@@ -1357,4 +1554,5 @@
 !==============================================================================================================================
 ELEMENTAL REAL FUNCTION str2real(str) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN) :: str
   INTEGER :: ierr
@@ -1364,4 +1562,5 @@
 !==============================================================================================================================
 ELEMENTAL DOUBLE PRECISION FUNCTION str2dble(str) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN) :: str
   INTEGER :: ierr
@@ -1371,4 +1570,5 @@
 !==============================================================================================================================
 ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION bool2str(b) RESULT(out)
+  IMPLICIT NONE
   LOGICAL, INTENT(IN) :: b
   WRITE(out,*)b
@@ -1377,4 +1577,5 @@
 !==============================================================================================================================
 ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION int2str(i, nDigits) RESULT(out)
+  IMPLICIT NONE
   INTEGER,           INTENT(IN) :: i
   INTEGER, OPTIONAL, INTENT(IN) :: nDigits
@@ -1387,4 +1588,5 @@
 !==============================================================================================================================
 ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION real2str(r,fmt) RESULT(out)
+  IMPLICIT NONE
   REAL,                       INTENT(IN) :: r
   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
@@ -1396,4 +1598,5 @@
 !==============================================================================================================================
 ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION dble2str(d,fmt) RESULT(out)
+  IMPLICIT NONE
   DOUBLE PRECISION,           INTENT(IN) :: d
   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
@@ -1405,4 +1608,5 @@
 !==============================================================================================================================
 ELEMENTAL SUBROUTINE cleanZeros(s)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(INOUT) :: s
   INTEGER :: ls, ix, i
@@ -1422,4 +1626,5 @@
 !==============================================================================================================================
 FUNCTION addQuotes_1(s) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN)  :: s
   CHARACTER(LEN=:), ALLOCATABLE :: out
@@ -1428,4 +1633,5 @@
 !==============================================================================================================================
 FUNCTION addQuotes_m(s) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN)  :: s(:)
   CHARACTER(LEN=:), ALLOCATABLE :: out(:)
@@ -1440,4 +1646,5 @@
 !==============================================================================================================================
 ELEMENTAL LOGICAL FUNCTION needQuotes(s) RESULT(out)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN) :: s
   CHARACTER(LEN=1) :: b, e
@@ -1454,4 +1661,5 @@
 !==============================================================================================================================
 LOGICAL FUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(out)
+  IMPLICIT NONE
 ! Purpose: Messages in case a list contains wrong elements (indicated by lerr boolean vector).
 ! Note:    Return value "out" is .TRUE. if there are errors (ie at least one element of "lerr" is TRUE).
@@ -1476,4 +1684,5 @@
 !==============================================================================================================================
 SUBROUTINE removeComment(str)
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(INOUT) :: str
   INTEGER :: ix
Index: /LMDZ6/branches/cirrus/libf/obsolete/filtreg_p.F
===================================================================
--- /LMDZ6/branches/cirrus/libf/obsolete/filtreg_p.F	(revision 5202)
+++ /LMDZ6/branches/cirrus/libf/obsolete/filtreg_p.F	(revision 5202)
@@ -0,0 +1,432 @@
+
+
+      SUBROUTINE filtreg_p ( champ, ibeg, iend, nlat, nbniv, 
+     &     ifiltre, iaire, griscal ,iter)
+      USE parallel_lmdz, only : OMP_CHUNK
+      USE mod_filtre_fft
+      USE timer_filtre
+      
+      USE filtreg_mod
+      
+      IMPLICIT NONE
+      
+c=======================================================================
+c
+c   Auteur: P. Le Van        07/10/97
+c   ------
+c
+c   Objet: filtre matriciel longitudinal ,avec les matrices precalculees
+c                     pour l'operateur  Filtre    .
+c   ------
+c
+c   Arguments:
+c   ----------
+c
+c      
+c      ibeg..iend            lattitude a filtrer
+c      nlat                  nombre de latitudes du champ
+c      nbniv                 nombre de niveaux verticaux a filtrer
+c      champ(iip1,nblat,nbniv)  en entree : champ a filtrer
+c                            en sortie : champ filtre
+c      ifiltre               +1  Transformee directe
+c                            -1  Transformee inverse
+c                            +2  Filtre directe
+c                            -2  Filtre inverse
+c
+c      iaire                 1   si champ intensif
+c                            2   si champ extensif (pondere par les aires)
+c
+c      iter                  1   filtre simple
+c
+c=======================================================================
+c
+c
+c                      Variable Intensive
+c                ifiltre = 1     filtre directe
+c                ifiltre =-1     filtre inverse
+c
+c                      Variable Extensive
+c                ifiltre = 2     filtre directe
+c                ifiltre =-2     filtre inverse
+c
+c
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "coefils.h"
+c
+      INTEGER ibeg,iend,nlat,nbniv,ifiltre,iter
+      INTEGER i,j,l,k
+      INTEGER iim2,immjm
+      INTEGER jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
+      
+      REAL  champ( iip1,nlat,nbniv)
+      
+      LOGICAL    griscal
+      INTEGER    hemisph, iaire
+      
+      REAL :: champ_fft(iip1,nlat,nbniv)
+      REAL :: champ_in(iip1,nlat,nbniv)
+      
+      LOGICAL,SAVE     :: first=.TRUE.
+c$OMP THREADPRIVATE(first) 
+
+      REAL, DIMENSION(iip1,nlat,nbniv) :: champ_loc
+      INTEGER :: ll_nb, nbniv_loc
+      REAL, SAVE :: sdd12(iim,4)
+c$OMP THREADPRIVATE(sdd12) 
+
+      INTEGER, PARAMETER :: type_sddu=1
+      INTEGER, PARAMETER :: type_sddv=2
+      INTEGER, PARAMETER :: type_unsddu=3
+      INTEGER, PARAMETER :: type_unsddv=4
+
+      INTEGER :: sdd1_type, sdd2_type
+
+      IF (first) THEN
+         sdd12(1:iim,type_sddu) = sddu(1:iim)
+         sdd12(1:iim,type_sddv) = sddv(1:iim)
+         sdd12(1:iim,type_unsddu) = unsddu(1:iim)
+         sdd12(1:iim,type_unsddv) = unsddv(1:iim)
+
+         CALL Init_timer
+         first=.FALSE.
+      ENDIF
+
+c$OMP MASTER      
+      CALL start_timer
+c$OMP END MASTER
+
+c-------------------------------------------------------c
+
+      IF(ifiltre.EQ.1.or.ifiltre.EQ.-1)
+     & CALL abort_gcm("fitreg_p","Pas de transformee simple 
+     &dans cette version",1)
+      
+      IF( iter.EQ. 2 )  THEN
+         PRINT *,' Pas d iteration du filtre dans cette version !'
+     &        , ' Utiliser old_filtreg et repasser !'
+         CALL abort_gcm("fitreg_p","stopped",1)
+      ENDIF
+
+      IF( ifiltre.EQ. -2 .AND..NOT.griscal )     THEN
+         PRINT *,' Cette routine ne calcule le filtre inverse que '
+     &        , ' sur la grille des scalaires !'
+         CALL abort_gcm("fitreg_p","stopped",1)
+      ENDIF
+
+      IF( ifiltre.NE.2 .AND.ifiltre.NE. - 2 )  THEN
+         PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
+     &        , ' corriger et repasser !'
+         CALL abort_gcm("fitreg_p","stopped",1)
+       ENDIF
+c
+
+      iim2   = iim * iim
+      immjm  = iim * jjm
+c
+c
+      IF( griscal )   THEN
+         IF( nlat. NE. jjp1 )  THEN
+            CALL abort_gcm("fitreg_p","nlat. NE. jjp1",1)
+         ELSE
+c     
+            IF( iaire.EQ.1 )  THEN
+               sdd1_type = type_sddv
+               sdd2_type = type_unsddv
+            ELSE
+               sdd1_type = type_unsddv
+               sdd2_type = type_sddv
+            ENDIF
+c
+            jdfil1 = 2
+            jffil1 = jfiltnu
+            jdfil2 = jfiltsu
+            jffil2 = jjm
+         ENDIF
+      ELSE
+         IF( nlat.NE.jjm )  THEN
+            CALL abort_gcm("fitreg_p","nlat. NE. jjm",1)
+         ELSE
+c
+            IF( iaire.EQ.1 )  THEN
+               sdd1_type = type_sddu
+               sdd2_type = type_unsddu
+            ELSE
+               sdd1_type = type_unsddu
+               sdd2_type = type_sddu
+            ENDIF
+c     
+            jdfil1 = 1
+            jffil1 = jfiltnv
+            jdfil2 = jfiltsv
+            jffil2 = jjm
+         ENDIF
+      ENDIF
+c      
+      DO hemisph = 1, 2
+c     
+         IF ( hemisph.EQ.1 )  THEN
+cym
+            jdfil = max(jdfil1,ibeg)
+            jffil = min(jffil1,iend)
+         ELSE
+cym
+            jdfil = max(jdfil2,ibeg)
+            jffil = min(jffil2,iend)
+         ENDIF
+
+
+cccccccccccccccccccccccccccccccccccccccccccc
+c Utilisation du filtre classique
+cccccccccccccccccccccccccccccccccccccccccccc
+
+         IF (.NOT. use_filtre_fft) THEN
+      
+c     !---------------------------------!
+c     ! Agregation des niveau verticaux !
+c     ! uniquement necessaire pour une  !
+c     ! execution OpenMP                !
+c     !---------------------------------!
+            ll_nb = 0
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+            DO l = 1, nbniv
+               ll_nb = ll_nb+1
+               DO j = jdfil,jffil
+                  DO i = 1, iim
+                     champ_loc(i,j,ll_nb) = 
+     &                    champ(i,j,l) * sdd12(i,sdd1_type)
+                  ENDDO
+               ENDDO
+            ENDDO
+c$OMP END DO NOWAIT
+
+            nbniv_loc = ll_nb
+
+            IF( hemisph.EQ.1 )      THEN
+               
+               IF( ifiltre.EQ.-2 )   THEN
+                  DO j = jdfil,jffil
+#ifdef BLAS
+                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
+     &                    matrinvn(1,1,j), iim, 
+     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
+     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:iim,j-jdfil+1,:)
+     &                    =matmul(matrinvn(:,:,j),champ_loc(:iim,j,:))
+#endif
+                  ENDDO
+                  
+               ELSE IF ( griscal )     THEN
+                  DO j = jdfil,jffil
+#ifdef BLAS
+                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
+     &                    matriceun(1,1,j), iim, 
+     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
+     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:iim,j-jdfil+1,:)
+     &                    =matmul(matriceun(:,:,j),champ_loc(:iim,j,:))
+#endif
+                  ENDDO
+                  
+               ELSE 
+                  DO j = jdfil,jffil
+#ifdef BLAS
+                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
+     &                    matricevn(1,1,j), iim, 
+     &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
+     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:iim,j-jdfil+1,:)
+     &                    =matmul(matricevn(:,:,j),champ_loc(:iim,j,:))
+#endif
+                  ENDDO
+                  
+               ENDIF
+               
+            ELSE
+               
+               IF( ifiltre.EQ.-2 )   THEN
+                  DO j = jdfil,jffil
+#ifdef BLAS
+                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
+     &                    matrinvs(1,1,j-jfiltsu+1), iim, 
+     &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
+     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:iim,j-jdfil+1,:)
+     &                    =matmul(matrinvs(:,:,j-jfiltsu+1),
+     &                            champ_loc(:iim,j,:))
+#endif
+                  ENDDO
+                  
+               ELSE IF ( griscal )     THEN
+                  
+                  DO j = jdfil,jffil
+#ifdef BLAS
+                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
+     &                    matriceus(1,1,j-jfiltsu+1), iim, 
+     &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
+     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:iim,j-jdfil+1,:)
+     &                    =matmul(matriceus(:,:,j-jfiltsu+1),
+     &                            champ_loc(:iim,j,:))
+#endif
+                  ENDDO
+                  
+               ELSE 
+                  
+                  DO j = jdfil,jffil
+#ifdef BLAS
+                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
+     &                    matricevs(1,1,j-jfiltsv+1), iim, 
+     &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
+     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:iim,j-jdfil+1,:)
+     &                    =matmul(matricevs(:,:,j-jfiltsv+1),
+     &                            champ_loc(:iim,j,:))
+#endif
+                  ENDDO
+                  
+               ENDIF
+               
+            ENDIF
+!     c     
+            IF( ifiltre.EQ.2 )  THEN
+               
+c     !-------------------------------------!
+c     ! Dés-agregation des niveau verticaux !
+c     ! uniquement necessaire pour une      !
+c     ! execution OpenMP                    !
+c     !-------------------------------------!
+               ll_nb = 0
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+               DO l = 1, nbniv
+                  ll_nb = ll_nb + 1
+                  DO j = jdfil,jffil
+                     DO i = 1, iim
+                        champ( i,j,l ) = (champ_loc(i,j,ll_nb) 
+     &                       + champ_fft(i,j-jdfil+1,ll_nb))
+     &                       * sdd12(i,sdd2_type)
+                     ENDDO
+                  ENDDO
+               ENDDO
+c$OMP END DO NOWAIT
+               
+            ELSE
+               
+               ll_nb = 0
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+               DO l = 1, nbniv_loc
+                  ll_nb = ll_nb + 1
+                  DO j = jdfil,jffil
+                     DO i = 1, iim
+                        champ( i,j,l ) = (champ_loc(i,j,ll_nb) 
+     &                       - champ_fft(i,j-jdfil+1,ll_nb))
+     &                       * sdd12(i,sdd2_type)
+                     ENDDO
+                  ENDDO
+               ENDDO
+c$OMP END DO NOWAIT
+               
+            ENDIF
+            
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+            DO l = 1, nbniv
+               DO j = jdfil,jffil
+                  champ( iip1,j,l ) = champ( 1,j,l )
+               ENDDO
+            ENDDO
+c$OMP END DO NOWAIT
+            
+ccccccccccccccccccccccccccccccccccccccccccccc
+c Utilisation du filtre FFT
+ccccccccccccccccccccccccccccccccccccccccccccc
+        
+         ELSE
+       
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+            DO l=1,nbniv
+               DO j=jdfil,jffil
+                  DO  i = 1, iim
+                     champ( i,j,l)= champ(i,j,l)*sdd12(i,sdd1_type)
+                     champ_fft( i,j,l) = champ(i,j,l)
+                  ENDDO
+               ENDDO
+            ENDDO
+c$OMP END DO NOWAIT
+
+            IF (jdfil<=jffil) THEN
+               IF( ifiltre. EQ. -2 )   THEN
+                  CALL Filtre_inv_fft(champ_fft,nlat,jdfil,jffil,nbniv) 
+               ELSE IF ( griscal )     THEN
+                  CALL Filtre_u_fft(champ_fft,nlat,jdfil,jffil,nbniv)
+               ELSE
+                  CALL Filtre_v_fft(champ_fft,nlat,jdfil,jffil,nbniv)
+               ENDIF
+            ENDIF
+
+
+            IF( ifiltre.EQ. 2 )  THEN
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)          
+               DO l=1,nbniv
+                  DO j=jdfil,jffil
+                     DO  i = 1, iim
+                        champ( i,j,l)=(champ(i,j,l)+champ_fft(i,j,l))
+     &                       *sdd12(i,sdd2_type)
+                     ENDDO
+                  ENDDO
+               ENDDO
+c$OMP END DO NOWAIT	  
+            ELSE
+        
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)  
+               DO l=1,nbniv
+                  DO j=jdfil,jffil
+                     DO  i = 1, iim
+                        champ(i,j,l)=(champ(i,j,l)-champ_fft(i,j,l))
+     &                       *sdd12(i,sdd2_type)
+                     ENDDO
+                  ENDDO
+               ENDDO
+c$OMP END DO NOWAIT          
+            ENDIF
+c
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
+            DO l=1,nbniv
+               DO j=jdfil,jffil
+!            champ_FFT( iip1,j,l ) = champ_FFT( 1,j,l )
+                  champ( iip1,j,l ) = champ( 1,j,l )
+               ENDDO
+            ENDDO
+c$OMP END DO NOWAIT          	
+         ENDIF 
+c Fin de la zone de filtrage
+
+	
+      ENDDO
+
+!      DO j=1,nlat
+!     
+!          PRINT *,"check FFT ----> Delta(",j,")=",
+!     &            sum(champ(:,j,:)-champ_fft(:,j,:))/sum(champ(:,j,:)),
+!     &            sum(champ(:,j,:)-champ_in(:,j,:))/sum(champ(:,j,:)) 
+!      ENDDO
+      
+!          PRINT *,"check FFT ----> Delta(",j,")=",
+!     &            sum(champ-champ_fft)/sum(champ)
+!      
+      
+c
+ 1111 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a 
+     &     filtrer, sur la grille des scalaires'/)
+ 2222 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a fi
+     &     ltrer, sur la grille de V ou de Z'/)
+c$OMP MASTER      
+      CALL stop_timer
+c$OMP END MASTER
+      RETURN
+      END
Index: /LMDZ6/branches/cirrus/libf/phylmd/Dust/phys_output_write_spl_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/Dust/phys_output_write_spl_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/Dust/phys_output_write_spl_mod.F90	(revision 5202)
@@ -325,5 +325,5 @@
          sissnow, runoff, albsol3_lic, evap_pot, &
          t2m, fluxt, fluxlat, fsollw, fsolsw, &
-         wfbils, wfbilo, cdragm, cdragh, cldl, cldm, &
+         wfbils, cdragm, cdragh, cldl, cldm, &
          cldh, cldt, JrNt, &
          ! cldljn, cldmjn, cldhjn, cldtjn &
@@ -353,6 +353,6 @@
          toplwad_aero, toplwad0_aero, sollwad_aero, &
          sollwad0_aero, toplwai_aero, sollwai_aero, &
-         scdnc, cldncl, reffclws, reffclwc, cldnvi, &
-         lcc, lcc3d, lcc3dcon, lcc3dstra, reffclwtop, &
+         !scdnc, cldncl, reffclws, reffclwc, cldnvi, &
+         !lcc, lcc3d, lcc3dcon, lcc3dstra, reffclwtop, &
          ec550aer, flwc, fiwc, t_seri, theta, q_seri, &
 !jyg<
@@ -377,5 +377,7 @@
     USE phys_output_var_mod, ONLY: vars_defined, snow_o, zfra_o, bils_diss, &
          bils_ec,bils_ech, bils_tke, bils_kinetic, bils_latent, bils_enthalp, &
-         itau_con, nfiles, clef_files, nid_files, zvstr_gwd_rando
+         itau_con, nfiles, clef_files, nid_files, zvstr_gwd_rando, &
+         scdnc, cldncl, reffclws, reffclwc, cldnvi, &
+         lcc, lcc3d, lcc3dcon, lcc3dstra, reffclwtop
     USE ocean_slab_mod, ONLY: tslab, slab_bilg, tice, seaice
     USE pbl_surface_mod, ONLY: snow
@@ -721,6 +723,4 @@
           IF (vars_defined)         zx_tmp_fi2d(1 : klon) = wfbils( 1 : klon, nsrf)
           CALL histwrite_phy(o_wbils_srf(nsrf), zx_tmp_fi2d)
-          IF (vars_defined)         zx_tmp_fi2d(1 : klon) = wfbilo( 1 : klon, nsrf)
-          CALL histwrite_phy(o_wbilo_srf(nsrf), zx_tmp_fi2d)
 
           IF (iflag_pbl > 1) THEN
Index: /LMDZ6/branches/cirrus/libf/phylmd/StratAer/aer_sedimnt.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/StratAer/aer_sedimnt.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/StratAer/aer_sedimnt.F90	(revision 5202)
@@ -17,5 +17,6 @@
 !-----------------------------------------------------------------------
 
-  USE phys_local_var_mod, ONLY: mdw, budg_sed_part, DENSO4, f_r_wet, vsed_aer
+  USE phys_local_var_mod, ONLY: mdw, budg_sed_part, DENSO4, DENSO4B, f_r_wet, f_r_wetB, vsed_aer
+  USE strataer_local_var_mod, ONLY: flag_new_strat_compo
   USE dimphy, ONLY : klon,klev
   USE infotrac_phy
@@ -89,7 +90,13 @@
 
       ! stokes-velocity with cunnigham slip- flow correction
-      ZVAER(JL,JK,nb) = 2./9.*(DENSO4(JL,JK)*1000.-ZRHO)*RG/zvis(JL,JK)*(f_r_wet(JL,JK)*mdw(nb)/2.)**2.* &
-         (1.+ 2.*zlair(JL,JK)/(f_r_wet(JL,JK)*mdw(nb))*(1.257+0.4*EXP(-0.55*f_r_wet(JL,JK)*mdw(nb)/zlair(JL,JK))))
-
+      IF(flag_new_strat_compo) THEN
+         ! stokes-velocity with cunnigham slip- flow correction
+         ZVAER(JL,JK,nb) = 2./9.*(DENSO4B(JL,JK,nb)*1000.-ZRHO)*RG/zvis(JL,JK)*(f_r_wetB(JL,JK,nb)*mdw(nb)/2.)**2.* &
+              (1.+ 2.*zlair(JL,JK)/(f_r_wetB(JL,JK,nb)*mdw(nb))*(1.257+0.4*EXP(-0.55*f_r_wetB(JL,JK,nb)*mdw(nb)/zlair(JL,JK))))
+      ELSE
+         ZVAER(JL,JK,nb) = 2./9.*(DENSO4(JL,JK)*1000.-ZRHO)*RG/zvis(JL,JK)*(f_r_wet(JL,JK)*mdw(nb)/2.)**2.* &
+              (1.+ 2.*zlair(JL,JK)/(f_r_wet(JL,JK)*mdw(nb))*(1.257+0.4*EXP(-0.55*f_r_wet(JL,JK)*mdw(nb)/zlair(JL,JK))))
+      ENDIF
+      
       ZSEDFLX(JL,nb)=ZVAER(JL,JK,nb)*ZRHO
       ZSOLAERB(nb)=ZSOLAERB(nb)+ZDTGDP*ZSEDFLX(JL,nb)
Index: /LMDZ6/branches/cirrus/libf/phylmd/StratAer/aerophys.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/StratAer/aerophys.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/StratAer/aerophys.F90	(revision 5202)
@@ -5,23 +5,28 @@
   IMPLICIT NONE
 !
-  REAL,PARAMETER                         :: ropx=1500.0              ! default aerosol particle mass density [kg/m3]
-  REAL,PARAMETER                         :: dens_aer_dry=1848.682308 ! dry aerosol particle mass density at T_0=293K[kg/m3]
-  REAL,PARAMETER                         :: dens_aer_ref=1483.905336 ! aerosol particle mass density with 75% H2SO4 at T_0=293K[kg/m3]
-  REAL,PARAMETER                         :: mdwmin=0.002e-6          ! dry diameter of smallest aerosol particles [m]
-  REAL,PARAMETER                         :: V_rat=2.0                ! volume ratio of neighboring size bins
-  REAL,PARAMETER                         :: mfrac_H2SO4=0.75         ! default mass fraction of H2SO4 in the aerosol
-  REAL, PARAMETER                        :: mAIRmol=28.949*1.66E-27  ! Average mass of an air molecule [kg]
-  REAL, PARAMETER                        :: mH2Omol=18.016*1.66E-27  ! Mass of an H2O molecule [kg]
-  REAL, PARAMETER                        :: mH2SO4mol=98.082*1.66E-27! Mass of an H2SO4 molecule [kg]
-  REAL, PARAMETER                        :: mSO2mol=64.06*1.66E-27   ! Mass of an SO2 molecule [kg]
-  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] 
+  REAL,PARAMETER    :: ropx=1500.0              ! default aerosol particle mass density [kg/m3]
+  REAL,PARAMETER    :: dens_aer_dry=1848.682308 ! dry aerosol particle mass density at T_0=293K[kg/m3]
+  REAL,PARAMETER    :: dens_aer_ref=1483.905336 ! aerosol particle mass density with 75% H2SO4 at T_0=293K[kg/m3]
+  REAL,PARAMETER    :: mdwmin=0.002e-6          ! dry diameter of smallest aerosol particles [m]
+  REAL,PARAMETER    :: V_rat=2.0                ! volume ratio of neighboring size bins
+  REAL,PARAMETER    :: mfrac_H2SO4=0.75         ! default mass fraction of H2SO4 in the aerosol
+  REAL, PARAMETER   :: mAIRmol=28.949*1.66E-27  ! Average mass of an air molecule [kg]
+  REAL, PARAMETER   :: mH2Omol=18.016*1.66E-27  ! Mass of an H2O molecule [kg]
+  REAL, PARAMETER   :: mH2SO4mol=98.082*1.66E-27! Mass of an H2SO4 molecule [kg]
+  REAL, PARAMETER   :: mSO2mol=64.06*1.66E-27   ! Mass of an SO2 molecule [kg]
+  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]
+  REAL, PARAMETER   :: rgas=8.3145 ! molar gas cste (J⋅K−1⋅mol−1=m3⋅Pa⋅K−1⋅mol−1=kg⋅m2⋅s−2⋅K−1⋅mol−1)
+  ! 
+  REAL, PARAMETER   :: MH2O  =1000.*mH2Omol     ! Mass of 1 molec [g] (18.016*1.66E-24)
+  REAL, PARAMETER   :: MH2SO4=1000.*mH2SO4mol   ! Mass of 1 molec [g] (98.082*1.66E-24)
+  REAL, PARAMETER   :: BOLZ  =1.381E-16         ! Boltzmann constant [dyn.cm/K]
 !
 END MODULE aerophys
Index: /LMDZ6/branches/cirrus/libf/phylmd/StratAer/coagulate.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/StratAer/coagulate.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/StratAer/coagulate.F90	(revision 5202)
@@ -26,6 +26,7 @@
   USE aerophys
   USE infotrac_phy
-  USE phys_local_var_mod, ONLY: DENSO4, f_r_wet
-
+  USE phys_local_var_mod, ONLY: DENSO4, DENSO4B, f_r_wet, f_r_wetB
+  USE strataer_local_var_mod, ONLY: flag_new_strat_compo
+  
   IMPLICIT NONE
 
@@ -43,9 +44,11 @@
   ! local variables in coagulation routine
   INTEGER                                       :: i,j,k,nb,ilon,ilev
-  REAL, DIMENSION(nbtr_bin)                     :: radius ! aerosol particle radius in each bin [m]
+  REAL, DIMENSION(nbtr_bin)                     :: radiusdry ! dry aerosol particle radius in each bin [m]
+  REAL, DIMENSION(nbtr_bin)                     :: radiuswet ! wet aerosol particle radius in each bin [m]
   REAL, DIMENSION(klon,klev,nbtr_bin)           :: tr_t ! Concentration Traceur at time t [U/KgA]
   REAL, DIMENSION(klon,klev,nbtr_bin)           :: tr_tp1 ! Concentration Traceur at time t+1 [U/KgA]
   REAL, DIMENSION(nbtr_bin,nbtr_bin,nbtr_bin)   :: ff   ! Volume fraction of intermediate particles
-  REAL, DIMENSION(nbtr_bin)                     :: V    ! Volume of bins
+  REAL, DIMENSION(nbtr_bin)                     :: Vdry ! Volume dry of bins
+  REAL, DIMENSION(nbtr_bin)                     :: Vwet ! Volume wet of bins
   REAL, DIMENSION(nbtr_bin,nbtr_bin)            :: Vij  ! Volume sum of i and j
   REAL                                          :: eta  ! Dynamic viscosity of air
@@ -82,15 +85,20 @@
   include "YOMCST.h"
 
-  DO i=1, nbtr_bin
-   radius(i)=mdw(i)/2.
-   V(i)= radius(i)**3.  !neglecting factor 4*RPI/3
-  ENDDO
-
-  DO j=1, nbtr_bin
-  DO i=1, nbtr_bin
-   Vij(i,j)= V(i)+V(j)
-  ENDDO
-  ENDDO
-
+! ff(i,j,k): Volume fraction of Vi,j that is partitioned to each model bin k
+! just need to be calculated in model initialization because mdw(:) size is fixed
+! no need to recalculate radius, Vdry, Vij, and ff every timestep because it is for  
+! dry aerosols
+  DO i=1, nbtr_bin
+     radiusdry(i)=mdw(i)/2.
+     Vdry(i)=radiusdry(i)**3.  !neglecting factor 4*RPI/3
+     Vwet(i)=0.0
+  ENDDO
+
+  DO j=1, nbtr_bin
+     DO i=1, nbtr_bin
+        Vij(i,j)= Vdry(i)+Vdry(j)
+     ENDDO
+  ENDDO
+  
 !--pre-compute the f(i,j,k) from Jacobson equation 13
   ff=0.0 
@@ -100,19 +108,20 @@
     IF (k.EQ.1) THEN
       ff(i,j,k)= 0.0
-    ELSEIF (k.GT.1.AND.V(k-1).LT.Vij(i,j).AND.Vij(i,j).LT.V(k)) THEN
+    ELSEIF (k.GT.1.AND.Vdry(k-1).LT.Vij(i,j).AND.Vij(i,j).LT.Vdry(k)) THEN
       ff(i,j,k)= 1.-ff(i,j,k-1)
     ELSEIF (k.EQ.nbtr_bin) THEN
-      IF (Vij(i,j).GE.v(k)) THEN
+      IF (Vij(i,j).GE.Vdry(k)) THEN
         ff(i,j,k)= 1.
       ELSE
         ff(i,j,k)= 0.0
       ENDIF
-    ELSEIF (k.LE.(nbtr_bin-1).AND.V(k).LE.Vij(i,j).AND.Vij(i,j).LT.V(k+1)) THEN
-      ff(i,j,k)= V(k)/Vij(i,j)*(V(k+1)-Vij(i,j))/(V(k+1)-V(k))
+    ELSEIF (k.LE.(nbtr_bin-1).AND.Vdry(k).LE.Vij(i,j).AND.Vij(i,j).LT.Vdry(k+1)) THEN
+      ff(i,j,k)= Vdry(k)/Vij(i,j)*(Vdry(k+1)-Vij(i,j))/(Vdry(k+1)-Vdry(k))
     ENDIF
   ENDDO
   ENDDO
   ENDDO
-
+! End of just need to be calculated at initialization because mdw(:) size is fixed
+  
   DO ilon=1, klon
   DO ilev=1, klev 
@@ -120,9 +129,18 @@
   IF (is_strato(ilon,ilev)) THEN
   !compute actual wet particle radius & volume for every grid box
-  DO i=1, nbtr_bin
-   radius(i)=f_r_wet(ilon,ilev)*mdw(i)/2.
-   V(i)= radius(i)**3.  !neglecting factor 4*RPI/3
-  ENDDO
-
+  IF(flag_new_strat_compo) THEN
+     DO i=1, nbtr_bin
+        radiuswet(i)=f_r_wetB(ilon,ilev,i)*mdw(i)/2.
+        Vwet(i)= radiuswet(i)**3.  !neglecting factor 4*RPI/3
+!!      Vwet(i)= Vdry(i)*(f_r_wetB(ilon,ilev,i)**3)
+     ENDDO
+  ELSE
+     DO i=1, nbtr_bin
+        radiuswet(i)=f_r_wet(ilon,ilev)*mdw(i)/2.
+        Vwet(i)= radiuswet(i)**3.  !neglecting factor 4*RPI/3
+!!      Vwet(i)= Vdry(i)*(f_r_wet(ilon,ilev)**3)
+     ENDDO
+  ENDIF
+  
 !--Calculations for the coagulation kernel---------------------------------------------------------
 
@@ -150,14 +168,21 @@
   Di=0.0
   DO i=1, nbtr_bin
-   Kn(i)=mnfrpth/radius(i)
-   Di(i)=RKBOL*t_seri(ilon,ilev)/(6.*RPI*radius(i)*eta)*(1.+Kn(i)*(1.249+0.42*exp(-0.87/Kn(i))))
+      Kn(i)=mnfrpth/radiuswet(i)
+      Di(i)=RKBOL*t_seri(ilon,ilev)/(6.*RPI*radiuswet(i)*eta)*(1.+Kn(i)*(1.249+0.42*exp(-0.87/Kn(i))))
   ENDDO
 
 !--pre-compute the thermal velocity of a particle thvelpar(i) from equation 20
   thvelpar=0.0
-  DO i=1, nbtr_bin
-   m_par(i)=4./3.*RPI*radius(i)**3.*DENSO4(ilon,ilev)*1000.
-   thvelpar(i)=sqrt(8.*RKBOL*t_seri(ilon,ilev)/(RPI*m_par(i)))
-  ENDDO
+  IF(flag_new_strat_compo) THEN
+     DO i=1, nbtr_bin
+        m_par(i)=4./3.*RPI*radiuswet(i)**3.*DENSO4B(ilon,ilev,i)*1000.
+        thvelpar(i)=sqrt(8.*RKBOL*t_seri(ilon,ilev)/(RPI*m_par(i)))
+     ENDDO
+  ELSE
+     DO i=1, nbtr_bin
+        m_par(i)=4./3.*RPI*radiuswet(i)**3.*DENSO4(ilon,ilev)*1000.
+        thvelpar(i)=sqrt(8.*RKBOL*t_seri(ilon,ilev)/(RPI*m_par(i)))
+     ENDDO
+  ENDIF
 
 !--pre-compute the particle mean free path mfppar(i) from equation 22
@@ -171,8 +196,9 @@
   delta=0.0
   DO i=1, nbtr_bin
-   delta(i)=((2.*radius(i)+mfppar(i))**3.-(4.*radius(i)**2.+mfppar(i)**2.)**1.5)/ &
-           & (6.*radius(i)*mfppar(i))-2.*radius(i)
-  ENDDO
-
+      delta(i)=((2.*radiuswet(i)+mfppar(i))**3.-(4.*radiuswet(i)**2.+mfppar(i)**2.)**1.5)/ &
+           & (6.*radiuswet(i)*mfppar(i))-2.*radiuswet(i)
+  ENDDO
+
+!   beta(i,j): coagulation kernel (rate coefficient) of 2 colliding particles i,j 
 !--pre-compute the beta(i,j) from equation 17 in Jacobson
   num=0.0
@@ -180,20 +206,20 @@
   DO i=1, nbtr_bin
 !
-   num=4.*RPI*(radius(i)+radius(j))*(Di(i)+Di(j))
-   denom=(radius(i)+radius(j))/(radius(i)+radius(j)+sqrt(delta(i)**2.+delta(j)**2.))+ &
-        & 4.*(Di(i)+Di(j))/(sqrt(thvelpar(i)**2.+thvelpar(j)**2.)*(radius(i)+radius(j)))
-   beta(i,j)=num/denom
+     num=4.*RPI*(radiuswet(i)+radiuswet(j))*(Di(i)+Di(j))
+     denom=(radiuswet(i)+radiuswet(j))/(radiuswet(i)+radiuswet(j)+sqrt(delta(i)**2.+delta(j)**2.))+ &
+          & 4.*(Di(i)+Di(j))/(sqrt(thvelpar(i)**2.+thvelpar(j)**2.)*(radiuswet(i)+radiuswet(j)))
+     beta(i,j)=num/denom
 !
 !--compute enhancement factor due to van der Waals forces
    IF (ok_vdw .EQ. 0) THEN      !--no enhancement factor
-     Evdw=1.0
+      Evdw=1.0
    ELSEIF (ok_vdw .EQ. 1) THEN  !--E(0) case
-     AvdWi = AvdW/(RKBOL*t_seri(ilon,ilev))*(4.*radius(i)*radius(j))/(radius(i)+radius(j))**2.
-     xvdW = LOG(1.+AvdWi)
-     EvdW = 1. + avdW1*xvdW + avdW3*xvdW**3
+      AvdWi = AvdW/(RKBOL*t_seri(ilon,ilev))*(4.*radiuswet(i)*radiuswet(j))/(radiuswet(i)+radiuswet(j))**2.
+      xvdW = LOG(1.+AvdWi)
+      EvdW = 1. + avdW1*xvdW + avdW3*xvdW**3
    ELSEIF (ok_vdw .EQ. 2) THEN  !--E(infinity) case
-     AvdWi = AvdW/(RKBOL*t_seri(ilon,ilev))*(4.*radius(i)*radius(j))/(radius(i)+radius(j))**2.
-     xvdW = LOG(1.+AvdWi)
-     EvdW = 1. + SQRT(AvdWi/3.)/(1.+bvdW0*SQRT(AvdWi)) + bvdW1*xvdW + bvdW3*xvdW**3.
+      AvdWi = AvdW/(RKBOL*t_seri(ilon,ilev))*(4.*radiuswet(i)*radiuswet(j))/(radiuswet(i)+radiuswet(j))**2.
+      xvdW = LOG(1.+AvdWi)
+      EvdW = 1. + SQRT(AvdWi/3.)/(1.+bvdW0*SQRT(AvdWi)) + bvdW1*xvdW + bvdW3*xvdW**3.
    ENDIF
 !
@@ -209,5 +235,6 @@
   denom=0.0
   DO j=1, nbtr_bin
-  denom=denom+(1.-ff(k,j,k))*beta(k,j)*tr_t(ilon,ilev,j)
+     !    fraction of coagulation of k and j that is not giving k
+     denom=denom+(1.-ff(k,j,k))*beta(k,j)*tr_t(ilon,ilev,j)
   ENDDO
 
@@ -219,13 +246,34 @@
     num=0.0
     DO j=1, k
-    numi=0.0
-    DO i=1, k-1
-    numi=numi+ff(i,j,k)*beta(i,j)*V(i)*tr_tp1(ilon,ilev,i)*tr_t(ilon,ilev,j)
+       numi=0.0
+       DO i=1, k-1
+!           
+!           see Jacobson: " In order to conserve volume and volume concentration (which
+!           coagulation physically does) while giving up some accuracy in number concentration" 
+!
+!           Coagulation of i and j giving k
+!           with V(i) and then V(j) because it considers i,j and j,i with the double loop
+!
+!           BUT WHY WET VOLUME V(i) in old STRATAER? tracers are already dry aerosols and coagulation 
+!           kernel beta(i,j) accounts for wet aerosols -> reply below
+!
+!             numi=numi+ff(i,j,k)*beta(i,j)*V(i)*tr_tp1(ilon,ilev,i)*tr_t(ilon,ilev,j)
+            numi=numi+ff(i,j,k)*beta(i,j)*Vdry(i)*tr_tp1(ilon,ilev,i)*tr_t(ilon,ilev,j)
+       ENDDO
+       num=num+numi
     ENDDO
-    num=num+numi
-    ENDDO
 
 !--calculate new concentration of other bins
-    tr_tp1(ilon,ilev,k)=(V(k)*tr_t(ilon,ilev,k)+pdtcoag*num)/(1.+pdtcoag*denom)/V(k)
+!      tr_tp1(ilon,ilev,k)=(V(k)*tr_t(ilon,ilev,k)+pdtcoag*num)/( (1.+pdtcoag*denom)*V(k) )
+    tr_tp1(ilon,ilev,k)=(Vdry(k)*tr_t(ilon,ilev,k)+pdtcoag*num)/( (1.+pdtcoag*denom)*Vdry(k) )
+!
+!       In constant composition (no dependency on aerosol size because no kelvin effect)
+!       V(l)= (f_r_wet(ilon,ilev)**3)*((mdw(l)/2.)**3) = (f_r_wet(ilon,ilev)**3)*Vdry(i)
+!       so numi and num are proportional (f_r_wet(ilon,ilev)**3)
+!       and so 
+!        tr_tp1(ilon,ilev,k)=(V(k)*tr_t(ilon,ilev,k)+pdtcoag*num)/( (1.+pdtcoag*denom)*V(k) )
+!                     =(Vdry(k)*tr_t(ilon,ilev,k)+pdtcoag*num_dry)/( (1.+pdtcoag*denom)*Vdry(k) ) 
+!          with num_dry=...beta(i,j)*Vdry(i)*....
+!       so in old STRATAER (.not.flag_new_strat_compo), it was correct
   ENDIF
 
@@ -234,5 +282,5 @@
 !--convert tracer concentration back from [number/m3] to [number/KgA] and write into tr_seri
   DO i=1, nbtr_bin
-   tr_seri(ilon,ilev,i+nbtr_sulgas) = tr_tp1(ilon,ilev,i) / zrho
+     tr_seri(ilon,ilev,i+nbtr_sulgas) = tr_tp1(ilon,ilev,i) / zrho
   ENDDO
 
@@ -240,4 +288,5 @@
   ENDDO !--end of loop klev
   ENDDO !--end of loop klon
+! *********************************************
 
 END SUBROUTINE COAGULATE
Index: /LMDZ6/branches/cirrus/libf/phylmd/StratAer/cond_evap_tstep_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/StratAer/cond_evap_tstep_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/StratAer/cond_evap_tstep_mod.F90	(revision 5202)
@@ -9,6 +9,162 @@
 CONTAINS
 
+      SUBROUTINE condens_evapor_rate_kelvin(R2SO4G,t_seri,pplay,R2SO4, &
+          & DENSO4,f_r_wet,R2SO4ik,DENSO4ik,f_r_wetik,FL,ASO4,DNDR)
+!
+!     INPUT: 
+!     R2SO4G: number density of gaseous H2SO4 [molecules/cm3]
+!     t_seri: temperature (K)
+!     pplay: pressure (Pa)
+!     R2SO4: aerosol H2SO4 weight fraction (percent) - flat surface (does not depend on aerosol size)
+!     DENSO4: aerosol density (gr/cm3) 
+!     f_r_wet: factor for converting dry to wet radius 
+!        assuming 'flat surface' composition (does not depend on aerosol size)
+!     variables that depends on aerosol size because of Kelvin effect
+!     R2SO4Gik: number density of gaseous H2SO4 [molecules/cm3] - depends on aerosol size
+!     DENSO4ik: aerosol density (gr/cm3) - depends on aerosol size
+!     f_r_wetik: factor for converting dry to wet radius - depends on aerosol size
+!     RRSI: radius [cm]
+
+      USE aerophys
+      USE infotrac_phy
+      USE YOMCST, ONLY : RPI
+      USE sulfate_aer_mod, ONLY : wph2so4, surftension, solh2so4, rpmvh2so4
+      USE strataer_local_var_mod, ONLY : ALPH2SO4, RRSI
+      
+      IMPLICIT NONE
+      
+      REAL, PARAMETER :: third=1./3.
+      
+      ! input variables
+      REAL            :: R2SO4G !H2SO4 number density [molecules/cm3]
+      REAL            :: t_seri
+      REAL            :: pplay
+      REAL            :: R2SO4
+      REAL            :: DENSO4
+      REAL            :: f_r_wet
+      REAL            :: R2SO4ik(nbtr_bin), DENSO4ik(nbtr_bin), f_r_wetik(nbtr_bin)
+      
+      ! output variables
+      REAL            :: FL(nbtr_bin)
+      REAL            :: ASO4(nbtr_bin)
+      REAL            :: DNDR(nbtr_bin)
+      
+      ! local variables
+      INTEGER            :: IK
+      REAL            :: ALPHA,CST
+      REAL            :: WH2(nbtr_bin)
+      REAL            :: RP,VTK,AA,FL1,RKNUD
+      REAL            :: DND
+      REAL            :: ATOT,AH2O
+      REAL            :: RRSI_wet(nbtr_bin)
+      REAL            :: FPATH, WPP, XA, FKELVIN
+      REAL            :: surtens, mvh2so4, temp
+      
+! ///    MOLEC CONDENSATION GROWTH (DUE TO CHANGES IN H2SO4 AND SO H2O)
+!    ------------------------------------------------------------------
+!                                  EXCEPT CN
+!       RK:H2SO4 WEIGHT PERCENT DOESN'T CHANGE
+!     BE CAREFUL,H2SO4 WEIGHT PERCENTAGE
+
+!                   MOLECULAR ACCOMODATION OF H2SO4
+!     H2SO4 accommodation  coefficient [condensation/evaporation]
+      ALPHA = ALPH2SO4
+!      FPLAIR=(2.281238E-5)*TAIR/PAIR
+!     1.E2 (m to cm), 
+      CST=1.E2*2.281238E-5
+!     same expression as in coagulate
+!     in coagulate: mean free path of air (Pruppacher and Klett, 2010, p.417) [m]
+!     mnfrpth=6.6E-8*(1.01325E+5/pplay(ilon,ilev))*(t_seri(ilon,ilev)/293.15)
+!     mnfrpth=2.28E-5*t_seri/pplay
+      
+      temp = min( max(t_seri, 190.), 300.) ! 190K <= temp <= 300K
+      
+      RRSI_wet(:)=RRSI(:)*f_r_wetik(:)
+
+!     Pruppa and Klett
+      FPATH=CST*t_seri/pplay
+    
+!     H2SO4 mass fraction in aerosol
+      WH2(:)=R2SO4ik(:)*1.0E-2
+
+!                               ACTIVITY COEFFICIENT(SEE GIAUQUE,1951)
+!                               AYERS ET AL (1980)
+!                                  (MU-MU0)
+!      RP=-10156.0/t_seri +16.259-(ACTSO4*4.184)/(8.31441*t_seri)
+!                                  DROPLET H2SO4 PRESSURE IN DYN.CM-2
+!      RP=EXP(RP)*1.01325E6/0.086
+!!      RP=EXP(RP)*1.01325E6
+!                                  H2SO4 NUMBER DENSITY NEAR DROPLET
+
+!      DND=RP*6.02E23/(8.31E7*t_seri)
+
+!                                 KELVIN EFFECT FACTOR
+!CK 20160613: bug fix, removed factor 250 (from original code by S. Bekki)
+!!      AA =2.0*MH2O*72.0/(DENSO4*BOLZ*t_seri*250.0)
+!      AA =2.0*MH2O*72.0/(DENSO4*BOLZ*t_seri)
+
+!                                  MEAN KINETIC VELOCITY
+!     DYN*CM*K/(K*GR)=(CM/SEC2)*CM
+!                                  IN CM/SEC
+      VTK=SQRT(8.0*BOLZ*t_seri/(RPI*MH2SO4))
+!                                 KELVIN EFFECT FACTOR
+
+!     Loop on bin radius (RRSI in cm)
+      DO IK=1,nbtr_bin
+
+      IF(R2SO4ik(IK) > 0.0) THEN
+
+!       h2so4 mass fraction (0<wpp<1)
+        wpp=R2SO4ik(IK)*1.e-2    
+        xa=18.*wpp/(18.*wpp+98.*(1.-wpp)) 
+!       equilibrium h2so4 number density over H2SO4/H2O solution (molec/cm3)
+        DND=solh2so4(t_seri,xa)
+!          KELVIN EFFECT:  
+!       surface tension (mN/m=1.e-3.kg/s2) = f(T,h2so4 mole fraction)
+        surtens=surftension(temp,xa)
+!       partial molar volume of h2so4 (cm3.mol-1 =1.e-6.m3.mol-1)
+        mvh2so4= rpmvh2so4(temp,R2SO4ik(IK))
+!       Kelvin factor (MKS)
+        fkelvin=exp( 2.*1.e-3*surtens*1.e-6*mvh2so4/ (1.e-2*RRSI_wet(IK)*rgas*temp) )
+!                              
+        DNDR(IK) =DND*fkelvin
+
+        FL1=RPI*ALPHA*VTK*(R2SO4G-DNDR(IK))
+
+!       TURCO(1979) FOR HNO3:ALH2SO4 CONDENSATION= ALH2SO4 EVAPORATION
+!       RPI*R2*VTK IS EQUIVALENT TO DIFFUSION COEFFICIENT
+!       EXTENSION OF THE RELATION FOR DIFFUSION KINETICS
+!       KNUDSEN NUMBER FPATH/RRSI
+!       NEW VERSION (SEE NOTES)
+        RKNUD=FPATH/RRSI_wet(IK)
+!       SENFELD
+        FL(IK)=FL1*RRSI_wet(IK)**2*( 1.0 +RKNUD ) & 
+     &     /( 1.0 +ALPHA/(2.0*RKNUD) +RKNUD )
+!       TURCO
+!        RL= (4.0/3.0 +0.71/RKNUD)/(1.0+1.0/RKNUD)
+!     *         +4.0*(1.0-ALPHA)/(3.0*ALPHA)
+!        FL=FL1*RRSI(IK)*RRSI(IK)
+!     *         /( (3.0*ALPHA/4.0)*(1.0/RKNUD+RL*ALPHA) )
+
+!                         INITIAL NUMBER OF H2SO4 MOLEC OF 1 DROPLET
+        ATOT=4.0*RPI*DENSO4ik(IK)*(RRSI_wet(IK)**3)/3.0 !attention: g and cm
+        ASO4(IK)=WH2(IK)*ATOT/MH2SO4 !attention: g
+!        ATOT=4.0*RPI*dens_aer(I,J)/1000.*(RRSI(IK)**3)/3.0
+!        ASO4=mfrac_H2SO4*ATOT/MH2SO4
+!                        INITIAL NUMBER OF H2O MOLEC OF 1 DROPLET
+        AH2O=(1.0-WH2(IK))*ATOT/MH2O !attention: g
+
+!       CHANGE OF THE NUMBER OF H2SO4 MOLEC OF 1 DROPLET DURING DT
+!       IT IS FOR KEM BUT THERE ARE OTHER WAYS
+
+      ENDIF  
+
+      ENDDO !loop over bins
+
+      END SUBROUTINE condens_evapor_rate_kelvin
+      
+!********************************************************************
       SUBROUTINE condens_evapor_rate(R2SO4G,t_seri,pplay,ACTSO4,R2SO4, &
-                   & DENSO4,f_r_wet,RRSI,Vbin,FL,ASO4,DNDR)
+                   & DENSO4,f_r_wet,FL,ASO4,DNDR)
 !
 !     INPUT: 
@@ -22,4 +178,5 @@
       USE infotrac_phy
       USE YOMCST, ONLY : RPI
+      USE strataer_local_var_mod, ONLY : ALPH2SO4, RRSI
 
       IMPLICIT NONE
@@ -33,7 +190,5 @@
       REAL DENSO4
       REAL f_r_wet
-      REAL RRSI(nbtr_bin)
-      REAL Vbin(nbtr_bin)
-
+      
       ! output variables
       REAL FL(nbtr_bin)
@@ -48,6 +203,5 @@
       REAL ATOT,AH2O
       REAL RRSI_wet(nbtr_bin)
-      REAL Vbin_wet(nbtr_bin)
-      REAL MH2SO4,MH2O,BOLZ,FPATH
+      REAL FPATH
 
 ! ///    MOLEC CONDENSATION GROWTH (DUE TO CHANGES IN H2SO4 AND SO H2O)
@@ -57,20 +211,14 @@
 !     BE CAREFUL,H2SO4 WEIGHT PERCENTAGE
 
-!                   WEIGHT OF 1 MOLEC IN G
-      MH2O  =1000.*mH2Omol !18.016*1.66E-24
-      MH2SO4=1000.*mH2SO4mol !98.082*1.66E-24
-!                   BOLTZMANN CONSTANTE IN DYN.CM/K
-      BOLZ  =1.381E-16
 !                   MOLECULAR ACCOMODATION OF H2SO4
-!     raes and van dingen
-      ALPHA =0.1    
+!     H2SO4 accommodation coefficient [condensation/evaporation]
+      ALPHA = ALPH2SO4
 !      FPLAIR=(2.281238E-5)*TAIR/PAIR
 !     1.E2 (m to cm), 
       CST=1.E2*2.281238E-5
 
-      ! compute local wet particle radius and volume
+      ! compute local wet particle radius [cm]
       RRSI_wet(:)=RRSI(:)*f_r_wet
-      Vbin_wet(:)=Vbin(:)*f_r_wet**3
-
+      
 !     Pruppa and Klett
       FPATH=CST*t_seri/pplay
@@ -138,10 +286,11 @@
 
 !********************************************************************
-      SUBROUTINE cond_evap_part(dt,FL,ASO4,f_r_wet,RRSI,Vbin,tr_seri)
+      SUBROUTINE condens_evapor_part(dt,FL,ASO4,f_r_wet,tr_seri)
 
       USE aerophys
       USE infotrac_phy
       USE YOMCST, ONLY : RPI
-
+      USE strataer_local_var_mod, ONLY : RRSI,Vbin
+      
       IMPLICIT NONE
 
@@ -151,10 +300,8 @@
       REAL ASO4(nbtr_bin)
       REAL f_r_wet
-      REAL RRSI(nbtr_bin)
-      REAL Vbin(nbtr_bin)
-
+      
       ! output variables
       REAL tr_seri(nbtr)
-
+      
       ! local variables
       REAL tr_seri_new(nbtr)
@@ -211,5 +358,5 @@
       tr_seri(:)=tr_seri_new(:)
 
-      END SUBROUTINE cond_evap_part
+      END SUBROUTINE condens_evapor_part
 
 END MODULE cond_evap_tstep_mod
Index: /LMDZ6/branches/cirrus/libf/phylmd/StratAer/micphy_tstep.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/StratAer/micphy_tstep.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/StratAer/micphy_tstep.F90	(revision 5202)
@@ -8,5 +8,6 @@
   USE aerophys
   USE infotrac_phy, ONLY : nbtr_bin, nbtr_sulgas, nbtr, id_H2SO4_strat
-  USE phys_local_var_mod, ONLY: mdw, budg_3D_nucl, budg_3D_cond_evap, budg_h2so4_to_part, R2SO4, DENSO4, f_r_wet
+  USE phys_local_var_mod, ONLY: mdw, budg_3D_nucl, budg_3D_cond_evap, budg_h2so4_to_part, R2SO4, DENSO4, &
+       f_r_wet, R2SO4B, DENSO4B, f_r_wetB
   USE nucleation_tstep_mod
   USE cond_evap_tstep_mod
@@ -14,5 +15,5 @@
   USE YOMCST, ONLY : RPI, RD, RG
   USE print_control_mod, ONLY: lunout
-  USE strataer_local_var_mod
+  USE strataer_local_var_mod ! contains also RRSI and Vbin
   
   IMPLICIT NONE
@@ -35,10 +36,8 @@
   REAL                      :: ntot !total number of molecules in the critical cluster (ntot>4)
   REAL                      :: x    ! molefraction of H2SO4 in the critical cluster     
-  REAL Vbin(nbtr_bin)
   REAL a_xm, b_xm, c_xm
   REAL PDT, dt
   REAL H2SO4_init
   REAL ACTSO4(klon,klev)
-  REAL RRSI(nbtr_bin)
   REAL nucl_rate
   REAL cond_evap_rate
@@ -48,9 +47,6 @@
   REAL DNDR(nbtr_bin)
   REAL H2SO4_sat
-
-  DO it=1,nbtr_bin
-    Vbin(it)=4.0*RPI*((mdw(it)/2.)**3)/3.0
-  ENDDO
-
+  REAL R2SO4ik(nbtr_bin), DENSO4ik(nbtr_bin), f_r_wetik(nbtr_bin)
+  
   !coefficients for H2SO4 density parametrization used for nucleation if ntot<4
   a_xm = 0.7681724 + 1.*(2.1847140 + 1.*(7.1630022 + 1.*(-44.31447 + &
@@ -61,12 +57,9 @@
        & 1.*(7.990811e-4 + 1.*(-7.458060e-4 + 1.*2.58139e-4 )))))
 
-  ! STRAACT (R2SO4, t_seri -> H2SO4 activity coefficient (ACTSO4)) for cond/evap
-  CALL STRAACT(ACTSO4)
-
-  ! compute particle radius in cm RRSI from diameter in m 
-  DO it=1,nbtr_bin
-    RRSI(it)=mdw(it)/2.*100.
-  ENDDO
-
+  IF(.not.flag_new_strat_compo) THEN
+     ! STRAACT (R2SO4, t_seri -> H2SO4 activity coefficient (ACTSO4)) for cond/evap
+     CALL STRAACT(ACTSO4)
+  ENDIF
+  
   DO ilon=1, klon
 !
@@ -104,7 +97,16 @@
       ENDIF
       ! compute cond/evap rate in kg(H2SO4)/kgA/s
-      CALL condens_evapor_rate(rhoa,t_seri(ilon,ilev),pplay(ilon,ilev), &
-             & ACTSO4(ilon,ilev),R2SO4(ilon,ilev),DENSO4(ilon,ilev),f_r_wet(ilon,ilev), &
-             & RRSI,Vbin,FL,ASO4,DNDR)
+      IF(flag_new_strat_compo) THEN
+         R2SO4ik(:)   = R2SO4B(ilon,ilev,:)
+         DENSO4ik(:)  = DENSO4B(ilon,ilev,:)
+         f_r_wetik(:) = f_r_wetB(ilon,ilev,:)
+         CALL condens_evapor_rate_kelvin(rhoa,t_seri(ilon,ilev),pplay(ilon,ilev), &
+              & R2SO4(ilon,ilev),DENSO4(ilon,ilev),f_r_wet(ilon,ilev), &
+              & R2SO4ik,DENSO4ik,f_r_wetik,FL,ASO4,DNDR)
+      ELSE
+         CALL condens_evapor_rate(rhoa,t_seri(ilon,ilev),pplay(ilon,ilev), &
+              & ACTSO4(ilon,ilev),R2SO4(ilon,ilev),DENSO4(ilon,ilev),f_r_wet(ilon,ilev), &
+              & FL,ASO4,DNDR)
+      ENDIF
       ! Compute H2SO4 saturate vapor for big particules
       H2SO4_sat = DNDR(nbtr_bin)/(pplay(ilon,ilev)/t_seri(ilon,ilev)/RD/1.E6/mH2SO4mol)
@@ -127,7 +129,7 @@
       tr_seri(ilon,ilev,id_H2SO4_strat)=MAX(0.,tr_seri(ilon,ilev,id_H2SO4_strat)-(nucl_rate+cond_evap_rate)*dt)
       ! apply cond to bins
-      CALL cond_evap_part(dt,FL,ASO4,f_r_wet(ilon,ilev),RRSI,Vbin,tr_seri(ilon,ilev,:))
+      CALL condens_evapor_part(dt,FL,ASO4,f_r_wet(ilon,ilev),tr_seri(ilon,ilev,:))
       ! apply nucl. to bins
-      CALL nucleation_part(nucl_rate,ntot,x,dt,Vbin,tr_seri(ilon,ilev,:))
+      CALL nucleation_part(nucl_rate,ntot,x,dt,tr_seri(ilon,ilev,:))
       ! compute fluxes as diagnostic in [kg(S)/m2/layer/s] (now - for evap and + for cond)
       budg_3D_cond_evap(ilon,ilev)=budg_3D_cond_evap(ilon,ilev)+mSatom/mH2SO4mol &
@@ -142,7 +144,13 @@
         & *pplay(ilon,ilev)/t_seri(ilon,ilev)/RD/1.E6/mH2SO4mol
     ! compute cond/evap rate in kg(H2SO4)/kgA/s (now only evap for pdtphys)
-    CALL condens_evapor_rate(rhoa,t_seri(ilon,ilev),pplay(ilon,ilev), &
-           & ACTSO4(ilon,ilev),R2SO4(ilon,ilev),DENSO4(ilon,ilev),f_r_wet(ilon,ilev), &
-           & RRSI,Vbin,FL,ASO4,DNDR)
+    IF(flag_new_strat_compo) THEN
+       CALL condens_evapor_rate_kelvin(rhoa,t_seri(ilon,ilev),pplay(ilon,ilev), &
+            & R2SO4(ilon,ilev),DENSO4(ilon,ilev),f_r_wet(ilon,ilev), &
+            & R2SO4ik,DENSO4ik,f_r_wetik,FL,ASO4,DNDR)
+    ELSE
+       CALL condens_evapor_rate(rhoa,t_seri(ilon,ilev),pplay(ilon,ilev), &
+            & ACTSO4(ilon,ilev),R2SO4(ilon,ilev),DENSO4(ilon,ilev),f_r_wet(ilon,ilev), &
+            & FL,ASO4,DNDR)
+    ENDIF
     ! limit evaporation (negative FL) over one physics time step to H2SO4 content of the droplet
     DO it=1,nbtr_bin
@@ -159,5 +167,5 @@
     tr_seri(ilon,ilev,id_H2SO4_strat)=MAX(0.,tr_seri(ilon,ilev,id_H2SO4_strat)-evap_rate*pdtphys)
     ! apply evap to bins
-    CALL cond_evap_part(pdtphys,FL,ASO4,f_r_wet(ilon,ilev),RRSI,Vbin,tr_seri(ilon,ilev,:))
+    CALL condens_evapor_part(pdtphys,FL,ASO4,f_r_wet(ilon,ilev),tr_seri(ilon,ilev,:))
     ! compute fluxes as diagnostic in [kg(S)/m2/layer/s] (now - for evap and + for cond)
     budg_3D_cond_evap(ilon,ilev)=budg_3D_cond_evap(ilon,ilev)+mSatom/mH2SO4mol &
Index: /LMDZ6/branches/cirrus/libf/phylmd/StratAer/miecalc_aer.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/StratAer/miecalc_aer.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/StratAer/miecalc_aer.F90	(revision 5202)
@@ -16,5 +16,5 @@
 
   USE phys_local_var_mod, ONLY: tr_seri, mdw, alpha_bin, piz_bin, cg_bin
-  USE aerophys
+  USE aerophys, ONLY: dens_aer_dry, dens_aer_ref, V_rat
   USE aero_mod
   USE infotrac_phy, ONLY : nbtr, nbtr_bin, nbtr_sulgas, id_SO2_strat
@@ -226,19 +226,5 @@
     40000.000,    0.2500,   1.48400,   1.0000E-08, &
     50000.000,    0.2000,   1.49800,   1.0000E-08 /), (/nb_lambda_h2so4,4/), order=(/2,1/) )
-
-  !--initialising dry diameters to geometrically spaced mass/volume (see Jacobson 1994)
-    mdw(1)=mdwmin
-    IF (V_rat.LT.1.62) THEN ! compensate for dip in second bin for lower volume ratio
-      mdw(2)=mdw(1)*2.**(1./3.)
-      DO it=3, nbtr_bin
-        mdw(it)=mdw(it-1)*V_rat**(1./3.)
-      ENDDO 
-    ELSE
-      DO it=2, nbtr_bin
-        mdw(it)=mdw(it-1)*V_rat**(1./3.)
-      ENDDO
-    ENDIF
-    WRITE(lunout,*) 'init mdw=', mdw
-
+     
     !--compute particle radius for a composition of 75% H2SO4 / 25% H2O at T=293K
     DO bin_number=1, nbtr_bin
Index: /LMDZ6/branches/cirrus/libf/phylmd/StratAer/nucleation_tstep_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/StratAer/nucleation_tstep_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/StratAer/nucleation_tstep_mod.F90	(revision 5202)
@@ -70,9 +70,10 @@
 !--------------------------------------------------------------------------------------------------
 
-SUBROUTINE nucleation_part(nucl_rate,ntot,x,dt,Vbin,tr_seri)
+SUBROUTINE nucleation_part(nucl_rate,ntot,x,dt,tr_seri)
 
   USE aerophys
   USE infotrac_phy
-
+  USE strataer_local_var_mod, ONLY : Vbin
+  
   IMPLICIT NONE
 
@@ -82,6 +83,5 @@
   REAL x    ! mole raction of H2SO4 in the critical cluster
   REAL dt
-  REAL Vbin(nbtr_bin)
-
+  
   ! output variable
   REAL tr_seri(nbtr)
Index: /LMDZ6/branches/cirrus/libf/phylmd/StratAer/strataer_local_var_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/StratAer/strataer_local_var_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/StratAer/strataer_local_var_mod.F90	(revision 5202)
@@ -51,4 +51,8 @@
   
   !============= NUCLEATION VARS =============
+  ! MOLECULAR ACCOMODATION OF H2SO4 (Raes and Van Dingen)
+  REAL,SAVE    :: ALPH2SO4               ! H2SO4 accommodation  coefficient [condensation/evaporation]
+  !$OMP THREADPRIVATE(ALPH2SO4)
+  
   ! 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
@@ -64,6 +68,4 @@
   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)
@@ -144,4 +146,7 @@
   !$OMP THREADPRIVATE(day_emit_roc)
   
+  REAL,ALLOCATABLE,SAVE    :: RRSI(:) ! radius [cm] for each aerosol size
+  REAL,ALLOCATABLE,SAVE    :: Vbin(:) ! volume [m3] for each aerosol size  
+  !$OMP THREADPRIVATE(RRSI, Vbin)
   REAL,SAVE    :: dlat, dlon             ! delta latitude and d longitude of grid in degree
   !$OMP THREADPRIVATE(dlat, dlon)
@@ -153,5 +158,10 @@
     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
+    USE infotrac_phy, ONLY: id_OCS_strat,id_SO2_strat,id_H2SO4_strat,nbtr_sulgas,nbtr_bin
+    USE phys_local_var_mod, ONLY : mdw
+    USE aerophys, ONLY: mdwmin, V_rat
+    USE YOMCST  , ONLY : RPI
+    
+    INTEGER :: it
     
     WRITE(lunout,*) 'IN STRATAER_LOCAL_VAR INIT WELCOME!'
@@ -185,4 +195,5 @@
     
     ! nuc init
+    ALPH2SO4 = 0.1
     flag_nuc_rate_box = .FALSE.
     nuclat_min=0  ; nuclat_max=0
@@ -238,4 +249,33 @@
     ENDIF ! if master
     
+    !--initialising dry diameters to geometrically spaced mass/volume (see Jacobson 1994)
+    mdw(1)=mdwmin
+    IF (V_rat.LT.1.62) THEN ! compensate for dip in second bin for lower volume ratio
+       mdw(2)=mdw(1)*2.**(1./3.)
+       DO it=3, nbtr_bin
+          mdw(it)=mdw(it-1)*V_rat**(1./3.)
+       ENDDO
+    ELSE
+       DO it=2, nbtr_bin
+          mdw(it)=mdw(it-1)*V_rat**(1./3.)
+       ENDDO
+    ENDIF
+    IF (is_master) WRITE(lunout,*) 'init mdw=', mdw
+    
+    !   compute particle radius RRSI [cm] and volume Vbin [m3] from diameter mdw [m]
+    ALLOCATE(RRSI(nbtr_bin), Vbin(nbtr_bin))
+    
+    DO it=1,nbtr_bin
+       !     [cm]
+       RRSI(it)=mdw(it)/2.*100.
+       !     [m3]
+       Vbin(it)=4.0*RPI*((mdw(it)/2.)**3)/3.0
+    ENDDO
+    
+    IF (is_master) THEN
+       WRITE(lunout,*) 'init RRSI=', RRSI
+       WRITE(lunout,*) 'init Vbin=', Vbin
+    ENDIF
+    
     WRITE(lunout,*) 'IN STRATAER INIT END'
     
Index: /LMDZ6/branches/cirrus/libf/phylmd/StratAer/strataer_nuc_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/StratAer/strataer_nuc_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/StratAer/strataer_nuc_mod.F90	(revision 5202)
@@ -13,5 +13,6 @@
     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
+    USE strataer_local_var_mod, ONLY: ALPH2SO4,flag_nuc_rate_box,nuclat_min,nuclat_max, &
+         nucpres_min,nucpres_max
     
     !Config Key  = flag_nuc_rate_box
@@ -30,6 +31,10 @@
     CALL getin_p('nucpres_max',nucpres_max)
     
+    ! Read argument H2SO4 accommodation  coefficient [condensation/evaporation]
+    CALL getin_p('alph2so4',ALPH2SO4)
+    
     !============= Print params =============
     IF (is_master) THEN
+       WRITE(lunout,*) 'IN STRATAER_NUC : ALPH2SO4 = ',alph2so4
        WRITE(lunout,*) 'IN STRATAER_NUC : flag_nuc_rate_box = ',flag_nuc_rate_box
        IF (flag_nuc_rate_box) THEN
Index: /LMDZ6/branches/cirrus/libf/phylmd/StratAer/sulfate_aer_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/StratAer/sulfate_aer_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/StratAer/sulfate_aer_mod.F90	(revision 5202)
@@ -7,73 +7,145 @@
 
 !*******************************************************************
-  SUBROUTINE STRACOMP_BIN(sh,t_seri,pplay)
-!
-!   Aerosol H2SO4 weight fraction as a function of PH2O and temperature
-!   INPUT:
-!   sh: VMR of H2O
-!   t_seri: temperature (K)
-!   pplay: middle layer pression (Pa)
-!
-!   OUTPUT:
-!   R2SO4: aerosol H2SO4 weight fraction (percent)
+      SUBROUTINE STRACOMP_KELVIN(sh,t_seri,pplay)
+!
+!     Aerosol H2SO4 weight fraction as a function of PH2O and temperature
+!     INPUT:
+!     sh: MMR of H2O
+!     t_seri: temperature (K)
+!     pplay: middle layer pression (Pa)
+!
+!     Modified in modules:
+!     R2SO4: aerosol H2SO4 weight fraction (percent)
+!     R2SO4B: aerosol H2SO4 weight fraction (percent) for each aerosol bin
+!     DENSO4: aerosol density (gr/cm3)
+!     DENSO4B: aerosol density (gr/cm3)for each aerosol bin
+!     f_r_wet: factor for converting dry to wet radius 
+!        assuming 'flat surface' composition (does not depend on aerosol size)
+!     f_r_wetB: factor for converting dry to wet radius 
+!        assuming 'curved surface' composition (depends on aerosol size)
     
-    USE dimphy, ONLY : klon,klev ! nb of longitude and altitude bands
-    USE aerophys
-    USE phys_local_var_mod, ONLY: R2SO4
+      USE dimphy, ONLY : klon,klev ! nb of longitude and altitude bands
+      USE infotrac_phy, ONLY : nbtr_bin
+      USE aerophys
+      USE phys_local_var_mod, ONLY: R2SO4, R2SO4B, DENSO4, DENSO4B, f_r_wet, f_r_wetB
+      USE strataer_local_var_mod, ONLY: RRSI
+!     WARNING: in phys_local_var_mod R2SO4B, DENSO4B, f_r_wetB (klon,klev,nbtr_bin)
+!          and dens_aer_dry must be declared somewhere
     
-    IMPLICIT NONE
+      IMPLICIT NONE
     
-    REAL,DIMENSION(klon,klev),INTENT(IN)          :: t_seri  ! Temperature
-    REAL,DIMENSION(klon,klev),INTENT(IN)          :: pplay   ! pression in the middle of each layer (Pa)
-    REAL,DIMENSION(klon,klev),INTENT(IN)          :: sh      ! specific humidity
+      REAL,DIMENSION(klon,klev),INTENT(IN)    :: t_seri  ! Temperature
+      REAL,DIMENSION(klon,klev),INTENT(IN)    :: pplay   ! pression in the middle of each layer (Pa)
+      REAL,DIMENSION(klon,klev),INTENT(IN)    :: sh      ! specific humidity (kg h2o/kg air)
+      
+!     local variables
+      integer         :: ilon,ilev,ik
+      real, parameter :: rath2oair = mAIRmol/mH2Omol  
+      real, parameter :: third = 1./3.
+      real            :: pph2ogas(klon,klev) 
+      real            :: temp, wpp, xa, surtens, mvh2o, radwet, fkelvin, pph2okel, r2so4ik, denso4ik
+!----------------------------------------
+  
+!     gas-phase h2o partial pressure (Pa) 
+!                                vmr=sh*rath2oair
+      pph2ogas(:,:) = pplay(:,:)*sh(:,:)*rath2oair
     
-    REAL ks(7)
-    REAL t,qh2o,ptot,pw
-    REAL a,b,c,det
-    REAL xsb,msb
+      DO ilon=1,klon
+      DO ilev=1,klev
+          
+        temp = max(t_seri(ilon,ilev),190.)
+        temp = min(temp,300.)
+
+!    ***   H2SO4-H2O flat surface ***
+!!       equilibrium H2O pressure over pure flat liquid water (Pa)
+!!        pflath2o=psh2o(temp)
+!       h2so4 weight percent(%) = f(P_h2o(Pa),T)
+        R2SO4(ilon,ilev)=wph2so4(pph2ogas(ilon,ilev),temp)  
+!       h2so4 mass fraction (0<wpp<1)
+        wpp=R2SO4(ilon,ilev)*1.e-2     
+!       mole fraction
+        xa=18.*wpp/(18.*wpp+98.*(1.-wpp))
+
+!        CHECK:compare h2so4 sat/ pressure (see Marti et al., 97 & reef. therein)
+!               R2SO4(ilon,ilev)=70.    temp=298.15
+!        equilibrium h2so4 number density over H2SO4/H2O solution (molec/cm3)
+!        include conversion from molec/cm3 to Pa
+!        ph2so4=solh2so4(temp,xa)*(1.38065e-16*temp)/10.
+!        print*,' ph2so4=',ph2so4,temp,R2SO4(ilon,ilev)
+!        good match with Martin, et Ayers, not with Gmitro (the famous 0.086)
+
+!       surface tension (mN/m=1.e-3.kg/s2) = f(T,h2so4 mole fraction)
+        surtens=surftension(temp,xa)
+!       molar volume of pure h2o (cm3.mol-1 =1.e-6.m3.mol-1)
+        mvh2o= rmvh2o(temp)
+!       aerosol density (gr/cm3) = f(T,h2so4 mass fraction)
+        DENSO4(ilon,ilev)=density(temp,wpp) 
+!           ->x1000., to have it in kg/m3
+!       factor for converting dry to wet radius
+        f_r_wet(ilon,ilev) = (dens_aer_dry/(DENSO4(ilon,ilev)*1.e3)/ & 
+                   &    (R2SO4(ilon,ilev)*1.e-2))**third
+!    ***   End of H2SO4-H2O flat surface ***
+
+
+!          Loop on bin radius (RRSI in cm)
+           DO IK=1,nbtr_bin 
+ 
+!      ***   H2SO4-H2O curved surface - Kelvin effect factor ***
+!            wet radius (m) (RRSI(IK) in [cm])
+             if (f_r_wetB(ilon,ilev,IK) .gt. 1.0) then 
+               radwet = 1.e-2*RRSI(IK)*f_r_wetB(ilon,ilev,IK)
+             else 
+!              H2SO4-H2O flat surface, only on the first timestep
+               radwet = 1.e-2*RRSI(IK)*f_r_wet(ilon,ilev)
+             endif
+!            Kelvin factor: 
+!            surface tension (mN/m=1.e-3.kg/s2) 
+!            molar volume of pure h2o (cm3.mol-1 =1.e-6.m3.mol-1)
+             fkelvin=exp( 2.*1.e-3*surtens*1.e-6*mvh2o/ (radwet*rgas*temp) )
+!            equilibrium: pph2o(gas) = pph2o(liq) = pph2o(liq_flat) * fkelvin
+!            equilibrium: pph2o(liq_flat) = pph2o(gas) / fkelvin
+!            h2o liquid partial pressure before Kelvin effect (Pa)
+             pph2okel = pph2ogas(ilon,ilev) / fkelvin
+!            h2so4 weight percent(%) = f(P_h2o(Pa),temp)
+             r2so4ik=wph2so4(pph2okel,temp)
+!            h2so4 mass fraction (0<wpp<1)
+             wpp=r2so4ik*1.e-2    
+!            mole fraction
+             xa=18.*wpp/(18.*wpp+98.*(1.-wpp)) 
+!            aerosol density (gr/cm3) = f(T,h2so4 mass fraction)
+             denso4ik=density(temp,wpp)
+!           
+!            recalculate Kelvin factor with surface tension and radwet 
+!                              with new R2SO4B and DENSO4B
+             surtens=surftension(temp,xa)
+!            wet radius (m)
+             radwet = 1.e-2*RRSI(IK)*(dens_aer_dry/(denso4ik*1.e3)/ & 
+                   &    (r2so4ik*1.e-2))**third
+             fkelvin=exp( 2.*1.e-3*surtens*1.e-6*mvh2o / (radwet*rgas*temp) ) 
+             pph2okel=pph2ogas(ilon,ilev) / fkelvin
+!            h2so4 weight percent(%) = f(P_h2o(Pa),temp)
+             R2SO4B(ilon,ilev,IK)=wph2so4(pph2okel,temp)
+!            h2so4 mass fraction (0<wpp<1)
+             wpp=R2SO4B(ilon,ilev,IK)*1.e-2    
+             xa=18.*wpp/(18.*wpp+98.*(1.-wpp)) 
+!            aerosol density (gr/cm3) = f(T,h2so4 mass fraction)
+             DENSO4B(ilon,ilev,IK)=density(temp,wpp)
+!            factor for converting dry to wet radius
+             f_r_wetB(ilon,ilev,IK) = (dens_aer_dry/(DENSO4B(ilon,ilev,IK)*1.e3)/ & 
+                   &    (R2SO4B(ilon,ilev,IK)*1.e-2))**third
+!
+!             print*,'R,Rwet(m),kelvin,h2so4(%),ro=',RRSI(ik),radwet,fkelvin, &
+!              &  R2SO4B(ilon,ilev,IK),DENSO4B(ilon,ilev,IK)
+!             print*,' equil.h2so4(molec/cm3), & 
+!              & sigma',solh2so4(temp,xa),surftension(temp,xa)
+
+           ENDDO
+
+      ENDDO
+      ENDDO
+
+      RETURN
     
-    INTEGER ilon,ilev
-    DATA ks/-21.661,2724.2,51.81,-15732.0,47.004,-6969.0,-4.6183/
-    
-!*******************************************************************
-!***     liquid aerosols process
-!*******************************************************************
-!        BINARIES LIQUID AEROROLS:
-    
-    DO ilon=1,klon
-       DO ilev=1,klev
-          
-          t = max(t_seri(ilon,ilev),185.)
-          qh2o=sh(ilon,ilev)/18.*28.9
-          ptot=pplay(ilon,ilev)/100.
-          pw = qh2o*ptot/1013.0
-          pw = min(pw,2.e-3/1013.)
-          pw = max(pw,2.e-5/1013.)
-          
-!*******************************************************************
-!***     binaries aerosols h2so4/h2o
-!*******************************************************************
-          a = ks(3) + ks(4)/t
-          b = ks(1) + ks(2)/t
-          c = ks(5) + ks(6)/t + ks(7)*log(t) - log(pw)
-          
-          det = b**2 - 4.*a*c
-          
-          IF (det > 0.) THEN
-             xsb = (-b - sqrt(det))/(2.*a)
-             msb = 55.51*xsb/(1.0 - xsb)
-          ELSE
-             msb = 0.
-          ENDIF
-          R2SO4(ilon,ilev) = 100*msb*0.098076/(1.0 + msb*0.098076)
-          
-          ! H2SO4 min dilution: 0.5%
-          R2SO4(ilon,ilev) = max( R2SO4(ilon,ilev), 0.005 )
-       ENDDO
-    ENDDO
-100 RETURN
-    
-  END SUBROUTINE STRACOMP_BIN
-
+  END SUBROUTINE STRACOMP_KELVIN
 !********************************************************************
     SUBROUTINE STRACOMP(sh,t_seri,pplay)
@@ -544,76 +616,4 @@
 
     END SUBROUTINE
-
-!****************************************************************
-    SUBROUTINE DENH2SA_TABA(t_seri)
-
-!   AERSOL DENSITY AS A FUNCTION OF H2SO4 WEIGHT PERCENT AND T
-!   from Tabazadeh et al. (1994) abaques
-!   ---------------------------------------------
-
-!   
-!   INPUT: 
-!   R2SO4: aerosol H2SO4 weight fraction (percent)
-!   t_seri: temperature (K)
-!   klon: number of latitude bands in the model domain
-!   klev: number of altitude bands in the model domain
-!   for IFS: perhaps add another dimension for longitude
-!
-!   OUTPUT: 
-!   DENSO4: aerosol mass density (gr/cm3 = aerosol mass/aerosol volume)
-!   
-    USE dimphy, ONLY : klon,klev
-    USE phys_local_var_mod, ONLY: R2SO4, DENSO4
-    
-    IMPLICIT NONE
-    
-    REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
-        
-    INTEGER i,j
-    
-!----------------------------------------------------------------------
-!	... Local variables
-!----------------------------------------------------------------------
-      real, parameter :: a9 = -268.2616e4, a10 = 576.4288e3
-      
-      real :: a0, a1, a2, a3, a4, a5, a6, a7 ,a8
-      real :: c1, c2, c3, c4, w
-      
-      
-!   Loop on model domain (2 dimension for UPMC model; 3 for IFS)
-    DO i=1,klon
-       DO j=1,klev
-!----------------------------------------------------------------------
-!	... Temperature variables
-!----------------------------------------------------------------------
-          c1 = t_seri(I,J)- 273.15
-          c2 = c1**2
-          c3 = c1*c2
-          c4 = c1*c3
-!----------------------------------------------------------------------
-!	Polynomial Coefficients
-!----------------------------------------------------------------------
-          a0 = 999.8426 + 334.5402e-4*c1 - 569.1304e-5*c2
-          a1 = 547.2659 - 530.0445e-2*c1 + 118.7671e-4*c2 + 599.0008e-6*c3
-          a2 = 526.295e1 + 372.0445e-1*c1 + 120.1909e-3*c2 - 414.8594e-5*c3 + 119.7973e-7*c4
-          a3 = -621.3958e2 - 287.7670*c1 - 406.4638e-3*c2 + 111.9488e-4*c3 + 360.7768e-7*c4
-          a4 = 409.0293e3 + 127.0854e1*c1 + 326.9710e-3*c2 - 137.7435e-4*c3 - 263.3585e-7*c4
-          a5 = -159.6989e4 - 306.2836e1*c1 + 136.6499e-3*c2 + 637.3031e-5*c3
-          a6 = 385.7411e4 + 408.3717e1*c1 - 192.7785e-3*c2
-          a7 = -580.8064e4 - 284.4401e1*c1
-          a8 = 530.1976e4 + 809.1053*c1
-!----------------------------------------------------------------------
-!	... Summation
-!----------------------------------------------------------------------
-!     w : H2SO4 Weight fraction
-          w=r2SO4(i,j)*0.01
-          DENSO4(i,j) = 0.001*(a0 + w*(a1 + w*(a2 + w*(a3 + w*(a4 +  & 
-               w*(a5 + w*(a6 + w*(a7 + w*(a8 + w*(a9 + w*a10))))))))))
-          DENSO4(i,j) = max (0.0, DENSO4(i,j) )
-
-       ENDDO
-    ENDDO
-
-  END SUBROUTINE DENH2SA_TABA
   
 !****************************************************************
@@ -764,4 +764,299 @@
        RETURN
        END SUBROUTINE
-
+!********************************************************************
+!-----------------------------------------------------------------------
+      real function psh2so4(T) result(psh2so4_out)
+!     equilibrium H2SO4 pressure over pure H2SO4 solution (Pa)
+!
+!---->Ayers et.al. (1980), GRL (7) pp 433-436
+!     plus corrections for lower temperatures by Kulmala and Laaksonen (1990)
+!     and Noppel et al. (1990)
+
+      implicit none
+      real, intent(in) :: T
+      real, parameter ::      &
+              &  b1=1.01325e5, &
+              &  b2=11.5,  &
+              &  b3=1.0156e4,  &
+              &  b4=0.38/545., &
+              &  tref=360.15
+
+!     saturation vapor pressure ( N/m2 = Pa = kg/(m.s2) )
+      psh2so4_out=b1*exp(  -b2 +b3*( 1./tref-1./T  &
+           &  +b4*(1.+log(tref/T)-tref/T) )   )  
+
+       return
+    end function psh2so4
+!-----------------------------------------------------------------------
+    real function ndsh2so4(T) result(ndsh2so4_out)
+!     equilibrium H2SO4 number density over pure H2SO4 (molec/cm3)
+
+      implicit none
+      real, intent(in) :: T
+      real :: presat
+
+!     Boltzmann constant ( 1.38065e-23 J/K = m2⋅kg/(s2⋅K) )
+!      akb idem in cm2⋅g/(s2⋅K) 
+      real, parameter :: akb=1.38065e-16
+
+!     pure h2so4 saturation vapor pressure (Pa)
+      presat=psh2so4(T)
+!     saturation number density (1/cm3) - (molec/cm3)
+      ndsh2so4_out=presat*10./(akb*T)
+
+       return
+     end function ndsh2so4
+!-----------------------------------------------------------------------
+     real function psh2o(T) result(psh2o_out)
+!     equilibrium H2O pressure over pure liquid water (Pa)
+!
+      implicit none
+      real, intent(in) :: T
+
+      if(T.gt.229.) then
+!        Preining et al., 1981 (from Kulmala et al., 1998)
+!        saturation vapor pressure (N/m2 = 1 Pa = 1 kg/(m·s2))
+         psh2o_out=exp( 77.34491296  -7235.424651/T &
+             &                 -8.2*log(T) + 5.7133e-3*T )
+      else
+!        Tabazadeh et al., 1997, parameterization for 185<T<260
+!        saturation water vapor partial pressure (mb = hPa =1.E2 kg/(m·s2))
+!        or from Clegg and Brimblecombe , J. Chem. Eng., p43, 1995.
+;
+         psh2o_out=18.452406985 -3505.1578807/T &
+              &    -330918.55082/(T*T)             &
+              &    +12725068.262/(T*T*T)
+!        in Pa
+         psh2o_out=100.*exp(psh2o_out)
+      end if
+!      print*,psh2o_out
+      
+       return
+     end function psh2o
+!-----------------------------------------------------------------------
+     real function density(T,so4mfrac) result(density_out)
+!        calculation of particle density (gr/cm3)
+
+!        requires Temperature (T) and acid mass fraction (so4mfrac)
+!---->Vehkamaeki et al. (2002)
+
+      implicit none
+      real, intent(in) :: T, so4mfrac
+      real, parameter :: &
+           &      a1= 0.7681724,&
+           &      a2= 2.184714, &
+           &      a3= 7.163002, &
+           &      a4=-44.31447, &
+           &      a5= 88.74606, &
+           &      a6=-75.73729, &
+           &      a7= 23.43228
+      real, parameter :: &
+           &      b1= 1.808225e-3, &
+           &      b2=-9.294656e-3, &
+           &      b3=-3.742148e-2, &
+           &      b4= 2.565321e-1, &
+           &      b5=-5.362872e-1, &
+           &      b6= 4.857736e-1, &
+           &      b7=-1.629592e-1
+      real, parameter :: &
+           &      c1=-3.478524e-6, &
+           &      c2= 1.335867e-5, &
+           &      c3= 5.195706e-5, &
+           &      c4=-3.717636e-4, &
+           &      c5= 7.990811e-4, &
+           &      c6=-7.458060e-4, &
+           &      c7= 2.581390e-4
+      real :: a,b,c,so4m2,so4m3,so4m4,so4m5,so4m6
+      
+      so4m2=so4mfrac*so4mfrac
+      so4m3=so4mfrac*so4m2
+      so4m4=so4mfrac*so4m3
+      so4m5=so4mfrac*so4m4
+      so4m6=so4mfrac*so4m5
+
+      a=+a1+a2*so4mfrac+a3*so4m2+a4*so4m3 &
+         &     +a5*so4m4+a6*so4m5+a7*so4m6
+      b=+b1+b2*so4mfrac+b3*so4m2+b4*so4m3 &
+         &     +b5*so4m4+b6*so4m5+b7*so4m6
+      c=+c1+c2*so4mfrac+c3*so4m2+c4*so4m3 &
+         &     +c5*so4m4+c6*so4m5+c7*so4m6
+      density_out=(a+b*T+c*T*T) ! units are gm/cm**3
+
+       return
+     end function density
+!-----------------------------------------------------------------------
+     real function surftension(T,so4frac) result(surftension_out)
+!        calculation of surface tension (mN/meter)
+!        requires Temperature (T) and acid mole fraction (so4frac)
+!---->Vehkamaeki et al. (2002)
+
+      implicit none
+      real,intent(in) :: T, so4frac
+      real :: a,b,so4mfrac,so4m2,so4m3,so4m4,so4m5,so4sig
+      real, parameter :: &
+            &     a1= 0.11864, &
+            &     a2=-0.11651, &
+            &     a3= 0.76852, &
+            &     a4=-2.40909, &
+            &     a5= 2.95434, &
+            &     a6=-1.25852
+      real, parameter :: &
+            &     b1=-1.5709e-4, &
+            &     b2= 4.0102e-4, &
+            &     b3=-2.3995e-3, &
+            &     b4= 7.611235e-3, &
+            &     b5=-9.37386e-3, &
+            &     b6= 3.89722e-3
+      real, parameter :: convfac=1.e3  ! convert from newton/m to dyne/cm
+      real, parameter :: Mw=18.01528, Ma=98.079
+
+!     so4 mass fraction
+      so4mfrac=Ma*so4frac/( Ma*so4frac+Mw*(1.-so4frac) )
+      so4m2=so4mfrac*so4mfrac
+      so4m3=so4mfrac*so4m2
+      so4m4=so4mfrac*so4m3
+      so4m5=so4mfrac*so4m4
+
+      a=+a1+a2*so4mfrac+a3*so4m2+a4*so4m3+a5*so4m4+a6*so4m5
+      b=+b1+b2*so4mfrac+b3*so4m2+b4*so4m3+b5*so4m4+b6*so4m5
+      so4sig=a+b*T
+      surftension_out=so4sig*convfac
+
+       return
+     end function surftension
+!-----------------------------------------------------------------------
+     real function wph2so4(pph2o,T) result(wph2so4_out)
+!     Calculates the equilibrium composition of h2so4 aerosols
+!     as a function of temperature and  H2O pressure, using
+!     the parameterization of Tabazadeh et al., GRL, p1931, 1997.
+!
+!   Parameters
+!
+!    input:
+!      T.....temperature (K)
+!      pph2o..... amhbiant 2o pressure (Pa)
+!
+!    output:
+!      wph2so4......sulfuric acid composition (weight percent wt % h2so4)
+!                     = h2so4 mass fraction*100.
+!
+      implicit none
+      real, intent(in) :: pph2o, T 
+      
+      real :: aw, rh, y1, y2, sulfmolal
+  
+!       psh2o(T): equilibrium H2O pressure over pure liquid water (Pa)
+!       relative humidity 
+        rh=pph2o/psh2o(T)
+!       water activity
+!        aw=min( 0.999,max(1.e-3,rh) )
+        aw=min( 0.999999999,max(1.e-8,rh) ) 
+
+!       composition
+!       calculation of h2so4 molality
+            if(aw .le. 0.05 .and. aw .gt. 0.) then
+               y1=12.372089320*aw**(-0.16125516114) &
+                 &  -30.490657554*aw -2.1133114241
+               y2=13.455394705*aw**(-0.19213122550) &
+                 &  -34.285174607*aw -1.7620073078
+            else if(aw .le. 0.85 .and. aw .gt. 0.05) then
+               y1=11.820654354*aw**(-0.20786404244) &
+                 &  -4.8073063730*aw -5.1727540348
+               y2=12.891938068*aw**(-0.23233847708) &
+                 &  -6.4261237757*aw -4.9005471319
+            else
+               y1=-180.06541028*aw**(-0.38601102592) &
+                 &  -93.317846778*aw +273.88132245
+               y2=-176.95814097*aw**(-0.36257048154) &
+                 &  -90.469744201*aw +267.45509988
+            end if
+!        h2so4 molality (m=moles of h2so4 (solute)/ kg of h2o(solvent))
+         sulfmolal = y1+((T-190.)*(y2-y1)/70.)
+
+!        for a solution containing mh2so4 and mh2o: 
+!        sulfmolal = (mh2so4(gr)/h2so4_molar_mass(gr/mole)) / (mh2o(gr)*1.e-3)
+!        mh2o=1.e3*(mh2so4/Mh2so4)/sulfmolal=1.e3*mh2so4/(Mh2so4*sulfmolal)
+!        h2so4_mass_fraction = mfh2so4 = mh2so4/(mh2o + mh2so4)
+!        mh2o=mh2so4*(1-mfh2so4)/mfh2so4
+!        combining the 2 equations
+!        1.e3*mh2so4/(Mh2so4*sulfmolal) = mh2so4*(1-mfh2so4)/mfh2so4
+!        1.e3/(Mh2so4*sulfmolal) = (1-mfh2so4)/mfh2so4
+!        1000*mfh2so4 = (1-mfh2so4)*Mh2so4*sulfmolal
+!        mfh2so4*(1000.+Mh2so4*sulfmolal) = Mh2so4*sulfmolal
+!        mfh2so4 = Mh2so4*sulfmolal / (1000.+Mh2so4*sulfmolal) 
+!        wph2so4 (% mass fraction)= 100.*Mh2so4*sulfmolal / (1000.+Mh2so4*sulfmolal) 
+!        recall activity of i = a_i = P_i/P_pure_i and 
+!          activity coefficient of i = gamma_i = a_i/X_i (X_i: mole fraction of i)
+!        so  P_i = gamma_i*X_i*P_pure_i
+!        if ideal solution, gamma_i=1, P_i = X_i*P_pure_i
+
+!        h2so4 weight precent
+         wph2so4_out = 9800.*sulfmolal/(98.*sulfmolal+1000.)
+!         print*,rh,pph2o,psh2o(T),vpice(T)
+!         print*,T,aw,sulfmolal,wph2so4_out
+         wph2so4_out = max(wph2so4_out,15.)
+         wph2so4_out = min(wph2so4_out,99.999)
+
+       return
+     end function wph2so4
+!-----------------------------------------------------------------------
+     real function solh2so4(T,xa) result(solh2so4_out)
+!     equilibrium h2so4 number density over H2SO4/H2O solution (molec/cm3)
+
+      implicit none
+      real, intent(in) :: T, xa       ! T(K)  xa(H2SO4 mass fraction)
+      
+      real :: xw, a12,b12, cacta, presat
+      
+      xw=1.0-xa
+
+!     pure h2so4 saturation number density (molec/cm3)
+      presat=ndsh2so4(T)
+!     compute activity of acid 
+      a12=5.672E3 -4.074E6/T +4.421E8/(T*T)
+      b12=1./0.527
+      cacta=10.**(a12*xw*xw/(xw+b12*xa)**2/T)
+!     h2so4 saturation number density over H2SO4/H2O solution (molec/cm3)
+      solh2so4_out=cacta*xa*presat
+
+       return
+     end function solh2so4
+!-----------------------------------------------------------------------      
+     real function rpmvh2so4(T,ws) result(rpmvh2so4_out)
+!     partial molar volume of h2so4 in h2so4/h2o solution (cm3/mole)
+
+      implicit none
+      real, intent(in) :: T, ws
+      real, dimension(22),parameter :: x=(/  &
+       & 2.393284E-02,-4.359335E-05,7.961181E-08,0.0,-0.198716351, &
+       & 1.39564574E-03,-2.020633E-06,0.51684706,-3.0539E-03,4.505475E-06, &
+       & -0.30119511,1.840408E-03,-2.7221253742E-06,-0.11331674116, &
+       & 8.47763E-04,-1.22336185E-06,0.3455282,-2.2111E-03,3.503768245E-06, &
+       & -0.2315332,1.60074E-03,-2.5827835E-06/)
+      
+      real :: w
+
+        w=ws*0.01
+        rpmvh2so4_out=x(5)+x(6)*T+x(7)*T*T+(x(8)+x(9)*T+x(10)*T*T)*w &
+          +(x(11)+x(12)*T+x(13)*T*T)*w*w
+!       h2so4 partial molar volume in h2so4/h2o solution (cm3/mole)
+        rpmvh2so4_out=rpmvh2so4_out*1000.
+        
+       return
+     end function rpmvh2so4
+!-----------------------------------------------------------------------
+     real function rmvh2o(T) result(rmvh2o_out)
+!     molar volume of pure h2o (cm3/mole)
+
+       implicit none
+       real, intent(in) :: T 
+       real, parameter :: x1=2.393284E-02,x2=-4.359335E-05,x3=7.961181E-08
+
+!      1000: L/mole ->  cm3/mole
+!      pure h2o molar volume (cm3/mole)
+       rmvh2o_out=(x1+x2*T+x3*T*T)*1000.
+       
+       return
+     end function rmvh2o
+!
 END MODULE sulfate_aer_mod
Index: /LMDZ6/branches/cirrus/libf/phylmd/StratAer/traccoag_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/StratAer/traccoag_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/StratAer/traccoag_mod.F90	(revision 5202)
@@ -9,8 +9,9 @@
        presnivs, xlat, xlon, pphis, pphi, &
        t_seri, pplay, paprs, sh, rh, tr_seri)
-
+    
     USE phys_local_var_mod, ONLY: mdw, R2SO4, DENSO4, f_r_wet, surf_PM25_sulf, & 
-        & budg_emi_ocs, budg_emi_so2, budg_emi_h2so4, budg_emi_part 
-
+        & budg_emi_ocs, budg_emi_so2, budg_emi_h2so4, budg_emi_part, &
+        & R2SO4B, DENSO4B, f_r_wetB, sulfmmr, SAD_sulfate, sulfmmr_mode, nd_mode, reff_sulfate
+    
     USE dimphy
     USE infotrac_phy, ONLY : nbtr_bin, nbtr_sulgas, nbtr, id_SO2_strat
@@ -56,5 +57,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
+    INTEGER                                :: it, k, i, j, ilon, ilev, itime, i_int, ieru
     LOGICAL,DIMENSION(klon,klev)           :: is_strato           ! true = above tropopause, false = below
     REAL,DIMENSION(klon,klev)              :: m_air_gridbox       ! mass of air in every grid box [kg]
@@ -82,4 +83,5 @@
     INTEGER                                :: injdur_sai          ! injection duration for SAI case [days]
     INTEGER                                :: yr, is_bissext
+    REAL                                   :: samoment2, samoment3! 2nd and 3rd order moments of size distribution
 
     IF (is_mpi_root .AND. flag_verbose_strataer) THEN
@@ -88,4 +90,5 @@
     ENDIF
     
+    !   radius [m]
     DO it=1, nbtr_bin
       r_bin(it)=mdw(it)/2.
@@ -117,13 +120,9 @@
 
     IF(flag_new_strat_compo) THEN
-       IF(debutphy) WRITE(lunout,*) 'traccoag: USE STRAT COMPO from Tabazadeh 1994', flag_new_strat_compo
-       ! STRACOMP (H2O, P, t_seri -> aerosol composition (R2SO4)) : binary routine (from reprobus)
-       ! H2SO4 mass fraction in aerosol (%) from Tabazadeh et al. (1994).
-       CALL stracomp_bin(sh,t_seri,pplay)
-       
-       ! aerosol density (gr/cm3) - from Tabazadeh
-       CALL denh2sa_taba(t_seri)
+       IF(debutphy) WRITE(lunout,*) 'traccoag: COMPO/DENSITY (Tabazadeh 97) + H2O kelvin effect', flag_new_strat_compo
+       ! STRACOMP (H2O, P, t_seri, R -> R2SO4 + Kelvin effect) : Taba97, Socol, etc...
+       CALL stracomp_kelvin(sh,t_seri,pplay)
     ELSE
-       IF(debutphy) WRITE(lunout,*) 'traccoag: USE STRAT COMPO from Bekki 2D model', flag_new_strat_compo
+       IF(debutphy) WRITE(lunout,*) 'traccoag: COMPO from Bekki 2D model', flag_new_strat_compo
        ! STRACOMP (H2O, P, t_seri -> aerosol composition (R2SO4)) 
        ! H2SO4 mass fraction in aerosol (%)
@@ -132,9 +131,9 @@
        ! aerosol density (gr/cm3)
        CALL denh2sa(t_seri)
+       
+       ! compute factor for converting dry to wet radius (for every grid box)
+       f_r_wet(:,:) = (dens_aer_dry/(DENSO4(:,:)*1000.)/(R2SO4(:,:)/100.))**(1./3.)
     ENDIF
     
-! compute factor for converting dry to wet radius (for every grid box)
-    f_r_wet(:,:) = (dens_aer_dry/(DENSO4(:,:)*1000.)/(R2SO4(:,:)/100.))**(1./3.)
-
 !--calculate mass of air in every grid box
     DO ilon=1, klon
@@ -348,4 +347,68 @@
     ENDDO
     
+!--compute 
+!     sulfmmr: Sulfate aerosol concentration (dry mixing ratio) (condensed H2SO4 mmr)
+!     SAD_sulfate: SAD all aerosols (cm2/cm3) (must be WET)
+!     sulfmmr_mode: sulfate(=H2SO4 if dry) MMR in different modes (ambiguous but based on sulfmmr, it mus be DRY(?) mmr)
+!     nd_mode: DRY(?) particle concentration in different modes (part/m3)
+     sulfmmr(:,:)=0.0
+     SAD_sulfate(:,:)=0.0
+     sulfmmr_mode(:,:,:)=0.0
+     nd_mode(:,:,:)=0.0
+     reff_sulfate(:,:)=0.0
+     
+     DO i=1,klon
+        DO j=1,klev
+           samoment2=0.0
+           samoment3=0.0
+           DO it=1, nbtr_bin
+              !surf_PM25_sulf(i)=surf_PM25_sulf(i)+tr_seri(i,1,it+nbtr_sulgas)*m_part(i,1,it) &
+              !assume that particles consist of ammonium sulfate at the surface (132g/mol) 
+              !and are dry at T = 20 deg. C and 50 perc. humidity
+              
+              !     sulfmmr_mode: sulfate(=H2SO4 if dry) MMR in different modes (based on sulfmmr, it must be DRY mmr)
+              !     equivalent to condensed H2SO4 mmr= H2SO4 kg / kgA in bin it
+              sulfmmr_mode(i,j,it) = tr_seri(i,j,it+nbtr_sulgas) &        ! [DRY part/kgA in bin it] 
+                   &  *(4./3.)*RPI*(mdw(it)/2.)**3.   &                   ! [mdw: dry diameter in m] 
+                   &  *dens_aer_dry                                       ! [dry aerosol mass density in kg/m3] 
+              
+              !     sulfmmr: Sulfate aerosol concentration (dry mass mixing ratio) 
+              !     equivalent to total condensed H2SO4 mmr (H2SO4 kg / kgA
+              sulfmmr(i,j) = sulfmmr(i,j) + sulfmmr_mode(i,j,it)
+              
+              !     nd_mode: particle concentration in different modes (DRY part/m3)
+              nd_mode(i,j,it) = tr_seri(i,j,it+nbtr_sulgas) &             ! [DRY part/kgA in bin it] 
+                   & *pplay(i,j)/t_seri(i,j)/RD                           ! [air mass concentration in kg air /m3A]
+              
+              IF(flag_new_strat_compo) THEN
+                 !     SAD_sulfate: SAD WET sulfate aerosols (cm2/cm3)
+                 SAD_sulfate(i,j) = SAD_sulfate(i,j) + nd_mode(i,j,it) &     ! [DRY part/m3A (in bin it)] 
+                      &  *4.*RPI*( mdw(it)*f_r_wetB(i,j,it)/2. )**2. &       ! [WET SA of part it in m2] 
+                      &  *1.e-2                                              ! conversion from m2/m3 to cm2/cm3A
+!    samoment2 : 2nd order moment of WET sulfate aerosols (m2/m3)
+                 samoment2 = samoment2 + nd_mode(i,j,it) &     ! [DRY part/m3A (in bin it)]
+                      &  *( mdw(it)*f_r_wetB(i,j,it)/2. )**2.                     ! [WET SA of part it in m2]
+!    samoment3 : 3nd order moment of WET sulfate aerosols (cm2/cm3)
+                 samoment3 = samoment3 + nd_mode(i,j,it) &     ! [DRY part/m3A (in bin it)]
+                      &  *( mdw(it)*f_r_wetB(i,j,it)/2. )**3.                     ! [WET SA of part it in m2]
+              ELSE
+!     SAD_sulfate: SAD WET sulfate aerosols (cm2/cm3)
+                 SAD_sulfate(i,j) = SAD_sulfate(i,j) + nd_mode(i,j,it) &     ! [DRY part/m3A (in bin it)] 
+                      &  *4.*RPI*( mdw(it)*f_r_wet(i,j)/2. )**2. &           ! [WET SA of part it in m2] 
+                      &  *1.e-2                                              ! conversion from m2/m3 to cm2/cm3A
+!    samoment2 : 2nd order moment of WET sulfate aerosols (m2/m3)
+                 samoment2 = samoment2 + nd_mode(i,j,it) &     ! [DRY part/m3A (in bin it)]
+                      &  *( mdw(it)*f_r_wet(i,j)/2. )**2.                          ! [WET SA of part it in m2]
+!    samoment3 : 3nd order moment of WET sulfate aerosols (cm2/cm3)
+                 samoment3 = samoment3 + nd_mode(i,j,it) &     ! [DRY part/m3A (in bin it)]
+                      &  *( mdw(it)*f_r_wet(i,j)/2. )**3.                          ! [WET SA of part it in m2]
+              ENDIF
+           ENDDO
+!     reff_sulfate: effective radius of WET sulfate aerosols (cm)
+           reff_sulfate(i,j) = (samoment3 / samoment2) &
+                & *1.e2                                              ! conversion from m to cm
+        ENDDO
+     ENDDO
+     
   END SUBROUTINE traccoag
 
Index: /LMDZ6/branches/cirrus/libf/phylmd/add_phys_tend_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/add_phys_tend_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/add_phys_tend_mod.F90	(revision 5202)
@@ -774,5 +774,5 @@
       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
+  CASE("bsss") param
       bilq_bnd = - bs_fall(1)
       bilh_bnd = (-(rcs-rcpd)*t_seri(1,1) + rlstt) * bs_fall(1)
Index: /LMDZ6/branches/cirrus/libf/phylmd/cdrag_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/cdrag_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/cdrag_mod.F90	(revision 5202)
@@ -23,4 +23,6 @@
 
   USE dimphy
+  USE coare_cp_mod, ONLY: coare_cp
+  USE coare30_flux_cnrm_mod, ONLY: coare30_flux_cnrm
   USE indice_sol_mod
   USE print_control_mod, ONLY: lunout, prt_level
@@ -341,8 +343,16 @@
          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) 
+         block
+           real, dimension(1) :: z0m_1d, z_0h_1d, sqrt_zdu2_1d, zgeop1_rg_1d  ! convert scalar to 1D for call
+           z0m_1d = z0m
+           z_0h_1d = z0h
+           sqrt_zdu2_1d = sqrt(zdu2)
+           zgeop1_rg_1d=zgeop1(i)/RG
+           call coare30_flux_cnrm(z0m_1d,t1(i),tsurf(i), q1(i),  &
+               sqrt_zdu2_1d,zgeop1_rg_1d,zgeop1_rg_1d,psol(i),qsurf(i),PQSAT, &
+               PSFTH,PFSTQ,PUSTAR,PCD,PCDN,PCH,PCE,PRI, &
+               PRESA,prain,pat1(i),z_0h_1d, LPRECIP, LPWG, coeffs)
+
+         end block
          cdmm(i) = coeffs(1)
          cdhh(i) = coeffs(2)
Index: /LMDZ6/branches/cirrus/libf/phylmd/clesphys.h
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/clesphys.h	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/clesphys.h	(revision 5202)
@@ -110,4 +110,7 @@
        LOGICAL :: ok_3Deffect
 
+!OB flag to activate water mass fixer in physiq
+       LOGICAL :: ok_water_mass_fixer
+
        COMMON/clesphys/                                                 &
 ! REAL FIRST
@@ -161,5 +164,5 @@
      &     , iflag_phytrac, ok_new_lscp, ok_bs, ok_rad_bs               &
      &     ,  iflag_thermals,nsplit_thermals, tau_thermals              &
-     &     , iflag_physiq, ok_3Deffect
+     &     , iflag_physiq, ok_3Deffect, ok_water_mass_fixer
        save /clesphys/
 !$OMP THREADPRIVATE(/clesphys/)
Index: DZ6/branches/cirrus/libf/phylmd/coare30_flux_cnrm.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/coare30_flux_cnrm.F90	(revision 5201)
+++ 	(revision )
@@ -1,631 +1,0 @@
-!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/cirrus/libf/phylmd/coare30_flux_cnrm_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/coare30_flux_cnrm_mod.F90	(revision 5202)
+++ /LMDZ6/branches/cirrus/libf/phylmd/coare30_flux_cnrm_mod.F90	(revision 5202)
@@ -0,0 +1,598 @@
+!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 coare30_flux_cnrm_mod
+  implicit none
+  private
+  public COARE30_FLUX_CNRM
+
+contains
+
+
+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 coare_cp_mod, ONLY: PSIFCTT=>psit_30, PSIFCTU=>psiuo
+
+!--------------------------------
+
+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
+!
+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(1)/ZL10(1)))
+ZTSR(:) = -ZDT(:)*XKARMAN/(LOG(PZREF(:)/ZOT10(:))-PSIFCTT(PZREF(1)/ZL10(1)))
+ZQSR(:) = -ZDQ(:)*XKARMAN/(LOG(PZREF(:)/ZOT10(:))-PSIFCTT(PZREF(1)/ZL10(1)))
+!
+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>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(1))
+  ZPTZ(:) = PSIFCTT(ZZTL(1))
+  !
+  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
+
+end module coare30_flux_cnrm_mod
Index: DZ6/branches/cirrus/libf/phylmd/coare_cp.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/coare_cp.F90	(revision 5201)
+++ 	(revision )
@@ -1,252 +1,0 @@
-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/cirrus/libf/phylmd/coare_cp_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/coare_cp_mod.F90	(revision 5202)
+++ /LMDZ6/branches/cirrus/libf/phylmd/coare_cp_mod.F90	(revision 5202)
@@ -0,0 +1,249 @@
+module coare_cp_mod
+  implicit none
+  private
+  public psit_30, psiuo, coare_cp
+
+contains
+
+  real function psit_30(zet)
+    implicit none
+    real, intent(in) :: zet
+
+    real :: x, psik, psic, f, c
+
+    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)
+    implicit none
+    real, intent(in) :: zet
+
+    real :: x, psik, psic, f, c
+
+    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
+
+
+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 :: 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 < 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 > 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 > 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
+
+end module coare_cp_mod
Index: /LMDZ6/branches/cirrus/libf/phylmd/ecrad/lmdz/calcul_cloud_overlap_decorr_len.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/ecrad/lmdz/calcul_cloud_overlap_decorr_len.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/ecrad/lmdz/calcul_cloud_overlap_decorr_len.F90	(revision 5202)
@@ -146,7 +146,7 @@
 !  ENDIF
 ENDIF
-CALL writefield_phy('latitude',latitude_deg,1)
-CALL writefield_phy('pressure_hl',pressure_hl,klev+1)
-CALL writefield_phy('Ldecorel',PDECORR_LEN_EDGES_M,klev)
+!CALL writefield_phy('latitude',latitude_deg,1)
+!CALL writefield_phy('pressure_hl',pressure_hl,klev+1)
+!CALL writefield_phy('Ldecorel',PDECORR_LEN_EDGES_M,klev)
 ! -------------------------------------------------------------------
 
Index: /LMDZ6/branches/cirrus/libf/phylmd/ecrad/lmdz/radiation_setup.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/ecrad/lmdz/radiation_setup.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/ecrad/lmdz/radiation_setup.F90	(revision 5202)
@@ -141,5 +141,4 @@
            &  -9, &
            &   4 /)
-!   rad_config%aerosol_optics_override_file_name = 'aerosol_optics_lmdz.nc'
 
 
Index: /LMDZ6/branches/cirrus/libf/phylmd/ecrad/lmdz/readaerosol_optic_ecrad.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/ecrad/lmdz/readaerosol_optic_ecrad.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/ecrad/lmdz/readaerosol_optic_ecrad.F90	(revision 5202)
@@ -4,5 +4,5 @@
      flag_aerosol, flag_bc_internal_mixture, itap, rjourvrai, &
      pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
-     tr_seri, mass_solu_aero, mass_solu_aero_pi) 
+     tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer) 
 !     tau_aero, piz_aero, cg_aero, &
 !     tausum_aero, drytausum_aero, tau3d_aero )
@@ -18,5 +18,5 @@
        concso4,concno3,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, &
        loadno3,load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7, & 
-       load_tmp8,load_tmp9,load_tmp10,m_allaer
+       load_tmp8,load_tmp9,load_tmp10
 
   USE infotrac_phy, ONLY: tracers, nqtot, nbtr
@@ -49,4 +49,8 @@
   REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero    ! Total mass for all soluble aerosols
   REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero_pi !     -"-     preindustrial values
+  REAL, DIMENSION(klon,klev,naero_tot), INTENT(OUT) :: m_allaer
+  ! AI a passer par la suite en argument si besoin pour ecrad
+  !REAL, DIMENSION(klon,klev,naero_tot), INTENT(OUT) :: m_allaer_pi !RAF
+
 !  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: tau_aero    ! Aerosol optical thickness
 !  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: piz_aero    ! Single scattering albedo aerosol
@@ -86,6 +90,5 @@
   REAL, DIMENSION(klon,klev)   :: nitrinscoarse_pi
   REAL, DIMENSION(klon,klev)   :: pdel, zrho
-!  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
-  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer_pi !RAF  
+  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer_pi
 
   integer :: id_ASBCM, id_ASPOMM, id_ASSO4M, id_ASMSAM, id_CSSO4M, id_CSMSAM, id_SSSSM
Index: /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_mcica_lw.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_mcica_lw.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_mcica_lw.F90	(revision 5202)
@@ -18,6 +18,4 @@
 !   2017-07-12  R. Hogan  Call fast adding method if only clouds scatter
 !   2017-10-23  R. Hogan  Renamed single-character variables
-
-#include "ecrad_config.h"
 
 module radiation_mcica_lw
@@ -126,11 +124,4 @@
     ! Identify clear-sky layers
     logical :: is_clear_sky_layer(nlev)
-
-    ! Temporary storage for more efficient summation
-#ifdef DWD_REDUCTION_OPTIMIZATIONS
-    real(jprb), dimension(nlev+1,2) :: sum_aux
-#else
-    real(jprb) :: sum_up, sum_dn
-#endif
 
     ! Index of the highest cloudy layer
@@ -188,28 +179,6 @@
 
       ! Sum over g-points to compute broadband fluxes
-#ifdef DWD_REDUCTION_OPTIMIZATIONS
-      sum_aux(:,:) = 0.0_jprb
-      do jg = 1,ng
-        do jlev = 1,nlev+1
-          sum_aux(jlev,1) = sum_aux(jlev,1) + flux_up_clear(jg,jlev)
-          sum_aux(jlev,2) = sum_aux(jlev,2) + flux_dn_clear(jg,jlev)
-        end do
-      end do
-      flux%lw_up_clear(jcol,:) = sum_aux(:,1)
-      flux%lw_dn_clear(jcol,:) = sum_aux(:,2)
-#else
-      do jlev = 1,nlev+1
-        sum_up = 0.0_jprb
-        sum_dn = 0.0_jprb
-        !$omp simd reduction(+:sum_up, sum_dn)
-        do jg = 1,ng
-          sum_up = sum_up + flux_up_clear(jg,jlev)
-          sum_dn = sum_dn + flux_dn_clear(jg,jlev)
-        end do
-        flux%lw_up_clear(jcol,jlev) = sum_up
-        flux%lw_dn_clear(jcol,jlev) = sum_dn
-      end do
-#endif
-
+      flux%lw_up_clear(jcol,:) = sum(flux_up_clear,1)
+      flux%lw_dn_clear(jcol,:) = sum(flux_dn_clear,1)
       ! Store surface spectral downwelling fluxes
       flux%lw_dn_surf_clear_g(:,jcol) = flux_dn_clear(:,nlev+1)
@@ -310,10 +279,8 @@
           else
             ! Clear-sky layer: copy over clear-sky values
-            do jg = 1,ng
-              reflectance(jg,jlev) = ref_clear(jg,jlev)
-              transmittance(jg,jlev) = trans_clear(jg,jlev)
-              source_up(jg,jlev) = source_up_clear(jg,jlev)
-              source_dn(jg,jlev) = source_dn_clear(jg,jlev)
-            end do
+            reflectance(:,jlev) = ref_clear(:,jlev)
+            transmittance(:,jlev) = trans_clear(:,jlev)
+            source_up(:,jlev) = source_up_clear(:,jlev)
+            source_dn(:,jlev) = source_dn_clear(:,jlev)
           end if
         end do
@@ -340,36 +307,13 @@
         
         ! Store overcast broadband fluxes
-#ifdef DWD_REDUCTION_OPTIMIZATIONS
-        sum_aux(:,:) = 0._jprb
-        do jg = 1, ng
-          do jlev = 1, nlev+1
-            sum_aux(jlev,1) = sum_aux(jlev,1) + flux_up(jg,jlev)
-            sum_aux(jlev,2) = sum_aux(jlev,2) + flux_dn(jg,jlev)
-          end do
-        end do
-        flux%lw_up(jcol,:) = sum_aux(:,1)
-        flux%lw_dn(jcol,:) = sum_aux(:,2)
-#else
-        do jlev = 1,nlev+1
-          sum_up = 0.0_jprb
-          sum_dn = 0.0_jprb
-          !$omp simd reduction(+:sum_up, sum_dn)
-          do jg = 1,ng
-            sum_up = sum_up + flux_up(jg,jlev)
-            sum_dn = sum_dn + flux_dn(jg,jlev)
-          end do
-          flux%lw_up(jcol,jlev) = sum_up
-          flux%lw_dn(jcol,jlev) = sum_dn
-        end do
-#endif
+        flux%lw_up(jcol,:) = sum(flux_up,1)
+        flux%lw_dn(jcol,:) = sum(flux_dn,1)
 
         ! Cloudy flux profiles currently assume completely overcast
         ! skies; perform weighted average with clear-sky profile
-        do jlev = 1,nlev+1
-          flux%lw_up(jcol,jlev) =  total_cloud_cover *flux%lw_up(jcol,jlev) &
-             &       + (1.0_jprb - total_cloud_cover)*flux%lw_up_clear(jcol,jlev)
-          flux%lw_dn(jcol,jlev) =  total_cloud_cover *flux%lw_dn(jcol,jlev) &
-             &       + (1.0_jprb - total_cloud_cover)*flux%lw_dn_clear(jcol,jlev)
-        end do
+        flux%lw_up(jcol,:) =  total_cloud_cover *flux%lw_up(jcol,:) &
+             &  + (1.0_jprb - total_cloud_cover)*flux%lw_up_clear(jcol,:)
+        flux%lw_dn(jcol,:) =  total_cloud_cover *flux%lw_dn(jcol,:) &
+             &  + (1.0_jprb - total_cloud_cover)*flux%lw_dn_clear(jcol,:)
         ! Store surface spectral downwelling fluxes
         flux%lw_dn_surf_g(:,jcol) = total_cloud_cover*flux_dn(:,nlev+1) &
@@ -391,8 +335,6 @@
         ! No cloud in profile and clear-sky fluxes already
         ! calculated: copy them over
-        do jlev = 1,nlev+1
-          flux%lw_up(jcol,jlev) = flux%lw_up_clear(jcol,jlev)
-          flux%lw_dn(jcol,jlev) = flux%lw_dn_clear(jcol,jlev)
-        end do
+        flux%lw_up(jcol,:) = flux%lw_up_clear(jcol,:)
+        flux%lw_dn(jcol,:) = flux%lw_dn_clear(jcol,:)
         flux%lw_dn_surf_g(:,jcol) = flux%lw_dn_surf_clear_g(:,jcol)
         if (config%do_lw_derivatives) then
Index: /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_mcica_sw.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_mcica_sw.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_mcica_sw.F90	(revision 5202)
@@ -17,6 +17,4 @@
 !   2017-04-22  R. Hogan  Store surface fluxes at all g-points
 !   2017-10-23  R. Hogan  Renamed single-character variables
-
-#include "ecrad_config.h"
 
 module radiation_mcica_sw
@@ -121,11 +119,4 @@
     ! Total cloud cover output from the cloud generator
     real(jprb) :: total_cloud_cover
-
-    ! Temporary storage for more efficient summation
-#ifdef DWD_REDUCTION_OPTIMIZATIONS
-    real(jprb), dimension(nlev+1,3) :: sum_aux
-#else
-    real(jprb) :: sum_up, sum_dn_diff, sum_dn_dir
-#endif
 
     ! Number of g points
@@ -184,47 +175,18 @@
         
         ! Sum over g-points to compute and save clear-sky broadband
-        ! fluxes. Note that the built-in "sum" function is very slow,
-        ! and before being replaced by the alternatives below
-        ! accounted for around 40% of the total cost of this routine.
-#ifdef DWD_REDUCTION_OPTIMIZATIONS
-        ! Optimized summation for the NEC architecture
-        sum_aux(:,:) = 0.0_jprb
-        do jg = 1,ng
-          do jlev = 1,nlev+1
-            sum_aux(jlev,1) = sum_aux(jlev,1) + flux_up(jg,jlev)
-            sum_aux(jlev,2) = sum_aux(jlev,2) + flux_dn_direct(jg,jlev)
-            sum_aux(jlev,3) = sum_aux(jlev,3) + flux_dn_diffuse(jg,jlev)
-          end do
-        end do
-        flux%sw_up_clear(jcol,:) = sum_aux(:,1)
-        flux%sw_dn_clear(jcol,:) = sum_aux(:,2) + sum_aux(:,3)
+        ! fluxes
+        flux%sw_up_clear(jcol,:) = sum(flux_up,1)
         if (allocated(flux%sw_dn_direct_clear)) then
-          flux%sw_dn_direct_clear(jcol,:) = sum_aux(:,2)
+          flux%sw_dn_direct_clear(jcol,:) &
+               &  = sum(flux_dn_direct,1)
+          flux%sw_dn_clear(jcol,:) = sum(flux_dn_diffuse,1) &
+               &  + flux%sw_dn_direct_clear(jcol,:)
+        else
+          flux%sw_dn_clear(jcol,:) = sum(flux_dn_diffuse,1) &
+               &  + sum(flux_dn_direct,1)
         end if
-#else
-        ! Optimized summation for the x86-64 architecture
-        do jlev = 1,nlev+1
-          sum_up      = 0.0_jprb
-          sum_dn_diff = 0.0_jprb
-          sum_dn_dir  = 0.0_jprb
-          !$omp simd reduction(+:sum_up, sum_dn_diff, sum_dn_dir)
-          do jg = 1,ng
-            sum_up      = sum_up      + flux_up(jg,jlev)
-            sum_dn_diff = sum_dn_diff + flux_dn_diffuse(jg,jlev)
-            sum_dn_dir  = sum_dn_dir  + flux_dn_direct(jg,jlev)
-          end do
-          flux%sw_up_clear(jcol,jlev) = sum_up
-          flux%sw_dn_clear(jcol,jlev) = sum_dn_diff + sum_dn_dir
-          if (allocated(flux%sw_dn_direct_clear)) then
-            flux%sw_dn_direct_clear(jcol,jlev) = sum_dn_dir
-          end if
-        end do
-#endif
-        
         ! Store spectral downwelling fluxes at surface
-        do jg = 1,ng
-          flux%sw_dn_diffuse_surf_clear_g(jg,jcol) = flux_dn_diffuse(jg,nlev+1)
-          flux%sw_dn_direct_surf_clear_g(jg,jcol)  = flux_dn_direct(jg,nlev+1)
-        end do
+        flux%sw_dn_diffuse_surf_clear_g(:,jcol) = flux_dn_diffuse(:,nlev+1)
+        flux%sw_dn_direct_surf_clear_g(:,jcol)  = flux_dn_direct(:,nlev+1)
 
         ! Do cloudy-sky calculation
@@ -287,11 +249,9 @@
             else
               ! Clear-sky layer: copy over clear-sky values
-              do jg = 1,ng
-                reflectance(jg,jlev) = ref_clear(jg,jlev)
-                transmittance(jg,jlev) = trans_clear(jg,jlev)
-                ref_dir(jg,jlev) = ref_dir_clear(jg,jlev)
-                trans_dir_diff(jg,jlev) = trans_dir_diff_clear(jg,jlev)
-                trans_dir_dir(jg,jlev) = trans_dir_dir_clear(jg,jlev)
-              end do
+              reflectance(:,jlev) = ref_clear(:,jlev)
+              transmittance(:,jlev) = trans_clear(:,jlev)
+              ref_dir(:,jlev) = ref_dir_clear(:,jlev)
+              trans_dir_diff(:,jlev) = trans_dir_diff_clear(:,jlev)
+              trans_dir_dir(:,jlev) = trans_dir_dir_clear(:,jlev)
             end if
           end do
@@ -304,73 +264,42 @@
           
           ! Store overcast broadband fluxes
-#ifdef DWD_REDUCTION_OPTIMIZATIONS
-          sum_aux(:,:) = 0.0_jprb
-          do jg = 1,ng
-            do jlev = 1,nlev+1
-              sum_aux(jlev,1) = sum_aux(jlev,1) + flux_up(jg,jlev)
-              sum_aux(jlev,2) = sum_aux(jlev,2) + flux_dn_direct(jg,jlev)
-              sum_aux(jlev,3) = sum_aux(jlev,3) + flux_dn_diffuse(jg,jlev)
-            end do
-          end do
-          flux%sw_up(jcol,:) = sum_aux(:,1)
-          flux%sw_dn(jcol,:) = sum_aux(:,2) + sum_aux(:,3)
+          flux%sw_up(jcol,:) = sum(flux_up,1)
           if (allocated(flux%sw_dn_direct)) then
-            flux%sw_dn_direct(jcol,:) = sum_aux(:,2)
+            flux%sw_dn_direct(jcol,:) = sum(flux_dn_direct,1)
+            flux%sw_dn(jcol,:) = sum(flux_dn_diffuse,1) &
+                 &  + flux%sw_dn_direct(jcol,:)
+          else
+            flux%sw_dn(jcol,:) = sum(flux_dn_diffuse,1) &
+                 &  + sum(flux_dn_direct,1)
           end if
-#else
-          do jlev = 1,nlev+1
-            sum_up      = 0.0_jprb
-            sum_dn_diff = 0.0_jprb
-            sum_dn_dir  = 0.0_jprb
-            !$omp simd reduction(+:sum_up, sum_dn_diff, sum_dn_dir)
-            do jg = 1,ng
-              sum_up      = sum_up      + flux_up(jg,jlev)
-              sum_dn_diff = sum_dn_diff + flux_dn_diffuse(jg,jlev)
-              sum_dn_dir  = sum_dn_dir  + flux_dn_direct(jg,jlev)
-            end do
-            flux%sw_up(jcol,jlev) = sum_up
-            flux%sw_dn(jcol,jlev) = sum_dn_diff + sum_dn_dir
-            if (allocated(flux%sw_dn_direct)) then
-              flux%sw_dn_direct(jcol,jlev) = sum_dn_dir
-            end if
-          end do
-#endif
-          
+
           ! Cloudy flux profiles currently assume completely overcast
           ! skies; perform weighted average with clear-sky profile
-          do jlev = 1, nlev+1
-            flux%sw_up(jcol,jlev) =  total_cloud_cover *flux%sw_up(jcol,jlev) &
-                 &     + (1.0_jprb - total_cloud_cover)*flux%sw_up_clear(jcol,jlev)
-            flux%sw_dn(jcol,jlev) =  total_cloud_cover *flux%sw_dn(jcol,jlev) &
-                 &     + (1.0_jprb - total_cloud_cover)*flux%sw_dn_clear(jcol,jlev)
-            if (allocated(flux%sw_dn_direct)) then
-              flux%sw_dn_direct(jcol,jlev) = total_cloud_cover *flux%sw_dn_direct(jcol,jlev) &
-                   &  + (1.0_jprb - total_cloud_cover)*flux%sw_dn_direct_clear(jcol,jlev)
-            end if
-          end do
+          flux%sw_up(jcol,:) =  total_cloud_cover *flux%sw_up(jcol,:) &
+               &  + (1.0_jprb - total_cloud_cover)*flux%sw_up_clear(jcol,:)
+          flux%sw_dn(jcol,:) =  total_cloud_cover *flux%sw_dn(jcol,:) &
+               &  + (1.0_jprb - total_cloud_cover)*flux%sw_dn_clear(jcol,:)
+          if (allocated(flux%sw_dn_direct)) then
+            flux%sw_dn_direct(jcol,:) = total_cloud_cover *flux%sw_dn_direct(jcol,:) &
+                 &  + (1.0_jprb - total_cloud_cover)*flux%sw_dn_direct_clear(jcol,:)
+          end if
           ! Likewise for surface spectral fluxes
-          do jg = 1,ng
-            flux%sw_dn_diffuse_surf_g(jg,jcol) = flux_dn_diffuse(jg,nlev+1)
-            flux%sw_dn_direct_surf_g(jg,jcol)  = flux_dn_direct(jg,nlev+1)
-            flux%sw_dn_diffuse_surf_g(jg,jcol) = total_cloud_cover *flux%sw_dn_diffuse_surf_g(jg,jcol) &
-                 &                 + (1.0_jprb - total_cloud_cover)*flux%sw_dn_diffuse_surf_clear_g(jg,jcol)
-            flux%sw_dn_direct_surf_g(jg,jcol)  = total_cloud_cover *flux%sw_dn_direct_surf_g(jg,jcol) &
-                 &                 + (1.0_jprb - total_cloud_cover)*flux%sw_dn_direct_surf_clear_g(jg,jcol)
-          end do
-
+          flux%sw_dn_diffuse_surf_g(:,jcol) = flux_dn_diffuse(:,nlev+1)
+          flux%sw_dn_direct_surf_g(:,jcol)  = flux_dn_direct(:,nlev+1)
+          flux%sw_dn_diffuse_surf_g(:,jcol) = total_cloud_cover *flux%sw_dn_diffuse_surf_g(:,jcol) &
+               &     + (1.0_jprb - total_cloud_cover)*flux%sw_dn_diffuse_surf_clear_g(:,jcol)
+          flux%sw_dn_direct_surf_g(:,jcol) = total_cloud_cover *flux%sw_dn_direct_surf_g(:,jcol) &
+               &     + (1.0_jprb - total_cloud_cover)*flux%sw_dn_direct_surf_clear_g(:,jcol)
+          
         else
           ! No cloud in profile and clear-sky fluxes already
           ! calculated: copy them over
-          do jlev = 1, nlev+1
-            flux%sw_up(jcol,jlev) = flux%sw_up_clear(jcol,jlev)
-            flux%sw_dn(jcol,jlev) = flux%sw_dn_clear(jcol,jlev)
-            if (allocated(flux%sw_dn_direct)) then
-              flux%sw_dn_direct(jcol,jlev) = flux%sw_dn_direct_clear(jcol,jlev)
-            end if
-          end do
-          do jg = 1,ng
-            flux%sw_dn_diffuse_surf_g(jg,jcol) = flux%sw_dn_diffuse_surf_clear_g(jg,jcol)
-            flux%sw_dn_direct_surf_g(jg,jcol)  = flux%sw_dn_direct_surf_clear_g(jg,jcol)
-          end do
+          flux%sw_up(jcol,:) = flux%sw_up_clear(jcol,:)
+          flux%sw_dn(jcol,:) = flux%sw_dn_clear(jcol,:)
+          if (allocated(flux%sw_dn_direct)) then
+            flux%sw_dn_direct(jcol,:) = flux%sw_dn_direct_clear(jcol,:)
+          end if
+          flux%sw_dn_diffuse_surf_g(:,jcol) = flux%sw_dn_diffuse_surf_clear_g(:,jcol)
+          flux%sw_dn_direct_surf_g(:,jcol)  = flux%sw_dn_direct_surf_clear_g(:,jcol)
 
         end if ! Cloud is present in profile
@@ -378,22 +307,18 @@
       else
         ! Set fluxes to zero if sun is below the horizon
-        do jlev = 1, nlev+1
-          flux%sw_up(jcol,jlev) = 0.0_jprb
-          flux%sw_dn(jcol,jlev) = 0.0_jprb
-          if (allocated(flux%sw_dn_direct)) then
-            flux%sw_dn_direct(jcol,jlev) = 0.0_jprb
-          end if
-          flux%sw_up_clear(jcol,jlev) = 0.0_jprb
-          flux%sw_dn_clear(jcol,jlev) = 0.0_jprb
-          if (allocated(flux%sw_dn_direct_clear)) then
-            flux%sw_dn_direct_clear(jcol,jlev) = 0.0_jprb
-          end if
-        end do
-        do jg = 1,ng
-          flux%sw_dn_diffuse_surf_g(jg,jcol) = 0.0_jprb
-          flux%sw_dn_direct_surf_g(jg,jcol)  = 0.0_jprb
-          flux%sw_dn_diffuse_surf_clear_g(jg,jcol) = 0.0_jprb
-          flux%sw_dn_direct_surf_clear_g(jg,jcol)  = 0.0_jprb
-        end do
+        flux%sw_up(jcol,:) = 0.0_jprb
+        flux%sw_dn(jcol,:) = 0.0_jprb
+        if (allocated(flux%sw_dn_direct)) then
+          flux%sw_dn_direct(jcol,:) = 0.0_jprb
+        end if
+        flux%sw_up_clear(jcol,:) = 0.0_jprb
+        flux%sw_dn_clear(jcol,:) = 0.0_jprb
+        if (allocated(flux%sw_dn_direct_clear)) then
+          flux%sw_dn_direct_clear(jcol,:) = 0.0_jprb
+        end if
+        flux%sw_dn_diffuse_surf_g(:,jcol) = 0.0_jprb
+        flux%sw_dn_direct_surf_g(:,jcol)  = 0.0_jprb
+        flux%sw_dn_diffuse_surf_clear_g(:,jcol) = 0.0_jprb
+        flux%sw_dn_direct_surf_clear_g(:,jcol)  = 0.0_jprb
       end if ! Sun above horizon
 
Index: /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_tripleclouds_lw.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_tripleclouds_lw.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_tripleclouds_lw.F90	(revision 5202)
@@ -170,7 +170,4 @@
     logical :: is_clear_sky_layer(0:nlev+1)
 
-    ! Temporaries to speed up summations
-    real(jprb) :: sum_dn, sum_up
-    
     ! Index of the highest cloudy layer
     integer :: i_cloud_top
@@ -264,21 +261,9 @@
       if (config%do_clear) then
         ! Sum over g-points to compute broadband fluxes
-        do jlev = 1,nlev+1
-          sum_up = 0.0_jprb
-          sum_dn = 0.0_jprb
-          !$omp simd reduction(+:sum_up, sum_dn)
-          do jg = 1,ng
-            sum_up = sum_up + flux_up_clear(jg,jlev)
-            sum_dn = sum_dn + flux_dn_clear(jg,jlev)
-          end do
-          flux%lw_up_clear(jcol,jlev) = sum_up
-          flux%lw_dn_clear(jcol,jlev) = sum_dn
-        end do
-
+        flux%lw_up_clear(jcol,:) = sum(flux_up_clear,1)
+        flux%lw_dn_clear(jcol,:) = sum(flux_dn_clear,1)
         ! Store surface spectral downwelling fluxes / TOA upwelling
-        do jg = 1,ng
-          flux%lw_dn_surf_clear_g(jg,jcol) = flux_dn_clear(jg,nlev+1)
-          flux%lw_up_toa_clear_g (jg,jcol) = flux_up_clear(jg,1)
-        end do
+        flux%lw_dn_surf_clear_g(:,jcol) = flux_dn_clear(:,nlev+1)
+        flux%lw_up_toa_clear_g (:,jcol) = flux_up_clear(:,1)
         ! Save the spectral fluxes if required
         if (config%do_save_spectral_flux) then
@@ -468,10 +453,5 @@
           end if
         else
-          sum_dn = 0.0_jprb
-          !$omp simd reduction(+:sum_dn)
-          do jg = 1,ng
-            sum_dn = sum_dn + flux_dn_clear(jg,jlev)
-          end do
-          flux%lw_dn(jcol,jlev) = sum_dn
+          flux%lw_dn(jcol,:) = sum(flux_dn_clear(:,jlev))
           if (config%do_save_spectral_flux) then
             call indexed_sum(flux_dn_clear(:,jlev), &
@@ -490,12 +470,5 @@
            &  + total_albedo(:,1,i_cloud_top)*flux_dn_clear(:,i_cloud_top)
       flux_up(:,2:) = 0.0_jprb
-
-      sum_up = 0.0_jprb
-      !$omp simd reduction(+:sum_up)
-      do jg = 1,ng
-        sum_up = sum_up + flux_up(jg,1)
-      end do
-      flux%lw_up(jcol,i_cloud_top) = sum_up
-
+      flux%lw_up(jcol,i_cloud_top) = sum(flux_up(:,1))
       if (config%do_save_spectral_flux) then
         call indexed_sum(flux_up(:,1), &
@@ -505,10 +478,5 @@
       do jlev = i_cloud_top-1,1,-1
         flux_up(:,1) = trans_clear(:,jlev)*flux_up(:,1) + source_up_clear(:,jlev)
-        sum_up = 0.0_jprb
-        !$omp simd reduction(+:sum_up)
-        do jg = 1,ng
-          sum_up = sum_up + flux_up(jg,1)
-        end do
-        flux%lw_up(jcol,jlev) = sum_up
+        flux%lw_up(jcol,jlev) = sum(flux_up(:,1))
         if (config%do_save_spectral_flux) then
           call indexed_sum(flux_up(:,1), &
@@ -560,15 +528,6 @@
 
         ! Store the broadband fluxes
-        sum_up = 0.0_jprb
-        sum_dn = 0.0_jprb
-        do jreg = 1,nregions
-          !$omp simd reduction(+:sum_up, sum_dn)
-          do jg = 1,ng
-            sum_up = sum_up + flux_up(jg,jreg)
-            sum_dn = sum_dn + flux_dn(jg,jreg)
-          end do
-        end do
-        flux%lw_up(jcol,jlev+1) = sum_up
-        flux%lw_dn(jcol,jlev+1) = sum_dn
+        flux%lw_up(jcol,jlev+1) = sum(sum(flux_up,1))
+        flux%lw_dn(jcol,jlev+1) = sum(sum(flux_dn,1))
 
         ! Save the spectral fluxes if required
Index: /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_tripleclouds_lw.F90.or
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_tripleclouds_lw.F90.or	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_tripleclouds_lw.F90.or	(revision 5202)
@@ -170,4 +170,7 @@
     logical :: is_clear_sky_layer(0:nlev+1)
 
+    ! Temporaries to speed up summations
+    real(jprb) :: sum_dn, sum_up
+    
     ! Index of the highest cloudy layer
     integer :: i_cloud_top
@@ -249,5 +252,5 @@
         call calc_ref_trans_lw(ng*nlev, &
              &  od(:,:,jcol), ssa(:,:,jcol), g(:,:,jcol), &
-             &  planck_hl(:,1:jlev,jcol), planck_hl(:,2:jlev+1,jcol), &
+             &  planck_hl(:,1:nlev,jcol), planck_hl(:,2:nlev+1,jcol), &
              &  ref_clear, trans_clear, &
              &  source_up_clear, source_dn_clear)
@@ -261,9 +264,21 @@
       if (config%do_clear) then
         ! Sum over g-points to compute broadband fluxes
-        flux%lw_up_clear(jcol,:) = sum(flux_up_clear,1)
-        flux%lw_dn_clear(jcol,:) = sum(flux_dn_clear,1)
+        do jlev = 1,nlev+1
+          sum_up = 0.0_jprb
+          sum_dn = 0.0_jprb
+          !$omp simd reduction(+:sum_up, sum_dn)
+          do jg = 1,ng
+            sum_up = sum_up + flux_up_clear(jg,jlev)
+            sum_dn = sum_dn + flux_dn_clear(jg,jlev)
+          end do
+          flux%lw_up_clear(jcol,jlev) = sum_up
+          flux%lw_dn_clear(jcol,jlev) = sum_dn
+        end do
+
         ! Store surface spectral downwelling fluxes / TOA upwelling
-        flux%lw_dn_surf_clear_g(:,jcol) = flux_dn_clear(:,nlev+1)
-        flux%lw_up_toa_clear_g (:,jcol) = flux_up_clear(:,1)
+        do jg = 1,ng
+          flux%lw_dn_surf_clear_g(jg,jcol) = flux_dn_clear(jg,nlev+1)
+          flux%lw_up_toa_clear_g (jg,jcol) = flux_up_clear(jg,1)
+        end do
         ! Save the spectral fluxes if required
         if (config%do_save_spectral_flux) then
@@ -453,5 +468,10 @@
           end if
         else
-          flux%lw_dn(jcol,:) = sum(flux_dn_clear(:,jlev))
+          sum_dn = 0.0_jprb
+          !$omp simd reduction(+:sum_dn)
+          do jg = 1,ng
+            sum_dn = sum_dn + flux_dn_clear(jg,jlev)
+          end do
+          flux%lw_dn(jcol,jlev) = sum_dn
           if (config%do_save_spectral_flux) then
             call indexed_sum(flux_dn_clear(:,jlev), &
@@ -470,5 +490,12 @@
            &  + total_albedo(:,1,i_cloud_top)*flux_dn_clear(:,i_cloud_top)
       flux_up(:,2:) = 0.0_jprb
-      flux%lw_up(jcol,i_cloud_top) = sum(flux_up(:,1))
+
+      sum_up = 0.0_jprb
+      !$omp simd reduction(+:sum_up)
+      do jg = 1,ng
+        sum_up = sum_up + flux_up(jg,1)
+      end do
+      flux%lw_up(jcol,i_cloud_top) = sum_up
+
       if (config%do_save_spectral_flux) then
         call indexed_sum(flux_up(:,1), &
@@ -478,5 +505,10 @@
       do jlev = i_cloud_top-1,1,-1
         flux_up(:,1) = trans_clear(:,jlev)*flux_up(:,1) + source_up_clear(:,jlev)
-        flux%lw_up(jcol,jlev) = sum(flux_up(:,1))
+        sum_up = 0.0_jprb
+        !$omp simd reduction(+:sum_up)
+        do jg = 1,ng
+          sum_up = sum_up + flux_up(jg,1)
+        end do
+        flux%lw_up(jcol,jlev) = sum_up
         if (config%do_save_spectral_flux) then
           call indexed_sum(flux_up(:,1), &
@@ -528,6 +560,15 @@
 
         ! Store the broadband fluxes
-        flux%lw_up(jcol,jlev+1) = sum(sum(flux_up,1))
-        flux%lw_dn(jcol,jlev+1) = sum(sum(flux_dn,1))
+        sum_up = 0.0_jprb
+        sum_dn = 0.0_jprb
+        do jreg = 1,nregions
+          !$omp simd reduction(+:sum_up, sum_dn)
+          do jg = 1,ng
+            sum_up = sum_up + flux_up(jg,jreg)
+            sum_dn = sum_dn + flux_dn(jg,jreg)
+          end do
+        end do
+        flux%lw_up(jcol,jlev+1) = sum_up
+        flux%lw_dn(jcol,jlev+1) = sum_dn
 
         ! Save the spectral fluxes if required
Index: /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_tripleclouds_sw.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_tripleclouds_sw.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_tripleclouds_sw.F90	(revision 5202)
@@ -74,11 +74,12 @@
     ! Gas and aerosol optical depth, single-scattering albedo and
     ! asymmetry factor at each shortwave g-point
-    real(jprb), intent(in), dimension(config%n_g_sw,nlev,istartcol:iendcol) &
-         &  :: od, ssa, g
+!    real(jprb), intent(in), dimension(istartcol:iendcol,nlev,config%n_g_sw) :: &
+    real(jprb), intent(in), dimension(config%n_g_sw,nlev,istartcol:iendcol) :: &
+         &  od, ssa, g
 
     ! Cloud and precipitation optical depth, single-scattering albedo and
     ! asymmetry factor in each shortwave band
-    real(jprb), intent(in), dimension(config%n_bands_sw,nlev,istartcol:iendcol) &
-         &  :: od_cloud, ssa_cloud, g_cloud
+    real(jprb), intent(in), dimension(config%n_bands_sw,nlev,istartcol:iendcol) :: &
+         &  od_cloud, ssa_cloud, g_cloud
 
     ! Optical depth, single scattering albedo and asymmetry factor in
@@ -91,6 +92,6 @@
     ! flux into a plane perpendicular to the incoming radiation at
     ! top-of-atmosphere in each of the shortwave g points
-    real(jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol) &
-         &  :: albedo_direct, albedo_diffuse, incoming_sw
+    real(jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol) :: &
+         &  albedo_direct, albedo_diffuse, incoming_sw
 
     ! Output
@@ -165,8 +166,4 @@
     real(jprb) :: scat_od, scat_od_cloud
 
-    ! Temporaries to speed up summations
-    real(jprb) :: sum_dn_diff, sum_dn_dir, sum_up
-
-    ! Local cosine of solar zenith angle
     real(jprb) :: mu0
 
@@ -447,33 +444,13 @@
       end if
       
-      ! Store the TOA broadband fluxes, noting that there is no
-      ! diffuse downwelling at TOA. The intrinsic "sum" command has
-      ! been found to be very slow; better performance is found on
-      ! x86-64 architecture with explicit loops and the "omp simd
-      ! reduction" directive.
-      sum_up     = 0.0_jprb
-      sum_dn_dir = 0.0_jprb
-      do jreg = 1,nregions
-        !$omp simd reduction(+:sum_up, sum_dn_dir)
-        do jg = 1,ng
-          sum_up     = sum_up     + flux_up(jg,jreg)
-          sum_dn_dir = sum_dn_dir + direct_dn(jg,jreg)
-        end do
-      end do
-      flux%sw_up(jcol,1) = sum_up
-      flux%sw_dn(jcol,1) = mu0 * sum_dn_dir
+      ! Store the TOA broadband fluxes
+      flux%sw_up(jcol,1) = sum(sum(flux_up,1))
+      flux%sw_dn(jcol,1) = mu0 * sum(sum(direct_dn,1))
       if (allocated(flux%sw_dn_direct)) then
         flux%sw_dn_direct(jcol,1) = flux%sw_dn(jcol,1)
       end if
       if (config%do_clear) then
-        sum_up     = 0.0_jprb
-        sum_dn_dir = 0.0_jprb
-        !$omp simd reduction(+:sum_up, sum_dn_dir)
-        do jg = 1,ng
-          sum_up     = sum_up     + flux_up_clear(jg)
-          sum_dn_dir = sum_dn_dir + direct_dn_clear(jg)
-        end do
-        flux%sw_up_clear(jcol,1) = sum_up
-        flux%sw_dn_clear(jcol,1) = mu0 * sum_dn_dir
+        flux%sw_up_clear(jcol,1) = sum(flux_up_clear)
+        flux%sw_dn_clear(jcol,1) = mu0 * sum(direct_dn_clear)
         if (allocated(flux%sw_dn_direct_clear)) then
           flux%sw_dn_direct_clear(jcol,1) = flux%sw_dn_clear(jcol,1)
@@ -490,5 +467,6 @@
              &           config%i_spec_from_reordered_g_sw, &
              &           flux%sw_dn_band(:,jcol,1))
-        flux%sw_dn_band(:,jcol,1) = mu0 * flux%sw_dn_band(:,jcol,1)
+        flux%sw_dn_band(:,jcol,1) = &
+             &  mu0 * flux%sw_dn_band(:,jcol,1)
         if (allocated(flux%sw_dn_direct_band)) then
           flux%sw_dn_direct_band(:,jcol,1) = flux%sw_dn_band(:,jcol,1)
@@ -571,38 +549,22 @@
                ! nothing to do
 
-        ! Store the broadband fluxes. The intrinsic "sum" command has
-        ! been found to be very slow; better performance is found on
-        ! x86-64 architecture with explicit loops and the "omp simd
-        ! reduction" directive.
-        sum_up      = 0.0_jprb
-        sum_dn_dir  = 0.0_jprb
-        sum_dn_diff = 0.0_jprb
-        do jreg = 1,nregions
-          !$omp simd reduction(+:sum_up, sum_dn_diff, sum_dn_dir)
-          do jg = 1,ng
-            sum_up      = sum_up      + flux_up(jg,jreg)
-            sum_dn_diff = sum_dn_diff + flux_dn(jg,jreg)
-            sum_dn_dir  = sum_dn_dir  + direct_dn(jg,jreg)
-          end do
-        end do
-        flux%sw_up(jcol,jlev+1) = sum_up
-        flux%sw_dn(jcol,jlev+1) = mu0 * sum_dn_dir + sum_dn_diff
+        ! Store the broadband fluxes
+        flux%sw_up(jcol,jlev+1) = sum(sum(flux_up,1))
         if (allocated(flux%sw_dn_direct)) then
-          flux%sw_dn_direct(jcol,jlev+1) = mu0 * sum_dn_dir
+          flux%sw_dn_direct(jcol,jlev+1) = mu0 * sum(sum(direct_dn,1))
+          flux%sw_dn(jcol,jlev+1) &
+               &  = flux%sw_dn_direct(jcol,jlev+1) + sum(sum(flux_dn,1))
+        else
+          flux%sw_dn(jcol,jlev+1) = mu0 * sum(sum(direct_dn,1)) + sum(sum(flux_dn,1))   
         end if
         if (config%do_clear) then
-          sum_up      = 0.0_jprb
-          sum_dn_dir  = 0.0_jprb
-          sum_dn_diff = 0.0_jprb
-          !$omp simd reduction(+:sum_up, sum_dn_diff, sum_dn_dir)
-          do jg = 1,ng
-            sum_up      = sum_up      + flux_up_clear(jg)
-            sum_dn_diff = sum_dn_diff + flux_dn_clear(jg)
-            sum_dn_dir  = sum_dn_dir  + direct_dn_clear(jg)
-          end do
-          flux%sw_up_clear(jcol,jlev+1) = sum_up
-          flux%sw_dn_clear(jcol,jlev+1) = mu0 * sum_dn_dir + sum_dn_diff
+          flux%sw_up_clear(jcol,jlev+1) = sum(flux_up_clear)
           if (allocated(flux%sw_dn_direct_clear)) then
-            flux%sw_dn_direct_clear(jcol,jlev+1) = mu0 * sum_dn_dir
+            flux%sw_dn_direct_clear(jcol,jlev+1) = mu0 * sum(direct_dn_clear)
+            flux%sw_dn_clear(jcol,jlev+1) &
+                 &  = flux%sw_dn_direct_clear(jcol,jlev+1) + sum(flux_dn_clear)
+          else
+            flux%sw_dn_clear(jcol,jlev+1) = mu0 * sum(direct_dn_clear) &
+                 &  + sum(flux_dn_clear)
           end if
         end if
@@ -643,4 +605,5 @@
           end if
         end if
+
       end do ! Final loop over levels
       
Index: /LMDZ6/branches/cirrus/libf/phylmd/fonte_neige_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/fonte_neige_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/fonte_neige_mod.F90	(revision 5202)
@@ -36,4 +36,18 @@
   REAL, ALLOCATABLE, DIMENSION(:)             :: runofflic_global
   !$OMP THREADPRIVATE(runofflic_global)
+#ifdef ISO
+  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: xtrun_off_ter
+  !$OMP THREADPRIVATE(xtrun_off_ter)
+  REAL, ALLOCATABLE, DIMENSION(:,:)           :: xtrun_off_lic
+  !$OMP THREADPRIVATE(xtrun_off_lic)
+  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: xtrun_off_lic_0 
+  !$OMP THREADPRIVATE(xtrun_off_lic_0)
+  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE:: fxtfonte_global
+  !$OMP THREADPRIVATE(fxtfonte_global)
+  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE:: fxtcalving_global
+  !$OMP THREADPRIVATE(fxtcalving_global)
+  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: xtrunofflic_global
+  !$OMP THREADPRIVATE(xtrunofflic_global)
+#endif
 
 CONTAINS
@@ -123,4 +137,93 @@
 
   END SUBROUTINE fonte_neige_init
+
+#ifdef ISO
+  SUBROUTINE fonte_neige_init_iso(xtrestart_runoff)
+
+! This subroutine allocates and initialize variables in the module. 
+! The variable run_off_lic_0 is initialized to the field read from
+! restart file. The other variables are initialized to zero.
+
+    USE infotrac_phy, ONLY: niso
+#ifdef ISOVERIF
+    USE isotopes_mod, ONLY: iso_eau,iso_HDO
+    USE isotopes_verif_mod
+#endif
+!
+!****************************************************************************************
+! Input argument
+    REAL, DIMENSION(niso,klon), INTENT(IN) :: xtrestart_runoff 
+
+! Local variables
+    INTEGER                           :: error
+    CHARACTER (len = 80)              :: abort_message 
+    CHARACTER (len = 20)              :: modname = 'fonte_neige_init'
+    INTEGER                           :: i
+
+
+!****************************************************************************************
+! Allocate run-off at landice and initilize with field read from restart
+!
+!****************************************************************************************
+
+    ALLOCATE(xtrun_off_lic_0(niso,klon), stat = error)
+    IF (error /= 0) THEN
+       abort_message='Pb allocation run_off_lic'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF    
+    
+    xtrun_off_lic_0(:,:) = xtrestart_runoff(:,:)        
+
+#ifdef ISOVERIF 
+      IF (iso_eau > 0) THEN   
+        CALL iso_verif_egalite_vect1D( &
+     &           xtrun_off_lic_0,run_off_lic_0,'fonte_neige 100', &
+     &           niso,klon)
+      ENDIF !IF (iso_eau > 0) THEN
+#endif        
+
+!****************************************************************************************
+! Allocate other variables and initilize to zero
+!
+!****************************************************************************************
+
+    ALLOCATE(xtrun_off_ter(niso,klon), stat = error)
+    IF (error /= 0) THEN
+       abort_message='Pb allocation xtrun_off_ter'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+    xtrun_off_ter(:,:) = 0.
+    
+    ALLOCATE(xtrun_off_lic(niso,klon), stat = error)
+    IF (error /= 0) THEN
+       abort_message='Pb allocation xtrun_off_lic'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+    xtrun_off_lic(:,:) = 0.
+
+    ALLOCATE(fxtfonte_global(niso,klon,nbsrf))
+    IF (error /= 0) THEN
+       abort_message='Pb allocation fxtfonte_global'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+    fxtfonte_global(:,:,:) = 0.0
+
+    ALLOCATE(fxtcalving_global(niso,klon,nbsrf))
+    IF (error /= 0) THEN
+       abort_message='Pb allocation fxtcalving_global'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+    fxtcalving_global(:,:,:) = 0.0
+
+    ALLOCATE(xtrunofflic_global(niso,klon))
+    IF (error /= 0) THEN
+       abort_message='Pb allocation xtrunofflic_global'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+    xtrunofflic_global(:,:) = 0.0
+
+  END SUBROUTINE fonte_neige_init_iso
+#endif
+
 !
 !****************************************************************************************
@@ -128,7 +231,19 @@
   SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
        tsurf, precip_rain, precip_snow, &
-       snow, qsol, tsurf_new, evap)
-
-  USE indice_sol_mod
+       snow, qsol, tsurf_new, evap &
+#ifdef ISO    
+     & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
+     & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag   &
+#endif
+     &   )
+
+    USE indice_sol_mod
+#ifdef ISO
+    USE infotrac_phy, ONLY: niso
+    !use isotopes_mod, ONLY: ridicule_snow,iso_eau,iso_HDO
+#ifdef ISOVERIF
+    USE isotopes_verif_mod
+#endif
+#endif
         
 ! Routine de traitement de la fonte de la neige dans le cas du traitement
@@ -172,4 +287,16 @@
     REAL, DIMENSION(klon), INTENT(INOUT) :: tsurf_new
     REAL, DIMENSION(klon), INTENT(INOUT) :: evap
+
+#ifdef ISO    
+        ! sortie de quelques diagnostiques
+    REAL, DIMENSION(klon), INTENT(OUT) :: fq_fonte_diag
+    REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte_diag
+    REAL, DIMENSION(klon), INTENT(OUT) ::  snow_evap_diag 
+    REAL, DIMENSION(klon), INTENT(OUT) ::  fqcalving_diag  
+    REAL,                  INTENT(OUT) :: max_eau_sol_diag  
+    REAL, DIMENSION(klon), INTENT(OUT) ::  runoff_diag   
+    REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_diag  
+    REAL,                  INTENT(OUT) :: coeff_rel_diag
+#endif
 
 ! Local variables
@@ -193,4 +320,9 @@
 
     LOGICAL               :: neige_fond
+
+#ifdef ISO
+        max_eau_sol_diag=max_eau_sol
+#endif
+
 
 !****************************************************************************************
@@ -231,4 +363,9 @@
     
     bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime
+#ifdef ISO
+    snow_evap_diag(:) = snow_evap(:)
+    coeff_rel_diag    = coeff_rel
+#endif
+
 
 
@@ -254,4 +391,8 @@
           bil_eau_s(i) = bil_eau_s(i) + fq_fonte 
           tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno  
+#ifdef ISO
+          fq_fonte_diag(i) = fq_fonte
+#endif
+
 
 !IM cf JLD OK     
@@ -273,4 +414,11 @@
        snow(i)=MIN(snow(i),snow_max)
     ENDDO
+#ifdef ISO
+    DO i = 1, knon
+       fqcalving_diag(i) = fqcalving(i)
+       fqfonte_diag(i)   = fqfonte(i)
+    ENDDO !DO i = 1, knon
+#endif
+
 
     IF (nisurf == is_ter) THEN
@@ -278,4 +426,7 @@
           qsol(i) = qsol(i) + bil_eau_s(i)
           run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
+#ifdef ISO
+          runoff_diag(i) = MAX(qsol(i) - max_eau_sol, 0.0)
+#endif
           qsol(i) = MIN(qsol(i), max_eau_sol) 
        ENDDO
@@ -290,4 +441,10 @@
        ENDDO
     ENDIF
+
+#ifdef ISO
+    DO i = 1, klon    
+      run_off_lic_diag(i) = run_off_lic(i)
+    ENDDO ! DO i = 1, knon    
+#endif
     
 !****************************************************************************************
@@ -312,14 +469,52 @@
 !****************************************************************************************
 !
-  SUBROUTINE fonte_neige_final(restart_runoff)
+  SUBROUTINE fonte_neige_final(restart_runoff &
+#ifdef ISO      
+     &                        ,xtrestart_runoff &
+#endif   
+     &                        )
 !
 ! This subroutine returns run_off_lic_0 for later writing to restart file.
 !
+#ifdef ISO
+    USE infotrac_phy, ONLY: niso
+#ifdef ISOVERIF
+    USE isotopes_mod, ONLY: iso_eau
+    USE isotopes_verif_mod
+#endif
+#endif
+!
 !****************************************************************************************
     REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
+#ifdef ISO     
+    REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrestart_runoff
+#ifdef ISOVERIF
+    INTEGER :: i
+#endif  
+#endif
+
+
 
 !****************************************************************************************
 ! Set the output variables
     restart_runoff(:) = run_off_lic_0(:)
+#ifdef ISO
+    xtrestart_runoff(:,:) = xtrun_off_lic_0(:,:)
+#ifdef ISOVERIF 
+    IF (iso_eau > 0) THEN   
+      DO i=1,klon
+        IF (iso_verif_egalite_nostop(run_off_lic_0(i) &
+     &                              ,xtrun_off_lic_0(iso_eau,i) &
+     &                              ,'fonte_neige 413') &
+     &      == 1) then
+          WRITE(*,*) 'i=',i
+          STOP
+        ENDIF
+      ENDDO !DO i=1,klon
+    ENDIF !IF (iso_eau > 0) then 
+#endif    
+#endif
+
+
 
 ! Deallocation of all varaibles in the module
@@ -334,4 +529,13 @@
     IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
     IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
+#ifdef ISO
+    IF (ALLOCATED(xtrun_off_lic_0)) DEALLOCATE(xtrun_off_lic_0)
+    IF (ALLOCATED(xtrun_off_ter)) DEALLOCATE(xtrun_off_ter)
+    IF (ALLOCATED(xtrun_off_lic)) DEALLOCATE(xtrun_off_lic)
+    IF (ALLOCATED(fxtfonte_global)) DEALLOCATE(fxtfonte_global)
+    IF (ALLOCATED(fxtcalving_global)) DEALLOCATE(fxtcalving_global)
+    IF (ALLOCATED(xtrunofflic_global)) DEALLOCATE(xtrunofflic_global)
+#endif
+
 
   END SUBROUTINE fonte_neige_final
@@ -340,5 +544,9 @@
 !
   SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
-       fqfonte_out, ffonte_out, run_off_lic_out)
+              fqfonte_out, ffonte_out, run_off_lic_out &
+#ifdef ISO     
+     &       ,fxtcalving_out, fxtfonte_out,xtrun_off_lic_out &
+#endif     
+     &       )
 
 
@@ -349,5 +557,8 @@
 !****************************************************************************************
 
-  USE indice_sol_mod
+    USE indice_sol_mod
+#ifdef ISO
+    USE infotrac_phy, ONLY: niso
+#endif
 
     REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
@@ -358,4 +569,11 @@
     REAL, DIMENSION(klon), INTENT(OUT)      :: run_off_lic_out
 
+#ifdef ISO
+    REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtcalving_out
+    REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtfonte_out
+    REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrun_off_lic_out
+    INTEGER   :: i,ixt
+#endif
+ 
     INTEGER   :: nisurf
 !****************************************************************************************
@@ -364,4 +582,8 @@
     fqfonte_out(:)   = 0.0
     fqcalving_out(:) = 0.0
+#ifdef ISO        
+    fxtfonte_out(:,:)   = 0.0
+    fxtcalving_out(:,:) = 0.0
+#endif
 
     DO nisurf = 1, nbsrf
@@ -373,7 +595,123 @@
     run_off_lic_out(:)=runofflic_global(:)
 
+#ifdef ISO
+    DO nisurf = 1, nbsrf
+      DO i=1,klon
+        DO ixt=1,niso
+          fxtfonte_out(ixt,i) = fxtfonte_out(ixt,i) + fxtfonte_global(ixt,i,nisurf)*pctsrf(i,nisurf)
+          fxtcalving_out(ixt,i) = fxtcalving_out(ixt,i) + fxtcalving_global(ixt,i,nisurf)*pctsrf(i,nisurf)
+        ENDDO !DO ixt=1,niso
+      ENDDO !DO i=1,klon
+    ENDDO !DO nisurf = 1, nbsrf
+    xtrun_off_lic_out(:,:) = xtrunofflic_global(:,:)
+#endif
+
   END SUBROUTINE fonte_neige_get_vars
 !
 !****************************************************************************************
 !
+!#ifdef ISO
+!  subroutine fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
+!    use infotrac_phy, ONLY: niso
+!
+!    ! inputs
+!    INTEGER, INTENT(IN)                      :: knon
+!    real, INTENT(IN), DIMENSION(niso,klon)   :: xtrun_off_lic_0_diag
+!
+!    xtrun_off_lic_0(:,:)=xtrun_off_lic_0_diag(:,:)
+!
+!  end subroutine fonte_neige_export_xtrun_off_lic_0
+!#endif 
+
+#ifdef ISO
+  SUBROUTINE gestion_neige_besoin_varglob_fonte_neige(klon,knon, &
+     &           xtprecip_snow,xtprecip_rain, &
+     &           fxtfonte_neige,fxtcalving, &
+     &           knindex,nisurf,run_off_lic_diag,coeff_rel_diag)
+
+        ! dans cette routine, on a besoin des variables globales de
+        ! fonte_neige_mod. Il faut donc la mettre dans fonte_neige_mod
+        ! le reste de gestion_neige est dans isotopes_routines_mod car sinon pb
+        ! de dépendance circulaire.
+
+    USE infotrac_phy, ONLY: ntiso,niso
+    USE isotopes_mod, ONLY: iso_eau    
+    USE indice_sol_mod    
+#ifdef ISOVERIF
+    USE isotopes_verif_mod
+#endif
+    IMPLICIT NONE
+
+    ! inputs
+    INTEGER, INTENT(IN)                     :: klon,knon
+    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_snow, xtprecip_rain
+    REAL, DIMENSION(niso,klon), INTENT(IN)  :: fxtfonte_neige,fxtcalving
+    INTEGER, INTENT(IN)                     :: nisurf
+    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
+    REAL, DIMENSION(klon), INTENT(IN)       :: run_off_lic_diag  
+    REAL, INTENT(IN)                        :: coeff_rel_diag  
+
+    ! locals
+    INTEGER :: i,ixt,j
+        
+#ifdef ISOVERIF
+    IF (nisurf == is_lic) THEN
+      IF (iso_eau > 0) THEN  
+        DO i = 1, knon
+           j = knindex(i)
+           CALL iso_verif_egalite(xtrun_off_lic_0(iso_eau,j), &
+     &             run_off_lic_0(j),'gestion_neige_besoin_varglob_fonte_neige 625')
+        ENDDO
+      ENDIF
+    ENDIF
+#endif
+
+! calcul de run_off_lic 
+
+    IF (nisurf == is_lic) THEN
+!         coeff_rel = dtime/(tau_calv * rday)
+
+      DO i = 1, knon
+        j = knindex(i)
+        DO ixt = 1, niso
+          xtrun_off_lic(ixt,i)   = (coeff_rel_diag *  fxtcalving(ixt,i)) &
+     &                            +(1. - coeff_rel_diag) * xtrun_off_lic_0(ixt,j)
+          xtrun_off_lic_0(ixt,j) = xtrun_off_lic(ixt,i)
+          xtrun_off_lic(ixt,i)   = xtrun_off_lic(ixt,i) + fxtfonte_neige(ixt,i) + xtprecip_rain(ixt,i)
+        ENDDO !DO ixt=1,niso
+#ifdef ISOVERIF
+          IF (iso_eau > 0) THEN             
+            IF (iso_verif_egalite_choix_nostop(xtrun_off_lic(iso_eau,i), &
+     &                  run_off_lic_diag(i),'gestion_neige_besoin_varglob_fonte_neige 1201a', &
+     &                  errmax,errmaxrel) == 1) THEN 
+               WRITE(*,*) 'i,j=',i,j   
+               WRITE(*,*) 'coeff_rel_diag=',coeff_rel_diag
+               STOP
+            ENDIF
+          ENDIF
+#endif
+      ENDDO
+    ENDIF !IF (nisurf == is_lic) THEN  
+
+! Save ffonte, fqfonte and fqcalving in global arrays for each 
+! sub-surface separately
+    DO i = 1, knon
+      DO ixt = 1, niso
+        fxtfonte_global(ixt,knindex(i),nisurf)   = fxtfonte_neige(ixt,i)
+        fxtcalving_global(ixt,knindex(i),nisurf) = fxtcalving(ixt,i)
+      ENDDO !do ixt=1,niso
+    ENDDO   
+
+    IF (nisurf == is_lic) THEN
+      DO i = 1, knon    
+        DO ixt = 1, niso   
+        xtrunofflic_global(ixt,knindex(i)) = xtrun_off_lic(ixt,i)
+        ENDDO ! DO ixt=1,niso   
+      ENDDO
+    ENDIF
+       
+  END SUBROUTINE gestion_neige_besoin_varglob_fonte_neige
+#endif
+
+
 END MODULE fonte_neige_mod
Index: /LMDZ6/branches/cirrus/libf/phylmd/grid_index.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/grid_index.F90	(revision 5202)
+++ /LMDZ6/branches/cirrus/libf/phylmd/grid_index.F90	(revision 5202)
@@ -0,0 +1,21 @@
+function grid_index(lon_deg,lat_deg)
+!--------------------------------------------------------------------------------
+! Get local index of grid point of longitude,latitude lon_deg,lat_deg
+! Author : FH 2024/07/18
+! Please do not put this function in a m*odule not to complexify the replay script
+!--------------------------------------------------------------------------------
+USE dimphy, only : klon
+USE geometry_mod, ONLY: latitude_deg, longitude_deg
+implicit none
+real, intent(in) :: lon_deg,lat_deg
+integer :: grid_index
+integer i
+grid_index=0
+do i=1,klon
+   if ( abs(lon_deg-longitude_deg(i)) < 0.02 .and.  abs(lat_deg-latitude_deg(i)) < 0.02 ) then
+        grid_index=i
+        exit
+   endif
+enddo
+return
+end
Index: /LMDZ6/branches/cirrus/libf/phylmd/infotrac_phy.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/infotrac_phy.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/infotrac_phy.F90	(revision 5202)
@@ -5,6 +5,6 @@
    USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx
    USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
-        delPhase, niso, getKey, isot_type, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
-        addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,   isoCheck, nbIso, ntiso, isoName
+        delPhase, niso, getKey, isot_type, processIsotopes,  isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
+        addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,  iqWIsoPha, nbIso, ntiso, isoName, isoCheck
    IMPLICIT NONE
 
@@ -20,10 +20,7 @@
    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
-
+
+   !=== FOR WATER
+   PUBLIC :: ivap, iliq, isol
    !=== FOR ISOTOPES: General
    PUBLIC :: isot_type, nbIso                              !--- Derived type, full isotopes families database + nb of families
@@ -37,4 +34,6 @@
    PUBLIC :: itZonIso                                      !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx)
    PUBLIC :: iqIsoPha                                      !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases
+   PUBLIC :: iqWIsoPha                                      !--- Same as iqIsoPha but with normal water phases
+
    PUBLIC :: isoCheck                                      !--- Run isotopes checking routines
    !=== FOR BOTH TRACERS AND ISOTOPES
@@ -73,5 +72,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 / "b"lowing) | /           | [g][l][s][b]           |
+!  | phase       | Phases list ("g"as / "l"iquid / "s"olid)             | /           | [g][l][s]              |
 !  | component   | Name(s) of the merged/cumulated section(s)           | /           | coma-separated names   |
 !  | iGeneration | Generation (>=1)                                     | /           |                        |
@@ -98,6 +97,7 @@
 !  | 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][b] 1:4 |
+!  | phase  | nphas  | Phases                     list + number         |                    | [g][l][s], 1:3  |
 !  | iqIsoPha        | Index in "qx"           = f(name(1:ntiso)),phas) | iqiso              | 1:nqtot         |
+!  | iqWIsoPha       | 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         |
 !  +-----------------+--------------------------------------------------+--------------------+-----------------+
@@ -112,4 +112,8 @@
 !$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac)
 
+   !=== INDICES OF WATER
+   INTEGER,               SAVE :: ivap,iliq,isol ! Indices for vap, liq and ice
+!$OMP THREADPRIVATE(ivap,iliq,isol)
+
    !=== VARIABLES FOR INCA
    INTEGER,               SAVE, ALLOCATABLE :: conv_flg(:), &   !--- Convection     activation ; needed for INCA        (nbtr)
@@ -123,12 +127,4 @@
   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
 
@@ -182,10 +178,8 @@
    INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)
    INTEGER :: iad                                                    !--- Advection scheme number
-   INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k                      !--- Indexes and temporary variables
-   LOGICAL :: lerr, ll, lInit
-   CHARACTER(LEN=1) :: p
+   INTEGER :: iq, jq, nt, im, nm, k                                 !--- Indexes and temporary variables
+   LOGICAL :: lerr, lInit
    TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
    TYPE(trac_type), POINTER             :: t1, t(:)
-   INTEGER :: ierr
    CHARACTER(LEN=maxlen),   ALLOCATABLE :: types_trac(:)  !--- Keyword for tracers type(s), parsed version
    
@@ -262,5 +256,5 @@
 !##############################################################################################################################
    IF(lInit) THEN
-      IF(readTracersFiles(ttp, type_trac == 'repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1)
+      IF(readTracersFiles(ttp, lRepr=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)
@@ -388,5 +382,5 @@
 
    !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
-   CALL indexUpdate(tracers)
+   IF(indexUpdate(tracers)) CALL abort_gcm(modname, 'problem when processing isotopes parameters', 1)
 
 !##############################################################################################################################
@@ -404,5 +398,5 @@
    !=== READ PHYSICAL PARAMETERS FOR ISOTOPES
    niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
-   IF(readIsotopesFile()) CALL abort_physic(modname, 'Problem when reading isotopes parameters', 1)
+   IF(processIsotopes()) CALL abort_physic(modname, 'Problem when processing isotopes parameters', 1)
 
 !##############################################################################################################################
@@ -416,5 +410,5 @@
    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_physic(modname, 'pb dans le calcul de nqtottr', 1)
+      CALL abort_physic(modname, 'problem with the computation of nqtottr', 1)
 
    !=== DISPLAY THE RESULTS
@@ -431,7 +425,6 @@
    t => tracers
    CALL msg('Information stored in infotrac_phy :', modname)
-   IF(dispTable('issssssssiiiiiiii', &
-      ['iq    ', 'name  ', 'lName ', 'gen0N ', 'parent', 'type  ', 'phase ', 'compon', 'isPhy ',           &
-                 'iGen  ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'],          &
+   IF(dispTable('issssssssiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp',      &
+                              'isPh', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'],     &
       cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),&
       cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,          &
Index: /LMDZ6/branches/cirrus/libf/phylmd/lmdz_atke_exchange_coeff.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/lmdz_atke_exchange_coeff.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/lmdz_atke_exchange_coeff.F90	(revision 5202)
@@ -7,5 +7,5 @@
 subroutine atke_compute_km_kh(ngrid,nlay,dtime, &
                         wind_u,wind_v,temp,qvap,play,pinterf,cdrag_uv, &
-                        tke,eps,Km_out,Kh_out)
+                        tke,eps,tke_shear,tke_buoy,tke_trans,Km_out,Kh_out)
 
 !========================================================================
@@ -79,4 +79,7 @@
 
 REAL, DIMENSION(ngrid,nlay+1), INTENT(OUT)    :: eps      ! output: TKE dissipation rate at interface between layers (m2/s3)
+REAL, DIMENSION(ngrid,nlay+1), INTENT(OUT)    :: tke_shear! output: TKE shear production rate (m2/s3)
+REAL, DIMENSION(ngrid,nlay+1), INTENT(OUT)    :: tke_buoy ! output: TKE buoyancy production rate (m2/s3)
+REAL, DIMENSION(ngrid,nlay+1), INTENT(OUT)    :: tke_trans! output: TKE transport (diffusion) term (m2/s3)
 REAL, DIMENSION(ngrid,nlay), INTENT(OUT)      :: Km_out   ! output: Exchange coefficient for momentum at interface between layers (m2/s)
 REAL, DIMENSION(ngrid,nlay), INTENT(OUT)      :: Kh_out   ! output: Exchange coefficient for heat flux at interface between layers (m2/s)
@@ -261,4 +264,7 @@
                 shear2(igrid,ilay) * (1. - Ri(igrid,ilay) / Prandtl(igrid,ilay))
                 eps(igrid,ilay) = (tke(igrid,ilay)**(3./2))/(cepsilon*l_exchange(igrid,ilay))
+                tke_shear(igrid,ilay)=l_exchange(igrid,ilay)*Sm(igrid,ilay)*sqrt(tke(igrid,ilay))*shear2(igrid,ilay) 
+                tke_buoy(igrid,ilay)=-l_exchange(igrid,ilay)*Sm(igrid,ilay)*sqrt(tke(igrid,ilay))*shear2(igrid,ilay) &
+                                    *(Ri(igrid,ilay) / Prandtl(igrid,ilay))
             ENDDO
         ENDDO
@@ -278,5 +284,8 @@
             qq=max(0.,qq)
             tke(igrid,ilay)=0.5*(qq**2)
-            eps(igrid,ilay) = (tke(igrid,ilay)**(3./2))/(cepsilon*l_exchange(igrid,ilay)) 
+            eps(igrid,ilay) = (tke(igrid,ilay)**(3./2))/(cepsilon*l_exchange(igrid,ilay))
+            tke_shear(igrid,ilay)=l_exchange(igrid,ilay)*Sm(igrid,ilay)*sqrt(tke(igrid,ilay))*shear2(igrid,ilay)
+            tke_buoy(igrid,ilay)=-l_exchange(igrid,ilay)*Sm(igrid,ilay)*sqrt(tke(igrid,ilay))*shear2(igrid,ilay) &
+                                *(Ri(igrid,ilay) / Prandtl(igrid,ilay)) 
             ENDDO
         ENDDO
@@ -293,5 +302,8 @@
             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.))) 
+                /(1.+qq*dtime/(cepsilon*l_exchange(igrid,ilay)*2.*sqrt(2.)))
+            tke_shear(igrid,ilay)=l_exchange(igrid,ilay)*Sm(igrid,ilay)*qq/sqrt(2.)*shear2(igrid,ilay)
+            tke_buoy(igrid,ilay)=-l_exchange(igrid,ilay)*Sm(igrid,ilay)*qq/sqrt(2.)*shear2(igrid,ilay) &
+                                *(Ri(igrid,ilay) / Prandtl(igrid,ilay)) 
             tke(igrid,ilay)=0.5*(qq**2) 
             eps(igrid,ilay) = (tke(igrid,ilay)**(3./2))/(cepsilon*l_exchange(igrid,ilay))
@@ -308,4 +320,7 @@
             eps(igrid,ilay) = (tke(igrid,ilay)**(3./2))/(cepsilon*l_exchange(igrid,ilay))
             qq=max(sqrt(2.*tke(igrid,ilay)),1.e-10)
+            tke_shear(igrid,ilay)=l_exchange(igrid,ilay)*Sm(igrid,ilay)*qq/sqrt(2.)*shear2(igrid,ilay)
+            tke_buoy(igrid,ilay)=-l_exchange(igrid,ilay)*Sm(igrid,ilay)*qq/sqrt(2.)*shear2(igrid,ilay) &
+                                *(Ri(igrid,ilay) / Prandtl(igrid,ilay))
             IF (Ri(igrid,ilay) .LT. 0.) THEN
                 netloss=qq/(2.*sqrt(2.)*cepsilon*l_exchange(igrid,ilay))
@@ -327,4 +342,7 @@
             DO igrid=1,ngrid
             qq=max(sqrt(2.*tke(igrid,ilay)),1.e-10)
+            tke_shear(igrid,ilay)=l_exchange(igrid,ilay)*Sm(igrid,ilay)*qq/sqrt(2.)*shear2(igrid,ilay)
+            tke_buoy(igrid,ilay)=-l_exchange(igrid,ilay)*Sm(igrid,ilay)*qq/sqrt(2.)*shear2(igrid,ilay) &
+                                *(Ri(igrid,ilay) / Prandtl(igrid,ilay))
             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.)))) &
@@ -349,4 +367,6 @@
     tke(igrid,nlay+1)=0.
     eps(igrid,nlay+1)=0.
+    tke_shear(igrid,nlay+1)=0.
+    tke_buoy(igrid,nlay+1)=0.
 END DO
 
@@ -359,4 +379,6 @@
     tke(igrid,1)=ctkes*(ustar**2)
     eps(igrid,1)=0. ! arbitrary as TKE is not properly defined at the surface
+    tke_shear(igrid,1)=0.
+    tke_buoy(igrid,1)=0.
 END DO
 
@@ -364,6 +386,7 @@
 ! vertical diffusion of TKE 
 !==========================
+tke_trans(:,:)=0.
 IF (atke_ok_vdiff) THEN
-    CALL atke_vdiff_tke(ngrid,nlay,dtime,z_lay,z_interf,temp,play,l_exchange,Sm,tke)
+    CALL atke_vdiff_tke(ngrid,nlay,dtime,z_lay,z_interf,temp,play,l_exchange,Sm,tke,tke_trans)
 ENDIF
 
@@ -387,5 +410,5 @@
 
 !===============================================================================================
-subroutine atke_vdiff_tke(ngrid,nlay,dtime,z_lay,z_interf,temp,play,l_exchange,Sm,tke)
+subroutine atke_vdiff_tke(ngrid,nlay,dtime,z_lay,z_interf,temp,play,l_exchange,Sm,tke,tke_trans)
 
 ! routine that computes the vertical diffusion of TKE by the turbulence
@@ -408,5 +431,5 @@
 
 REAL, DIMENSION(ngrid,nlay+1), INTENT(INOUT)  :: tke    ! turbulent kinetic energy at interface between layers
-
+REAL, DIMENSION(ngrid,nlay+1), INTENT(INOUT)  :: tke_trans ! turbulent kinetic energy transport term (m2/s3)
 
 
@@ -480,4 +503,5 @@
 ! update TKE
 tke(:,:)=tke(:,:)+dtke(:,:)
+tke_trans(:,:)=dtke(:,:)/dtime
 
 
Index: /LMDZ6/branches/cirrus/libf/phylmd/lmdz_atke_turbulence_ini.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/lmdz_atke_turbulence_ini.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/lmdz_atke_turbulence_ini.F90	(revision 5202)
@@ -50,5 +50,6 @@
       !!
       !! ** Purpose :   Initialization of the atke module and choice of some constants
-      !!               
+      !!                Default values correspond to the  'best' configuration
+      !!                from tuning on GABLS1 in Vignon et al. 2024, JAMES
       !!----------------------------------------------------------------------
 
@@ -73,9 +74,9 @@
 
       ! flag that controls options in atke_compute_km_kh
-      iflag_atke=0
+      iflag_atke=1
       CALL getin_p('iflag_atke',iflag_atke)
 
       ! flag that controls the calculation of mixing length in atke
-      iflag_atke_lmix=0
+      iflag_atke_lmix=3
       CALL getin_p('iflag_atke_lmix',iflag_atke_lmix)
 
@@ -86,5 +87,5 @@
 
       ! activate vertical diffusion of TKE or not
-      atke_ok_vdiff=.false.
+      atke_ok_vdiff=.true.
       CALL getin_p('atke_ok_vdiff',atke_ok_vdiff)
 
@@ -101,13 +102,13 @@
       ! Sun et al 2011, JAMC 
       ! between 10 and 40
-      l0=15.0 
+      l0=42.5279652116005 
       CALL getin_p('atke_l0',l0)
 
       ! critical Richardson number 
-      ric=0.25
+      ric=0.190537327781655
       CALL getin_p('atke_ric',ric)
 
       ! constant for tke dissipation calculation
-      cepsilon=5.87 ! default value as in yamada4
+      cepsilon=8.89273387537601
       CALL getin_p('atke_cepsilon',cepsilon)
 
@@ -131,5 +132,5 @@
 
       ! slope of Pr=f(Ri) for stable conditions
-      pr_slope=5.0 ! default value from Zilitinkevich et al. 2005
+      pr_slope=4.67885738180385
       CALL getin_p('atke_pr_slope',pr_slope)
       if (pr_slope .le. 1) then
@@ -139,5 +140,5 @@
 
       ! value of turbulent prandtl number in neutral conditions (Ri=0)
-      pr_neut=0.8
+      pr_neut=0.837372701768868
       CALL getin_p('atke_pr_neut',pr_neut)
 
@@ -151,5 +152,5 @@
 
       ! coefficient for mixing length depending on local stratification
-      clmix=0.5
+      clmix=0.648055235325291
       CALL getin_p('atke_clmix',clmix)
 
@@ -160,10 +161,10 @@
       ! 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
+      smmin=0.0960838631869678
       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.
+      cke=2.47069655134662
       CALL getin_p('atke_cke',cke)
 
Index: /LMDZ6/branches/cirrus/libf/phylmd/lmdz_call_atke.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/lmdz_call_atke.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/lmdz_call_atke.F90	(revision 5202)
@@ -8,5 +8,5 @@
 contains
 
-subroutine call_atke(dtime,ngrid,nlay,cdrag_uv,cdrag_t,u_surf,v_surf,temp_surf, &
+subroutine call_atke(dtime,ngrid,nlay,nsrf,ni,cdrag_uv,cdrag_t,u_surf,v_surf,temp_surf, &
                         wind_u,wind_v,temp,qvap,play,pinterf, &
                         tke,eps,Km_out,Kh_out)
@@ -16,4 +16,5 @@
 
 USE lmdz_atke_turbulence_ini, ONLY : iflag_num_atke, rg, rd
+USE phys_local_var_mod, ONLY: tke_shear, tke_buoy, tke_trans
 
 implicit none
@@ -26,4 +27,6 @@
 INTEGER, INTENT(IN) :: ngrid ! number of horizontal index (flat grid)
 INTEGER, INTENT(IN) :: nlay ! number of vertical index  
+INTEGER, INTENT(IN) :: nsrf ! surface tile index
+INTEGER, DIMENSION(ngrid), INTENT(IN) :: ni ! array of indices to move from knon to klon arrays
 
 
@@ -50,12 +53,13 @@
 
 
+REAL, DIMENSION(ngrid,nlay+1) :: tke_shear_term,tke_buoy_term,tke_trans_term
 REAL, DIMENSION(ngrid,nlay) :: wind_u_predict, wind_v_predict
 REAL, DIMENSION(ngrid) ::  wind1
-INTEGER i
+INTEGER i,j,k
 
 
 call atke_compute_km_kh(ngrid,nlay,dtime,&
                         wind_u,wind_v,temp,qvap,play,pinterf,cdrag_uv,&
-                        tke,eps,Km_out,Kh_out)
+                        tke,eps,tke_shear_term,tke_buoy_term,tke_trans_term,Km_out,Kh_out)
 
 
@@ -76,10 +80,19 @@
    call atke_compute_km_kh(ngrid,nlay,dtime,&
                         wind_u_predict,wind_v_predict,temp,qvap,play,pinterf,cdrag_uv, &
-                        tke,eps,Km_out,Kh_out)
+                        tke,eps,tke_shear_term,tke_buoy_term,tke_trans_term,Km_out,Kh_out)
 
 end if
 
 
+! Diagnostics of tke loss/source terms
 
+ DO k=1,nlay+1
+    DO i=1,ngrid
+       j=ni(i)
+       tke_shear(j,k,nsrf)=tke_shear_term(i,k)
+       tke_buoy(j,k,nsrf)=tke_buoy_term(i,k)
+       tke_trans(j,k,nsrf)=tke_trans_term(i,k)
+    ENDDO
+ ENDDO
 
 
Index: /LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp.F90	(revision 5202)
@@ -7,13 +7,16 @@
 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 SUBROUTINE lscp(klon,klev,dtime,missing_val,            &
-     paprs,pplay,temp,qt,ptconv,ratqs,                  &
+     paprs,pplay,temp,qt,qice_save,ptconv,ratqs,        &
      d_t, d_q, d_ql, d_qi, rneb, rneblsvol,             &
-     pfraclr,pfracld,                                   &
+     pfraclr, pfracld,                                  &
+     cldfraliq, sigma2_icefracturb,mean_icefracturb,    &
      radocond, radicefrac, rain, snow,                  &
      frac_impa, frac_nucl, beta,                        &
-     prfl, psfl, rhcl, qta, fraca,                     &
-     tv, pspsk, tla, thl, iflag_cld_th,             &
-     iflag_ice_thermo, distcltop, temp_cltop, cell_area,&
-     cf_seri, rvc_seri, u_seri, v_seri, pbl_eps,        &
+     prfl, psfl, rhcl, qta, fraca,                      &
+     tv, pspsk, tla, thl, iflag_cld_th,                 &
+     iflag_ice_thermo, distcltop, temp_cltop,           &
+     tke, tke_dissip,                                   &
+     cell_area,                                         &
+     cf_seri, rvc_seri, u_seri, v_seri,                 &
      qsub, qissr, qcld, subfra, issrfra, gamma_cond,    &
      ratio_qi_qtot, dcf_sub, dcf_con, dcf_mix,          &
@@ -100,5 +103,6 @@
 ! 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 : calc_qsat_ecmwf, calc_gammasat
+USE lmdz_lscp_tools, ONLY : icefrac_lscp, icefrac_lscp_turb
 USE lmdz_lscp_tools, ONLY : fallice_velocity, distance_to_cloud_top
 USE lmdz_lscp_condensation, ONLY : condensation_lognormal, condensation_ice_supersat
@@ -115,5 +119,5 @@
 USE lmdz_lscp_ini, ONLY : RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RG
 USE lmdz_lscp_ini, ONLY : ok_poprecip
-USE lmdz_lscp_ini, ONLY : ok_external_lognormal, ok_ice_supersat, ok_unadjusted_clouds
+USE lmdz_lscp_ini, ONLY : ok_external_lognormal, ok_ice_supersat, ok_unadjusted_clouds, iflag_icefrac
 
 IMPLICIT NONE
@@ -134,4 +138,5 @@
   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] 
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: qice_save       ! ice specific from previous time step [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
@@ -141,15 +146,17 @@
   !Inputs associated with thermal plumes
 
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: tv             ! virtual potential temperature [K]
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: qta            ! 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)   :: pspsk          ! exner potential (p/100000)**(R/cp) 
-  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: tla            ! liquid temperature within thermals [K]
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: tv                  ! virtual potential temperature [K]
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: qta                 ! 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)   :: pspsk               ! exner potential (p/100000)**(R/cp) 
+  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: tla                 ! liquid temperature within thermals [K]
+  REAL, DIMENSION(klon,klev+1),      INTENT(IN)   :: tke                 !--turbulent kinetic energy [m2/s2]
+  REAL, DIMENSION(klon,klev+1),      INTENT(IN)   :: tke_dissip          !--TKE dissipation [m2/s3]
 
   ! INPUT/OUTPUT variables
   !------------------------
   
-  REAL, DIMENSION(klon,klev),      INTENT(INOUT)   :: thl          ! liquid potential temperature [K]
-  REAL, DIMENSION(klon,klev),      INTENT(INOUT)   :: ratqs        ! function of pressure that sets the large-scale
+  REAL, DIMENSION(klon,klev),      INTENT(INOUT)   :: thl              ! liquid potential temperature [K]
+  REAL, DIMENSION(klon,klev),      INTENT(INOUT)   :: ratqs            ! function of pressure that sets the large-scale
 
   ! INPUT/OUTPUT condensation and ice supersaturation
@@ -160,5 +167,4 @@
   REAL, DIMENSION(klon,klev),      INTENT(IN)   :: u_seri           ! eastward wind [m/s]
   REAL, DIMENSION(klon,klev),      INTENT(IN)   :: v_seri           ! northward wind [m/s]
-  REAL, DIMENSION(klon,klev+1),    INTENT(IN)   :: pbl_eps          ! TKE dissipation [?]
   REAL, DIMENSION(klon),           INTENT(IN)   :: cell_area        ! area of each cell [m2]
 
@@ -179,4 +185,7 @@
   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)  :: cldfraliq           ! liquid fraction of cloud [-]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: sigma2_icefracturb  ! Variance of the diagnostic supersaturation distribution (icefrac_turb) [-]
+  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: mean_icefracturb    ! Mean of the diagnostic supersaturation distribution (icefrac_turb) [-]
   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
@@ -190,8 +199,8 @@
   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: beta             ! conversion rate of condensed water
 
-  ! fraction of aerosol scavenging through impaction and nucleation (for on-line)
+  ! 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 [-]
+  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 condensation and ice supersaturation
@@ -255,6 +264,5 @@
   ! LOCAL VARIABLES:
   !----------------
-
-  REAL,DIMENSION(klon) :: qsl, qsi
+  REAL,DIMENSION(klon) :: qsl, qsi                                ! saturation threshold at current vertical level
   REAL :: zct, zcl,zexpo
   REAL, DIMENSION(klon,klev) :: ctot
@@ -263,10 +271,10 @@
   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, DIMENSION(klon) :: gammasat,dgammasatdt                   ! coefficient to make cold condensation at the correct RH and derivative wrt T
+  REAL, DIMENSION(klon) :: Tbef,qlbef,DT                          ! temperature, humidity and temp. variation during lognormal iteration
   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, DIMENSION(klon) :: zpdf_sig,zpdf_k,zpdf_delta             ! lognormal parameters
+  REAL, DIMENSION(klon) :: Zpdf_a,zpdf_b,zpdf_e1,zpdf_e2          ! lognormal intermediate variables
   REAL :: erf
   REAL, DIMENSION(klon) :: zfice_th
@@ -285,4 +293,5 @@
   REAL :: zmelt,zrain,zsnow,zprecip
   REAL, DIMENSION(klon) :: dzfice
+  REAL, DIMENSION(klon) :: zfice_turb, dzfice_turb
   REAL :: zsolid
   REAL, DIMENSION(klon) :: qtot, qzero
@@ -315,5 +324,6 @@
   REAL, DIMENSION(klon,klev) :: radocondi, radocondl
   REAL :: effective_zneb
-  REAL, DIMENSION(klon) :: distcltop1D, temp_cltop1D
+  REAL, DIMENSION(klon) :: zdistcltop, ztemp_cltop
+  REAL, DIMENSION(klon) :: zqliq, zqice, zqvapcl        ! for icefrac_lscp_turb
   
   ! for condensation and ice supersaturation
@@ -328,5 +338,4 @@
   REAL :: min_qParent, min_ratio
 
-
   INTEGER i, k, n, kk, iter
   INTEGER, DIMENSION(klon) :: n_i
@@ -382,4 +391,7 @@
 pfraclr(:,:)=0.0
 pfracld(:,:)=0.0
+cldfraliq(:,:)=0.
+sigma2_icefracturb(:,:)=0.
+mean_icefracturb(:,:)=0.
 radocond(:,:) = 0.0
 radicefrac(:,:) = 0.0
@@ -391,4 +403,6 @@
 zfice(:)=0.0
 dzfice(:)=0.0
+zfice_turb(:)=0.0
+dzfice_turb(:)=0.0
 zqprecl(:)=0.0
 zqpreci(:)=0.0
@@ -405,6 +419,6 @@
 d_tot_zneb(:) = 0.0
 qzero(:) = 0.0
-distcltop1D(:)=0.0
-temp_cltop1D(:) = 0.0
+zdistcltop(:)=0.0
+ztemp_cltop(:) = 0.0
 ztupnew(:)=0.0
 
@@ -459,5 +473,4 @@
 
 
-
 !c_iso: variable initialisation for iso 
 
@@ -478,4 +491,9 @@
 
     ! Initialisation temperature and specific humidity
+    ! temp(klon,klev) is not modified by the routine, instead all changes in temperature are made on zt
+    ! at the end of the klon loop, a temperature incremtent d_t due to all processes
+    ! (thermalization, evap/sub incoming precip, cloud formation, precipitation processes) is calculated 
+    ! d_t = temperature tendency due to lscp
+    ! The temperature of the overlying layer is updated here because needed for thermalization
     DO i = 1, klon
         zt(i)=temp(i,k)
@@ -812,5 +830,5 @@
                 ELSEIF (iflag_cloudth_vert .EQ. 7) THEN
                    ! Updated version of Arnaud Jam (correction by E. Vignon) + adapted treatment
-                   ! for boundary-layer mixed phase clouds following Vignon et al.  
+                   ! for boundary-layer mixed phase clouds 
                     CALL cloudth_mpc(klon,klev,k,mpc_bl_points,zt,zq,qta(:,k),fraca(:,k), &
                                      pspsk(:,k),paprs(:,k+1),paprs(:,k),pplay(:,k), tla(:,k), &
@@ -834,15 +852,15 @@
             
                 ! lognormal 
-            lognormale = .TRUE.
+            lognormale(:) = .TRUE.
 
         ELSEIF (iflag_cld_th .GE. 6) THEN
             
                 ! lognormal distribution when no thermals 
-            lognormale = fraca(:,k) < min_frac_th_cld
+            lognormale(:) = fraca(:,k) < min_frac_th_cld
 
         ELSE
                 ! When iflag_cld_th=5, we always assume
                 ! bi-gaussian distribution
-            lognormale = .FALSE.
+            lognormale(:) = .FALSE.
         
         ENDIF
@@ -900,8 +918,8 @@
                   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)
+                       CALL distance_to_cloud_top(klon,klev,k,temp,pplay,paprs,rneb,zdistcltop,ztemp_cltop)
                   ENDIF
-                  CALL icefrac_lscp(klon, zt(:), iflag_ice_thermo, distcltop1D(:),temp_cltop1D(:),zfice(:),dzfice(:))
-
+
+                  CALL icefrac_lscp(klon, zt(:), iflag_ice_thermo, zdistcltop(:),ztemp_cltop(:),zfice(:),dzfice(:))
 
                   !--AB Activates a condensation scheme that allows for
@@ -938,5 +956,5 @@
                         pplay(:,k), paprs(:,k), paprs(:,k+1), &
                         cf_seri(:,k), rvc_seri(:,k), ratio_qi_qtot(:,k), &
-                        shear(:), pbl_eps(:,k), cell_area(:), &
+                        shear(:), tke_dissip(:,k), cell_area(:), &
                         Tbef(:), zq(:), zqs(:), gammasat(:), ratqs(:,k), keepgoing(:), &
                         rneb(:,k), zqn(:), qvc(:), issrfra(:,k), qissr(:,k), &
@@ -1017,5 +1035,6 @@
                             cste=RLSTT
                         ENDIF
-
+                        
+                        ! LEA_R : check formule
                         IF ( ok_unadjusted_clouds ) THEN
                           !--AB We relax the saturation adjustment assumption
@@ -1059,17 +1078,25 @@
         ! 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)
-
+           CALL distance_to_cloud_top(klon,klev,k,temp,pplay,paprs,rneb,zdistcltop,ztemp_cltop)
+           distcltop(:,k)=zdistcltop(:)
+           temp_cltop(:,k)=ztemp_cltop(:)
+        ENDIF
+
+        ! Partition function depending on temperature
+        CALL icefrac_lscp(klon, zt, iflag_ice_thermo, zdistcltop, ztemp_cltop, zfice, dzfice)
+
+        ! Partition function depending on tke for non shallow-convective clouds 
+        IF (iflag_icefrac .GE. 1) THEN
+
+           CALL icefrac_lscp_turb(klon, dtime, Tbef, pplay(:,k), paprs(:,k), paprs(:,k+1), qice_save(:,k), ziflcld, zqn, &
+           rneb(:,k), tke(:,k), tke_dissip(:,k), zqliq, zqvapcl, zqice, zfice_turb, dzfice_turb, cldfraliq(:,k),sigma2_icefracturb(:,k), mean_icefracturb(:,k))
+
+        ENDIF
 
         ! Water vapor update, Phase determination and subsequent latent heat exchange
         DO i=1, klon
-
+            ! Overwrite phase partitioning in boundary layer mixed phase clouds when the 
+            ! iflag_cloudth_vert=7 and specific param is activated
             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
@@ -1078,7 +1105,5 @@
                 zq(i) = zq(i) - zcond(i)        
                 zfice(i)=zfice_th(i)
-
             ELSE
-
                 ! Checks on rneb, rhcl and zqn
                 IF (rneb(i,k) .LE. 0.0) THEN
@@ -1108,4 +1133,12 @@
                     ! following line is very strange and probably wrong:
                     rhcl(i,k)=(zqs(i)+zq(i))/2./zqs(i)
+                    ! Overwrite partitioning for non shallow-convective clouds if iflag_icefrac>1 (icefrac turb param) 
+                    IF (iflag_icefrac .GE. 1) THEN
+                        IF (lognormale(i)) THEN  
+                           zcond(i)  = zqliq(i) + zqice(i)
+                           zfice(i)=zfice_turb(i)
+                           rhcl(i,k) = zqvapcl(i) * rneb(i,k) + (zq(i) - zqn(i)) * (1.-rneb(i,k))
+                        ENDIF
+                    ENDIF
                 ENDIF
 
@@ -1493,5 +1526,8 @@
                 znebprecipcld(i)=0.0
             ENDIF
-
+        !IF ( ((1-zfice(i))*zoliq(i) .GT. 0.) .AND. (zt(i) .LE. 233.15) ) THEN
+        !print*,'WARNING LEA OLIQ A <-40°C '
+        !print*,'zt,Tbef,oliq,oice,cldfraliq,icefrac,rneb',zt(i),Tbef(i),(1-zfice(i))*zoliq(i),zfice(i)*zoliq(i),cldfraliq(i,k),zfice(i),rneb(i,k)
+        !ENDIF 
         ENDDO
 
Index: /LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp_ini.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp_ini.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp_ini.F90	(revision 5202)
@@ -67,29 +67,33 @@
   !$OMP THREADPRIVATE(iflag_t_glace)
 
-  INTEGER, SAVE, PROTECTED :: iflag_cloudth_vert=0         ! option for determining cloud fraction and content in convective boundary layers
+  INTEGER, SAVE, PROTECTED :: iflag_cloudth_vert=0          ! option for determining cloud fraction and content in convective boundary layers
   !$OMP THREADPRIVATE(iflag_cloudth_vert)
 
-  INTEGER, SAVE, PROTECTED :: iflag_gammasat=0             ! which threshold for homogeneous nucleation below -40oC
+  INTEGER, SAVE, PROTECTED :: iflag_gammasat=0              ! which threshold for homogeneous nucleation below -40oC
   !$OMP THREADPRIVATE(iflag_gammasat)
 
-  INTEGER, SAVE, PROTECTED :: iflag_rain_incloud_vol=0     ! use of volume cloud fraction for rain autoconversion 
+  INTEGER, SAVE, PROTECTED :: iflag_rain_incloud_vol=0      ! use of volume cloud fraction for rain autoconversion 
   !$OMP THREADPRIVATE(iflag_rain_incloud_vol)
 
-  INTEGER, SAVE, PROTECTED :: iflag_bergeron=0             ! bergeron effect for liquid precipitation treatment  
+  INTEGER, SAVE, PROTECTED :: iflag_bergeron=0              ! bergeron effect for liquid precipitation treatment  
   !$OMP THREADPRIVATE(iflag_bergeron)
 
-  INTEGER, SAVE, PROTECTED :: iflag_fisrtilp_qsat=0        ! qsat adjustment (iterative) during autoconversion
+  INTEGER, SAVE, PROTECTED :: iflag_fisrtilp_qsat=0         ! qsat adjustment (iterative) during autoconversion
   !$OMP THREADPRIVATE(iflag_fisrtilp_qsat)
 
-  INTEGER, SAVE, PROTECTED :: iflag_pdf=0                  ! type of subgrid scale qtot pdf
+  INTEGER, SAVE, PROTECTED :: iflag_pdf=0                   ! type of subgrid scale qtot pdf
   !$OMP THREADPRIVATE(iflag_pdf)
 
-  INTEGER, SAVE, PROTECTED :: iflag_autoconversion=0       ! autoconversion option
+  INTEGER, SAVE, PROTECTED :: iflag_icefrac=0               ! which phase partitioning function to use
+  !$OMP THREADPRIVATE(iflag_icefrac)
+
+  INTEGER, SAVE, PROTECTED :: iflag_autoconversion=0        ! autoconversion option
   !$OMP THREADPRIVATE(iflag_autoconversion)
 
-  LOGICAL, SAVE, PROTECTED :: reevap_ice=.false.           ! no liquid precip for T< threshold
+
+  LOGICAL, SAVE, PROTECTED :: reevap_ice=.false.            ! no liquid precip for T< threshold
   !$OMP THREADPRIVATE(reevap_ice)
 
-  REAL, SAVE, PROTECTED :: cld_lc_lsc=2.6e-4               ! liquid autoconversion coefficient, stratiform rain
+  REAL, SAVE, PROTECTED :: cld_lc_lsc=2.6e-4                ! liquid autoconversion coefficient, stratiform rain
   !$OMP THREADPRIVATE(cld_lc_lsc)
 
@@ -118,5 +122,5 @@
   !$OMP THREADPRIVATE(coef_eva)
 
-  REAL, SAVE, PROTECTED :: coef_sub                        ! tuning coefficient ice precip sublimation
+  REAL, SAVE, PROTECTED :: coef_sub                         ! tuning coefficient ice precip sublimation
   !$OMP THREADPRIVATE(coef_sub)
 
@@ -124,5 +128,5 @@
   !$OMP THREADPRIVATE(expo_eva)
 
-  REAL, SAVE, PROTECTED :: expo_sub                       ! tuning coefficient ice precip sublimation
+  REAL, SAVE, PROTECTED :: expo_sub                         ! tuning coefficient ice precip sublimation
   !$OMP THREADPRIVATE(expo_sub)
 
@@ -226,4 +230,22 @@
   !$OMP THREADPRIVATE(thresh_precip_frac)
 
+  REAL, SAVE, PROTECTED :: tau_mixenv=100000                ! Homogeneization time of mixed phase clouds [s]
+  !$OMP THREADPRIVATE(tau_mixenv)
+
+    REAL, SAVE, PROTECTED :: capa_crystal=1.                ! Sursaturation of ice part in mixed phase clouds [-]
+  !$OMP THREADPRIVATE(capa_crystal)
+
+  REAL, SAVE, PROTECTED :: lmix_mpc=1000                    ! Length of turbulent zones in Mixed Phase Clouds [m]
+  !$OMP THREADPRIVATE(lmix_mpc)
+
+  REAL, SAVE, PROTECTED :: naero5=0.5                       ! Number concentration of aerosol larger than 0.5 microns [scm-3]
+  !$OMP THREADPRIVATE(naero5)
+
+  REAL, SAVE, PROTECTED :: gamma_snwretro = 0.              ! Proportion of snow taken into account in ice retroaction in icefrac_turb [-]
+  !$OMP THREADPRIVATE(gamma_snwretro)
+
+  REAL, SAVE, PROTECTED :: gamma_taud = 1.                  ! Tuning coeff for tau_dissipturb [-]
+  !$OMP THREADPRIVATE(gamma_taud)
+
   REAL, SAVE, PROTECTED :: gamma_col=1.                     ! A COMMENTER TODO [-]
   !$OMP THREADPRIVATE(gamma_col)
@@ -235,17 +257,17 @@
   !$OMP THREADPRIVATE(gamma_rim)
 
-  REAL, SAVE, PROTECTED :: rho_rain=1000.                    ! A COMMENTER TODO [kg/m3]
+  REAL, SAVE, PROTECTED :: rho_rain=1000.                   ! Rain density [kg/m3]
   !$OMP THREADPRIVATE(rho_rain)
 
-  REAL, SAVE, PROTECTED :: rho_ice=920.                    ! A COMMENTER TODO [kg/m3]
+  REAL, SAVE, PROTECTED :: rho_ice=920.                     ! Ice density  [kg/m3]
   !$OMP THREADPRIVATE(rho_ice)
 
-  REAL, SAVE, PROTECTED :: r_rain=500.E-6                   ! A COMMENTER TODO [m]
+  REAL, SAVE, PROTECTED :: r_rain=500.E-6                   ! Rain droplets radius for POPRECIP [m]
   !$OMP THREADPRIVATE(r_rain)
 
-  REAL, SAVE, PROTECTED :: r_snow=1.E-3                    ! A COMMENTER TODO [m]
+  REAL, SAVE, PROTECTED :: r_snow=1.E-3                     ! Ice crystals radius for POPRECIP [m]
   !$OMP THREADPRIVATE(r_snow)
 
-  REAL, SAVE, PROTECTED :: tau_auto_snow_min=100.          ! A COMMENTER TODO [s]
+  REAL, SAVE, PROTECTED :: tau_auto_snow_min=100.           ! A COMMENTER TODO [s]
   !$OMP THREADPRIVATE(tau_auto_snow_min)
 
@@ -256,32 +278,32 @@
   !$OMP THREADPRIVATE(eps)
 
-  REAL, SAVE, PROTECTED :: gamma_melt=1.                   ! A COMMENTER TODO [-]
+  REAL, SAVE, PROTECTED :: gamma_melt=1.                    ! A COMMENTER TODO [-]
   !$OMP THREADPRIVATE(gamma_melt)
 
-  REAL, SAVE, PROTECTED :: alpha_freez=4.                 ! A COMMENTER TODO [-]
+  REAL, SAVE, PROTECTED :: alpha_freez=4.                   ! A COMMENTER TODO [-]
   !$OMP THREADPRIVATE(alpha_freez)
 
-  REAL, SAVE, PROTECTED :: beta_freez=0.1                 ! A COMMENTER TODO [m-3.s-1]
+  REAL, SAVE, PROTECTED :: beta_freez=0.1                   ! A COMMENTER TODO [m-3.s-1]
   !$OMP THREADPRIVATE(beta_freez)
 
-  REAL, SAVE, PROTECTED :: gamma_freez=1.                 ! A COMMENTER TODO [-]
+  REAL, SAVE, PROTECTED :: gamma_freez=1.                   ! A COMMENTER TODO [-]
   !$OMP THREADPRIVATE(gamma_freez)
 
-  REAL, SAVE, PROTECTED :: rain_fallspeed=4.              ! A COMMENTER TODO [m/s]
+  REAL, SAVE, PROTECTED :: rain_fallspeed=4.                ! A COMMENTER TODO [m/s]
   !$OMP THREADPRIVATE(rain_fallspeed)
 
-  REAL, SAVE, PROTECTED :: rain_fallspeed_clr              ! A COMMENTER TODO [m/s]
+  REAL, SAVE, PROTECTED :: rain_fallspeed_clr                ! A COMMENTER TODO [m/s]
   !$OMP THREADPRIVATE(rain_fallspeed_clr)
 
-  REAL, SAVE, PROTECTED :: rain_fallspeed_cld             ! A COMMENTER TODO [m/s]
+  REAL, SAVE, PROTECTED :: rain_fallspeed_cld               ! A COMMENTER TODO [m/s]
   !$OMP THREADPRIVATE(rain_fallspeed_cld)
 
-  REAL, SAVE, PROTECTED :: snow_fallspeed=1.             ! A COMMENTER TODO [m/s]
+  REAL, SAVE, PROTECTED :: snow_fallspeed=1.               ! A COMMENTER TODO [m/s]
   !$OMP THREADPRIVATE(snow_fallspeed)
 
-  REAL, SAVE, PROTECTED :: snow_fallspeed_clr             ! A COMMENTER TODO [m/s]
+  REAL, SAVE, PROTECTED :: snow_fallspeed_clr               ! A COMMENTER TODO [m/s]
   !$OMP THREADPRIVATE(snow_fallspeed_clr)
 
-  REAL, SAVE, PROTECTED :: snow_fallspeed_cld             ! A COMMENTER TODO [m/s]
+  REAL, SAVE, PROTECTED :: snow_fallspeed_cld               ! A COMMENTER TODO [m/s]
   !$OMP THREADPRIVATE(snow_fallspeed_cld)
   !--End of the parameters for poprecip
@@ -325,5 +347,5 @@
     RLMLT=RLMLT_in
     RTT=RTT_in
-    RG=RG_in
+    RV=RV_in
     RVTMP2=RVTMP2_in
     RPI=RPI_in
@@ -347,4 +369,5 @@
     CALL getin_p('iflag_fisrtilp_qsat',iflag_fisrtilp_qsat)
     CALL getin_p('iflag_pdf',iflag_pdf)
+    CALL getin_p('iflag_icefrac',iflag_icefrac)
     CALL getin_p('reevap_ice',reevap_ice)
     CALL getin_p('cld_lc_lsc',cld_lc_lsc)
@@ -368,4 +391,10 @@
     CALL getin_p('dist_liq',dist_liq)
     CALL getin_p('tresh_cl',tresh_cl)
+    CALL getin_p('tau_mixenv',tau_mixenv)
+    CALL getin_p('capa_crystal',capa_crystal)
+    CALL getin_p('lmix_mpc',lmix_mpc)
+    CALL getin_p('naero5',naero5)
+    CALL getin_p('gamma_snwretro',gamma_snwretro)
+    CALL getin_p('gamma_taud',gamma_taud)
     CALL getin_p('iflag_oldbug_fisrtilp',iflag_oldbug_fisrtilp)
     CALL getin_p('temp_nowater',temp_nowater)
@@ -430,4 +459,5 @@
     WRITE(lunout,*) 'lscp_ini, iflag_fisrtilp_qsat:', iflag_fisrtilp_qsat
     WRITE(lunout,*) 'lscp_ini, iflag_pdf', iflag_pdf
+    WRITE(lunout,*) 'lscp_ini, iflag_icefrac', iflag_icefrac
     WRITE(lunout,*) 'lscp_ini, reevap_ice', reevap_ice
     WRITE(lunout,*) 'lscp_ini, cld_lc_lsc', cld_lc_lsc
@@ -448,4 +478,10 @@
     WRITE(lunout,*) 'lscp_ini, dist_liq', dist_liq
     WRITE(lunout,*) 'lscp_ini, tresh_cl', tresh_cl
+    WRITE(lunout,*) 'lscp_ini, tau_mixenv', tau_mixenv
+    WRITE(lunout,*) 'lscp_ini, capa_crystal', capa_crystal
+    WRITE(lunout,*) 'lscp_ini, lmix_mpc', lmix_mpc
+    WRITE(lunout,*) 'lscp_ini, naero5', naero5
+    WRITE(lunout,*) 'lscp_ini, gamma_snwretro', gamma_snwretro
+    WRITE(lunout,*) 'lscp_ini, gamma_taud', gamma_taud
     WRITE(lunout,*) 'lscp_ini, iflag_oldbug_fisrtilp', iflag_oldbug_fisrtilp
     WRITE(lunout,*) 'lscp_ini, fl_cor_ebil', fl_cor_ebil
Index: /LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp_poprecip.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp_poprecip.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp_poprecip.F90	(revision 5202)
@@ -559,7 +559,10 @@
 
     !--Same as for aggregation
-    !--Eff_snow_liq formula: following Milbrandt and Yau 2005,
+    !--Eff_snow_liq formula:
     !--it s a product of a collection efficiency and a sticking efficiency
-    Eff_snow_ice = 0.05 * EXP( 0.1 * ( temp(i) - RTT ) )
+    ! Milbrandt and Yau formula that gives very low values:
+    ! Eff_snow_ice = 0.05 * EXP( 0.1 * ( temp(i) - RTT ) )
+    ! Lin 1983's formula 
+    Eff_snow_ice = EXP( 0.025 * MIN( ( temp(i) - RTT ), 0.) ) 
     !--rho_snow formula follows Brandes et al. 2007 (JAMC)
     rho_snow = 1.e3 * 0.178 * ( r_snow * 2. * 1000. )**(-0.922)
@@ -653,7 +656,7 @@
     !--NB.: this process needs a temperature adjustment
 
-    !--Eff_snow_liq formula: following Seifert and Beheng 2006,
-    !--assuming a cloud droplet diameter of 20 microns.
-    Eff_snow_liq = 0.2
+    !--Eff_snow_liq formula: following Ferrier 1994,
+    !--assuming 1
+    Eff_snow_liq = 1.0
     !--rho_snow formula follows Brandes et al. 2007 (JAMC)
     rho_snow = 1.e3 * 0.178 * ( r_snow * 2. * 1000. )**(-0.922)
Index: /LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp_tools.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp_tools.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp_tools.F90	(revision 5202)
@@ -136,5 +136,5 @@
     CHARACTER (len = 80) :: abort_message
 
-    IF ((iflag_t_glace.LT.2) .OR. (iflag_t_glace.GT.6)) THEN
+    IF ((iflag_t_glace.LT.2)) THEN !.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)
@@ -194,5 +194,5 @@
 
         ! with CMIP6 function of temperature at cloud top
-        IF (iflag_t_glace .EQ. 5) THEN 
+        IF ((iflag_t_glace .EQ. 5) .OR. (iflag_t_glace .EQ. 7)) THEN 
                 liqfrac_tmp = (temp(i)-t_glace_min) / (t_glace_max-t_glace_min)
                 liqfrac_tmp =  MIN(MAX(liqfrac_tmp,0.0),1.0)
@@ -232,8 +232,7 @@
                 ENDIF 
         ENDIF
-
+      
 
      ENDDO ! klon
- 
      RETURN
  
@@ -241,4 +240,275 @@
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
+SUBROUTINE ICEFRAC_LSCP_TURB(klon, dtime, temp, pplay, paprsdn, paprsup, qice_ini, snowcld, qtot_incl, cldfra, tke, tke_dissip, qliq, qvap_cld, qice, icefrac, dicefracdT, cldfraliq, sigma2_icefracturb, mean_icefracturb)
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! Compute the liquid, ice and vapour content (+ice fraction) based 
+  ! on turbulence (see Fields 2014, Furtado 2016, Raillard 2025)
+  ! L.Raillard (30/08/24)
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+   USE lmdz_lscp_ini, ONLY : prt_level, lunout
+   USE lmdz_lscp_ini, ONLY : RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RG, RV, RPI
+   USE lmdz_lscp_ini, ONLY : seuil_neb, temp_nowater
+   USE lmdz_lscp_ini, ONLY : tau_mixenv, lmix_mpc, naero5, gamma_snwretro, gamma_taud, capa_crystal
+   USE lmdz_lscp_ini, ONLY : eps
+
+   IMPLICIT NONE
+
+   INTEGER,   INTENT(IN)                           :: klon              !--number of horizontal grid points
+   REAL,      INTENT(IN)                           :: dtime             !--time step [s]
+
+   REAL,      INTENT(IN),       DIMENSION(klon)    :: temp              !--temperature
+   REAL,      INTENT(IN),       DIMENSION(klon)    :: pplay             !--pressure in the middle of the layer       [Pa]
+   REAL,      INTENT(IN),       DIMENSION(klon)    :: paprsdn           !--pressure at the bottom interface of the layer [Pa]
+   REAL,      INTENT(IN),       DIMENSION(klon)    :: paprsup           !--pressure at the top interface of the layer [Pa]
+   REAL,      INTENT(IN),       DIMENSION(klon)    :: qtot_incl         !--specific total cloud water content, in-cloud content [kg/kg]
+   REAL,      INTENT(IN),       DIMENSION(klon)    :: cldfra            !--cloud fraction in gridbox [-]
+   REAL,      INTENT(IN),       DIMENSION(klon)    :: tke               !--turbulent kinetic energy [m2/s2]
+   REAL,      INTENT(IN),       DIMENSION(klon)    :: tke_dissip        !--TKE dissipation [m2/s3]
+
+   REAL,      INTENT(IN),       DIMENSION(klon)    :: qice_ini          !--initial specific ice content gridbox-mean [kg/kg]
+   REAL,      INTENT(IN),       DIMENSION(klon)    :: snowcld
+   REAL,      INTENT(OUT),      DIMENSION(klon)    :: qliq              !--specific liquid content gridbox-mean [kg/kg]
+   REAL,      INTENT(OUT),      DIMENSION(klon)    :: qvap_cld          !--specific cloud vapor content, gridbox-mean [kg/kg]
+   REAL,      INTENT(OUT),      DIMENSION(klon)    :: qice              !--specific ice content gridbox-mean [kg/kg]
+   REAL,      INTENT(OUT),      DIMENSION(klon)    :: icefrac           !--fraction of ice in condensed water [-]
+   REAL,      INTENT(OUT),      DIMENSION(klon)    :: dicefracdT
+
+   REAL,      INTENT(OUT),      DIMENSION(klon)    :: cldfraliq         !--fraction of cldfra which is liquid only
+   REAL,      INTENT(OUT),      DIMENSION(klon)    :: sigma2_icefracturb     !--Temporary 
+   REAL,      INTENT(OUT),      DIMENSION(klon)    :: mean_icefracturb      !--Temporary 
+
+   REAL, DIMENSION(klon) :: qzero, qsatl, dqsatl, qsati, dqsati         !--specific humidity saturation values
+   INTEGER :: i
+
+   REAL :: qvap_incl, qice_incl, qliq_incl, qiceini_incl                !--In-cloud specific quantities [kg/kg]
+   REAL :: qsnowcld_incl
+   !REAL :: capa_crystal                                                 !--Capacitance of ice crystals  [-]
+   REAL :: water_vapor_diff                                             !--Water-vapour diffusion coefficient in air [m2/s] (function of T&P)
+   REAL :: air_thermal_conduct                                          !--Thermal conductivity of air [J/m/K/s] (function of T)
+   REAL :: C0                                                           !--Lagrangian structure function [-]
+   REAL :: tau_mixingenv
+   REAL :: tau_dissipturb
+   REAL :: invtau_phaserelax
+   REAL :: sigma2_pdf, mean_pdf
+   REAL :: ai, bi, B0
+   REAL :: sursat_iceliq
+   REAL :: sursat_env
+   REAL :: liqfra_max
+   REAL :: sursat_iceext
+   REAL :: nb_crystals                                                  !--number concentration of ice crystals [#/m3]
+   REAL :: moment1_PSD                                                  !--1st moment of ice PSD 
+   REAL :: N0_PSD, lambda_PSD                                           !--parameters of the exponential PSD
+
+   REAL :: rho_ice                                                      !--ice density [kg/m3]
+   REAL :: cldfra1D
+   REAL :: deltaz, rho_air
+   REAL :: psati                                                        !--saturation vapor pressure wrt i [Pa]
+   
+   C0            = 10.                                                  !--value assumed in Field2014            
+   rho_ice       = 950.
+   sursat_iceext = -0.1
+   !capa_crystal  = 1. !r_ice                                       
+   qzero(:)      = 0.
+   cldfraliq(:)  = 0.
+   icefrac(:)    = 0.
+   dicefracdT(:) = 0.
+
+   sigma2_icefracturb(:) = 0.
+   mean_icefracturb(:)  = 0.
+
+   !--wrt liquid water
+   CALL calc_qsat_ecmwf(klon,temp(:),qzero(:),pplay(:),RTT,1,.false.,qsatl(:),dqsatl(:))
+   !--wrt ice
+   CALL calc_qsat_ecmwf(klon,temp(:),qzero(:),pplay(:),RTT,2,.false.,qsati(:),dqsati(:))
+
+
+    DO i=1,klon
+
+
+     rho_air  = pplay(i) / temp(i) / RD
+     !deltaz   = ( paprsdn(i) - paprsup(i) ) / RG / rho_air(i)
+     ! because cldfra is intent in, but can be locally modified due to test 
+     cldfra1D = cldfra(i)
+     IF (cldfra(i) .LE. 0.) THEN
+        qvap_cld(i)   = 0.
+        qliq(i)       = 0.
+        qice(i)       = 0.
+        cldfraliq(i)  = 0.
+        icefrac(i)    = 0.
+        dicefracdT(i) = 0.
+
+     ! If there is a cloud
+     ELSE
+        IF (cldfra(i) .GE. 1.0) THEN
+           cldfra1D = 1.0
+        END IF
+        
+        ! T>0°C, no ice allowed
+        IF ( temp(i) .GE. RTT ) THEN
+           qvap_cld(i)   = qsatl(i) * cldfra1D
+           qliq(i)       = MAX(0.0,qtot_incl(i)-qsatl(i))  * cldfra1D
+           qice(i)       = 0.
+           cldfraliq(i)  = 1.
+           icefrac(i)    = 0.
+           dicefracdT(i) = 0.
+        
+        ! T<-38°C, no liquid allowed
+        ELSE IF ( temp(i) .LE. temp_nowater) THEN
+           qvap_cld(i)   = qsati(i) * cldfra1D
+           qliq(i)       = 0.
+           qice(i)       = MAX(0.0,qtot_incl(i)-qsati(i)) * cldfra1D
+           cldfraliq(i)  = 0.
+           icefrac(i)    = 1.
+           dicefracdT(i) = 0.
+
+        ! MPC temperature
+        ELSE
+           ! Not enough TKE     
+           IF ( tke_dissip(i) .LE. eps )  THEN
+              qvap_cld(i)   = qsati(i) * cldfra1D
+              qliq(i)       = 0.
+              qice(i)       = MAX(0.,qtot_incl(i)-qsati(i)) * cldfra1D   
+              cldfraliq(i)  = 0.
+              icefrac(i)    = 1.
+              dicefracdT(i) = 0.
+           
+           ! Enough TKE   
+           ELSE  
+              print*,"MOUCHOIRACTIVE"
+              !---------------------------------------------------------
+              !--               ICE SUPERSATURATION PDF   
+              !--------------------------------------------------------- 
+              !--If -38°C< T <0°C and there is enough turbulence, 
+              !--we compute the cloud liquid properties with a Gaussian PDF 
+              !--of ice supersaturation F(Si) (Field2014, Furtado2016). 
+              !--Parameters of the PDF are function of turbulence and 
+              !--microphysics/existing ice.
+
+              sursat_iceliq = qsatl(i)/qsati(i) - 1.
+              psati         = qsati(i) * pplay(i) / (RD/RV)
+
+              !-------------- MICROPHYSICAL TERMS --------------
+              !--We assume an exponential ice PSD whose parameters 
+              !--are computed following Morrison&Gettelman 2008
+              !--Ice number density is assumed equals to INP density 
+              !--which is a function of temperature (DeMott 2010)  
+              !--bi and B0 are microphysical function characterizing 
+              !--vapor/ice interactions
+              !--tau_phase_relax is the typical time of vapor deposition
+              !--onto ice crystals
+              
+              qiceini_incl  = qice_ini(i) / cldfra1D
+              qsnowcld_incl = snowcld(i) * RG * dtime / ( paprsdn(i) - paprsup(i) ) / cldfra1D
+              sursat_env    = max(0., (qtot_incl(i) - qiceini_incl)/qsati(i) - 1.)
+              IF ( qiceini_incl .GT. eps ) THEN
+                nb_crystals = 1.e3 * 5.94e-5 * ( RTT - temp(i) )**3.33 * naero5**(0.0264*(RTT-temp(i))+0.0033)
+                lambda_PSD  = ( (RPI*rho_ice*nb_crystals) / (rho_air*(qiceini_incl + gamma_snwretro * qsnowcld_incl)) ) ** (1./3.)
+                N0_PSD      = nb_crystals * lambda_PSD
+                moment1_PSD = N0_PSD/lambda_PSD**2
+              ELSE
+                moment1_PSD = 0.
+              ENDIF
+
+              !--Formulae for air thermal conductivity and water vapor diffusivity 
+              !--comes respectively from Beard and Pruppacher (1971) 
+              !--and  Hall and Pruppacher (1976)
+
+              air_thermal_conduct = ( 5.69 + 0.017 * ( temp(i) - RTT ) ) * 1.e-3 * 4.184
+              water_vapor_diff    = 2.11*1e-5 * ( temp(i) / RTT )**1.94 * ( 101325 / pplay(i) )
+              
+              bi = 1./((qsati(i)+qsatl(i))/2.) + RLSTT**2 / RCPD / RV / temp(i)**2
+              B0 = 4. * RPI * capa_crystal * 1. / (  RLSTT**2 / air_thermal_conduct / RV / temp(i)**2  &
+                                                  +  RV * temp(i) / psati / water_vapor_diff  )
+
+              invtau_phaserelax  = (bi * B0 * moment1_PSD )
+
+!             Old way of estimating moment1 : spherical crystals + monodisperse PSD              
+!             nb_crystals = rho_air * qiceini_incl / ( 4. / 3. * RPI * r_ice**3. * rho_ice )
+!             moment1_PSD = nb_crystals * r_ice 
+
+              !----------------- TURBULENT SOURCE/SINK TERMS -----------------
+              !--Tau_mixingenv is the time needed to homogeneize the parcel 
+              !--with its environment by turbulent diffusion over the parcel
+              !--length scale
+              !--if lmix_mpc <0, tau_mixigenv value is prescribed
+              !--else tau_mixigenv value is derived from tke_dissip and lmix_mpc
+              !--Tau_dissipturb is the time needed turbulence to decay due to
+              !--viscosity
+
+              ai = RG / RD / temp(i) * ( RD * RLSTT / RCPD / RV / temp(i) - 1. )
+              IF ( lmix_mpc .GT. 0 ) THEN 
+                 tau_mixingenv = ( lmix_mpc**2. / tke_dissip(i) )**(1./3.)
+              ELSE 
+                 tau_mixingenv = tau_mixenv
+              ENDIF 
+              
+              tau_dissipturb = gamma_taud * 2. * 2./3. * tke(i) / tke_dissip(i) / C0
+
+              !--------------------- PDF COMPUTATIONS ---------------------
+              !--Formulae for sigma2_pdf (variance), mean of PDF in Furtado2016
+              !--cloud liquid fraction and in-cloud liquid content are given 
+              !--by integrating resp. F(Si) and Si*F(Si)
+              !--Liquid is limited by the available water vapor trough a 
+              !--maximal liquid fraction
+
+              liqfra_max = MAX(0., (MIN (1.,( qtot_incl(i) - qiceini_incl - qsati(i) * (1 + sursat_iceext ) ) / ( qsatl(i) - qsati(i) ) ) ) )
+              sigma2_pdf = 1./2. * ( ai**2 ) *  2./3. * tke(i) * tau_dissipturb / ( invtau_phaserelax + 1./tau_mixingenv )
+              mean_pdf   = sursat_env * 1./tau_mixingenv / ( invtau_phaserelax + 1./tau_mixingenv )
+              cldfraliq(i) = 0.5 * (1. - erf( ( sursat_iceliq - mean_pdf) / (SQRT(2.* sigma2_pdf) ) ) )
+              IF (cldfraliq(i) .GT. liqfra_max) THEN
+                  cldfraliq(i) = liqfra_max
+              ENDIF 
+              
+              qliq_incl = qsati(i) * SQRT(sigma2_pdf) / SQRT(2.*RPI) * EXP( -1.*(sursat_iceliq - mean_pdf)**2. / (2.*sigma2_pdf) )  &
+                        - qsati(i) * cldfraliq(i) * (sursat_iceliq - mean_pdf )
+              
+              sigma2_icefracturb(i)= sigma2_pdf
+              mean_icefracturb(i)  = mean_pdf 
+     
+              !------------ SPECIFIC VAPOR CONTENT AND WATER CONSERVATION  ------------
+
+              IF ( (qliq_incl .LE. eps) .OR. (cldfraliq(i) .LE. eps) ) THEN
+                  qliq_incl    = 0.
+                  cldfraliq(i) = 0.
+              END IF
+               
+              !--Specific humidity is the max between qsati and the weighted mean between 
+              !--qv in MPC patches and qv in ice-only parts. We assume that MPC parts are
+              !--always at qsatl and ice-only parts slightly subsaturated (qsati*sursat_iceext+1)
+              !--The whole cloud can therefore be supersaturated but never subsaturated.
+
+              qvap_incl = MAX(qsati(i), ( 1. - cldfraliq(i) ) * (sursat_iceext + 1.) * qsati(i) + cldfraliq(i) * qsatl(i) )
+
+
+              IF ( qvap_incl  .GE. qtot_incl(i) ) THEN
+                 qvap_incl = qsati(i)
+                 qliq_incl = qtot_incl(i) - qvap_incl
+                 qice_incl = 0.
+
+              ELSEIF ( (qvap_incl + qliq_incl) .GE. qtot_incl(i) ) THEN
+                 qliq_incl = MAX(0.0,qtot_incl(i) - qvap_incl)
+                 qice_incl = 0.
+              ELSE
+                 qice_incl = qtot_incl(i) - qvap_incl - qliq_incl
+              END IF
+
+              qvap_cld(i)   = qvap_incl * cldfra1D
+              qliq(i)       = qliq_incl * cldfra1D
+              qice(i)       = qice_incl * cldfra1D
+              icefrac(i)    = qice(i) / ( qice(i) + qliq(i) )
+              dicefracdT(i) = 0.
+              !print*,'MPC turb'
+
+           END IF ! Enough TKE
+
+        END IF ! ! MPC temperature
+
+     END IF ! cldfra
+   
+   ENDDO ! klon
+END SUBROUTINE ICEFRAC_LSCP_TURB
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
 
Index: /LMDZ6/branches/cirrus/libf/phylmd/lmdz_thermcell_plume_6A.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/lmdz_thermcell_plume_6A.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/lmdz_thermcell_plume_6A.F90	(revision 5202)
@@ -63,5 +63,5 @@
       REAL,dimension(ngrid,nlay) :: zeps
 
-      REAL, dimension(ngrid) ::    wmaxa(ngrid)
+      REAL, dimension(ngrid) ::    wmaxa
 
       INTEGER ig,l,k,lt,it,lm
Index: /LMDZ6/branches/cirrus/libf/phylmd/ocean_forced_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/ocean_forced_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/ocean_forced_mod.F90	(revision 5202)
@@ -22,5 +22,10 @@
        radsol, snow, agesno, & 
        qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-       tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa)
+       tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa &
+#ifdef ISO
+       ,xtprecip_rain, xtprecip_snow, xtspechum,Roce,rlat, &
+       xtsnow,xtevap,h1 &  
+#endif            
+       )
 !
 ! This subroutine treats the "open ocean", all grid points that are not entierly covered
@@ -36,4 +41,13 @@
     USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
     use config_ocean_skin_m, only: activate_ocean_skin
+#ifdef ISO
+    USE infotrac_phy, ONLY: ntiso,niso
+    USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, calcul_iso_surf_sic_vectall    
+#ifdef ISOVERIF
+    USE isotopes_mod, ONLY: iso_eau,ridicule
+    !USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_egalite_choix
+    USE isotopes_verif_mod
+#endif
+#endif
 
     INCLUDE "YOMCST.h"
@@ -57,4 +71,10 @@
     real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
 
+#ifdef ISO
+    REAL, DIMENSION(ntiso,klon), INTENT(IN)  :: xtprecip_rain, xtprecip_snow
+    REAL, DIMENSION(ntiso,klon), INTENT(IN)  :: xtspechum
+    REAL, DIMENSION(klon),       INTENT(IN)  :: rlat
+#endif
+
 ! In/Output arguments
 !****************************************************************************************
@@ -62,5 +82,9 @@
     REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
     REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno !? put to 0 in ocean
-  
+#ifdef ISO     
+    REAL, DIMENSION(niso,klon), INTENT(IN)   :: xtsnow
+    REAL, DIMENSION(niso,klon), INTENT(INOUT):: Roce
+#endif
+
 ! Output arguments
 !****************************************************************************************
@@ -72,4 +96,9 @@
     REAL, intent(out):: sens_prec_liq(:) ! (knon)
 
+#ifdef ISO     
+    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap ! isotopes in evaporation flux
+    REAL, DIMENSION(klon),       INTENT(OUT) :: h1 ! just a diagnostic, not useful for the simulation
+#endif
+
 ! Local variables
 !****************************************************************************************
@@ -80,6 +109,10 @@
     REAL, DIMENSION(klon)       :: u1_lay, v1_lay
     LOGICAL                     :: check=.FALSE.
-    REAL sens_prec_sol(knon) 
-    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol    
+    REAL, DIMENSION(knon)       :: sens_prec_sol
+    REAL, DIMENSION(klon)       :: lat_prec_liq, lat_prec_sol    
+#ifdef ISO   
+    REAL, PARAMETER :: t_coup = 273.15      
+#endif
+
 
 !****************************************************************************************
@@ -87,5 +120,20 @@
 !****************************************************************************************
     IF (check) WRITE(*,*)' Entering ocean_forced_noice'
-    
+
+#ifdef ISO
+#ifdef ISOVERIF
+    DO i = 1, knon
+      IF (iso_eau > 0) THEN         
+        CALL iso_verif_egalite_choix(xtspechum(iso_eau,i), &
+     &                  spechum(i),'ocean_forced_mod 111', &
+     &                  errmax,errmaxrel)     
+        CALL iso_verif_egalite_choix(snow(i), &
+     &                  xtsnow(iso_eau,i),'ocean_forced_mod 117', &
+     &                  errmax,errmaxrel)
+      ENDIF !IF (iso_eau > 0) THEN
+    ENDDO !DO i=1,knon
+#endif      
+#endif 
+
 !****************************************************************************************
 ! 1)    
@@ -103,5 +151,9 @@
 
     else ! GCM
-      CALL limit_read_sst(knon,knindex,tsurf_lim)
+      CALL limit_read_sst(knon,knindex,tsurf_lim &
+#ifdef ISO
+     &     ,Roce,rlat &
+#endif     
+     &     )
     endif ! knon
 !sb--
@@ -161,4 +213,27 @@
          flux_u1, flux_v1)  
 
+#ifdef ISO     
+    CALL calcul_iso_surf_oce_vectall(klon, knon,t_coup, &
+     &    ps,tsurf_new,spechum,u1_lay, v1_lay, xtspechum, &
+     &    evap, Roce,xtevap,h1 &
+#ifdef ISOTRAC
+     &    ,knindex &
+#endif
+     &    )
+#endif         
+
+#ifdef ISO
+#ifdef ISOVERIF
+!          write(*,*) 'ocean_forced_mod 176: sortie de ocean_forced_noice'
+    IF (iso_eau > 0) THEN
+      DO i = 1, knon               
+        CALL iso_verif_egalite_choix(snow(i), &
+     &          xtsnow(iso_eau,i),'ocean_forced_mod 180', &
+     &          errmax,errmaxrel)
+      ENDDO ! DO j=1,knon
+    ENDIF !IF (iso_eau > 0) THEN
+#endif
+#endif   
+
   END SUBROUTINE ocean_forced_noice
 !
@@ -173,5 +248,10 @@
        radsol, snow, qsol, agesno, tsoil, &
        qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-       tsurf_new, dflux_s, dflux_l, rhoa)
+       tsurf_new, dflux_s, dflux_l, rhoa &
+#ifdef ISO
+       ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
+       xtsnow, xtsol,xtevap,Rland_ice &  
+#endif            
+       )
 !
 ! This subroutine treats the ocean where there is ice. 
@@ -187,4 +267,13 @@
     USE indice_sol_mod
     USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
+#ifdef ISO
+    USE infotrac_phy, ONLY: niso, ntiso
+    USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, calcul_iso_surf_sic_vectall 
+#ifdef ISOVERIF
+    USE isotopes_mod, ONLY: iso_eau,ridicule
+    !USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_egalite_choix
+    USE isotopes_verif_mod
+#endif
+#endif
 
 !   INCLUDE "indicesol.h"
@@ -209,4 +298,10 @@
     REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1, gustiness
     real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
+#ifdef ISO
+    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
+    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum
+    REAL, DIMENSION(niso,klon),  INTENT(IN) :: Roce 
+    REAL, DIMENSION(niso,klon),  INTENT(IN) :: Rland_ice
+#endif
 
 ! In/Output arguments
@@ -216,4 +311,8 @@
     REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
     REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
+#ifdef ISO     
+    REAL, DIMENSION(niso,klon), INTENT(INOUT)     :: xtsnow
+    REAL, DIMENSION(niso,klon), INTENT(IN)        :: xtsol
+#endif
 
 ! Output arguments
@@ -226,4 +325,7 @@
     REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
     REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l      
+#ifdef ISO     
+    REAL, DIMENSION(ntiso,klon), INTENT(OUT)      :: xtevap
+#endif      
 
 ! Local variables
@@ -238,7 +340,21 @@
     REAL, DIMENSION(klon)       :: u0, v0
     REAL, DIMENSION(klon)       :: u1_lay, v1_lay
-    REAL sens_prec_liq(knon), sens_prec_sol (knon)   
+    REAL, DIMENSION(knon)       :: sens_prec_liq, sens_prec_sol
     REAL, DIMENSION(klon)       :: lat_prec_liq, lat_prec_sol    
 
+#ifdef ISO
+    REAL, PARAMETER :: t_coup = 273.15
+    REAL, DIMENSION(klon) :: fq_fonte_diag
+    REAL, DIMENSION(klon) :: fqfonte_diag
+    REAL, DIMENSION(klon) :: snow_evap_diag 
+    REAL, DIMENSION(klon) :: fqcalving_diag 
+    REAL, DIMENSION(klon) :: run_off_lic_diag
+    REAL :: coeff_rel_diag
+    REAL :: max_eau_sol_diag  
+    REAL, DIMENSION(klon) :: runoff_diag    
+    INTEGER IXT
+    REAL, DIMENSION(niso,klon) :: xtsnow_prec, xtsol_prec
+    REAL, DIMENSION(klon) :: snow_prec, qsol_prec  
+#endif
 
 !****************************************************************************************
@@ -307,7 +423,68 @@
 !
 !****************************************************************************************
+#ifdef ISO
+   ! verif
+#ifdef ISOVERIF
+    DO i = 1, knon
+      IF (iso_eau > 0) THEN
+        IF (snow(i) > ridicule) THEN
+          CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
+   &              'interfsurf 964',errmax,errmaxrel)
+        ENDIF !IF ((snow(i) > ridicule)) THEN
+      ENDIF !IF (iso_eau > 0) THEN      
+    ENDDO !DO i=1,knon  
+#endif
+   ! end verif
+
+    DO i = 1, knon
+      snow_prec(i) = snow(i)
+      DO ixt = 1, niso
+      xtsnow_prec(ixt,i) = xtsnow(ixt,i)
+      ENDDO !DO ixt=1,niso
+      ! initialisation:
+      fq_fonte_diag(i) = 0.0
+      fqfonte_diag(i)  = 0.0
+      snow_evap_diag(i)= 0.0
+    ENDDO !DO i=1,knon
+#endif
+
+
     CALL fonte_neige( knon, is_sic, knindex, dtime, &
          tsurf_tmp, precip_rain, precip_snow, &
-         snow, qsol, tsurf_new, evap)
+         snow, qsol, tsurf_new, evap &
+#ifdef ISO    
+     &  ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
+     &  ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag   &
+#endif
+     &   )
+
+
+#ifdef ISO
+! isotopes: tout est externalisé
+!#ifdef ISOVERIF
+!        write(*,*) 'ocean_forced_mod 377: call calcul_iso_surf_sic_vectall'
+!        write(*,*) 'klon,knon=',klon,knon
+!#endif
+    CALL calcul_iso_surf_sic_vectall(klon,knon, &
+     &          evap,snow_evap_diag,Tsurf_new,Roce,snow, &
+     &          fq_fonte_diag,fqfonte_diag,dtime,t_coup, &
+     &          precip_snow,xtprecip_snow,xtprecip_rain, snow_prec,xtsnow_prec, &
+     &          xtspechum,spechum,ps, &
+     &          xtevap,xtsnow,fqcalving_diag, &
+     &          knindex,is_sic,run_off_lic_diag,coeff_rel_diag,Rland_ice &
+     &   )
+#ifdef ISOVERIF
+        !write(*,*) 'ocean_forced_mod 391: sortie calcul_iso_surf_sic_vectall'
+    IF (iso_eau > 0) THEN
+      DO i = 1, knon  
+        CALL iso_verif_egalite_choix(snow(i), &
+     &           xtsnow(iso_eau,i),'ocean_forced_mod 396', &
+     &           errmax,errmaxrel)
+      ENDDO ! DO j=1,knon
+    ENDIF !IF (iso_eau > 0) then
+#endif 
+!#ifdef ISOVERIF
+#endif   
+!#ifdef ISO
     
 ! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno)
Index: /LMDZ6/branches/cirrus/libf/phylmd/pbl_surface_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/pbl_surface_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/pbl_surface_mod.F90	(revision 5202)
@@ -33,4 +33,7 @@
                                   wx_pbl_check, wx_pbl_dts_check, wx_evappot
   use config_ocean_skin_m, only: activate_ocean_skin
+#ifdef ISO
+  USE infotrac_phy, ONLY: niso,ntraciso=>ntiso    
+#endif
 
   IMPLICIT NONE
@@ -49,8 +52,19 @@
   !$OMP THREADPRIVATE(ydTs0, ydqs0)
 
+#ifdef ISO
+  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: xtsnow   ! snow at surface
+  !$OMP THREADPRIVATE(xtsnow)
+  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: Rland_ice   ! snow at surface
+  !$OMP THREADPRIVATE(Rland_ice)  
+  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: Roce   ! snow at surface
+  !$OMP THREADPRIVATE(Roce)  
+#endif
+
   INTEGER, SAVE :: iflag_pbl_surface_t2m_bug
   !$OMP THREADPRIVATE(iflag_pbl_surface_t2m_bug)
   INTEGER, SAVE :: iflag_new_t2mq2m
   !$OMP THREADPRIVATE(iflag_new_t2mq2m)
+  LOGICAL, SAVE :: ok_bug_zg_wk_pbl
+  !$OMP THREADPRIVATE(ok_bug_zg_wk_pbl)
 
 !FC
@@ -176,4 +190,69 @@
 
   END SUBROUTINE pbl_surface_init
+
+#ifdef ISO
+  SUBROUTINE pbl_surface_init_iso(xtsnow_rst,Rland_ice_rst)
+
+! This routine should be called after the restart file has been read.
+! This routine initialize the restart variables and does some validation tests
+! for the index of the different surfaces and tests the choice of type of ocean.
+
+    USE indice_sol_mod
+    USE print_control_mod, ONLY: lunout
+#ifdef ISOVERIF
+    USE isotopes_mod, ONLY: iso_eau,ridicule
+    USE isotopes_verif_mod
+#endif
+    IMPLICIT NONE
+
+    INCLUDE "dimsoil.h"
+ 
+! Input variables
+!****************************************************************************************
+    REAL, DIMENSION(niso,klon, nbsrf), INTENT(IN)          :: xtsnow_rst
+    REAL, DIMENSION(niso,klon), INTENT(IN)          :: Rland_ice_rst
+  
+! Local variables
+!****************************************************************************************
+    INTEGER                       :: ierr
+    CHARACTER(len=80)             :: abort_message
+    CHARACTER(len = 20)           :: modname = 'pbl_surface_init'
+    integer i,ixt
+    
+!****************************************************************************************
+! Allocate and initialize module variables with fields read from restart file.
+!
+!****************************************************************************************    
+
+    ALLOCATE(xtsnow(niso,klon,nbsrf), stat=ierr)
+    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
+
+    ALLOCATE(Rland_ice(niso,klon), stat=ierr)
+    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
+
+    ALLOCATE(Roce(niso,klon), stat=ierr)
+    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
+
+    xtsnow(:,:,:)  = xtsnow_rst(:,:,:)
+    Rland_ice(:,:) = Rland_ice_rst(:,:)
+    Roce(:,:)      = 0.0
+
+#ifdef ISOVERIF 
+      IF (iso_eau >= 0) THEN
+         CALL iso_verif_egalite_vect2D( &
+     &           xtsnow,snow, &
+     &           'pbl_surface_mod 170',niso,klon,nbsrf)
+         DO i=1,klon  
+            IF (iso_eau >= 0) THEN  
+              CALL iso_verif_egalite(Rland_ice(iso_eau,i),1.0, &
+     &         'pbl_surf_mod 177')
+            ENDIF
+         ENDDO
+      ENDIF
+#endif
+
+  END SUBROUTINE pbl_surface_init_iso
+#endif
+
 !  
 !****************************************************************************************
@@ -239,5 +318,12 @@
 !FC
 !!!
-                        )
+#ifdef ISO
+     &   ,xtrain_f, xtsnow_f,xt, &
+     &   wake_dlxt,zxxtevap,xtevap, &
+     &   d_xt,d_xt_w,d_xt_x, &
+     &   xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, &
+     &   h1_diag,runoff_diag,xtrunoff_diag &
+#endif      
+     &   )
 !****************************************************************************************
 ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
@@ -314,4 +400,13 @@
     USE mod_grid_phy_lmdz,  ONLY : nbp_lon, nbp_lat, grid1dto2d_glo
     USE print_control_mod,  ONLY : prt_level,lunout
+#ifdef ISO
+  USE isotopes_mod, ONLY: Rdefault,iso_eau
+#ifdef ISOVERIF
+        USE isotopes_verif_mod
+#endif
+#ifdef ISOTRAC
+        USE isotrac_mod, only: index_iso
+#endif
+#endif
     USE ioipsl_getin_p_mod, ONLY : getin_p
     use phys_state_var_mod, only: ds_ns, dt_ns, delta_sst, delta_sal, dter, &
@@ -366,5 +461,11 @@
     REAL, DIMENSION(klon),        INTENT(IN)        :: gustiness ! gustiness
 
-    REAL, DIMENSION(klon),        INTENT(IN)        :: cldt    ! total cloud fraction
+    REAL, DIMENSION(klon),        INTENT(IN)        :: cldt    ! total cloud 
+
+#ifdef ISO
+    REAL, DIMENSION(ntraciso,klon,klev),   INTENT(IN)        :: xt       ! water vapour (kg/kg)
+    REAL, DIMENSION(ntraciso,klon),        INTENT(IN)        :: xtrain_f  ! rain fall
+    REAL, DIMENSION(ntraciso,klon),        INTENT(IN)        :: xtsnow_f  ! snow fall
+#endif
 
 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
@@ -379,5 +480,7 @@
     REAL, DIMENSION(klon),        INTENT(IN)        :: wake_dens
 !!!
-
+#ifdef ISO
+    REAL, DIMENSION(ntraciso,klon,klev),   INTENT(IN)        :: wake_dlxt   
+#endif
 ! Input/Output variables
 !****************************************************************************************
@@ -448,4 +551,14 @@
     REAL, INTENT(OUT):: zcoefm(:, :, :) ! (klon, klev, nbsrf + 1)
     ! coef for turbulent diffusion of U and V (?), mean for each grid point
+#ifdef ISO
+    REAL, DIMENSION(ntraciso,klon),        INTENT(OUT)       :: zxxtevap     ! water vapour flux at surface, positiv upwards
+    REAL, DIMENSION(ntraciso,klon, klev),  INTENT(OUT)       :: d_xt        ! change in water vapour
+    REAL, DIMENSION(klon),                 INTENT(OUT)       :: runoff_diag
+    REAL, DIMENSION(niso,klon),            INTENT(OUT)       :: xtrunoff_diag
+    REAL, DIMENSION(ntraciso,klon,klev),   INTENT(OUT)       :: d_xt_w
+    REAL, DIMENSION(ntraciso,klon,klev),   INTENT(OUT)       :: d_xt_x
+#endif
+
+
 
 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
@@ -511,5 +624,10 @@
     REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v     ! v wind tension (kg m/s)/(m**2 s) or Pascal
 !FC
-    REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT)  :: treedrg      ! tree drag (m)               
+    REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: treedrg  ! tree drag (m)               
+#ifdef ISO        
+    REAL, DIMENSION(niso,klon),   INTENT(OUT)       :: xtsol      ! water height in the soil (mm)
+    REAL, DIMENSION(ntraciso,klon, nbsrf)           :: xtevap     ! evaporation at surface
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: h1_diag    ! just diagnostic, not useful
+#endif
 
 
@@ -525,4 +643,10 @@
     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
+    REAL, DIMENSION(niso,klon),                  INTENT(OUT) :: zxxtsnow    ! snow at surface, mean for each grid point
+    REAL, DIMENSION(ntraciso,klon, klev),        INTENT(OUT) :: zxfluxxt    ! water vapour flux, mean for each grid point 
+    REAL, DIMENSION(ntraciso,klon, klev, nbsrf), INTENT(OUT) :: flux_xt     ! water vapour flux(latent flux) (kg/m**2/s)  
+#endif
 
 ! Martin
@@ -573,4 +697,12 @@
     REAL, DIMENSION(klon)              :: ysnow, yqsurf, yagesno, yqsol
     REAL, DIMENSION(klon)              :: yrain_f, ysnow_f, ybs_f
+#ifdef ISO
+    REAL, DIMENSION(ntraciso,klon)     :: yxt1
+    REAL, DIMENSION(niso,klon)         :: yxtsnow, yxtsol   
+    REAL, DIMENSION(ntraciso,klon)     :: yxtrain_f, yxtsnow_f 
+    REAL, DIMENSION(klon)              :: yrunoff_diag
+    REAL, DIMENSION(niso,klon)         :: yxtrunoff_diag
+    REAL, DIMENSION(niso,klon)         :: yRland_ice    
+#endif
     REAL, DIMENSION(klon)              :: ysolsw, ysollw
     REAL, DIMENSION(klon)              :: yfder
@@ -581,4 +713,8 @@
     REAL, DIMENSION(klon)              :: y_flux_t1, y_flux_q1
     REAL, DIMENSION(klon)              :: y_dflux_t, y_dflux_q
+#ifdef ISO
+    REAL, DIMENSION(ntraciso,klon)     ::  y_flux_xt1
+    REAL, DIMENSION(ntraciso,klon)     ::  y_dflux_xt
+#endif
     REAL, DIMENSION(klon)              :: y_flux_u1, y_flux_v1
     REAL, DIMENSION(klon)              :: y_flux_bs, y_flux0
@@ -608,4 +744,7 @@
     REAL, DIMENSION(klon)              :: AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0
     REAL, DIMENSION(klon)              :: AcoefH, AcoefQ, BcoefH, BcoefQ
+#ifdef ISO
+    REAL, DIMENSION(ntraciso,klon)     :: AcoefXT, BcoefXT
+#endif
     REAL, DIMENSION(klon)              :: AcoefU, AcoefV, BcoefU, BcoefV
     REAL, DIMENSION(klon)              :: AcoefQBS, BcoefQBS
@@ -626,4 +765,10 @@
     REAL, DIMENSION(klon,klev)         :: yu, yv
     REAL, DIMENSION(klon,klev)         :: yt, yq, yqbs
+#ifdef ISO
+    REAL, DIMENSION(ntraciso,klon)      :: yxtevap
+    REAL, DIMENSION(ntraciso,klon,klev) :: y_d_xt
+    REAL, DIMENSION(ntraciso,klon,klev) :: y_flux_xt
+    REAL, DIMENSION(ntraciso,klon,klev) :: yxt   
+#endif
     REAL, DIMENSION(klon,klev)         :: ypplay, ydelp
     REAL, DIMENSION(klon,klev)         :: delp
@@ -697,4 +842,17 @@
     REAL, DIMENSION(klon,klev)         :: Kcoef_hq_w, Kcoef_m_w, gama_h_w, gama_q_w
     REAL, DIMENSION(klon)              :: alf_1, alf_2, alf_1_x, alf_2_x, alf_1_w, alf_2_w
+#ifdef ISO
+    REAL, DIMENSION(ntraciso,klon,klev)         :: yxt_x, yxt_w
+    REAL, DIMENSION(ntraciso,klon)              :: y_flux_xt1_x , y_flux_xt1_w   
+    REAL, DIMENSION(ntraciso,klon,klev)         :: y_flux_xt_x,y_d_xt_x,zxfluxxt_x
+    REAL, DIMENSION(ntraciso,klon,klev)         :: y_flux_xt_w,y_d_xt_w,zxfluxxt_w
+    REAL, DIMENSION(ntraciso,klon,klev,nbsrf)   :: flux_xt_x, flux_xt_w
+    REAL, DIMENSION(ntraciso,klon)              :: AcoefXT_x, BcoefXT_x
+    REAL, DIMENSION(ntraciso,klon)              :: AcoefXT_w, BcoefXT_w
+    REAL, DIMENSION(ntraciso,klon,klev)         :: CcoefXT, DcoefXT
+    REAL, DIMENSION(ntraciso,klon,klev)         :: CcoefXT_x, DcoefXT_x
+    REAL, DIMENSION(ntraciso,klon,klev)         :: CcoefXT_w, DcoefXT_w
+    REAL, DIMENSION(ntraciso,klon,klev)         :: gama_xt,gama_xt_x,gama_xt_w
+#endif
 !!!
 !!!jyg le 08/02/2012
@@ -889,5 +1047,5 @@
     REAL, DIMENSION(klon)              :: yrmu0
     ! Martin
-    REAL, DIMENSIOn(klon)              :: yri0
+    REAL, DIMENSION(klon)              :: yri0
 
     REAL, DIMENSION(klon):: ydelta_sst, ydelta_sal, yds_ns, ydt_ns, ydter, &
@@ -896,4 +1054,12 @@
     ! dt_ds, tkt, tks, taur, sss on ocean points
     REAL :: missing_val
+#ifdef ISO
+    REAL, DIMENSION(klon)       :: h1
+    INTEGER                     :: ixt
+!#ifdef ISOVERIF
+!    integer iso_verif_positif_nostop
+!#endif    
+#endif
+
 !****************************************************************************************
 ! End of declarations
@@ -924,4 +1090,42 @@
       iflag_split = iflag_split_ref
 
+#ifdef ISO      
+#ifdef ISOVERIF
+      DO i=1,klon
+        DO ixt=1,niso
+          CALL iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 608')
+        ENDDO
+      ENDDO
+#endif
+#ifdef ISOVERIF
+      DO i=1,klon  
+        IF (iso_eau >= 0) THEN  
+          CALL iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
+     &         'pbl_surf_mod 585',errmax,errmaxrel)
+          CALL iso_verif_egalite_choix(xtsnow_f(iso_eau,i),snow_f(i), &
+     &         'pbl_surf_mod 594',errmax,errmaxrel)
+          IF (iso_verif_egalite_choix_nostop(xtsol(iso_eau,i),qsol(i), &
+     &         'pbl_surf_mod 596',errmax,errmaxrel) == 1) THEN
+                WRITE(*,*) 'i=',i
+                STOP
+          ENDIF
+          DO nsrf=1,nbsrf
+            CALL iso_verif_egalite_choix(xtsnow(iso_eau,i,nsrf),snow(i,nsrf), &
+     &         'pbl_surf_mod 598',errmax,errmaxrel)
+          ENDDO
+        ENDIF !IF (iso_eau >= 0) THEN   
+      ENDDO !DO i=1,knon  
+      DO k=1,klev
+        DO i=1,klon  
+          IF (iso_eau >= 0) THEN  
+            CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
+     &           'pbl_surf_mod 595',errmax,errmaxrel)
+          ENDIF !IF (iso_eau >= 0) THEN  
+        ENDDO !DO i=1,knon  
+      ENDDO !DO k=1,klev
+#endif
+#endif
+
+
 !****************************************************************************************
 ! 1) Initialisation and validation tests 
@@ -935,4 +1139,8 @@
        CALL getin_p('iflag_new_t2mq2m',iflag_new_t2mq2m)
        WRITE(lunout,*) 'pbl_iflag_new_t2mq2m=',iflag_new_t2mq2m
+
+       ok_bug_zg_wk_pbl=.TRUE.
+       CALL getin_p('ok_bug_zg_wk_pbl',ok_bug_zg_wk_pbl)
+       WRITE(lunout,*) 'ok_bug_zg_wk_pbl=',ok_bug_zg_wk_pbl
 
        print*,'PBL SURFACE AVEC GUSTINESS'
@@ -984,4 +1192,14 @@
       PRINT*,'WARNING : On impose qsol=',qsol0
       qsol(:)=qsol0
+#ifdef ISO
+      DO ixt=1,niso
+        xtsol(ixt,:)=qsol0*Rdefault(ixt)
+      ENDDO
+#ifdef ISOTRAC      
+      DO ixt=1+niso,ntraciso
+        xtsol(ixt,:)=qsol0*Rdefault(index_iso(ixt))
+      ENDDO
+#endif       
+#endif
     ENDIF
 !****************************************************************************************
@@ -1034,4 +1252,13 @@
  qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0.
  runoff(:)=0.
+#ifdef ISO
+zxxtevap(:,:)=0.
+ d_xt(:,:,:)=0. 
+ d_xt_x(:,:,:)=0.
+ d_xt_w(:,:,:)=0.
+ flux_xt(:,:,:,:)=0. 
+! xtsnow(:,:,:)=0.! attention, xtsnow est l'équivalent de snow et non de qsnow
+ xtevap(:,:,:)=0.
+#endif
     IF (iflag_pbl<20.or.iflag_pbl>=30) THEN
        zcoefh(:,:,:) = 0.0
@@ -1123,4 +1350,17 @@
 !FC
 
+#ifdef ISO
+   yxtrain_f = 0.0 ; yxtsnow_f = 0.0
+   yxtsnow  = 0.0
+   yxt = 0.0
+   yxtsol = 0.0
+   flux_xt = 0.0
+   yRland_ice = 0.0
+!   d_xt = 0.0      
+   y_dflux_xt = 0.0  
+   dflux_xt=0.0 
+   y_d_xt_x=0.      ; y_d_xt_w=0.       
+#endif 
+
 ! >> PC
 !the yfields_out variable is defined in (klon,nbcf_out) even if it is used on
@@ -1149,4 +1389,7 @@
     fluxlat_x(:,:)=0. ;           fluxlat_w(:,:)=0. 
 !>jyg
+#ifdef ISO
+    flux_xt_x(:,:,:,:)=0. ;          flux_xt_w(:,:,:,:)=0.
+#endif
 !
 !jyg<
@@ -1448,4 +1691,34 @@
           yfluxbs(j)=0.0
           y_flux_bs(j) = 0.0
+!!!
+#ifdef ISO
+          DO ixt=1,ntraciso
+            yxtrain_f(ixt,j) = xtrain_f(ixt,i)
+            yxtsnow_f(ixt,j) = xtsnow_f(ixt,i)  
+          ENDDO
+          DO ixt=1,niso
+            yxtsnow(ixt,j)   = xtsnow(ixt,i,nsrf)
+          ENDDO    
+          !IF (nsrf == is_lic) THEN
+          DO ixt=1,niso
+            yRland_ice(ixt,j)= Rland_ice(ixt,i)  
+          ENDDO    
+          !endif !IF (nsrf == is_lic) THEN
+#ifdef ISOVERIF
+          IF (iso_eau >= 0) THEN
+              call iso_verif_egalite_choix(ysnow_f(j), &
+     &          yxtsnow_f(iso_eau,j),'pbl_surf_mod 862', &
+     &          errmax,errmaxrel)
+              call iso_verif_egalite_choix(ysnow(j), &
+     &          yxtsnow(iso_eau,j),'pbl_surf_mod 872', &
+     &          errmax,errmaxrel)
+          ENDIF
+#endif
+#ifdef ISOVERIF
+         DO ixt=1,ntraciso
+           call iso_verif_noNaN(yxtsnow_f(ixt,j),'pbl_surf_mod 921')
+         ENDDO
+#endif
+#endif
        ENDDO
 ! >> PC
@@ -1487,4 +1760,9 @@
              yq(j,k) = q(i,k)
              yqbs(j,k)=qbs(i,k)
+#ifdef ISO
+             DO ixt=1,ntraciso   
+               yxt(ixt,j,k) = xt(ixt,i,k)
+             ENDDO !DO ixt=1,ntraciso
+#endif
           ENDDO
         ENDDO
@@ -1504,4 +1782,10 @@
              yq_w(j,k) = q(i,k)+(1.-wake_s(i))*wake_dlq(i,k)
 !!!
+#ifdef ISO
+             DO ixt=1,ntraciso
+               yxt_x(ixt,j,k) = xt(ixt,i,k)-wake_s(i)*wake_dlxt(ixt,i,k)
+               yxt_w(ixt,j,k) = xt(ixt,i,k)+(1.-wake_s(i))*wake_dlxt(ixt,i,k)
+             ENDDO
+#endif
           ENDDO
         ENDDO
@@ -1559,4 +1843,9 @@
              i = ni(j)
              yqsol(j) = qsol(i)
+#ifdef ISO
+             DO ixt=1,niso
+               yxtsol(ixt,j) = xtsol(ixt,i)
+             ENDDO
+#endif
           ENDDO
        ENDIF
@@ -1664,6 +1953,9 @@
             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)
+        IF(ok_bug_zg_wk_pbl) THEN
+         zgeo1(1:knon) = wake_s(1:knon)*zgeo1_w(1:knon) + (1.-wake_s(1:knon))*zgeo1_x(1:knon)
+        ELSE
+         zgeo1(1:knon) = ywake_s(1:knon)*zgeo1_w(1:knon) + (1.-ywake_s(1:knon))*zgeo1_x(1:knon)
+        ENDIF
 
 ! --- special Dice. JYG+MPL 25112013 puis BOMEX
@@ -1704,5 +1996,5 @@
 
         IF (iflag_pbl>=50) THEN
-        CALL call_atke(dtime,knon,klev,ycdragm(1:knon), ycdragh(1:knon),yus0(1:knon),yvs0(1:knon),yts(1:knon), &
+        CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm(1:knon), ycdragh(1:knon),yus0(1:knon),yvs0(1:knon),yts(1:knon), &
                   yu(1:knon,:),yv(1:knon,:),yt(1:knon,:),yq(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:),       &
                   ytke(1:knon,:),yeps(1:knon,:), ycoefm(1:knon,:), ycoefh(1:knon,:))
@@ -1749,5 +2041,5 @@
         IF (iflag_pbl>=50) THEN
      
-        CALL call_atke(dtime,knon,klev,ycdragm_x(1:knon),ycdragh_x(1:knon),yus0(1:knon),yvs0(1:knon),yts_x(1:knon),    &
+        CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm_x(1:knon),ycdragh_x(1:knon),yus0(1:knon),yvs0(1:knon),yts_x(1:knon),    &
                        yu_x(1:knon,:),yv_x(1:knon,:),yt_x(1:knon,:),yq_x(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:),  &
                        ytke_x(1:knon,:),yeps_x(1:knon,:),ycoefm_x(1:knon,:), ycoefh_x(1:knon,:))
@@ -1789,5 +2081,5 @@
         IF (iflag_pbl>=50) THEN
         
-        CALL call_atke(dtime,knon,klev,ycdragm_w(1:knon),ycdragh_w(1:knon),yus0(1:knon),yvs0(1:knon),yts_w(1:knon), &
+        CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm_w(1:knon),ycdragh_w(1:knon),yus0(1:knon),yvs0(1:knon),yts_w(1:knon), &
                 yu_w(1:knon,:),yv_w(1:knon,:),yt_w(1:knon,:),yq_w(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:),      &
                 ytke_w(1:knon,:),yeps_w(1:knon,:),ycoefm_w(1:knon,:),ycoefh_w(1:knon,:))
@@ -1850,5 +2142,9 @@
             Kcoef_hq, gama_q, gama_h, &
 !!!
-            AcoefH, AcoefQ, BcoefH, BcoefQ)
+            AcoefH, AcoefQ, BcoefH, BcoefQ &
+#ifdef ISO
+         &   ,yxt, CcoefXT, DcoefXT, gama_xt, AcoefXT, BcoefXT & 
+#endif               
+         &   )
        ELSE  !(iflag_split .eq.0)
         CALL climb_hq_down(knon, ycoefh_x, ypaprs, ypplay, &
@@ -1858,5 +2154,9 @@
             Kcoef_hq_x, gama_q_x, gama_h_x, &
 !!!
-            AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x)
+            AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x &
+#ifdef ISO
+         &   ,yxt_x, CcoefXT_x, DcoefXT_x, gama_xt_x, AcoefXT_x, BcoefXT_x & 
+#endif               
+         &   )
 !!!
        IF (prt_level >=10) THEN
@@ -1873,5 +2173,9 @@
             Kcoef_hq_w, gama_q_w, gama_h_w, &
 !!!
-            AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w)
+            AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w &
+#ifdef ISO
+         &   ,yxt_w, CcoefXT_w, DcoefXT_w, gama_xt_w, AcoefXT_w, BcoefXT_w & 
+#endif               
+         &   )
 !!!
        IF (prt_level >=10) THEN
@@ -1955,5 +2259,13 @@
          yt1(:) = yt(:,1)
          yq1(:) = yq(:,1)
+#ifdef ISO
+         yxt1(:,:) = yxt(:,:,1)
+#endif
+
        ELSE IF (iflag_split .ge. 1) THEN
+#ifdef ISO
+        call abort_gcm('pbl_surface_mod 2149','isos pas encore dans iflag_split=1',1)
+#endif
+
 !
 ! Cdragq computation
@@ -2117,5 +2429,11 @@
                yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
                y_flux_u1, y_flux_v1, &
-               yveget,ylai,yheight )
+               yveget,ylai,yheight   &
+#ifdef ISO
+         &      ,yxtrain_f, yxtsnow_f,yxt1, &
+         &      yxtsnow,yxtsol,yxtevap,h1, &
+         &      yrunoff_diag,yxtrunoff_diag,yRland_ice &
+#endif               
+         &      )
  
 !FC quid qd yveget ylai yheight ne sont pas definit
@@ -2147,5 +2465,27 @@
           ENDDO
       ENDIF
-     
+
+#ifdef ISOVERIF
+        DO j=1,knon
+          DO ixt=1,ntraciso
+            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')
+          ENDDO
+        ENDDO
+#endif
+#ifdef ISOVERIF
+!        write(*,*) 'pbl_surface_mod 1038: sortie surf_land'
+        DO j=1,knon
+          IF (iso_eau >= 0) THEN     
+                 CALL iso_verif_egalite(yxtsnow(iso_eau,j), &
+     &                                  ysnow(j),'pbl_surf_mod 1043')
+          ENDIF !if (iso_eau.gt.0) then
+        ENDDO !DO i=1,klon
+#endif
+    
        CASE(is_lic)
           ! Martin
@@ -2168,5 +2508,10 @@
                   ysnowhgt, yqsnow, ytoice, ysissnow, &
                   yalb3_new, yrunoff, &
-                  y_flux_u1, y_flux_v1)
+                  y_flux_u1, y_flux_v1 &
+#ifdef ISO
+                  &    ,yxtrain_f, yxtsnow_f,yxt1,yRland_ice &
+                  &    ,yxtsnow,yxtsol,yxtevap &
+#endif              
+                  &    )
              
              !jyg<
@@ -2190,5 +2535,27 @@
                 ENDDO
              ENDIF
-             
+
+#ifdef ISOVERIF
+             DO j=1,knon
+               DO ixt=1,ntraciso
+                 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')
+                enddo
+             enddo
+#endif
+#ifdef ISOVERIF
+             !write(*,*) 'pbl_surface_mod 1060: sortie surf_landice'
+             do j=1,knon
+               IF (iso_eau >= 0) THEN     
+                 CALL iso_verif_egalite(yxtsnow(iso_eau,j), &
+                        &               ysnow(j),'pbl_surf_mod 1064')
+               ENDIF !if (iso_eau >= 0) THEN
+             ENDDO !DO i=1,klon
+#endif
+            
           END IF
           
@@ -2207,5 +2574,10 @@
                y_flux_u1, y_flux_v1, ydelta_sst(:knon), ydelta_sal(:knon), &
                yds_ns(:knon), ydt_ns(:knon), ydter(:knon), ydser(:knon), &
-               ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss)
+               ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss &
+#ifdef ISO
+         &      ,yxtrain_f, yxtsnow_f,yxt1,Roce, &
+         &      yxtsnow,yxtevap,h1 &
+#endif               
+         &      )
       IF (prt_level >=10) THEN
           print *,'arg de surf_ocean: ycdragh ',ycdragh(1:knon)
@@ -2248,5 +2620,10 @@
 !albedo SB <<<
                ytsurf_new, y_dflux_t, y_dflux_q, &
-               y_flux_u1, y_flux_v1)
+               y_flux_u1, y_flux_v1 &
+#ifdef ISO
+         &      ,yxtrain_f, yxtsnow_f,yxt1,Roce, &
+         &      yxtsnow,yxtsol,yxtevap,Rland_ice &
+#endif               
+         &      )
           
 ! Special DICE MPL 05082013 puis BOMEX MPL 20150410
@@ -2256,5 +2633,27 @@
           y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1)
           ENDDO
-      ENDIF
+       ENDIF
+
+#ifdef ISOVERIF
+        DO j=1,knon
+          DO ixt=1,ntraciso
+            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')
+          ENDDO
+        ENDDO
+#endif
+#ifdef ISOVERIF
+        !write(*,*) 'pbl_surface_mod 1077: sortie surf_seaice'
+        DO j=1,knon
+          IF (iso_eau >= 0) THEN     
+                 CALL iso_verif_egalite(yxtsnow(iso_eau,j), &
+     &                                  ysnow(j),'pbl_surf_mod 1106')
+          ENDIF !IF (iso_eau >= 0) THEN
+        ENDDO !DO i=1,klon
+#endif
 
        CASE DEFAULT
@@ -2316,4 +2715,9 @@
             yt1_new=(1./RCPD)*(AcoefH(j)+BcoefH(j)*y_flux_t1(j)*dtime)
             ytsurf_new(j)=yt1_new-y_flux_t1(j)/(Kech_h(j)*RCPD)
+            ! for cases forced in flux and for which forcing in Ts is needed
+            ! to prevent the latter to reach unrealistic value (even if not used,
+            ! Ts is calculated and hgardfou can appear during the calculation
+            ! of surface saturation humidity for example
+            if (ok_forc_tsurf) ytsurf_new(j)=tg
           ENDDO
 
@@ -2326,4 +2730,7 @@
           y_flux_t1(j) =  yfluxsens(j)
           y_flux_q1(j) = -yevap(j)
+#ifdef ISO
+          y_flux_xt1(:,:) = -yxtevap(:,:)
+#endif
           ENDDO
         ENDIF ! (ok_flux_surf)
@@ -2341,4 +2748,8 @@
 
        IF (iflag_split .GE. 1) THEN
+#ifdef ISO
+        call abort_gcm('pbl_surface_mod 2607','isos pas encore dans iflag_split=1',1)
+#endif
+!
 !
          IF (nsrf .ne. is_oce) THEN
@@ -2558,5 +2969,11 @@
             Kcoef_hq, gama_q, gama_h, &
 !!!
-            y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:))    
+            y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:) &
+#ifdef ISO
+        &    ,yxt,y_flux_xt1 &
+        &    ,AcoefXT,BcoefXT,CcoefXT,DcoefXT,gama_xt &
+        &    ,y_flux_xt(:,:,:),y_d_xt(:,:,:) &
+#endif
+        &    )    
        ELSE  !(iflag_split .eq.0)
         CALL climb_hq_up(knon, dtime, yt_x, yq_x, &
@@ -2567,5 +2984,11 @@
             Kcoef_hq_x, gama_q_x, gama_h_x, &
 !!!
-            y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:))    
+            y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:) &
+#ifdef ISO
+        &    ,yxt_x,y_flux_xt1_x &
+        &    ,AcoefXT_x,BcoefXT_x,CcoefXT_x,DcoefXT_x,gama_xt_x &
+        &    ,y_flux_xt_x(:,:,:),y_d_xt_x(:,:,:) &
+#endif
+        &    )    
 !
        CALL climb_hq_up(knon, dtime, yt_w, yq_w, &
@@ -2576,5 +2999,11 @@
             Kcoef_hq_w, gama_q_w, gama_h_w, &
 !!!
-            y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:))    
+            y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:) &
+#ifdef ISO
+        &    ,yxt_w,y_flux_xt1_w &
+        &    ,AcoefXT_w,BcoefXT_w,CcoefXT_w,DcoefXT_w,gama_xt_w &
+        &    ,y_flux_xt_w(:,:,:),y_d_xt_w(:,:,:) &
+#endif
+        &    )    
 !!!
        ENDIF  ! (iflag_split .eq.0)
@@ -2694,6 +3123,25 @@
              flux_u(i,k,nsrf) = y_flux_u(j,k)
              flux_v(i,k,nsrf) = y_flux_v(j,k)
+
+#ifdef ISO
+             DO ixt=1,ntraciso
+                y_d_xt(ixt,j,k)  = y_d_xt(ixt,j,k) * ypct(j)
+                flux_xt(ixt,i,k,nsrf) = y_flux_xt(ixt,j,k)
+             ENDDO ! DO ixt=1,ntraciso
+             h1_diag(i)=h1(j)
+#endif
+
            ENDDO
         ENDDO
+
+#ifdef ISO
+#ifdef ISOVERIF
+        if (iso_eau.gt.0) then
+         call iso_verif_egalite_vect2D( &
+                y_d_xt,y_d_q, &
+                'pbl_surface_mod 2600',ntraciso,klon,klev)
+        endif       
+#endif
+#endif
 
        ELSE  !(iflag_split .eq.0)
@@ -2713,4 +3161,11 @@
             flux_u_x(i,k,nsrf) = y_flux_u_x(j,k)
             flux_v_x(i,k,nsrf) = y_flux_v_x(j,k)
+
+#ifdef ISO
+            DO ixt=1,ntraciso
+              y_d_xt_x(ixt,j,k)  = y_d_xt_x(ixt,j,k) * ypct(j)
+              flux_xt_x(ixt,i,k,nsrf) = y_flux_xt_x(ixt,j,k)
+            ENDDO ! DO ixt=1,ntraciso
+#endif
           ENDDO
         ENDDO
@@ -2730,4 +3185,12 @@
             flux_u_w(i,k,nsrf) = y_flux_u_w(j,k)
             flux_v_w(i,k,nsrf) = y_flux_v_w(j,k)
+
+#ifdef ISO
+            DO ixt=1,ntraciso
+              y_d_xt_w(ixt,j,k)  = y_d_xt_w(ixt,j,k) * ypct(j)
+              flux_xt_w(ixt,i,k,nsrf) = y_flux_xt_w(ixt,j,k)
+            ENDDO ! do ixt=1,ntraciso
+#endif
+
           ENDDO
         ENDDO
@@ -2741,4 +3204,9 @@
             flux_u(i,k,nsrf) = flux_u_x(i,k,nsrf)+ywake_s(j)*(flux_u_w(i,k,nsrf)-flux_u_x(i,k,nsrf))
             flux_v(i,k,nsrf) = flux_v_x(i,k,nsrf)+ywake_s(j)*(flux_v_w(i,k,nsrf)-flux_v_x(i,k,nsrf))
+#ifdef ISO
+            DO ixt=1,ntraciso
+              flux_xt(ixt,i,k,nsrf) = flux_xt_x(ixt,i,k,nsrf)+ywake_s(j)*(flux_xt_w(ixt,i,k,nsrf)-flux_xt_x(ixt,i,k,nsrf))
+            ENDDO ! do ixt=1,ntraciso
+#endif
           ENDDO
         ENDDO
@@ -2798,4 +3266,24 @@
           dflux_t(i) = dflux_t(i) + y_dflux_t(j)*ypct(j)
           dflux_q(i) = dflux_q(i) + y_dflux_q(j)*ypct(j)
+#ifdef ISO
+        DO ixt=1,niso
+          xtsnow(ixt,i,nsrf) = yxtsnow(ixt,j)  
+        ENDDO
+        DO ixt=1,ntraciso
+          xtevap(ixt,i,nsrf) = - flux_xt(ixt,i,1,nsrf)
+          dflux_xt(ixt,i) = dflux_xt(ixt,i) + y_dflux_xt(ixt,j)*ypct(j)
+        ENDDO  
+        IF (nsrf == is_lic) THEN
+          DO ixt=1,niso
+            Rland_ice(ixt,i) = yRland_ice(ixt,j)  
+          ENDDO
+        ENDIF !IF (nsrf == is_lic) THEN     
+#ifdef ISOVERIF
+        IF (iso_eau.gt.0) THEN  
+          call iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
+     &         'pbl_surf_mod 1230',errmax,errmaxrel)
+        ENDIF !if (iso_eau.gt.0) then
+#endif        
+#endif
        ENDDO
 
@@ -2902,4 +3390,11 @@
              i = ni(j)
              qsol(i) = yqsol(j)
+#ifdef ISO
+             runoff_diag(i)=yrunoff_diag(j)   
+             DO ixt=1,niso
+               xtsol(ixt,i) = yxtsol(ixt,j)
+               xtrunoff_diag(ixt,i)=yxtrunoff_diag(ixt,j)
+             ENDDO
+#endif
           ENDDO
        ENDIF
@@ -2914,5 +3409,22 @@
           ENDDO
        ENDDO
-       
+
+#ifdef ISO
+#ifdef ISOVERIF
+       !write(*,*) 'pbl_surface 2858'
+       DO i = 1, klon
+         DO ixt=1,niso
+           call iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 1405')
+         ENDDO
+       ENDDO
+#endif
+#ifdef ISOVERIF
+     IF (iso_eau.gt.0) THEN
+        call iso_verif_egalite_vect2D( &
+                y_d_xt,y_d_q, &
+                'pbl_surface_mod 1261',ntraciso,klon,klev)
+     ENDIF !if (iso_eau.gt.0) then
+#endif
+#endif
 !!! jyg le 07/02/2012
        IF (iflag_split .ge.1) THEN
@@ -2933,4 +3445,11 @@
            d_u_w(i,k) = d_u_w(i,k) + y_d_u_w(j,k)
            d_v_w(i,k) = d_v_w(i,k) + y_d_v_w(j,k)
+#ifdef ISO
+           DO ixt=1,ntraciso
+             d_xt_x(ixt,i,k) = d_xt_x(ixt,i,k) + y_d_xt_x(ixt,j,k)
+             d_xt_w(ixt,i,k) = d_xt_w(ixt,i,k) + y_d_xt_w(ixt,j,k)
+           ENDDO ! DO ixt=1,ntraciso
+#endif
+
 !
 !!           d_wake_dlt(i,k) = d_wake_dlt(i,k) + y_d_t_w(i,k)-y_d_t_x(i,k)
@@ -2948,4 +3467,9 @@
              d_t(i,k) = d_t(i,k) + y_d_t(j,k)
              d_q(i,k) = d_q(i,k) + y_d_q(j,k)
+#ifdef ISO
+             DO ixt=1,ntraciso
+               d_xt(ixt,i,k) = d_xt(ixt,i,k) + y_d_xt(ixt,j,k)
+             ENDDO !DO ixt=1,ntraciso
+#endif
              d_u(i,k) = d_u(i,k) + y_d_u(j,k)
              d_v(i,k) = d_v(i,k) + y_d_v(j,k)
@@ -2962,4 +3486,24 @@
          ENDDO
         ENDIF
+
+#ifdef ISO
+#ifdef ISOVERIF
+!        write(*,*) 'd_q,d_xt(iso_eau,554,19)=',d_q(554,19),d_xt(iso_eau,554,19)
+!        write(*,*) 'pbl_surface 2929: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1)
+!        write(*,*) 'y_d_q,y_d_xt(iso_eau,2,1)=',y_d_q(2,1),y_d_xt(iso_eau,2,1)
+!        write(*,*) 'iso_eau.gt.0=',iso_eau.gt.0
+        call iso_verif_noNaN_vect2D( &
+     &           d_xt, &
+     &           'pbl_surface 1385',ntraciso,klon,klev)  
+     IF (iso_eau >= 0) THEN
+        call iso_verif_egalite_vect2D( &
+                y_d_xt,y_d_q, &
+                'pbl_surface_mod 2945',ntraciso,klon,klev)
+        call iso_verif_egalite_vect2D( &
+                d_xt,d_q, &
+                'pbl_surface_mod 1276',ntraciso,klon,klev)
+     ENDIF !IF (iso_eau >= 0) THEN
+#endif
+#endif
 
 !      print*,'Dans pbl OK4'
@@ -3349,4 +3893,15 @@
    iflag_split=iflag_split_ref
 
+#ifdef ISO
+#ifdef ISOVERIF
+!        write(*,*) 'pbl_surface tmp 3249: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1)
+    IF (iso_eau >= 0) THEN
+        call iso_verif_egalite_vect2D( &
+                d_xt,d_q, &
+                'pbl_surface_mod 1276',ntraciso,klon,klev)
+    ENDIF !IF (iso_eau >= 0) THEN
+#endif
+#endif
+
 !****************************************************************************************
 ! 16) Calculate the mean value over all sub-surfaces for some variables
@@ -3370,4 +3925,10 @@
     zxfluxt_w(:,:) = 0.0 ; zxfluxq_w(:,:) = 0.0
     zxfluxu_w(:,:) = 0.0 ; zxfluxv_w(:,:) = 0.0
+#ifdef ISO
+      zxfluxxt(:,:,:) = 0.0 
+      zxfluxxt_x(:,:,:) = 0.0
+      zxfluxxt_w(:,:,:) = 0.0
+#endif
+
 
 !!! jyg le 07/02/2012
@@ -3388,4 +3949,10 @@
               zxfluxu_w(i,k) = zxfluxu_w(i,k) + flux_u_w(i,k,nsrf) * pctsrf(i,nsrf)
               zxfluxv_w(i,k) = zxfluxv_w(i,k) + flux_v_w(i,k,nsrf) * pctsrf(i,nsrf)
+#ifdef ISO
+              DO ixt=1,ntraciso
+                zxfluxxt_x(ixt,i,k) = zxfluxxt_x(ixt,i,k) + flux_xt_x(ixt,i,k,nsrf) * pctsrf(i,nsrf)
+                zxfluxxt_w(ixt,i,k) = zxfluxxt_w(ixt,i,k) + flux_xt_w(ixt,i,k,nsrf) * pctsrf(i,nsrf)
+              ENDDO ! DO ixt=1,ntraciso
+#endif
             ENDDO
           ENDDO
@@ -3407,4 +3974,9 @@
              zxfluxu(i,k) = zxfluxu(i,k) + flux_u(i,k,nsrf) * pctsrf(i,nsrf)
              zxfluxv(i,k) = zxfluxv(i,k) + flux_v(i,k,nsrf) * pctsrf(i,nsrf)
+#ifdef ISO
+             DO ixt=1,niso
+               zxfluxxt(ixt,i,k) = zxfluxxt(ixt,i,k) + flux_xt(ixt,i,k,nsrf) * pctsrf(i,nsrf)
+             ENDDO ! DO ixt=1,niso
+#endif
           ENDDO
        ENDDO
@@ -3431,4 +4003,12 @@
        END DO
     endif
+
+#ifdef ISO
+    DO i = 1, klon
+      DO ixt=1,ntraciso
+        zxxtevap(ixt,i)     = - zxfluxxt(ixt,i,1)
+      ENDDO
+    ENDDO
+#endif
 
 !!!
@@ -3606,8 +4186,17 @@
     zxqsurf(:) = 0.0
     zxsnow(:)  = 0.0
+#ifdef ISO
+    zxxtsnow(:,:)  = 0.0
+#endif
+
     DO nsrf = 1, nbsrf
        DO i = 1, klon
           zxqsurf(i) = zxqsurf(i) + MAX(qsurf(i,nsrf),0.0) * pctsrf(i,nsrf)
           zxsnow(i)  = zxsnow(i)  + snow(i,nsrf)  * pctsrf(i,nsrf)
+#ifdef ISO
+          DO ixt=1,niso
+            zxxtsnow(ixt,i)  = zxxtsnow(ixt,i)  + xtsnow(ixt,i,nsrf)  * pctsrf(i,nsrf)
+          ENDDO ! DO ixt=1,niso
+#endif
        ENDDO
     ENDDO
@@ -3621,7 +4210,17 @@
 !****************************************************************************************
 !
-  SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst)
+  SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst &
+#ifdef ISO
+       ,xtsnow_rst,Rland_ice_rst &
+#endif       
+       )
 
     USE indice_sol_mod
+#ifdef ISO
+#ifdef ISOVERIF
+    USE isotopes_mod, ONLY: iso_eau,ridicule
+    USE isotopes_verif_mod, ONLY: errmax,errmaxrel
+#endif    
+#endif
 
     INCLUDE "dimsoil.h"
@@ -3633,4 +4232,8 @@
     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: qsurf_rst
     REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(OUT) :: ftsoil_rst
+#ifdef ISO
+    REAL, DIMENSION(niso,klon, nbsrf), INTENT(OUT)     :: xtsnow_rst
+    REAL, DIMENSION(niso,klon), INTENT(OUT)            :: Rland_ice_rst
+#endif
 
  
@@ -3643,4 +4246,8 @@
     qsurf_rst(:,:)    = qsurf(:,:)
     ftsoil_rst(:,:,:) = ftsoil(:,:,:)
+#ifdef ISO
+    xtsnow_rst(:,:,:)  = xtsnow(:,:,:) 
+    Rland_ice_rst(:,:) = Rland_ice(:,:)
+#endif
 
 !****************************************************************************************
@@ -3655,4 +4262,9 @@
     IF (ALLOCATED(ydTs0)) DEALLOCATE(ydTs0)
     IF (ALLOCATED(ydqs0)) DEALLOCATE(ydqs0)
+#ifdef ISO
+    IF (ALLOCATED(xtsnow)) DEALLOCATE(xtsnow)
+    IF (ALLOCATED(Rland_ice)) DEALLOCATE(Rland_ice)
+    IF (ALLOCATED(Roce)) DEALLOCATE(Roce)
+#endif
 
 !jyg<
@@ -3673,5 +4285,9 @@
   SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, &
        evap, z0m, z0h, agesno,                                  &
-       tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke)  
+       tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke &
+#ifdef ISO
+      ,xtevap  &
+#endif
+&      )  
     !albedo SB <<<
     ! Give default values where new fraction has appread
@@ -3702,4 +4318,7 @@
     REAL, DIMENSION(klon,nbsrf+1), INTENT(INOUT)        :: z0m,z0h
     REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: tke
+#ifdef ISO
+    REAL, DIMENSION(ntraciso,klon,nbsrf), INTENT(INOUT)        :: xtevap
+#endif
 
 ! Local variables
@@ -3709,4 +4328,7 @@
     CHARACTER(len=20) :: modname = 'pbl_surface_newfrac'
     INTEGER, DIMENSION(nbsrf) :: nfois=0, mfois=0, pfois=0
+#ifdef ISO
+    INTEGER           :: ixt
+#endif
 !
 ! All at once !! 
@@ -3754,4 +4376,9 @@
                 u10m(i,nsrf)  = u10m(i,nsrf_comp1)
                 v10m(i,nsrf)  = v10m(i,nsrf_comp1)
+#ifdef ISO
+                DO ixt=1,ntraciso
+                  xtevap(ixt,i,nsrf) = xtevap(ixt,i,nsrf_comp1)       
+                ENDDO       
+#endif
                 IF (iflag_pbl > 1) THEN
                  tke(i,:,nsrf) = tke(i,:,nsrf_comp1)
@@ -3809,4 +4436,10 @@
                 u10m(i,nsrf)  = u10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + u10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
                 v10m(i,nsrf)  = v10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + v10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
+#ifdef ISO
+                DO ixt=1,ntraciso
+                  xtevap(ixt,i,nsrf) = xtevap(ixt,i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) &
+                                     + xtevap(ixt,i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3) 
+                ENDDO       
+#endif
                 IF (iflag_pbl > 1) THEN
                  tke(i,:,nsrf) = tke(i,:,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tke(i,:,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
@@ -3821,4 +4454,7 @@
              agesno(i,nsrf)   = 0.
              ftsoil(i,:,nsrf) = tsurf(i,nsrf)
+#ifdef ISO            
+             xtsnow(:,i,nsrf) = 0.
+#endif
           ELSE
              pfois(nsrf) = pfois(nsrf)+ 1
Index: /LMDZ6/branches/cirrus/libf/phylmd/phys_local_var_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/phys_local_var_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/phys_local_var_mod.F90	(revision 5202)
@@ -14,4 +14,8 @@
       REAL, SAVE, ALLOCATABLE :: ql_seri(:,:),qs_seri(:,:)
       !$OMP THREADPRIVATE(ql_seri,qs_seri)
+! SN 15/07/2024 ISO 4D
+      REAL, SAVE, ALLOCATABLE :: qx_seri(:,:,:)
+      !$OMP THREADPRIVATE(qx_seri)
+! SN
       REAL, SAVE, ALLOCATABLE :: qbs_seri(:,:)
       !$OMP THREADPRIVATE(qbs_seri)
@@ -24,4 +28,6 @@
       REAL, SAVE, ALLOCATABLE :: pbl_eps(:,:,:)
       !$OMP THREADPRIVATE(pbl_eps)
+      REAL, SAVE, ALLOCATABLE :: tke_shear(:,:,:), tke_buoy(:,:,:), tke_trans(:,:,:)
+      !$OMP THREADPRIVATE(tke_shear,tke_buoy,tke_trans)
       REAL, SAVE, ALLOCATABLE :: tr_seri(:,:,:)
       !$OMP THREADPRIVATE(tr_seri)
@@ -64,4 +70,8 @@
       REAL, SAVE, ALLOCATABLE :: d_t_eva(:,:),d_q_eva(:,:),d_ql_eva(:,:),d_qi_eva(:,:)
       !$OMP THREADPRIVATE(d_t_eva,d_q_eva,d_ql_eva,d_qi_eva)
+! SN 15/07/2024 ISO 4D
+      REAL, SAVE, ALLOCATABLE :: d_qx_eva(:,:,:)
+      !$OMP THREADPRIVATE(d_qx_eva)
+! SN
       REAL, SAVE, ALLOCATABLE :: d_t_lscst(:,:),d_q_lscst(:,:)
       !$OMP THREADPRIVATE(d_t_lscst,d_q_lscst)
@@ -84,6 +94,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)
+      REAL, SAVE, ALLOCATABLE :: d_t_bsss(:,:), d_q_bsss(:,:), d_qbs_bsss(:,:)
+      !$OMP THREADPRIVATE( d_t_bsss,d_q_bsss, d_qbs_bsss)
 !>nrlmd+jyg
       REAL, SAVE, ALLOCATABLE :: d_t_oro(:,:)
@@ -117,4 +127,48 @@
       REAL, SAVE, ALLOCATABLE :: d_q_ch4(:,:)
       !$OMP THREADPRIVATE(d_q_ch4)
+#ifdef ISO
+      REAL, SAVE, ALLOCATABLE :: xt_seri(:,:,:)
+      !$OMP THREADPRIVATE( xt_seri)
+      REAL, SAVE, ALLOCATABLE :: xtl_seri(:,:,:)
+      !$OMP THREADPRIVATE( xtl_seri)
+      REAL, SAVE, ALLOCATABLE :: xts_seri(:,:,:)
+      !$OMP THREADPRIVATE( xts_seri)
+      REAL, SAVE, ALLOCATABLE :: xtbs_seri(:,:,:)
+      !$OMP THREADPRIVATE( xtbs_seri)
+      REAL, SAVE, ALLOCATABLE :: d_xt_eva(:,:,:)
+      !$OMP THREADPRIVATE( d_xt_eva)
+      REAL, SAVE, ALLOCATABLE :: d_xtl_eva(:,:,:)
+      !$OMP THREADPRIVATE( d_xtl_eva)
+      REAL, SAVE, ALLOCATABLE :: d_xti_eva(:,:,:)
+      !$OMP THREADPRIVATE( d_xti_eva)
+      REAL, SAVE, ALLOCATABLE :: d_xt_vdf(:,:,:)
+      !$OMP THREADPRIVATE( d_xt_vdf)
+      REAL, SAVE, ALLOCATABLE :: d_xt_dyn(:,:,:)
+      !$OMP THREADPRIVATE( d_xt_dyn)
+      REAL, SAVE, ALLOCATABLE :: d_xtl_dyn(:,:,:), d_xts_dyn(:,:,:), d_xtbs_dyn(:,:,:)
+      !$OMP THREADPRIVATE(d_xtl_dyn, d_xts_dyn, d_xtbs_dyn)
+      REAL, SAVE, ALLOCATABLE :: d_xt_con(:,:,:)
+      !$OMP THREADPRIVATE( d_xt_con)
+      REAL, SAVE, ALLOCATABLE :: d_xt_wake(:,:,:)
+      !$OMP THREADPRIVATE( d_xt_wake)
+      REAL, SAVE, ALLOCATABLE :: d_xt_lsc(:,:,:),d_xtl_lsc(:,:,:),d_xti_lsc(:,:,:)
+      !$OMP THREADPRIVATE( d_xt_lsc,d_xtl_lsc,d_xti_lsc)
+      REAL, SAVE, ALLOCATABLE :: d_xt_ajsb(:,:,:)
+      !$OMP THREADPRIVATE( d_xt_ajsb)
+      REAL, SAVE, ALLOCATABLE :: d_xt_ajs(:,:,:)
+      !$OMP THREADPRIVATE( d_xt_ajs)
+      REAL, SAVE, ALLOCATABLE :: d_xt_ajs_w(:,:,:), d_xt_ajs_x(:,:,:)
+      !$OMP THREADPRIVATE(d_xt_ajs_w, d_xt_ajs_x)
+      REAL, SAVE, ALLOCATABLE :: d_xt_vdf_w(:,:,:), d_xt_vdf_x(:,:,:)
+      !$OMP THREADPRIVATE(d_xt_vdf_w, d_xt_vdf_x)
+      REAL, SAVE, ALLOCATABLE :: d_xt_ch4(:,:,:)
+      !$OMP THREADPRIVATE( d_xt_ch4)
+      REAL, SAVE, ALLOCATABLE :: d_xt_prod_nucl(:,:,:)
+      !$OMP THREADPRIVATE( d_xt_prod_nucl)
+      REAL, SAVE, ALLOCATABLE :: d_xt_cosmo(:,:,:)
+      !$OMP THREADPRIVATE( d_xt_cosmo)
+      REAL, SAVE, ALLOCATABLE :: d_xt_decroiss(:,:,:)
+      !$OMP THREADPRIVATE( d_xt_decroiss)
+#endif
 
 ! tendance du a la conersion Ec -> E thermique
@@ -124,7 +178,4 @@
       !$OMP THREADPRIVATE(d_ts, d_tr)
 
-! aerosols
-      REAL, SAVE, ALLOCATABLE :: m_allaer (:,:,:)
-      !$OMP THREADPRIVATE(m_allaer)
 ! diagnostique pour le rayonnement
       REAL, SAVE, ALLOCATABLE :: topswad_aero(:),  solswad_aero(:)      ! diag
@@ -307,5 +358,17 @@
 !!!OMP THREADPRIVATE(d_s_the, d_dens_the)
       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)           :: d_deltat_ajs_cv, d_deltaq_ajs_cv
-!$OMP THREADPRIVATE(d_deltat_ajs_cv, d_deltaq_ajs_cv)                       
+!$OMP THREADPRIVATE(d_deltat_ajs_cv, d_deltaq_ajs_cv)
+#ifdef ISO
+    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:,:)          :: d_deltaxt_wk
+!$OMP THREADPRIVATE(d_deltaxt_wk)
+    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:,:)          :: d_deltaxt_wk_gw
+!$OMP THREADPRIVATE(d_deltaxt_wk_gw)
+    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:,:)          ::  d_deltaxt_the
+!$OMP THREADPRIVATE(d_deltaxt_the)
+    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:,:)          ::  d_deltaxt_vdf
+!$OMP THREADPRIVATE(d_deltaxt_vdf)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)           ::  d_deltaxt_ajs_cv
+!$OMP THREADPRIVATE(d_deltaxt_ajs_cv)
+#endif                       
 !!         End of Wake variables
 !!
@@ -343,8 +406,24 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxfluxlat, zxtsol, snow_lsc, zxfqfonte
 !$OMP THREADPRIVATE(zxfluxlat, zxtsol, snow_lsc, zxfqfonte)
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxrunofflic
-!$OMP THREADPRIVATE(zxrunofflic)
+!SN runoffdiag
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxrunofflic, runoff_diag
+!$OMP THREADPRIVATE(zxrunofflic, runoff_diag)
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxqsurf, rain_lsc, rain_num
 !$OMP THREADPRIVATE(zxqsurf, rain_lsc, rain_num)
+#ifdef ISO
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: xtevap,xtprw
+!$OMP THREADPRIVATE(xtevap,xtprw)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: h1_diag
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: xtrunoff_diag
+!$OMP THREADPRIVATE(h1_diagv,xtrunoff_diag)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zxfxtcalving
+!$OMP THREADPRIVATE(zxfxtcalving)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: xtsnow_lsc, zxfxtfonte
+!$OMP THREADPRIVATE(xtsnow_lsc, zxfxtfonte)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zxxtrunofflic
+!$OMP THREADPRIVATE(zxxtrunofflic)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: xtrain_lsc
+!$OMP THREADPRIVATE(xtrain_lsc)
+#endif
 !
 !jyg+nrlmd<
@@ -384,4 +463,10 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: kh, kh_x, kh_w
 !$OMP THREADPRIVATE(kh, kh_x, kh_w)
+#ifdef ISO
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: dxtvdf_x, dxtvdf_w
+!$OMP THREADPRIVATE(dxtvdf_x, dxtvdf_w)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: xt_therm
+!$OMP THREADPRIVATE(xt_therm)
+#endif
 !!!
 !!!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
@@ -446,4 +531,50 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:):: sij
 !$OMP THREADPRIVATE(sij)
+#ifdef ISO
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xtwdtrainA
+!$OMP THREADPRIVATE(xtwdtrainA)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xtev
+!$OMP THREADPRIVATE(xtev)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xttaa
+!$OMP THREADPRIVATE(xttaa)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xtclw
+!$OMP THREADPRIVATE(xtclw)
+#ifdef DIAGISO
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: qlp
+!$OMP THREADPRIVATE(qlp)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: qvp
+!$OMP THREADPRIVATE(qvp)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: fq_detrainement
+!$OMP THREADPRIVATE(fq_detrainement)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: fq_ddft
+!$OMP THREADPRIVATE(fq_ddft)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: fq_fluxmasse
+!$OMP THREADPRIVATE(fq_fluxmasse)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: fq_evapprecip
+!$OMP THREADPRIVATE(fq_evapprecip)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: f_detrainement
+!$OMP THREADPRIVATE(f_detrainement)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: q_detrainement
+!$OMP THREADPRIVATE(q_detrainement)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xt_detrainement
+!$OMP THREADPRIVATE(xt_detrainement)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xtlp
+!$OMP THREADPRIVATE(xtlp)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xtvp
+!$OMP THREADPRIVATE(xtvp)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: q_the
+!$OMP THREADPRIVATE(q_the)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xt_the
+!$OMP THREADPRIVATE(xt_the)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: fxt_detrainement
+!$OMP THREADPRIVATE(fxt_detrainement)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: fxt_ddft
+!$OMP THREADPRIVATE(fxt_ddft)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: fxt_fluxmasse
+!$OMP THREADPRIVATE(fxt_fluxmasse)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: fxt_evapprecip
+!$OMP THREADPRIVATE(fxt_evapprecip)
+#endif
+#endif
 !
 !      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: coefh, coefm, lambda_th
@@ -481,4 +612,10 @@
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pfraclr,pfracld
 !$OMP THREADPRIVATE(pfraclr,pfracld)
+      REAL, SAVE, ALLOCATABLE :: cldfraliq(:,:)
+!$OMP THREADPRIVATE(cldfraliq)
+      REAL, SAVE, ALLOCATABLE ::mean_icefracturb(:,:)
+!$OMP THREADPRIVATE(mean_icefracturb)
+      REAL, SAVE, ALLOCATABLE :: sigma2_icefracturb(:,:)
+!$OMP THREADPRIVATE(sigma2_icefracturb)
 
 ! variables de sorties MM
@@ -487,4 +624,12 @@
 !$OMP THREADPRIVATE(zxsnow,snowhgt,qsnow,to_ice)
 !$OMP THREADPRIVATE(sissnow,runoff,albsol3_lic)
+#ifdef ISO
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: zxxtsnow
+!$OMP THREADPRIVATE(zxxtsnow)     
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: xtVprecip,xtVprecipi
+!$OMP THREADPRIVATE(xtVprecip,xtVprecipi) 
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: pxtrfl, pxtsfl
+!$OMP THREADPRIVATE(pxtrfl, pxtsfl) 
+#endif
 
       REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: p_tropopause, z_tropopause, t_tropopause
@@ -567,8 +712,14 @@
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: R2SO4
 !$OMP THREADPRIVATE(R2SO4)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: R2SO4B
+!$OMP THREADPRIVATE(R2SO4B)
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: DENSO4
 !$OMP THREADPRIVATE(DENSO4)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:, :) :: DENSO4B
+!$OMP THREADPRIVATE(DENSO4B)      
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: f_r_wet
 !$OMP THREADPRIVATE(f_r_wet)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:, :) :: f_r_wetB
+!$OMP THREADPRIVATE(f_r_wetB)
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: decfluxaer
 !$OMP THREADPRIVATE(decfluxaer)
@@ -599,4 +750,19 @@
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vsed_aer
 !$OMP THREADPRIVATE(vsed_aer)
+!     Sulfate aerosol concentration (dry mixing ratio) (condensed H2SO4 mmr)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sulfmmr
+!$OMP THREADPRIVATE(sulfmmr)
+!     SAD all aerosols (cm2/cm3)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: SAD_sulfate
+!$OMP THREADPRIVATE(SAD_sulfate)
+!     Effective radius of wet surface aerosols (cm)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: reff_sulfate
+!$OMP THREADPRIVATE(reff_sulfate)
+!     sulfate MMR in different modes (based on sulfmmr, it must be dry mmr)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sulfmmr_mode
+!$OMP THREADPRIVATE(sulfmmr_mode)
+!     particle concentration in different modes (part/m3)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nd_mode
+!$OMP THREADPRIVATE(nd_mode)
 !
 !---3D budget variables
@@ -647,17 +813,28 @@
 SUBROUTINE phys_local_var_init
 USE dimphy
-USE infotrac_phy, ONLY : nbtr
+USE infotrac_phy, ONLY : nbtr,nqtot
+#ifdef ISO
+USE infotrac_phy, ONLY : ntraciso=>ntiso,niso
+#endif
 USE aero_mod
 USE indice_sol_mod
 USE phys_output_var_mod
 USE phys_state_var_mod
+#ifdef CPP_StratAer
+USE infotrac_phy, ONLY : nbtr_bin
+#endif
 
 IMPLICIT NONE
       ALLOCATE(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev), qbs_seri(klon,klev))
+! SN 4D ISO
+      ALLOCATE(qx_seri(klon,klev,nqtot))
+! SN
       ALLOCATE(u_seri(klon,klev),v_seri(klon,klev))
       ALLOCATE(cf_seri(klon,klev),rvc_seri(klon,klev))
       ALLOCATE(l_mixmin(klon,klev+1,nbsrf),l_mix(klon,klev+1,nbsrf),wprime(klon,klev+1,nbsrf))
       ALLOCATE(pbl_eps(klon,klev+1,nbsrf+1))
+      ALLOCATE(tke_shear(klon,klev+1,nbsrf), tke_buoy(klon,klev+1,nbsrf), tke_trans(klon,klev+1,nbsrf))
       pbl_eps(:,:,:)=0.
+      tke_shear(:,:,:)=0.; tke_buoy(:,:,:)=0.; tke_trans(:,:,:)=0.
       l_mix(:,:,:)=0.;l_mixmin(:,:,:)=0.;wprime(:,:,:)=0. ! doit etre initialse car pas toujours remplis
       ALLOCATE(rhcl(klon,klev))
@@ -684,4 +861,7 @@
       ALLOCATE(d_u_ajs(klon,klev),d_v_ajs(klon,klev))
       ALLOCATE(d_t_eva(klon,klev),d_q_eva(klon,klev))
+! SN 4D ISO
+      ALLOCATE(d_qx_eva(klon,klev,nqtot))
+! SN 
       ALLOCATE(d_ql_eva(klon,klev),d_qi_eva(klon,klev))
       ALLOCATE(d_t_lscst(klon,klev),d_q_lscst(klon,klev))
@@ -690,7 +870,36 @@
       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_bsss(klon,klev),d_q_bsss(klon,klev),d_qbs_bsss(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))
+#ifdef ISO
+      allocate(xt_seri(ntraciso,klon,klev))
+      allocate(xtl_seri(ntraciso,klon,klev))
+      allocate(xts_seri(ntraciso,klon,klev))
+      allocate(xtbs_seri(ntraciso,klon,klev))
+      allocate(d_xt_dyn(ntraciso,klon,klev))
+      allocate(d_xtl_dyn(ntraciso,klon,klev))
+      allocate(d_xts_dyn(ntraciso,klon,klev))
+      allocate(d_xtbs_dyn(ntraciso,klon,klev))
+      allocate(d_xt_con(ntraciso,klon,klev))
+      allocate(d_xt_wake(ntraciso,klon,klev))
+      allocate(d_xt_lsc(ntraciso,klon,klev))
+      allocate(d_xtl_lsc(ntraciso,klon,klev))
+      allocate(d_xti_lsc(ntraciso,klon,klev))
+      allocate(d_xt_ajsb(ntraciso,klon,klev))
+      allocate(d_xt_ajs(ntraciso,klon,klev))
+      allocate(d_xt_ajs_w(ntraciso,klon,klev))
+      allocate(d_xt_ajs_x(ntraciso,klon,klev))
+      allocate(d_xt_eva(ntraciso,klon,klev))
+      allocate(d_xtl_eva(ntraciso,klon,klev))
+      allocate(d_xti_eva(ntraciso,klon,klev))
+      allocate(d_xt_vdf(ntraciso,klon,klev))  
+      allocate(d_xt_vdf_w(ntraciso,klon,klev))
+      allocate(d_xt_vdf_x(ntraciso,klon,klev))
+      allocate(d_xt_ch4(ntraciso,klon,klev))
+      allocate(d_xt_prod_nucl(ntraciso,klon,klev))
+      allocate(d_xt_cosmo(ntraciso,klon,klev))
+      allocate(d_xt_decroiss(ntraciso,klon,klev))
+#endif
 
       ALLOCATE(d_u_vdf(klon,klev),d_v_vdf(klon,klev))
@@ -704,6 +913,4 @@
       ALLOCATE(d_ts(klon,nbsrf), d_tr(klon,klev,nbtr))
 
-! aerosols
-      ALLOCATE(m_allaer(klon,klev,naero_tot))
 ! Special RRTM
       ALLOCATE(ZLWFT0_i(klon,klev+1),ZSWFT0_i(klon,klev+1),ZFLDN0(klon,klev+1))
@@ -813,4 +1020,11 @@
 !!      ALLOCATE( d_s_the(klon), d_dens_the(klon))
       ALLOCATE(d_deltat_ajs_cv(klon, klev), d_deltaq_ajs_cv(klon, klev))
+#ifdef ISO
+      ALLOCATE(d_deltaxt_wk(ntraciso,klon, klev))
+      ALLOCATE(d_deltaxt_wk_gw(ntraciso,klon, klev))
+      ALLOCATE(d_deltaxt_the(ntraciso,klon, klev))
+      ALLOCATE(d_deltaxt_vdf(ntraciso,klon, klev))
+      ALLOCATE(d_deltaxt_ajs_cv(ntraciso,klon, klev))
+#endif
 !!         End of wake variables
 !!
@@ -834,5 +1048,7 @@
       ALLOCATE(zxfqcalving(klon), zxfluxlat(klon))
       ALLOCATE(zxtsol(klon), snow_lsc(klon), zxfqfonte(klon), zxqsurf(klon))
-      ALLOCATE(zxrunofflic(klon))
+! SN add runoff_diag
+      ALLOCATE(zxrunofflic(klon), runoff_diag(klon))
+      runoff_diag(:)=0.
       ALLOCATE(zxustartlic(klon), zxrhoslic(klon), zxqsaltlic(klon))
       zxustartlic(:)=0. ; zxrhoslic(:)=0. ; zxqsaltlic(:)=0.
@@ -841,4 +1057,17 @@
       ALLOCATE(qlth(klon,klev), qith(klon,klev), qsith(klon,klev), wiceth(klon,klev))
       !
+#ifdef ISO
+      ALLOCATE(xtevap(ntraciso,klon))
+      ALLOCATE(xtprw(ntraciso,klon))
+      ALLOCATE(zxfxtcalving(niso,klon))
+      ALLOCATE(xtsnow_lsc(ntraciso,klon), zxfxtfonte(niso,klon)) 
+      ALLOCATE(zxxtrunofflic(niso,klon)) 
+      ALLOCATE(xtrain_lsc(ntraciso,klon))
+      ALLOCATE(xtrunoff_diag(niso,klon))
+      ALLOCATE(h1_diag(klon))
+!SN
+      xtrunoff_diag(:,:)=0. ! because variables are only given values on knon grid points
+#endif
+!
       ALLOCATE(sens_x(klon), sens_w(klon))
       ALLOCATE(zxfluxlat_x(klon), zxfluxlat_w(klon))
@@ -857,4 +1086,8 @@
       ALLOCATE(cdragm_x(klon), cdragm_w(klon))
       ALLOCATE(kh(klon), kh_x(klon), kh_w(klon))
+#ifdef ISO
+      ALLOCATE(dxtvdf_x(ntraciso,klon,klev), dxtvdf_w(ntraciso,klon,klev))
+      ALLOCATE(xt_therm(ntraciso,klon,klev))
+#endif
 !
       ALLOCATE(ptconv(klon,klev))
@@ -912,4 +1145,27 @@
       ALLOCATE(epmlmMm(klon,klev,klev), eplaMm(klon,klev))
       ALLOCATE(sij(klon,klev,klev))
+#ifdef ISO
+      ALLOCATE(xtwdtrainA(ntraciso,klon,klev))
+      ALLOCATE(xtev(ntraciso,klon,klev) )
+      ALLOCATE(xttaa(ntraciso,klon,klev) )
+      ALLOCATE(xtclw(ntraciso,klon,klev) )
+#ifdef DIAGISO
+      ALLOCATE(qlp(klon,klev))
+      ALLOCATE(qvp(klon,klev))
+      ALLOCATE(fq_detrainement(klon,klev))
+      ALLOCATE(fq_ddft(klon,klev))
+      ALLOCATE(fq_fluxmasse(klon,klev))
+      ALLOCATE(fq_evapprecip(klon,klev))
+      ALLOCATE(f_detrainement(klon,klev), q_detrainement(klon,klev))
+      ALLOCATE(xtlp(ntraciso,klon,klev))
+      ALLOCATE(xtvp(ntraciso,klon,klev))
+      ALLOCATE(q_the(klon,klev), xt_the(ntraciso,klon,klev))
+      ALLOCATE(fxt_detrainement(ntraciso,klon,klev))
+      ALLOCATE(fxt_ddft(ntraciso,klon,klev))
+      ALLOCATE(fxt_fluxmasse(ntraciso,klon,klev))
+      ALLOCATE(fxt_evapprecip(ntraciso,klon,klev))
+      ALLOCATE(xt_detrainement(ntraciso,klon,klev))
+#endif
+#endif
 
       ALLOCATE(prfl(klon, klev+1))
@@ -931,4 +1187,7 @@
       ALLOCATE(pfraclr(klon,klev),pfracld(klon,klev))
       pfraclr(:,:)=0. ; pfracld(:,:)=0. ! because not always defined
+      ALLOCATE(cldfraliq(klon,klev))
+      ALLOCATE(sigma2_icefracturb(klon,klev))
+      ALLOCATE(mean_icefracturb(klon,klev))
       ALLOCATE(distcltop(klon,klev))
       ALLOCATE(temp_cltop(klon,klev))
@@ -937,4 +1196,9 @@
       ALLOCATE (zxsnow(klon),snowhgt(klon),qsnow(klon),to_ice(klon))
       ALLOCATE (sissnow(klon),runoff(klon),albsol3_lic(klon))
+#ifdef ISO
+      ALLOCATE (zxxtsnow(niso,klon))
+      ALLOCATE(xtVprecip(ntraciso,klon, klev+1),xtVprecipi(ntraciso,klon, klev+1))
+      ALLOCATE(pxtsfl(ntraciso,klon, klev+1),pxtrfl(ntraciso,klon, klev+1))
+#endif
 
       ALLOCATE (p_tropopause(klon))
@@ -968,6 +1232,9 @@
       ALLOCATE (d_q_emiss(klon,klev))
       ALLOCATE (R2SO4(klon,klev))
+      ALLOCATE (R2SO4B(klon,klev,nbtr_bin))
       ALLOCATE (DENSO4(klon,klev))
+      ALLOCATE (DENSO4B(klon,klev,nbtr_bin))
       ALLOCATE (f_r_wet(klon,klev))
+      ALLOCATE (f_r_wetB(klon,klev,nbtr_bin))
       ALLOCATE (decfluxaer(klon,nbtr))
       ALLOCATE (mdw(nbtr))
@@ -1006,4 +1273,9 @@
       ALLOCATE (surf_PM25_sulf(klon))
       ALLOCATE (vsed_aer(klon,klev))
+      ALLOCATE (sulfmmr(klon,klev))
+      ALLOCATE (SAD_sulfate(klon,klev))
+      ALLOCATE (reff_sulfate(klon,klev))
+      ALLOCATE (sulfmmr_mode(klon,klev,nbtr_bin))
+      ALLOCATE (nd_mode(klon,klev,nbtr_bin))
 #endif
 
@@ -1016,7 +1288,11 @@
 IMPLICIT NONE
       DEALLOCATE(t_seri,q_seri,ql_seri,qs_seri, qbs_seri)
+! SN 4D ISO
+      DEALLOCATE(qx_seri)
+! SN
       DEALLOCATE(u_seri,v_seri)
       DEALLOCATE(cf_seri,rvc_seri)
       DEALLOCATE(l_mixmin,l_mix,wprime)
+      DEALLOCATE(tke_shear,tke_buoy,tke_trans)
       DEALLOCATE(pbl_eps)
       DEALLOCATE(rhcl)
@@ -1043,4 +1319,7 @@
       DEALLOCATE(d_u_ajs,d_v_ajs)
       DEALLOCATE(d_t_eva,d_q_eva)
+! SN 4D ISO
+      DEALLOCATE(d_qx_eva)
+! SN
       DEALLOCATE(d_ql_eva,d_qi_eva)
       DEALLOCATE(d_t_lscst,d_q_lscst)
@@ -1049,5 +1328,27 @@
       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_t_bsss,d_q_bsss,d_qbs_bsss)
+#ifdef ISO
+      deallocate(xt_seri,xtl_seri,xts_seri,xtbs_seri)
+      DEALLOCATE(d_xtl_eva,d_xti_eva)
+      deallocate(d_xt_dyn,d_xtl_dyn,d_xts_dyn,d_xtbs_dyn)
+      deallocate(d_xt_con)
+      deallocate(d_xt_wake)
+      deallocate(d_xt_lsc)
+      deallocate(d_xtl_lsc,d_xti_lsc)
+      deallocate(d_xt_ajsb)
+      deallocate(d_xt_ajs)
+      deallocate(d_xt_ajs_w,d_xt_ajs_x)
+      deallocate(d_xt_eva)
+      deallocate(d_xtl_eva)
+      deallocate(d_xti_eva)
+      deallocate(d_xt_vdf)
+      deallocate(d_xt_vdf_w,d_xt_vdf_x)
+      deallocate(d_xt_ch4)
+      deallocate(d_xt_prod_nucl)
+      deallocate(d_xt_cosmo)
+      deallocate(d_xt_decroiss)
+#endif
+
       DEALLOCATE(d_u_vdf,d_v_vdf)
       DEALLOCATE(d_t_oli,d_t_oro)
@@ -1121,6 +1422,4 @@
       DEALLOCATE(solsw_aerop, solsw0_aerop)
       DEALLOCATE(topswcf_aerop, solswcf_aerop)
-!AI Aerosols
-      DEALLOCATE(m_allaer)
 !CK LW diagnostics
       DEALLOCATE(toplwad_aerop, sollwad_aerop)
@@ -1155,4 +1454,10 @@
 !!      DEALLOCATE( d_s_the, d_dens_the)
       DEALLOCATE(d_deltat_ajs_cv, d_deltaq_ajs_cv)
+#ifdef ISO
+      DEALLOCATE(d_deltaxt_wk)
+      DEALLOCATE(d_deltaxt_wk_gw)
+      DEALLOCATE(d_deltaxt_ajs_cv)
+      DEALLOCATE(d_deltaxt_vdf)
+#endif
 !
       DEALLOCATE(bils)
@@ -1173,5 +1478,6 @@
       DEALLOCATE(uwat, vwat)
       DEALLOCATE(zxfqcalving, zxfluxlat)
-      DEALLOCATE(zxrunofflic)
+! SN runoff_diag
+      DEALLOCATE(zxrunofflic, runoff_diag)
       DEALLOCATE(zxustartlic, zxrhoslic, zxqsaltlic)
       DEALLOCATE(zxtsol, snow_lsc, zxfqfonte, zxqsurf)
@@ -1194,4 +1500,14 @@
       DEALLOCATE(cdragm_x, cdragm_w)
       DEALLOCATE(kh, kh_x, kh_w)
+#ifdef ISO
+      DEALLOCATE(xtevap,xtprw)
+      DEALLOCATE(zxfxtcalving)
+      DEALLOCATE(zxxtrunofflic)
+      DEALLOCATE(xtsnow_lsc, zxfxtfonte)
+      DEALLOCATE(xtrain_lsc)
+      DEALLOCATE(dxtvdf_x, dxtvdf_w)
+      DEALLOCATE(xt_therm)
+      DEALLOCATE(h1_diag,xtrunoff_diag)
+#endif
 !
       DEALLOCATE(ptconv)
@@ -1243,4 +1559,27 @@
       DEALLOCATE(epmlmMm, eplaMm)
       DEALLOCATE(sij)
+#ifdef ISO
+      DEALLOCATE(xtwdtrainA)
+      DEALLOCATE(xttaa )
+      DEALLOCATE(xtclw )
+      DEALLOCATE(xtev )
+#ifdef DIAGISO
+      DEALLOCATE(qlp)
+      DEALLOCATE(qvp)
+      DEALLOCATE(fq_detrainement)
+      DEALLOCATE(fq_ddft)
+      DEALLOCATE(fq_fluxmasse)
+      DEALLOCATE(fq_evapprecip)
+      DEALLOCATE(f_detrainement,q_detrainement)
+      DEALLOCATE(xtlp)
+      DEALLOCATE(xtvp)
+      DEALLOCATE(q_the,xt_the)
+      DEALLOCATE(fxt_detrainement)
+      DEALLOCATE(fxt_ddft)
+      DEALLOCATE(fxt_fluxmasse)
+      DEALLOCATE(fxt_evapprecip)
+      DEALLOCATE(xt_detrainement)
+#endif
+#endif
 
 
@@ -1259,7 +1598,14 @@
       DEALLOCATE(rneb)
       DEALLOCATE(pfraclr,pfracld)
+      DEALLOCATE(cldfraliq)
+      DEALLOCATE(sigma2_icefracturb)
+      DEALLOCATE(mean_icefracturb)
       DEALLOCATE (zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic)
       DEALLOCATE(distcltop)
       DEALLOCATE(temp_cltop)
+#ifdef ISO
+      DEALLOCATE (zxxtsnow,xtVprecip,xtVprecipi,pxtrfl,pxtsfl)
+#endif
+
       DEALLOCATE (p_tropopause)
       DEALLOCATE (z_tropopause)
@@ -1291,7 +1637,7 @@
 ! variables for strat. aerosol CK
       DEALLOCATE (d_q_emiss)
-      DEALLOCATE (R2SO4)
-      DEALLOCATE (DENSO4)
-      DEALLOCATE (f_r_wet)
+      DEALLOCATE (R2SO4, R2SO4B)
+      DEALLOCATE (DENSO4, DENSO4B)
+      DEALLOCATE (f_r_wet, f_r_wetB)
       DEALLOCATE (decfluxaer)
       DEALLOCATE (mdw)
@@ -1308,4 +1654,9 @@
       DEALLOCATE (surf_PM25_sulf)
       DEALLOCATE (vsed_aer)
+      DEALLOCATE (sulfmmr)
+      DEALLOCATE (SAD_sulfate)
+      DEALLOCATE (reff_sulfate)
+      DEALLOCATE (sulfmmr_mode)
+      DEALLOCATE (nd_mode)
       DEALLOCATE (budg_3D_ocs_to_so2)
       DEALLOCATE (budg_3D_so2_to_h2so4)
Index: /LMDZ6/branches/cirrus/libf/phylmd/phys_output_ctrlout_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/phys_output_ctrlout_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/phys_output_ctrlout_mod.F90	(revision 5202)
@@ -1112,6 +1112,13 @@
   TYPE(ctrl_out), SAVE :: o_tke = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'tke ', 'TKE', 'm2/s2', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_tke_shear = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'tke_shear ', 'TKE shear term', 'm2/s3', (/ ('', i=1, 10) /))  
+  TYPE(ctrl_out), SAVE :: o_tke_buoy = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'tke_buoy ', 'TKE buoyancy term', 'm2/s3', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_tke_trans = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'tke_trans ', 'TKE transport term', 'm2/s3', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_tke_dissip = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'tke_dissip ', 'TKE DISSIPATION', 'm2/s3', (/ ('', i=1, 10) /))   
+    'tke_dissip ', 'TKE dissipation term', 'm2/s3', (/ ('', i=1, 10) /))
+
   TYPE(ctrl_out), SAVE :: o_tke_max = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'tke_max', 'TKE max', 'm2/s2',                                  &
@@ -1442,4 +1449,12 @@
   TYPE(ctrl_out), SAVE :: o_tau_strat_1020 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     'OD1020_strat_only', 'Stratospheric Aerosol Optical depth at 1020 nm ', '1', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_SAD_sulfate = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
+    'SAD_sulfate', 'SAD WET sulfate aerosols', 'cm2/cm3', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_reff_sulfate = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
+    'reff_sulfate', 'Effective radius of WET sulfate aerosols', 'cm', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_sulfmmr = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
+    'sulfMMR', 'Sulfate aerosol concentration (dry mass mixing ratio)', 'kg(H2SO4)/kg(air)', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_nd_mode(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_sulfmmr_mode(:)
 !--chemistry
   TYPE(ctrl_out), SAVE :: o_R2SO4 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
@@ -1551,4 +1566,11 @@
   TYPE(ctrl_out), SAVE :: o_rneb = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'rneb', 'Cloud fraction', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_cldfraliq = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'cldfraliq', 'Liquid fraction of the cloud', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_sigma2_icefracturb = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'sigma2_icefracturb', 'Variance of the diagnostic supersaturation distribution (icefrac_turb) [-]', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_mean_icefracturb = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'mean_icefracturb', 'Mean of the diagnostic supersaturation distribution (icefrac_turb) [-]', '-', (/ ('', i=1, 10) /))
+ 
   TYPE(ctrl_out), SAVE :: o_rnebjn = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11,11, 11/), &      
     'rnebjn', 'Cloud fraction in day', '-', (/ ('', i=1, 10) /))
@@ -1981,4 +2003,28 @@
   TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_dry(:)
 
+#ifdef ISO
+  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(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtovap(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtoliq(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtcond(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtrunoff_diag(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtdyn(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtldyn(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtvdf(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtcon(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtlsc(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxteva(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtajs(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtthe(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtch4(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtprod_nucl(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtcosmo(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtdecroiss(:)
+#endif
+
   TYPE(ctrl_out), SAVE :: o_rsu = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'rsu', 'SW upward radiation', 'W m-2', (/ ('', i=1, 10) /))
@@ -2064,4 +2110,9 @@
   TYPE(ctrl_out), SAVE :: o_runoff = ctrl_out((/ 1, 1, 10, 1, 10, 10, 11, 11, 11, 11/), &
     'runoff', 'Run-off rate land ice', 'kg/m2/s', (/ ('', i=1, 10) /))
+! SN add runoff_diag
+!#ifdef ISO
+  TYPE(ctrl_out), SAVE :: o_runoff_diag = ctrl_out((/ 1, 1, 10, 1, 10, 10, 11, 11, 11, 11/), &
+    'runoffland', 'Run-off rate land for bucket', 'kg/m2/s', (/ ('', i=1, 10) /))
+!#endif
   TYPE(ctrl_out), SAVE :: o_albslw3 = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     'albslw3', 'Surface albedo LW3', '-', (/ ('', i=1, 10) /))
Index: /LMDZ6/branches/cirrus/libf/phylmd/phys_output_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/phys_output_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/phys_output_mod.F90	(revision 5202)
@@ -35,5 +35,5 @@
     USE iophy 
     USE dimphy
-    USE infotrac_phy, ONLY: nqtot, tracers, niso
+    USE infotrac_phy, ONLY: nqtot, tracers, niso, ntraciso=>ntiso
     USE strings_mod,  ONLY: maxlen
     USE ioipsl
@@ -49,4 +49,13 @@
     ! ug Pour les sorties XIOS
     USE wxios
+#ifdef CPP_StratAer
+   USE infotrac_phy, ONLY: nbtr_bin
+#endif
+#ifdef ISO
+    USE isotopes_mod, ONLY: isoName,iso_HTO
+#ifdef ISOTRAC
+    use isotrac_mod, only: index_zone,index_iso,strtrac
+#endif
+#endif
 
     IMPLICIT NONE
@@ -93,5 +102,5 @@
     CHARACTER(LEN=4), DIMENSION(nlevSTD)  :: clevSTD
     REAL, DIMENSION(nlevSTD)              :: rlevSTD
-    INTEGER                               :: nsrf, k, iq, iff, i, j, ilev, itr, ixt, iiso, izone
+    INTEGER                               :: nsrf, k, iq, iff, i, j, ilev, itr, itrb, ixt, iiso, izone
     INTEGER                               :: naero
     LOGICAL                               :: ok_veget
@@ -112,4 +121,8 @@
     LOGICAL, DIMENSION(nfiles)            :: phys_out_filestations
 
+#ifdef ISO
+    CHARACTER(LEN=maxlen) :: outiso
+    CHARACTER(LEN=20) :: unit
+#endif
     CHARACTER(LEN=maxlen) :: tnam, lnam, dn
     INTEGER :: flag(nfiles)
@@ -158,4 +171,32 @@
     ALLOCATE(o_dtr_sscav(nqtot),o_dtr_sat(nqtot),o_dtr_uscav(nqtot))
     ALLOCATE(o_dtr_dry(nqtot),o_dtr_vdf(nqtot))
+#ifdef CPP_StratAer
+    ALLOCATE(o_nd_mode(nbtr_bin),o_sulfmmr_mode(nbtr_bin))
+#endif
+#ifdef ISO
+    ALLOCATE(o_xtprecip(ntraciso))
+    ALLOCATE(o_xtplul(ntraciso))
+    ALLOCATE(o_xtpluc(ntraciso))
+    ALLOCATE(o_xtevap(ntraciso))
+    ALLOCATE(o_xtevap_srf(ntraciso,4))
+    ALLOCATE(o_xtovap(ntraciso))
+    ALLOCATE(o_xtoliq(ntraciso))
+    ALLOCATE(o_xtcond(ntraciso))
+    ALLOCATE(o_xtrunoff_diag(ntraciso))
+    ALLOCATE(o_dxtdyn(ntraciso))
+    ALLOCATE(o_dxtldyn(ntraciso))
+    ALLOCATE(o_dxtcon(ntraciso))
+    ALLOCATE(o_dxtlsc(ntraciso))
+    ALLOCATE(o_dxteva(ntraciso))
+    ALLOCATE(o_dxtajs(ntraciso))
+    ALLOCATE(o_dxtvdf(ntraciso))
+    ALLOCATE(o_dxtthe(ntraciso))
+    ALLOCATE(o_dxtch4(ntraciso))
+    if (iso_HTO.gt.0) then
+      ALLOCATE(o_dxtprod_nucl(ntraciso))
+      ALLOCATE(o_dxtcosmo(ntraciso))
+      ALLOCATE(o_dxtdecroiss(ntraciso))
+    endif
+#endif
 
     levmax = [klev, klev, klev, klev, klev, klev, nlevSTD, nlevSTD, nlevSTD, klev]
@@ -467,5 +508,5 @@
      ENDIF ! clef_files
 
-          itr = 0
+          itr = 0; itrb = 0
           DO iq = 1, nqtot 
             IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
@@ -503,9 +544,74 @@
             lnam = 'Cumulated tracer '//TRIM(tracers(iq)%longName)
             tnam = 'cum'//TRIM(tracers(iq)%name); o_trac_cum(itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-          ENDDO
+            
+#ifdef CPP_StratAer
+            if(tracers(iq)%name(1:3)=='BIN') then
+               itrb = itrb + 1
+               flag = [11, 11, 11, 11, 11, 11, 11, 11, 11, 1]
+               lnam = 'Dry particle concentration in '//TRIM(tracers(iq)%longName)
+               tnam = TRIM(tracers(iq)%name)//'_nd_mode';     o_nd_mode       (itrb) = ctrl_out(flag, tnam, lnam, "part/m3", [('',i=1,nfiles)])
+               lnam = 'Sulfate MMR in '//TRIM(tracers(iq)%longName)
+               tnam = TRIM(tracers(iq)%name)//'_sulfmmr_mode';o_sulfmmr_mode  (itrb) = ctrl_out(flag, tnam, lnam, "kg(H2SO4)/kg(air)", [('',i=1,nfiles)])
+            endif
+#endif
+         ENDDO
 
    ENDDO !  iff
 
-    ! Updated write frequencies due to phys_out_filetimesteps. 
+#ifdef ISO
+    write(*,*) 'phys_output_mid 589'
+    do ixt=1,ntraciso
+      outiso = TRIM(isoName(ixt))
+      i = INDEX(outiso, '_', .TRUE.)
+      outiso = outiso(1:i-1)//outiso(i+1:LEN_TRIM(outiso))
+
+      flag = [1,  1,  1, 10,  5, 10, 11, 11, 11, 11]; unit = 'kg/(s*m2)'
+      o_xtprecip(ixt)=ctrl_out(flag, 'precip'//TRIM(outiso), 'Precip Totale liq+sol', unit, [('',i=1,nfiles)])
+      o_xtpluc  (ixt)=ctrl_out(flag,   'pluc'//TRIM(outiso),    'Convective Precip.', unit, [('',i=1,nfiles)])
+
+      flag = [1,  1,  1, 10, 10, 10, 11, 11, 11, 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'
+      o_xtovap  (ixt)=ctrl_out(flag,   'ovap'//TRIM(outiso),     'Specific humidity', unit, [('',i=1,nfiles)])
+      o_xtoliq  (ixt)=ctrl_out(flag,   'oliq'//TRIM(outiso),          'Liquid water', unit, [('',i=1,nfiles)])
+      o_xtcond  (ixt)=ctrl_out(flag,  'ocond'//TRIM(outiso),       'Condensed water', unit, [('',i=1,nfiles)])
+
+      flag = [1,  1,  1, 10, 5, 10, 11, 11, 11, 11]; unit = 'kg/m2/s'
+      o_xtrunoff_diag  (ixt)=ctrl_out(flag, 'runoffland'//TRIM(outiso), 'Run-off rate land for bucket', unit, [('',i=1,nfiles)])
+
+      flag = [4, 10, 10, 10, 10, 10, 11, 11, 11, 11]; unit = '(kg/kg)/s'
+      o_dxtdyn  (ixt)=ctrl_out(flag,  'dqdyn'//TRIM(outiso),           'Dynamics dQ', unit, [('',i=1,nfiles)])
+      o_dxtldyn (ixt)=ctrl_out(flag, 'dqldyn'//TRIM(outiso),          'Dynamics dQL', unit, [('',i=1,nfiles)])
+      o_dxtcon  (ixt)=ctrl_out(flag,  'dqcon'//TRIM(outiso),         'Convection dQ', unit, [('',i=1,nfiles)])
+      o_dxteva  (ixt)=ctrl_out(flag,  'dqeva'//TRIM(outiso),      'Reevaporation dQ', unit, [('',i=1,nfiles)])
+      o_dxtlsc  (ixt)=ctrl_out(flag,  'dqlsc'//TRIM(outiso),       'Condensation dQ', unit, [('',i=1,nfiles)])
+      o_dxtajs  (ixt)=ctrl_out(flag,  'dqajs'//TRIM(outiso),        'Dry adjust. dQ', unit, [('',i=1,nfiles)])
+      o_dxtvdf  (ixt)=ctrl_out(flag,  'dqvdf'//TRIM(outiso),     'Boundary-layer dQ', unit, [('',i=1,nfiles)])
+      o_dxtthe  (ixt)=ctrl_out(flag,  'dqthe'//TRIM(outiso),            'Thermal dQ', unit, [('',i=1,nfiles)])
+
+      IF(ok_qch4) o_dxtch4(ixt)=ctrl_out(flag, 'dqch4'//TRIM(outiso), 'H2O due to CH4 oxidation & photolysis', &
+                                                                                      unit, [('',i=1,nfiles)])
+      IF(ixt == iso_HTO) THEN
+      o_dxtprod_nucl(ixt)=ctrl_out(flag, 'dqprodnucl'//TRIM(outiso), 'dHTO/dt due to nuclear production',      &
+                                                                                      unit, [('',i=1,nfiles)])
+      o_dxtcosmo    (ixt)=ctrl_out(flag,    'dqcosmo'//TRIM(outiso), 'dHTO/dt due to cosmogenic production',   &
+                                                                                      unit, [('',i=1,nfiles)])
+      o_dxtdecroiss (ixt)=ctrl_out(flag, 'dqdecroiss'//TRIM(outiso), 'dHTO/dt due to radiative destruction',   &
+                                                                                      unit, [('',i=1,nfiles)])
+      END IF
+    enddo !do ixt=1,niso
+    write(*,*) 'phys_output_mid 596'
+#endif
+
+   ! Updated write frequencies due to phys_out_filetimesteps. 
     ! Write frequencies are now in seconds.  
     ecrit_mth = ecrit_files(1)
Index: /LMDZ6/branches/cirrus/libf/phylmd/phys_output_write_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/phys_output_write_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/phys_output_write_mod.F90	(revision 5202)
@@ -65,5 +65,6 @@
          o_fder, o_ffonte, o_fqcalving, o_fqfonte, o_mrroli, o_runofflic, &
          o_taux, o_tauy, o_snowsrf, o_qsnow, &
-         o_snowhgt, o_toice, o_sissnow, o_runoff, &
+! SN runoff_diag
+         o_snowhgt, o_toice, o_sissnow, o_runoff, o_runoff_diag, &
          o_albslw3, o_pourc_srf, o_fract_srf, &
          o_taux_srf, o_tauy_srf, o_tsol_srf, &
@@ -141,5 +142,5 @@
          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_pfraclr, o_pfracld, o_cldfraliq, o_sigma2_icefracturb, o_mean_icefracturb,  &
          o_qrainlsc, o_qsnowlsc, o_dqreva, o_dqrauto, o_dqrcol, o_dqrmelt, o_dqrfreez, &
          o_dqssub, o_dqsauto, o_dqsagg, o_dqsrim, o_dqsmelt, o_dqsfreez, &
@@ -147,5 +148,5 @@
          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_tke_max, o_kz, o_kz_max, o_clwcon, o_tke_shear, o_tke_buoy, o_tke_trans,  &
          o_dtdyn, o_dqdyn, o_dqdyn2d, o_dqldyn, o_dqldyn2d, & 
          o_dqsdyn, o_dqsdyn2d, o_dqbsdyn, o_dqbsdyn2d, o_dudyn, o_dvdyn, &
@@ -208,4 +209,5 @@
 ! Isotopes
          o_xtprecip,o_xtplul,o_xtpluc,o_xtovap,o_xtoliq,o_xtcond, &
+         o_xtrunoff_diag, &
          o_xtevap,o_dxtdyn,o_dxtldyn,o_dxtcon,o_dxtlsc,o_dxteva, &
          o_dxtajs,o_dxtvdf,o_dxtthe, o_dxtch4, &
@@ -248,4 +250,5 @@
 
 #ifdef CPP_StratAer
+    USE infotrac_phy, ONLY: nbtr_bin
     USE phys_output_ctrlout_mod, ONLY:  & 
          o_budg_3D_nucl, o_budg_3D_cond_evap, o_budg_3D_ocs_to_so2, o_budg_3D_so2_to_h2so4, &
@@ -259,5 +262,6 @@
          o_budg_ocs_to_so2, o_budg_so2_to_h2so4, o_budg_h2so4_to_part, &
          o_surf_PM25_sulf, o_ext_strat_550, o_tau_strat_550, &
-         o_vsed_aer, o_tau_strat_1020, o_ext_strat_1020, o_f_r_wet
+         o_vsed_aer, o_tau_strat_1020, o_ext_strat_1020, o_f_r_wet, &
+         o_SAD_sulfate, o_reff_sulfate, o_sulfmmr, o_nd_mode, o_sulfmmr_mode
 #endif
 
@@ -314,10 +318,11 @@
          zn2mout, t2m_min_mon, t2m_max_mon, evap, &
          snowerosion, zxustartlic, zxrhoslic, zxqsaltlic, &
-         l_mixmin,l_mix, pbl_eps, &
+         l_mixmin,l_mix, pbl_eps, tke_shear, tke_buoy, tke_trans, &
          zu10m, zv10m, zq2m, zustar, zxqsurf, &
          rain_lsc, rain_num, snow_lsc, bils, sens, fder, &
          zxffonte, zxfqcalving, zxfqfonte, zxrunofflic, fluxu, &
          fluxv, zxsnow, qsnow, snowhgt, to_ice, &
-         sissnow, runoff, albsol3_lic, evap_pot, &
+! SN runoff_diag
+         sissnow, runoff, runoff_diag, albsol3_lic, evap_pot, &
          t2m, fluxt, fluxlat, fsollw, fsolsw, &
          wfbils, wfevap, &
@@ -367,6 +372,7 @@
          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, &
-         pfraclr, pfracld,  &
+         rneb, rnebjn, rneblsvol,  &
+         zx_rh, zx_rhl, zx_rhi, &
+         pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, &
          qraindiag, qsnowdiag, dqreva, dqssub, &
          dqrauto,dqrcol,dqrmelt,dqrfreez, &
@@ -382,5 +388,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, &
+         d_t_bsss, d_q_bsss, d_qbs_bsss, 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, &
@@ -395,4 +401,5 @@
         d_xt_ajs, d_xt_ajsb, &
         d_xt_prod_nucl,d_xt_cosmo,d_xt_decroiss, &
+        xtrunoff_diag, &
 #endif
          ep, epmax_diag, &  ! epmax_cape
@@ -416,5 +423,6 @@
          budg_ocs_to_so2, budg_so2_to_h2so4, budg_h2so4_to_part, & 
          surf_PM25_sulf, tau_strat_550, tausum_strat, &
-         vsed_aer, tau_strat_1020, f_r_wet
+         vsed_aer, tau_strat_1020, f_r_wet, &
+         SAD_sulfate, reff_sulfate, sulfmmr, nd_mode, sulfmmr_mode
 #endif
 
@@ -449,5 +457,5 @@
     USE indice_sol_mod, ONLY: nbsrf
 #ifdef ISO
-    USE isotopes_mod, ONLY: iso_HTO
+    USE isotopes_mod, ONLY: iso_HTO, isoName
 #endif
     USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
@@ -530,4 +538,9 @@
     CHARACTER(LEN=maxlen) :: unt
 #endif
+
+#ifdef ISO
+    CHARACTER(LEN=maxlen) :: outiso
+#endif
+
     REAL,DIMENSION(klon,klev) :: z, dz
     REAL,DIMENSION(klon)      :: zrho, zt
@@ -1310,6 +1323,6 @@
 
        ENDDO
-       
-                
+
+
         IF (iflag_pbl > 1) THEN
           zx_tmp_fi3d=0.
@@ -1323,5 +1336,43 @@
           ENDIF
           
-          CALL histwrite_phy(o_tke_dissip, zx_tmp_fi3d)    
+          CALL histwrite_phy(o_tke_dissip, zx_tmp_fi3d)   
+
+          zx_tmp_fi3d=0.
+          IF (vars_defined) THEN
+             DO nsrf=1,nbsrf
+                DO k=1,klev
+                   zx_tmp_fi3d(:,k)=zx_tmp_fi3d(:,k) &
+                        +pctsrf(:,nsrf)*tke_shear(:,k,nsrf)
+                ENDDO
+             ENDDO
+          ENDIF
+
+          CALL histwrite_phy(o_tke_shear, zx_tmp_fi3d)
+
+          zx_tmp_fi3d=0.
+          IF (vars_defined) THEN
+             DO nsrf=1,nbsrf
+                DO k=1,klev
+                   zx_tmp_fi3d(:,k)=zx_tmp_fi3d(:,k) &
+                        +pctsrf(:,nsrf)*tke_buoy(:,k,nsrf)
+                ENDDO
+             ENDDO
+          ENDIF
+
+          CALL histwrite_phy(o_tke_buoy, zx_tmp_fi3d)
+
+
+          zx_tmp_fi3d=0.
+          IF (vars_defined) THEN
+             DO nsrf=1,nbsrf
+                DO k=1,klev
+                   zx_tmp_fi3d(:,k)=zx_tmp_fi3d(:,k) &
+                        +pctsrf(:,nsrf)*tke_trans(:,k,nsrf)
+                ENDDO
+             ENDDO
+          ENDIF
+
+          CALL histwrite_phy(o_tke_trans, zx_tmp_fi3d)
+
        ENDIF
 
@@ -1814,4 +1865,12 @@
           CALL histwrite_phy(o_tau_strat_550, tausum_strat(:,1))
           CALL histwrite_phy(o_tau_strat_1020, tausum_strat(:,2))
+          CALL histwrite_phy(o_SAD_sulfate, SAD_sulfate)
+          CALL histwrite_phy(o_reff_sulfate, reff_sulfate)
+          CALL histwrite_phy(o_sulfmmr, sulfmmr)
+          ! All BINs fields
+          DO itr = 1, nbtr_bin
+             CALL histwrite_phy(o_nd_mode(itr), nd_mode(:,:,itr))
+             CALL histwrite_phy(o_sulfmmr_mode(itr), sulfmmr_mode(:,:,itr))
+          ENDDO !--itr
        ENDIF
 #endif
@@ -2005,4 +2064,7 @@
            CALL histwrite_phy(o_pfraclr, pfraclr)
            CALL histwrite_phy(o_pfracld, pfracld)
+           CALL histwrite_phy(o_cldfraliq, cldfraliq)
+           CALL histwrite_phy(o_sigma2_icefracturb, sigma2_icefracturb)
+           CALL histwrite_phy(o_mean_icefracturb, mean_icefracturb)
            IF (ok_poprecip) THEN
            CALL histwrite_phy(o_qrainlsc, qraindiag)
@@ -2306,9 +2368,9 @@
           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
+          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_qbs_bsss(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
+          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_bsss(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
+          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_bsss(1:klon,1:klev)/pdtphys
           CALL histwrite_phy(o_dtbs, zx_tmp_fi3d)
        ENDIF
@@ -2810,7 +2872,12 @@
        end if
 
+    !! runoff land bucket - ajout S. Nguyen 23 07 2024
+    CALL histwrite_phy(o_runoff_diag, runoff_diag)
+
 #ifdef ISO
-    do ixt=1,ntiso
-!        write(*,*) 'ixt'
+    !write(*,*) 'tmp phys_output_write: ntiso=',ntiso
+
+    DO ixt = 1, ntiso
+        !write(*,*) 'ixt,o_xtovap(ixt)=',ixt,o_xtovap(ixt)
         IF (vars_defined) zx_tmp_fi2d(:) = xtrain_fall(ixt,:) + xtsnow_fall(ixt,:)
         CALL histwrite_phy(o_xtprecip(ixt), zx_tmp_fi2d)
@@ -2824,4 +2891,8 @@
         CALL histwrite_phy(o_xtovap(ixt),  xt_seri(ixt,:,:))
         CALL histwrite_phy(o_xtoliq(ixt), xtl_seri(ixt,:,:))
+
+        !! runoff land bucket - ajout S. Nguyen 25 avril 2024
+        CALL histwrite_phy(o_xtrunoff_diag(ixt), xtrunoff_diag(ixt,:))
+
 
         DO nsrf = 1, nbsrf ! ajout Camille 8 mai 2023
@@ -2884,4 +2955,17 @@
           ENDDO !  iff
 #endif
+
+!SN activate water isotopes present in tracer.def
+#ifdef ISO
+          DO ixt = 1, ntiso
+            outiso = TRIM(isoName(ixt))
+            i = INDEX(outiso, '_', .TRUE.)
+            outiso = outiso(1:i-1)//outiso(i+1:LEN_TRIM(outiso))
+
+            CALL xios_set_fieldgroup_attr("iso2D_"//TRIM(outiso), enabled=.TRUE.)
+            CALL xios_set_fieldgroup_attr("iso3D_"//TRIM(outiso), enabled=.TRUE.)
+
+          ENDDO
+#endif
           !On finalise l'initialisation:
           IF (using_xios) CALL wxios_closedef()
Index: /LMDZ6/branches/cirrus/libf/phylmd/phys_state_var_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/phys_state_var_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/phys_state_var_mod.F90	(revision 5202)
@@ -87,6 +87,7 @@
 !$OMP THREADPRIVATE(prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien)
 #ifdef ISO
-      REAL, ALLOCATABLE, SAVE :: xt_ancien(:,:,:),xtl_ancien(:,:,:),xts_ancien(:,:,:)
-!$OMP THREADPRIVATE(xt_ancien,xtl_ancien,xts_ancien)
+      REAL, ALLOCATABLE, SAVE :: xt_ancien(:,:,:),xtl_ancien(:,:,:),xts_ancien(:,:,:), &
+              xtbs_ancien(:,:,:)
+!$OMP THREADPRIVATE(xt_ancien,xtl_ancien,xts_ancien,xtbs_ancien)
 #endif
       REAL, ALLOCATABLE, SAVE :: u_ancien(:,:), v_ancien(:,:)
@@ -760,4 +761,5 @@
       ALLOCATE(xtl_ancien(ntraciso,klon,klev))
       ALLOCATE(xts_ancien(ntraciso,klon,klev))
+      ALLOCATE(xtbs_ancien(ntraciso,klon,klev))
       ALLOCATE(xtrain_fall(ntraciso,klon))
       ALLOCATE(xtsnow_fall(ntraciso,klon))
@@ -950,5 +952,5 @@
 #ifdef ISO    
       DEALLOCATE(xtsol,fxtevap)  
-      DEALLOCATE(xt_ancien,xtl_ancien,xts_ancien, fxtd, wake_deltaxt)
+      DEALLOCATE(xt_ancien,xtl_ancien,xts_ancien,xtbs_ancien, fxtd, wake_deltaxt)
       DEALLOCATE(xtrain_fall, xtsnow_fall, xtrain_con, xtsnow_con)
 #ifdef ISOTRAC 
Index: /LMDZ6/branches/cirrus/libf/phylmd/physiq_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/physiq_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/physiq_mod.F90	(revision 5202)
@@ -1,3 +1,3 @@
-!
+
 ! $Id$
 !
@@ -184,5 +184,5 @@
        d_ts, &
        !
-       d_t_bs,d_q_bs,d_qbs_bs, &
+       d_t_bsss,d_q_bsss,d_qbs_bsss, &
        !
 !       d_t_oli,d_u_oli,d_v_oli, &
@@ -333,6 +333,6 @@
        !
        rneblsvol, &
-       pfraclr,pfracld, &
-       distcltop,temp_cltop, &
+       pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb,  &
+       distcltop, temp_cltop,  &
        !-- LSCP - condensation and ice supersaturation variables
        qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, &
@@ -909,5 +909,4 @@
     REAL zdtime, zdtime1, zdtime2, zlongi
     !
-    REAL qcheck
     REAL z_avant(klon), z_apres(klon), z_factor(klon)
     LOGICAL zx_ajustq
@@ -1133,4 +1132,5 @@
     REAL, DIMENSION(klon,klev)     :: mass_solu_aero_pi
     ! - " - (pre-industrial value)
+    REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
 
     ! Parameters
@@ -1271,5 +1271,4 @@
 
     !--OB variables for mass fixer (hard coded for now)
-    LOGICAL, PARAMETER :: mass_fixer=.FALSE.
     REAL qql1(klon),qql2(klon),corrqql
 
@@ -1401,15 +1400,4 @@
        IF (read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) & 
           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
 
        print*, '================================================='
@@ -1527,4 +1515,7 @@
        iflag_phytrac = 1 ! by default we do want to call phytrac
        CALL getin_p('iflag_phytrac',iflag_phytrac)
+
+       ok_water_mass_fixer=.FALSE.  ! OB: by default we do not apply the mass fixer
+       CALL getin_p('ok_water_mass_fixer',ok_water_mass_fixer)
 #ifdef CPP_Dust
        IF (iflag_phytrac.EQ.0) THEN 
@@ -1551,4 +1542,5 @@
        WRITE(lunout,*) 'fl_cor_ebil=',        fl_cor_ebil
        WRITE(lunout,*) 'iflag_phytrac=',      iflag_phytrac
+       WRITE(lunout,*) 'ok_water_mass_fixer=',ok_water_mass_fixer
        WRITE(lunout,*) 'NVM=',                nvm_lmdz
 
@@ -1802,7 +1794,8 @@
       IF (.NOT. create_etat0_limit) CALL init_readaerosolstrato(flag_aerosol_strat)  !! initialise aero strato from file for XIOS interpolation (unstructured_grid)
 
+      ! A.I : Initialisations pour le 1er passage a Cosp
       if (ok_cosp) then
+
 #ifdef CPP_COSP
-        ! 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, &
@@ -1824,39 +1817,24 @@
 #endif
 
-#ifdef CPP_COSP2
-        CALL ini_COSP(ref_liq_cosp0,ref_ice_cosp0,pctsrf_cosp0,zu10m_cosp0,zv10m_cosp0, &
+#ifdef CPP_COSPV2
+          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_cosp2(itap,phys_tstep,freq_cosp, &
-               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
-               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
-               klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
-               JrNt,ref_liq,ref_ice, &
-               pctsrf(:,is_ter)+pctsrf(:,is_lic), &
-               zu10m,zv10m,pphis, &
-               zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
-               qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
-               prfl(:,1:klev),psfl(:,1:klev), &
-               pmflxr(:,1:klev),pmflxs(:,1:klev), &
-               mr_ozone,cldtau, cldemi)
-#endif
-
-#ifdef CPP_COSPV2
+
           CALL lmdz_cosp_interface(itap,phys_tstep,freq_cosp, &
                ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
                ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
                klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
-               JrNt,ref_liq,ref_ice, &
-               pctsrf(:,is_ter)+pctsrf(:,is_lic), &
-               zu10m,zv10m,pphis, &
-               phicosp,paprs(:,1:klev),pplay,zxtsol,t_seri, &
-               qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
-               prfl(:,1:klev),psfl(:,1:klev), &
-               pmflxr(:,1:klev),pmflxs(:,1:klev), &
-               mr_ozone,cldtau, cldemi)
+               JrNt_cosp0,ref_liq_cosp0,ref_ice_cosp0, &
+               pctsrf_cosp0, &
+               zu10m_cosp0,zv10m_cosp0,pphis, &
+               pphi,paprs(:,1:klev),pplay,zxtsol_cosp0,t, &
+               qx(:,:,ivap),zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0,fiwc_cosp0, &
+               prfl_cosp0(:,1:klev),psfl_cosp0(:,1:klev), &
+               pmflxr_cosp0(:,1:klev),pmflxs_cosp0(:,1:klev), &
+               mr_ozone_cosp0,cldtau_cosp0, cldemi_cosp0)
 #endif
-      ENDIF 
+      endif  ! ok_cosp
 
        !
@@ -1908,4 +1886,14 @@
        !
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+#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
 
 #ifdef CPP_Dust
@@ -1948,8 +1936,11 @@
        ELSE IF (klon_glo==1) THEN
           pbl_tke(:,:,is_ave) = 0.
+          pbl_eps(:,:,is_ave) = 0.
           DO nsrf=1,nbsrf
             DO k = 1,klev+1
                  pbl_tke(:,k,is_ave) = pbl_tke(:,k,is_ave) &
                      +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf)
+                 pbl_eps(:,k,is_ave) = pbl_eps(:,k,is_ave) &
+                     +pctsrf(:,nsrf)*pbl_eps(:,k,nsrf)
             ENDDO
           ENDDO
@@ -1957,4 +1948,5 @@
           pbl_tke(:,:,is_ave) = 0. !ym missing init : maybe must be initialized in the same way that for klon_glo==1 ??
 !>jyg
+          pbl_eps(:,:,is_ave) = 0.
        ENDIF
        !IM begin
@@ -2470,6 +2462,6 @@
     ENDDO
     !
-    !--OB mass fixer 
-    IF (mass_fixer) THEN
+    !--OB water mass fixer 
+    IF (ok_water_mass_fixer) THEN
     !--store initial water burden
     qql1(:)=0.0
@@ -3024,7 +3016,7 @@
     ! Blowing snow sublimation and sedimentation
 
-    d_t_bs(:,:)=0.
-    d_q_bs(:,:)=0.
-    d_qbs_bs(:,:)=0.
+    d_t_bsss(:,:)=0.
+    d_q_bsss(:,:)=0.
+    d_qbs_bsss(:,:)=0.
     bsfl(:,:)=0.
     bs_fall(:)=0.
@@ -3032,9 +3024,9 @@
 
      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)
+                                        d_t_bsss,d_q_bsss,d_qbs_bsss,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)
+               (du0,dv0,d_t_bsss,d_q_bsss,dql0,dqi0,d_qbs_bsss,paprs,&
+               'bsss',abortphy,flag_inhib_tend,itap,0)
 
     ENDIF
@@ -3079,21 +3071,4 @@
        ENDDO
     ENDDO
-    IF (check) THEN
-       za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
-       WRITE(lunout,*) "avantcon=", za
-    ENDIF
-    zx_ajustq = .FALSE.
-    IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
-    IF (zx_ajustq) THEN
-       DO i = 1, klon
-          z_avant(i) = 0.0
-       ENDDO
-       DO k = 1, klev
-          DO i = 1, klon
-             z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k)) &
-                  *(paprs(i,k)-paprs(i,k+1))/RG
-          ENDDO
-       ENDDO
-    ENDIF
 
     ! Calcule de vitesse verticale a partir de flux de masse verticale
@@ -3488,42 +3463,4 @@
        CALL writefield_phy('q_seri',q_seri,nbp_lev)
     ENDIF
-
-    IF (check) THEN
-       za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
-       WRITE(lunout,*)"aprescon=", za
-       zx_t = 0.0
-       za = 0.0
-       DO i = 1, klon
-          za = za + cell_area(i)/REAL(klon)
-          zx_t = zx_t + (rain_con(i)+ &
-               snow_con(i))*cell_area(i)/REAL(klon)
-       ENDDO
-       zx_t = zx_t/za*phys_tstep
-       WRITE(lunout,*)"Precip=", zx_t
-    ENDIF
-    IF (zx_ajustq) THEN
-       DO i = 1, klon
-          z_apres(i) = 0.0
-       ENDDO
-       DO k = 1, klev
-          DO i = 1, klon
-             z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k)) &
-                  *(paprs(i,k)-paprs(i,k+1))/RG
-          ENDDO
-       ENDDO
-       DO i = 1, klon
-          z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*phys_tstep) &
-               /z_apres(i)
-       ENDDO
-       DO k = 1, klev
-          DO i = 1, klon
-             IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &
-                  z_factor(i).LT.(1.0-1.0E-08)) THEN
-                q_seri(i,k) = q_seri(i,k) * z_factor(i)
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDIF
-    zx_ajustq=.FALSE.
 
     !
@@ -3921,13 +3858,15 @@
 
     CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay, &
-         t_seri, q_seri,ptconv,ratqs, &
+         t_seri, q_seri,qs_ancien,ptconv,ratqs, &
          d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, & 
-         pfraclr,pfracld, &
+         pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb,  &
          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, distcltop, temp_cltop, cell_area, &
-         cf_seri, rvc_seri, u_seri, v_seri, pbl_eps(:,:,is_ave), &
+         iflag_ice_thermo, distcltop, temp_cltop,   &
+         pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), &
+         cell_area, &
+         cf_seri, rvc_seri, u_seri, v_seri, &
          qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, &
          dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, &
@@ -4021,18 +3960,4 @@
        ENDIF
 
-    ENDIF
-
-    IF (check) THEN
-       za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
-       WRITE(lunout,*)"apresilp=", za
-       zx_t = 0.0
-       za = 0.0
-       DO i = 1, klon
-          za = za + cell_area(i)/REAL(klon)
-          zx_t = zx_t + (rain_lsc(i) &
-               + snow_lsc(i))*cell_area(i)/REAL(klon)
-       ENDDO
-       zx_t = zx_t/za*phys_tstep
-       WRITE(lunout,*)"Precip=", zx_t
     ENDIF
 
@@ -4405,5 +4330,5 @@
                   flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
                   pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
-                  tr_seri, mass_solu_aero, mass_solu_aero_pi)  
+                  tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer)  
 #else
                 abort_message='You should compile with -rad ecrad if running with iflag_rrtm=2'
@@ -4651,5 +4576,5 @@
                ! Rajoute par OB pour RRTM
                tau_aero_lw_rrtm, & 
-               cldtaupirad, &
+               cldtaupirad, m_allaer, &
 !              zqsat, flwcrad, fiwcrad, &
                zqsat, flwc, fiwc, &
@@ -4729,5 +4654,5 @@
                                 ! Rajoute par OB pour RRTM
                      tau_aero_lw_rrtm, &
-                     cldtaupi, &
+                     cldtaupi, m_allaer, &
 !                    zqsat, flwcrad, fiwcrad, &
                      zqsat, flwc, fiwc, &
@@ -4775,5 +4700,5 @@
                      tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
                      tau_aero_lw_rrtm, &
-                     cldtaupi, &
+                     cldtaupi, m_allaer, &
                      zqsat, flwc, fiwc, &
                      ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
@@ -5508,5 +5433,5 @@
     !--currently flag is turned off
     !==================================================================
-    IF (mass_fixer) THEN
+    IF (ok_water_mass_fixer) THEN
     qql2(:)=0.0
     DO k = 1, klev
Index: /LMDZ6/branches/cirrus/libf/phylmd/phystokenc_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/phystokenc_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/phystokenc_mod.F90	(revision 5202)
@@ -46,4 +46,6 @@
 ! Objet: Ecriture des variables pour transport offline
 !
+!  Note (A Cozic - July 2024): when coupled with inca, offline fields are no 
+!  longer calculated in this routine but directly in the physics code.
 !======================================================================
 
Index: /LMDZ6/branches/cirrus/libf/phylmd/radlwsw_m.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/radlwsw_m.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/radlwsw_m.F90	(revision 5202)
@@ -21,5 +21,5 @@
        tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB RRTM
        tau_aero_lw_rrtm, &              ! rajoute par C.Kleinschmitt pour RRTM
-       cldtaupi, &
+       cldtaupi, m_allaer, &
        qsat, flwc, fiwc, &
        ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
@@ -80,5 +80,4 @@
     ! Besoin pour ECRAD de pctsrf, zmasq, longitude, altitude
 #ifdef CPP_ECRAD
-    USE phys_local_var_mod, ONLY: rhcl, m_allaer
     USE geometry_mod, ONLY: latitude, longitude
     USE phys_state_var_mod, ONLY: pctsrf
@@ -247,4 +246,5 @@
     REAL,    INTENT(in)  :: ref_liq_pi(klon,klev) ! cloud droplet radius pre-industrial from newmicro
     REAL,    INTENT(in)  :: ref_ice_pi(klon,klev) ! ice crystal radius   pre-industrial from newmicro
+    REAL,    INTENT(in)  :: m_allaer(klon,klev,naero_tot) ! mass aero
 
     CHARACTER(len=512), INTENT(in) :: namelist_ecrad_file
@@ -706,4 +706,6 @@
              zsollw0(i)=0.
              zsollwdown(i)=0.
+             ztoplwad0aero(i) = 0.
+             ztoplwadaero(i) = 0.
           ENDDO
           ! Old radiation scheme, used for AR4 runs
Index: /LMDZ6/branches/cirrus/libf/phylmd/surf_land_bucket_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/surf_land_bucket_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/surf_land_bucket_mod.F90	(revision 5202)
@@ -16,5 +16,11 @@
        snow, qsol, agesno, tsoil, &
        qsurf, z0_new, alb1_new, alb2_new, evap, &
-       fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
+       fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l &
+#ifdef ISO
+       ,xtprecip_rain, xtprecip_snow,xtspechum, &
+       xtsnow, xtsol,xtevap,h1, &
+       runoff_diag,xtrunoff_diag,Rland_ice &
+#endif           
+            )
 
     USE limit_read_mod
@@ -28,4 +34,14 @@
     USE mod_phys_lmdz_para
     USE indice_sol_mod
+#ifdef ISO
+    use infotrac_phy, ONLY: ntiso,niso
+    USE isotopes_mod, ONLY: iso_eau, iso_HDO, iso_O18, iso_O17, &
+        ridicule_qsol
+    USE isotopes_routines_mod, ONLY: calcul_iso_surf_ter_vectall
+#ifdef ISOVERIF
+    USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_noNaN, &
+        iso_verif_aberrant_o17,iso_verif_egalite_choix,iso_verif_egalite
+#endif
+#endif
 !****************************************************************************************
 ! Bucket calculations for surface. 
@@ -52,4 +68,8 @@
     REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
     REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
+#ifdef ISO
+    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
+    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum    
+#endif
 
 ! In/Output variables
@@ -58,4 +78,7 @@
     REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
     REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
+#ifdef ISO
+    REAL, DIMENSION(niso,klon), INTENT(INOUT)       :: xtsnow,xtsol
+#endif
 
 ! Output variables
@@ -67,4 +90,11 @@
     REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
     REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l      
+#ifdef ISO
+    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
+    REAL, DIMENSION(klon),       INTENT(OUT) :: h1
+    REAL, DIMENSION(niso,klon),  INTENT(OUT) :: xtrunoff_diag
+    REAL, DIMENSION(klon),       INTENT(OUT) :: runoff_diag
+    REAL, DIMENSION(niso,klon),  INTENT(IN)  :: Rland_ice
+#endif
 
 ! Local variables
@@ -78,7 +108,43 @@
     REAL, DIMENSION(klon) :: dummy_riverflow,dummy_coastalflow 
     INTEGER               :: i
-!
-!****************************************************************************************
-
+#ifdef ISO
+    INTEGER               :: ixt
+    REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec
+    REAL, DIMENSION(klon) :: snow_prec,qsol_prec
+    REAL, PARAMETER       :: t_coup = 273.15
+    REAL, DIMENSION(klon) :: fq_fonte_diag
+    REAL, DIMENSION(klon) :: fqfonte_diag
+    REAL, DIMENSION(klon) :: snow_evap_diag 
+    REAL, DIMENSION(klon) :: fqcalving_diag 
+    REAL                  :: max_eau_sol_diag  
+    REAL, DIMENSION(klon) :: run_off_lic_diag 
+    REAL :: coeff_rel_diag
+#endif 
+!
+!****************************************************************************************
+
+#ifdef ISO
+#ifdef ISOVERIF
+        !write(*,*) 'surf_land_bucket 152'
+        DO i=1,knon
+          IF (iso_eau > 0) THEN
+            CALL iso_verif_egalite_choix(precip_snow(i), &
+     &                                   xtprecip_snow(iso_eau,i),'surf_land_bucket 131', &
+     &                                   errmax,errmaxrel)
+            CALL iso_verif_egalite_choix(qsol(i), &
+     &                                   xtsol(iso_eau,i),'surf_land_bucket 134', &
+     &                                   errmax,errmaxrel)
+          ENDIF
+        ENDDO
+#endif 
+#ifdef ISOVERIF
+        DO i=1,knon
+          DO ixt=1,niso
+            CALL iso_verif_noNaN(xtsol(ixt,i),'surf_land_mod_bucket 142')
+          ENDDO !do ixt=1,niso
+        ENDDO !do i=1,knon
+        !write(*,*) 'surf_land_bucket 152'
+#endif
+#endif
 
 !
@@ -131,4 +197,41 @@
          tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
     
+#ifdef ISO
+   ! verif
+#ifdef ISOVERIF
+    !write(*,*) 'surf_land_bucket 211'
+    DO i=1,knon
+      IF (iso_eau > 0) THEN
+        CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
+     &           snow(i),'surf_land_bucket 522', &
+     &           errmax,errmaxrel) 
+      ENDIF !IF (iso_eau > 0) then
+    ENDDO !DO i=1,knon 
+#endif
+   ! end verif
+#endif         
+#ifdef ISO
+    DO i=1,knon
+      snow_prec(i)=snow(i)
+      qsol_prec(i)=qsol(i)
+      DO ixt=1,niso
+        xtsnow_prec(ixt,i)=xtsnow(ixt,i)
+        xtsol_prec(ixt,i) =xtsol(ixt,i)
+      ENDDO !DO ixt=1,niso
+      ! initialisation:
+      fqfonte_diag(i)  =0.0
+      fq_fonte_diag(i) =0.0
+      snow_evap_diag(i)=0.0
+    ENDDO !DO i=1,knon 
+#ifdef ISOVERIF
+    ! write(*,*) 'surf_land_bucket 235'
+    DO i=1,knon  
+      IF (iso_eau > 0) THEN
+        CALL iso_verif_egalite(qsol_prec(i),xtsol_prec(iso_eau,i), &
+    &                              'surf_land_bucket 141')
+      ENDIF
+    ENDDO !DO i=1,knon
+#endif    
+#endif    
 !
 !* Calculate snow height, run_off, age of snow
@@ -136,5 +239,64 @@
     CALL fonte_neige( knon, is_ter, knindex, dtime, &
          tsurf, precip_rain, precip_snow, &
-         snow, qsol, tsurf_new, evap)
+         snow, qsol, tsurf_new, evap &
+#ifdef ISO    
+     & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
+     & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag   &
+#endif
+     &   )
+
+#ifdef ISO
+#ifdef ISOVERIF
+        DO i=1,knon
+          DO ixt=1,niso
+            CALL iso_verif_noNaN(xtsol_prec(ixt,i),'surf_land_burcket 237')
+          ENDDO
+        ENDDO
+#endif
+#ifdef ISOVERIF
+        !write(*,*) 'surf_land_bucket 235'
+        DO i=1,knon
+          IF (iso_eau > 0) THEN
+            CALL iso_verif_egalite_choix(qsol_prec(i), &
+     &                                   xtsol_prec(iso_eau,i),'surf_land_bucket 628', &
+     &                                   errmax,errmaxrel)
+            CALL iso_verif_egalite_choix(precip_snow(i), &
+     &                                   xtprecip_snow(iso_eau,i),'surf_land_bucket 227', &
+     &                                   errmax,errmaxrel)
+             ! attention, dans fonte_neige, on modifie snow sans modifier
+             ! xtsnow
+             ! c'est fait plus tard dans gestion_neige
+!            write(*,*) 'surf_land_bucket 287: i=',i
+!            write(*,*) 'snow(i)=',snow(i)
+            CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
+     &                                   snow_prec(i),'surf_land_bucket 245', &
+     &                                   errmax,errmaxrel) 
+          ENDIF  
+          IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN
+              IF (qsol_prec(i) > ridicule_qsol) THEN
+                CALL iso_verif_aberrant_o17(xtsol_prec(iso_O17,i)/qsol_prec(i) &
+     &                                     ,xtsol_prec(iso_O18,i)/qsol_prec(i) &
+     &                                     ,'surf_land_bucket 642')
+              ENDIF !IF ((qsol_prec(i) > ridicule_qsol) &
+          ENDIF !IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN
+        ENDDO  !DO i=1,knon 
+        !write(*,*) 'surf_land_mod 291'
+        !write(*,*) 'snow_evap_diag(1)=',snow_evap_diag(1)
+#endif          
+        CALL calcul_iso_surf_ter_vectall(klon,knon, &
+     &           evap,snow_evap_diag,snow, &
+     &           fq_fonte_diag,fqfonte_diag,dtime,precip_rain,xtprecip_rain, &
+     &           precip_snow,xtprecip_snow, snow_prec,xtsnow_prec, &
+     &           tsurf_new,xtspechum,pref,spechum,t_coup,u1_lay,v1_lay,p1lay, &
+     &           qsol,xtsol,qsol_prec,xtsol_prec, &
+     &           max_eau_sol_diag, &
+     &           xtevap,xtsnow,h1,runoff_diag,xtrunoff_diag,fqcalving_diag, &
+     &           knindex,is_ter,run_off_lic_diag,coeff_rel_diag,Rland_ice &
+     &   )
+!#ifdef ISOVERIF
+!        write(*,*) 'surf_land_bucket 303'
+!#endif
+#endif
+
 !
 !* Calculate the age of snow
Index: /LMDZ6/branches/cirrus/libf/phylmd/surf_land_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/surf_land_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/surf_land_mod.F90	(revision 5202)
@@ -20,5 +20,11 @@
        qsurf, tsurf_new, dflux_s, dflux_l, &
        flux_u1, flux_v1 , & 
-       veget,lai,height)
+       veget,lai,height &
+#ifdef ISO
+       ,xtprecip_rain, xtprecip_snow,xtspechum, &
+       xtsnow, xtsol,xtevap,h1, &
+       runoff_diag,xtrunoff_diag,Rland_ice &
+#endif               
+               )
 
     USE dimphy
@@ -59,4 +65,12 @@
     USE calcul_fluxs_mod
     USE indice_sol_mod
+#ifdef ISO
+    use infotrac_phy, ONLY: ntiso,niso
+    use isotopes_mod, ONLY: nudge_qsol, iso_eau
+#ifdef ISOVERIF
+    use isotopes_verif_mod
+#endif
+#endif
+
     USE print_control_mod, ONLY: lunout
 
@@ -92,5 +106,8 @@
                                                          ! corresponds to previous sollwdown
     REAL, DIMENSION(klon), INTENT(IN)       :: q2m, t2m
-
+#ifdef ISO
+    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtprecip_rain, xtprecip_snow
+    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtspechum
+#endif 
 ! In/Output variables
 !****************************************************************************************
@@ -98,4 +115,7 @@
     REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
     REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
+#ifdef ISO
+    REAL, DIMENSION(niso,klon), INTENT(INOUT)    :: xtsnow, xtsol
+#endif
 
 ! Output variables
@@ -116,4 +136,11 @@
     REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget,lai
     REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height
+#ifdef ISO
+    REAL, DIMENSION(ntiso,klon), INTENT(OUT)      :: xtevap
+    REAL, DIMENSION(klon), INTENT(OUT)      :: h1
+    REAL, DIMENSION(niso,klon), INTENT(OUT)      :: xtrunoff_diag
+    REAL, DIMENSION(klon), INTENT(OUT)      :: runoff_diag
+    REAL, DIMENSION(niso,klon), INTENT(IN)        :: Rland_ice
+#endif
 
 ! Local variables
@@ -132,5 +159,11 @@
 !albedo SB <<<
 
-
+#ifdef ISO       
+      real, parameter :: t_coup = 273.15
+      real, dimension(klon) :: fqfonte_diag
+      real, dimension(klon) :: snow_evap_diag 
+      real, dimension(klon) :: fqcalving_diag 
+      integer :: ixt
+#endif 
 !****************************************************************************************
 !Total solid precip
@@ -142,4 +175,27 @@
 ENDIF
 !****************************************************************************************
+#ifdef ISO
+#ifdef ISOVERIF
+!        write(*,*) 'surf_land_mod 162'
+        do i=1,knon
+          if (iso_eau.gt.0) then
+            call iso_verif_egalite_choix(precip_snow(i), &
+     &          xtprecip_snow(iso_eau,i),'surf_land_mod 129', &
+     &          errmax,errmaxrel)
+            call iso_verif_egalite_choix(qsol(i), &
+     &          xtsol(iso_eau,i),'surf_land_mod 139', &
+     &          errmax,errmaxrel)
+          endif  
+        enddo
+#endif 
+#ifdef ISOVERIF
+!       write(*,*) 'surf_land 169: ok_veget=',ok_veget
+        do i=1,knon
+         do ixt=1,ntiso
+           call iso_verif_noNaN(xtprecip_snow(ixt,i),'surf_land 146')
+         enddo
+        enddo
+#endif
+#endif
 
 
@@ -172,4 +228,7 @@
        END DO
 
+#ifdef ISO
+      CALL abort_gcm('surf_land_mod 220','isos pas prevus dans orchidee',1)
+#endif
        ! temporary for keeping same results using lwdown_m instead of lwdown
        CALL surf_land_orchidee(itime, dtime, date0, knon, &
@@ -183,5 +242,21 @@
             tsol_rad, tsurf_new, alb1_new, alb2_new, &
             emis_new, z0m, z0h, qsurf, &
-            veget, lai, height)       
+            veget, lai, height &
+!#ifdef ISO
+!            , xtprecip_rain, xtprecip_snow, xtspechum, xtevap &
+!#endif
+            )                  
+
+#ifdef ISO
+#ifdef ISOVERIF
+     write(*,*) 'surf_land 193: apres surf_land_orchidee'   
+     do i=1,knon
+        if (iso_eau.gt.0) then
+             call iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
+    &            'surf_land 197',errmax,errmaxrel)
+        endif !if (iso_eau.gt.0) then      
+      enddo !do i=1,knon  
+#endif
+#endif
 !  
 !* Add contribution of relief to surface roughness
@@ -196,4 +271,18 @@
 !
 !****************************************************************************************
+#ifdef ISO
+#ifdef ISOVERIF
+!       write(*,*) 'surf_land 247'
+        call iso_verif_egalite_vect1D( &
+     &           xtsnow,snow,'surf_land_mod 207',niso,klon)
+#endif
+#endif
+
+#ifdef ISO
+        if (nudge_qsol.eq.1) then
+          call surf_land_nudge_qsol(knon,rlat,rlon,qsol,xtsol,knindex)
+        endif
+        !write(*,*) 'surf_land 258'
+#endif
        CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
             tsurf, p1lay, cdragh, precip_rain, precip_totsnow, temp_air, &
@@ -202,5 +291,11 @@
             snow, qsol, agesno, tsoil, &
             qsurf, z0m, alb1_new, alb2_new, evap, &
-            fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
+            fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l &
+#ifdef ISO
+            ,xtprecip_rain, xtprecip_snow,xtspechum, &
+            xtsnow, xtsol,xtevap,h1, &
+     &      runoff_diag, xtrunoff_diag,Rland_ice &
+#endif           
+     &       )
         z0h(1:knon)=z0m(1:knon) ! En attendant mieux
 
@@ -224,4 +319,16 @@
          p1lay, temp_air, &
          flux_u1, flux_v1)
+
+#ifdef ISO
+#ifdef ISOVERIF
+!     write(*,*) 'surf_land 237: sortie'   
+      DO i=1,knon
+        IF (iso_eau >= 0) THEN
+             call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
+    &            'surf_land 241',errmax,errmaxrel)
+        ENDIF !if (iso_eau.gt.0) then      
+      ENDDO !do i=1,knon  
+#endif
+#endif
 
 !albedo SB >>>
@@ -248,4 +355,79 @@
     
   END SUBROUTINE surf_land
+
+
+#ifdef ISO
+  SUBROUTINE surf_land_nudge_qsol(knon,rlat,rlon,qsol,xtsol,knindex)
+
+    USE dimphy   
+    USE infotrac_phy, ONLY: niso
+    USE isotopes_mod, ONLY: region_nudge_qsol    
+    INTEGER, INTENT(IN)                       :: knon         
+    REAL, DIMENSION(klon), INTENT(IN)         :: rlon, rlat
+    REAL, DIMENSION(klon), INTENT(INOUT)      :: qsol
+    INTEGER, DIMENSION(klon), INTENT(IN)      :: knindex    
+    REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsol 
+    REAL :: lat_min_nudge_qsol,lat_max_nudge_qsol
+    REAL :: lon_min_nudge_qsol,lon_max_nudge_qsol
+    INTEGER :: i,ixt
+    REAL :: qsol_new
+
+    IF (region_nudge_qsol == 1) THEN
+        ! Aamzonie du Sud
+        lat_min_nudge_qsol=-15.0
+        lat_max_nudge_qsol=-5.0
+        lon_min_nudge_qsol=-70.0
+        lon_max_nudge_qsol=-50.0
+    ELSE IF (region_nudge_qsol == 2) THEN
+        ! Aamzonie du Nord
+        lat_min_nudge_qsol=-5.0
+        lat_max_nudge_qsol=5.0
+        lon_min_nudge_qsol=-70.0
+        lon_max_nudge_qsol=-50.0
+    ELSE
+        WRITE(*,*) 'surf_land 298: cas pas prevu'
+        WRITE(*,*) 'region_nudge_qsol=',region_nudge_qsol
+        stop
+    ENDIF
+
+!    write(*,*) 'surf_land 314: knon=',knon
+!    write(*,*) 'rlat=',rlat
+!    write(*,*) 'rlon=',rlon
+!    write(*,*) 'region_nudge_qsol=',region_nudge_qsol
+
+    DO i=1,knon
+      IF ((rlat(knindex(i)) >= lat_min_nudge_qsol).and. &
+  &       (rlat(knindex(i)) <= lat_max_nudge_qsol).and. &
+  &       (rlon(knindex(i)) >= lon_min_nudge_qsol).and. &
+  &       (rlon(knindex(i)) <= lon_max_nudge_qsol)) THEN
+!        write(*,*) 'surf_land 324: bon domaine: rlat,rlon,qsol=', &
+!  &             rlat(knindex(i)),rlon(knindex(i)),qsol(knindex(i))
+        qsol_new=qsol(i)
+        IF (region_nudge_qsol == 1) THEN   
+           qsol_new=max(qsol(i),50.0)   
+        ELSE IF (region_nudge_qsol == 2) THEN      
+           qsol_new=max(qsol(i),120.0)
+        ELSE !if (region_nudge_qsol.eq.1) then
+           WRITE(*,*) 'surf_land 317: cas pas prevu'
+           WRITE(*,*) 'region_nudge_qsol=',region_nudge_qsol
+           STOP
+        ENDIF !if (region_nudge_qsol.eq.1) then
+        IF (qsol(i) > 0.0) THEN
+           DO ixt=1,niso
+              xtsol(ixt,i)=xtsol(ixt,i)*qsol_new/qsol(i)
+           ENDDO
+        ELSE !IF (qsol(i) > 0.0) THEN
+           DO ixt=1,niso
+             xtsol(ixt,i)=0.0
+           ENDDO
+        ENDIF !IF (qsol(i) > 0.0) THEN
+        qsol(i)=qsol_new
+        WRITE(*,*) 'surf_land 346: qsol_new=',qsol(i)      
+     ENDIF ! if ((rlat(i).ge.lat_min_nudge_qsol).and.
+  ENDDO !DO i=1,knon
+
+  END SUBROUTINE surf_land_nudge_qsol
+#endif
+
 !
 !****************************************************************************************
Index: /LMDZ6/branches/cirrus/libf/phylmd/surf_landice_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/surf_landice_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/surf_landice_mod.F90	(revision 5202)
@@ -23,5 +23,10 @@
        snowhgt, qsnow, to_ice, sissnow, &
        alb3, runoff, &
-       flux_u1, flux_v1)
+       flux_u1, flux_v1 &
+#ifdef ISO
+         &      ,xtprecip_rain, xtprecip_snow,xtspechum,Rland_ice &
+         &      ,xtsnow,xtsol,xtevap &
+#endif               
+           &    )
 
     USE dimphy
@@ -33,4 +38,14 @@
     USE phys_local_var_mod, ONLY : zxrhoslic, zxustartlic, zxqsaltlic
     USE phys_output_var_mod, ONLY : snow_o,zfra_o
+#ifdef ISO   
+    USE fonte_neige_mod,  ONLY : xtrun_off_lic
+    USE infotrac_phy,     ONLY : ntiso,niso
+    USE isotopes_routines_mod, ONLY: calcul_iso_surf_lic_vectall
+#ifdef ISOVERIF
+    USE isotopes_mod, ONLY: iso_eau,ridicule
+    USE isotopes_verif_mod
+#endif
+#endif
+ 
 !FC
     USE ioipsl_getin_p_mod, ONLY : getin_p
@@ -68,4 +83,9 @@
     REAL, DIMENSION(klon), INTENT(IN)             :: rugoro
     REAL, DIMENSION(klon,nbsrf), INTENT(IN)       :: pctsrf
+#ifdef ISO
+    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtprecip_rain, xtprecip_snow 
+    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtspechum 
+#endif
+
 
     LOGICAL,  INTENT(IN)                          :: debut   !true if first step
@@ -85,4 +105,9 @@
     REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
     REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
+#ifdef ISO
+    REAL, DIMENSION(niso,klon), INTENT(INOUT)     :: xtsnow, xtsol 
+    REAL, DIMENSION(niso,klon), INTENT(INOUT)     :: Rland_ice
+#endif
+
 
 ! Output variables
@@ -108,4 +133,9 @@
     REAL, DIMENSION(klon), INTENT(OUT)           :: sissnow
     REAL, DIMENSION(klon), INTENT(OUT)           :: runoff  !Land ice runoff
+#ifdef ISO
+    REAL, DIMENSION(ntiso,klon), INTENT(OUT)     :: xtevap     
+!    real, DIMENSION(niso,klon) :: xtrun_off_lic_0_diag ! est une variable globale de
+!    fonte_neige
+#endif
  
 
@@ -120,4 +150,21 @@
     REAL, DIMENSION(klon)    :: fqfonte,ffonte
     REAL, DIMENSION(klon)    :: run_off_lic_frac
+#ifdef ISO       
+    REAL, PARAMETER          :: t_coup = 273.15
+    REAL, DIMENSION(klon)    :: fqfonte_diag
+    REAL, DIMENSION(klon)    :: fq_fonte_diag
+    REAL, DIMENSION(klon)    ::  snow_evap_diag 
+    REAL, DIMENSION(klon)    ::  fqcalving_diag 
+    REAL max_eau_sol_diag  
+    REAL, DIMENSION(klon)    ::  runoff_diag 
+    REAL, DIMENSION(klon)    ::    run_off_lic_diag 
+    REAL                     ::  coeff_rel_diag
+    INTEGER                  :: ixt
+    REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec
+    REAL, DIMENSION(klon) :: snow_prec,qsol_prec
+!    real, DIMENSION(klon) :: run_off_lic_0_diag
+#endif
+
+
     REAL, DIMENSION(klon)    :: emis_new                  !Emissivity
     REAL, DIMENSION(klon)    :: swdown,lwdown
@@ -146,4 +193,6 @@
     REAL, DIMENSION(klon)  :: fluxbs_1, fluxbs_2, bsweight_fresh
     LOGICAL, DIMENSION(klon) :: ok_remaining_freshsnow
+    REAL  :: ta1, ta2, ta3, z01, z02, z03, coefa, coefb, coefc, coefd
+
 
 ! End definition
@@ -161,4 +210,16 @@
 !FC firtscall initializations
 !******************************************************************************************
+#ifdef ISO
+#ifdef ISOVERIF
+!     write(*,*) 'surf_land_ice 1499'   
+  DO i=1,knon
+    IF (iso_eau > 0) THEN
+      CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
+    &                              'surf_land_ice 126',errmax,errmaxrel)
+    ENDIF !IF (iso_eau > 0) THEN      
+  ENDDO !DO i=1,knon  
+#endif
+#endif
+
   IF (firstcall) THEN
   alb_vis_sno_lic=0.77
@@ -200,4 +261,8 @@
 !****************************************************************************************
 #ifdef CPP_INLANDSIS
+
+#ifdef ISO
+        CALL abort_gcm('surf_landice 235','isotopes pas dans INLANDSIS',1)
+#endif
 
         debut_is=debut
@@ -321,4 +386,29 @@
          tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
 
+#ifdef ISO
+#ifdef ISOVERIF
+     !write(*,*) 'surf_land_ice 1499'   
+     DO i=1,knon
+       IF (iso_eau > 0) THEN
+         IF (snow(i) > ridicule) THEN
+           CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
+    &                                   'surf_land_ice 1151',errmax,errmaxrel)
+         ENDIF !IF ((snow(i) > ridicule)) THEN
+       ENDIF !IF (iso_eau > 0) THEN
+     ENDDO !DO i=1,knon  
+#endif
+
+    DO i=1,knon
+      snow_prec(i)=snow(i)
+      DO ixt=1,niso
+        xtsnow_prec(ixt,i)=xtsnow(ixt,i)
+      ENDDO !DO ixt=1,niso
+      ! initialisation:
+      fq_fonte_diag(i)=0.0
+      fqfonte_diag(i)=0.0
+      snow_evap_diag(i)=0.0 
+    ENDDO !DO i=1,knon 
+#endif         
+
     CALL calcul_flux_wind(knon, dtime, &
          u0, v0, u1, v1, gustiness, cdragm, &
@@ -350,8 +440,36 @@
 !
 !****************************************************************************************
-    z0m = z0m_landice
-    z0h = z0h_landice
-    !z0m = SQRT(z0m**2+rugoro**2)
-
+
+if (z0m_landice .GT. 0.) then
+    z0m(1:knon) = z0m_landice
+    z0h(1:knon) = z0h_landice
+else
+    ! parameterization of z0=f(T) following measurements in Adelie Land by Amory et al 2018
+    coefa = 0.1658 !0.1862 !Ant
+    coefb = -50.3869 !-55.7718 !Ant
+    ta1 = 253.15 !255. Ant
+    ta2 = 273.15
+    ta3 = 273.15+3
+    z01 = exp(coefa*ta1 + coefb) !~0.2 ! ~0.25 mm
+    z02 = exp(coefa*ta2 + coefb) !~6  !~7 mm
+    z03 = z01
+    coefc = log(z03/z02)/(ta3-ta2)
+    coefd = log(z03)-coefc*ta3
+    do j=1,knon 
+      if (temp_air(j) .lt. ta1) then
+        z0m(j) = z01
+      else if (temp_air(j).ge.ta1 .and. temp_air(j).lt.ta2) then
+        z0m(j) = exp(coefa*temp_air(j) + coefb)
+      else if (temp_air(j).ge.ta2 .and. temp_air(j).lt.ta3) then
+        ! if st > 0, melting induce smooth surface
+        z0m(j) = exp(coefc*temp_air(j) + coefd)
+      else
+        z0m(j) = z03
+      endif
+      z0h(j)=z0m(j)
+    enddo
+
+endif    
+ 
 
 !****************************************************************************************
@@ -366,5 +484,5 @@
    if (ok_bs) then
        fluxbs(:)=0.
-       do j=1,klon
+       do j=1,knon
           ws1(j)=(u1(j)**2+v1(j)**2)**0.5
           ustar(j)=(cdragm(j)*(u1(j)**2+v1(j)**2))**0.5
@@ -493,8 +611,36 @@
  
     CALL fonte_neige(knon, is_lic, knindex, dtime, &
-         tsurf, precip_rain, precip_totsnow,  &
-         snow, qsol, tsurf_new, evap_totsnow)
+         tsurf, precip_rain, precip_totsnow, &
+         snow, qsol, tsurf_new, evap_totsnow &
+#ifdef ISO    
+     &  ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag     &
+     &  ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag &
+#endif
+     &   )
+
+
+#ifdef ISO
+#ifdef ISOVERIF
+    DO i=1,knon  
+      IF (iso_eau > 0) THEN  
+        CALL iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
+     &                               'surf_landice_mod 217',errmax,errmaxrel)
+      ENDIF !IF (iso_eau > 0) THEN
+    ENDDO !DO i=1,knon
+#endif
+
+    CALL calcul_iso_surf_lic_vectall(klon,knon, &
+     &    evap,snow_evap_diag,Tsurf_new,snow, &
+     &    fq_fonte_diag,fqfonte_diag,dtime,t_coup, &
+     &    precip_snow,xtprecip_snow,precip_rain,xtprecip_rain, snow_prec,xtsnow_prec, &
+     &    xtspechum,spechum,ps,Rland_ice, &
+     &    xtevap,xtsnow,fqcalving_diag, &
+     &    knindex,is_lic,run_off_lic_diag,coeff_rel_diag &
+     &   ) 
+
+!        call fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
+
+#endif
    
-    
     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)))  
Index: /LMDZ6/branches/cirrus/libf/phylmd/surf_ocean_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/surf_ocean_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/surf_ocean_mod.F90	(revision 5202)
@@ -21,5 +21,10 @@
        tsurf_new, dflux_s, dflux_l, lmt_bils, &
        flux_u1, flux_v1, delta_sst, delta_sal, ds_ns, dt_ns, dter, dser, &
-       dt_ds, tkt, tks, taur, sss)
+       dt_ds, tkt, tks, taur, sss &
+#ifdef ISO
+        &       ,xtprecip_rain, xtprecip_snow,xtspechum,Roce, &
+        &       xtsnow,xtevap,h1 &
+#endif               
+        &       )
 
     use albedo, only: alboc, alboc_cd
@@ -31,6 +36,13 @@
     USE ocean_cpl_mod, ONLY    : ocean_cpl_noice
     USE indice_sol_mod, ONLY : nbsrf, is_oce
+#ifdef ISO
+    USE infotrac_phy, ONLY : ntraciso=>ntiso,niso
+#ifdef ISOVERIF
+    USE isotopes_mod, ONLY: iso_eau,ridicule
+    USE isotopes_verif_mod
+#endif
+#endif
     USE limit_read_mod
-    use config_ocean_skin_m, only: activate_ocean_skin
+    USE config_ocean_skin_m, ONLY: activate_ocean_skin
     !
     ! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force, 
@@ -68,4 +80,8 @@
     REAL, DIMENSION(klon), INTENT(IN)        :: rugoro
     REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
+#ifdef ISO
+    REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow 
+    REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtspechum
+#endif
 
     ! In/Output variables
@@ -75,4 +91,8 @@
     REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
     REAL, DIMENSION(klon), INTENT(inOUT)     :: z0h
+#ifdef ISO
+    REAL, DIMENSION(niso,klon), INTENT(IN)   :: xtsnow 
+    REAL, DIMENSION(niso,klon), INTENT(INOUT):: Roce  
+#endif
 
     REAL, intent(inout):: delta_sst(:) ! (knon)
@@ -136,4 +156,9 @@
     ! size klon because of the coupling machinery.)
 
+#ifdef ISO
+    REAL, DIMENSION(ntraciso,klon), INTENT(out) :: xtevap ! isotopes in surface evaporation flux 
+    REAL, DIMENSION(klon), INTENT(out)          :: h1 ! just a diagnostic, not useful for the simulation   
+#endif
+
     ! Local variables
     !*************************************************************************
@@ -146,12 +171,26 @@
     REAL, DIMENSION(klon) :: precip_totsnow
     CHARACTER(len=20),PARAMETER :: modname="surf_ocean"
-    real rhoa(knon) ! density of moist air  (kg / m3)
+    REAL rhoa(knon) ! density of moist air  (kg / m3)
     REAL sens_prec_liq(knon)
 
     REAL t_int(knon) ! ocean-air interface temperature, in K
-    real s_int(knon) ! ocean-air interface salinity, in ppt
+    REAL s_int(knon) ! ocean-air interface salinity, in ppt
 
     !**************************************************************************
 
+#ifdef ISO
+#ifdef ISOVERIF
+    DO i = 1, knon
+      IF (iso_eau > 0) THEN         
+        CALL iso_verif_egalite_choix(xtspechum(iso_eau,i), &
+     &          spechum(i),'surf_ocean_mod 117', &
+     &          errmax,errmaxrel)          
+        CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
+     &          snow(i),'surf_ocean_mod 127', &
+     &          errmax,errmaxrel) 
+      ENDIF !IF (iso_eau > 0) then
+    ENDDO !DO i=1,klon
+#endif      
+#endif
 
     !******************************************************************************
@@ -230,5 +269,10 @@
             radsol, snow, agesno, &
             qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa)
+            tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa &
+#ifdef ISO
+            ,xtprecip_rain, xtprecip_snow, xtspechum,Roce,rlat, &
+            xtsnow,xtevap,h1 &  
+#endif            
+            )
     END SELECT
 
Index: /LMDZ6/branches/cirrus/libf/phylmd/surf_seaice_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmd/surf_seaice_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmd/surf_seaice_mod.F90	(revision 5202)
@@ -21,5 +21,10 @@
        z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &  
        tsurf_new, dflux_s, dflux_l, &
-       flux_u1, flux_v1)
+       flux_u1, flux_v1 &
+#ifdef ISO
+         &      ,xtprecip_rain, xtprecip_snow,xtspechum,Roce, &
+         &      xtsnow,xtsol,xtevap,Rland_ice &
+#endif               
+         &      )
 
   USE dimphy
@@ -29,4 +34,7 @@
   USE ocean_slab_mod, ONLY   : ocean_slab_ice
   USE indice_sol_mod
+#ifdef ISO
+  USE infotrac_phy, ONLY : ntiso,niso
+#endif
 
 !
@@ -62,4 +70,10 @@
     REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
     REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
+#ifdef ISO
+    REAL, DIMENSION(ntiso,klon), INTENT(IN)  :: xtprecip_rain, xtprecip_snow 
+    REAL, DIMENSION(klon),       INTENT(IN)  :: xtspechum
+    REAL, DIMENSION(niso,klon),  INTENT(IN)  :: Roce
+    REAL, DIMENSION(niso,klon),  INTENT(IN)  :: Rland_ice
+#endif
 
 ! In/Output arguments
@@ -68,4 +82,8 @@
     REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
     REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
+#ifdef ISO
+    REAL, DIMENSION(niso,klon), INTENT(INOUT)     :: xtsnow  
+    REAL, DIMENSION(niso,klon), INTENT(IN)        :: xtsol 
+#endif
 
 ! Output arguments
@@ -82,8 +100,16 @@
     REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l      
     REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
+#ifdef ISO
+    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
+#endif
 
 ! Local arguments
 !****************************************************************************************
     REAL, DIMENSION(klon)  :: radsol
+#ifdef ISO
+#ifdef ISOVERIF
+    INTEGER :: j
+#endif
+#endif
 
 !albedo SB >>>
@@ -145,5 +171,10 @@
             radsol, snow, qsol, agesno, tsoil, &
             qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l, rhoa)
+            tsurf_new, dflux_s, dflux_l, rhoa &
+#ifdef ISO
+            ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
+            xtsnow, xtsol,xtevap,Rland_ice &  
+#endif            
+            )
 
     END IF
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/add_phys_tend_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/add_phys_tend_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/add_phys_tend_mod.F90	(revision 5202)
@@ -957,5 +957,5 @@
       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
+  CASE("bsss") param
       bilq_bnd = - bs_fall(1)
       bilh_bnd = (-(rcs-rcpd)*t_seri(1,1) + rlstt) * bs_fall(1)
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/add_wake_tend.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/add_wake_tend.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/add_wake_tend.F90	(revision 5202)
@@ -1,3 +1,3 @@
-SUBROUTINE add_wake_tend(zddeltat, zddeltaq, zds, zddensaw, zddensw, zoccur, text, abortphy &
+SUBROUTINE add_wake_tend(zddeltat, zddeltaq, zds, zdas, zddensw, zddensaw, zoccur, text, abortphy &
 #ifdef ISO
         , zddeltaxt &
@@ -13,6 +13,6 @@
 
 USE dimphy, ONLY: klon, klev
-USE phys_state_var_mod, ONLY: wake_deltat, wake_deltaq, wake_s,  &
-                              awake_dens, wake_dens
+USE phys_state_var_mod, ONLY: wake_deltat, wake_deltaq, wake_s, awake_s,  &
+                              wake_dens, awake_dens
 
 USE print_control_mod, ONLY: prt_level
@@ -26,5 +26,5 @@
 !------------
   REAL, DIMENSION(klon, klev),   INTENT (IN)         :: zddeltat, zddeltaq
-  REAL, DIMENSION(klon),         INTENT (IN)         :: zds, zddensaw, zddensw
+  REAL, DIMENSION(klon),         INTENT (IN)         :: zds, zdas, zddensw, zddensaw
   INTEGER, DIMENSION(klon),      INTENT (IN)         :: zoccur
   CHARACTER*(*),                 INTENT (IN)         :: text
@@ -79,10 +79,12 @@
            IF (zoccur(i) .GE. 1) THEN
              wake_s(i)     = wake_s(i)    + zds(i)
+             awake_s(i)    = awake_s(i)    + zdas(i)
+             wake_dens(i)  = wake_dens(i) + zddensw(i)
              awake_dens(i) = awake_dens(i) + zddensaw(i)
-             wake_dens(i)  = wake_dens(i) + zddensw(i)
            ELSE
              wake_s(i)     = 0.
+             awake_s(i)    = 0.
+             wake_dens(i)  = 0.
              awake_dens(i) = 0.
-             wake_dens(i)  = 0.
            ENDIF   ! (zoccur(i) .GE. 1)
          END DO
Index: DZ6/branches/cirrus/libf/phylmdiso/coare30_flux_cnrm.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/coare30_flux_cnrm.F90	(revision 5201)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/coare30_flux_cnrm.F90
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/coare30_flux_cnrm_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/coare30_flux_cnrm_mod.F90	(revision 5202)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/coare30_flux_cnrm_mod.F90	(revision 5202)
@@ -0,0 +1,1 @@
+link ../phylmd/coare30_flux_cnrm_mod.F90
Index: DZ6/branches/cirrus/libf/phylmdiso/coare_cp.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/coare_cp.F90	(revision 5201)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/coare_cp.F90
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/coare_cp_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/coare_cp_mod.F90	(revision 5202)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/coare_cp_mod.F90	(revision 5202)
@@ -0,0 +1,1 @@
+link ../phylmd/coare_cp_mod.F90
Index: DZ6/branches/cirrus/libf/phylmdiso/cosp2
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/cosp2	(revision 5201)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../phylmd/cosp/
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/fonte_neige_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/fonte_neige_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/fonte_neige_mod.F90	(revision 5202)
@@ -1,711 +1,1 @@
-!
-! $Header$
-!
-MODULE fonte_neige_mod
-!
-! This module will treat the process of snow, melting, accumulating, calving, in 
-! case of simplified soil model.
-!
-!****************************************************************************************
-  USE dimphy, ONLY : klon
-  USE indice_sol_mod
-
-  IMPLICIT NONE
-  SAVE
-
-! run_off_ter and run_off_lic are the runoff at the compressed grid knon for 
-! land and land-ice respectively
-! Note: run_off_lic is used in mod_landice and therfore not private
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE    :: run_off_ter
-  !$OMP THREADPRIVATE(run_off_ter)
-  REAL, ALLOCATABLE, DIMENSION(:)             :: run_off_lic
-  !$OMP THREADPRIVATE(run_off_lic)
-
-! run_off_lic_0 is the runoff at land-ice a time-step earlier, on the global 1D array grid
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE    :: run_off_lic_0
-  !$OMP THREADPRIVATE(run_off_lic_0)
-  
-  REAL, PRIVATE                               :: tau_calv  
-  !$OMP THREADPRIVATE(tau_calv)
-  REAL, ALLOCATABLE, DIMENSION(:,:)           :: ffonte_global
-  !$OMP THREADPRIVATE(ffonte_global)
-  REAL, ALLOCATABLE, DIMENSION(:,:)           :: fqfonte_global
-  !$OMP THREADPRIVATE(fqfonte_global)
-  REAL, ALLOCATABLE, DIMENSION(:,:)           :: fqcalving_global
-  !$OMP THREADPRIVATE(fqcalving_global)
-  REAL, ALLOCATABLE, DIMENSION(:)             :: runofflic_global
-  !$OMP THREADPRIVATE(runofflic_global)
-#ifdef ISO
-  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE    :: xtrun_off_ter
-  !$OMP THREADPRIVATE(xtrun_off_ter)
-  REAL, ALLOCATABLE, DIMENSION(:,:)             :: xtrun_off_lic
-  !$OMP THREADPRIVATE(xtrun_off_lic)
-  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE    :: xtrun_off_lic_0 
-  !$OMP THREADPRIVATE(xtrun_off_lic_0)
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE  :: fxtfonte_global
-  !$OMP THREADPRIVATE(fxtfonte_global)
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE  :: fxtcalving_global
-  !$OMP THREADPRIVATE(fxtcalving_global)
-  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: xtrunofflic_global
-  !$OMP THREADPRIVATE(xtrunofflic_global)
-#endif
-
-CONTAINS
-!
-!****************************************************************************************
-!
-  SUBROUTINE fonte_neige_init(restart_runoff)
-
-! This subroutine allocates and initialize variables in the module. 
-! The variable run_off_lic_0 is initialized to the field read from
-! restart file. The other variables are initialized to zero.
-!
-!****************************************************************************************
-! Input argument
-    REAL, DIMENSION(klon), INTENT(IN) :: restart_runoff 
-
-! Local variables
-    INTEGER                           :: error
-    CHARACTER (len = 80)              :: abort_message 
-    CHARACTER (len = 20)              :: modname = 'fonte_neige_init'
-
-
-!****************************************************************************************
-! Allocate run-off at landice and initilize with field read from restart
-!
-!****************************************************************************************
-
-    ALLOCATE(run_off_lic_0(klon), stat = error)
-    IF (error /= 0) THEN
-       abort_message='Pb allocation run_off_lic'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-    run_off_lic_0(:) = restart_runoff(:) 
-
-!****************************************************************************************
-! Allocate other variables and initilize to zero
-!
-!****************************************************************************************
-    ALLOCATE(run_off_ter(klon), stat = error)
-    IF (error /= 0) THEN
-       abort_message='Pb allocation run_off_ter'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-    run_off_ter(:) = 0.
-    
-    ALLOCATE(run_off_lic(klon), stat = error)
-    IF (error /= 0) THEN
-       abort_message='Pb allocation run_off_lic'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-    run_off_lic(:) = 0.
-    
-    ALLOCATE(ffonte_global(klon,nbsrf))
-    IF (error /= 0) THEN
-       abort_message='Pb allocation ffonte_global'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-    ffonte_global(:,:) = 0.0
-
-    ALLOCATE(fqfonte_global(klon,nbsrf))
-    IF (error /= 0) THEN
-       abort_message='Pb allocation fqfonte_global'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-    fqfonte_global(:,:) = 0.0
-
-    ALLOCATE(fqcalving_global(klon,nbsrf))
-    IF (error /= 0) THEN
-       abort_message='Pb allocation fqcalving_global'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-    fqcalving_global(:,:) = 0.0
-
-    ALLOCATE(runofflic_global(klon))
-    IF (error /= 0) THEN
-       abort_message='Pb allocation runofflic_global'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-    runofflic_global(:) = 0.0
-
-!****************************************************************************************
-! Read tau_calv
-!
-!****************************************************************************************
-    CALL conf_interface(tau_calv)
-
-
-  END SUBROUTINE fonte_neige_init
-
-#ifdef ISO
-  SUBROUTINE fonte_neige_init_iso(xtrestart_runoff)
-
-! This subroutine allocates and initialize variables in the module. 
-! The variable run_off_lic_0 is initialized to the field read from
-! restart file. The other variables are initialized to zero.
-
-    use infotrac_phy, ONLY: niso
-#ifdef ISOVERIF
-    USE isotopes_mod, ONLY: iso_eau,iso_HDO
-    USE isotopes_verif_mod
-#endif
-!
-!****************************************************************************************
-! Input argument
-    REAL, DIMENSION(niso,klon), INTENT(IN) :: xtrestart_runoff 
-
-! Local variables
-    INTEGER                           :: error
-    CHARACTER (len = 80)              :: abort_message 
-    CHARACTER (len = 20)              :: modname = 'fonte_neige_init'
-    integer i
-
-
-!****************************************************************************************
-! Allocate run-off at landice and initilize with field read from restart
-!
-!****************************************************************************************
-
-    ALLOCATE(xtrun_off_lic_0(niso,klon), stat = error)
-    IF (error /= 0) THEN
-       abort_message='Pb allocation run_off_lic'
-       CALL abort_gcm(modname,abort_message,1)
-    ENDIF    
-    
-    xtrun_off_lic_0(:,:) = xtrestart_runoff(:,:)        
-
-#ifdef ISOVERIF 
-      if (iso_eau.gt.0) then   
-        call iso_verif_egalite_vect1D( &
-     &           xtrun_off_lic_0,run_off_lic_0,'fonte_neige 100', &
-     &           niso,klon)
-      endif !if (iso_eau.gt.0) then 
-#endif        
-
-!****************************************************************************************
-! Allocate other variables and initilize to zero
-!
-!****************************************************************************************
-
-    ALLOCATE(xtrun_off_ter(niso,klon), stat = error)
-    IF (error /= 0) THEN
-       abort_message='Pb allocation xtrun_off_ter'
-       CALL abort_gcm(modname,abort_message,1)
-    ENDIF
-    xtrun_off_ter(:,:) = 0.
-    
-    ALLOCATE(xtrun_off_lic(niso,klon), stat = error)
-    IF (error /= 0) THEN
-       abort_message='Pb allocation xtrun_off_lic'
-       CALL abort_gcm(modname,abort_message,1)
-    ENDIF
-    xtrun_off_lic(:,:) = 0.
-
-    ALLOCATE(fxtfonte_global(niso,klon,nbsrf))
-    IF (error /= 0) THEN
-       abort_message='Pb allocation fxtfonte_global'
-       CALL abort_gcm(modname,abort_message,1)
-    ENDIF
-    fxtfonte_global(:,:,:) = 0.0
-
-    ALLOCATE(fxtcalving_global(niso,klon,nbsrf))
-    IF (error /= 0) THEN
-       abort_message='Pb allocation fxtcalving_global'
-       CALL abort_gcm(modname,abort_message,1)
-    ENDIF
-    fxtcalving_global(:,:,:) = 0.0
-
-    ALLOCATE(xtrunofflic_global(niso,klon))
-    IF (error /= 0) THEN
-       abort_message='Pb allocation xtrunofflic_global'
-       CALL abort_gcm(modname,abort_message,1)
-    ENDIF
-    xtrunofflic_global(:,:) = 0.0
-
-  END SUBROUTINE fonte_neige_init_iso
-#endif
-!
-!
-!****************************************************************************************
-!
-  SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
-       tsurf, precip_rain, precip_snow, &
-       snow, qsol, tsurf_new, evap &
-#ifdef ISO    
-     & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
-     & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag   &
-#endif
-     &   )
-
-  USE indice_sol_mod
-#ifdef ISO
-    use infotrac_phy, ONLY: niso
-    !use isotopes_mod, ONLY: ridicule_snow,iso_eau,iso_HDO
-#ifdef ISOVERIF
-    use isotopes_verif_mod
-#endif
-#endif
-        
-! Routine de traitement de la fonte de la neige dans le cas du traitement
-! de sol simplifie!
-! LF 03/2001
-! input:
-!   knon         nombre de points a traiter
-!   nisurf       surface a traiter
-!   knindex      index des mailles valables pour surface a traiter
-!   dtime        
-!   tsurf        temperature de surface
-!   precip_rain  precipitations liquides
-!   precip_snow  precipitations solides
-!
-! input/output:
-!   snow         champs hauteur de neige
-!   qsol         hauteur d'eau contenu dans le sol
-!   tsurf_new    temperature au sol
-!   evap
-!
-  INCLUDE "YOETHF.h"
-  INCLUDE "YOMCST.h"
-  INCLUDE "FCTTRE.h"
-  INCLUDE "clesphys.h"
-
-! Input variables
-!****************************************************************************************
-    INTEGER, INTENT(IN)                  :: knon
-    INTEGER, INTENT(IN)                  :: nisurf
-    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
-    REAL   , INTENT(IN)                  :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf
-    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain
-    REAL, DIMENSION(klon), INTENT(IN)    :: precip_snow
-    
-! Input/Output variables
-!****************************************************************************************
-
-    REAL, DIMENSION(klon), INTENT(INOUT) :: snow
-    REAL, DIMENSION(klon), INTENT(INOUT) :: qsol
-    REAL, DIMENSION(klon), INTENT(INOUT) :: tsurf_new
-    REAL, DIMENSION(klon), INTENT(INOUT) :: evap
-
-
-#ifdef ISO    
-        ! sortie de quelques diagnostiques
-        real, dimension(klon),intent(out) :: fq_fonte_diag
-        real, dimension(klon),intent(out) :: fqfonte_diag
-        real, dimension(klon), intent(out) ::  snow_evap_diag 
-        real, dimension(klon), intent(out) ::  fqcalving_diag  
-        real, intent(out) :: max_eau_sol_diag  
-        real, dimension(klon), intent(out) ::  runoff_diag   
-        real, dimension(klon), intent(OUT):: run_off_lic_diag  
-        real, intent(OUT):: coeff_rel_diag
-#endif
-! Local variables
-!****************************************************************************************
-
-    INTEGER               :: i, j
-    REAL                  :: fq_fonte
-    REAL                  :: coeff_rel
-    REAL, PARAMETER       :: snow_max=3000.
-    REAL, PARAMETER       :: max_eau_sol = 150.0
-!! PB temporaire en attendant mieux pour le modele de neige
-! REAL, parameter :: chasno = RLMLT/(2.3867E+06*0.15)
-    REAL, PARAMETER       :: chasno = 3.334E+05/(2.3867E+06*0.15)
-!IM cf JLD/ GKtest
-    REAL, PARAMETER       :: chaice = 3.334E+05/(2.3867E+06*0.15)
-! fin GKtest
-    REAL, DIMENSION(klon) :: ffonte
-    REAL, DIMENSION(klon) :: fqcalving, fqfonte
-    REAL, DIMENSION(klon) :: d_ts
-    REAL, DIMENSION(klon) :: bil_eau_s, snow_evap
-
-    LOGICAL               :: neige_fond
-
-#ifdef ISO
-        max_eau_sol_diag=max_eau_sol
-#endif
-
-!****************************************************************************************
-! Start calculation
-! - Initialization
-!
-!****************************************************************************************
-    coeff_rel = dtime/(tau_calv * rday)
-    
-    bil_eau_s(:) = 0.
-
-!****************************************************************************************
-! - Increment snow due to precipitation and evaporation
-! - Calculate the water balance due to precipitation and evaporation (bil_eau_s)
-!
-!****************************************************************************************
-    WHERE (precip_snow > 0.) 
-       snow = snow + (precip_snow * dtime)
-    END WHERE
-
-    snow_evap = 0.
-  
-
-    IF (.NOT. ok_lic_cond) THEN
-!---only positive evaporation has an impact on snow 
-!---note that this could create a bit of water
-!---this was the default until CMIP6 
-      WHERE (evap > 0. )
-         snow_evap = MIN (snow / dtime, evap)    !---one cannot evaporate more than the amount of snow
-         snow = snow - snow_evap * dtime         !---snow that remains on the ground
-         snow = MAX(0.0, snow)                   !---just in case
-      END WHERE
-
-    ELSE
-!--now considers both positive and negative evaporation in the budget of snow 
-      snow_evap = MIN (snow / dtime, evap)    !---one cannot evaporate more than the amount of snow
-      snow = snow - snow_evap * dtime         !---snow that remains or deposits on the ground
-      snow = MAX(0.0, snow)                   !---just in case
-
-   ENDIF
-    
-
-    bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime
-#ifdef ISO
-        snow_evap_diag(:)=snow_evap(:)
-        coeff_rel_diag=coeff_rel
-#endif
-
-
-!****************************************************************************************
-! - Calculate melting snow
-! - Calculate calving and decrement snow, if there are to much snow
-! - Update temperature at surface
-!
-!****************************************************************************************
-
-    ffonte(:) = 0.0
-    fqcalving(:) = 0.0
-    fqfonte(:) = 0.0
-
-    DO i = 1, knon
-       ! Y'a-t-il fonte de neige?
-       neige_fond = (snow(i)>epsfra .OR. nisurf==is_sic .OR. nisurf==is_lic) .AND. tsurf_new(i)>=RTT
-       IF (neige_fond) THEN
-          fq_fonte     = MIN( MAX((tsurf_new(i)-RTT )/chasno,0.0),snow(i))
-          ffonte(i)    = fq_fonte * RLMLT/dtime
-          fqfonte(i)   = fq_fonte/dtime
-          snow(i)      = MAX(0., snow(i) - fq_fonte)
-          bil_eau_s(i) = bil_eau_s(i) + fq_fonte 
-          tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno  
-#ifdef ISO
-        fq_fonte_diag(i)=fq_fonte
-#endif
-
-!IM cf JLD OK     
-!IM cf JLD/ GKtest fonte aussi pour la glace
-          IF (nisurf == is_sic .OR. nisurf == is_lic ) THEN
-             fq_fonte = MAX((tsurf_new(i)-RTT )/chaice,0.0)
-             ffonte(i) = ffonte(i) + fq_fonte * RLMLT/dtime
-             IF ( ok_lic_melt ) THEN
-                fqfonte(i) = fqfonte(i) + fq_fonte/dtime
-                bil_eau_s(i) = bil_eau_s(i) + fq_fonte
-             ENDIF
-             tsurf_new(i) = RTT
-          ENDIF
-          d_ts(i) = tsurf_new(i) - tsurf(i)
-       ENDIF
-
-       ! s'il y a une hauteur trop importante de neige, elle est ecretee
-       fqcalving(i) = MAX(0., snow(i) - snow_max)/dtime
-       snow(i)=MIN(snow(i),snow_max)
-    ENDDO
-#ifdef ISO
-    DO i = 1, knon
-       fqcalving_diag(i)=fqcalving(i)
-       fqfonte_diag(i)=fqfonte(i)
-    enddo !DO i = 1, knon
-#endif
-
-    IF (nisurf == is_ter) THEN
-       DO i = 1, knon
-          qsol(i) = qsol(i) + bil_eau_s(i)
-          run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
-#ifdef ISO
-        runoff_diag(i)=MAX(qsol(i) - max_eau_sol, 0.0)
-#endif
-          qsol(i) = MIN(qsol(i), max_eau_sol) 
-       ENDDO
-    ELSE IF (nisurf == is_lic) THEN
-       DO i = 1, knon
-          j = knindex(i)
-          !--temporal filtering
-          run_off_lic(i)   = coeff_rel*fqcalving(i) + (1.-coeff_rel)*run_off_lic_0(j)
-          run_off_lic_0(j) = run_off_lic(i)
-          !--add melting snow and liquid precip to runoff of ice cap
-          run_off_lic(i)   = run_off_lic(i) + fqfonte(i) + precip_rain(i)
-       ENDDO
-    ENDIF
-
-#ifdef ISO
-    DO i = 1, klon    
-        run_off_lic_diag(i)=run_off_lic(i)
-    enddo ! DO i = 1, knon    
-#endif
-    
-!****************************************************************************************
-! Save ffonte, fqfonte and fqcalving in global arrays for each 
-! sub-surface separately
-!
-!****************************************************************************************
-    DO i = 1, knon
-       ffonte_global(knindex(i),nisurf)    = ffonte(i)
-       fqfonte_global(knindex(i),nisurf)   = fqfonte(i)
-       fqcalving_global(knindex(i),nisurf) = fqcalving(i)
-    ENDDO
-
-    IF (nisurf == is_lic) THEN
-    DO i = 1, knon
-       runofflic_global(knindex(i)) = run_off_lic(i)
-    ENDDO
-    ENDIF
-
-  END SUBROUTINE fonte_neige
-!
-!****************************************************************************************
-!
-  SUBROUTINE fonte_neige_final(restart_runoff &
-#ifdef ISO      
-     &     ,xtrestart_runoff &
-#endif   
-     &   )
-!
-! This subroutine returns run_off_lic_0 for later writing to restart file.
-!
-#ifdef ISO
-    use infotrac_phy, ONLY: niso
-#ifdef ISOVERIF
-    use isotopes_mod, ONLY: iso_eau
-    use isotopes_verif_mod
-#endif
-#endif
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
-#ifdef ISO     
-    REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrestart_runoff
-#ifdef ISOVERIF
-    integer i
-#endif  
-#endif
-
-!****************************************************************************************
-! Set the output variables
-    restart_runoff(:) = run_off_lic_0(:)
-#ifdef ISO
-    xtrestart_runoff(:,:) = xtrun_off_lic_0(:,:)
-#ifdef ISOVERIF 
-      if (iso_eau.gt.0) then   
-        do i=1,klon
-          if (iso_verif_egalite_nostop(run_off_lic_0(i), &
-     &         xtrun_off_lic_0(iso_eau,i),'fonte_neige 413') &
-     &         .eq.1) then
-              write(*,*) 'i=',i
-              stop
-          endif
-        enddo !do i=1,klon
-      endif !if (iso_eau.gt.0) then 
-#endif    
-#endif
-
-! Deallocation of all varaibles in the module
-!   DEALLOCATE(run_off_lic_0, run_off_ter, run_off_lic, ffonte_global, &
-!        fqfonte_global, fqcalving_global)
-
-    IF (ALLOCATED(run_off_lic_0)) DEALLOCATE(run_off_lic_0)
-    IF (ALLOCATED(run_off_ter)) DEALLOCATE(run_off_ter)
-    IF (ALLOCATED(run_off_lic)) DEALLOCATE(run_off_lic)
-    IF (ALLOCATED(ffonte_global)) DEALLOCATE(ffonte_global)
-    IF (ALLOCATED(fqfonte_global)) DEALLOCATE(fqfonte_global)
-    IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
-    IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
-#ifdef ISO
-    IF (ALLOCATED(xtrun_off_lic_0)) DEALLOCATE(xtrun_off_lic_0)
-    IF (ALLOCATED(xtrun_off_ter)) DEALLOCATE(xtrun_off_ter)
-    IF (ALLOCATED(xtrun_off_lic)) DEALLOCATE(xtrun_off_lic)
-    IF (ALLOCATED(fxtfonte_global)) DEALLOCATE(fxtfonte_global)
-    IF (ALLOCATED(fxtcalving_global)) DEALLOCATE(fxtcalving_global)
-    IF (ALLOCATED(xtrunofflic_global)) DEALLOCATE(xtrunofflic_global)
-#endif
-
-  END SUBROUTINE fonte_neige_final
-!
-!****************************************************************************************
-!
-  SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
-       fqfonte_out, ffonte_out, run_off_lic_out &
-#ifdef ISO     
-     &  ,fxtcalving_out, fxtfonte_out,xtrun_off_lic_out &
-#endif     
-     &  )
-
-
-! Cumulate ffonte, fqfonte and fqcalving respectively for
-! all type of surfaces according to their fraction.
-!
-! This routine is called from physiq.F before histwrite.
-!****************************************************************************************
-
-  USE indice_sol_mod
-#ifdef ISO
-    use infotrac_phy, ONLY: niso
-#endif
-
-    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
-
-    REAL, DIMENSION(klon), INTENT(OUT)      :: fqcalving_out
-    REAL, DIMENSION(klon), INTENT(OUT)      :: fqfonte_out
-    REAL, DIMENSION(klon), INTENT(OUT)      :: ffonte_out
-    REAL, DIMENSION(klon), INTENT(OUT)      :: run_off_lic_out
-
-
-#ifdef ISO
-    REAL, DIMENSION(niso,klon), INTENT(OUT)      :: fxtcalving_out
-    REAL, DIMENSION(niso,klon), INTENT(OUT)      :: fxtfonte_out
-    REAL, DIMENSION(niso,klon), INTENT(OUT)      :: xtrun_off_lic_out
-    integer i,ixt
-#endif
-    INTEGER   :: nisurf
-!****************************************************************************************
-
-    ffonte_out(:)    = 0.0
-    fqfonte_out(:)   = 0.0
-    fqcalving_out(:) = 0.0
-#ifdef ISO        
-    fxtfonte_out(:,:)   = 0.0
-    fxtcalving_out(:,:) = 0.0
-#endif
-
-    DO nisurf = 1, nbsrf
-       ffonte_out(:) = ffonte_out(:) + ffonte_global(:,nisurf)*pctsrf(:,nisurf)
-       fqfonte_out(:) = fqfonte_out(:) + fqfonte_global(:,nisurf)*pctsrf(:,nisurf)
-       fqcalving_out(:) = fqcalving_out(:) + fqcalving_global(:,nisurf)*pctsrf(:,nisurf)
-    ENDDO
-
-    run_off_lic_out(:)=runofflic_global(:)
-
-
-#ifdef ISO
-       DO nisurf = 1, nbsrf
-        do i=1,klon
-         do ixt=1,niso
-          fxtfonte_out(ixt,i) = fxtfonte_out(ixt,i) + fxtfonte_global(ixt,i,nisurf)*pctsrf(i,nisurf)
-          fxtcalving_out(ixt,i) = fxtcalving_out(ixt,i) + fxtcalving_global(ixt,i,nisurf)*pctsrf(i,nisurf)
-         enddo !do ixt=1,niso
-        enddo !do i=1,klon
-       enddo !DO nisurf = 1, nbsrf
-       xtrun_off_lic_out(:,:)=xtrunofflic_global(:,:)
-#endif
-
-  END SUBROUTINE fonte_neige_get_vars
-!
-!****************************************************************************************
-!
-!#ifdef ISO
-!  subroutine fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
-!    use infotrac_phy, ONLY: niso
-!
-!    ! inputs
-!    INTEGER, INTENT(IN)                      :: knon
-!    real, INTENT(IN), DIMENSION(niso,klon)   :: xtrun_off_lic_0_diag
-!
-!    xtrun_off_lic_0(:,:)=xtrun_off_lic_0_diag(:,:)
-!
-!  end subroutine fonte_neige_export_xtrun_off_lic_0
-!#endif 
-
-#ifdef ISO
-        subroutine gestion_neige_besoin_varglob_fonte_neige(klon,knon, &
-     &           xtprecip_snow,xtprecip_rain, &
-     &           fxtfonte_neige,fxtcalving, &
-     &           knindex,nisurf,run_off_lic_diag,coeff_rel_diag)
-
-        ! dans cette routine, on a besoin des variables globales de
-        ! fonte_neige_mod. Il faut donc la mettre dans fonte_neige_mod
-        ! le reste de gestion_neige est dans isotopes_routines_mod car sinon pb
-        ! de dépendance circulaire.
-
-    USE infotrac_phy, ONLY: ntiso,niso
-    USE isotopes_mod, ONLY: iso_eau    
-  USE indice_sol_mod    
-#ifdef ISOVERIF
-    USE isotopes_verif_mod
-#endif
-        implicit none
-
-         ! inputs
-        integer klon,knon
-        real xtprecip_snow(ntiso,klon),xtprecip_rain(ntiso,klon)
-    INTEGER, INTENT(IN)                  :: nisurf
-    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
-    real, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag  
-     real, INTENT(IN) ::   coeff_rel_diag  
-        real, DIMENSION(niso,klon), INTENT(IN) :: fxtfonte_neige,fxtcalving
-
-        ! locals
-        integer i,ixt,j
-        
-#ifdef ISOVERIF
-        IF (nisurf == is_lic) THEN
-          if (iso_eau.gt.0) then  
-           DO i = 1, knon
-             j = knindex(i)
-               call iso_verif_egalite(xtrun_off_lic_0(iso_eau,j), &
-     &                  run_off_lic_0(j),'gestion_neige_besoin_varglob_fonte_neige 625')
-           enddo
-          endif
-        endif
-#endif
-
-! calcul de run_off_lic 
-
-      IF (nisurf == is_lic) THEN
-!         coeff_rel = dtime/(tau_calv * rday)
-
-         DO i = 1, knon
-          j = knindex(i)
-          do ixt=1,niso
-          xtrun_off_lic(ixt,i)   = (coeff_rel_diag *  fxtcalving(ixt,i)) + &
-               (1. - coeff_rel_diag) * xtrun_off_lic_0(ixt,j)
-          xtrun_off_lic_0(ixt,j) = xtrun_off_lic(ixt,i)
-          xtrun_off_lic(ixt,i)   = xtrun_off_lic(ixt,i) + fxtfonte_neige(ixt,i) + xtprecip_rain(ixt,i)
-          enddo !do ixt=1,niso
-#ifdef ISOVERIF
-          if (iso_eau.gt.0) then             
-                 if (iso_verif_egalite_choix_nostop(xtrun_off_lic(iso_eau,i), &
-     &                  run_off_lic_diag(i),'gestion_neige_besoin_varglob_fonte_neige 1201a', &
-     &                  errmax,errmaxrel).eq.1) then 
-                        write(*,*) 'i,j=',i,j   
-                        write(*,*) 'coeff_rel_diag=',coeff_rel_diag
-                        stop
-                 endif
-          endif
-#endif
-         END DO
-      endif !IF (nisurf == is_lic) THEN  
-
-! Save ffonte, fqfonte and fqcalving in global arrays for each 
-! sub-surface separately
-    DO i = 1, knon
-     do ixt=1,niso
-       fxtfonte_global(ixt,knindex(i),nisurf)   = fxtfonte_neige(ixt,i)
-       fxtcalving_global(ixt,knindex(i),nisurf) = fxtcalving(ixt,i)
-     enddo !do ixt=1,niso
-    ENDDO   
-
-    IF (nisurf == is_lic) THEN
-    DO i = 1, knon    
-     do ixt=1,niso   
-       xtrunofflic_global(ixt,knindex(i)) = xtrun_off_lic(ixt,i)
-     enddo ! do ixt=1,niso   
-    ENDDO
-    ENDIF
-       
-        end subroutine gestion_neige_besoin_varglob_fonte_neige
-#endif
-
-
-END MODULE fonte_neige_mod
+link ../phylmd/fonte_neige_mod.F90
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/isotopes_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/isotopes_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/isotopes_mod.F90	(revision 5202)
@@ -20,8 +20,6 @@
 
    !--- Variables not depending on isotopes
-   REAL,    SAVE :: pxtmelt, pxtice, pxtmin, pxtmax
-!$OMP THREADPRIVATE(pxtmelt, pxtice, pxtmin, pxtmax)
-   REAL,    SAVE :: tdifexp, tv0cin, thumxt1
-!$OMP THREADPRIVATE(tdifexp, tv0cin, thumxt1)
+   REAL,    SAVE :: thumxt1
+   !$OMP THREADPRIVATE(thumxt1)
    INTEGER, SAVE :: ntot 
 !$OMP THREADPRIVATE(ntot)
@@ -30,10 +28,6 @@
    REAL,    SAVE :: P_veg
 !$OMP THREADPRIVATE(P_veg)
-   REAL,    SAVE :: musi, lambda_sursat
-!$OMP THREADPRIVATE(musi, lambda_sursat)
-   REAL,    SAVE :: Kd
-!$OMP THREADPRIVATE(Kd)
-   REAL,    SAVE :: rh_cste_surf_cond, T_cste_surf_cond
-!$OMP THREADPRIVATE(rh_cste_surf_cond, T_cste_surf_cond)
+   REAL,    SAVE :: lambda_sursat
+!$OMP THREADPRIVATE(lambda_sursat)
    LOGICAL, SAVE :: bidouille_anti_divergence    ! T: regularly, xteau <- q to avoid slow drifts
 !$OMP THREADPRIVATE(bidouille_anti_divergence)
@@ -54,6 +48,4 @@
    REAL,    SAVE :: sstlatcrit, dsstlatcrit
 !$OMP THREADPRIVATE(sstlatcrit, dsstlatcrit)
-   REAL,    SAVE :: deltaO18_oce
-!$OMP THREADPRIVATE(deltaO18_oce)
    INTEGER, SAVE :: albedo_prescrit              ! 0: default ; 1: constant albedo
 !$OMP THREADPRIVATE(albedo_prescrit)
@@ -88,4 +80,6 @@
    REAL,    SAVE :: fac_modif_evaoce
 !$OMP THREADPRIVATE(fac_modif_evaoce)
+   REAL,    SAVE :: deltaO18_oce
+!$OMP THREADPRIVATE(deltaO18_oce)
    INTEGER, SAVE :: ok_bidouille_wake
 !$OMP THREADPRIVATE(ok_bidouille_wake)
@@ -106,6 +100,34 @@
                     alpha_liq_sol, Rdefault, Rmethox
 !$OMP THREADPRIVATE(alpha_liq_sol, Rdefault, Rmethox)
-   REAL, SAVE ::    fac_coeff_eq17_liq, fac_coeff_eq17_ice
-!$OMP THREADPRIVATE(fac_coeff_eq17_liq, fac_coeff_eq17_ice)
+!   REAL, SAVE ::    fac_coeff_eq17_liq, fac_coeff_eq17_ice
+!!$OMP THREADPRIVATE(fac_coeff_eq17_liq, fac_coeff_eq17_ice)
+
+   !--- H2[18]O reference
+   REAL, PARAMETER :: fac_enrichoce18=0.0005
+   REAL, PARAMETER :: alpha_liq_sol_O18=1.00291
+   REAL, PARAMETER :: talph1_O18=1137.
+   REAL, PARAMETER :: talph2_O18=-0.4156
+   REAL, PARAMETER :: talph3_O18=-2.0667E-3
+   REAL, PARAMETER :: talps1_O18=11.839
+   REAL, PARAMETER :: talps2_O18=-0.028244
+   REAL, PARAMETER :: tdifrel_O18=1./0.9723
+   REAL, PARAMETER :: tkcin0_O18=0.006
+   REAL, PARAMETER :: tkcin1_O18=0.000285
+   REAL, PARAMETER :: tkcin2_O18=0.00082
+   REAL, PARAMETER :: fac_coeff_eq17_liq=0.529
+   REAL, PARAMETER :: fac_coeff_eq17_ice=0.529
+
+   !---- Parameters that do not depend on the nature of water isotopes:
+   REAL, PARAMETER :: pxtmelt = 273.15 ! temperature at which ice formation starts
+   REAL, PARAMETER :: pxtice  = 273.15-10.0 ! -- temperature at which all condensate is ice:
+   REAL, PARAMETER :: pxtmin = 273.15 - 120.0   ! On ne calcule qu'au dessus de -120°C
+   REAL, PARAMETER :: pxtmax = 273.15 +  60.0   ! On ne calcule qu'au dessus de +60°C
+   REAL, PARAMETER :: tdifexp = 0.58 ! -- a constant for alpha_eff for equilibrium below cloud base:
+   REAL, PARAMETER :: tv0cin  = 7.0 ! wind threshold (m/s) for smooth/rough regime (Merlivat and Jouzel 1979)
+   REAL, PARAMETER :: musi=1.0  ! facteurs lambda et mu dans Si=musi-lambda*T
+   REAL, PARAMETER :: Kd=2.5e-9 ! m2/s ! diffusion dans le sol
+   REAL, PARAMETER :: rh_cste_surf_cond = 0.6 ! cas où cste_surf_cond: on met rhs ou/et Ts cste pour voir
+   REAL, PARAMETER :: T_cste_surf_cond = 288.0
+
 
    !--- Negligible lower thresholds: no need to check for absurd values under these lower limits
@@ -140,9 +162,5 @@
    INTEGER :: ixt
 
-   !--- H2[18]O reference
-   REAL :: fac_enrichoce18, alpha_liq_sol_O18, &
-           talph1_O18, talph2_O18, talph3_O18, talps1_O18, talps2_O18, &
-           tkcin0_O18, tkcin1_O18, tkcin2_O18, tdifrel_O18  
-
+ 
    !--- For H2[17]O
    REAL    :: fac_kcin, pente_MWL
@@ -152,4 +170,5 @@
    LOGICAL, PARAMETER ::   ok_nocinsat = .FALSE. ! if T: no sursaturation effect for ice
    LOGICAL, PARAMETER :: Rdefault_smow = .FALSE. ! if T: Rdefault=smow; if F: nul
+   LOGICAL, PARAMETER :: tnat1 = .TRUE. ! If T: all tnats are 1.
 
    !--- For [3]H
@@ -157,5 +176,4 @@
 
    CHARACTER(LEN=maxlen) :: modname, sxt
-   REAL, ALLOCATABLE :: tmp(:)
 
    modname = 'iso_init'
@@ -214,5 +232,4 @@
       CALL get_in('lat_max_albedo', lat_max_albedo,  100.)
    END IF
-   deltaO18_oce=0.0
    CALL get_in('deltaP_BL',           deltaP_BL,     10.0)
    CALL get_in('ruissellement_pluie', ruissellement_pluie, 0)
@@ -249,57 +266,137 @@
    CALL get_in('ok_prod_nucl_tritium', ok_prod_nucl_tritium, .FALSE., .FALSE.)
 
-   !--------------------------------------------------------------
-   ! Parameters that do not depend on the nature of water isotopes:
-   !--------------------------------------------------------------
-   ! -- temperature at which ice condensate starts to form (valeur ECHAM?):
-   pxtmelt = 273.15
-
-   ! -- temperature at which all condensate is ice:
-   pxtice  = 273.15-10.0
-
-   !- -- test PHASE
-!   pxtmelt = 273.15 - 10.0
-!   pxtice  = 273.15 - 30.0
-
-   ! -- minimum temperature to calculate fractionation coeff
-   pxtmin = 273.15 - 120.0   ! On ne calcule qu'au dessus de -120°C
-   pxtmax = 273.15 +  60.0   ! On ne calcule qu'au dessus de +60°C
-   !    Remarque: les coeffs ont ete mesures seulement jusq'à -40!
-
-   ! -- a constant for alpha_eff for equilibrium below cloud base:
-   tdifexp = 0.58
-   tv0cin  = 7.0
-
-   ! facteurs lambda et mu dans Si=musi-lambda*T
-   musi=1.0
-   if (ok_nocinsat) lambda_sursat = 0.0          ! no sursaturation effect
-
-   ! diffusion dans le sol
-   Kd=2.5e-9 ! m2/s   
-
-   ! cas où cste_surf_cond: on met rhs ou/et Ts cste pour voir
-   rh_cste_surf_cond = 0.6
-    T_cste_surf_cond = 288.0
+   ! Ocean composition
+   CALL get_in('deltaO18_oce',  deltaO18_oce, 0.0)
    
    CALL msg('iso_O18, iso_HDO, iso_eau = '//TRIM(strStack(int2str([iso_O18, iso_HDO, iso_eau]))), modname)
 
    !--------------------------------------------------------------
-   ! Parameters that depend on the nature of water isotopes:
+   ! Isotope fractionation factors and a few isotopic constants
    !--------------------------------------------------------------
-   IF(getKey('tnat',    tnat,    isoName)) CALL abort_physic(modname, 'can''t get tnat',    1)
-   IF(getKey('toce',    toce,    isoName)) CALL abort_physic(modname, 'can''t get toce',    1)
-   IF(getKey('tcorr',   tcorr,   isoName)) CALL abort_physic(modname, 'can''t get tcorr',   1)
-   IF(getKey('talph1',  talph1,  isoName)) CALL abort_physic(modname, 'can''t get talph1',  1)
-   IF(getKey('talph2',  talph2,  isoName)) CALL abort_physic(modname, 'can''t get talph2',  1)
-   IF(getKey('talph3',  talph3,  isoName)) CALL abort_physic(modname, 'can''t get talph3',  1)
-   IF(getKey('talps1',  talps1,  isoName)) CALL abort_physic(modname, 'can''t get talps1',  1)
-   IF(getKey('talps2',  talps2,  isoName)) CALL abort_physic(modname, 'can''t get talps2',  1)
-   IF(getKey('tkcin0',  tkcin0,  isoName)) CALL abort_physic(modname, 'can''t get tkcin0',  1)
-   IF(getKey('tkcin1',  tkcin1,  isoName)) CALL abort_physic(modname, 'can''t get tkcin1',  1)
-   IF(getKey('tkcin2',  tkcin2,  isoName)) CALL abort_physic(modname, 'can''t get tkcin2',  1)
-   IF(getKey('tdifrel', tdifrel, isoName)) CALL abort_physic(modname, 'can''t get tdifrel', 1)
-   IF(getKey('alpha_liq_sol', alpha_liq_sol, isoName)) CALL abort_physic(modname, 'can''t get alpha_liq_sol',  1)
-   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)
+   ALLOCATE(tkcin0(niso))
+   ALLOCATE(tkcin1(niso))
+   ALLOCATE(tkcin2(niso))
+   ALLOCATE(tnat(niso))
+   ALLOCATE(tdifrel(niso))
+   ALLOCATE(toce(niso))
+   ALLOCATE(tcorr(niso))
+   ALLOCATE(talph1(niso))
+   ALLOCATE(talph2(niso))
+   ALLOCATE(talph3(niso))
+   ALLOCATE(talps1(niso))
+   ALLOCATE(talps2(niso))
+   ALLOCATE(alpha_liq_sol(niso))
+   ALLOCATE(Rdefault(niso))
+   ALLOCATE(Rmethox(niso))
+
+   do ixt=1,niso
+     if (ixt.eq.iso_HTO) then  ! Tritium
+       tkcin0(ixt) = 0.01056
+       tkcin1(ixt) = 0.0005016
+       tkcin2(ixt) = 0.0014432
+       if (tnat1) then 
+               tnat(ixt)=1 
+       else 
+               tnat(ixt)=0.
+       endif
+       toce(ixt)=4.0E-19 ! rapport T/H = 0.2 TU Dreisigacker and Roether 1978
+       tcorr(ixt)=1.
+       tdifrel(ixt)=1./0.968
+       talph1(ixt)=46480.
+       talph2(ixt)=-103.87
+       talph3(ixt)=0.
+       talps1(ixt)=46480.
+       talps2(ixt)=-103.87
+       alpha_liq_sol(ixt)=1. 
+       Rmethox(ixt)=0.0
+     endif
+     if (ixt.eq.iso_O17) then  ! O17
+       pente_MWL=0.528 
+       tdifrel(ixt)=1./0.98555 ! valeur utilisée en 1D et dans modèle de LdG ! tdifrel(ixt)=1./0.985452 ! donné par Amaelle
+       fac_kcin= (tdifrel(ixt)-1.0)/(tdifrel_O18-1.0) ! fac_kcin=0.5145 ! donné par Amaelle
+       tkcin0(ixt) = tkcin0_O18*fac_kcin
+       tkcin1(ixt) = tkcin1_O18*fac_kcin
+       tkcin2(ixt) = tkcin2_O18*fac_kcin
+       if (tnat1) then 
+               tnat(ixt)=1 
+       else 
+               tnat(ixt)=0.004/100. ! O17 représente 0.004% de l'oxygène
+       endif
+       toce(ixt)=tnat(ixt)*(1.0+deltaO18_oce/1000.0)**pente_MWL
+       tcorr(ixt)=1.0+fac_enrichoce18*pente_MWL ! donné par Amaelle            
+       talph1(ixt)=talph1_O18
+       talph2(ixt)=talph2_O18
+       talph3(ixt)=talph3_O18
+       talps1(ixt)=talps1_O18
+       talps2(ixt)=talps2_O18     
+       alpha_liq_sol(ixt)=(alpha_liq_sol_O18)**fac_coeff_eq17_liq 
+       Rdefault(ixt)=tnat(ixt)*(-3.15/1000.0+1.0)
+       Rmethox(ixt)=(230./1000.+1.)*tnat(ixt) !Zahn et al 2006
+     endif
+     if (ixt.eq.iso_O18) then  ! Oxygene18
+       tkcin0(ixt) = tkcin0_O18
+       tkcin1(ixt) = tkcin1_O18
+       tkcin2(ixt) = tkcin2_O18
+       if (tnat1) then
+               tnat(ixt)=1 
+       else 
+               tnat(ixt)=2005.2E-6
+       endif
+       toce(ixt)=tnat(ixt)*(1.0+deltaO18_oce/1000.0)
+       tcorr(ixt)=1.0+fac_enrichoce18
+       tdifrel(ixt)=tdifrel_O18
+       talph1(ixt)=talph1_O18
+       talph2(ixt)=talph2_O18
+       talph3(ixt)=talph3_O18
+       talps1(ixt)=talps1_O18
+       talps2(ixt)=talps2_O18
+       alpha_liq_sol(ixt)=alpha_liq_sol_O18   
+       Rdefault(ixt)=tnat(ixt)*(-6.0/1000.0+1.0)
+       Rmethox(ixt)=(130./1000.+1.)*tnat(ixt) !Zahn et al 2006  
+     endif
+     if (ixt.eq.iso_HDO) then ! Deuterium
+       pente_MWL=8.0
+       tdifrel(ixt)=1./0.9755 !          fac_kcin=0.88
+       fac_kcin= (tdifrel(ixt)-1)/(tdifrel_O18-1)
+       tkcin0(ixt) = tkcin0_O18*fac_kcin
+       tkcin1(ixt) = tkcin1_O18*fac_kcin
+       tkcin2(ixt) = tkcin2_O18*fac_kcin
+       if (tnat1) then 
+               tnat(ixt)=1
+       else
+               tnat(ixt)=155.76E-6
+       endif
+       toce(ixt)=tnat(ixt)*(1.0+pente_MWL*deltaO18_oce/1000.0)
+       tcorr(ixt)=1.0+fac_enrichoce18*pente_MWL          
+       talph1(ixt)=24844.
+       talph2(ixt)=-76.248
+       talph3(ixt)=52.612E-3
+       talps1(ixt)=16288.
+       talps2(ixt)=-0.0934
+       !ZXalpha_liq_sol=1.0192 ! Weston, Ralph, 1955
+       alpha_liq_sol(ixt)=1.0212 
+       ! valeur de Lehmann & Siegenthaler, 1991, Journal of
+       ! Glaciology, vol 37, p 23
+       Rdefault(ixt)=tnat(ixt)*((-6.0*pente_MWL+10.0)/1000.0+1.0)
+       Rmethox(ixt)=tnat(ixt)*(-25.0/1000.+1.) ! Zahn et al 2006
+     endif
+     if (ixt.eq.iso_eau) then ! Oxygene16
+       tkcin0(ixt) = 0.0
+       tkcin1(ixt) = 0.0
+       tkcin2(ixt) = 0.0
+       tnat(ixt)=1.
+       toce(ixt)=tnat(ixt)
+       tcorr(ixt)=1.0
+       tdifrel(ixt)=1.
+       talph1(ixt)=0.
+       talph2(ixt)=0.
+       talph3(ixt)=0.
+       talps1(ixt)=0.
+       talph3(ixt)=0.
+       alpha_liq_sol(ixt)=1.
+       Rdefault(ixt)=tnat(ixt)*1.0
+       Rmethox(ixt)=1.0
+     endif
+   enddo ! ixt=1,niso
 
    IF(.NOT.Rdefault_smow) then
@@ -308,4 +405,5 @@
    ENDIF
    write(*,*) 'Rdefault=',Rdefault
+   write(*,*) 'toce=',toce
 
    !--- Sensitivity test: no kinetic effect in sfc evaporation
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/isotopes_routines_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/isotopes_routines_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/isotopes_routines_mod.F90	(revision 5202)
@@ -1525,5 +1525,4 @@
 #endif       
        pxtfra=max(min(pxtfra,alpha_max),0.0)
-
 
       end subroutine fractcalk_liq
@@ -15922,7 +15921,4 @@
 
       ! verif
-!      text="phyisoetat0 67"
-!      write(*,*) 'snow(8,1)=',snow(8,1)
-!      write(*,*) 'xtsnow(4,8,1)=',xtsnow(4,8,1)
 #ifdef ISOVERIF
       do i=1,klon
@@ -15934,6 +15930,4 @@
          enddo !do ixt=1,niso
       enddo !do i=1,klon
-#endif      
-#ifdef ISOVERIF
       do i=1,klon
          if (iso_eau.gt.0) then
@@ -16021,5 +16015,4 @@
          endif 
        enddo !do i=1,klon
-
 #endif
       !end verif
@@ -16128,5 +16121,5 @@
           deltaD_run_off_lic_0(ixt)=deltaD_sol(ixt)
           deltaD_land_ice(ixt)=deltaD_snow(ixt)
-          call fractcalk_liq(ixt, 283.0, alpha(ixt))            
+          call fractcalk_liq(ixt, 283.0, alpha(ixt))    
         enddo !do ixt=1,niso
         call calcul_kcin(2.0,kcin) 
@@ -18830,4 +18823,8 @@
         if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
             if (q.gt.ridicule) then
+                    write(*,*) 'xt,q=',xt,q
+                    write(*,*) 'alpha=',alpha
+                    write(*,*) 'toce,kcin,h0=',toce,kcin,h0
+                    write(*,*) 'RMerlivat=',RMerlivat
                 call iso_verif_aberrant_encadre( xt/q, 'isotopes_routines_mod 18930b: iso_init_ideal')
             endif
@@ -18902,4 +18899,82 @@
 end subroutine appel_stewart_debug
 
+
+subroutine dispatch(klon,klev,qx,q_seri,xt_seri,ql_seri,xtl_seri,qs_seri,xts_seri)
+
+use infotrac_phy, ONLY: nqtot,nqo,ivap,iliq,isol,iqIsoPha,ntraciso=>ntiso
+implicit none
+
+! inputs
+integer, intent(in) :: klon,klev
+real,dimension(klon,klev,nqtot), intent(in) ::qx
+
+! outputs
+real,dimension(klon,klev), intent(out) ::q_seri,ql_seri,qs_seri
+real,dimension(ntraciso,klon,klev), intent(out) :: xt_seri,xtl_seri,xts_seri
+
+! locals
+integer :: i,k,ixt
+
+do k=1,klev
+do i=1,klon
+    q_seri(i,k)  = qx(i,k,ivap)
+    ql_seri(i,k) = qx(i,k,iliq)
+    IF (nqo.EQ.2) THEN             !--vapour and liquid only
+             qs_seri(i,k) = 0.
+    ELSE IF (nqo.ge.3) THEN        !--vapour, liquid and ice
+             qs_seri(i,k) = qx(i,k,isol)
+    ENDIF
+    do ixt=1,ntraciso
+          xt_seri(ixt,i,k)  = qx(i,k,iqIsoPha(ixt,ivap))
+          xtl_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,iliq))
+          if (nqo.eq.2) then
+             xts_seri(ixt,i,k) = 0.
+          else if (nqo.eq.3) then
+             xts_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,isol))
+          endif
+    enddo !do ixt=1,niso
+
+enddo
+enddo
+
+end subroutine dispatch
+
+subroutine together(klon,klev,qx,q_seri,xt_seri,ql_seri,xtl_seri,qs_seri,xts_seri)
+
+use infotrac_phy, ONLY: nqtot,nqo,ivap,iliq,isol,iqIsoPha,ntraciso=>ntiso
+implicit none
+
+! inputs
+integer, intent(in) :: klon,klev
+real,dimension(klon,klev), intent(in) ::q_seri,ql_seri,qs_seri
+real,dimension(ntraciso,klon,klev), intent(in) :: xt_seri,xtl_seri,xts_seri
+
+! inputs
+real,dimension(klon,klev,nqtot), intent(out) ::qx
+
+! locals
+integer :: i,k,ixt
+
+do k=1,klev
+do i=1,klon  
+    qx(i,k,ivap)  = q_seri(i,k)
+    qx(i,k,iliq) = ql_seri(i,k)
+    IF (nqo.ge.3) THEN        !--vapour, liquid and ice
+             qx(i,k,isol) = qs_seri(i,k)
+    ENDIF
+    do ixt=1,ntraciso
+          qx(i,k,iqIsoPha(ixt,ivap)) = xt_seri(ixt,i,k)  
+          qx(i,k,iqIsoPha(ixt,iliq)) = xtl_seri(ixt,i,k)
+          if (nqo.ge.3) then
+             qx(i,k,iqIsoPha(ixt,isol)) = xts_seri(ixt,i,k)
+          endif
+    enddo !do ixt=1,niso
+
+enddo
+enddo
+
+end subroutine together
+
+
 END MODULE isotopes_routines_mod
 #endif
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/isotopes_verif_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/isotopes_verif_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/isotopes_verif_mod.F90	(revision 5202)
@@ -1042,4 +1042,5 @@
             write(*,*) 'deltaD=',deltaD
             write(*,*) 'Dexcess=',dexcess
+            write(*,*) 'tnat=',tnat
 !            stop
             iso_verif_O18_aberrant_nostop=1
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/isotrac_routines_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/isotrac_routines_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/isotrac_routines_mod.F90	(revision 5202)
@@ -681,5 +681,5 @@
               Eqi_prime_cas(il)=Eqi_prime(cas(il)) &
      &           *(Pxtisup(ieau,cas(il))/Pqisup(cas(il)))
-              Eqi_cas(il)=Eqi(il) &
+              Eqi_cas(il)=Eqi(cas(il)) & ! corr bug Camille 15 juin 2024
      &           *(Pxtisup(ieau,cas(il))/Pqisup(cas(il)))
             else
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/ocean_forced_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/ocean_forced_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/ocean_forced_mod.F90	(revision 5202)
@@ -1,542 +1,1 @@
-!
-! $Id: ocean_forced_mod.F90 3327 2018-05-16 13:58:59Z musat $
-!
-MODULE ocean_forced_mod
-!
-! This module is used for both the sub-surfaces ocean and sea-ice for the case of a 
-! forced ocean,  "ocean=force".
-!
-  IMPLICIT NONE
-
-CONTAINS
-!
-!****************************************************************************************
-!
-  SUBROUTINE ocean_forced_noice( &
-       itime, dtime, jour, knon, knindex, &
-       p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, &
-       temp_air, spechum, &
-       AcoefH, AcoefQ, BcoefH, BcoefQ, &
-       AcoefU, AcoefV, BcoefU, BcoefV, &
-       ps, u1, v1, gustiness, tsurf_in, &
-       radsol, snow, agesno, & 
-       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-       tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa &
-#ifdef ISO
-            ,xtprecip_rain, xtprecip_snow, xtspechum,Roce,rlat, &
-            xtsnow,xtevap,h1 &  
-#endif            
-            )
-!
-! This subroutine treats the "open ocean", all grid points that are not entierly covered
-! by ice.
-! The routine receives data from climatologie file limit.nc and does some calculations at the 
-! surface. 
-!
-    USE dimphy
-    USE calcul_fluxs_mod
-    USE limit_read_mod
-    USE mod_grid_phy_lmdz
-    USE indice_sol_mod
-    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
-    use config_ocean_skin_m, only: activate_ocean_skin
-#ifdef ISO
-  USE infotrac_phy, ONLY: ntiso,niso
-    USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, &
-&       calcul_iso_surf_sic_vectall    
-#ifdef ISOVERIF
-    USE isotopes_mod, ONLY: iso_eau,ridicule
-    !USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_egalite_choix
-    USE isotopes_verif_mod
-#endif
-#endif
-
-    INCLUDE "YOMCST.h"
-    INCLUDE "clesphys.h"
-    INCLUDE "flux_arp.h"
-
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                      :: itime, jour, knon
-    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
-    REAL, INTENT(IN)                         :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
-    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragq, cdragm
-    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
-    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
-    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
-    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
-    REAL, DIMENSION(klon), INTENT(IN)        :: ps
-    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
-    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in
-    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
-
-#ifdef ISO
-    REAL, DIMENSION(ntiso,klon), INTENT(IN)  :: xtprecip_rain, xtprecip_snow
-    REAL, DIMENSION(ntiso,klon), INTENT(IN)  :: xtspechum
-    real, dimension(klon), intent(IN) :: rlat
-#endif
-
-! In/Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
-    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
-    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno !? put to 0 in ocean
-#ifdef ISO     
-    REAL, DIMENSION(niso,klon), INTENT(IN)    :: xtsnow
-    REAL, DIMENSION(niso,klon), INTENT(INOUT)    :: Roce
-#endif
-
-! Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
-    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
-    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l
-    REAL, intent(out):: sens_prec_liq(:) ! (knon)
-
-#ifdef ISO     
-    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap ! isotopes in evaporation flux
-    REAL, DIMENSION(klon), INTENT(out)    :: h1 ! just a diagnostic, not useful for the simulation
-#endif
-
-! Local variables
-!****************************************************************************************
-    INTEGER                     :: i, j
-    REAL, DIMENSION(klon)       :: cal, beta, dif_grnd
-    REAL, DIMENSION(klon)       :: alb_neig, tsurf_lim, zx_sl
-    REAL, DIMENSION(klon)       :: u0, v0
-    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
-    LOGICAL                     :: check=.FALSE.
-    REAL sens_prec_sol(knon) 
-    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol    
-
-#ifdef ISO   
-      real, parameter :: t_coup = 273.15      
-#endif
-
-!****************************************************************************************
-! Start calculation
-!****************************************************************************************
-    IF (check) WRITE(*,*)' Entering ocean_forced_noice'
-    
-#ifdef ISO
-#ifdef ISOVERIF
-        do i=1,knon
-          if (iso_eau.gt.0) then         
-              call iso_verif_egalite_choix(xtspechum(iso_eau,i), &
-     &                  spechum(i),'ocean_forced_mod 111', &
-     &                  errmax,errmaxrel)     
-              call iso_verif_egalite_choix(snow(i), &
-     &          xtsnow(iso_eau,i),'ocean_forced_mod 117', &
-     &          errmax,errmaxrel)
-           endif !if (iso_eau.gt.0) then
-        enddo !do i=1,knon
-#endif      
-#endif 
-
-!****************************************************************************************
-! 1)    
-! Read sea-surface temperature from file limit.nc
-!
-!****************************************************************************************
-!--sb:
-!!jyg    if (knon.eq.1) then ! single-column model
-    if (klon_glo.eq.1) then ! single-column model
-      ! EV: now surface Tin flux_arp.h
-      !CALL read_tsurf1d(knon,tsurf_lim) ! new
-       DO i = 1, knon
-        tsurf_lim(i) = tg
-       ENDDO
-
-    else ! GCM
-      CALL limit_read_sst(knon,knindex,tsurf_lim &
-#ifdef ISO
-     &  ,Roce,rlat   &
-#endif     
-     &   )
-    endif ! knon
-!sb--
-
-!****************************************************************************************
-! 2)
-! Flux calculation
-!
-!****************************************************************************************
-! Set some variables for calcul_fluxs
-    !cal = 0.
-    !beta = 1.
-    !dif_grnd = 0.
-    
-    
-    ! EV: use calbeta to calculate beta
-    ! Need to initialize qsurf for calbeta but it is not modified by this routine
-    qsurf(:)=0.
-    CALL calbeta(dtime, is_oce, knon, snow, qsurf, beta, cal, dif_grnd)
-
-
-    alb_neig(:) = 0.
-    agesno(:) = 0.
-    lat_prec_liq = 0.; lat_prec_sol = 0.
-
-! Suppose zero surface speed
-    u0(:)=0.0
-    v0(:)=0.0
-    u1_lay(:) = u1(:) - u0(:)
-    v1_lay(:) = v1(:) - v0(:)
-
-! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf
-    CALL calcul_fluxs(knon, is_oce, dtime, &
-         merge(tsurf_in, tsurf_lim, activate_ocean_skin == 2), p1lay, cal, &
-         beta, cdragh, cdragq, ps, &
-         precip_rain, precip_snow, snow, qsurf,  &
-         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
-         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
-         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
-         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
-    if (activate_ocean_skin == 2) tsurf_new = tsurf_lim
-
-    do j = 1, knon
-      i = knindex(j)
-      sens_prec_liq_o(i,1) = sens_prec_liq(j)
-      sens_prec_sol_o(i,1) = sens_prec_sol(j)
-      lat_prec_liq_o(i,1) = lat_prec_liq(j)
-      lat_prec_sol_o(i,1) = lat_prec_sol(j)
-    enddo
-
-
-! - Flux calculation at first modele level for U and V
-    CALL calcul_flux_wind(knon, dtime, &
-         u0, v0, u1, v1, gustiness, cdragm, &
-         AcoefU, AcoefV, BcoefU, BcoefV, &
-         p1lay, temp_air, &
-         flux_u1, flux_v1)  
- 
-
-#ifdef ISO     
-        call calcul_iso_surf_oce_vectall(klon, knon,t_coup, &
-     &    ps,tsurf_new,spechum,u1_lay, v1_lay, xtspechum, &
-     &    evap, Roce,xtevap,h1 &
-#ifdef ISOTRAC
-     &    ,knindex &
-#endif
-     &   )
-#endif         
-
-#ifdef ISO
-#ifdef ISOVERIF
-!          write(*,*) 'ocean_forced_mod 176: sortie de ocean_forced_noice'
-          if (iso_eau.gt.0) then
-           do i=1,knon               
-              call iso_verif_egalite_choix(snow(i), &
-     &          xtsnow(iso_eau,i),'ocean_forced_mod 180', &
-     &          errmax,errmaxrel)
-           enddo ! do j=1,knon
-          endif !if (iso_eau.gt.0) then
-#endif
-#endif   
-
-  END SUBROUTINE ocean_forced_noice
-!
-!***************************************************************************************
-!
-  SUBROUTINE ocean_forced_ice( &
-       itime, dtime, jour, knon, knindex, &
-       tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
-       AcoefH, AcoefQ, BcoefH, BcoefQ, &
-       AcoefU, AcoefV, BcoefU, BcoefV, &
-       ps, u1, v1, gustiness, &
-       radsol, snow, qsol, agesno, tsoil, &
-       qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-       tsurf_new, dflux_s, dflux_l, rhoa &
-#ifdef ISO
-            ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
-            xtsnow, xtsol,xtevap,Rland_ice &  
-#endif            
-            )
-!
-! This subroutine treats the ocean where there is ice. 
-! The routine reads data from climatologie file and does flux calculations at the 
-! surface.
-!
-    USE dimphy
-    USE geometry_mod, ONLY: longitude,latitude
-
-    USE calcul_fluxs_mod
-    USE surface_data,     ONLY : calice, calsno
-    USE limit_read_mod
-    USE fonte_neige_mod,  ONLY : fonte_neige
-    USE indice_sol_mod
-    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
-#ifdef ISO
-  USE infotrac_phy, ONLY: niso, ntiso
-    USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, &
-&       calcul_iso_surf_sic_vectall 
-#ifdef ISOVERIF
-    USE isotopes_mod, ONLY: iso_eau,ridicule
-    !USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_egalite_choix
-    USE isotopes_verif_mod
-#endif
-#endif
-
-!   INCLUDE "indicesol.h"
-    INCLUDE "dimsoil.h"
-    INCLUDE "YOMCST.h"
-    INCLUDE "clesphys.h"
-    INCLUDE "flux_arp.h"
-
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                  :: itime, jour, knon
-    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
-    REAL, INTENT(IN)                     :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf_in
-    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)    :: temp_air, spechum
-    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefH, AcoefQ, BcoefH, BcoefQ
-    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefU, AcoefV, BcoefU, BcoefV
-    REAL, DIMENSION(klon), INTENT(IN)    :: ps
-    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1, gustiness
-    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
-#ifdef ISO
-    REAL, DIMENSION(ntiso,klon), INTENT(IN)    :: xtprecip_rain, xtprecip_snow
-    REAL, DIMENSION(ntiso,klon), INTENT(IN)    :: xtspechum
-    REAL, DIMENSION(niso,klon),  INTENT(IN)    :: Roce 
-    REAL, DIMENSION(niso,klon),  INTENT(IN)    :: Rland_ice
-#endif
-
-! In/Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(INOUT)          :: radsol
-    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
-    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
-    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
-#ifdef ISO     
-    REAL, DIMENSION(niso,klon), INTENT(INOUT)    :: xtsnow
-    REAL, DIMENSION(niso,klon), INTENT(IN)    :: xtsol
-#endif
-
-! Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1_new  ! new albedo in visible SW interval
-    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2_new  ! new albedo in near IR interval
-    REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
-    REAL, DIMENSION(klon), INTENT(OUT)            :: flux_u1, flux_v1
-    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l      
-#ifdef ISO     
-    REAL, DIMENSION(ntiso,klon), INTENT(OUT)    :: xtevap
-#endif      
-
-! Local variables
-!****************************************************************************************
-    LOGICAL                     :: check=.FALSE.
-    INTEGER                     :: i, j
-    REAL                        :: zfra
-    REAL, PARAMETER             :: t_grnd=271.35
-    REAL, DIMENSION(klon)       :: cal, beta, dif_grnd, capsol
-    REAL, DIMENSION(klon)       :: alb_neig, tsurf_tmp
-    REAL, DIMENSION(klon)       :: soilcap, soilflux
-    REAL, DIMENSION(klon)       :: u0, v0
-    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
-    REAL sens_prec_liq(knon), sens_prec_sol (knon)
-    REAL, DIMENSION(klon)       :: lat_prec_liq, lat_prec_sol    
-
-#ifdef ISO       
-      real, parameter :: t_coup = 273.15
-      real, dimension(klon) :: fq_fonte_diag
-      real, dimension(klon) :: fqfonte_diag
-      real, dimension(klon) ::  snow_evap_diag 
-      real, dimension(klon) ::  fqcalving_diag 
-      real, DIMENSION(klon) :: run_off_lic_diag
-      real :: coeff_rel_diag
-      real  :: max_eau_sol_diag  
-      real, dimension(klon)  ::  runoff_diag    
-      integer ixt
-      REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec
-      REAL, DIMENSION(klon) :: snow_prec,qsol_prec  
-#endif      
-
-!****************************************************************************************
-! Start calculation
-!****************************************************************************************
-    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon 
-
-!****************************************************************************************
-! 1) 
-! Flux calculation : tsurf_new, evap, fluxlat, fluxsens, flux_u1, flux_v1
-!                    dflux_s, dflux_l and qsurf
-!****************************************************************************************
-
-    tsurf_tmp(:) = tsurf_in(:)
-
-! calculate the parameters cal, beta, capsol and dif_grnd and then recalculate cal
-    CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd)
-
-    
-    IF (soil_model) THEN 
-! update tsoil and calculate soilcap and soilflux
-       CALL soil(dtime, is_sic, knon, snow, tsurf_tmp, qsol, &
-        & 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)
-       dif_grnd = 1.0 / tau_gl
-    ELSE 
-       dif_grnd = 1.0 / tau_gl
-       cal = RCPD * calice
-       WHERE (snow > 0.0) cal = RCPD * calsno 
-    ENDIF
-
-!    beta = 1.0
-    lat_prec_liq = 0.; lat_prec_sol = 0.
-
-! Suppose zero surface speed
-    u0(:)=0.0
-    v0(:)=0.0
-    u1_lay(:) = u1(:) - u0(:)
-    v1_lay(:) = v1(:) - v0(:)
-    CALL calcul_fluxs(knon, is_sic, dtime, &
-         tsurf_tmp, p1lay, cal, beta, cdragh, cdragh, ps, &
-         precip_rain, precip_snow, snow, qsurf,  &
-         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
-         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
-         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
-         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
-    do j = 1, knon
-      i = knindex(j)
-      sens_prec_liq_o(i,2) = sens_prec_liq(j)
-      sens_prec_sol_o(i,2) = sens_prec_sol(j)
-      lat_prec_liq_o(i,2) = lat_prec_liq(j)
-      lat_prec_sol_o(i,2) = lat_prec_sol(j)
-    enddo
-
-! - Flux calculation at first modele level for U and V
-    CALL calcul_flux_wind(knon, dtime, &
-         u0, v0, u1, v1, gustiness, cdragm, &
-         AcoefU, AcoefV, BcoefU, BcoefV, &
-         p1lay, temp_air, &
-         flux_u1, flux_v1)  
-
-!****************************************************************************************
-! 2)
-! Calculations due to snow and runoff
-!
-!****************************************************************************************
-
-#ifdef ISO
-   ! verif
-#ifdef ISOVERIF
-     do i=1,knon
-       if (iso_eau.gt.0) then
-           if (snow(i).gt.ridicule) then
-             call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
-     &           'interfsurf 964',errmax,errmaxrel)
-            endif !if ((snow(i).gt.ridicule)) then
-        endif !if (iso_eau.gt.0) then      
-      enddo !do i=1,knon  
-#endif
-   ! end verif
-
-    do i=1,knon
-      snow_prec(i)=snow(i)
-      do ixt=1,niso
-      xtsnow_prec(ixt,i)=xtsnow(ixt,i)
-      enddo !do ixt=1,niso
-      ! initialisation:
-      fq_fonte_diag(i)=0.0
-      fqfonte_diag(i)=0.0
-      snow_evap_diag(i)=0.0
-    enddo !do i=1,knon
-#endif
-
-    CALL fonte_neige( knon, is_sic, knindex, dtime, &
-         tsurf_tmp, precip_rain, precip_snow, &
-         snow, qsol, tsurf_new, evap &
-#ifdef ISO    
-     & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
-     & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag   &
-#endif
-     &   )
-
-
-#ifdef ISO
-! isotopes: tout est externalisé
-!#ifdef ISOVERIF
-!        write(*,*) 'ocean_forced_mod 377: call calcul_iso_surf_sic_vectall'
-!        write(*,*) 'klon,knon=',klon,knon
-!#endif
-         call calcul_iso_surf_sic_vectall(klon,knon, &
-             &   evap,snow_evap_diag,Tsurf_new,Roce,snow, &
-             &   fq_fonte_diag,fqfonte_diag,dtime,t_coup, &
-             &   precip_snow,xtprecip_snow,xtprecip_rain, snow_prec,xtsnow_prec, &
-             &   xtspechum,spechum,ps, &
-             &   xtevap,xtsnow,fqcalving_diag, &
-             &   knindex,is_sic,run_off_lic_diag,coeff_rel_diag,Rland_ice &
-     &  )   
-#ifdef ISOVERIF
-        !write(*,*) 'ocean_forced_mod 391: sortie calcul_iso_surf_sic_vectall'
-          if (iso_eau.gt.0) then
-           do i=1,knon  
-              call iso_verif_egalite_choix(snow(i), &
-     &          xtsnow(iso_eau,i),'ocean_forced_mod 396', &
-     &          errmax,errmaxrel)
-           enddo ! do j=1,knon
-          endif !if (iso_eau.gt.0) then
-#endif 
-!#ifdef ISOVERIF
-#endif   
-!#ifdef ISO
-    
-! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno)
-! 
-    CALL albsno(klon, knon, dtime, agesno(:), alb_neig(:), precip_snow(:))  
-
-    WHERE (snow(1:knon) .LT. 0.0001) agesno(1:knon) = 0.
-
-    alb1_new(:) = 0.0
-    DO i=1, knon
-       zfra = MAX(0.0,MIN(1.0,snow(i)/(snow(i)+10.0)))
-       alb1_new(i) = alb_neig(i) * zfra +  0.6 * (1.0-zfra)
-    ENDDO
-
-    alb2_new(:) = alb1_new(:)
-
-  END SUBROUTINE ocean_forced_ice
-
-!************************************************************************
-! 1D case
-!************************************************************************
-!  SUBROUTINE read_tsurf1d(knon,sst_out)
-!
-! This subroutine specifies the surface temperature to be used in 1D simulations
-!
-!      USE dimphy, ONLY : klon
-!
-!      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
-!      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
-!
-!       INTEGER :: i
-! COMMON defined in lmdz1d.F:
-!       real ts_cur
-!       common /sst_forcing/ts_cur
-!
-!       DO i = 1, knon
-!        sst_out(i) = ts_cur
-!       ENDDO
-!
-!      END SUBROUTINE read_tsurf1d
-!
-!
-!************************************************************************
-END MODULE ocean_forced_mod
-
-
-
-
-
-
+link ../phylmd/ocean_forced_mod.F90
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/output_physiqex_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/output_physiqex_mod.F90	(revision 5202)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/output_physiqex_mod.F90	(revision 5202)
@@ -0,0 +1,1 @@
+link ../phylmd/output_physiqex_mod.F90
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/pbl_surface_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/pbl_surface_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/pbl_surface_mod.F90	(revision 5202)
@@ -1,4462 +1,1 @@
-!
-! $Id: pbl_surface_mod.F90 3956 2021-07-06 07:16:14Z jyg $
-!
-MODULE pbl_surface_mod
-!
-! Planetary Boundary Layer and Surface module
-!
-! This module manages the calculation of turbulent diffusion in the boundary layer 
-! and all interactions towards the differents sub-surfaces.
-!
-!
-  USE dimphy
-  USE mod_phys_lmdz_para,  ONLY : mpi_size
-  USE mod_grid_phy_lmdz,   ONLY : klon_glo
-  USE ioipsl
-  USE surface_data,        ONLY : type_ocean, ok_veget, landice_opt
-  USE surf_land_mod,       ONLY : surf_land
-  USE surf_landice_mod,    ONLY : surf_landice
-  USE surf_ocean_mod,      ONLY : surf_ocean
-  USE surf_seaice_mod,     ONLY : surf_seaice
-  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 lmdz_call_atke,      ONLY : call_atke
-  USE ioipsl_getin_p_mod,  ONLY : getin_p
-  USE cdrag_mod
-  USE stdlevvar_mod
-  USE wx_pbl_var_mod,      ONLY : wx_pbl_init, wx_pbl_final, &
-                                  wx_pbl_prelim_0, wx_pbl_prelim_beta
-  USE wx_pbl_mod,          ONLY : wx_pbl0_merge, wx_pbl_split, wx_pbl_dts_merge, &
-                                  wx_pbl_check, wx_pbl_dts_check, wx_evappot
-  use config_ocean_skin_m, only: activate_ocean_skin
-#ifdef ISO
-  USE infotrac_phy, ONLY: niso,ntraciso=>ntiso    
-#endif
-
-  IMPLICIT NONE
-
-! Declaration of variables saved in restart file
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: fder   ! flux drift
-  !$OMP THREADPRIVATE(fder)
-  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE    :: snow   ! snow at surface
-  !$OMP THREADPRIVATE(snow)
-  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: qsurf  ! humidity at surface
-  !$OMP THREADPRIVATE(qsurf)
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE          :: ftsoil ! soil temperature
-  !$OMP THREADPRIVATE(ftsoil)
-  REAL, ALLOCATABLE, DIMENSION(:), SAVE              :: ydTs0, ydqs0  
-                                                     ! nul forced temperature and humidity differences
-  !$OMP THREADPRIVATE(ydTs0, ydqs0)
-
-#ifdef ISO
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: xtsnow   ! snow at surface
-  !$OMP THREADPRIVATE(xtsnow)
-  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: Rland_ice   ! snow at surface
-  !$OMP THREADPRIVATE(Rland_ice)  
-  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: Roce   ! snow at surface
-  !$OMP THREADPRIVATE(Roce)  
-#endif
-
-  INTEGER, SAVE :: iflag_pbl_surface_t2m_bug
-  !$OMP THREADPRIVATE(iflag_pbl_surface_t2m_bug)
-  INTEGER, SAVE :: iflag_new_t2mq2m
-  !$OMP THREADPRIVATE(iflag_new_t2mq2m)
-
-!FC
-!  integer, save :: iflag_frein
-!  !$OMP THREADPRIVATE(iflag_frein)
-
-CONTAINS
-!
-!****************************************************************************************
-!
-  SUBROUTINE pbl_surface_init(fder_rst, snow_rst, qsurf_rst, ftsoil_rst)
-
-! This routine should be called after the restart file has been read.
-! This routine initialize the restart variables and does some validation tests
-! for the index of the different surfaces and tests the choice of type of ocean.
-
-    USE indice_sol_mod
-    USE print_control_mod, ONLY: lunout
-    USE ioipsl_getin_p_mod, ONLY : getin_p
-    IMPLICIT NONE
-
-    INCLUDE "dimsoil.h"
- 
-! Input variables
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(IN)                 :: fder_rst
-    REAL, DIMENSION(klon, nbsrf), INTENT(IN)          :: snow_rst
-    REAL, DIMENSION(klon, nbsrf), INTENT(IN)          :: qsurf_rst
-    REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(IN) :: ftsoil_rst
-  
-! Local variables
-!****************************************************************************************
-    INTEGER                       :: ierr
-    CHARACTER(len=80)             :: abort_message
-    CHARACTER(len = 20)           :: modname = 'pbl_surface_init'
-    
-!****************************************************************************************
-! Allocate and initialize module variables with fields read from restart file.
-!
-!****************************************************************************************    
-    ALLOCATE(fder(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
-
-    ALLOCATE(snow(klon,nbsrf), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
-
-    ALLOCATE(qsurf(klon,nbsrf), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
-
-    ALLOCATE(ftsoil(klon,nsoilmx,nbsrf), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
-
-    ALLOCATE(ydTs0(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
-
-    ALLOCATE(ydqs0(klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
-
-    fder(:)       = fder_rst(:)
-    snow(:,:)     = snow_rst(:,:)
-    qsurf(:,:)    = qsurf_rst(:,:)
-    ftsoil(:,:,:) = ftsoil_rst(:,:,:)
-    ydTs0(:) = 0.
-    ydqs0(:) = 0.
-
-!****************************************************************************************
-! Test for sub-surface indices
-!
-!****************************************************************************************
-    IF (is_ter /= 1) THEN 
-      WRITE(lunout,*)" *** Warning ***"
-      WRITE(lunout,*)" is_ter n'est pas le premier surface, is_ter = ",is_ter
-      WRITE(lunout,*)"or on doit commencer par les surfaces continentales"
-      abort_message="voir ci-dessus"
-      CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-    IF ( is_oce > is_sic ) THEN
-      WRITE(lunout,*)' *** Warning ***'
-      WRITE(lunout,*)' Pour des raisons de sequencement dans le code'
-      WRITE(lunout,*)' l''ocean doit etre traite avant la banquise'
-      WRITE(lunout,*)' or is_oce = ',is_oce, '> is_sic = ',is_sic
-      abort_message='voir ci-dessus'
-      CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-    IF ( is_lic > is_sic ) THEN
-      WRITE(lunout,*)' *** Warning ***'
-      WRITE(lunout,*)' Pour des raisons de sequencement dans le code'
-      WRITE(lunout,*)' la glace contineltalle doit etre traite avant la glace de mer'
-      WRITE(lunout,*)' or is_lic = ',is_lic, '> is_sic = ',is_sic
-      abort_message='voir ci-dessus'
-      CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-!****************************************************************************************
-! Validation of ocean mode
-!
-!****************************************************************************************
-
-    IF (type_ocean /= 'slab  ' .AND. type_ocean /= 'force ' .AND. type_ocean /= 'couple') THEN
-       WRITE(lunout,*)' *** Warning ***'
-       WRITE(lunout,*)'Option couplage pour l''ocean = ', type_ocean
-       abort_message='option pour l''ocean non valable'
-       CALL abort_physic(modname,abort_message,1)
-    ENDIF
-
-    iflag_pbl_surface_t2m_bug=0
-    CALL getin_p('iflag_pbl_surface_t2m_bug',iflag_pbl_surface_t2m_bug)
-    WRITE(lunout,*) 'iflag_pbl_surface_t2m_bug=',iflag_pbl_surface_t2m_bug
-!FC
-!    iflag_frein = 0
-!    CALL getin_p('iflag_frein',iflag_frein)
-!
-!jyg<
-!****************************************************************************************
-! Allocate variables for pbl splitting
-!
-!****************************************************************************************
-
-    CALL wx_pbl_init
-!>jyg
-
-  END SUBROUTINE pbl_surface_init
-
-#ifdef ISO
-  SUBROUTINE pbl_surface_init_iso(xtsnow_rst,Rland_ice_rst)
-
-! This routine should be called after the restart file has been read.
-! This routine initialize the restart variables and does some validation tests
-! for the index of the different surfaces and tests the choice of type of ocean.
-
-    USE indice_sol_mod
-    USE print_control_mod, ONLY: lunout
-#ifdef ISOVERIF
-    USE isotopes_mod, ONLY: iso_eau,ridicule
-    USE isotopes_verif_mod
-#endif
-    IMPLICIT NONE
-
-    INCLUDE "dimsoil.h"
- 
-! Input variables
-!****************************************************************************************
-    REAL, DIMENSION(niso,klon, nbsrf), INTENT(IN)          :: xtsnow_rst
-    REAL, DIMENSION(niso,klon), INTENT(IN)          :: Rland_ice_rst
-  
-! Local variables
-!****************************************************************************************
-    INTEGER                       :: ierr
-    CHARACTER(len=80)             :: abort_message
-    CHARACTER(len = 20)           :: modname = 'pbl_surface_init'
-    integer i,ixt
-    
-!****************************************************************************************
-! Allocate and initialize module variables with fields read from restart file.
-!
-!****************************************************************************************    
-
-    ALLOCATE(xtsnow(niso,klon,nbsrf), stat=ierr)
-    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
-
-    ALLOCATE(Rland_ice(niso,klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
-
-    ALLOCATE(Roce(niso,klon), stat=ierr)
-    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
-
-    xtsnow(:,:,:)     = xtsnow_rst(:,:,:)
-    Rland_ice(:,:)     = Rland_ice_rst(:,:)
-    Roce(:,:)     = 0.0
-
-#ifdef ISOVERIF 
-      if (iso_eau.gt.0) then
-         call iso_verif_egalite_vect2D( &
-     &           xtsnow,snow, &
-     &           'pbl_surface_mod 170',niso,klon,nbsrf)
-         do i=1,klon  
-            if (iso_eau.gt.0) then  
-              call iso_verif_egalite(Rland_ice(iso_eau,i),1.0, &
-     &         'pbl_surf_mod 177')
-            endif
-         enddo
-      endif
-#endif
-
-  END SUBROUTINE pbl_surface_init_iso
-#endif
-
-!  
-!****************************************************************************************
-!  
-
-  SUBROUTINE pbl_surface( &
-       dtime,     date0,     itap,     jour,          &
-       debut,     lafin,                              &
-       rlon,      rlat,      rugoro,   rmu0,          &
-       lwdown_m,  cldt,          &
-       rain_f,    snow_f,    bs_f, solsw_m,  solswfdiff_m, sollw_m,       &
-       gustiness,                                     &
-       t,         q,        qbs,  u,        v,             &
-!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
-!!       t_x,       q_x,       t_w,      q_w,           &
-       wake_dlt,             wake_dlq,                &
-       wake_cstar,           wake_s,                  &
-!!!
-       pplay,     paprs,     pctsrf,                  &
-       ts,SFRWL,   alb_dir, alb_dif,ustar, u10m, v10m,wstar, &
-       cdragh,    cdragm,   zu1,    zv1,              &
-!jyg<   (26/09/2019)
-       beta, &
-!>jyg
-       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_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,                              &
-       d_t_x,     d_q_x,                              & 
-!!       d_wake_dlt,d_wake_dlq,                         &
-       zxsens_x,  zxfluxlat_x,zxsens_w,zxfluxlat_w,   &
-!!!
-!!! nrlmd le 13/06/2011
-       delta_tsurf,wake_dens,cdragh_x,cdragh_w,       &
-       cdragm_x,cdragm_w,kh,kh_x,kh_w,                &
-!!!
-       zcoefh,    zcoefm,    slab_wfbils,             &
-       qsol,    zq2m,      s_pblh,   s_plcl,        &
-!!!
-!!! jyg le 08/02/2012
-       s_pblh_x, s_plcl_x,   s_pblh_w, s_plcl_w,      &
-!!!
-       s_capCL,   s_oliqCL,  s_cteiCL, s_pblT,        &
-       s_therm,   s_trmb1,   s_trmb2,  s_trmb3,       &
-       zustar,zu10m,  zv10m,    fder_print,    &
-       zxqsurf, delta_qsurf,                       &
-       rh2m,      zxfluxu,  zxfluxv,               &
-       z0m, z0h,   agesno,  sollw,    solsw,         &
-       d_ts,      evap,    fluxlat,   t2m,           &
-       wfbils,    wfevap,                           & 
-       flux_t,   flux_u, flux_v,                    &
-       dflux_t,   dflux_q,   zxsnow,                  &
-!jyg<
-!!       zxfluxt,   zxfluxq,   q2m,      flux_q, tke,   &
-       zxfluxt,   zxfluxq, zxfluxqbs,   q2m, flux_q, flux_qbs, tke_x, eps_x, &
-!>jyg
-!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
-!!        tke_x,     tke_w                              &
-       wake_dltke,                                     &
-        treedrg                                   &
-!FC
-!!!
-#ifdef ISO
-     &   ,xtrain_f, xtsnow_f,xt, &
-     &   wake_dlxt,zxxtevap,xtevap, &
-     &   d_xt,d_xt_w,d_xt_x, &
-     &   xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, &
-     &   h1_diag,runoff_diag,xtrunoff_diag &
-#endif      
-     &   )
-!****************************************************************************************
-! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-! Objet: interface de "couche limite" (diffusion verticale)
-!
-!AA REM:
-!AA-----
-!AA Tout ce qui a trait au traceurs est dans phytrac maintenant
-!AA pour l'instant le calcul de la couche limite pour les traceurs
-!AA se fait avec cltrac et ne tient pas compte de la differentiation
-!AA des sous-fraction de sol.
-!AA REM bis :
-!AA----------
-!AA Pour pouvoir extraire les coefficient d'echanges et le vent 
-!AA dans la premiere couche, 3 champs supplementaires ont ete crees
-!AA zcoefh, zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
-!AA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir 
-!AA si les informations des subsurfaces doivent etre prises en compte
-!AA il faudra sortir ces memes champs en leur ajoutant une dimension, 
-!AA c'est a dire nbsrf (nbre de subsurface).
-!
-! Arguments:
-!
-! dtime----input-R- interval du temps (secondes)
-! itap-----input-I- numero du pas de temps
-! date0----input-R- jour initial
-! t--------input-R- temperature (K)
-! q--------input-R- vapeur d'eau (kg/kg)
-! u--------input-R- vitesse u
-! v--------input-R- vitesse v
-! wake_dlt-input-R- temperatre difference between (w) and (x) (K)
-! wake_dlq-input-R- humidity difference between (w) and (x) (kg/kg)
-!wake_cstar-input-R- wake gust front speed (m/s)
-! wake_s---input-R- wake fractionnal area
-! ts-------input-R- temperature du sol (en Kelvin)
-! paprs----input-R- pression a intercouche (Pa)
-! pplay----input-R- pression au milieu de couche (Pa)
-! rlat-----input-R- latitude en degree
-! z0m, z0h ----input-R- longeur de rugosite (en m)
-! Martin
-! cldt-----input-R- total cloud fraction
-! Martin
-!
-! d_t------output-R- le changement pour "t"
-! d_q------output-R- le changement pour "q"
-! d_u------output-R- le changement pour "u"
-! d_v------output-R- le changement pour "v"
-! d_ts-----output-R- le changement pour "ts"
-! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
-!                    (orientation positive vers le bas)
-! tke_x---input/output-R- tke in the (x) region (kg/m**2/s)
-! wake_dltke-input/output-R- tke difference between (w) and (x) (kg/m**2/s)
-! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
-! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
-! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
-! dflux_t--output-R- derive du flux sensible
-! dflux_q--output-R- derive du flux latent
-! zu1------output-R- le vent dans la premiere couche
-! zv1------output-R- le vent dans la premiere couche
-! trmb1----output-R- deep_cape
-! trmb2----output-R- inhibition 
-! trmb3----output-R- Point Omega
-! cteiCL---output-R- Critere d'instab d'entrainmt des nuages de CL
-! plcl-----output-R- Niveau de condensation
-! pblh-----output-R- HCL
-! pblT-----output-R- T au nveau HCL
-! treedrg--output-R- tree drag (m)               
-!
-    USE carbon_cycle_mod,   ONLY : carbon_cycle_cpl, carbon_cycle_tr, level_coupling_esm 
-    USE carbon_cycle_mod,   ONLY : co2_send, nbcf_out, fields_out, yfields_out, cfname_out
-    use hbtm_mod, only: hbtm
-    USE indice_sol_mod
-    USE time_phylmdz_mod,   ONLY : day_ini,annee_ref,itau_phy
-    USE mod_grid_phy_lmdz,  ONLY : nbp_lon, nbp_lat, grid1dto2d_glo
-    USE print_control_mod,  ONLY : prt_level,lunout
-#ifdef ISO
-  USE isotopes_mod, ONLY: Rdefault,iso_eau
-#ifdef ISOVERIF
-        USE isotopes_verif_mod
-#endif
-#ifdef ISOTRAC
-        USE isotrac_mod, only: index_iso
-#endif
-#endif
-    USE ioipsl_getin_p_mod, ONLY : getin_p
-    use phys_state_var_mod, only: ds_ns, dt_ns, delta_sst, delta_sal, dter, &
-         dser, dt_ds, zsig, zmea
-    use phys_output_var_mod, only: tkt, tks, taur, sss
-    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
-
-    INCLUDE "dimsoil.h"
-    INCLUDE "YOMCST.h"
-    INCLUDE "YOETHF.h"
-    INCLUDE "FCTTRE.h"
-    INCLUDE "clesphys.h"
-    INCLUDE "compbl.h"
-    INCLUDE "flux_arp.h"
-!FC 
-    INCLUDE "dimpft.h"
-
-!****************************************************************************************
-    REAL,                         INTENT(IN)        :: dtime   ! time interval (s)
-    REAL,                         INTENT(IN)        :: date0   ! initial day
-    INTEGER,                      INTENT(IN)        :: itap    ! time step
-    INTEGER,                      INTENT(IN)        :: jour    ! current day of the year
-    LOGICAL,                      INTENT(IN)        :: debut   ! true if first run step
-    LOGICAL,                      INTENT(IN)        :: lafin   ! true if last run step
-    REAL, DIMENSION(klon),        INTENT(IN)        :: rlon    ! longitudes in degrees
-    REAL, DIMENSION(klon),        INTENT(IN)        :: rlat    ! latitudes in degrees
-    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(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
-    REAL, DIMENSION(klon),        INTENT(IN)        :: sollw_m ! net longwave radiation at mean surface
-    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
-    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: pplay   ! mid-layer pression (Pa)
-    REAL, DIMENSION(klon,klev+1), INTENT(IN)        :: paprs   ! pression between layers (Pa) 
-    REAL, DIMENSION(klon, nbsrf), INTENT(IN)        :: pctsrf  ! sub-surface fraction
-! Martin
-    REAL, DIMENSION(klon),        INTENT(IN)        :: lwdown_m ! downward longwave radiation at mean s    
-    REAL, DIMENSION(klon),        INTENT(IN)        :: gustiness ! gustiness
-
-    REAL, DIMENSION(klon),        INTENT(IN)        :: cldt    ! total cloud fraction
-
-#ifdef ISO
-    REAL, DIMENSION(ntraciso,klon,klev),   INTENT(IN)        :: xt       ! water vapour (kg/kg)
-    REAL, DIMENSION(ntraciso,klon),        INTENT(IN)        :: xtrain_f  ! rain fall
-    REAL, DIMENSION(ntraciso,klon),        INTENT(IN)        :: xtsnow_f  ! snow fall
-#endif
-
-!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
-!!    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: t_x       ! Temp\'erature hors poche froide
-!!    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: t_w       ! Temp\'erature dans la poches froide
-!!    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: q_x       ! 
-!!    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: q_w       ! Pareil pour l'humidit\'e
-    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: wake_dlt  !temperature difference between (w) and (x) (K)
-    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: wake_dlq  !humidity difference between (w) and (x) (K)
-    REAL, DIMENSION(klon),        INTENT(IN)        :: wake_s    ! Fraction de poches froides
-    REAL, DIMENSION(klon),        INTENT(IN)        :: wake_cstar! Vitesse d'expansion des poches froides
-    REAL, DIMENSION(klon),        INTENT(IN)        :: wake_dens
-!!!
-#ifdef ISO
-    REAL, DIMENSION(ntraciso,klon,klev),   INTENT(IN)        :: wake_dlxt   
-#endif
-! Input/Output variables
-!****************************************************************************************
-!jyg<
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: beta    ! Aridity factor
-!>jyg
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: ts      ! temperature at surface (K)
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: delta_tsurf !surface temperature difference between
-                                                                   !wake and off-wake regions
-!albedo SB >>>
-    REAL, DIMENSIOn(6),intent(in) :: SFRWL
-    REAL, DIMENSION(klon, nsw, nbsrf), INTENT(INOUT)     :: alb_dir,alb_dif
-!albedo SB <<<
-!jyg Pourquoi ustar et wstar sont-elles INOUT ?
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: ustar   ! u* (m/s)
-    REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT)   :: wstar   ! w* (m/s)
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: u10m    ! u speed at 10m
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: v10m    ! v speed at 10m
-!jyg<
-!!    REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke
-    REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke_x
-!>jyg 
-
-!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
-    REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: wake_dltke ! TKE_w - TKE_x
-!!!
-
-! Output variables
-!****************************************************************************************
-    REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(OUT)   :: eps_x      ! TKE dissipation rate
-
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: cdragh     ! drag coefficient for T and Q
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: cdragm     ! drag coefficient for wind
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: zu1        ! u wind speed in first layer
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: zv1        ! v wind speed in first layer
-!albedo SB >>>
-    REAL, DIMENSION(klon, nsw),   INTENT(OUT)       :: alb_dir_m,alb_dif_m
-!albedo SB <<<
-    ! Martin
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: alb3_lic
-    ! Martin
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxsens     ! sensible heat flux at surface with inversed sign 
-                                                                  ! (=> 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 ???
-    REAL, DIMENSION(klon,klev),   INTENT(OUT)       :: d_t_w      !   !
-    REAL, DIMENSION(klon,klev),   INTENT(OUT)       :: d_q_w      !      !  Tendances dans les poches
-    REAL, DIMENSION(klon,klev),   INTENT(OUT)       :: d_t_x      !   !
-    REAL, DIMENSION(klon,klev),   INTENT(OUT)       :: d_q_x      !      !  Tendances hors des poches
-!!! jyg
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxfluxlat  ! latent flux, mean for each grid point
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: zt2m       ! temperature at 2m, mean for each grid point
-    INTEGER, DIMENSION(klon, 6),  INTENT(OUT)       :: zn2mout    ! number of times the 2m temperature is out of the [tsol,temp]
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: qsat2m
-    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_t        ! change in temperature 
-    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_t_diss       ! change in temperature 
-    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_q        ! change in water vapour
-    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)
-    ! coef for turbulent diffusion of T and Q, mean for each grid point
-
-    REAL, INTENT(OUT):: zcoefm(:, :, :) ! (klon, klev, nbsrf + 1)
-    ! coef for turbulent diffusion of U and V (?), mean for each grid point
-#ifdef ISO
-    REAL, DIMENSION(ntraciso,klon),        INTENT(OUT)       :: zxxtevap     ! water vapour flux at surface, positiv upwards
-    REAL, DIMENSION(ntraciso,klon, klev),  INTENT(OUT)       :: d_xt        ! change in water vapour
-    REAL, DIMENSION(klon),  INTENT(OUT)       :: runoff_diag
-    REAL, DIMENSION(niso,klon),  INTENT(OUT)       :: xtrunoff_diag
-    REAL, DIMENSION(ntraciso,klon,klev),   INTENT(OUT)       :: d_xt_w
-    REAL, DIMENSION(ntraciso,klon,klev),   INTENT(OUT)       :: d_xt_x
-#endif
-
-!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxsens_x   ! Flux sensible hors poche
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxsens_w   ! Flux sensible dans la poche
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxfluxlat_x! Flux latent hors poche
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxfluxlat_w! Flux latent dans la poche
-!!    REAL, DIMENSION(klon,klev),   INTENT(OUT)       :: d_wake_dlt
-!!    REAL, DIMENSION(klon,klev),   INTENT(OUT)       :: d_wake_dlq
-
-! Output only for diagnostics
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: cdragh_x
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: cdragh_w
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: cdragm_x
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: cdragm_w
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: kh
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: kh_x
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: kh_w
-!!! 
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: slab_wfbils! heat balance at surface only for slab at ocean points
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: qsol     ! water height in the soil (mm)
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: zq2m       ! water vapour at 2m, mean for each grid point
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_pblh     ! height of the planetary boundary layer(HPBL)
-!!! jyg le 08/02/2012
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_pblh_x   ! height of the PBL in the off-wake region
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_pblh_w   ! height of the PBL in the wake region
-!!!
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_plcl     ! condensation level
-!!! jyg le 08/02/2012
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_plcl_x   ! condensation level in the off-wake region
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_plcl_w   ! condensation level in the wake region
-!!!
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_capCL    ! CAPE of PBL
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_oliqCL   ! liquid water intergral of PBL
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_cteiCL   ! cloud top instab. crit. of PBL
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_pblT     ! temperature at PBLH
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_therm    ! thermal virtual temperature excess
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_trmb1    ! deep cape, mean for each grid point
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_trmb2    ! inhibition, mean for each grid point
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_trmb3    ! point Omega, mean for each grid point
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: zustar     ! u*
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: zu10m      ! u speed at 10m, mean for each grid point
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: zv10m      ! v speed at 10m, mean for each grid point
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: fder_print ! fder for printing (=fder(i) + dflux_t(i) + dflux_q(i))
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxqsurf    ! humidity at surface, mean for each grid point
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: delta_qsurf! humidity difference at surface, mean for each grid point
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: rh2m       ! relative humidity at 2m
-    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxu    ! u wind tension, mean for each grid point
-    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxv    ! v wind tension, mean for each grid point
-    REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT)   :: z0m,z0h      ! rugosity length (m)
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: agesno   ! age of snow at surface
-    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: solsw      ! net shortwave radiation at surface 
-    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: sollw      ! net longwave radiation at surface
-    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: d_ts       ! change in temperature at surface
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: evap       ! evaporation at surface
-    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: fluxlat    ! latent flux
-    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: t2m        ! temperature at 2 meter height
-    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: wfbils     ! heat balance at surface
-    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: wfevap     ! water balance (evap) at surface weighted by srf
-    REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_t     ! sensible heat flux (CpT) J/m**2/s (W/m**2)
-                                                                  ! positve orientation downwards
-    REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_u     ! u wind tension (kg m/s)/(m**2 s) or Pascal
-    REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v     ! v wind tension (kg m/s)/(m**2 s) or Pascal
-!FC
-    REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT)  :: treedrg      ! tree drag (m)               
-#ifdef ISO        
-    REAL, DIMENSION(niso,klon),        INTENT(OUT)       :: xtsol     ! water height in the soil (mm)
-    REAL, DIMENSION(ntraciso,klon, nbsrf)       :: xtevap     ! evaporation at surface
-    REAL, DIMENSION(klon), INTENT(OUT)       :: h1_diag ! just diagnostic, not useful
-#endif
-
-
-! Output not needed
-    REAL, DIMENSION(klon),       INTENT(OUT)        :: dflux_t    ! change of sensible heat flux 
-    REAL, DIMENSION(klon),       INTENT(OUT)        :: dflux_q    ! change of water vapour flux
-    REAL, DIMENSION(klon),       INTENT(OUT)        :: zxsnow     ! snow at surface, mean for each grid point
-    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
-    REAL, DIMENSION(niso,klon),       INTENT(OUT)        :: zxxtsnow     ! snow at surface, mean for each grid point
-    REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT)        :: zxfluxxt    ! water vapour flux, mean for each grid point 
-    REAL, DIMENSION(ntraciso,klon, klev, nbsrf), INTENT(OUT) :: flux_xt     ! water vapour flux(latent flux) (kg/m**2/s)  
-#endif
-
-! Martin
-! inlandsis
-    REAL, DIMENSION(klon),       INTENT(OUT)        :: qsnow      ! snow water content
-    REAL, DIMENSION(klon),       INTENT(OUT)        :: snowhgt    ! snow height
-    REAL, DIMENSION(klon),       INTENT(OUT)        :: to_ice     ! snow passed to ice
-    REAL, DIMENSION(klon),       INTENT(OUT)        :: sissnow    ! snow in snow model
-    REAL, DIMENSION(klon),       INTENT(OUT)        :: runoff     ! runoff on land ice
-! Martin
-
-! Local variables with attribute SAVE
-!****************************************************************************************
-    INTEGER, SAVE                            :: nhoridbg, nidbg   ! variables for IOIPSL
-!$OMP THREADPRIVATE(nhoridbg, nidbg)
-    LOGICAL, SAVE                            :: debugindex=.FALSE.
-!$OMP THREADPRIVATE(debugindex)
-    LOGICAL, SAVE                            :: first_call=.TRUE.
-!$OMP THREADPRIVATE(first_call)
-    CHARACTER(len=8), DIMENSION(nbsrf), SAVE :: cl_surf
-!$OMP THREADPRIVATE(cl_surf)
-    REAL, SAVE                               :: beta_land         ! beta for wx_dts
-!$OMP THREADPRIVATE(beta_land)
-
-! Other local variables
-!****************************************************************************************
-! >> PC
-    INTEGER                            :: ierr
-    INTEGER                            :: n 
-! << PC
-    INTEGER                            :: iflag_split, iflag_split_ref 
-    INTEGER                            :: i, k, nsrf 
-    INTEGER                            :: knon, j
-    INTEGER                            :: idayref
-    INTEGER , DIMENSION(klon)          :: ni
-    REAL                               :: yt1_new
-    REAL                               :: zx_alf1, zx_alf2 !valeur ambiante par extrapola
-    REAL                               :: amn, amx
-    REAL                               :: f1 ! fraction de longeurs visibles parmi tout SW intervalle
-    REAL, DIMENSION(klon)              :: r_co2_ppm     ! taux CO2 atmosphere
-    REAL, DIMENSION(klon)              :: yts, yz0m, yz0h, ypct
-    REAL, DIMENSION(klon)              :: yz0h_old
-!albedo SB >>>
-    REAL, DIMENSION(klon)              :: yalb,yalb_vis
-!albedo SB <<<
-    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, ybs_f
-#ifdef ISO
-    REAL, DIMENSION(ntraciso,klon)              :: yxt1
-    REAL, DIMENSION(niso,klon)              :: yxtsnow, yxtsol   
-    REAL, DIMENSION(ntraciso,klon)              :: yxtrain_f, yxtsnow_f 
-    REAL, DIMENSION(klon)  ::  yrunoff_diag
-    REAL, DIMENSION(niso,klon)  ::  yxtrunoff_diag
-    REAL, DIMENSION(niso,klon)              :: yRland_ice    
-#endif
-    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
-#ifdef ISO
-    REAL, DIMENSION(ntraciso,klon)              ::  y_flux_xt1
-    REAL, DIMENSION(ntraciso,klon)              ::  y_dflux_xt
-#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
-    INTEGER, DIMENSION(klon, nbsrf, 6) :: n2mout, n2mout_x, n2mout_w
-    REAL, DIMENSION(klon)              :: yustar
-    REAL, DIMENSION(klon)              :: ywstar
-    REAL, DIMENSION(klon)              :: ywindsp
-    REAL, DIMENSION(klon)              :: yt10m, yq10m
-    REAL, DIMENSION(klon)              :: ypblh
-    REAL, DIMENSION(klon)              :: ylcl
-    REAL, DIMENSION(klon)              :: ycapCL
-    REAL, DIMENSION(klon)              :: yoliqCL
-    REAL, DIMENSION(klon)              :: ycteiCL
-    REAL, DIMENSION(klon)              :: ypblT
-    REAL, DIMENSION(klon)              :: ytherm
-    REAL, DIMENSION(klon)              :: ytrmb1
-    REAL, DIMENSION(klon)              :: ytrmb2
-    REAL, DIMENSION(klon)              :: ytrmb3
-    REAL, DIMENSION(klon)              :: uzon, vmer
-    REAL, DIMENSION(klon)              :: tair1, qair1, tairsol
-    REAL, DIMENSION(klon)              :: psfce, patm
-    REAL, DIMENSION(klon)              :: qairsol, zgeo1, speed, zri1, pref !speed, zri1, pref, added by Fuxing WANG, 04/03/2015
-    REAL, DIMENSION(klon)              :: yz0h_oupas
-    REAL, DIMENSION(klon)              :: yfluxsens
-    REAL, DIMENSION(klon)              :: AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0
-    REAL, DIMENSION(klon)              :: AcoefH, AcoefQ, BcoefH, BcoefQ
-#ifdef ISO
-    REAL, DIMENSION(ntraciso,klon)     :: AcoefXT, BcoefXT
-#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
-!albedo SB >>>
-    REAL, DIMENSION(klon,nsw)          :: yalb_dir_new, yalb_dif_new
-!albedo SB <<<
-    REAL, DIMENSION(klon)              :: ztsol
-    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, y_d_qbs
-    REAL, DIMENSION(klon,klev)         :: y_d_u, y_d_v
-    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, ycoefqbs
-    REAL, DIMENSION(klon)              :: ycdragh, ycdragq, ycdragm
-    REAL, DIMENSION(klon,klev)         :: yu, yv
-    REAL, DIMENSION(klon,klev)         :: yt, yq, yqbs
-#ifdef ISO
-    REAL, DIMENSION(ntraciso,klon)              :: yxtevap
-    REAL, DIMENSION(ntraciso,klon,klev)              :: y_d_xt
-    REAL, DIMENSION(ntraciso,klon,klev)         ::  y_flux_xt
-    REAL, DIMENSION(ntraciso,klon,klev)              :: yxt   
-#endif
-    REAL, DIMENSION(klon,klev)         :: ypplay, ydelp
-    REAL, DIMENSION(klon,klev)         :: delp
-    REAL, DIMENSION(klon,klev+1)       :: ypaprs
-    REAL, DIMENSION(klon,klev+1)       :: ytke, yeps
-    REAL, DIMENSION(klon,nsoilmx)      :: ytsoil
-!FC 
-    REAL, DIMENSION(klon,nvm_lmdz)          :: yveget
-    REAL, DIMENSION(klon,nvm_lmdz)          :: ylai
-    REAL, DIMENSION(klon,nvm_lmdz)          :: yheight
-    REAL, DIMENSION(klon,klev)              :: y_d_u_frein
-    REAL, DIMENSION(klon,klev)              :: y_d_v_frein
-    REAL, DIMENSION(klon,klev)              :: y_treedrg
-!FC
-
-    CHARACTER(len=80)                  :: abort_message
-    CHARACTER(len=20)                  :: modname = 'pbl_surface'
-    LOGICAL, PARAMETER                 :: zxli=.FALSE. ! utiliser un jeu de fonctions simples
-    LOGICAL, PARAMETER                 :: check=.FALSE.
-
-!!! nrlmd le 02/05/2011
-!!! jyg le 07/02/2012
-    REAL, DIMENSION(klon)              :: ywake_s, ywake_cstar, ywake_dens
-!!!
-    REAL, DIMENSION(klon,klev+1)       :: ytke_x, ytke_w, yeps_x, yeps_w
-    REAL, DIMENSION(klon,klev+1)       :: ywake_dltke
-    REAL, DIMENSION(klon,klev)         :: yu_x, yv_x, yu_w, yv_w
-    REAL, DIMENSION(klon,klev)         :: yt_x, yq_x, yt_w, yq_w
-    REAL, DIMENSION(klon,klev)         :: ycoefh_x, ycoefm_x, ycoefh_w, ycoefm_w
-    REAL, DIMENSION(klon,klev)         :: ycoefq_x, ycoefq_w
-    REAL, DIMENSION(klon)              :: ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w
-    REAL, DIMENSION(klon)              :: ycdragm_x, ycdragm_w
-    REAL, DIMENSION(klon)              :: AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x
-    REAL, DIMENSION(klon)              :: AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w
-    REAL, DIMENSION(klon)              :: AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x
-    REAL, DIMENSION(klon)              :: AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w
-    REAL, DIMENSION(klon)              :: y_flux_t1_x, y_flux_q1_x, y_flux_t1_w, y_flux_q1_w
-    REAL, DIMENSION(klon)              :: y_flux_u1_x, y_flux_v1_x, y_flux_u1_w, y_flux_v1_w
-    REAL, DIMENSION(klon,klev)         :: y_flux_t_x, y_flux_q_x, y_flux_t_w, y_flux_q_w
-    REAL, DIMENSION(klon,klev)         :: y_flux_u_x, y_flux_v_x, y_flux_u_w, y_flux_v_w
-    REAL, DIMENSION(klon)              :: yfluxlat_x, yfluxlat_w
-    REAL, DIMENSION(klon,klev)         :: y_d_t_x, y_d_q_x, y_d_t_w, y_d_q_w
-    REAL, DIMENSION(klon,klev)         :: y_d_t_diss_x, y_d_t_diss_w
-    REAL, DIMENSION(klon,klev)         :: d_t_diss_x, d_t_diss_w
-    REAL, DIMENSION(klon,klev)         :: y_d_u_x, y_d_v_x, y_d_u_w, y_d_v_w
-    REAL, DIMENSION(klon, klev, nbsrf) :: flux_t_x, flux_q_x, flux_t_w, flux_q_w
-    REAL, DIMENSION(klon, klev, nbsrf) :: flux_u_x, flux_v_x, flux_u_w, flux_v_w
-    REAL, DIMENSION(klon, nbsrf)       :: fluxlat_x, fluxlat_w
-    REAL, DIMENSION(klon, klev)        :: zxfluxt_x, zxfluxq_x, zxfluxt_w, zxfluxq_w
-    REAL, DIMENSION(klon, klev)        :: zxfluxu_x, zxfluxv_x, zxfluxu_w, zxfluxv_w
-    REAL                               :: zx_qs_surf, zcor_surf, zdelta_surf
-!jyg<
-    REAL, DIMENSION(klon)              :: ybeta
-    REAL, DIMENSION(klon)              :: ybeta_prev
-!>jyg
-    REAL, DIMENSION(klon, klev)        :: d_u_x
-    REAL, DIMENSION(klon, klev)        :: d_u_w
-    REAL, DIMENSION(klon, klev)        :: d_v_x
-    REAL, DIMENSION(klon, klev)        :: d_v_w 
-
-    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
-    REAL, DIMENSION(klon,klev)         :: CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x
-    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
-    REAL, DIMENSION(klon)              :: alf_1, alf_2, alf_1_x, alf_2_x, alf_1_w, alf_2_w
-#ifdef ISO
-    REAL, DIMENSION(ntraciso,klon,klev)         :: yxt_x, yxt_w
-    REAL, DIMENSION(ntraciso,klon)              :: y_flux_xt1_x , y_flux_xt1_w   
-    REAL, DIMENSION(ntraciso,klon,klev)         :: y_flux_xt_x,y_d_xt_x,zxfluxxt_x
-    REAL, DIMENSION(ntraciso,klon,klev)         :: y_flux_xt_w,y_d_xt_w,zxfluxxt_w
-    REAL, DIMENSION(ntraciso,klon,klev,nbsrf)   :: flux_xt_x, flux_xt_w
-    REAL, DIMENSION(ntraciso,klon)              :: AcoefXT_x, BcoefXT_x
-    REAL, DIMENSION(ntraciso,klon)              :: AcoefXT_w, BcoefXT_w
-    REAL, DIMENSION(ntraciso,klon,klev)         :: CcoefXT, DcoefXT
-    REAL, DIMENSION(ntraciso,klon,klev)         :: CcoefXT_x, DcoefXT_x
-    REAL, DIMENSION(ntraciso,klon,klev)         :: CcoefXT_w, DcoefXT_w
-    REAL, DIMENSION(ntraciso,klon,klev)         :: gama_xt,gama_xt_x,gama_xt_w
-#endif
-!!!
-!!!jyg le 08/02/2012
-    REAL, DIMENSION(klon, nbsrf)       :: windsp
-!
-    REAL, DIMENSION(klon, nbsrf)       :: t2m_x
-    REAL, DIMENSION(klon, nbsrf)       :: q2m_x
-    REAL, DIMENSION(klon)              :: rh2m_x
-    REAL, DIMENSION(klon)              :: qsat2m_x
-    REAL, DIMENSION(klon, nbsrf)       :: u10m_x
-    REAL, DIMENSION(klon, nbsrf)       :: v10m_x
-    REAL, DIMENSION(klon, nbsrf)       :: ustar_x
-    REAL, DIMENSION(klon, nbsrf)       :: wstar_x
-!              
-    REAL, DIMENSION(klon, nbsrf)       :: pblh_x
-    REAL, DIMENSION(klon, nbsrf)       :: plcl_x
-    REAL, DIMENSION(klon, nbsrf)       :: capCL_x
-    REAL, DIMENSION(klon, nbsrf)       :: oliqCL_x
-    REAL, DIMENSION(klon, nbsrf)       :: cteiCL_x
-    REAL, DIMENSION(klon, nbsrf)       :: pblt_x
-    REAL, DIMENSION(klon, nbsrf)       :: therm_x
-    REAL, DIMENSION(klon, nbsrf)       :: trmb1_x
-    REAL, DIMENSION(klon, nbsrf)       :: trmb2_x
-    REAL, DIMENSION(klon, nbsrf)       :: trmb3_x
-!
-    REAL, DIMENSION(klon, nbsrf)       :: t2m_w
-    REAL, DIMENSION(klon, nbsrf)       :: q2m_w
-    REAL, DIMENSION(klon)              :: rh2m_w
-    REAL, DIMENSION(klon)              :: qsat2m_w
-    REAL, DIMENSION(klon, nbsrf)       :: u10m_w
-    REAL, DIMENSION(klon, nbsrf)       :: v10m_w
-    REAL, DIMENSION(klon, nbsrf)       :: ustar_w
-    REAL, DIMENSION(klon, nbsrf)       :: wstar_w
-!                           
-    REAL, DIMENSION(klon, nbsrf)       :: pblh_w
-    REAL, DIMENSION(klon, nbsrf)       :: plcl_w
-    REAL, DIMENSION(klon, nbsrf)       :: capCL_w
-    REAL, DIMENSION(klon, nbsrf)       :: oliqCL_w
-    REAL, DIMENSION(klon, nbsrf)       :: cteiCL_w
-    REAL, DIMENSION(klon, nbsrf)       :: pblt_w
-    REAL, DIMENSION(klon, nbsrf)       :: therm_w
-    REAL, DIMENSION(klon, nbsrf)       :: trmb1_w
-    REAL, DIMENSION(klon, nbsrf)       :: trmb2_w
-    REAL, DIMENSION(klon, nbsrf)       :: trmb3_w
-!
-    REAL, DIMENSION(klon)       :: yt2m_x
-    REAL, DIMENSION(klon)       :: yq2m_x
-    REAL, DIMENSION(klon)       :: yt10m_x
-    REAL, DIMENSION(klon)       :: yq10m_x
-    REAL, DIMENSION(klon)       :: yu10m_x
-    REAL, DIMENSION(klon)       :: yv10m_x
-    REAL, DIMENSION(klon)       :: yustar_x
-    REAL, DIMENSION(klon)       :: ywstar_x
-!              
-    REAL, DIMENSION(klon)       :: ypblh_x
-    REAL, DIMENSION(klon)       :: ylcl_x
-    REAL, DIMENSION(klon)       :: ycapCL_x
-    REAL, DIMENSION(klon)       :: yoliqCL_x
-    REAL, DIMENSION(klon)       :: ycteiCL_x
-    REAL, DIMENSION(klon)       :: ypblt_x
-    REAL, DIMENSION(klon)       :: ytherm_x
-    REAL, DIMENSION(klon)       :: ytrmb1_x
-    REAL, DIMENSION(klon)       :: ytrmb2_x
-    REAL, DIMENSION(klon)       :: ytrmb3_x
-!
-    REAL, DIMENSION(klon)       :: yt2m_w
-    REAL, DIMENSION(klon)       :: yq2m_w
-    REAL, DIMENSION(klon)       :: yt10m_w
-    REAL, DIMENSION(klon)       :: yq10m_w
-    REAL, DIMENSION(klon)       :: yu10m_w
-    REAL, DIMENSION(klon)       :: yv10m_w
-    REAL, DIMENSION(klon)       :: yustar_w
-    REAL, DIMENSION(klon)       :: ywstar_w
-!                       
-    REAL, DIMENSION(klon)       :: ypblh_w
-    REAL, DIMENSION(klon)       :: ylcl_w
-    REAL, DIMENSION(klon)       :: ycapCL_w
-    REAL, DIMENSION(klon)       :: yoliqCL_w
-    REAL, DIMENSION(klon)       :: ycteiCL_w
-    REAL, DIMENSION(klon)       :: ypblt_w
-    REAL, DIMENSION(klon)       :: ytherm_w
-    REAL, DIMENSION(klon)       :: ytrmb1_w
-    REAL, DIMENSION(klon)       :: ytrmb2_w
-    REAL, DIMENSION(klon)       :: ytrmb3_w
-!
-    REAL, DIMENSION(klon)       :: uzon_x, vmer_x, speed_x, zri1_x, pref_x !speed_x, zri1_x, pref_x, added by Fuxing WANG, 04/03/2015
-    REAL, DIMENSION(klon)       :: zgeo1_x, tair1_x, qair1_x, tairsol_x
-!
-    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
-!jyg<
-!!    REAL   ::   dd_Ch
-!!    REAL   ::   dd_Cm
-!!    REAL   ::   dd_Kh
-!!    REAL   ::   dd_Km
-!!    REAL   ::   dd_u 
-!!    REAL   ::   dd_v 
-!!    REAL   ::   dd_t 
-!!    REAL   ::   dd_q 
-!!    REAL   ::   dd_AH
-!!    REAL   ::   dd_AQ
-!!    REAL   ::   dd_AU
-!!    REAL   ::   dd_AV
-!!    REAL   ::   dd_BH
-!!    REAL   ::   dd_BQ
-!!    REAL   ::   dd_BU
-!!    REAL   ::   dd_BV
-!!
-!!    REAL   ::   dd_KHp
-!!    REAL   ::   dd_KQp
-!!    REAL   ::   dd_KUp
-!!    REAL   ::   dd_KVp
-!>jyg
-
-!!!
-!!! nrlmd le 13/06/2011
-    REAL, DIMENSION(klon)              :: y_delta_flux_t1, y_delta_flux_q1, y_delta_flux_u1, y_delta_flux_v1
-    REAL, DIMENSION(klon)              :: y_delta_tsurf, y_delta_tsurf_new
-    REAL, DIMENSION(klon)              :: delta_coef, tau_eq
-    REAL, DIMENSION(klon)              :: HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn
-    REAL, DIMENSION(klon)              :: phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0
-    REAL, DIMENSION(klon)              :: y_delta_qsurf
-    REAL, DIMENSION(klon)              :: y_delta_qsats
-    REAL, DIMENSION(klon)              :: yg_T, yg_Q
-    REAL, DIMENSION(klon)              :: yGamma_dTs_phiT, yGamma_dQs_phiQ
-    REAL, DIMENSION(klon)              :: ydTs_ins, ydqs_ins
-!
-    REAL, PARAMETER                    :: facteur=2./sqrt(3.14)
-    REAL, PARAMETER                    :: inertia=2000.
-    REAL, DIMENSION(klon)              :: ydtsurf_th
-    REAL                               :: zdelta_surf_x,zdelta_surf_w,zx_qs_surf_x,zx_qs_surf_w
-    REAL                               :: zcor_surf_x,zcor_surf_w
-    REAL                               :: mod_wind_x, mod_wind_w
-    REAL                               :: rho1
-    REAL, DIMENSION(klon)              :: Kech_h           ! Coefficient d'echange pour l'energie
-    REAL, DIMENSION(klon)              :: Kech_h_x, Kech_h_w 
-    REAL, DIMENSION(klon)              :: Kech_m
-    REAL, DIMENSION(klon)              :: Kech_m_x, Kech_m_w 
-    REAL, DIMENSION(klon)              :: yts_x, yts_w
-    REAL, DIMENSION(klon)              :: yqsatsrf0_x, yqsatsrf0_w
-    REAL, DIMENSION(klon)              :: yqsurf_x, yqsurf_w
-!jyg<
-!!    REAL, DIMENSION(klon)              :: Kech_Hp, Kech_H_xp, Kech_H_wp
-!!    REAL, DIMENSION(klon)              :: Kech_Qp, Kech_Q_xp, Kech_Q_wp
-!!    REAL, DIMENSION(klon)              :: Kech_Up, Kech_U_xp, Kech_U_wp
-!!    REAL, DIMENSION(klon)              :: Kech_Vp, Kech_V_xp, Kech_V_wp
-!>jyg
-
-    REAL                               :: fact_cdrag
-    REAL                               :: z1lay
-
-    REAL                               :: vent
-!
-! For debugging with IOIPSL
-    INTEGER, DIMENSION(nbp_lon*nbp_lat)    :: ndexbg
-    REAL                               :: zjulian
-    REAL, DIMENSION(klon)              :: tabindx
-    REAL, DIMENSION(nbp_lon,nbp_lat)         :: zx_lon, zx_lat
-    REAL, DIMENSION(nbp_lon,nbp_lat)         :: debugtab
-
-
-    REAL, DIMENSION(klon,nbsrf)        :: pblh         ! height of the planetary boundary layer
-    REAL, DIMENSION(klon,nbsrf)        :: plcl         ! condensation level
-    REAL, DIMENSION(klon,nbsrf)        :: capCL
-    REAL, DIMENSION(klon,nbsrf)        :: oliqCL
-    REAL, DIMENSION(klon,nbsrf)        :: cteiCL
-    REAL, DIMENSION(klon,nbsrf)        :: pblT
-    REAL, DIMENSION(klon,nbsrf)        :: therm
-    REAL, DIMENSION(klon,nbsrf)        :: trmb1        ! deep cape
-    REAL, DIMENSION(klon,nbsrf)        :: trmb2        ! inhibition
-    REAL, DIMENSION(klon,nbsrf)        :: trmb3        ! point Omega
-    REAL, DIMENSION(klon,nbsrf)        :: zx_rh2m, zx_qsat2m
-    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)
-
-    REAL                               :: zx_qs1, zcor1, zdelta1 
-
-    ! Martin
-    REAL, DIMENSION(klon, nbsrf)       :: sollwd ! net longwave radiation at surface
-    REAL, DIMENSION(klon)              :: ytoice
-    REAL, DIMENSION(klon)              :: ysnowhgt, yqsnow, ysissnow, yrunoff
-    REAL, DIMENSION(klon)              :: yzmea
-    REAL, DIMENSION(klon)              :: yzsig
-    REAL, DIMENSION(klon)              :: ycldt
-    REAL, DIMENSION(klon)              :: yrmu0
-    ! Martin
-    REAL, DIMENSION(klon)              :: yri0
-    REAL, DIMENSION(klon):: ydelta_sst, ydelta_sal, yds_ns, ydt_ns, ydter, &
-         ydser, ydt_ds, ytkt, ytks, ytaur, ysss
-    ! 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
-    integer ixt
-!#ifdef ISOVERIF
-!    integer iso_verif_positif_nostop
-!#endif    
-#endif
-
-!****************************************************************************************
-! 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)
-!!jyg      iflag_split = mod(iflag_pbl_split,10)
-!
-! Flags controlling the splitting of the turbulent boundary layer:
-!   iflag_split_ref = 0  ==> no splitting
-!                   = 1  ==> splitting without coupling with surface temperature
-!                   = 2  ==> splitting with coupling with surface temperature over land
-!                   = 3  ==> splitting over ocean; no splitting over land
-!   iflag_split: actual flag controlling the splitting.
-!   iflag_split = iflag_split_ref outside the sub-surface loop
-!               = iflag_split_ref if iflag_split_ref = 0, 1, or 2
-!               = 0 over land  if iflga_split_ref = 3
-!               = 1 over ocean if iflga_split_ref = 3
-
-      iflag_split_ref = mod(iflag_pbl_split,10)
-      iflag_split = iflag_split_ref
-
-#ifdef ISO      
-#ifdef ISOVERIF
-      do i=1,klon
-       do ixt=1,niso
-       call iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 608')
-       enddo
-      enddo
-#endif
-#ifdef ISOVERIF
-      do i=1,klon  
-       if (iso_eau.gt.0) then  
-          call iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
-     &         'pbl_surf_mod 585',errmax,errmaxrel)
-          call iso_verif_egalite_choix(xtsnow_f(iso_eau,i),snow_f(i), &
-     &         'pbl_surf_mod 594',errmax,errmaxrel)
-          if (iso_verif_egalite_choix_nostop(xtsol(iso_eau,i),qsol(i), &
-     &         'pbl_surf_mod 596',errmax,errmaxrel).eq.1) then
-                write(*,*) 'i=',i
-                stop
-          endif
-          do nsrf=1,nbsrf
-            call iso_verif_egalite_choix(xtsnow(iso_eau,i,nsrf),snow(i,nsrf), &
-     &         'pbl_surf_mod 598',errmax,errmaxrel)
-          enddo
-       endif !if (iso_eau.gt.0) then   
-      enddo !do i=1,knon  
-      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), &
-     &         'pbl_surf_mod 595',errmax,errmaxrel)
-        endif !if (iso_eau.gt.0) then   
-       enddo !do i=1,knon  
-      enddo !do k=1,klev
-#endif
-#endif
-
-
-!****************************************************************************************
-! 1) Initialisation and validation tests 
-!    Only done first time entering this subroutine
-!
-!****************************************************************************************
-
-    IF (first_call) THEN
-
-       iflag_new_t2mq2m=1
-       CALL getin_p('iflag_new_t2mq2m',iflag_new_t2mq2m)
-       WRITE(lunout,*) 'pbl_iflag_new_t2mq2m=',iflag_new_t2mq2m
-
-       print*,'PBL SURFACE AVEC GUSTINESS'
-       first_call=.FALSE.
-      
-       ! Initialize ok_flux_surf (for 1D model)
-       IF (klon_glo>1) ok_flux_surf=.FALSE.
-       IF (klon_glo>1) ok_forc_tsurf=.FALSE.
-
-       ! intialize beta_land
-       beta_land = 0.5
-       call getin_p('beta_land', beta_land)
-       
-       ! Initilize debug IO
-       IF (debugindex .AND. mpi_size==1) THEN 
-          ! initialize IOIPSL output
-          idayref = day_ini
-          CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
-          CALL grid1dTo2d_glo(rlon,zx_lon)
-          DO i = 1, nbp_lon
-             zx_lon(i,1) = rlon(i+1)
-             zx_lon(i,nbp_lat) = rlon(i+1)
-          ENDDO
-          CALL grid1dTo2d_glo(rlat,zx_lat)
-          CALL histbeg("sous_index",nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:), &
-               1,nbp_lon,1,nbp_lat, &
-               itau_phy,zjulian,dtime,nhoridbg,nidbg) 
-          ! no vertical axis
-          cl_surf(1)='ter'
-          cl_surf(2)='lic'
-          cl_surf(3)='oce'
-          cl_surf(4)='sic'
-          DO nsrf=1,nbsrf
-             CALL histdef(nidbg, cl_surf(nsrf),cl_surf(nsrf), "-",nbp_lon, &
-                  nbp_lat,nhoridbg, 1, 1, 1, -99, 32, "inst", dtime,dtime) 
-          ENDDO
-
-          CALL histend(nidbg)
-          CALL histsync(nidbg)
-
-       ENDIF
-       
-    ENDIF
-          
-!****************************************************************************************
-! Force soil water content to qsol0 if qsol0>0 and VEGET=F (use bucket
-! instead of ORCHIDEE)
-    IF (qsol0>=0.) THEN
-      PRINT*,'WARNING : On impose qsol=',qsol0
-      qsol(:)=qsol0
-#ifdef ISO
-      do ixt=1,niso
-        xtsol(ixt,:)=qsol0*Rdefault(ixt)
-      enddo
-#ifdef ISOTRAC      
-      do ixt=1+niso,ntraciso
-        xtsol(ixt,:)=qsol0*Rdefault(index_iso(ixt))
-      enddo
-#endif       
-#endif
-    ENDIF
-!****************************************************************************************
-
-!****************************************************************************************
-! 2) Initialization to zero 
-!****************************************************************************************
-!
-! 2a) Initialization of all argument variables with INTENT(OUT)
-!****************************************************************************************
- cdragh(:)=0. ; cdragm(:)=0.
- zu1(:)=0. ; zv1(:)=0.
-!albedo SB >>>
-  alb_dir_m=0. ; alb_dif_m=0. ; alb3_lic(:)=0.
-!albedo SB <<<
- 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_qbs(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
- zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0.
- zxsens_x(:)=0. ; zxsens_w(:)=0. ; zxfluxlat_x(:)=0. ; zxfluxlat_w(:)=0.
- cdragh_x(:)=0. ; cdragh_w(:)=0. ; cdragm_x(:)=0. ; cdragm_w(:)=0.
- kh(:)=0. ; kh_x(:)=0. ; kh_w(:)=0.
- slab_wfbils(:)=0.
- s_pblh(:)=0. ; s_pblh_x(:)=0. ; s_pblh_w(:)=0.
- s_plcl(:)=0. ; s_plcl_x(:)=0. ; s_plcl_w(:)=0.
- s_capCL(:)=0. ; s_oliqCL(:)=0. ; s_cteiCL(:)=0. ; s_pblT(:)=0.
- s_therm(:)=0.
- s_trmb1(:)=0. ; s_trmb2(:)=0. ; s_trmb3(:)=0.
- zustar(:)=0.
- zu10m(:)=0. ; zv10m(:)=0.
- fder_print(:)=0.
- zxqsurf(:)=0.
- delta_qsurf(:) = 0.
- zxfluxu(:,:)=0. ; zxfluxv(:,:)=0.
- solsw(:,:)=0. ; sollw(:,:)=0.
- d_ts(:,:)=0.
- evap(:,:)=0.
- snowerosion(:,:)=0. 
- fluxlat(:,:)=0.
- wfbils(:,:)=0. ; wfevap(:,:)=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.; zxfluxqbs(:,:)=0.
- qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0.
- runoff(:)=0.
-#ifdef ISO
-zxxtevap(:,:)=0.
- d_xt(:,:,:)=0. 
- d_xt_x(:,:,:)=0.
- d_xt_w(:,:,:)=0.
- flux_xt(:,:,:,:)=0. 
-! xtsnow(:,:,:)=0.! attention, xtsnow est l'équivalent de snow et non de qsnow
- xtevap(:,:,:)=0.
-#endif
-    IF (iflag_pbl<20.or.iflag_pbl>=30) THEN
-       zcoefh(:,:,:) = 0.0
-       zcoefh(:,1,:) = 999999. ! zcoefh(:,k=1) should never be used
-       zcoefm(:,:,:) = 0.0
-       zcoefm(:,1,:) = 999999. !
-    ELSE
-      zcoefm(:,:,is_ave)=0.
-      zcoefh(:,:,is_ave)=0.
-    ENDIF
-!!
-!  The components "is_ave" of tke_x and wake_deltke are "OUT" variables
-!jyg<
-!!    tke(:,:,is_ave)=0.
-    tke_x(:,:,is_ave)=0.
-    eps_x(:,:,is_ave)=0.
-
-    wake_dltke(:,:,is_ave)=0.
-!>jyg
-!!! jyg le 23/02/2013
-    t2m(:,:)       = 999999.     ! t2m and q2m are meaningfull only over sub-surfaces
-    q2m(:,:)       = 999999.     ! actually present in the grid cell.
-!!!
-    rh2m(:) = 0. ; qsat2m(:) = 0.
-!!!
-!!! jyg le 10/02/2012
-    rh2m_x(:) = 0. ; qsat2m_x(:) = 0. ; rh2m_w(:) = 0. ; qsat2m_w(:) = 0.
-
-! 2b) Initialization of all local variables that will be compressed later
-!****************************************************************************************
-!!    cdragh = 0.0  ; cdragm = 0.0     ; dflux_t = 0.0   ; dflux_q = 0.0
-    ypct = 0.0    ; yts = 0.0        ; ysnow = 0.0
-!!    zv1 = 0.0     ; yqsurf = 0.0
-!albedo SB >>>
-    yqsurf = 0.0  ; yalb = 0.0 ; yalb_vis = 0.0
-!albedo SB <<<
-    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 ; 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 
-    yqsol = 0.0    
-
-    ytke=0.
-    yeps=0.
-    yri0(:)=0.
-!FC 
-    y_treedrg=0.
-
-    ! Martin
-    ysnowhgt = 0.0; yqsnow = 0.0     ; yrunoff = 0.0   ; ytoice =0.0
-    yalb3_new = 0.0  ; ysissnow = 0.0 
-    ycldt = 0.0      ; yrmu0 = 0.0
-    ! Martin
-    y_d_qbs(:,:)=0.0
-
-!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
-    ytke_x=0.     ; ytke_w=0.        ; ywake_dltke=0.
-    yeps_x=0.     ; yeps_w=0.
-    y_d_t_x=0.    ; y_d_t_w=0.       ; y_d_q_x=0.      ; y_d_q_w=0.
-!!    d_t_w=0.      ; d_q_w=0.         
-!!    d_t_x=0.      ; d_q_x=0.
-!!    d_wake_dlt=0.    ; d_wake_dlq=0.
-    yfluxlat_x=0. ; yfluxlat_w=0.
-    ywake_s=0.    ; ywake_cstar=0.   ;ywake_dens=0.
-!!!
-!!! nrlmd le 13/06/2011
-    tau_eq=0.     ; delta_coef=0.
-    y_delta_flux_t1=0.
-    ydtsurf_th=0.
-    yts_x(:)=0.      ; yts_w(:)=0.
-    y_delta_tsurf(:)=0. ; y_delta_qsurf(:)=0.
-    yqsurf_x(:)=0.      ; yqsurf_w(:)=0.
-    yg_T(:) = 0. ;        yg_Q(:) = 0.
-    yGamma_dTs_phiT(:) = 0. ; yGamma_dQs_phiQ(:) = 0.
-    ydTs_ins(:) = 0. ; ydqs_ins(:) = 0.
-
-!!!
-    ytsoil = 999999. 
-!FC
-    y_d_u_frein(:,:)=0.
-    y_d_v_frein(:,:)=0.
-!FC
-
-#ifdef ISO
-   yxtrain_f = 0.0 ; yxtsnow_f = 0.0
-   yxtsnow  = 0.0
-   yxt = 0.0
-   yxtsol = 0.0
-   flux_xt = 0.0
-   yRland_ice = 0.0
-!   d_xt = 0.0      
-   y_dflux_xt = 0.0  
-   dflux_xt=0.0 
-   y_d_xt_x=0.      ; y_d_xt_w=0.       
-#endif 
-
-! >> PC
-!the yfields_out variable is defined in (klon,nbcf_out) even if it is used on
-!the ORCHIDEE grid and as such should be defined in yfields_out(knon,nbcf_out) but
-!the knon variable is not known at that level of pbl_surface_mod
-
-!the yfields_in variable is defined in (klon,nbcf_in) even if it is used on the
-!ORCHIDEE grid and as such should be defined in yfields_in(knon,nbcf_in) but the
-!knon variable is not known at that level of pbl_surface_mod
-
-   yfields_out(:,:) = 0.
-! << PC
-
-
-! 2c) Initialization of all local variables computed within the subsurface loop and used later on
-!****************************************************************************************
-    d_t_diss_x(:,:) = 0. ;        d_t_diss_w(:,:) = 0.
-    d_u_x(:,:)=0. ;               d_u_w(:,:)=0. 
-    d_v_x(:,:)=0. ;               d_v_w(:,:)=0.
-    flux_t_x(:,:,:)=0. ;          flux_t_w(:,:,:)=0. 
-    flux_q_x(:,:,:)=0. ;          flux_q_w(:,:,:)=0.
-!
-!jyg<
-    flux_u_x(:,:,:)=0. ;          flux_u_w(:,:,:)=0.
-    flux_v_x(:,:,:)=0. ;          flux_v_w(:,:,:)=0.
-    fluxlat_x(:,:)=0. ;           fluxlat_w(:,:)=0. 
-!>jyg
-#ifdef ISO
-    flux_xt_x(:,:,:,:)=0. ;          flux_xt_w(:,:,:,:)=0.
-#endif
-!
-!jyg<
-! pblh,plcl,capCL,cteiCL ... are meaningfull only over sub-surfaces
-! actually present in the grid cell  ==> value set to 999999.
-!                           
-!jyg<
-       ustar(:,:)   = 999999.
-       wstar(:,:)   = 999999.
-       windsp(:,:)  = SQRT(u10m(:,:)**2 + v10m(:,:)**2 )
-       u10m(:,:)    = 999999. 
-       v10m(:,:)    = 999999. 
-!>jyg
-!
-       pblh(:,:)   = 999999.        ! Hauteur de couche limite
-       plcl(:,:)   = 999999.        ! Niveau de condensation de la CLA
-       capCL(:,:)  = 999999.        ! CAPE de couche limite
-       oliqCL(:,:) = 999999.        ! eau_liqu integree de couche limite
-       cteiCL(:,:) = 999999.        ! cloud top instab. crit. couche limite
-       pblt(:,:)   = 999999.        ! T a la Hauteur de couche limite
-       therm(:,:)  = 999999.
-       trmb1(:,:)  = 999999.        ! deep_cape
-       trmb2(:,:)  = 999999.        ! inhibition 
-       trmb3(:,:)  = 999999.        ! Point Omega
-!
-       t2m_x(:,:)    = 999999. 
-       q2m_x(:,:)    = 999999. 
-       ustar_x(:,:)   = 999999.
-       wstar_x(:,:)   = 999999.
-       u10m_x(:,:)   = 999999. 
-       v10m_x(:,:)   = 999999. 
-!                           
-       pblh_x(:,:)   = 999999.      ! Hauteur de couche limite
-       plcl_x(:,:)   = 999999.      ! Niveau de condensation de la CLA
-       capCL_x(:,:)  = 999999.      ! CAPE de couche limite
-       oliqCL_x(:,:) = 999999.      ! eau_liqu integree de couche limite
-       cteiCL_x(:,:) = 999999.      ! cloud top instab. crit. couche limite
-       pblt_x(:,:)   = 999999.      ! T a la Hauteur de couche limite
-       therm_x(:,:)  = 999999.      
-       trmb1_x(:,:)  = 999999.      ! deep_cape
-       trmb2_x(:,:)  = 999999.      ! inhibition 
-       trmb3_x(:,:)  = 999999.      ! Point Omega
-!
-       t2m_w(:,:)    = 999999. 
-       q2m_w(:,:)    = 999999. 
-       ustar_w(:,:)   = 999999.
-       wstar_w(:,:)   = 999999.
-       u10m_w(:,:)   = 999999. 
-       v10m_w(:,:)   = 999999. 
-                           
-       pblh_w(:,:)   = 999999.      ! Hauteur de couche limite
-       plcl_w(:,:)   = 999999.      ! Niveau de condensation de la CLA
-       capCL_w(:,:)  = 999999.      ! CAPE de couche limite
-       oliqCL_w(:,:) = 999999.      ! eau_liqu integree de couche limite
-       cteiCL_w(:,:) = 999999.      ! cloud top instab. crit. couche limite
-       pblt_w(:,:)   = 999999.      ! T a la Hauteur de couche limite
-       therm_w(:,:)  = 999999.      
-       trmb1_w(:,:)  = 999999.      ! deep_cape
-       trmb2_w(:,:)  = 999999.      ! inhibition 
-       trmb3_w(:,:)  = 999999.      ! Point Omega
-!!!      
-!
-!!!
-!****************************************************************************************
-! 3) - Calculate pressure thickness of each layer
-!    - Calculate the wind at first layer
-!    - Mean calculations of albedo
-!    - Calculate net radiance at sub-surface
-!****************************************************************************************
-    DO k = 1, klev
-       DO i = 1, klon
-          delp(i,k) = paprs(i,k)-paprs(i,k+1)
-       ENDDO
-    ENDDO
-
-!****************************************************************************************
-! Test for rugos........ from physiq.. A la fin plutot???
-!
-!****************************************************************************************
-
-    DO nsrf = 1, nbsrf
-       DO i = 1, klon
-          z0m(i,nsrf) = MAX(z0m(i,nsrf),z0min)
-          z0h(i,nsrf) = MAX(z0h(i,nsrf),z0min)
-       ENDDO
-    ENDDO
-
-! Mean calculations of albedo
-!
-! * alb  : mean albedo for whole SW interval
-!
-! Mean albedo for grid point
-! * alb_m  : mean albedo at whole SW interval
-
-    alb_dir_m(:,:) = 0.0
-    alb_dif_m(:,:) = 0.0
-    DO k = 1, nsw
-     DO nsrf = 1, nbsrf
-       DO i = 1, klon
-          alb_dir_m(i,k) = alb_dir_m(i,k) + alb_dir(i,k,nsrf) * pctsrf(i,nsrf)
-          alb_dif_m(i,k) = alb_dif_m(i,k) + alb_dif(i,k,nsrf) * pctsrf(i,nsrf)
-       ENDDO
-     ENDDO
-    ENDDO
-
-! We here suppose the fraction f1 of incoming radiance of visible radiance 
-! as a fraction of all shortwave radiance 
-    f1 = 0.5
-!    f1 = 1    ! put f1=1 to recreate old calculations
-
-!f1 is already included with SFRWL values in each surf files
-    alb=0.0
-    DO k=1,nsw
-      DO nsrf = 1, nbsrf
-        DO i = 1, klon
-            alb(i,nsrf) = alb(i,nsrf) + alb_dir(i,k,nsrf)*SFRWL(k)
-        ENDDO
-      ENDDO
-    ENDDO
-
-    alb_m=0.0
-    DO k = 1,nsw
-      DO i = 1, klon
-        alb_m(i) = alb_m(i) + alb_dir_m(i,k)*SFRWL(k)
-      ENDDO
-    ENDDO
-!albedo SB <<<
-
-
-
-! Calculation of mean temperature at surface grid points
-    ztsol(:) = 0.0
-    DO nsrf = 1, nbsrf
-       DO i = 1, klon
-          ztsol(i) = ztsol(i) + ts(i,nsrf)*pctsrf(i,nsrf)
-       ENDDO
-    ENDDO
-
-! Linear distrubution on sub-surface of long- and shortwave net radiance
-    DO nsrf = 1, nbsrf
-       DO i = 1, klon
-          sollw(i,nsrf) = sollw_m(i) + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ts(i,nsrf))
-!--OB this line is not satisfactory because alb is the direct albedo not total albedo
-          solsw(i,nsrf) = solsw_m(i) * (1.-alb(i,nsrf)) / (1.-alb_m(i))
-       ENDDO
-    ENDDO
-!
-!<al1: second order corrections
-!- net = dwn -up; up=sig( T4 + 4sum%T3T' + 6sum%T2T'2 +...)
-   IF (iflag_order2_sollw == 1) THEN
-    meansqT(:) = 0. ! as working buffer
-    DO nsrf = 1, nbsrf
-     DO i = 1, klon
-      meansqT(i) = meansqT(i)+(ts(i,nsrf)-ztsol(i))**2 *pctsrf(i,nsrf)
-     ENDDO
-    ENDDO
-    DO nsrf = 1, nbsrf
-     DO i = 1, klon
-      sollw(i,nsrf) = sollw(i,nsrf) &
-                + 6.0*RSIGMA*ztsol(i)**2 *(meansqT(i)-(ztsol(i)-ts(i,nsrf))**2)
-     ENDDO
-    ENDDO
-   ENDIF   ! iflag_order2_sollw == 1
-!>al1
-
-!--OB add diffuse fraction of SW down
-   DO n=1,nbcf_out
-       IF (cfname_out(n) == "swdownfdiff" ) fields_out(:,n) = solswfdiff_m(:)
-   ENDDO
-! >> PC
-   IF (carbon_cycle_cpl .AND. carbon_cycle_tr .AND. nbcf_out.GT.0 ) THEN
-       r_co2_ppm(:) = co2_send(:)
-       DO n=1,nbcf_out
-           IF (cfname_out(n) == "atmco2" ) fields_out(:,n) = co2_send(:)
-       ENDDO
-   ENDIF
-   IF ( .NOT. carbon_cycle_tr .AND. nbcf_out.GT.0 ) THEN
-       r_co2_ppm(:) = co2_ppm     ! Constant field
-       DO n=1,nbcf_out
-           IF (cfname_out(n) == "atmco2" ) fields_out(:,n) = co2_ppm
-       ENDDO
-   ENDIF
-! << PC
-
-!****************************************************************************************
-! 4) Loop over different surfaces
-!
-! Only points containing a fraction of the sub surface will be treated.
-! 
-!****************************************************************************************
-                                                                          !<<<<<<<<<<<<<
-    loop_nbsrf: DO nsrf = 1, nbsrf                                        !<<<<<<<<<<<<<
-                                                                          !<<<<<<<<<<<<<
-       IF (prt_level >=10) print *,' Loop nsrf ',nsrf
-!
-       IF (iflag_split_ref == 3) THEN
-         IF (nsrf == is_oce) THEN
-            iflag_split = 1
-         ELSE
-            iflag_split=0
-         ENDIF   !! (nsrf == is_oce)
-       ELSE                     
-         iflag_split = iflag_split_ref
-       ENDIF   !! (iflag_split_ref == 3)
-
-! Search for index(ni) and size(knon) of domaine to treat
-       ni(:) = 0
-       knon  = 0
-       DO i = 1, klon
-          IF (pctsrf(i,nsrf) > 0.) THEN
-             knon = knon + 1
-             ni(knon) = i
-          ENDIF
-       ENDDO
-
-!!! jyg le 19/08/2012
-!       IF (knon <= 0) THEN
-!         IF (prt_level >= 10) print *,' no grid point for nsrf= ',nsrf
-!         cycle loop_nbsrf
-!       ENDIF
-!!!
-
-       ! write index, with IOIPSL
-       IF (debugindex .AND. mpi_size==1) THEN 
-          tabindx(:)=0.
-          DO i=1,knon
-             tabindx(i)=REAL(i)
-          ENDDO
-          debugtab(:,:) = 0.
-          ndexbg(:) = 0
-          CALL gath2cpl(tabindx,debugtab,knon,ni)
-          CALL histwrite(nidbg,cl_surf(nsrf),itap,debugtab,nbp_lon*nbp_lat, ndexbg)
-       ENDIF
-       
-!****************************************************************************************
-! 5) Compress variables 
-!
-!****************************************************************************************
-
-!
-!jyg<    (20190926)
-!   Provisional : set ybeta to standard values
-       IF (nsrf .NE. is_ter) THEN
-           ybeta(:) = 1.
-       ELSE
-           IF (iflag_split .EQ. 0) THEN
-              ybeta(:) = 1.
-           ELSE
-             DO j = 1, knon
-                i = ni(j)
-                ybeta(j)   = beta(i,nsrf)
-             ENDDO
-           ENDIF  ! (iflag_split .LE.1)
-       ENDIF !  (nsrf .NE. is_ter)
-!>jyg
-!
-       DO j = 1, knon
-          i = ni(j)
-          ypct(j)    = pctsrf(i,nsrf)
-          yts(j)     = ts(i,nsrf)
-          ysnow(j)   = snow(i,nsrf)
-          yqsurf(j)  = qsurf(i,nsrf)
-          yalb(j)    = alb(i,nsrf)
-!albedo SB >>>
-          yalb_vis(j) = alb_dir(i,1,nsrf)
-          IF (nsw==6) THEN
-            yalb_vis(j)=(alb_dir(i,1,nsrf)*SFRWL(1)+alb_dir(i,2,nsrf)*SFRWL(2) &
-              +alb_dir(i,3,nsrf)*SFRWL(3))/(SFRWL(1)+SFRWL(2)+SFRWL(3))
-          ENDIF
-!albedo SB <<<
-          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)
-          ylwdown(j) = lwdown_m(i)
-          ygustiness(j) = gustiness(i)
-          ysolsw(j)  = solsw(i,nsrf)
-          ysollw(j)  = sollw(i,nsrf)
-          yz0m(j)  = z0m(i,nsrf)
-          yz0h(j)  = z0h(i,nsrf)
-          yrugoro(j) = rugoro(i)
-          yu1(j)     = u(i,1)
-          yv1(j)     = v(i,1)
-          yqbs1(j)   = qbs(i,1)
-          ypaprs(j,klev+1) = paprs(i,klev+1)
-!jyg<
-!!          ywindsp(j) = SQRT(u10m(i,nsrf)**2 + v10m(i,nsrf)**2 )
-          ywindsp(j) = windsp(i,nsrf)
-!>jyg
-          ! Martin and Etienne
-          yzmea(j)   = zmea(i)
-          yzsig(j)   = zsig(i)
-          ycldt(j)   = cldt(i)
-          yrmu0(j)   = rmu0(i)
-          ! Martin
-!!! 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
-          do ixt=1,ntraciso
-            yxtrain_f(ixt,j) = xtrain_f(ixt,i)
-            yxtsnow_f(ixt,j) = xtsnow_f(ixt,i)  
-          enddo
-          do ixt=1,niso
-            yxtsnow(ixt,j)   = xtsnow(ixt,i,nsrf)
-          enddo    
-          !IF (nsrf == is_lic) THEN
-            do ixt=1,niso
-              yRland_ice(ixt,j)   = Rland_ice(ixt,i)  
-            enddo    
-          !endif !IF (nsrf == is_lic) THEN
-#ifdef ISOVERIF
-          if (iso_eau.gt.0) then
-              call iso_verif_egalite_choix(ysnow_f(j), &
-     &          yxtsnow_f(iso_eau,j),'pbl_surf_mod 862', &
-     &          errmax,errmaxrel)
-              call iso_verif_egalite_choix(ysnow(j), &
-     &          yxtsnow(iso_eau,j),'pbl_surf_mod 872', &
-     &          errmax,errmaxrel)
-          endif
-#endif
-#ifdef ISOVERIF
-         do ixt=1,ntraciso
-           call iso_verif_noNaN(yxtsnow_f(ixt,j),'pbl_surf_mod 921')
-         enddo
-#endif
-#endif
-       ENDDO
-! >> PC
-!--compressing fields_out onto ORCHIDEE grid
-!--these fields are shared and used directly surf_land_orchidee_mod
-       DO n = 1, nbcf_out
-         DO j = 1, knon
-           i = ni(j)
-           yfields_out(j,n) = fields_out(i,n)
-         ENDDO
-       ENDDO
-! << PC
-       DO k = 1, klev
-          DO j = 1, knon
-             i = ni(j)
-             ypaprs(j,k) = paprs(i,k)
-             ypplay(j,k) = pplay(i,k)
-             ydelp(j,k)  = delp(i,k)
-          ENDDO
-       ENDDO
-!
-!!! jyg le 07/02/2012 et le 10/04/2013
-        DO k = 1, klev+1
-          DO j = 1, knon
-             i = ni(j)
-!jyg<
-!!             ytke(j,k)   = tke(i,k,nsrf)
-             ytke(j,k)   = tke_x(i,k,nsrf)
-          ENDDO
-        ENDDO
-!>jyg
-        DO k = 1, klev
-          DO j = 1, knon
-             i = ni(j)
-             y_treedrg(j,k) =  treedrg(i,k,nsrf)
-             yu(j,k) = u(i,k)
-             yv(j,k) = v(i,k)
-             yt(j,k) = t(i,k)
-             yq(j,k) = q(i,k)
-             yqbs(j,k)=qbs(i,k)
-#ifdef ISO
-             do ixt=1,ntraciso   
-               yxt(ixt,j,k) = xt(ixt,i,k)
-             enddo !do ixt=1,ntraciso
-#endif
-          ENDDO
-        ENDDO
-!
-       IF (iflag_split.GE.1) THEN
-!!! nrlmd le 02/05/2011
-        DO k = 1, klev
-          DO j = 1, knon
-             i = ni(j)
-             yu_x(j,k) = u(i,k)
-             yv_x(j,k) = v(i,k)
-             yt_x(j,k) = t(i,k)-wake_s(i)*wake_dlt(i,k)
-             yq_x(j,k) = q(i,k)-wake_s(i)*wake_dlq(i,k)
-             yu_w(j,k) = u(i,k)
-             yv_w(j,k) = v(i,k)
-             yt_w(j,k) = t(i,k)+(1.-wake_s(i))*wake_dlt(i,k)
-             yq_w(j,k) = q(i,k)+(1.-wake_s(i))*wake_dlq(i,k)
-!!!
-#ifdef ISO
-             do ixt=1,ntraciso
-               yxt_x(ixt,j,k) = xt(ixt,i,k)-wake_s(i)*wake_dlxt(ixt,i,k)
-               yxt_w(ixt,j,k) = xt(ixt,i,k)+(1.-wake_s(i))*wake_dlxt(ixt,i,k)
-             enddo
-#endif
-          ENDDO
-        ENDDO
-
-        IF (prt_level .ge. 10) THEN
-          print *,'pbl_surface, wake_s(1), wake_dlt(1,:) ', wake_s(1), wake_dlt(1,:)
-          print *,'pbl_surface, wake_s(1), wake_dlq(1,:) ', wake_s(1), wake_dlq(1,:)
-        ENDIF
-
-!!! nrlmd le 02/05/2011
-        DO k = 1, klev+1
-          DO j = 1, knon
-             i = ni(j)
-!jyg<
-!!             ytke_x(j,k) = tke(i,k,nsrf)-wake_s(i)*wake_dltke(i,k,nsrf)
-!!             ytke_w(j,k) = tke(i,k,nsrf)+(1.-wake_s(i))*wake_dltke(i,k,nsrf)
-!!             ywake_dltke(j,k) = wake_dltke(i,k,nsrf)
-!!             ytke(j,k)     = tke(i,k,nsrf)
-!
-             ytke_x(j,k)      = tke_x(i,k,nsrf)
-             ytke(j,k)        = tke_x(i,k,nsrf)+wake_s(i)*wake_dltke(i,k,nsrf)
-             ytke_w(j,k)      = tke_x(i,k,nsrf)+wake_dltke(i,k,nsrf)
-             ywake_dltke(j,k) = wake_dltke(i,k,nsrf)
-            
-!>jyg
-          ENDDO
-        ENDDO
-!!!
-!!! jyg le 07/02/2012
-        DO j = 1, knon
-          i = ni(j)
-          ywake_s(j)=wake_s(i)
-          ywake_cstar(j)=wake_cstar(i)
-          ywake_dens(j)=wake_dens(i)
-        ENDDO
-!!!
-!!! nrlmd le 13/06/2011
-        DO j=1,knon
-         yts_x(j)=yts(j)-ywake_s(j)*y_delta_tsurf(j)
-         yts_w(j)=yts(j)+(1.-ywake_s(j))*y_delta_tsurf(j)
-        ENDDO
-!!!
-       ENDIF  ! (iflag_split .ge.1)
-!!!
-       DO k = 1, nsoilmx
-          DO j = 1, knon
-             i = ni(j)
-             ytsoil(j,k) = ftsoil(i,k,nsrf)
-          ENDDO
-       ENDDO
-       
-       ! qsol(water height in soil) only for bucket continental model
-       IF ( nsrf .EQ. is_ter .AND. .NOT. ok_veget ) THEN 
-          DO j = 1, knon
-             i = ni(j)
-             yqsol(j) = qsol(i)
-#ifdef ISO
-             do ixt=1,niso
-               yxtsol(ixt,j) = xtsol(ixt,i)
-             enddo
-#endif
-          ENDDO
-       ENDIF
-
-       if (nsrf == is_oce .and. activate_ocean_skin >= 1) then
-          if (activate_ocean_skin == 2 .and. type_ocean == "couple") then
-             ydelta_sal(:knon) = delta_sal(ni(:knon))
-             ydelta_sst(:knon) = delta_sst(ni(:knon))
-             ydter(:knon) = dter(ni(:knon))
-             ydser(:knon) = dser(ni(:knon))
-             ydt_ds(:knon) = dt_ds(ni(:knon))
-          end if
-          
-          yds_ns(:knon) = ds_ns(ni(:knon))
-          ydt_ns(:knon) = dt_ns(ni(:knon))
-       end if
-       
-!****************************************************************************************
-! 6a) Calculate coefficients for turbulent diffusion at surface, cdragh et cdragm.
-!
-!****************************************************************************************
-
-
-!!! jyg le 07/02/2012
-       IF (iflag_split .eq.0) THEN
-!!!
-!!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
-! Faire disparaitre les lignes commentees fin 2015 (le temps des tests)
-!       CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
-!           yu(:,1), yv(:,1), yt(:,1), yq(:,1), &
-!           yts, yqsurf, yrugos, &
-!           ycdragm, ycdragh )
-! Fuxing WANG, 04/03/2015, replace the clcdrag by the merged version: cdrag
-        DO i = 1, knon
-!          print*,'PBL ',i,RD
-!          print*,'PBL ',yt(i,1),ypaprs(i,1),ypplay(i,1)
-           zgeo1(i) = RD * yt(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
-                * (ypaprs(i,1)-ypplay(i,1))
-           speed(i) = SQRT(yu(i,1)**2+yv(i,1)**2)
-        ENDDO
-        CALL cdrag(knon, nsrf, &
-            speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1), s_pblh, &
-            yts, yqsurf, yz0m, yz0h, yri0, 0, &
-            ycdragm, ycdragh, zri1, pref, rain_f, zxtsol, ypplay(:,1))
-
-! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
-     IF (ok_prescr_ust) THEN
-      DO i = 1, knon
-       print *,'ycdragm avant=',ycdragm(i)
-       vent= sqrt(yu(i,1)*yu(i,1)+yv(i,1)*yv(i,1))
-!      ycdragm(i) = ust*ust/(1.+(yu(i,1)*yu(i,1)+yv(i,1)*yv(i,1)))
-!      ycdragm(i) = ust*ust/((1.+sqrt(yu(i,1)*yu(i,1)+yv(i,1)*yv(i,1))) &
-!     *sqrt(yu(i,1)*yu(i,1)+yv(i,1)*yv(i,1)))
-       ycdragm(i) = ust*ust/(1.+vent)/vent
-!      print *,'ycdragm ust yu yv apres=',ycdragm(i),ust,yu(i,1),yv(i,1)
-      ENDDO
-     ENDIF
-
-        IF (prt_level >=10) print *,'clcdrag -> ycdragh ', ycdragh
-       ELSE  !(iflag_split .eq.0)
-
-! Faire disparaitre les lignes commentees fin 2015 (le temps des tests)
-!       CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
-!           yu_x(:,1), yv_x(:,1), yt_x(:,1), yq_x(:,1), &
-!           yts_x, yqsurf, yrugos, &
-!           ycdragm_x, ycdragh_x )
-! Fuxing WANG, 04/03/2015, replace the clcdrag by the merged version: cdrag
-        DO i = 1, knon
-           zgeo1_x(i) = RD * yt_x(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
-                * (ypaprs(i,1)-ypplay(i,1))
-           speed_x(i) = SQRT(yu_x(i,1)**2+yv_x(i,1)**2)
-        ENDDO
-
-
-            CALL cdrag(knon, nsrf, &
-            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, rain_f, zxtsol, ypplay(:,1) )
-
-! --- special Dice. JYG+MPL 25112013
-        IF (ok_prescr_ust) THEN
-         DO i = 1, knon
-!         print *,'ycdragm_x avant=',ycdragm_x(i)
-          vent= sqrt(yu_x(i,1)*yu_x(i,1)+yv_x(i,1)*yv_x(i,1))
-          ycdragm_x(i) = ust*ust/(1.+vent)/vent
-!         print *,'ycdragm_x ust yu yv apres=',ycdragm_x(i),ust,yu_x(i,1),yv_x(i,1)
-         ENDDO
-        ENDIF
-        IF (prt_level >=10) print *,'clcdrag -> ycdragh_x ', ycdragh_x
-!
-! Faire disparaitre les lignes commentees fin 2015 (le temps des tests)
-!        CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
-!            yu_w(:,1), yv_w(:,1), yt_w(:,1), yq_w(:,1), &
-!            yts_w, yqsurf, yz0m, &
-!            ycdragm_w, ycdragh_w )
-! Fuxing WANG, 04/03/2015, replace the clcdrag by the merged version: cdrag
-        DO i = 1, knon
-           zgeo1_w(i) = RD * yt_w(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
-                * (ypaprs(i,1)-ypplay(i,1))
-           speed_w(i) = SQRT(yu_w(i,1)**2+yv_w(i,1)**2)
-        ENDDO
-        CALL cdrag(knon, nsrf, &
-            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, 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
-        IF (ok_prescr_ust) THEN
-         DO i = 1, knon
-!         print *,'ycdragm_w avant=',ycdragm_w(i)
-          vent= sqrt(yu_w(i,1)*yu_w(i,1)+yv_w(i,1)*yv_w(i,1))
-          ycdragm_w(i) = ust*ust/(1.+vent)/vent
-!         print *,'ycdragm_w ust yu yv apres=',ycdragm_w(i),ust,yu_w(i,1),yv_w(i,1)
-         ENDDO
-        ENDIF
-        IF (prt_level >=10) print *,'clcdrag -> ycdragh_w ', ycdragh_w
-!!!
-       ENDIF  ! (iflag_split .eq.0)
-!!!
-       
-
-!****************************************************************************************
-! 6b) Calculate coefficients for turbulent diffusion in the atmosphere, ycoefh et ycoefm.
-!
-!****************************************************************************************
-
-!!! jyg le 07/02/2012
-       IF (iflag_split .eq.0) THEN
-!!!
-!!! 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
-       ENDIF
-
-        IF (iflag_pbl>=50) THEN
-        CALL call_atke(dtime,knon,klev,ycdragm(1:knon), ycdragh(1:knon),yus0(1:knon),yvs0(1:knon),yts(1:knon), &
-                  yu(1:knon,:),yv(1:knon,:),yt(1:knon,:),yq(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:),       &
-                  ytke(1:knon,:),yeps(1:knon,:), ycoefm(1:knon,:), ycoefh(1:knon,:))
-
-        ELSE
-
-        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
-            ypaprs, ypplay, yu, yv, yq, yt, yts, yqsurf, ycdragm, &
-            ycoefm, ycoefh, ytke, yeps, y_treedrg)
-!            ycoefm, ycoefh, ytke)
-!FC y_treedrg ajoute
-       IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
-! In this case, coef_diff_turb is called for the Cd only
-       DO k = 2, klev
-          DO j = 1, knon
-             i = ni(j)
-             ycoefh(j,k)   = zcoefh(i,k,nsrf)
-             ycoefm(j,k)   = zcoefm(i,k,nsrf)
-          ENDDO
-       ENDDO
-       ENDIF
-
-       ENDIF ! iflag_pbl >= 50
-
-        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  
-      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
-
-       ENDIF
-
-        IF (iflag_pbl>=50) THEN
-     
-        CALL call_atke(dtime,knon,klev,ycdragm_x(1:knon),ycdragh_x(1:knon),yus0(1:knon),yvs0(1:knon),yts_x(1:knon),    &
-                       yu_x(1:knon,:),yv_x(1:knon,:),yt_x(1:knon,:),yq_x(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:),  &
-                       ytke_x(1:knon,:),yeps_x(1:knon,:),ycoefm_x(1:knon,:), ycoefh_x(1:knon,:))
-
-        ELSE
-
-        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
-            ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yqsurf_x, ycdragm_x, &
-            ycoefm_x, ycoefh_x, ytke_x,yeps_x,y_treedrg)
-!            ycoefm_x, ycoefh_x, ytke_x)
-!FC doit on le mettre ( on ne l utilise pas si il y a du spliting)
-       IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
-! In this case, coef_diff_turb is called for the Cd only
-       DO k = 2, klev
-          DO j = 1, knon
-             i = ni(j)
-             ycoefh_x(j,k)   = zcoefh(i,k,nsrf)
-             ycoefm_x(j,k)   = zcoefm(i,k,nsrf)
-          ENDDO
-       ENDDO
-       ENDIF
-
-        ENDIF ! iflag_pbl >= 50
-
-        IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_x ',ycoefh_x
-!
-      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
-      ENDIF
-
-        IF (iflag_pbl>=50) THEN
-        
-        CALL call_atke(dtime,knon,klev,ycdragm_w(1:knon),ycdragh_w(1:knon),yus0(1:knon),yvs0(1:knon),yts_w(1:knon), &
-                yu_w(1:knon,:),yv_w(1:knon,:),yt_w(1:knon,:),yq_w(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:),      &
-                ytke_w(1:knon,:),yeps_w(1:knon,:),ycoefm_w(1:knon,:),ycoefh_w(1:knon,:))
-
-        ELSE
-
-        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
-            ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yqsurf_w, ycdragm_w, &
-            ycoefm_w, ycoefh_w, ytke_w,yeps_w,y_treedrg)
-!            ycoefm_w, ycoefh_w, ytke_w)
-       IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
-! In this case, coef_diff_turb is called for the Cd only
-       DO k = 2, klev
-          DO j = 1, knon
-             i = ni(j)
-             ycoefh_w(j,k)   = zcoefh(i,k,nsrf)
-             ycoefm_w(j,k)   = zcoefm(i,k,nsrf)
-          ENDDO
-       ENDDO
-       ENDIF
-
-       ENDIF ! iflag_pbl >= 50
-
-        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
-!!   arbitraire pour ycoefh et ycoefm
-      DO k = 2,klev
-        DO j = 1,knon
-         ycoefh(j,k) = ycoefh_x(j,k) + ywake_s(j)*(ycoefh_w(j,k) - ycoefh_x(j,k))
-         ycoefm(j,k) = ycoefm_x(j,k) + ywake_s(j)*(ycoefm_w(j,k) - ycoefm_x(j,k))
-        ENDDO
-      ENDDO
-       ENDIF  ! (iflag_split .eq.0)
-       
-!****************************************************************************************
-! 
-! 8) "La descente" - "The downhill"
-!  
-!  climb_hq_down and climb_wind_down calculate the coefficients
-!  Ccoef_X et Dcoef_X for X=[H, Q, U, V].
-!  Only the coefficients at surface for H and Q are returned.
-!
-!****************************************************************************************
-
-! - Calculate the coefficients Ccoef_H, Ccoef_Q, Dcoef_H and Dcoef_Q 
-!!! jyg le 07/02/2012
-       IF (iflag_split .eq.0) THEN
-!!!
-!!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
-        CALL climb_hq_down(knon, ycoefh, ypaprs, ypplay, &
-            ydelp, yt, yq, dtime, &
-!!! jyg le 09/05/2011
-            CcoefH, CcoefQ, DcoefH, DcoefQ, &
-            Kcoef_hq, gama_q, gama_h, &
-!!!
-            AcoefH, AcoefQ, BcoefH, BcoefQ &
-#ifdef ISO
-         &   ,yxt, CcoefXT, DcoefXT, gama_xt, AcoefXT, BcoefXT & 
-#endif               
-         &   )
-       ELSE  !(iflag_split .eq.0)
-        CALL climb_hq_down(knon, ycoefh_x, ypaprs, ypplay, &
-            ydelp, yt_x, yq_x, dtime, &
-!!! nrlmd le 02/05/2011
-            CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x, &
-            Kcoef_hq_x, gama_q_x, gama_h_x, &
-!!!
-            AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x &
-#ifdef ISO
-         &   ,yxt_x, CcoefXT_x, DcoefXT_x, gama_xt_x, AcoefXT_x, BcoefXT_x & 
-#endif               
-         &   )
-!!!
-       IF (prt_level >=10) THEN
-         PRINT *,'pbl_surface (climb_hq_down.x->) AcoefH_x ',AcoefH_x
-         PRINT *,'pbl_surface (climb_hq_down.x->) AcoefQ_x ',AcoefQ_x
-         PRINT *,'pbl_surface (climb_hq_down.x->) BcoefH_x ',BcoefH_x
-         PRINT *,'pbl_surface (climb_hq_down.x->) BcoefQ_x ',BcoefQ_x
-       ENDIF
-!
-        CALL climb_hq_down(knon, ycoefh_w, ypaprs, ypplay, &
-            ydelp, yt_w, yq_w, dtime, &
-!!! nrlmd le 02/05/2011
-            CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w, &
-            Kcoef_hq_w, gama_q_w, gama_h_w, &
-!!!
-            AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w &
-#ifdef ISO
-         &   ,yxt_w, CcoefXT_w, DcoefXT_w, gama_xt_w, AcoefXT_w, BcoefXT_w & 
-#endif               
-         &   )
-!!!
-       IF (prt_level >=10) THEN
-         PRINT *,'pbl_surface (climb_hq_down.w->) AcoefH_w ',AcoefH_w
-         PRINT *,'pbl_surface (climb_hq_down.w->) AcoefQ_w ',AcoefQ_w
-         PRINT *,'pbl_surface (climb_hq_down.w->) BcoefH_w ',BcoefH_w
-         PRINT *,'pbl_surface (climb_hq_down.w->) BcoefQ_w ',BcoefQ_w
-       ENDIF
-!!!
-       ENDIF  ! (iflag_split .eq.0)
-!!!
-
-! - Calculate the coefficients Ccoef_U, Ccoef_V, Dcoef_U and Dcoef_V
-!!! jyg le 07/02/2012
-       IF (iflag_split .eq.0) THEN
-!!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
-        CALL climb_wind_down(knon, dtime, ycoefm, ypplay, ypaprs, yt, ydelp, yu, yv, &
-!!! jyg le 09/05/2011
-            CcoefU, CcoefV, DcoefU, DcoefV, &
-            Kcoef_m, alf_1, alf_2, &
-!!!
-            AcoefU, AcoefV, BcoefU, BcoefV)
-       ELSE  ! (iflag_split .eq.0)
-        CALL climb_wind_down(knon, dtime, ycoefm_x, ypplay, ypaprs, yt_x, ydelp, yu_x, yv_x, &
-!!! nrlmd le 02/05/2011
-            CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, &
-            Kcoef_m_x, alf_1_x, alf_2_x, &
-!!!
-            AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x)
-!
-        CALL climb_wind_down(knon, dtime, ycoefm_w, ypplay, ypaprs, yt_w, ydelp, yu_w, yv_w, &
-!!! nrlmd le 02/05/2011
-            CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w, &
-            Kcoef_m_w, alf_1_w, alf_2_w, &
-!!!
-            AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w)
-!!!      
-       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
-
-
-
-!****************************************************************************************
-! 9) Small calculations
-!
-!****************************************************************************************
-
-! - Reference pressure is given the values at surface level          
-       ypsref(:) = ypaprs(:,1)  
-
-! - CO2 field on 2D grid to be sent to ORCHIDEE
-!   Transform to compressed field
-       IF (carbon_cycle_cpl) THEN
-          DO i=1,knon
-             r_co2_ppm(i) = co2_send(ni(i))
-          ENDDO
-       ELSE
-          r_co2_ppm(:) = co2_ppm     ! Constant field
-       ENDIF
-
-!!! nrlmd le 02/05/2011  -----------------------On raccorde les 2 colonnes dans la couche 1 
-!----------------------------------------------------------------------------------------
-!!! jyg le 07/02/2012
-!!! jyg le 01/02/2017
-       IF (iflag_split .eq. 0) THEN
-         yt1(:) = yt(:,1)
-         yq1(:) = yq(:,1)
-#ifdef ISO
-         yxt1(:,:) = yxt(:,:,1)
-#endif
-
-       ELSE IF (iflag_split .ge. 1) THEN
-#ifdef ISO
-        call abort_gcm('pbl_surface_mod 2149','isos pas encore dans iflag_split=1',1)
-#endif
-
-!
-! Cdragq computation
-! ------------------
-    !******************************************************************************
-    ! Cdragq computed from cdrag
-    ! The difference comes only from a factor (f_z0qh_oce) on z0, so that
-    ! it can be computed inside wx_pbl0_merge
-    ! More complicated appraches may require the propagation through
-    ! pbl_surface of an independant cdragq variable.
-    !******************************************************************************
-!
-    IF ( f_z0qh_oce .ne. 1. .and. nsrf .eq.is_oce) THEN
-       ! Si on suit les formulations par exemple de Tessel, on 
-       ! a z0h=0.4*nu/u*, z0q=0.62*nu/u*, d'ou f_z0qh_oce=0.62/0.4=1.55
-!!       ycdragq_x(1:knon)=ycdragh_x(1:knon)*                                      &
-!!            log(z1lay(1:knon)/yz0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*yz0h(1:knon)))
-!!       ycdragq_w(1:knon)=ycdragh_w(1:knon)*                                      &
-!!            log(z1lay(1:knon)/yz0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*yz0h(1:knon)))
-!
-       DO j = 1,knon
-         z1lay = zgeo1(j)/RG
-         fact_cdrag = log(z1lay/yz0h(j))/log(z1lay/(f_z0qh_oce*yz0h(j)))
-         ycdragq_x(j)=ycdragh_x(j)*fact_cdrag
-         ycdragq_w(j)=ycdragh_w(j)*fact_cdrag
-!!     Print *,'YYYYpbl0: fact_cdrag ', fact_cdrag
-       ENDDO  ! j = 1,knon
-!
-!!  Print *,'YYYYpbl0: z1lay, yz0h, f_z0qh_oce, ycdragh_w, ycdragq_w ', &
-!!                z1lay, yz0h(1:knon), f_z0qh_oce, ycdragh_w(1:knon), ycdragq_w(1:knon)
-    ELSE
-       ycdragq_x(1:knon)=ycdragh_x(1:knon)
-       ycdragq_w(1:knon)=ycdragh_w(1:knon)
-    ENDIF  ! ( f_z0qh_oce .ne. 1. .and. nsrf .eq.is_oce)
-!
-         CALL wx_pbl_prelim_0(knon, nsrf, dtime, ypplay, ypaprs, ywake_s,  &
-                         yts, y_delta_tsurf, ygustiness, &
-                         yt_x, yt_w, yq_x, yq_w, &
-                         yu_x, yu_w, yv_x, yv_w, &
-                         ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
-                         ycdragm_x, ycdragm_w, &
-                         AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
-                         AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
-                         BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
-                         BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
-                         Kech_h_x, Kech_h_w, Kech_h  &
-                         )
-         CALL wx_pbl_prelim_beta(knon, dtime, ywake_s, ybeta,  &
-                         BcoefQ_x, BcoefQ_w  &
-                         )
-         CALL wx_pbl0_merge(knon, ypplay, ypaprs,  &
-                         ywake_s, ydTs0, ydqs0, &
-                         yt_x, yt_w, yq_x, yq_w, &
-                         yu_x, yu_w, yv_x, yv_w, &
-                         ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
-                         ycdragm_x, ycdragm_w, &
-                         AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
-                         AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
-                         BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
-                         BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
-                         AcoefH_0, AcoefQ_0, AcoefU, AcoefV, &
-                         BcoefH_0, BcoefQ_0, BcoefU, BcoefV, &
-                         ycdragh, ycdragq, ycdragm, &
-                         yt1, yq1, yu1, yv1 &
-                         )
-         IF (iflag_split .eq. 2 .AND. nsrf .ne. is_oce) THEN
-           CALL wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
-                           ywake_s, ybeta, ywake_cstar, ywake_dens, &
-                           AcoefH_x, AcoefH_w, &
-                           BcoefH_x, BcoefH_w, &
-                           AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0,  &
-                           AcoefH, AcoefQ, BcoefH, BcoefQ,  &
-                           HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
-                           phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
-                           yg_T, yg_Q, &
-                           yGamma_dTs_phiT, yGamma_dQs_phiQ, &
-                           ydTs_ins, ydqs_ins &
-                           )
-         ELSE !
-           AcoefH(:) = AcoefH_0(:)
-           AcoefQ(:) = AcoefQ_0(:)
-           BcoefH(:) = BcoefH_0(:)
-           BcoefQ(:) = BcoefQ_0(:)
-           yg_T(:) = 0.
-           yg_Q(:) = 0.
-           yGamma_dTs_phiT(:) = 0.
-           yGamma_dQs_phiQ(:) = 0.
-           ydTs_ins(:) = 0.
-           ydqs_ins(:) = 0.
-         ENDIF   ! (iflag_split .eq. 2)
-       ENDIF  ! (iflag_split .eq.0)
-!!!
-       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)
-
-       ENDIF
-
-!  Save initial value of z0h for use in evappot (z0h wiil be computed again in the surface models)
-          yz0h_old(1:knon) = yz0h(1:knon)
-!
-!****************************************************************************************
-!
-! Calulate t2m and q2m for the case of calculation at land grid points 
-! t2m and q2m are needed as input to ORCHIDEE
-!
-!****************************************************************************************
-       IF (nsrf == is_ter) THEN
-
-          DO i = 1, knon
-             zgeo1(i) = RD * yt(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
-                  * (ypaprs(i,1)-ypplay(i,1))
-          ENDDO
-
-          ! Calculate the temperature et relative humidity at 2m and the wind at 10m 
-          IF (iflag_new_t2mq2m==1) THEN
-           CALL stdlevvarn(klon, knon, is_ter, zxli, &
-               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
-               yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
-               yt2m, yq2m, yt10m, yq10m, yu10m, yustar, &
-               yn2mout(:, nsrf, :))
-          ELSE 
-          CALL stdlevvar(klon, knon, is_ter, zxli, &
-               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
-               yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
-               yt2m, yq2m, yt10m, yq10m, yu10m, yustar, ypblh, rain_f, zxtsol)
-          ENDIF
-          
-       ENDIF
-
-!****************************************************************************************
-!
-! 10) Switch according to current surface
-!     It is necessary to start with the continental surfaces because the ocean
-!     needs their run-off.
-!
-!****************************************************************************************
-       SELECT CASE(nsrf)
-     
-       CASE(is_ter)
-!          print*,"DEBUGTS",yts(knon/2),ylwdown(knon/2)
-          CALL surf_land(itap, dtime, date0, jour, knon, ni,&
-               rlon, rlat, yrmu0, &
-               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, ybs_f, yt1, yq1,&
-               AcoefH, AcoefQ, BcoefH, BcoefQ, & 
-               AcoefU, AcoefV, BcoefU, BcoefV, & 
-               ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
-               ylwdown, yq2m, yt2m, &
-               ysnow, yqsol, yagesno, ytsoil, &
-               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, &
-               yveget,ylai,yheight   &
-#ifdef ISO
-         &      ,yxtrain_f, yxtsnow_f,yxt1, &
-         &      yxtsnow,yxtsol,yxtevap,h1, &
-         &      yrunoff_diag,yxtrunoff_diag,yRland_ice &
-#endif               
-         &      )
- 
-!FC quid qd yveget ylai yheight ne sont pas definit
-!FC  yveget,ylai,yheight, &
-            IF (ifl_pbltree .ge. 1) THEN
-              CALL   freinage(knon, yu, yv, yt, &
-!                yveget,ylai, yheight,ypaprs,ypplay,y_d_u_frein,y_d_v_frein)
-                yveget,ylai, yheight,ypaprs,ypplay,y_treedrg, y_d_u_frein,y_d_v_frein)
-            ENDIF
-
-               
-! Special DICE MPL 05082013 puis BOMEX
-       IF (ok_prescr_ust) THEN
-          DO j=1,knon
-!         ysnow(:)=0.
-!         yqsol(:)=0.
-!         yagesno(:)=50.
-!         ytsoil(:,:)=300.
-!         yz0_new(:)=0.001
-!         yevap(:)=flat/RLVTT
-!         yfluxlat(:)=-flat
-!         yfluxsens(:)=-fsens
-!         yqsurf(:)=0.
-!         ytsurf_new(:)=tg
-!         y_dflux_t(:)=0.
-!         y_dflux_q(:)=0.
-          y_flux_u1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yu(j,1)*ypplay(j,1)/RD/yt(j,1)
-          y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1)
-          ENDDO
-      ENDIF
-
-#ifdef ISOVERIF
-        do j=1,knon
-          do ixt=1,ntraciso
-            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')
-          enddo
-        enddo
-#endif
-#ifdef ISOVERIF
-!        write(*,*) 'pbl_surface_mod 1038: sortie surf_land'
-        do j=1,knon
-          if (iso_eau.gt.0) then     
-                 call iso_verif_egalite(yxtsnow(iso_eau,j), &
-     &                  ysnow(j),'pbl_surf_mod 1043')
-           endif !if (iso_eau.gt.0) then
-        enddo !do i=1,klon
-#endif
-     
-       CASE(is_lic)
-          ! Martin
-          IF (landice_opt .LT. 2) THEN
-             ! Land ice is treated by LMDZ and not by ORCHIDEE
-             
-             CALL surf_landice(itap, dtime, knon, ni, &
-                  rlon, rlat, debut, lafin, &
-                  yrmu0, ylwdown, yalb, zgeo1, &
-                  ysolsw, ysollw, yts, ypplay(:,1), &
-                  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,yqbs1, yagesno, &
-                  ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
-                  yfluxbs, ytsurf_new, y_dflux_t, y_dflux_q, &
-                  yzmea, yzsig, ycldt, &
-                  ysnowhgt, yqsnow, ytoice, ysissnow, &
-                  yalb3_new, yrunoff, &
-                  y_flux_u1, y_flux_v1 &
-#ifdef ISO
-                  &    ,yxtrain_f, yxtsnow_f,yxt1,yRland_ice &
-                  &    ,yxtsnow,yxtsol,yxtevap &
-#endif              
-                  &    )
-             
-             !jyg<
-             !!          alb3_lic(:)=0.
-             !>jyg
-             DO j = 1, knon
-                i = ni(j)
-                alb3_lic(i) = yalb3_new(j)
-                snowhgt(i)   = ysnowhgt(j)
-                qsnow(i)     = yqsnow(j)
-                to_ice(i)    = ytoice(j)
-                sissnow(i)   = ysissnow(j)
-                runoff(i)    = yrunoff(j)
-             ENDDO
-             ! Martin
-             ! Special DICE MPL 05082013 puis BOMEX MPL 20150410
-             IF (ok_prescr_ust) THEN
-                DO j=1,knon
-                   y_flux_u1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yu(j,1)*ypplay(j,1)/RD/yt(j,1)
-                   y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1)
-                ENDDO
-             ENDIF
-             
-#ifdef ISOVERIF
-             do j=1,knon
-                do ixt=1,ntraciso
-                   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')
-                enddo
-             enddo
-#endif
-#ifdef ISOVERIF
-             !write(*,*) 'pbl_surface_mod 1060: sortie surf_landice'
-             do j=1,knon
-                if (iso_eau.gt.0) then     
-                   call iso_verif_egalite(yxtsnow(iso_eau,j), &
-                        &                  ysnow(j),'pbl_surf_mod 1064')
-                endif !if (iso_eau.gt.0) then
-             enddo !do i=1,klon
-#endif
-          END IF
-       CASE(is_oce)
-           CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb_vis, &
-               ywindsp, rmu0, yfder, yts, &
-               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, ybs_f, yt(:,1), yq(:,1),&    ! ym missing init
-               AcoefH, AcoefQ, BcoefH, BcoefQ, &
-               AcoefU, AcoefV, BcoefU, BcoefV, &
-               ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
-               ysnow, yqsurf, yagesno, &
-               yz0m, yz0h, SFRWL,yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
-               ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, &
-               y_flux_u1, y_flux_v1, ydelta_sst(:knon), ydelta_sal(:knon), &
-               yds_ns(:knon), ydt_ns(:knon), ydter(:knon), ydser(:knon), &
-               ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss &
-#ifdef ISO
-         &      ,yxtrain_f, yxtsnow_f,yxt1,Roce, &
-         &      yxtsnow,yxtevap,h1 &
-#endif               
-         &      )
-      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
-       ENDIF
-! Special DICE MPL 05082013 puis BOMEX MPL 20150410
-       IF (ok_prescr_ust) THEN
-          DO j=1,knon
-          y_flux_u1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yu(j,1)*ypplay(j,1)/RD/yt(j,1)
-          y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1)
-          ENDDO
-      ENDIF
-          
-       CASE(is_sic)
-          CALL surf_seaice( &
-!albedo SB >>>
-               rlon, rlat, ysolsw, ysollw, yalb_vis, yfder, &
-!albedo SB <<<
-               itap, dtime, jour, knon, ni, &
-               lafin, &
-!!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,&
-               AcoefH, AcoefQ, BcoefH, BcoefQ, &
-               AcoefU, AcoefV, BcoefU, BcoefV, &
-               ypsref, yu1, yv1, ygustiness, pctsrf, &
-               ysnow, yqsurf, yqsol, yagesno, ytsoil, &
-!albedo SB >>>
-               yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
-!albedo SB <<<
-               ytsurf_new, y_dflux_t, y_dflux_q, &
-               y_flux_u1, y_flux_v1 &
-#ifdef ISO
-         &      ,yxtrain_f, yxtsnow_f,yxt1,Roce, &
-         &      yxtsnow,yxtsol,yxtevap,Rland_ice &
-#endif               
-         &      )
-          
-! Special DICE MPL 05082013 puis BOMEX MPL 20150410
-       IF (ok_prescr_ust) THEN
-          DO j=1,knon
-          y_flux_u1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yu(j,1)*ypplay(j,1)/RD/yt(j,1)
-          y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1)
-          ENDDO
-      ENDIF
-
-#ifdef ISOVERIF
-        do j=1,knon
-          do ixt=1,ntraciso
-            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')
-          enddo
-        enddo
-#endif
-#ifdef ISOVERIF
-        !write(*,*) 'pbl_surface_mod 1077: sortie surf_seaice'
-        do j=1,knon
-          if (iso_eau.gt.0) then     
-                 call iso_verif_egalite(yxtsnow(iso_eau,j), &
-     &                  ysnow(j),'pbl_surf_mod 1106')
-           endif !if (iso_eau.gt.0) then
-        enddo !do i=1,klon
-#endif
-
-       CASE DEFAULT
-          WRITE(lunout,*) 'Surface index = ', nsrf
-          abort_message = 'Surface index not valid'
-          CALL abort_physic(modname,abort_message,1)
-       END SELECT
-
-
-!****************************************************************************************
-! 11) - Calcul the increment of surface temperature
-!
-!****************************************************************************************
-
-       IF (evap0>=0.) THEN
-          yevap(:)=evap0
-          yevap(:)=RLVTT*evap0
-       ENDIF
-
-       y_d_ts(1:knon)   = ytsurf_new(1:knon) - yts(1:knon)
- 
-!****************************************************************************************
-!
-! 12) "La remontee" - "The uphill"
-!
-!  The fluxes (y_flux_X) and tendancy (y_d_X) are calculated 
-!  for X=H, Q, U and V, for all vertical levels.
-!
-!****************************************************************************************
-!!
-!!!
-!!! jyg le 10/04/2013 et EV 10/2020
-
-        IF (ok_forc_tsurf) THEN
-            DO j=1,knon
-                ytsurf_new(j)=tg
-                y_d_ts(j) = ytsurf_new(j) - yts(j) 
-            ENDDO
-        ENDIF ! ok_forc_tsurf
-
-!!!
-        IF (ok_flux_surf) THEN
-          IF (prt_level >=10) THEN
-           PRINT *,'pbl_surface: fsens flat RLVTT=',fsens,flat,RLVTT
-          ENDIF
-          y_flux_t1(:) =  fsens
-          y_flux_q1(:) =  flat/RLVTT
-          yfluxlat(:) =  flat
-!
-!!  Test sur iflag_split retire le 2/02/2018, sans vraiment comprendre la raison de ce test. (jyg)
-!!          IF (iflag_split .eq.0) THEN
-             DO j=1,knon
-             Kech_h(j) = ycdragh(j) * (1.0+SQRT(yu(j,1)**2+yv(j,1)**2)) * &
-                  ypplay(j,1)/(RD*yt(j,1))
-             ENDDO
-!!          ENDIF ! (iflag_split .eq.0)
-
-          DO j = 1, knon
-            yt1_new=(1./RCPD)*(AcoefH(j)+BcoefH(j)*y_flux_t1(j)*dtime)
-            ytsurf_new(j)=yt1_new-y_flux_t1(j)/(Kech_h(j)*RCPD)
-          ENDDO
-
-          DO j=1,knon
-          y_d_ts(j) = ytsurf_new(j) - yts(j) 
-          ENDDO
-
-        ELSE ! (ok_flux_surf)
-          DO j=1,knon
-          y_flux_t1(j) =  yfluxsens(j)
-          y_flux_q1(j) = -yevap(j)
-#ifdef ISO
-          y_flux_xt1(:,:) = -yxtevap(:,:)
-#endif
-          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
-!
-! ------------------------------------------------------------------------------
-! 12a)  Splitting
-! ------------------------------------------------------------------------------
-
-       IF (iflag_split .GE. 1) THEN
-#ifdef ISO
-        call abort_gcm('pbl_surface_mod 2607','isos pas encore dans iflag_split=1',1)
-#endif
-!
-         IF (nsrf .ne. is_oce) THEN
-!
-!         Compute potential evaporation and aridity factor  (jyg, 20200328)
-          ybeta_prev(:) = ybeta(:)
-             DO j = 1, knon
-               yqa(j) = AcoefQ(j) - BcoefQ(j)*yevap(j)*dtime
-             ENDDO
-!
-          CALL wx_evappot(knon, yqa, yTsurf_new, yevap_pot)
-!
-          ybeta(1:knon) = min(yevap(1:knon)/yevap_pot(1:knon), 1.)
-          
-          IF (prt_level >=10) THEN
-           DO j=1,knon
-            print*,'y_flux_t1,yfluxlat,wakes' &
- &                ,  y_flux_t1(j), yfluxlat(j), ywake_s(j)
-            print*,'beta_prev, beta, ytsurf_new', ybeta_prev(j), ybeta(j), ytsurf_new(j)
-            print*,'inertia,facteur,cstar', inertia, facteur,wake_cstar(j)
-           ENDDO
-          ENDIF  ! (prt_level >=10)
-!
-! Second call to wx_pbl0_merge and wx_pbl_dts_merge in order to take into account 
-! the update of the aridity coeficient beta.
-!
-        CALL wx_pbl_prelim_beta(knon, dtime, ywake_s, ybeta,  &
-                        BcoefQ_x, BcoefQ_w  &
-                        )
-        CALL wx_pbl0_merge(knon, ypplay, ypaprs,  &
-                          ywake_s, ydTs0, ydqs0, &
-                          yt_x, yt_w, yq_x, yq_w, &
-                          yu_x, yu_w, yv_x, yv_w, &
-                          ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
-                          ycdragm_x, ycdragm_w, &
-                          AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
-                          AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
-                          BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
-                          BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
-                          AcoefH_0, AcoefQ_0, AcoefU, AcoefV, &
-                          BcoefH_0, BcoefQ_0, BcoefU, BcoefV, &
-                          ycdragh, ycdragq, ycdragm, &
-                          yt1, yq1, yu1, yv1 &
-                          )
-          IF (iflag_split .eq. 2) THEN
-            CALL wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
-                            ywake_s, ybeta, ywake_cstar, ywake_dens, &
-                            AcoefH_x, AcoefH_w, &
-                            BcoefH_x, BcoefH_w, &
-                            AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0,  &
-                            AcoefH, AcoefQ, BcoefH, BcoefQ,  &
-                            HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
-                            phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
-                            yg_T, yg_Q, &
-                            yGamma_dTs_phiT, yGamma_dQs_phiQ, &
-                            ydTs_ins, ydqs_ins &
-                            )
-          ELSE !
-            AcoefH(:) = AcoefH_0(:)
-            AcoefQ(:) = AcoefQ_0(:)
-            BcoefH(:) = BcoefH_0(:)
-            BcoefQ(:) = BcoefQ_0(:)
-            yg_T(:) = 0.
-            yg_Q(:) = 0.
-            yGamma_dTs_phiT(:) = 0.
-            yGamma_dQs_phiQ(:) = 0.
-            ydTs_ins(:) = 0.
-            ydqs_ins(:) = 0.
-          ENDIF   ! (iflag_split .eq. 2)
-!
-        ELSE    ! (nsrf .ne. is_oce)
-          ybeta(1:knon) = 1.
-          yevap_pot(1:knon) = yevap(1:knon)
-          AcoefH(:) = AcoefH_0(:)
-          AcoefQ(:) = AcoefQ_0(:)
-          BcoefH(:) = BcoefH_0(:)
-          BcoefQ(:) = BcoefQ_0(:)
-          yg_T(:) = 0.
-          yg_Q(:) = 0.
-          yGamma_dTs_phiT(:) = 0.
-          yGamma_dQs_phiQ(:) = 0.
-          ydTs_ins(:) = 0.
-          ydqs_ins(:) = 0.
-        ENDIF   ! (nsrf .ne. is_oce)
-! 
-        CALL wx_pbl_split(knon, nsrf, dtime, ywake_s, ybeta, iflag_split, &
-                       yg_T, yg_Q, &
-                       yGamma_dTs_phiT, yGamma_dQs_phiQ, &
-                       ydTs_ins, ydqs_ins, &
-                       y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, &
-!!!!                       HTRn_b, dd_HTRn, HTphiT_b, dd_HTphiT, &
-                       phiQ0_b, phiT0_b, &
-                       y_flux_t1_x, y_flux_t1_w, &
-                       y_flux_q1_x, y_flux_q1_w, &
-                       y_flux_u1_x, y_flux_u1_w, &
-                       y_flux_v1_x, y_flux_v1_w, &
-                       yfluxlat_x, yfluxlat_w, &
-                       y_delta_qsats, &
-                       y_delta_tsurf_new, y_delta_qsurf &
-                       )
-!
-         CALL wx_pbl_check(knon, dtime, ypplay, ypaprs, ywake_s, ybeta, iflag_split, &
-                       yTs, y_delta_tsurf,  & 
-                       yqsurf, yTsurf_new,  &
-                       y_delta_tsurf_new, y_delta_qsats,  &
-                       AcoefH_x, AcoefH_w, &
-                       BcoefH_x, BcoefH_w, &
-                       AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0,  &
-                       AcoefH, AcoefQ, BcoefH, BcoefQ,  &
-                       y_flux_t1, y_flux_q1,  &
-                       y_flux_t1_x, y_flux_t1_w, &
-                       y_flux_q1_x, y_flux_q1_w)
-!
-         IF (nsrf .ne. is_oce) THEN
-           CALL wx_pbl_dts_check(knon, dtime, ypplay, ypaprs, ywake_s, ybeta, iflag_split, &
-                         yTs, y_delta_tsurf,  & 
-                         yqsurf, yTsurf_new,  &
-                         y_delta_qsats, y_delta_tsurf_new, y_delta_qsurf,  &
-                         AcoefH_x, AcoefH_w, &
-                         BcoefH_x, BcoefH_w, &
-                         AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0,  &
-                         AcoefH, AcoefQ, BcoefH, BcoefQ,  &
-                         HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
-                         phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
-                         yg_T, yg_Q, &
-                         yGamma_dTs_phiT, yGamma_dQs_phiQ, &
-                         ydTs_ins, ydqs_ins, &
-                         y_flux_t1, y_flux_q1,  &
-                         y_flux_t1_x, y_flux_t1_w, &
-                         y_flux_q1_x, y_flux_q1_w )
-         ENDIF   ! (nsrf .ne. is_oce)
-!
-       ELSE  ! (iflag_split .ge. 1)
-         ybeta(1:knon) = 1.
-         yevap_pot(1:knon) = yevap(1:knon)
-       ENDIF  ! (iflag_split .ge. 1)
-!
-       IF (prt_level >= 10) THEN
-         print *,'pbl_surface, ybeta , yevap, yevap_pot ', &
-                               ybeta , yevap, yevap_pot
-       ENDIF  ! (prt_level >= 10)
-!
-!>jyg
-!
- 
-!!jyg!!   A reprendre apres reflexion   ===============================================
-!!jyg!!
-!!jyg!!        DO j=1,knon
-!!jyg!!!!! nrlmd le 13/06/2011
-!!jyg!!
-!!jyg!!!----Diffusion dans le sol dans le cas continental seulement
-!!jyg!!       IF (nsrf.eq.is_ter) THEN
-!!jyg!!!----Calcul du coefficient delta_coeff
-!!jyg!!          tau_eq(j)=(ywake_s(j)/2.)*(1./max(wake_cstar(j),0.01))*sqrt(0.4/(3.14*max(wake_dens(j),8e-12)))
-!!jyg!!
-!!jyg!!!          delta_coef(j)=dtime/(inertia*sqrt(tau_eq(j)))
-!!jyg!!          delta_coef(j)=facteur*sqrt(tau_eq(j))/inertia
-!!jyg!!!          delta_coef(j)=0.
-!!jyg!!       ELSE 
-!!jyg!!         delta_coef(j)=0.
-!!jyg!!       ENDIF
-!!jyg!!
-!!jyg!!!----Calcul de delta_tsurf
-!!jyg!!         y_delta_tsurf(j)=delta_coef(j)*y_delta_flux_t1(j)
-!!jyg!!
-!!jyg!!!----Si il n'y a pas des poches...
-!!jyg!!         IF (wake_cstar(j).le.0.01) THEN
-!!jyg!!           y_delta_tsurf(j)=0.
-!!jyg!!           y_delta_flux_t1(j)=0.
-!!jyg!!         ENDIF
-!!jyg!!
-!!jyg!!!-----Calcul de ybeta (evap_r\'eelle/evap_potentielle)
-!!jyg!!!!!!! jyg le 23/02/2012
-!!jyg!!!!!!!
-!!jyg!!!!        ybeta(j)=y_flux_q1(j)   /    &
-!!jyg!!!! &        (Kech_h(j)*(yq(j,1)-yqsatsurf(j)))
-!!jyg!!!!!!        ybeta(j)=-1.*yevap(j)   /    &
-!!jyg!!!!!! &        (ywake_s(j)*Kech_h_w(j)*(yq_w(j,1)-yqsatsurf_w(j))+(1.-ywake_s(j))*Kech_h_x(j)*(yq_x(j,1)-yqsatsurf_x(j)))
-!!jyg!!!!!!! fin jyg
-!!jyg!!!!!
-!!jyg!!
-!!jyg!!       ENDDO
-!!jyg!!
-!!jyg!!!!! fin nrlmd le 13/06/2011
-!!jyg!!
-       IF (iflag_split .ge. 1) THEN
-       IF (prt_level >=10) THEN
-        DO j = 1, knon
-         print*,'Chx,Chw,Ch', ycdragh_x(j), ycdragh_w(j), ycdragh(j)
-         print*,'Khx,Khw,Kh', Kech_h_x(j), Kech_h_w(j), Kech_h(j)
-         print*,'t1x, t1w, t1, t1_ancien', &
- &               yt_x(j,1), yt_w(j,1),  yt(j,1), t(j,1)
-         print*,'delta_coef,delta_flux,delta_tsurf,tau', delta_coef(j), y_delta_flux_t1(j), y_delta_tsurf(j), tau_eq(j) 
-        ENDDO
-
-        DO j=1,knon
-         print*,'fluxT_x, fluxT_w, y_flux_t1, fluxQ_x, fluxQ_w, yfluxlat, wakes' &
- &             , y_flux_t1_x(j), y_flux_t1_w(j), y_flux_t1(j), y_flux_q1_x(j)*RLVTT, y_flux_q1_w(j)*RLVTT, yfluxlat(j), ywake_s(j)
-         print*,'beta, ytsurf_new ', ybeta(j), ytsurf_new(j)
-         print*,'inertia, facteur, cstar', inertia, facteur,wake_cstar(j)
-        ENDDO
-       ENDIF  ! (prt_level >=10)
-
-!!! jyg le 07/02/2012
-       ENDIF  ! (iflag_split .ge.1)
-!!!
-
-!!! jyg le 07/02/2012
-       IF (iflag_split .eq.0) THEN
-!!!
-!!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
-        CALL climb_hq_up(knon, dtime, yt, yq, &
-            y_flux_q1, y_flux_t1, ypaprs, ypplay, &
-!!! jyg le 07/02/2012
-            AcoefH, AcoefQ, BcoefH, BcoefQ, &
-            CcoefH, CcoefQ, DcoefH, DcoefQ, &
-            Kcoef_hq, gama_q, gama_h, &
-!!!
-            y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:) &
-#ifdef ISO
-        &    ,yxt,y_flux_xt1 &
-        &    ,AcoefXT,BcoefXT,CcoefXT,DcoefXT,gama_xt &
-        &    ,y_flux_xt(:,:,:),y_d_xt(:,:,:) &
-#endif
-        &    )    
-       ELSE  !(iflag_split .eq.0)
-        CALL climb_hq_up(knon, dtime, yt_x, yq_x, &
-            y_flux_q1_x, y_flux_t1_x, ypaprs, ypplay, &
-!!! nrlmd le 02/05/2011
-            AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x, &
-            CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x, &
-            Kcoef_hq_x, gama_q_x, gama_h_x, &
-!!!
-            y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:) &
-#ifdef ISO
-        &    ,yxt_x,y_flux_xt1_x &
-        &    ,AcoefXT_x,BcoefXT_x,CcoefXT_x,DcoefXT_x,gama_xt_x &
-        &    ,y_flux_xt_x(:,:,:),y_d_xt_x(:,:,:) &
-#endif
-        &    )    
-!
-       CALL climb_hq_up(knon, dtime, yt_w, yq_w, &
-            y_flux_q1_w, y_flux_t1_w, ypaprs, ypplay, &
-!!! nrlmd le 02/05/2011
-            AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w, &
-            CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w, &
-            Kcoef_hq_w, gama_q_w, gama_h_w, &
-!!!
-            y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:) &
-#ifdef ISO
-        &    ,yxt_w,y_flux_xt1_w &
-        &    ,AcoefXT_w,BcoefXT_w,CcoefXT_w,DcoefXT_w,gama_xt_w &
-        &    ,y_flux_xt_w(:,:,:),y_d_xt_w(:,:,:) &
-#endif
-        &    )    
-!!!
-       ENDIF  ! (iflag_split .eq.0)
-!!!
-
-!!! jyg le 07/02/2012
-       IF (iflag_split .eq.0) THEN
-!!!
-!!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
-        CALL climb_wind_up(knon, dtime, yu, yv, y_flux_u1, y_flux_v1, &
-!!! jyg le 07/02/2012
-            AcoefU, AcoefV, BcoefU, BcoefV, &
-            CcoefU, CcoefV, DcoefU, DcoefV, &
-            Kcoef_m, &
-!!!
-            y_flux_u, y_flux_v, y_d_u, y_d_v)
-     y_d_t_diss(:,:)=0.
-     IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
-        CALL yamada_c(knon,dtime,ypaprs,ypplay &
-    &   ,yu,yv,yt,y_d_u,y_d_v,y_d_t,ycdragm,ytke,ycoefm,ycoefh,ycoefq,y_d_t_diss,yustar &
-    &   ,iflag_pbl)
-     ENDIF
-!     print*,'yamada_c OK'
-
-       ELSE  !(iflag_split .eq.0)
-        CALL climb_wind_up(knon, dtime, yu_x, yv_x, y_flux_u1_x, y_flux_v1_x, &
-!!! nrlmd le 02/05/2011
-            AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x, &
-            CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, &
-            Kcoef_m_x, &
-!!!
-            y_flux_u_x, y_flux_v_x, y_d_u_x, y_d_v_x)
-!
-     y_d_t_diss_x(:,:)=0.
-     IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
-        CALL yamada_c(knon,dtime,ypaprs,ypplay &
-    &   ,yu_x,yv_x,yt_x,y_d_u_x,y_d_v_x,y_d_t_x,ycdragm_x,ytke_x,ycoefm_x,ycoefh_x &
-        ,ycoefq_x,y_d_t_diss_x,yustar_x &
-    &   ,iflag_pbl)
-     ENDIF
-!     print*,'yamada_c OK'
-
-        CALL climb_wind_up(knon, dtime, yu_w, yv_w, y_flux_u1_w, y_flux_v1_w, &
-!!! nrlmd le 02/05/2011
-            AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w, &
-            CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w, &
-            Kcoef_m_w, &
-!!!
-            y_flux_u_w, y_flux_v_w, y_d_u_w, y_d_v_w)
-!!!
-     y_d_t_diss_w(:,:)=0.
-     IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
-        CALL yamada_c(knon,dtime,ypaprs,ypplay &
-    &   ,yu_w,yv_w,yt_w,y_d_u_w,y_d_v_w,y_d_t_w,ycdragm_w,ytke_w,ycoefm_w,ycoefh_w &
-        ,ycoefq_w,y_d_t_diss_w,yustar_w &
-    &   ,iflag_pbl)
-     ENDIF
-!     print*,'yamada_c OK'
-!
-        IF (prt_level >=10) THEN
-         print *, 'After climbing up, lfuxlat_x, fluxlat_w ', &
-               yfluxlat_x, yfluxlat_w
-        ENDIF
-!
-       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
-
-!!!
-!!
-!!        DO j = 1, knon
-!!          y_dflux_t(j) = y_dflux_t(j) * ypct(j)
-!!          y_dflux_q(j) = y_dflux_q(j) * ypct(j)
-!!        ENDDO
-!!
-!****************************************************************************************
-! 13) Transform variables for output format : 
-!     - Decompress
-!     - Multiply with pourcentage of current surface
-!     - Cumulate in global variable
-!
-!****************************************************************************************
-#ifdef ISO
-        !write(*,*) 'pbl_surface tmp 2575'
-#ifdef ISOVERIF
-        if (iso_eau.gt.0) then
-         call iso_verif_egalite_vect2D( &
-                y_d_xt,y_d_q, &
-                'pbl_surface_mod 2581',ntraciso,klon,klev)
-        endif       
-#endif
-#endif
-
-
-!!! jyg le 07/02/2012
-       IF (iflag_split.EQ.0) THEN
-!!!
-        DO k = 1, klev
-           DO j = 1, knon
-             i = ni(j)
-             y_d_t_diss(j,k)  = y_d_t_diss(j,k) * ypct(j)
-             y_d_t(j,k)  = y_d_t(j,k) * ypct(j)
-             y_d_q(j,k)  = y_d_q(j,k) * ypct(j)
-             y_d_u(j,k)  = y_d_u(j,k) * ypct(j)
-             y_d_v(j,k)  = y_d_v(j,k) * ypct(j)
-!FC
-             IF  (nsrf .EQ. is_ter .and. ifl_pbltree .GE. 1) THEN
-!            if (y_d_u_frein(j,k).ne.0. ) then
-!        print*, nsrf,'IS_TER ++', y_d_u_frein(j,k)*ypct(j),y_d_u(j,k),j,k
-!            ENDIF
-               y_d_u(j,k) =y_d_u(j,k) + y_d_u_frein(j,k)*ypct(j)
-               y_d_v(j,k) =y_d_v(j,k) + y_d_v_frein(j,k)*ypct(j)
-               treedrg(i,k,nsrf)=y_treedrg(j,k)
-             ELSE 
-               treedrg(i,k,nsrf)=0.
-             ENDIF
-!FC
-             flux_t(i,k,nsrf) = y_flux_t(j,k)
-             flux_q(i,k,nsrf) = y_flux_q(j,k)
-             flux_u(i,k,nsrf) = y_flux_u(j,k)
-             flux_v(i,k,nsrf) = y_flux_v(j,k)
-
-#ifdef ISO
-             do ixt=1,ntraciso
-                y_d_xt(ixt,j,k)  = y_d_xt(ixt,j,k) * ypct(j)
-                flux_xt(ixt,i,k,nsrf) = y_flux_xt(ixt,j,k)
-             enddo ! do ixt=1,ntraciso
-             h1_diag(i)=h1(j)
-#endif
-
-           ENDDO
-        ENDDO
-#ifdef ISO
-#ifdef ISOVERIF
-        if (iso_eau.gt.0) then
-         call iso_verif_egalite_vect2D( &
-                y_d_xt,y_d_q, &
-                'pbl_surface_mod 2600',ntraciso,klon,klev)
-        endif       
-#endif
-#endif
-
-       ELSE  !(iflag_split .eq.0)
-
-! Tendances hors poches
-        DO k = 1, klev
-          DO j = 1, knon
-            i = ni(j)
-            y_d_t_diss_x(j,k)  = y_d_t_diss_x(j,k) * ypct(j)
-            y_d_t_x(j,k)  = y_d_t_x(j,k) * ypct(j)
-            y_d_q_x(j,k)  = y_d_q_x(j,k) * ypct(j)
-            y_d_u_x(j,k)  = y_d_u_x(j,k) * ypct(j)
-            y_d_v_x(j,k)  = y_d_v_x(j,k) * ypct(j)
-
-            flux_t_x(i,k,nsrf) = y_flux_t_x(j,k)
-            flux_q_x(i,k,nsrf) = y_flux_q_x(j,k)
-            flux_u_x(i,k,nsrf) = y_flux_u_x(j,k)
-            flux_v_x(i,k,nsrf) = y_flux_v_x(j,k)
-
-#ifdef ISO
-             do ixt=1,ntraciso
-                y_d_xt_x(ixt,j,k)  = y_d_xt_x(ixt,j,k) * ypct(j)
-                flux_xt_x(ixt,i,k,nsrf) = y_flux_xt_x(ixt,j,k)
-             enddo ! do ixt=1,ntraciso
-#endif
-          ENDDO
-        ENDDO
-
-! Tendances dans les poches
-        DO k = 1, klev
-          DO j = 1, knon
-            i = ni(j)
-            y_d_t_diss_w(j,k)  = y_d_t_diss_w(j,k) * ypct(j)
-            y_d_t_w(j,k)  = y_d_t_w(j,k) * ypct(j)
-            y_d_q_w(j,k)  = y_d_q_w(j,k) * ypct(j)
-            y_d_u_w(j,k)  = y_d_u_w(j,k) * ypct(j)
-            y_d_v_w(j,k)  = y_d_v_w(j,k) * ypct(j)
-
-            flux_t_w(i,k,nsrf) = y_flux_t_w(j,k)
-            flux_q_w(i,k,nsrf) = y_flux_q_w(j,k)
-            flux_u_w(i,k,nsrf) = y_flux_u_w(j,k)
-            flux_v_w(i,k,nsrf) = y_flux_v_w(j,k)
-#ifdef ISO
-             do ixt=1,ntraciso
-                y_d_xt_w(ixt,j,k)  = y_d_xt_w(ixt,j,k) * ypct(j)
-                flux_xt_w(ixt,i,k,nsrf) = y_flux_xt_w(ixt,j,k)
-             enddo ! do ixt=1,ntraciso
-#endif
-
-          ENDDO
-        ENDDO
-
-! Flux, tendances et Tke moyenne dans la maille
-        DO k = 1, klev
-          DO j = 1, knon
-            i = ni(j)
-            flux_t(i,k,nsrf) = flux_t_x(i,k,nsrf)+ywake_s(j)*(flux_t_w(i,k,nsrf)-flux_t_x(i,k,nsrf))
-            flux_q(i,k,nsrf) = flux_q_x(i,k,nsrf)+ywake_s(j)*(flux_q_w(i,k,nsrf)-flux_q_x(i,k,nsrf))
-            flux_u(i,k,nsrf) = flux_u_x(i,k,nsrf)+ywake_s(j)*(flux_u_w(i,k,nsrf)-flux_u_x(i,k,nsrf))
-            flux_v(i,k,nsrf) = flux_v_x(i,k,nsrf)+ywake_s(j)*(flux_v_w(i,k,nsrf)-flux_v_x(i,k,nsrf))
-#ifdef ISO
-            do ixt=1,ntraciso
-            flux_xt(ixt,i,k,nsrf) = flux_xt_x(ixt,i,k,nsrf)+ywake_s(j)*(flux_xt_w(ixt,i,k,nsrf)-flux_xt_x(ixt,i,k,nsrf))
-            enddo ! do ixt=1,ntraciso
-#endif
-          ENDDO
-        ENDDO
-        DO j=1,knon
-          yfluxlat(j)=yfluxlat_x(j)+ywake_s(j)*(yfluxlat_w(j)-yfluxlat_x(j))
-        ENDDO
-        IF (prt_level >=10) THEN
-          print *,' nsrf, flux_t(:,1,nsrf), flux_t_x(:,1,nsrf), flux_t_w(:,1,nsrf) ', &
-                    nsrf, flux_t(:,1,nsrf), flux_t_x(:,1,nsrf), flux_t_w(:,1,nsrf)
-        ENDIF
-
-        DO k = 1, klev
-          DO j = 1, knon
-            y_d_t_diss(j,k) = y_d_t_diss_x(j,k)+ywake_s(j)*(y_d_t_diss_w(j,k) -y_d_t_diss_x(j,k))
-            y_d_t(j,k) = y_d_t_x(j,k)+ywake_s(j)*(y_d_t_w(j,k) -y_d_t_x(j,k))
-            y_d_q(j,k) = y_d_q_x(j,k)+ywake_s(j)*(y_d_q_w(j,k) -y_d_q_x(j,k))
-            y_d_u(j,k) = y_d_u_x(j,k)+ywake_s(j)*(y_d_u_w(j,k) -y_d_u_x(j,k))
-            y_d_v(j,k) = y_d_v_x(j,k)+ywake_s(j)*(y_d_v_w(j,k) -y_d_v_x(j,k))
-#ifdef ISO
-            do ixt=1,ntraciso
-              y_d_xt(ixt,j,k) = y_d_xt_x(ixt,j,k)+ywake_s(j)*(y_d_xt_w(ixt,j,k) -y_d_xt_x(ixt,j,k))
-            enddo ! do ixt=1,ntraciso
-#endif
-
-          ENDDO
-        ENDDO
-
-       ENDIF  ! (iflag_split .eq.0)
-!!!
-
-       ! 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)
-!albedo SB >>>
-          DO k=1,nsw
-            alb_dir(i,k,nsrf) = yalb_dir_new(j,k)
-            alb_dif(i,k,nsrf) = yalb_dif_new(j,k)
-          ENDDO
-!albedo SB <<<
-          snow(i,nsrf) = ysnow(j)  
-          qsurf(i,nsrf) = yqsurf(j)
-          z0m(i,nsrf) = yz0m(j)
-          z0h(i,nsrf) = yz0h(j)
-          fluxlat(i,nsrf) = yfluxlat(j)
-          agesno(i,nsrf) = yagesno(j)  
-          cdragh(i) = cdragh(i) + ycdragh(j)*ypct(j)
-          cdragm(i) = cdragm(i) + ycdragm(j)*ypct(j)
-          dflux_t(i) = dflux_t(i) + y_dflux_t(j)*ypct(j)
-          dflux_q(i) = dflux_q(i) + y_dflux_q(j)*ypct(j)
-#ifdef ISO
-        do ixt=1,niso
-          xtsnow(ixt,i,nsrf) = yxtsnow(ixt,j)  
-        enddo
-        do ixt=1,ntraciso
-          xtevap(ixt,i,nsrf) = - flux_xt(ixt,i,1,nsrf)
-          dflux_xt(ixt,i) = dflux_xt(ixt,i) + y_dflux_xt(ixt,j)*ypct(j)
-        enddo  
-        IF (nsrf == is_lic) THEN
-          do ixt=1,niso
-            Rland_ice(ixt,i) = yRland_ice(ixt,j)  
-          enddo
-        endif !IF (nsrf == is_lic) THEN     
-#ifdef ISOVERIF
-        if (iso_eau.gt.0) then  
-          call iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
-     &         'pbl_surf_mod 1230',errmax,errmaxrel)
-        endif !if (iso_eau.gt.0) then
-#endif        
-#endif
-       END DO !DO j = 1, knon
-
-
-!      print*,'Dans pbl OK2'
-
-!!! jyg le 07/02/2012
-       IF (iflag_split .ge.1) THEN
-!!!
-!!! nrlmd le 02/05/2011
-        DO j = 1, knon
-          i = ni(j)
-          fluxlat_x(i,nsrf) = yfluxlat_x(j)
-          fluxlat_w(i,nsrf) = yfluxlat_w(j)
-!!!
-!!! nrlmd le 13/06/2011
-!!jyg20170131          delta_tsurf(i,nsrf)=y_delta_tsurf(j)*ypct(j)
-!!jyg20210118          delta_tsurf(i,nsrf)=y_delta_tsurf(j)
-          delta_tsurf(i,nsrf)=y_delta_tsurf_new(j)
-!
-          delta_qsurf(i) = delta_qsurf(i) + y_delta_qsurf(j)*ypct(j)
-!
-          cdragh_x(i) = cdragh_x(i) + ycdragh_x(j)*ypct(j)
-          cdragh_w(i) = cdragh_w(i) + ycdragh_w(j)*ypct(j)
-          cdragm_x(i) = cdragm_x(i) + ycdragm_x(j)*ypct(j)
-          cdragm_w(i) = cdragm_w(i) + ycdragm_w(j)*ypct(j)
-          kh(i) = kh(i) + Kech_h(j)*ypct(j)
-          kh_x(i) = kh_x(i) + Kech_h_x(j)*ypct(j)
-          kh_w(i) = kh_w(i) + Kech_h_w(j)*ypct(j)
-!!!
-        ENDDO
-!!!      
-       ENDIF  ! (iflag_split .ge.1)
-!!!
-!!! nrlmd le 02/05/2011
-!!jyg le 20/02/2011
-!!        tke_x(:,:,nsrf)=0.
-!!        tke_w(:,:,nsrf)=0.
-!!jyg le 20/02/2011
-!!        DO k = 1, klev+1
-!!          DO j = 1, knon
-!!            i = ni(j)
-!!            wake_dltke(i,k,nsrf) = ytke_w(j,k) - ytke_x(j,k)
-!!            tke(i,k,nsrf)   = ytke_x(j,k) + ywake_s(j)*wake_dltke(i,k,nsrf)
-!!          ENDDO
-!!        ENDDO
-!!jyg le 20/02/2011
-!!        DO k = 1, klev+1
-!!          DO j = 1, knon
-!!            i = ni(j)
-!!            tke(i,k,nsrf)=(1.-ywake_s(j))*tke_x(i,k,nsrf)+ywake_s(j)*tke_w(i,k,nsrf)
-!!          ENDDO
-!!        ENDDO
-!!!
-       IF (iflag_split .eq.0) THEN
-        wake_dltke(:,:,nsrf) = 0.
-        DO k = 1, klev+1
-           DO j = 1, knon
-              i = ni(j)
-!jyg<
-!!              tke(i,k,nsrf)    = ytke(j,k)
-!!              tke(i,k,is_ave) = tke(i,k,is_ave) + ytke(j,k)*ypct(j)
-              tke_x(i,k,nsrf)    = ytke(j,k)
-              tke_x(i,k,is_ave)  = tke_x(i,k,is_ave) + ytke(j,k)*ypct(j)
-              eps_x(i,k,nsrf)    = yeps(j,k)
-              eps_x(i,k,is_ave)  = eps_x(i,k,is_ave) + yeps(j,k)*ypct(j)
-!>jyg
-           ENDDO
-        ENDDO
-
-       ELSE  ! (iflag_split .eq.0)
-        DO k = 1, klev+1
-          DO j = 1, knon
-            i = ni(j)
-            wake_dltke(i,k,nsrf) = ytke_w(j,k) - ytke_x(j,k)
-!jyg<
-!!            tke(i,k,nsrf)   = ytke_x(j,k) + ywake_s(j)*wake_dltke(i,k,nsrf)
-!!            tke(i,k,is_ave) = tke(i,k,is_ave) + tke(i,k,nsrf)*ypct(j)
-            tke_x(i,k,nsrf)   = ytke_x(j,k)
-            tke_x(i,k,is_ave)   = tke_x(i,k,is_ave) + tke_x(i,k,nsrf)*ypct(j)       
-            eps_x(i,k,nsrf)   = yeps_x(j,k)
-            eps_x(i,k,is_ave)   = eps_x(i,k,is_ave) + eps_x(i,k,nsrf)*ypct(j) 
-            wake_dltke(i,k,is_ave)   = wake_dltke(i,k,is_ave) + wake_dltke(i,k,nsrf)*ypct(j)
-            
-
-!>jyg
-          ENDDO
-        ENDDO
-       ENDIF  ! (iflag_split .eq.0)
-!!!
-       DO k = 2, klev
-          DO j = 1, knon
-             i = ni(j)
-             zcoefh(i,k,nsrf) = ycoefh(j,k)
-             zcoefm(i,k,nsrf) = ycoefm(j,k)
-             zcoefh(i,k,is_ave) = zcoefh(i,k,is_ave) + ycoefh(j,k)*ypct(j)
-             zcoefm(i,k,is_ave) = zcoefm(i,k,is_ave) + ycoefm(j,k)*ypct(j)
-          ENDDO
-       ENDDO
-
-!      print*,'Dans pbl OK3'
-
-       IF ( nsrf .EQ. is_ter ) THEN 
-          DO j = 1, knon
-             i = ni(j)
-             qsol(i) = yqsol(j)
-#ifdef ISO
-             runoff_diag(i)=yrunoff_diag(j)   
-             do ixt=1,niso
-               xtsol(ixt,i) = yxtsol(ixt,j)
-               xtrunoff_diag(ixt,i)=yxtrunoff_diag(ixt,j)
-             enddo
-#endif
-          ENDDO
-       ENDIF
-       
-!jyg<
-!!       ftsoil(:,:,nsrf) = 0.
-!>jyg
-       DO k = 1, nsoilmx
-          DO j = 1, knon
-             i = ni(j)
-             ftsoil(i, k, nsrf) = ytsoil(j,k)
-          ENDDO
-       ENDDO
-       
-#ifdef ISO
-#ifdef ISOVERIF
-       !write(*,*) 'pbl_surface 2858'
-       DO i = 1, klon
-        do ixt=1,niso
-          call iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 1405')
-        enddo
-       enddo        
-#endif
-#ifdef ISOVERIF
-     if (iso_eau.gt.0) then
-        call iso_verif_egalite_vect2D( &
-                y_d_xt,y_d_q, &
-                'pbl_surface_mod 1261',ntraciso,klon,klev)
-     endif !if (iso_eau.gt.0) then
-#endif
-#endif 
-       
-!!! jyg le 07/02/2012
-       IF (iflag_split .ge.1) THEN
-!!!
-!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
-        DO k = 1, klev
-          DO j = 1, knon
-           i = ni(j)
-           d_t_diss_x(i,k) = d_t_diss_x(i,k) + y_d_t_diss_x(j,k)
-           d_t_x(i,k) = d_t_x(i,k) + y_d_t_x(j,k)
-           d_q_x(i,k) = d_q_x(i,k) + y_d_q_x(j,k)
-           d_u_x(i,k) = d_u_x(i,k) + y_d_u_x(j,k)
-           d_v_x(i,k) = d_v_x(i,k) + y_d_v_x(j,k)
-!
-           d_t_diss_w(i,k) = d_t_diss_w(i,k) + y_d_t_diss_w(j,k)
-           d_t_w(i,k) = d_t_w(i,k) + y_d_t_w(j,k)
-           d_q_w(i,k) = d_q_w(i,k) + y_d_q_w(j,k)
-           d_u_w(i,k) = d_u_w(i,k) + y_d_u_w(j,k)
-           d_v_w(i,k) = d_v_w(i,k) + y_d_v_w(j,k)
-
-#ifdef ISO
-           do ixt=1,ntraciso
-             d_xt_x(ixt,i,k) = d_xt_x(ixt,i,k) + y_d_xt_x(ixt,j,k)
-             d_xt_w(ixt,i,k) = d_xt_w(ixt,i,k) + y_d_xt_w(ixt,j,k)
-           enddo ! do ixt=1,ntraciso
-#endif
-!
-!!           d_wake_dlt(i,k) = d_wake_dlt(i,k) + y_d_t_w(i,k)-y_d_t_x(i,k)
-!!           d_wake_dlq(i,k) = d_wake_dlq(i,k) + y_d_q_w(i,k)-y_d_q_x(i,k)
-          ENDDO
-        ENDDO
-!!!
-       ENDIF  ! (iflag_split .ge.1)
-!!!
-       
-       DO k = 1, klev
-          DO j = 1, knon
-             i = ni(j)
-             d_t_diss(i,k) = d_t_diss(i,k) + y_d_t_diss(j,k)
-             d_t(i,k) = d_t(i,k) + y_d_t(j,k)
-             d_q(i,k) = d_q(i,k) + y_d_q(j,k)
-#ifdef ISO
-             do ixt=1,ntraciso
-              d_xt(ixt,i,k) = d_xt(ixt,i,k) + y_d_xt(ixt,j,k)
-             enddo !do ixt=1,ntraciso
-#endif
-             d_u(i,k) = d_u(i,k) + y_d_u(j,k)
-             d_v(i,k) = d_v(i,k) + y_d_v(j,k)
-          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
-#ifdef ISOVERIF
-!        write(*,*) 'd_q,d_xt(iso_eau,554,19)=',d_q(554,19),d_xt(iso_eau,554,19)
-!        write(*,*) 'pbl_surface 2929: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1)
-!        write(*,*) 'y_d_q,y_d_xt(iso_eau,2,1)=',y_d_q(2,1),y_d_xt(iso_eau,2,1)
-!        write(*,*) 'iso_eau.gt.0=',iso_eau.gt.0
-        call iso_verif_noNaN_vect2D( &
-     &           d_xt, &
-     &           'pbl_surface 1385',ntraciso,klon,klev)  
-     if (iso_eau.gt.0) then
-        call iso_verif_egalite_vect2D( &
-                y_d_xt,y_d_q, &
-                'pbl_surface_mod 2945',ntraciso,klon,klev)
-        call iso_verif_egalite_vect2D( &
-                d_xt,d_q, &
-                'pbl_surface_mod 1276',ntraciso,klon,klev)
-     endif !if (iso_eau.gt.0) then
-#endif
-#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)
-       ENDIF
-
-       if (nsrf == is_oce .and. activate_ocean_skin >= 1) then
-          delta_sal = missing_val
-          ds_ns = missing_val
-          dt_ns = missing_val
-          delta_sst = missing_val
-          dter = missing_val
-          dser = missing_val
-          tkt = missing_val
-          tks = missing_val
-          taur = missing_val
-          sss = missing_val
-          
-          delta_sal(ni(:knon)) = ydelta_sal(:knon)
-          ds_ns(ni(:knon)) = yds_ns(:knon)
-          dt_ns(ni(:knon)) = ydt_ns(:knon)
-          delta_sst(ni(:knon)) = ydelta_sst(:knon)
-          dter(ni(:knon)) = ydter(:knon)
-          dser(ni(:knon)) = ydser(:knon)
-          tkt(ni(:knon)) = ytkt(:knon)
-          tks(ni(:knon)) = ytks(:knon)
-          taur(ni(:knon)) = ytaur(:knon)
-          sss(ni(:knon)) = ysss(:knon)
-
-          if (activate_ocean_skin == 2 .and. type_ocean == "couple") then
-             dt_ds = missing_val
-             dt_ds(ni(:knon)) = ydt_ds(:knon)
-          end if
-       end if
-
-
-
-!****************************************************************************************
-! 14) Calculate the temperature and relative humidity at 2m and the wind at 10m 
-!     Call HBTM
-!
-!****************************************************************************************
-!!!
-!
-#undef T2m     
-#define T2m     
-#ifdef T2m
-! Calculations of diagnostic t,q at 2m and u, v at 10m
-
-!      print*,'Dans pbl OK41'
-!      print*,'tair1,yt(:,1),y_d_t(:,1)'
-!      print*, tair1,yt(:,1),y_d_t(:,1)
-!!! jyg le 07/02/2012
-       IF (iflag_split .eq.0) THEN
-        DO j=1, knon
-          uzon(j) = yu(j,1) + y_d_u(j,1)
-          vmer(j) = yv(j,1) + y_d_v(j,1)
-          tair1(j) = yt(j,1) + y_d_t(j,1) + y_d_t_diss(j,1)
-          qair1(j) = yq(j,1) + y_d_q(j,1)
-          zgeo1(j) = RD * tair1(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
-               * (ypaprs(j,1)-ypplay(j,1))
-          tairsol(j) = yts(j) + y_d_ts(j)
-          qairsol(j) = yqsurf(j)
-        ENDDO
-       ELSE  ! (iflag_split .eq.0)
-        DO j=1, knon
-          uzon_x(j) = yu_x(j,1) + y_d_u_x(j,1)
-          vmer_x(j) = yv_x(j,1) + y_d_v_x(j,1)
-          tair1_x(j) = yt_x(j,1) + y_d_t_x(j,1) + y_d_t_diss_x(j,1)
-          qair1_x(j) = yq_x(j,1) + y_d_q_x(j,1)
-          zgeo1_x(j) = RD * tair1_x(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
-               * (ypaprs(j,1)-ypplay(j,1))
-          tairsol(j) = yts(j) + y_d_ts(j)
-!!          tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf(j)
-          tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf_new(j)
-          qairsol(j) = yqsurf(j)
-        ENDDO
-        DO j=1, knon
-          uzon_w(j) = yu_w(j,1) + y_d_u_w(j,1)
-          vmer_w(j) = yv_w(j,1) + y_d_v_w(j,1)
-          tair1_w(j) = yt_w(j,1) + y_d_t_w(j,1) + y_d_t_diss_w(j,1)
-          qair1_w(j) = yq_w(j,1) + y_d_q_w(j,1)
-          zgeo1_w(j) = RD * tair1_w(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
-               * (ypaprs(j,1)-ypplay(j,1))
-          tairsol_w(j) = tairsol(j) + (1.- ywake_s(j))*y_delta_tsurf(j)
-          qairsol(j) = yqsurf(j)
-        ENDDO
-!!!      
-       ENDIF  ! (iflag_split .eq.0)
-!!!
-       DO j=1, knon
-!         i = ni(j)
-!         yz0h_oupas(j) = yz0m(j)
-!         IF(nsrf.EQ.is_oce) THEN
-!            yz0h_oupas(j) = z0m(i,nsrf)
-!         ENDIF
-          psfce(j)=ypaprs(j,1)
-          patm(j)=ypplay(j,1)
-       ENDDO
-
-       IF (iflag_pbl_surface_t2m_bug==1) THEN
-          yz0h_oupas(1:knon)=yz0m(1:knon)
-       ELSE
-          yz0h_oupas(1:knon)=yz0h(1:knon)
-       ENDIF
-       
-!      print*,'Dans pbl OK42A'
-!      print*,'tair1,yt(:,1),y_d_t(:,1)'
-!      print*, tair1,yt(:,1),y_d_t(:,1)
-
-! Calculate the temperature and relative humidity at 2m and the wind at 10m 
-!!! jyg le 07/02/2012
-       IF (iflag_split .eq.0) THEN
-        IF (iflag_new_t2mq2m==1) THEN
-           CALL stdlevvarn(klon, knon, nsrf, zxli, &
-            uzon, vmer, tair1, qair1, zgeo1, &
-            tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
-            yt2m, yq2m, yt10m, yq10m, yu10m, yustar, &
-            yn2mout(:, nsrf, :))
-        ELSE
-        CALL stdlevvar(klon, knon, nsrf, zxli, &
-            uzon, vmer, tair1, qair1, zgeo1, &
-            tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
-            yt2m, yq2m, yt10m, yq10m, yu10m, yustar, ypblh, rain_f, zxtsol)
-        ENDIF
-       ELSE  !(iflag_split .eq.0)
-        IF (iflag_new_t2mq2m==1) THEN
-         CALL stdlevvarn(klon, knon, nsrf, zxli, &
-            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, &
-            yn2mout_x(:, nsrf, :))
-         CALL stdlevvarn(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, &
-            yn2mout_w(:, nsrf, :))
-        ELSE
-        CALL stdlevvar(klon, knon, nsrf, zxli, &
-            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, 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, ypblh_w, rain_f, zxtsol)
-        ENDIF
-!!!
-       ENDIF  ! (iflag_split .eq.0)
-!!!
-!!! jyg le 07/02/2012
-       IF (iflag_split .eq.0) THEN
-        DO j=1, knon
-          i = ni(j)
-          t2m(i,nsrf)=yt2m(j)
-          q2m(i,nsrf)=yq2m(j)
-     ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
-          ustar(i,nsrf)=yustar(j)
-          u10m(i,nsrf)=(yu10m(j) * uzon(j))/SQRT(uzon(j)**2+vmer(j)**2)
-          v10m(i,nsrf)=(yu10m(j) * vmer(j))/SQRT(uzon(j)**2+vmer(j)**2)
-!
-          DO k = 1, 6
-           n2mout(i,nsrf,k) = yn2mout(j,nsrf,k)
-          END DO  
-!
-        ENDDO
-       ELSE  !(iflag_split .eq.0)
-        DO j=1, knon
-          i = ni(j)
-          t2m_x(i,nsrf)=yt2m_x(j)
-          q2m_x(i,nsrf)=yq2m_x(j)
-     ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
-          ustar_x(i,nsrf)=yustar_x(j)
-          u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
-          v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
-!
-          DO k = 1, 6
-           n2mout_x(i,nsrf,k) = yn2mout_x(j,nsrf,k)
-          END DO  
-!
-        ENDDO
-        DO j=1, knon
-          i = ni(j)
-          t2m_w(i,nsrf)=yt2m_w(j)
-          q2m_w(i,nsrf)=yq2m_w(j)
-     ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
-          ustar_w(i,nsrf)=yustar_w(j)
-          u10m_w(i,nsrf)=(yu10m_w(j) * uzon_w(j))/SQRT(uzon_w(j)**2+vmer_w(j)**2)
-          v10m_w(i,nsrf)=(yu10m_w(j) * vmer_w(j))/SQRT(uzon_w(j)**2+vmer_w(j)**2)
-!
-          ustar(i,nsrf) = ustar_x(i,nsrf) + wake_s(i)*(ustar_w(i,nsrf)-ustar_x(i,nsrf))
-          u10m(i,nsrf) = u10m_x(i,nsrf) + wake_s(i)*(u10m_w(i,nsrf)-u10m_x(i,nsrf))
-          v10m(i,nsrf) = v10m_x(i,nsrf) + wake_s(i)*(v10m_w(i,nsrf)-v10m_x(i,nsrf))
-!
-          DO k = 1, 6
-           n2mout_w(i,nsrf,k) = yn2mout_w(j,nsrf,k)
-          END DO  
-!
-        ENDDO
-!!!
-       ENDIF  ! (iflag_split .eq.0)
-!!!
-
-!      print*,'Dans pbl OK43'
-!IM Calcule de l'humidite relative a 2m (rh2m) pour diagnostique
-!IM Ajoute dependance type surface
-       IF (thermcep) THEN
-!!! jyg le 07/02/2012
-       IF (iflag_split .eq.0) THEN
-          DO j = 1, knon
-             i=ni(j)
-             zdelta1 = MAX(0.,SIGN(1., rtt-yt2m(j) ))
-             zx_qs1  = r2es * FOEEW(yt2m(j),zdelta1)/paprs(i,1)
-             zx_qs1  = MIN(0.5,zx_qs1)
-             zcor1   = 1./(1.-RETV*zx_qs1)
-             zx_qs1  = zx_qs1*zcor1
-             
-             rh2m(i)   = rh2m(i)   + yq2m(j)/zx_qs1 * pctsrf(i,nsrf)
-             qsat2m(i) = qsat2m(i) + zx_qs1  * pctsrf(i,nsrf)
-          ENDDO
-       ELSE  ! (iflag_split .eq.0)
-          DO j = 1, knon
-             i=ni(j)
-             zdelta1 = MAX(0.,SIGN(1., rtt-yt2m_x(j) ))
-             zx_qs1  = r2es * FOEEW(yt2m_x(j),zdelta1)/paprs(i,1)
-             zx_qs1  = MIN(0.5,zx_qs1)
-             zcor1   = 1./(1.-RETV*zx_qs1)
-             zx_qs1  = zx_qs1*zcor1
-             
-             rh2m_x(i)   = rh2m_x(i)   + yq2m_x(j)/zx_qs1 * pctsrf(i,nsrf)
-             qsat2m_x(i) = qsat2m_x(i) + zx_qs1  * pctsrf(i,nsrf)
-          ENDDO
-          DO j = 1, knon
-             i=ni(j)
-             zdelta1 = MAX(0.,SIGN(1., rtt-yt2m_w(j) ))
-             zx_qs1  = r2es * FOEEW(yt2m_w(j),zdelta1)/paprs(i,1)
-             zx_qs1  = MIN(0.5,zx_qs1)
-             zcor1   = 1./(1.-RETV*zx_qs1)
-             zx_qs1  = zx_qs1*zcor1
-             
-             rh2m_w(i)   = rh2m_w(i)   + yq2m_w(j)/zx_qs1 * pctsrf(i,nsrf)
-             qsat2m_w(i) = qsat2m_w(i) + zx_qs1  * pctsrf(i,nsrf)
-          ENDDO
-!!!      
-       ENDIF  ! (iflag_split .eq.0)
-!!!
-       ENDIF
-!
-       IF (prt_level >=10) THEN
-         print *, 'T2m, q2m, RH2m ', &
-          t2m, q2m, rh2m
-       ENDIF
-
-!   print*,'OK pbl 5'
-!
-!!! jyg le 07/02/2012
-       IF (iflag_split .eq.0) THEN
-        CALL hbtm(knon, ypaprs, ypplay, &
-            yt2m,yt10m,yq2m,yq10m,yustar,ywstar, &
-            y_flux_t,y_flux_q,yu,yv,yt,yq, &
-            ypblh,ycapCL,yoliqCL,ycteiCL,ypblT, &
-            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
-          ENDIF
-       ELSE  ! (iflag_split .eq.0)
-        CALL HBTM(knon, ypaprs, ypplay, &
-            yt2m_x,yt10m_x,yq2m_x,yq10m_x,yustar_x,ywstar_x, &
-            y_flux_t_x,y_flux_q_x,yu_x,yv_x,yt_x,yq_x, &
-            ypblh_x,ycapCL_x,yoliqCL_x,ycteiCL_x,ypblT_x, &
-            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
-          ENDIF
-        CALL HBTM(knon, ypaprs, ypplay, &
-            yt2m_w,yt10m_w,yq2m_w,yq10m_w,yustar_w,ywstar_w, &
-            y_flux_t_w,y_flux_q_w,yu_w,yv_w,yt_w,yq_w, &
-            ypblh_w,ycapCL_w,yoliqCL_w,ycteiCL_w,ypblT_w, &
-            ytherm_w,ytrmb1_w,ytrmb2_w,ytrmb3_w,ylcl_w)
-!!!      
-       ENDIF  ! (iflag_split .eq.0)
-!!!
-       
-!!! jyg le 07/02/2012
-       IF (iflag_split .eq.0) THEN
-!!!
-        DO j=1, knon
-          i = ni(j)
-          pblh(i,nsrf)   = ypblh(j)
-          wstar(i,nsrf)  = ywstar(j)
-          plcl(i,nsrf)   = ylcl(j)
-          capCL(i,nsrf)  = ycapCL(j)
-          oliqCL(i,nsrf) = yoliqCL(j)
-          cteiCL(i,nsrf) = ycteiCL(j)
-          pblT(i,nsrf)   = ypblT(j)
-          therm(i,nsrf)  = ytherm(j)
-          trmb1(i,nsrf)  = ytrmb1(j)
-          trmb2(i,nsrf)  = ytrmb2(j)
-          trmb3(i,nsrf)  = ytrmb3(j)
-        ENDDO
-        IF (prt_level >=10) THEN
-          print *, 'After HBTM: pblh ', pblh
-          print *, 'After HBTM: plcl ', plcl
-          print *, 'After HBTM: cteiCL ', cteiCL
-        ENDIF
-       ELSE  !(iflag_split .eq.0)
-        DO j=1, knon
-          i = ni(j)
-          pblh_x(i,nsrf)   = ypblh_x(j)
-          wstar_x(i,nsrf)  = ywstar_x(j)
-          plcl_x(i,nsrf)   = ylcl_x(j)
-          capCL_x(i,nsrf)  = ycapCL_x(j)
-          oliqCL_x(i,nsrf) = yoliqCL_x(j)
-          cteiCL_x(i,nsrf) = ycteiCL_x(j)
-          pblT_x(i,nsrf)   = ypblT_x(j)
-          therm_x(i,nsrf)  = ytherm_x(j)
-          trmb1_x(i,nsrf)  = ytrmb1_x(j)
-          trmb2_x(i,nsrf)  = ytrmb2_x(j)
-          trmb3_x(i,nsrf)  = ytrmb3_x(j)
-        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
-        ENDIF
-        DO j=1, knon
-          i = ni(j)
-          pblh_w(i,nsrf)   = ypblh_w(j)
-          wstar_w(i,nsrf)  = ywstar_w(j)
-          plcl_w(i,nsrf)   = ylcl_w(j)
-          capCL_w(i,nsrf)  = ycapCL_w(j)
-          oliqCL_w(i,nsrf) = yoliqCL_w(j)
-          cteiCL_w(i,nsrf) = ycteiCL_w(j)
-          pblT_w(i,nsrf)   = ypblT_w(j)
-          therm_w(i,nsrf)  = ytherm_w(j)
-          trmb1_w(i,nsrf)  = ytrmb1_w(j)
-          trmb2_w(i,nsrf)  = ytrmb2_w(j)
-          trmb3_w(i,nsrf)  = ytrmb3_w(j)
-        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
-        ENDIF
-!!!
-       ENDIF  ! (iflag_split .eq.0)
-!!!
-
-!   print*,'OK pbl 6'
-#else 
-! T2m not defined
-! No calculation
-       PRINT*,' Warning !!! No T2m calculation. Output is set to zero.'
-#endif
-
-!****************************************************************************************
-! 15) End of loop over different surfaces
-!
-!****************************************************************************************
-    ENDDO loop_nbsrf
-!
-!----------------------------------------------------------------------------------------
-!   Reset iflag_split 
-!
-   iflag_split=iflag_split_ref
-
-#ifdef ISO
-#ifdef ISOVERIF
-!        write(*,*) 'pbl_surface tmp 3249: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1)
-        if (iso_eau.gt.0) then
-        call iso_verif_egalite_vect2D( &
-                d_xt,d_q, &
-                'pbl_surface_mod 1276',ntraciso,klon,klev)
-     endif !if (iso_eau.gt.0) then
-#endif
-#endif
-
-!****************************************************************************************
-! 16) Calculate the mean value over all sub-surfaces for some variables
-!
-!****************************************************************************************
-    
-    z0m(:,nbsrf+1) = 0.0
-    z0h(:,nbsrf+1) = 0.0
-    DO nsrf = 1, nbsrf
-       DO i = 1, klon
-          z0m(i,nbsrf+1) = z0m(i,nbsrf+1) + z0m(i,nsrf)*pctsrf(i,nsrf)
-          z0h(i,nbsrf+1) = z0h(i,nbsrf+1) + z0h(i,nsrf)*pctsrf(i,nsrf)
-       ENDDO
-    ENDDO
-
-!   print*,'OK pbl 7'
-    zxfluxt(:,:) = 0.0 ; zxfluxq(:,:) = 0.0
-    zxfluxu(:,:) = 0.0 ; zxfluxv(:,:) = 0.0
-    zxfluxt_x(:,:) = 0.0 ; zxfluxq_x(:,:) = 0.0
-    zxfluxu_x(:,:) = 0.0 ; zxfluxv_x(:,:) = 0.0
-    zxfluxt_w(:,:) = 0.0 ; zxfluxq_w(:,:) = 0.0
-    zxfluxu_w(:,:) = 0.0 ; zxfluxv_w(:,:) = 0.0
-#ifdef ISO
-        zxfluxxt(:,:,:) = 0.0 
-        zxfluxxt_x(:,:,:) = 0.0
-        zxfluxxt_w(:,:,:) = 0.0
-#endif
-
-!!! jyg le 07/02/2012
-       IF (iflag_split .ge.1) THEN
-!!!
-!!! nrlmd & jyg les 02/05/2011, 05/02/2012
-
-        DO nsrf = 1, nbsrf
-          DO k = 1, klev
-            DO i = 1, klon
-              zxfluxt_x(i,k) = zxfluxt_x(i,k) + flux_t_x(i,k,nsrf) * pctsrf(i,nsrf)
-              zxfluxq_x(i,k) = zxfluxq_x(i,k) + flux_q_x(i,k,nsrf) * pctsrf(i,nsrf)
-              zxfluxu_x(i,k) = zxfluxu_x(i,k) + flux_u_x(i,k,nsrf) * pctsrf(i,nsrf)
-              zxfluxv_x(i,k) = zxfluxv_x(i,k) + flux_v_x(i,k,nsrf) * pctsrf(i,nsrf)
-!
-              zxfluxt_w(i,k) = zxfluxt_w(i,k) + flux_t_w(i,k,nsrf) * pctsrf(i,nsrf)
-              zxfluxq_w(i,k) = zxfluxq_w(i,k) + flux_q_w(i,k,nsrf) * pctsrf(i,nsrf)
-              zxfluxu_w(i,k) = zxfluxu_w(i,k) + flux_u_w(i,k,nsrf) * pctsrf(i,nsrf)
-              zxfluxv_w(i,k) = zxfluxv_w(i,k) + flux_v_w(i,k,nsrf) * pctsrf(i,nsrf)
-#ifdef ISO
-        do ixt=1,ntraciso
-              zxfluxxt_x(ixt,i,k) = zxfluxxt_x(ixt,i,k) + flux_xt_x(ixt,i,k,nsrf) * pctsrf(i,nsrf)
-              zxfluxxt_w(ixt,i,k) = zxfluxxt_w(ixt,i,k) + flux_xt_w(ixt,i,k,nsrf) * pctsrf(i,nsrf)
-        enddo ! do ixt=1,ntraciso
-#endif
-            ENDDO
-          ENDDO
-        ENDDO
-
-    DO i = 1, klon
-      zxsens_x(i) = - zxfluxt_x(i,1)
-      zxsens_w(i) = - zxfluxt_w(i,1)
-    ENDDO
-!!!
-       ENDIF  ! (iflag_split .ge.1)
-!!!
-
-    DO nsrf = 1, nbsrf
-       DO k = 1, klev
-          DO i = 1, klon
-             zxfluxt(i,k) = zxfluxt(i,k) + flux_t(i,k,nsrf) * pctsrf(i,nsrf)
-             zxfluxq(i,k) = zxfluxq(i,k) + flux_q(i,k,nsrf) * pctsrf(i,nsrf)
-             zxfluxu(i,k) = zxfluxu(i,k) + flux_u(i,k,nsrf) * pctsrf(i,nsrf)
-             zxfluxv(i,k) = zxfluxv(i,k) + flux_v(i,k,nsrf) * pctsrf(i,nsrf)
-#ifdef ISO
-             do ixt=1,niso
-               zxfluxxt(ixt,i,k) = zxfluxxt(ixt,i,k) + flux_xt(ixt,i,k,nsrf) * pctsrf(i,nsrf)
-             enddo ! do ixt=1,niso
-#endif
-          ENDDO
-       ENDDO
-    ENDDO
-
-    DO i = 1, klon
-       zxsens(i)     = - zxfluxt(i,1) ! flux de chaleur sensible au sol
-       zxevap(i)     = - zxfluxq(i,1) ! flux d'evaporation au sol
-       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
-     do ixt=1,ntraciso
-       zxxtevap(ixt,i)     = - zxfluxxt(ixt,i,1)
-     enddo
-   enddo
-#endif
-!!!
-
-!
-! Incrementer la temperature du sol
-!
-    zxtsol(:) = 0.0  ; zxfluxlat(:) = 0.0
-    zt2m(:) = 0.0    ; zq2m(:) = 0.0 ; zn2mout(:,:) = 0
-    zustar(:)=0.0 ; zu10m(:) = 0.0   ; zv10m(:) = 0.0
-    s_pblh(:) = 0.0  ; s_plcl(:) = 0.0 
-!!! jyg le 07/02/2012
-     s_pblh_x(:) = 0.0  ; s_plcl_x(:) = 0.0 
-     s_pblh_w(:) = 0.0  ; s_plcl_w(:) = 0.0 
-!!!
-    s_capCL(:) = 0.0 ; s_oliqCL(:) = 0.0
-    s_cteiCL(:) = 0.0; s_pblT(:) = 0.0
-    s_therm(:) = 0.0 ; s_trmb1(:) = 0.0
-    s_trmb2(:) = 0.0 ; s_trmb3(:) = 0.0
-    wstar(:,is_ave)=0.
-    
-!   print*,'OK pbl 9'
-    
-!!! nrlmd le 02/05/2011
-    zxfluxlat_x(:) = 0.0  ;  zxfluxlat_w(:) = 0.0
-!!!
-    
-    DO nsrf = 1, nbsrf
-       DO i = 1, klon          
-          ts(i,nsrf) = ts(i,nsrf) + d_ts(i,nsrf)
-          
-          wfbils(i,nsrf) = ( solsw(i,nsrf) + sollw(i,nsrf) &
-               + flux_t(i,1,nsrf) + fluxlat(i,nsrf) ) * pctsrf(i,nsrf)
-          wfevap(i,nsrf) = evap(i,nsrf)*pctsrf(i,nsrf)
-
-          zxtsol(i)    = zxtsol(i)    + ts(i,nsrf)      * pctsrf(i,nsrf)
-          zxfluxlat(i) = zxfluxlat(i) + fluxlat(i,nsrf) * pctsrf(i,nsrf)
-       ENDDO
-    ENDDO
-!
-!<al1 order 2 correction to zxtsol, for radiation computations (main atm effect of Ts)
-   IF (iflag_order2_sollw == 1) THEN
-    meansqT(:) = 0. ! as working buffer
-    DO nsrf = 1, nbsrf
-     DO i = 1, klon
-      meansqT(i) = meansqT(i)+(ts(i,nsrf)-zxtsol(i))**2 *pctsrf(i,nsrf)
-     ENDDO
-    ENDDO
-    zxtsol(:) = zxtsol(:)+1.5*meansqT(:)/zxtsol(:)
-   ENDIF   ! iflag_order2_sollw == 1
-!>al1
-          
-!!! jyg le 07/02/2012
-       IF (iflag_split .eq.0) THEN
-        DO nsrf = 1, nbsrf
-         DO i = 1, klon          
-          zt2m(i)  = zt2m(i)  + t2m(i,nsrf)  * pctsrf(i,nsrf)
-          zq2m(i)  = zq2m(i)  + q2m(i,nsrf)  * pctsrf(i,nsrf)
-!
-          DO k = 1, 6
-           zn2mout(i,k)  = zn2mout(i,k)  + n2mout(i,nsrf,k)  * pctsrf(i,nsrf)
-          ENDDO  
-!
-          zustar(i) = zustar(i) + ustar(i,nsrf) * pctsrf(i,nsrf)
-          wstar(i,is_ave)=wstar(i,is_ave)+wstar(i,nsrf)*pctsrf(i,nsrf)
-          zu10m(i) = zu10m(i) + u10m(i,nsrf) * pctsrf(i,nsrf)
-          zv10m(i) = zv10m(i) + v10m(i,nsrf) * pctsrf(i,nsrf)
-
-          s_pblh(i)   = s_pblh(i)   + pblh(i,nsrf)  * pctsrf(i,nsrf)
-          s_plcl(i)   = s_plcl(i)   + plcl(i,nsrf)  * pctsrf(i,nsrf)
-          s_capCL(i)  = s_capCL(i)  + capCL(i,nsrf) * pctsrf(i,nsrf)
-          s_oliqCL(i) = s_oliqCL(i) + oliqCL(i,nsrf)* pctsrf(i,nsrf)
-          s_cteiCL(i) = s_cteiCL(i) + cteiCL(i,nsrf)* pctsrf(i,nsrf)
-          s_pblT(i)   = s_pblT(i)   + pblT(i,nsrf)  * pctsrf(i,nsrf)
-          s_therm(i)  = s_therm(i)  + therm(i,nsrf) * pctsrf(i,nsrf)
-          s_trmb1(i)  = s_trmb1(i)  + trmb1(i,nsrf) * pctsrf(i,nsrf)
-          s_trmb2(i)  = s_trmb2(i)  + trmb2(i,nsrf) * pctsrf(i,nsrf)
-          s_trmb3(i)  = s_trmb3(i)  + trmb3(i,nsrf) * pctsrf(i,nsrf)
-         ENDDO
-        ENDDO
-       ELSE  !(iflag_split .eq.0)
-        DO nsrf = 1, nbsrf
-         DO i = 1, klon          
-!!! nrlmd le 02/05/2011
-          zxfluxlat_x(i) = zxfluxlat_x(i) + fluxlat_x(i,nsrf) * pctsrf(i,nsrf)
-          zxfluxlat_w(i) = zxfluxlat_w(i) + fluxlat_w(i,nsrf) * pctsrf(i,nsrf)
-!!!
-!!! jyg le 08/02/2012
-!!  Pour le moment, on sort les valeurs dans (x) et (w) de pblh et de plcl ; 
-!!  pour zt2m, on fait la moyenne surfacique sur les sous-surfaces ;
-!!  pour qsat2m, on fait la moyenne surfacique sur (x) et (w) ;
-!!  pour les autres variables, on sort les valeurs de la region (x).
-          zt2m(i)  = zt2m(i)  + (t2m_x(i,nsrf)+wake_s(i)*(t2m_w(i,nsrf)-t2m_x(i,nsrf))) * pctsrf(i,nsrf)
-          zq2m(i)  = zq2m(i)  + q2m_x(i,nsrf)  * pctsrf(i,nsrf)
-!
-          DO k = 1, 6
-           zn2mout(i,k)  = zn2mout(i,k)  + n2mout_x(i,nsrf,k)  * pctsrf(i,nsrf)
-          ENDDO
-!
-          zustar(i) = zustar(i) + ustar_x(i,nsrf) * pctsrf(i,nsrf)
-          wstar(i,is_ave)=wstar(i,is_ave)+wstar_x(i,nsrf)*pctsrf(i,nsrf)
-          zu10m(i) = zu10m(i) + u10m_x(i,nsrf) * pctsrf(i,nsrf)
-          zv10m(i) = zv10m(i) + v10m_x(i,nsrf) * pctsrf(i,nsrf)
-!
-          s_pblh(i)     = s_pblh(i)     + pblh_x(i,nsrf)  * pctsrf(i,nsrf)
-          s_pblh_x(i)   = s_pblh_x(i)   + pblh_x(i,nsrf)  * pctsrf(i,nsrf)
-          s_pblh_w(i)   = s_pblh_w(i)   + pblh_w(i,nsrf)  * pctsrf(i,nsrf)
-!
-          s_plcl(i)     = s_plcl(i)     + plcl_x(i,nsrf)  * pctsrf(i,nsrf)
-          s_plcl_x(i)   = s_plcl_x(i)   + plcl_x(i,nsrf)  * pctsrf(i,nsrf)
-          s_plcl_w(i)   = s_plcl_w(i)   + plcl_w(i,nsrf)  * pctsrf(i,nsrf)
-!
-          s_capCL(i)  = s_capCL(i)  + capCL_x(i,nsrf) * pctsrf(i,nsrf)
-          s_oliqCL(i) = s_oliqCL(i) + oliqCL_x(i,nsrf)* pctsrf(i,nsrf)
-          s_cteiCL(i) = s_cteiCL(i) + cteiCL_x(i,nsrf)* pctsrf(i,nsrf)
-          s_pblT(i)   = s_pblT(i)   + pblT_x(i,nsrf)  * pctsrf(i,nsrf)
-          s_therm(i)  = s_therm(i)  + therm_x(i,nsrf) * pctsrf(i,nsrf)
-          s_trmb1(i)  = s_trmb1(i)  + trmb1_x(i,nsrf) * pctsrf(i,nsrf)
-          s_trmb2(i)  = s_trmb2(i)  + trmb2_x(i,nsrf) * pctsrf(i,nsrf)
-          s_trmb3(i)  = s_trmb3(i)  + trmb3_x(i,nsrf) * pctsrf(i,nsrf)
-         ENDDO
-        ENDDO
-        DO i = 1, klon          
-          qsat2m(i)= qsat2m_x(i)+ wake_s(i)*(qsat2m_x(i)-qsat2m_w(i))
-        ENDDO
-!!!
-       ENDIF  ! (iflag_split .eq.0)
-!!!
-
-    IF (check) THEN
-       amn=MIN(ts(1,is_ter),1000.)
-       amx=MAX(ts(1,is_ter),-1000.)
-       DO i=2, klon
-          amn=MIN(ts(i,is_ter),amn)
-          amx=MAX(ts(i,is_ter),amx)
-       ENDDO
-       PRINT*,' debut apres d_ts min max ftsol(ts)',itap,amn,amx
-    ENDIF
-
-!jg ?
-!!$!
-!!$! If a sub-surface does not exsist for a grid point, the mean value for all 
-!!$! sub-surfaces is distributed.
-!!$!
-!!$    DO nsrf = 1, nbsrf
-!!$       DO i = 1, klon
-!!$          IF ((pctsrf_new(i,nsrf) .LT. epsfra) .OR. (t2m(i,nsrf).EQ.0.)) THEN
-!!$             ts(i,nsrf)     = zxtsol(i)
-!!$             t2m(i,nsrf)    = zt2m(i)
-!!$             q2m(i,nsrf)    = zq2m(i)
-!!$             u10m(i,nsrf)   = zu10m(i)
-!!$             v10m(i,nsrf)   = zv10m(i)
-!!$
-!!$! Les variables qui suivent sont plus utilise, donc peut-etre pas la peine a les mettre ajour
-!!$             pblh(i,nsrf)   = s_pblh(i)
-!!$             plcl(i,nsrf)   = s_plcl(i)
-!!$             capCL(i,nsrf)  = s_capCL(i)
-!!$             oliqCL(i,nsrf) = s_oliqCL(i) 
-!!$             cteiCL(i,nsrf) = s_cteiCL(i)
-!!$             pblT(i,nsrf)   = s_pblT(i)
-!!$             therm(i,nsrf)  = s_therm(i)
-!!$             trmb1(i,nsrf)  = s_trmb1(i)
-!!$             trmb2(i,nsrf)  = s_trmb2(i)
-!!$             trmb3(i,nsrf)  = s_trmb3(i)
-!!$          ENDIF
-!!$       ENDDO
-!!$    ENDDO
-
-
-    DO i = 1, klon
-       fder(i) = - 4.0*RSIGMA*zxtsol(i)**3 
-    ENDDO
-    
-    zxqsurf(:) = 0.0
-    zxsnow(:)  = 0.0
-#ifdef ISO
-    zxxtsnow(:,:)  = 0.0
-#endif
-    DO nsrf = 1, nbsrf
-       DO i = 1, klon
-          zxqsurf(i) = zxqsurf(i) + MAX(qsurf(i,nsrf),0.0) * pctsrf(i,nsrf)
-          zxsnow(i)  = zxsnow(i)  + snow(i,nsrf)  * pctsrf(i,nsrf)
-#ifdef ISO
-          do ixt=1,niso
-            zxxtsnow(ixt,i)  = zxxtsnow(ixt,i)  + xtsnow(ixt,i,nsrf)  * pctsrf(i,nsrf)
-          enddo ! do ixt=1,niso
-#endif
-       END DO
-    END DO
-
-! Premier niveau de vent sortie dans physiq.F
-    zu1(:) = u(:,1)
-    zv1(:) = v(:,1)
-
-  END SUBROUTINE pbl_surface
-!
-!****************************************************************************************
-!
-  SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst &
-#ifdef ISO
-       ,xtsnow_rst,Rland_ice_rst &
-#endif       
-       )
-
-    USE indice_sol_mod
-#ifdef ISO
-#ifdef ISOVERIF
-    USE isotopes_mod, ONLY: iso_eau,ridicule
-    USE isotopes_verif_mod, ONLY: errmax,errmaxrel
-#endif    
-#endif
-
-    INCLUDE "dimsoil.h"
-
-! Ouput variables
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)                 :: fder_rst
-    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: snow_rst
-    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: qsurf_rst
-    REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(OUT) :: ftsoil_rst
-#ifdef ISO
-    REAL, DIMENSION(niso,klon, nbsrf), INTENT(OUT)          :: xtsnow_rst
-    REAL, DIMENSION(niso,klon), INTENT(OUT)          :: Rland_ice_rst
-#endif
-
- 
-!****************************************************************************************
-! Return module variables for writing to restart file
-!
-!****************************************************************************************    
-    fder_rst(:)       = fder(:)
-    snow_rst(:,:)     = snow(:,:)
-    qsurf_rst(:,:)    = qsurf(:,:)
-    ftsoil_rst(:,:,:) = ftsoil(:,:,:)
-#ifdef ISO
-    xtsnow_rst(:,:,:)     = xtsnow(:,:,:) 
-    Rland_ice_rst(:,:)     = Rland_ice(:,:)
-#endif
-
-!****************************************************************************************
-! Deallocate module variables
-!
-!****************************************************************************************
-!   DEALLOCATE(qsol, fder, snow, qsurf, evap, rugos, agesno, ftsoil)
-    IF (ALLOCATED(fder)) DEALLOCATE(fder)
-    IF (ALLOCATED(snow)) DEALLOCATE(snow)
-    IF (ALLOCATED(qsurf)) DEALLOCATE(qsurf)
-    IF (ALLOCATED(ftsoil)) DEALLOCATE(ftsoil)
-    IF (ALLOCATED(ydTs0)) DEALLOCATE(ydTs0)
-    IF (ALLOCATED(ydqs0)) DEALLOCATE(ydqs0)
-#ifdef ISO
-    IF (ALLOCATED(xtsnow)) DEALLOCATE(xtsnow)
-    IF (ALLOCATED(Rland_ice)) DEALLOCATE(Rland_ice)
-    IF (ALLOCATED(Roce)) DEALLOCATE(Roce)
-#endif
-
-!jyg<
-!****************************************************************************************
-! Deallocate variables for pbl splitting
-!
-!****************************************************************************************
-
-    CALL wx_pbl_final
-!>jyg
-
-  END SUBROUTINE pbl_surface_final
-!  
-!****************************************************************************************
-! 
-
-!albedo SB >>>
-  SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, &
-       evap, z0m, z0h, agesno,                                  &
-       tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke &
-#ifdef ISO
-     ,xtevap  &
-#endif
-&       )  
-!albedo SB <<<
-    ! Give default values where new fraction has appread
-
-    USE indice_sol_mod
-    use phys_state_var_mod, only: delta_sal, ds_ns, dt_ns, delta_sst, dter, &
-         dser, dt_ds
-    use config_ocean_skin_m, only: activate_ocean_skin
-
-
-    INCLUDE "dimsoil.h"
-    INCLUDE "clesphys.h"
-    INCLUDE "compbl.h"
-
-! Input variables
-!****************************************************************************************
-    INTEGER, INTENT(IN)                     :: itime
-    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf_new, pctsrf_old
-
-! InOutput variables
-!****************************************************************************************
-    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: tsurf
-!albedo SB >>>
-    REAL, DIMENSION(klon,nsw,nbsrf), INTENT(INOUT)       :: alb_dir, alb_dif 
-    INTEGER :: k
-!albedo SB <<<
-    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: ustar,u10m, v10m
-    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: evap, agesno
-    REAL, DIMENSION(klon,nbsrf+1), INTENT(INOUT)        :: z0m,z0h
-    REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: tke
-#ifdef ISO
-    REAL, DIMENSION(ntraciso,klon,nbsrf), INTENT(INOUT)        :: xtevap
-#endif
-
-! Local variables
-!****************************************************************************************
-    INTEGER           :: nsrf, nsrf_comp1, nsrf_comp2, nsrf_comp3, i
-    CHARACTER(len=80) :: abort_message
-    CHARACTER(len=20) :: modname = 'pbl_surface_newfrac'
-    INTEGER, DIMENSION(nbsrf) :: nfois=0, mfois=0, pfois=0
-
-#ifdef ISO
-        integer ixt
-#endif
-!
-! All at once !! 
-!****************************************************************************************
-    
-    DO nsrf = 1, nbsrf
-       ! First decide complement sub-surfaces
-       SELECT CASE (nsrf)
-       CASE(is_oce)
-          nsrf_comp1=is_sic
-          nsrf_comp2=is_ter
-          nsrf_comp3=is_lic
-       CASE(is_sic)
-          nsrf_comp1=is_oce
-          nsrf_comp2=is_ter
-          nsrf_comp3=is_lic
-       CASE(is_ter)
-          nsrf_comp1=is_lic
-          nsrf_comp2=is_oce
-          nsrf_comp3=is_sic
-       CASE(is_lic)
-          nsrf_comp1=is_ter
-          nsrf_comp2=is_oce
-          nsrf_comp3=is_sic
-       END SELECT
-
-       ! Initialize all new fractions
-       DO i=1, klon
-          IF (pctsrf_new(i,nsrf) > 0. .AND. pctsrf_old(i,nsrf) == 0.) THEN
-             
-             IF (pctsrf_old(i,nsrf_comp1) > 0.) THEN
-                ! Use the complement sub-surface, keeping the continents unchanged
-                qsurf(i,nsrf) = qsurf(i,nsrf_comp1)
-                evap(i,nsrf)  = evap(i,nsrf_comp1)
-                z0m(i,nsrf) = z0m(i,nsrf_comp1)
-                z0h(i,nsrf) = z0h(i,nsrf_comp1)
-                tsurf(i,nsrf) = tsurf(i,nsrf_comp1)
-!albedo SB >>>
-                DO k=1,nsw
-                 alb_dir(i,k,nsrf)=alb_dir(i,k,nsrf_comp1)
-                 alb_dif(i,k,nsrf)=alb_dif(i,k,nsrf_comp1)
-                ENDDO
-!albedo SB <<<
-                ustar(i,nsrf)  = ustar(i,nsrf_comp1)
-                u10m(i,nsrf)  = u10m(i,nsrf_comp1)
-                v10m(i,nsrf)  = v10m(i,nsrf_comp1)
-#ifdef ISO
-                do ixt=1,ntraciso
-                  xtevap(ixt,i,nsrf)  = xtevap(ixt,i,nsrf_comp1)       
-                enddo       
-#endif
-                IF (iflag_pbl > 1) THEN
-                 tke(i,:,nsrf) = tke(i,:,nsrf_comp1)
-                ENDIF
-                mfois(nsrf) = mfois(nsrf) + 1
-                ! F. Codron sensible default values for ocean and sea ice
-                IF (nsrf.EQ.is_oce) THEN
-                   tsurf(i,nsrf) = 271.35
-                   ! (temperature of sea water under sea ice, so that
-                   ! is also the temperature of appearing sea water)
-                   DO k=1,nsw
-                      alb_dir(i,k,nsrf) = 0.06 ! typical Ocean albedo
-                      alb_dif(i,k,nsrf) = 0.06
-                   ENDDO
-                   if (activate_ocean_skin >= 1) then
-                      if (activate_ocean_skin == 2 &
-                           .and. type_ocean == "couple") then
-                         delta_sal(i) = 0.
-                         delta_sst(i) = 0.
-                         dter(i) = 0.
-                         dser(i) = 0.
-                         dt_ds(i) = 0.
-                      end if
-                      
-                      ds_ns(i) = 0.
-                      dt_ns(i) = 0.
-                   end if
-                ELSE IF (nsrf.EQ.is_sic) THEN
-                   tsurf(i,nsrf) = 271.35
-                   ! (Temperature at base of sea ice. Surface
-                   ! temperature could be higher, up to 0 Celsius
-                   ! degrees. We set it to -1.8 Celsius degrees for
-                   ! consistency with the ocean slab model.)
-                   DO k=1,nsw
-                      alb_dir(i,k,nsrf) = 0.3 ! thin ice
-                      alb_dif(i,k,nsrf) = 0.3
-                   ENDDO
-                ENDIF
-             ELSE
-                ! The continents have changed. The new fraction receives the mean sum of the existent fractions
-                qsurf(i,nsrf) = qsurf(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + qsurf(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
-                evap(i,nsrf)  = evap(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + evap(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
-                z0m(i,nsrf) = z0m(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + z0m(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
-                z0h(i,nsrf) = z0h(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + z0h(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
-                tsurf(i,nsrf) = tsurf(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tsurf(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
-!albedo SB >>>
-                DO k=1,nsw
-                 alb_dir(i,k,nsrf)=alb_dir(i,k,nsrf_comp2)*pctsrf_old(i,nsrf_comp2)+&
-                                        alb_dir(i,k,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
-                 alb_dif(i,k,nsrf)=alb_dif(i,k,nsrf_comp2)*pctsrf_old(i,nsrf_comp2)+&
-                                        alb_dif(i,k,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
-                ENDDO
-!albedo SB <<<
-                ustar(i,nsrf)  = ustar(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + ustar(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
-                u10m(i,nsrf)  = u10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + u10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
-                v10m(i,nsrf)  = v10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + v10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
-#ifdef ISO
-                do ixt=1,ntraciso
-                  xtevap(ixt,i,nsrf)  = xtevap(ixt,i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) &
-                  + xtevap(ixt,i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3) 
-                enddo       
-#endif
-                IF (iflag_pbl > 1) THEN
-                 tke(i,:,nsrf) = tke(i,:,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tke(i,:,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
-                ENDIF
-            
-                ! Security abort. This option has never been tested. To test, comment the following line.
-!                abort_message='The fraction of the continents have changed!'
-!                CALL abort_physic(modname,abort_message,1)
-                nfois(nsrf) = nfois(nsrf) + 1
-             ENDIF
-             snow(i,nsrf)     = 0.
-             agesno(i,nsrf)   = 0.
-             ftsoil(i,:,nsrf) = tsurf(i,nsrf)
-#ifdef ISO            
-             xtsnow(:,i,nsrf)     = 0.
-#endif
-          ELSE
-             pfois(nsrf) = pfois(nsrf)+ 1
-          ENDIF
-       ENDDO
-       
-    ENDDO
-
-  END SUBROUTINE pbl_surface_newfrac
-!  
-!****************************************************************************************
-!  
-END MODULE pbl_surface_mod
+link ../phylmd/pbl_surface_mod.F90
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/phyetat0_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/phyetat0_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/phyetat0_mod.F90	(revision 5202)
@@ -30,5 +30,5 @@
        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, &
-       wake_s, wake_dens, awake_dens, cv_gen, zgam, zmax0, zmea, zpic, zsig, &
+       wake_s, awake_s, wake_dens, awake_dens, cv_gen, zgam, zmax0, zmea, zpic, zsig, &
 #ifdef ISO
        fxtevap, xtsol, xt_ancien, xtl_ancien, xts_ancien, wake_deltaxt, &
@@ -49,5 +49,5 @@
   USE time_phylmdz_mod, ONLY: init_iteration, pdtphys, itau_phy
   USE wxios, ONLY: missing_val_xios => missing_val, using_xios
-  use netcdf, only:  nf90_fill_real
+  use netcdf, only: missing_val_netcdf => nf90_fill_real
   use config_ocean_skin_m, only: activate_ocean_skin
 #ifdef ISO
@@ -112,4 +112,11 @@
   REAL Rland_ice(niso,klon)
 #endif
+
+  IF (using_xios) THEN
+    missing_val=missing_val_xios
+  ELSE
+    missing_val=missing_val_netcdf
+  ENDIF
+
   ! FH1D
   !     real iolat(jjm+1)
@@ -117,9 +124,4 @@
 
   ! 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)
@@ -324,4 +326,9 @@
 
 !===================================================================
+! Lecture dans le cas iflag_pbl_surface =1
+!===================================================================
+
+   if ( iflag_physiq <= 1 ) then
+!===================================================================
   ! Lecture des temperatures du sol profond:
 !===================================================================
@@ -351,5 +358,4 @@
   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.)
@@ -405,4 +411,6 @@
   ENDIF
 
+  endif ! iflag_physiq <= 1
+
   ! Lecture de l'age de la neige:
   found=phyetat0_srf(agesno,"AGESNO","SNOW AGE",0.001)
@@ -498,4 +506,5 @@
   found=phyetat0_get(wake_deltaq,"WAKE_DELTAQ","Delta hum. wake/env",0.)
   found=phyetat0_get(wake_s,"WAKE_S","Wake frac. area",0.)
+  found=phyetat0_get(awake_s,"AWAKE_S","Active Wake frac. area",0.)
 !jyg<
 !  Set wake_dens to -1000. when there is no restart so that the actual
@@ -677,9 +686,10 @@
 !        write(*,*) 'xtsnow(:,994,2)=',xtsnow(:,994,2)
 !#endif
-
+  if ( iflag_physiq <= 1 ) then
   CALL pbl_surface_init(fder, snow, qsurf, tsoil)
 #ifdef ISO
   CALL pbl_surface_init_iso(xtsnow,Rland_ice)
 #endif
+  endif
 
   ! Initialize module ocean_cpl_mod for the case of coupled ocean
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/phys_local_var_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/phys_local_var_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/phys_local_var_mod.F90	(revision 5202)
@@ -14,4 +14,8 @@
       REAL, SAVE, ALLOCATABLE :: ql_seri(:,:),qs_seri(:,:)
       !$OMP THREADPRIVATE(ql_seri,qs_seri)
+! SN 15/07/2024 ISO 4D
+      REAL, SAVE, ALLOCATABLE :: qx_seri(:,:,:)
+      !$OMP THREADPRIVATE(qx_seri)
+! SN
       REAL, SAVE, ALLOCATABLE :: qbs_seri(:,:)
       !$OMP THREADPRIVATE(qbs_seri)
@@ -24,4 +28,6 @@
       REAL, SAVE, ALLOCATABLE :: pbl_eps(:,:,:)
       !$OMP THREADPRIVATE(pbl_eps)
+      REAL, SAVE, ALLOCATABLE :: tke_shear(:,:,:), tke_buoy(:,:,:), tke_trans(:,:,:)
+      !$OMP THREADPRIVATE(tke_shear,tke_buoy,tke_trans)
       REAL, SAVE, ALLOCATABLE :: tr_seri(:,:,:)
       !$OMP THREADPRIVATE(tr_seri)
@@ -64,4 +70,8 @@
       REAL, SAVE, ALLOCATABLE :: d_t_eva(:,:),d_q_eva(:,:),d_ql_eva(:,:),d_qi_eva(:,:)
       !$OMP THREADPRIVATE(d_t_eva,d_q_eva,d_ql_eva,d_qi_eva)
+! SN 15/07/2024 ISO 4D
+      REAL, SAVE, ALLOCATABLE :: d_qx_eva(:,:,:)
+      !$OMP THREADPRIVATE(d_qx_eva)
+! SN
       REAL, SAVE, ALLOCATABLE :: d_t_lscst(:,:),d_q_lscst(:,:)
       !$OMP THREADPRIVATE(d_t_lscst,d_q_lscst)
@@ -84,6 +94,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)
+      REAL, SAVE, ALLOCATABLE :: d_t_bsss(:,:), d_q_bsss(:,:), d_qbs_bsss(:,:)
+      !$OMP THREADPRIVATE( d_t_bsss,d_q_bsss, d_qbs_bsss)
 !>nrlmd+jyg
       REAL, SAVE, ALLOCATABLE :: d_t_oro(:,:)
@@ -124,4 +134,6 @@
       REAL, SAVE, ALLOCATABLE :: xts_seri(:,:,:)
       !$OMP THREADPRIVATE( xts_seri)
+      REAL, SAVE, ALLOCATABLE :: xtbs_seri(:,:,:)
+      !$OMP THREADPRIVATE( xtbs_seri)
       REAL, SAVE, ALLOCATABLE :: d_xt_eva(:,:,:)
       !$OMP THREADPRIVATE( d_xt_eva)
@@ -134,6 +146,6 @@
       REAL, SAVE, ALLOCATABLE :: d_xt_dyn(:,:,:)
       !$OMP THREADPRIVATE( d_xt_dyn)
-      REAL, SAVE, ALLOCATABLE :: d_xtl_dyn(:,:,:), d_xts_dyn(:,:,:)
-      !$OMP THREADPRIVATE(d_xtl_dyn, d_xts_dyn)
+      REAL, SAVE, ALLOCATABLE :: d_xtl_dyn(:,:,:), d_xts_dyn(:,:,:), d_xtbs_dyn(:,:,:)
+      !$OMP THREADPRIVATE(d_xtl_dyn, d_xts_dyn, d_xtbs_dyn)
       REAL, SAVE, ALLOCATABLE :: d_xt_con(:,:,:)
       !$OMP THREADPRIVATE( d_xt_con)
@@ -166,7 +178,4 @@
       !$OMP THREADPRIVATE(d_ts, d_tr)
 
-! aerosols
-      REAL, SAVE, ALLOCATABLE :: m_allaer (:,:,:)
-      !$OMP THREADPRIVATE(m_allaer)
 ! diagnostique pour le rayonnement
       REAL, SAVE, ALLOCATABLE :: topswad_aero(:),  solswad_aero(:)      ! diag
@@ -292,4 +301,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(:)
@@ -300,5 +330,5 @@
 !$OMP THREADPRIVATE(sens, flwp, fiwp)
 !!
-!FC
+!FC 
       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zxfluxt, zxfluxq
 !$OMP THREADPRIVATE(zxfluxt, zxfluxq)
@@ -315,6 +345,6 @@
     REAL, SAVE, ALLOCATABLE,DIMENSION(:,:)          :: d_deltat_wk, d_deltaq_wk
 !$OMP THREADPRIVATE(d_deltat_wk, d_deltaq_wk)
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:)            :: d_s_wk, d_dens_a_wk, d_dens_wk
-!$OMP THREADPRIVATE(d_s_wk, d_dens_a_wk, d_dens_wk)
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:)            :: d_s_wk, d_s_a_wk, d_dens_wk, d_dens_a_wk
+!$OMP THREADPRIVATE(d_s_wk, d_s_a_wk, d_dens_wk, d_dens_a_wk)
     REAL, SAVE, ALLOCATABLE,DIMENSION(:,:)          :: d_deltat_wk_gw, d_deltaq_wk_gw
 !$OMP THREADPRIVATE(d_deltat_wk_gw, d_deltaq_wk_gw)
@@ -328,5 +358,5 @@
 !!!OMP THREADPRIVATE(d_s_the, d_dens_the)
       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)           :: d_deltat_ajs_cv, d_deltaq_ajs_cv
-!$OMP THREADPRIVATE(d_deltat_ajs_cv, d_deltaq_ajs_cv)                       
+!$OMP THREADPRIVATE(d_deltat_ajs_cv, d_deltaq_ajs_cv)
 #ifdef ISO
     REAL, SAVE, ALLOCATABLE,DIMENSION(:,:,:)          :: d_deltaxt_wk
@@ -376,6 +406,7 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxfluxlat, zxtsol, snow_lsc, zxfqfonte
 !$OMP THREADPRIVATE(zxfluxlat, zxtsol, snow_lsc, zxfqfonte)
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxrunofflic
-!$OMP THREADPRIVATE(zxrunofflic)
+!SN runoffdiag
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxrunofflic, runoff_diag
+!$OMP THREADPRIVATE(zxrunofflic, runoff_diag)
       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxqsurf, rain_lsc, rain_num
 !$OMP THREADPRIVATE(zxqsurf, rain_lsc, rain_num)
@@ -383,7 +414,7 @@
       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: xtevap,xtprw
 !$OMP THREADPRIVATE(xtevap,xtprw)
-      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: h1_diag,runoff_diag
+      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: h1_diag
       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: xtrunoff_diag
-!$OMP THREADPRIVATE(h1_diag,runoff_diag,xtrunoff_diag)
+!$OMP THREADPRIVATE(h1_diagv,xtrunoff_diag)
       REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zxfxtcalving
 !$OMP THREADPRIVATE(zxfxtcalving)
@@ -581,4 +612,10 @@
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pfraclr,pfracld
 !$OMP THREADPRIVATE(pfraclr,pfracld)
+      REAL, SAVE, ALLOCATABLE :: cldfraliq(:,:)
+!$OMP THREADPRIVATE(cldfraliq)
+      REAL, SAVE, ALLOCATABLE ::mean_icefracturb(:,:)
+!$OMP THREADPRIVATE(mean_icefracturb)
+      REAL, SAVE, ALLOCATABLE :: sigma2_icefracturb(:,:)
+!$OMP THREADPRIVATE(sigma2_icefracturb)
 
 ! variables de sorties MM
@@ -671,10 +708,18 @@
 !
 ! variables for stratospheric aerosol
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: d_q_emiss
+!$OMP THREADPRIVATE(d_q_emiss)
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: R2SO4
 !$OMP THREADPRIVATE(R2SO4)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: R2SO4B
+!$OMP THREADPRIVATE(R2SO4B)
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: DENSO4
 !$OMP THREADPRIVATE(DENSO4)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:, :) :: DENSO4B
+!$OMP THREADPRIVATE(DENSO4B)      
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: f_r_wet
 !$OMP THREADPRIVATE(f_r_wet)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:, :) :: f_r_wetB
+!$OMP THREADPRIVATE(f_r_wetB)
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: decfluxaer
 !$OMP THREADPRIVATE(decfluxaer)
@@ -685,4 +730,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)
@@ -701,4 +750,19 @@
       REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vsed_aer
 !$OMP THREADPRIVATE(vsed_aer)
+!     Sulfate aerosol concentration (dry mixing ratio) (condensed H2SO4 mmr)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sulfmmr
+!$OMP THREADPRIVATE(sulfmmr)
+!     SAD all aerosols (cm2/cm3)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: SAD_sulfate
+!$OMP THREADPRIVATE(SAD_sulfate)
+!     Effective radius of wet surface aerosols (cm)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: reff_sulfate
+!$OMP THREADPRIVATE(reff_sulfate)
+!     sulfate MMR in different modes (based on sulfmmr, it must be dry mmr)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sulfmmr_mode
+!$OMP THREADPRIVATE(sulfmmr_mode)
+!     particle concentration in different modes (part/m3)
+      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nd_mode
+!$OMP THREADPRIVATE(nd_mode)
 !
 !---3D budget variables
@@ -749,5 +813,5 @@
 SUBROUTINE phys_local_var_init
 USE dimphy
-USE infotrac_phy, ONLY : nbtr
+USE infotrac_phy, ONLY : nbtr,nqtot
 #ifdef ISO
 USE infotrac_phy, ONLY : ntraciso=>ntiso,niso
@@ -757,12 +821,20 @@
 USE phys_output_var_mod
 USE phys_state_var_mod
+#ifdef CPP_StratAer
+USE infotrac_phy, ONLY : nbtr_bin
+#endif
 
 IMPLICIT NONE
       ALLOCATE(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev), qbs_seri(klon,klev))
+! SN 4D ISO
+      ALLOCATE(qx_seri(klon,klev,nqtot))
+! SN
       ALLOCATE(u_seri(klon,klev),v_seri(klon,klev))
       ALLOCATE(cf_seri(klon,klev),rvc_seri(klon,klev))
       ALLOCATE(l_mixmin(klon,klev+1,nbsrf),l_mix(klon,klev+1,nbsrf),wprime(klon,klev+1,nbsrf))
       ALLOCATE(pbl_eps(klon,klev+1,nbsrf+1))
+      ALLOCATE(tke_shear(klon,klev+1,nbsrf), tke_buoy(klon,klev+1,nbsrf), tke_trans(klon,klev+1,nbsrf))
       pbl_eps(:,:,:)=0.
+      tke_shear(:,:,:)=0.; tke_buoy(:,:,:)=0.; tke_trans(:,:,:)=0.
       l_mix(:,:,:)=0.;l_mixmin(:,:,:)=0.;wprime(:,:,:)=0. ! doit etre initialse car pas toujours remplis
       ALLOCATE(rhcl(klon,klev))
@@ -789,4 +861,7 @@
       ALLOCATE(d_u_ajs(klon,klev),d_v_ajs(klon,klev))
       ALLOCATE(d_t_eva(klon,klev),d_q_eva(klon,klev))
+! SN 4D ISO
+      ALLOCATE(d_qx_eva(klon,klev,nqtot))
+! SN 
       ALLOCATE(d_ql_eva(klon,klev),d_qi_eva(klon,klev))
       ALLOCATE(d_t_lscst(klon,klev),d_q_lscst(klon,klev))
@@ -795,5 +870,5 @@
       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_bsss(klon,klev),d_q_bsss(klon,klev),d_qbs_bsss(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))
@@ -802,7 +877,9 @@
       allocate(xtl_seri(ntraciso,klon,klev))
       allocate(xts_seri(ntraciso,klon,klev))
+      allocate(xtbs_seri(ntraciso,klon,klev))
       allocate(d_xt_dyn(ntraciso,klon,klev))
       allocate(d_xtl_dyn(ntraciso,klon,klev))
       allocate(d_xts_dyn(ntraciso,klon,klev))
+      allocate(d_xtbs_dyn(ntraciso,klon,klev))
       allocate(d_xt_con(ntraciso,klon,klev))
       allocate(d_xt_wake(ntraciso,klon,klev))
@@ -835,4 +912,5 @@
       ALLOCATE(d_u_lif(klon,klev),d_v_lif(klon,klev))
       ALLOCATE(d_ts(klon,nbsrf), d_tr(klon,klev,nbtr))
+
 ! Special RRTM
       ALLOCATE(ZLWFT0_i(klon,klev+1),ZSWFT0_i(klon,klev+1),ZFLDN0(klon,klev+1))
@@ -913,4 +991,16 @@
       ALLOCATE(toplwad0_aerop(klon), sollwad0_aerop(klon))
 
+!AI Ajout Ecrad (3Deffect)
+      ALLOCATE(topswad_aero_s2(klon), solswad_aero_s2(klon))
+      ALLOCATE(topswai_aero_s2(klon), solswai_aero_s2(klon))
+      ALLOCATE(topswad0_aero_s2(klon), solswad0_aero_s2(klon))
+      ALLOCATE(topsw_aero_s2(klon,naero_grp), topsw0_aero_s2(klon,naero_grp))
+      ALLOCATE(solsw_aero_s2(klon,naero_grp), solsw0_aero_s2(klon,naero_grp))
+      ALLOCATE(topswcf_aero_s2(klon,naero_grp), solswcf_aero_s2(klon,naero_grp))
+! additional LW variables CK
+      ALLOCATE(toplwad_aero_s2(klon), sollwad_aero_s2(klon))
+      ALLOCATE(toplwai_aero_s2(klon), sollwai_aero_s2(klon))
+      ALLOCATE(toplwad0_aero_s2(klon), sollwad0_aero_s2(klon))
+
 ! FH Ajout de celles necessaires au phys_output_write_mod
 
@@ -923,5 +1013,5 @@
       ALLOCATE(wake_omg(klon, klev))
       ALLOCATE(d_deltat_wk(klon, klev), d_deltaq_wk(klon, klev))
-      ALLOCATE(d_s_wk(klon), d_dens_a_wk(klon), d_dens_wk(klon))
+      ALLOCATE(d_s_wk(klon), d_s_a_wk(klon), d_dens_wk(klon), d_dens_a_wk(klon))
       ALLOCATE(d_deltat_wk_gw(klon, klev), d_deltaq_wk_gw(klon, klev))
       ALLOCATE(d_deltat_vdf(klon, klev), d_deltaq_vdf(klon, klev))
@@ -958,5 +1048,7 @@
       ALLOCATE(zxfqcalving(klon), zxfluxlat(klon))
       ALLOCATE(zxtsol(klon), snow_lsc(klon), zxfqfonte(klon), zxqsurf(klon))
-      ALLOCATE(zxrunofflic(klon))
+! SN add runoff_diag
+      ALLOCATE(zxrunofflic(klon), runoff_diag(klon))
+      runoff_diag(:)=0.
       ALLOCATE(zxustartlic(klon), zxrhoslic(klon), zxqsaltlic(klon))
       zxustartlic(:)=0. ; zxrhoslic(:)=0. ; zxqsaltlic(:)=0.
@@ -973,5 +1065,7 @@
       ALLOCATE(xtrain_lsc(ntraciso,klon))
       ALLOCATE(xtrunoff_diag(niso,klon))
-      ALLOCATE(h1_diag(klon),runoff_diag(klon))
+      ALLOCATE(h1_diag(klon))
+!SN
+      xtrunoff_diag(:,:)=0. ! because variables are only given values on knon grid points
 #endif
 !
@@ -1032,24 +1126,23 @@
       ALLOCATE(wfevap(klon, nbsrf))
       ALLOCATE(evap_pot(klon, nbsrf))
-! FC
+! FC 
       ALLOCATE(zxfluxq(klon,klev),zxfluxt(klon,klev))
-!
 !
 !  Deep convective variables used in phytrac
       ALLOCATE(pmflxr(klon, klev+1), pmflxs(klon, klev+1))
       ALLOCATE(wdtrainA(klon,klev),wdtrainS(klon,klev),wdtrainM(klon,klev))
-      ALLOCATE(dnwd(klon, klev), upwd(klon, klev) )
+      ALLOCATE(dnwd(klon, klev), upwd(klon, klev))
       ALLOCATE(ep(klon,klev))                          ! epmax_cape
-      ALLOCATE(da(klon,klev), mp(klon,klev) )
-      ALLOCATE(phi(klon,klev,klev) )
-      ALLOCATE(wght_cvfd(klon,klev) )
-      ALLOCATE(phi2(klon,klev,klev) )
+      ALLOCATE(da(klon,klev), mp(klon,klev))
+      ALLOCATE(phi(klon,klev,klev))
+      ALLOCATE(wght_cvfd(klon,klev))
+      ALLOCATE(phi2(klon,klev,klev))
       ALLOCATE(d1a(klon,klev), dam(klon,klev))
-      ALLOCATE(ev(klon,klev) )
-      ALLOCATE(elij(klon,klev,klev) )
-      ALLOCATE(qtaa(klon,klev) )
-      ALLOCATE(clw(klon,klev) )
-      ALLOCATE(epmlmMm(klon,klev,klev), eplaMm(klon,klev) )
-      ALLOCATE(sij(klon,klev,klev) )
+      ALLOCATE(ev(klon,klev))
+      ALLOCATE(elij(klon,klev,klev))
+      ALLOCATE(qtaa(klon,klev))
+      ALLOCATE(clw(klon,klev))
+      ALLOCATE(epmlmMm(klon,klev,klev), eplaMm(klon,klev))
+      ALLOCATE(sij(klon,klev,klev))
 #ifdef ISO
       ALLOCATE(xtwdtrainA(ntraciso,klon,klev))
@@ -1094,4 +1187,7 @@
       ALLOCATE(pfraclr(klon,klev),pfracld(klon,klev))
       pfraclr(:,:)=0. ; pfracld(:,:)=0. ! because not always defined
+      ALLOCATE(cldfraliq(klon,klev))
+      ALLOCATE(sigma2_icefracturb(klon,klev))
+      ALLOCATE(mean_icefracturb(klon,klev))
       ALLOCATE(distcltop(klon,klev))
       ALLOCATE(temp_cltop(klon,klev))
@@ -1134,7 +1230,11 @@
 
 #ifdef CPP_StratAer
+      ALLOCATE (d_q_emiss(klon,klev))
       ALLOCATE (R2SO4(klon,klev))
+      ALLOCATE (R2SO4B(klon,klev,nbtr_bin))
       ALLOCATE (DENSO4(klon,klev))
+      ALLOCATE (DENSO4B(klon,klev,nbtr_bin))
       ALLOCATE (f_r_wet(klon,klev))
+      ALLOCATE (f_r_wetB(klon,klev,nbtr_bin))
       ALLOCATE (decfluxaer(klon,nbtr))
       ALLOCATE (mdw(nbtr))
@@ -1147,4 +1247,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))
@@ -1171,4 +1273,9 @@
       ALLOCATE (surf_PM25_sulf(klon))
       ALLOCATE (vsed_aer(klon,klev))
+      ALLOCATE (sulfmmr(klon,klev))
+      ALLOCATE (SAD_sulfate(klon,klev))
+      ALLOCATE (reff_sulfate(klon,klev))
+      ALLOCATE (sulfmmr_mode(klon,klev,nbtr_bin))
+      ALLOCATE (nd_mode(klon,klev,nbtr_bin))
 #endif
 
@@ -1181,7 +1288,11 @@
 IMPLICIT NONE
       DEALLOCATE(t_seri,q_seri,ql_seri,qs_seri, qbs_seri)
+! SN 4D ISO
+      DEALLOCATE(qx_seri)
+! SN
       DEALLOCATE(u_seri,v_seri)
       DEALLOCATE(cf_seri,rvc_seri)
       DEALLOCATE(l_mixmin,l_mix,wprime)
+      DEALLOCATE(tke_shear,tke_buoy,tke_trans)
       DEALLOCATE(pbl_eps)
       DEALLOCATE(rhcl)
@@ -1208,4 +1319,7 @@
       DEALLOCATE(d_u_ajs,d_v_ajs)
       DEALLOCATE(d_t_eva,d_q_eva)
+! SN 4D ISO
+      DEALLOCATE(d_qx_eva)
+! SN
       DEALLOCATE(d_ql_eva,d_qi_eva)
       DEALLOCATE(d_t_lscst,d_q_lscst)
@@ -1214,9 +1328,9 @@
       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)
+      DEALLOCATE(d_t_bsss,d_q_bsss,d_qbs_bsss)
+#ifdef ISO
+      deallocate(xt_seri,xtl_seri,xts_seri,xtbs_seri)
       DEALLOCATE(d_xtl_eva,d_xti_eva)
-      deallocate(d_xt_dyn,d_xtl_dyn,d_xts_dyn)
+      deallocate(d_xt_dyn,d_xtl_dyn,d_xts_dyn,d_xtbs_dyn)
       deallocate(d_xt_con)
       deallocate(d_xt_wake)
@@ -1308,5 +1422,4 @@
       DEALLOCATE(solsw_aerop, solsw0_aerop)
       DEALLOCATE(topswcf_aerop, solswcf_aerop)
-
 !CK LW diagnostics
       DEALLOCATE(toplwad_aerop, sollwad_aerop)
@@ -1314,4 +1427,16 @@
       DEALLOCATE(toplwad0_aerop, sollwad0_aerop)
 
+!AI Ajout pour Ecrad (3Deffect)
+      DEALLOCATE(topswad_aero_s2, solswad_aero_s2)
+      DEALLOCATE(topswai_aero_s2, solswai_aero_s2)
+      DEALLOCATE(topswad0_aero_s2, solswad0_aero_s2)
+      DEALLOCATE(topsw_aero_s2, topsw0_aero_s2)
+      DEALLOCATE(solsw_aero_s2, solsw0_aero_s2)
+      DEALLOCATE(topswcf_aero_s2, solswcf_aero_s2)
+!CK LW diagnostics
+      DEALLOCATE(toplwad_aero_s2, sollwad_aero_s2)
+      DEALLOCATE(toplwai_aero_s2, sollwai_aero_s2)
+      DEALLOCATE(toplwad0_aero_s2, sollwad0_aero_s2)      
+
 ! FH Ajout de celles necessaires au phys_output_write_mod
       DEALLOCATE(tal1, pal1, pab1, pab2)
@@ -1322,5 +1447,5 @@
       DEALLOCATE(wake_omg)
       DEALLOCATE(d_deltat_wk, d_deltaq_wk)
-      DEALLOCATE(d_s_wk, d_dens_a_wk, d_dens_wk)
+      DEALLOCATE(d_s_wk, d_s_a_wk, d_dens_wk, d_dens_a_wk)
       DEALLOCATE(d_deltat_wk_gw, d_deltaq_wk_gw)
       DEALLOCATE(d_deltat_vdf, d_deltaq_vdf)
@@ -1353,5 +1478,6 @@
       DEALLOCATE(uwat, vwat)
       DEALLOCATE(zxfqcalving, zxfluxlat)
-      DEALLOCATE(zxrunofflic)
+! SN runoff_diag
+      DEALLOCATE(zxrunofflic, runoff_diag)
       DEALLOCATE(zxustartlic, zxrhoslic, zxqsaltlic)
       DEALLOCATE(zxtsol, snow_lsc, zxfqfonte, zxqsurf)
@@ -1382,5 +1508,5 @@
       DEALLOCATE(dxtvdf_x, dxtvdf_w)
       DEALLOCATE(xt_therm)
-      DEALLOCATE(h1_diag,runoff_diag,xtrunoff_diag)
+      DEALLOCATE(h1_diag,xtrunoff_diag)
 #endif
 !
@@ -1422,15 +1548,15 @@
       DEALLOCATE(upwd, dnwd)
       DEALLOCATE(ep)
-      DEALLOCATE(da, mp )
-      DEALLOCATE(phi )
-      DEALLOCATE(wght_cvfd )
-      DEALLOCATE(phi2 )
+      DEALLOCATE(da, mp)
+      DEALLOCATE(phi)
+      DEALLOCATE(wght_cvfd)
+      DEALLOCATE(phi2)
       DEALLOCATE(d1a, dam)
-      DEALLOCATE(ev )
-      DEALLOCATE(elij )
-      DEALLOCATE(qtaa )
-      DEALLOCATE(clw )
-      DEALLOCATE(epmlmMm, eplaMm )
-      DEALLOCATE(sij )
+      DEALLOCATE(ev)
+      DEALLOCATE(elij)
+      DEALLOCATE(qtaa)
+      DEALLOCATE(clw)
+      DEALLOCATE(epmlmMm, eplaMm)
+      DEALLOCATE(sij)
 #ifdef ISO
       DEALLOCATE(xtwdtrainA)
@@ -1472,7 +1598,10 @@
       DEALLOCATE(rneb)
       DEALLOCATE(pfraclr,pfracld)
+      DEALLOCATE(cldfraliq)
+      DEALLOCATE(sigma2_icefracturb)
+      DEALLOCATE(mean_icefracturb)
+      DEALLOCATE (zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic)
       DEALLOCATE(distcltop)
       DEALLOCATE(temp_cltop)
-      DEALLOCATE (zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic)
 #ifdef ISO
       DEALLOCATE (zxxtsnow,xtVprecip,xtVprecipi,pxtrfl,pxtsfl)
@@ -1507,11 +1636,14 @@
 #ifdef CPP_StratAer
 ! variables for strat. aerosol CK
-      DEALLOCATE (R2SO4)
-      DEALLOCATE (DENSO4)
-      DEALLOCATE (f_r_wet)
+      DEALLOCATE (d_q_emiss)
+      DEALLOCATE (R2SO4, R2SO4B)
+      DEALLOCATE (DENSO4, DENSO4B)
+      DEALLOCATE (f_r_wet, f_r_wetB)
       DEALLOCATE (decfluxaer)
       DEALLOCATE (mdw)
       DEALLOCATE (SO2_lifetime)
       DEALLOCATE (OCS_lifetime)
+      DEALLOCATE (H2SO4_lifetime)
+      DEALLOCATE (O3_clim)
       DEALLOCATE (alpha_bin)
       DEALLOCATE (piz_bin)
@@ -1522,4 +1654,9 @@
       DEALLOCATE (surf_PM25_sulf)
       DEALLOCATE (vsed_aer)
+      DEALLOCATE (sulfmmr)
+      DEALLOCATE (SAD_sulfate)
+      DEALLOCATE (reff_sulfate)
+      DEALLOCATE (sulfmmr_mode)
+      DEALLOCATE (nd_mode)
       DEALLOCATE (budg_3D_ocs_to_so2)
       DEALLOCATE (budg_3D_so2_to_h2so4)
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/phys_output_ctrlout_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/phys_output_ctrlout_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/phys_output_ctrlout_mod.F90	(revision 5202)
@@ -1112,6 +1112,13 @@
   TYPE(ctrl_out), SAVE :: o_tke = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'tke ', 'TKE', 'm2/s2', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_tke_shear = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'tke_shear ', 'TKE shear term', 'm2/s3', (/ ('', i=1, 10) /))  
+  TYPE(ctrl_out), SAVE :: o_tke_buoy = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'tke_buoy ', 'TKE buoyancy term', 'm2/s3', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_tke_trans = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'tke_trans ', 'TKE transport term', 'm2/s3', (/ ('', i=1, 10) /))
   TYPE(ctrl_out), SAVE :: o_tke_dissip = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
-    'tke_dissip ', 'TKE DISSIPATION', 'm2/s3', (/ ('', i=1, 10) /))   
+    'tke_dissip ', 'TKE dissipation term', 'm2/s3', (/ ('', i=1, 10) /))
+
   TYPE(ctrl_out), SAVE :: o_tke_max = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'tke_max', 'TKE max', 'm2/s2',                                  &
@@ -1442,4 +1449,12 @@
   TYPE(ctrl_out), SAVE :: o_tau_strat_1020 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     'OD1020_strat_only', 'Stratospheric Aerosol Optical depth at 1020 nm ', '1', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_SAD_sulfate = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
+    'SAD_sulfate', 'SAD WET sulfate aerosols', 'cm2/cm3', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_reff_sulfate = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
+    'reff_sulfate', 'Effective radius of WET sulfate aerosols', 'cm', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_sulfmmr = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
+    'sulfMMR', 'Sulfate aerosol concentration (dry mass mixing ratio)', 'kg(H2SO4)/kg(air)', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_nd_mode(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_sulfmmr_mode(:)
 !--chemistry
   TYPE(ctrl_out), SAVE :: o_R2SO4 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
@@ -1551,4 +1566,11 @@
   TYPE(ctrl_out), SAVE :: o_rneb = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11, 11, 11/), &
     'rneb', 'Cloud fraction', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_cldfraliq = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'cldfraliq', 'Liquid fraction of the cloud', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_sigma2_icefracturb = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'sigma2_icefracturb', 'Variance of the diagnostic supersaturation distribution (icefrac_turb) [-]', '-', (/ ('', i=1, 10) /))
+  TYPE(ctrl_out), SAVE :: o_mean_icefracturb = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
+    'mean_icefracturb', 'Mean of the diagnostic supersaturation distribution (icefrac_turb) [-]', '-', (/ ('', i=1, 10) /))
+ 
   TYPE(ctrl_out), SAVE :: o_rnebjn = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11,11, 11/), &      
     'rnebjn', 'Cloud fraction in day', '-', (/ ('', i=1, 10) /))
@@ -1981,5 +2003,4 @@
   TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_dry(:)
 
-
 #ifdef ISO
   TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtprecip(:)
@@ -1991,4 +2012,5 @@
   TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtoliq(:)
   TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtcond(:)
+  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtrunoff_diag(:)
   TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtdyn(:)
   TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtldyn(:)
@@ -2088,4 +2110,9 @@
   TYPE(ctrl_out), SAVE :: o_runoff = ctrl_out((/ 1, 1, 10, 1, 10, 10, 11, 11, 11, 11/), &
     'runoff', 'Run-off rate land ice', 'kg/m2/s', (/ ('', i=1, 10) /))
+! SN add runoff_diag
+!#ifdef ISO
+  TYPE(ctrl_out), SAVE :: o_runoff_diag = ctrl_out((/ 1, 1, 10, 1, 10, 10, 11, 11, 11, 11/), &
+    'runoffland', 'Run-off rate land for bucket', 'kg/m2/s', (/ ('', i=1, 10) /))
+!#endif
   TYPE(ctrl_out), SAVE :: o_albslw3 = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
     'albslw3', 'Surface albedo LW3', '-', (/ ('', i=1, 10) /))
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/phys_output_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/phys_output_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/phys_output_mod.F90	(revision 5202)
@@ -1,660 +1,1 @@
-! $Id: phys_output_mod.F90 3792 2021-01-04 17:01:25Z evignon $
-!
-
-MODULE phys_output_mod 
-  USE indice_sol_mod
-  USE phys_output_var_mod
-  USE phys_output_write_mod, ONLY : phys_output_write
-  REAL, DIMENSION(nfiles),SAVE :: ecrit_files
-
-! Abderrahmane 12 2007
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!! Ecreture des Sorties du modele dans les fichiers Netcdf :
-! histmth.nc : moyennes mensuelles
-! histday.nc : moyennes journalieres
-! histhf.nc  : moyennes toutes les 3 heures
-! histins.nc : valeurs instantanees
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-CONTAINS
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!! Ouverture des fichier et definition des variable de sortie !!!!!!!!
-  !! histbeg, histvert et histdef
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-  SUBROUTINE phys_output_open(rlon,rlat,pim,tabij,ipt,jpt,plon,plat, &
-       jjmp1,nlevSTD,clevSTD,rlevSTD, dtime, ok_veget, &
-       type_ocean, iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, &
-       ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, read_climoz, &
-       phys_out_filestations, &
-       aerosol_couple, flag_aerosol_strat, &
-       pdtphys, paprs, pphis, pplay, lmax_th, ptconv, ptconvth, ivap, &
-       d_u, d_t, qx, d_qx, zmasse, ok_sync)   
-
-    USE iophy 
-    USE dimphy
-    USE infotrac_phy, ONLY: nqtot, tracers, niso, ntraciso=>ntiso
-    USE strings_mod,  ONLY: maxlen
-    USE ioipsl
-    USE phys_cal_mod, only : hour, calend
-    USE mod_phys_lmdz_para
-    !Martin
-    USE surface_data, ONLY : landice_opt
-    USE phys_output_ctrlout_mod
-    USE mod_grid_phy_lmdz, only: klon_glo,nbp_lon,nbp_lat
-    USE print_control_mod, ONLY: prt_level,lunout
-    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
-    ! ug Pour les sorties XIOS
-    USE wxios
-#ifdef ISO
-    USE isotopes_mod, ONLY: isoName,iso_HTO
-#ifdef ISOTRAC
-    use isotrac_mod, only: index_zone,index_iso,strtrac
-#endif
-#endif
-
-    IMPLICIT NONE
-    include "clesphys.h"
-    include "alpale.h"
-    include "YOMCST.h"
-
-    ! ug Nouveaux arguments n\'ecessaires au histwrite_mod:
-    INTEGER, INTENT(IN)                         :: ivap
-    INTEGER, DIMENSION(klon), INTENT(IN)        :: lmax_th
-    LOGICAL, INTENT(IN)                         :: ok_sync
-    LOGICAL, DIMENSION(klon, klev), INTENT(IN)  :: ptconv, ptconvth
-    REAL, INTENT(IN)                            :: pdtphys
-    REAL, DIMENSION(klon), INTENT(IN)           :: pphis
-    REAL, DIMENSION(klon, klev), INTENT(IN)     :: pplay, d_u, d_t
-    REAL, DIMENSION(klon, klev+1), INTENT(IN)   :: paprs
-    REAL, DIMENSION(klon,klev,nqtot), INTENT(IN):: qx, d_qx
-    REAL, DIMENSION(klon, klev), INTENT(IN)      :: zmasse
-
-
-    REAL,DIMENSION(klon),INTENT(IN) :: rlon
-    REAL,DIMENSION(klon),INTENT(IN) :: rlat
-    INTEGER, INTENT(IN)             :: pim
-    INTEGER, DIMENSION(pim)            :: tabij
-    INTEGER,DIMENSION(pim), INTENT(IN) :: ipt, jpt
-    REAL,DIMENSION(pim), INTENT(IN) :: plat, plon
-    REAL,DIMENSION(pim,2) :: plat_bounds, plon_bounds
-
-    INTEGER                               :: jjmp1
-    INTEGER                               :: nlevSTD, radpas
-    LOGICAL                               :: ok_mensuel, ok_journe, ok_hf, ok_instan
-    LOGICAL                               :: ok_LES,ok_ade,ok_aie
-    INTEGER                               :: flag_aerosol_strat
-    LOGICAL                               :: aerosol_couple
-    INTEGER, INTENT(IN)::  read_climoz ! read ozone climatology
-    !     Allowed values are 0, 1 and 2
-    !     0: do not read an ozone climatology
-    !     1: read a single ozone climatology that will be used day and night
-    !     2: read two ozone climatologies, the average day and night
-    !     climatology and the daylight climatology
-
-    REAL                                  :: dtime
-    INTEGER                               :: idayref
-    REAL                                  :: zjulian_start, zjulian
-    CHARACTER(LEN=4), DIMENSION(nlevSTD)  :: clevSTD
-    REAL, DIMENSION(nlevSTD)              :: rlevSTD
-    INTEGER                               :: nsrf, k, iq, iff, i, j, ilev, itr, ixt, iiso, izone
-    INTEGER                               :: naero
-    LOGICAL                               :: ok_veget
-    INTEGER                               :: iflag_pbl
-    INTEGER                               :: iflag_pbl_split
-    CHARACTER(LEN=4)                      :: bb2
-    CHARACTER(LEN=2)                      :: bb3
-    CHARACTER(LEN=6)                      :: type_ocean
-    INTEGER, DIMENSION(nbp_lon*jjmp1)         ::  ndex2d
-    INTEGER, DIMENSION(nbp_lon*jjmp1*klev)    :: ndex3d
-    INTEGER                               :: imin_ins, imax_ins
-    INTEGER                               :: jmin_ins, jmax_ins
-    INTEGER, DIMENSION(nfiles)            :: phys_out_levmin, phys_out_levmax
-    INTEGER, DIMENSION(nfiles)            :: phys_out_filelevels
-    CHARACTER(LEN=20), DIMENSION(nfiles)  :: chtimestep = (/ 'Default', 'Default', 'Default', 'Default', 'Default', &
-                                                             'Default', 'Default', 'Default', 'Default', 'Default' /)
-    LOGICAL, DIMENSION(nfiles)            :: phys_out_filekeys
-    LOGICAL, DIMENSION(nfiles)            :: phys_out_filestations
-
-#ifdef ISO
-    CHARACTER(LEN=maxlen) :: outiso
-    CHARACTER(LEN=20) :: unit
-#endif
-    CHARACTER(LEN=maxlen) :: tnam, lnam, dn
-    INTEGER :: flag(nfiles)
-
-!!!!!!!!!! stockage dans une region limitee pour chaque fichier !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    !                 entre [phys_out_lonmin,phys_out_lonmax] et [phys_out_latmin,phys_out_latmax]
-    LOGICAL, DIMENSION(nfiles), SAVE :: &
-      phys_out_regfkey = [.FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE.]
-    REAL,    DIMENSION(nfiles), SAVE :: &
-      phys_out_lonmin  = [  -180.,   -180.,   -180.,   -180.,   -180.,   -180.,   -180.,   -180.,   -180.,   -180.], &
-      phys_out_lonmax  = [   180.,    180.,    180.,    180.,    180.,    180.,    180.,    180.,    180.,    180.], &
-      phys_out_latmin  = [   -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.], &
-      phys_out_latmax  = [    90.,     90.,     90.,     90.,     90.,     90.,     90.,     90.,     90.,     90.]
-    REAL, DIMENSION(klev,2) :: Ahyb_bounds, Bhyb_bounds
-    REAL, DIMENSION(klev+1)   :: lev_index
-                
-    ! ug Variables utilis\'ees pour r\'ecup\'erer le calendrier pour xios
-    INTEGER :: x_an, x_mois, x_jour
-    REAL :: x_heure
-    INTEGER :: ini_an, ini_mois, ini_jour
-    REAL :: ini_heure
-    INTEGER                         :: ISW
-    REAL, DIMENSION(NSW)            :: wl1_sun, wl2_sun !wavelength bounds (in um) for SW
-    REAL, DIMENSION(NSW)            :: wn1_sun, wn2_sun !wavenumber bounds (in m-1) for SW 
-    REAL, DIMENSION(NSW)            :: spectband  !mean wavenumb. of each sp.band
-    REAL, DIMENSION(NSW,2)          :: spbnds_sun !bounds of spectband
-
-    WRITE(lunout,*) 'Debut phys_output_mod.F90'
-    ! Initialisations (Valeurs par defaut
-
-    DO ilev=1,klev
-      Ahyb_bounds(ilev,1) = ap(ilev)
-      Ahyb_bounds(ilev,2) = ap(ilev+1)
-      Bhyb_bounds(ilev,1) = bp(ilev)
-      Bhyb_bounds(ilev,2) = bp(ilev+1)
-      lev_index(ilev) = REAL(ilev)
-    END DO
-      lev_index(klev+1) = REAL(klev+1)
-
-    IF (.NOT. ALLOCATED(o_trac)) ALLOCATE(o_trac(nqtot))
-    IF (.NOT. ALLOCATED(o_trac_cum)) ALLOCATE(o_trac_cum(nqtot))
-    ALLOCATE(o_dtr_the(nqtot),o_dtr_con(nqtot),o_dtr_lessi_impa(nqtot))
-    ALLOCATE(o_dtr_lessi_nucl(nqtot),o_dtr_insc(nqtot),o_dtr_bcscav(nqtot))
-    ALLOCATE(o_dtr_evapls(nqtot),o_dtr_ls(nqtot),o_dtr_trsp(nqtot))
-    ALLOCATE(o_dtr_sscav(nqtot),o_dtr_sat(nqtot),o_dtr_uscav(nqtot))
-    ALLOCATE(o_dtr_dry(nqtot),o_dtr_vdf(nqtot))
-
-#ifdef ISO
-    ALLOCATE(o_xtprecip(ntraciso))
-    ALLOCATE(o_xtplul(ntraciso))
-    ALLOCATE(o_xtpluc(ntraciso))
-    ALLOCATE(o_xtevap(ntraciso))
-    ALLOCATE(o_xtevap_srf(ntraciso,4))
-    ALLOCATE(o_xtovap(ntraciso))
-    ALLOCATE(o_xtoliq(ntraciso))
-    ALLOCATE(o_xtcond(ntraciso))
-    ALLOCATE(o_dxtdyn(ntraciso))
-    ALLOCATE(o_dxtldyn(ntraciso))
-    ALLOCATE(o_dxtcon(ntraciso))
-    ALLOCATE(o_dxtlsc(ntraciso))
-    ALLOCATE(o_dxteva(ntraciso))
-    ALLOCATE(o_dxtajs(ntraciso))
-    ALLOCATE(o_dxtvdf(ntraciso))
-    ALLOCATE(o_dxtthe(ntraciso))
-    ALLOCATE(o_dxtch4(ntraciso))
-    if (iso_HTO.gt.0) then
-      ALLOCATE(o_dxtprod_nucl(ntraciso))
-      ALLOCATE(o_dxtcosmo(ntraciso))
-      ALLOCATE(o_dxtdecroiss(ntraciso))
-    endif
-#endif
-
-    levmax = (/ klev, klev, klev, klev, klev, klev, nlevSTD, nlevSTD, nlevSTD, klev /)
-
-    phys_out_filenames(1) = 'histmth'
-    phys_out_filenames(2) = 'histday'
-    phys_out_filenames(3) = 'histhf6h'
-    phys_out_filenames(4) = 'histhf3h'
-    phys_out_filenames(5) = 'histhf3hm'
-    phys_out_filenames(6) = 'histstn'
-    phys_out_filenames(7) = 'histmthNMC'
-    phys_out_filenames(8) = 'histdayNMC'
-    phys_out_filenames(9) = 'histhfNMC'
-    phys_out_filenames(10)= 'histstrataer'
-
-    type_ecri(1) = 'ave(X)'
-    type_ecri(2) = 'ave(X)'
-    type_ecri(3) = 'inst(X)'
-    type_ecri(4) = 'inst(X)'
-    type_ecri(5) = 'ave(X)'
-    type_ecri(6) = 'inst(X)'
-    type_ecri(7) = 'inst(X)'
-    type_ecri(8) = 'inst(X)'
-    type_ecri(9) = 'inst(X)'
-    type_ecri(10)= 'ave(X)'
-
-    clef_files(1) = ok_mensuel
-    clef_files(2) = ok_journe
-    clef_files(3) = ok_hf
-    clef_files(4) = ok_instan
-    clef_files(5) = ok_LES
-    clef_files(6) = ok_instan
-    clef_files(7) = ok_histNMC(1)
-    clef_files(8) = ok_histNMC(2)
-    clef_files(9) = ok_histNMC(3)
-#ifdef CPP_StratAer
-    clef_files(10)= .TRUE.
-#else
-    clef_files(10)= .FALSE.
-#endif
-
-    !sortir des fichiers "stations" si clef_stations(:)=.TRUE.
-    clef_stations(1) = .FALSE.
-    clef_stations(2) = .FALSE.
-    clef_stations(3) = .FALSE.
-    clef_stations(4) = .FALSE.
-    clef_stations(5) = .FALSE.
-    clef_stations(6) = .FALSE.
-    clef_stations(7) = .FALSE.
-    clef_stations(8) = .FALSE.
-    clef_stations(9) = .FALSE.
-    clef_stations(10)= .FALSE.
-
-    lev_files(1) = lev_histmth
-    lev_files(2) = lev_histday
-    lev_files(3) = lev_histhf
-    lev_files(4) = lev_histins
-    lev_files(5) = lev_histLES
-    lev_files(6) = lev_histins
-    lev_files(7) = levout_histNMC(1)
-    lev_files(8) = levout_histNMC(2)
-    lev_files(9) = levout_histNMC(3)
-    lev_files(10)= 5
-
-    ecrit_files(1) = ecrit_mth
-    ecrit_files(2) = ecrit_day
-    ecrit_files(3) = ecrit_hf
-    ecrit_files(4) = ecrit_ins
-    ecrit_files(5) = ecrit_LES
-    ecrit_files(6) = ecrit_ins
-    ecrit_files(7) = freq_outNMC(1)
-    ecrit_files(8) = freq_outNMC(2)
-    ecrit_files(9) = freq_outNMC(3)
-    ecrit_files(10)= ecrit_mth
-
-    !! Lectures des parametres de sorties dans physiq.def
-
-    CALL getin('phys_out_regfkey',phys_out_regfkey)
-    CALL getin('phys_out_lonmin',phys_out_lonmin)
-    CALL getin('phys_out_lonmax',phys_out_lonmax)
-    CALL getin('phys_out_latmin',phys_out_latmin)
-    CALL getin('phys_out_latmax',phys_out_latmax)
-    phys_out_levmin(:)=levmin(:)
-    CALL getin('phys_out_levmin',levmin)
-    phys_out_levmax(:)=levmax(:)
-    CALL getin('phys_out_levmax',levmax)
-    CALL getin('phys_out_filenames',phys_out_filenames)
-    phys_out_filekeys(:)=clef_files(:)
-    CALL getin('phys_out_filekeys',clef_files)
-    phys_out_filestations(:)=clef_stations(:)
-    CALL getin('phys_out_filestations',clef_stations)
-    phys_out_filelevels(:)=lev_files(:)
-    CALL getin('phys_out_filelevels',lev_files)
-    CALL getin('phys_out_filetimesteps',chtimestep)
-    phys_out_filetypes(:)=type_ecri(:)
-    CALL getin('phys_out_filetypes',type_ecri)
-
-    type_ecri_files(:)=type_ecri(:)
-
-!    if (ok_all_xml) phys_out_filelevels = 999
-
-    WRITE(lunout,*)'phys_out_lonmin=',phys_out_lonmin
-    WRITE(lunout,*)'phys_out_lonmax=',phys_out_lonmax
-    WRITE(lunout,*)'phys_out_latmin=',phys_out_latmin
-    WRITE(lunout,*)'phys_out_latmax=',phys_out_latmax
-    WRITE(lunout,*)'phys_out_filenames=',phys_out_filenames
-    WRITE(lunout,*)'phys_out_filetypes=',type_ecri
-    WRITE(lunout,*)'phys_out_filekeys=',clef_files
-    WRITE(lunout,*)'phys_out_filestations=',clef_stations
-    WRITE(lunout,*)'phys_out_filelevels=',lev_files
-    WRITE(lunout,*)'phys_out_regfkey=',phys_out_regfkey
-
-! A noter pour
-! l heure initiale - dans les fichiers histoire hist* - on met comme  
-! heure de debut soit la vraie heure (pour le 1D) soit 0h (pour le 3D) 
-! afin d avoir une seule sortie mensuelle par mois lorsque l on tourne 
-! par annee (IM).
-!
-     idayref = day_ref
-     IF (klon_glo==1) THEN
-       ! current_time (used to compute hour) is updated at the begining of
-       ! the physics; to set the correct outputs "initial time" we thus 
-       ! have to use (hour-dtphys).
-         CALL ymds2ju(annee_ref, 1, idayref, hour-pdtphys, zjulian)
-         print *,'phys_output_mod: annee,iday,hour,zjulian=',annee_ref,idayref, hour, zjulian
-     ELSE
-         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
-         CALL ymds2ju(annee_ref, 1, day_ini, start_time*rday, zjulian_start)
-     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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    ! Appel de histbeg et histvert pour creer le fichier et les niveaux verticaux !!
-    ! Appel des histbeg pour definir les variables (nom, moy ou inst, freq de sortie ..
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-    zdtime_moy = dtime         ! Frequence ou l on moyenne
-
-
-  ecrit_files(7) = ecrit_files(1)
-  ecrit_files(8) = ecrit_files(2)
-  ecrit_files(9) = ecrit_files(3)
-
-  DO iff=1,nfiles
-
-       ! Calculate ecrit_files for all files
-      IF ( chtimestep(iff).eq.'Default' ) THEN
-          ! Par defaut ecrit_files = (ecrit_mensuel ecrit_jour ecrit_hf
-          ! ...)*86400.
-          ecrit_files(iff)=ecrit_files(iff)*86400.
-      ELSE IF (chtimestep(iff).eq.'-1') THEN
-          PRINT*,'ecrit_files(',iff,') < 0 so IOIPSL work on different'
-          PRINT*,'months length'
-          ecrit_files(iff)=-1.
-      ELSE
-       CALL convers_timesteps(chtimestep(iff),dtime,ecrit_files(iff)) 
-      ENDIF
-
-       WRITE(lunout,*)'ecrit_files(',iff,')= ',ecrit_files(iff)
-       zoutm(iff) = ecrit_files(iff) ! Frequence ou l on ecrit en seconde
-
-
-    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: 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
-!
-!!! 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 !using_xios
-
-        IF (clef_files(iff)) THEN
-!!!!!!!!!!!!!!!!! Traitement dans le cas ou l'on veut stocker sur un domaine limite !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-          IF (phys_out_regfkey(iff)) THEN
-             imin_ins=1
-             imax_ins=nbp_lon
-             jmin_ins=1
-             jmax_ins=jjmp1
-
-             ! correction abderr        
-             DO i=1,nbp_lon
-                WRITE(lunout,*)'io_lon(i)=',io_lon(i)
-                IF (io_lon(i).le.phys_out_lonmin(iff)) imin_ins=i
-                IF (io_lon(i).le.phys_out_lonmax(iff)) imax_ins=i+1
-             ENDDO
-
-             DO j=1,jjmp1
-                WRITE(lunout,*)'io_lat(j)=',io_lat(j)
-                IF (io_lat(j).ge.phys_out_latmin(iff)) jmax_ins=j+1
-                IF (io_lat(j).ge.phys_out_latmax(iff)) jmin_ins=j
-             ENDDO
-
-             WRITE(lunout,*)'On stoke le fichier histoire numero ',iff,' sur ', &
-                  imin_ins,imax_ins,jmin_ins,jmax_ins
-             WRITE(lunout,*)'longitudes : ', &
-                  io_lon(imin_ins),io_lon(imax_ins), &
-                  'latitudes : ', &
-                  io_lat(jmax_ins),io_lat(jmin_ins)
-
-             CALL histbeg(phys_out_filenames(iff),nbp_lon,io_lon,jjmp1,io_lat, &
-                  imin_ins,imax_ins-imin_ins+1, &
-                  jmin_ins,jmax_ins-jmin_ins+1, &
-                  itau_phy,zjulian,dtime,nhorim(iff),nid_files(iff))
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-             !IM fichiers stations
-          ELSE IF (clef_stations(iff)) THEN
-
-             IF (prt_level >= 10) THEN
-             WRITE(lunout,*)'phys_output_open: iff=',iff,'  phys_out_filenames(iff)=',phys_out_filenames(iff)
-             ENDIF
-             
-             CALL histbeg_phy_all(rlon,rlat,pim,tabij,ipt,jpt,plon,plat,plon_bounds,plat_bounds, &
-                  phys_out_filenames(iff), &
-                  itau_phy,zjulian,dtime,nhorim(iff),nid_files(iff))
-          ELSE
-
-             IF (prt_level >= 10) THEN
-             WRITE(lunout,*)'phys_output_open: iff=',iff,'  phys_out_filenames(iff)=',phys_out_filenames(iff)
-             ENDIF
-
-             CALL histbeg_phy_all(phys_out_filenames(iff),itau_phy,zjulian,&
-                 dtime,nhorim(iff),nid_files(iff))
-          ENDIF
-
-#ifndef CPP_IOIPSL_NO_OUTPUT 
-          IF (iff.LE.6.OR.iff.EQ.10) THEN
-             CALL histvert(nid_files(iff), "presnivs", "Vertical levels", "Pa", &  
-               levmax(iff) - levmin(iff) + 1, &
-               presnivs(levmin(iff):levmax(iff)), nvertm(iff),"down")
-!!!! Composantes de la coordonnee sigma-hybride 
-          CALL histvert(nid_files(iff), "Ahyb","Ahyb comp of Hyb Cord ", "Pa", &
-               levmax(iff) - levmin(iff) + 1,aps,nvertap(iff))
-
-          CALL histvert(nid_files(iff), "Bhyb","Bhyb comp of Hyb Cord", " ", &
-               levmax(iff) - levmin(iff) + 1,bps,nvertbp(iff))
-
-          CALL histvert(nid_files(iff), "Alt","Height approx for scale heigh of 8km at levels", "Km", &                       
-               levmax(iff) - levmin(iff) + 1,pseudoalt,nvertAlt(iff))
-
-          ELSE
-          ! NMC files
-             CALL histvert(nid_files(iff), "plev", "pressure", "Pa", &
-               levmax(iff) - levmin(iff) + 1, &
-              rlevSTD(levmin(iff):levmax(iff)), nvertm(iff), "down")
-          ENDIF
-#endif
-
-     ENDIF ! clef_files
-
-          itr = 0
-          DO iq = 1, nqtot 
-            IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
-            itr = itr + 1
-            dn = 'd'//TRIM(tracers(iq)%name)//'_'
-
-            flag = [1, 5, 5, 5, 10, 10, 11, 11, 11, 11]
-            lnam = 'Tracer '//TRIM(tracers(iq)%longName)
-            tnam = TRIM(tracers(iq)%name);  o_trac          (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-
-            flag = [4, 7, 7, 7, 10, 10, 11, 11, 11, 11]
-            lnam = 'Tendance tracer '//TRIM(tracers(iq)%longName)
-            tnam = TRIM(dn)//'vdf';         o_dtr_vdf       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-
-            flag = [5, 7, 7, 7, 10, 10, 11, 11, 11, 11]
-            tnam = TRIM(dn)//'the';         o_dtr_the       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-            tnam = TRIM(dn)//'con';         o_dtr_con       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-
-            flag = [7, 7, 7, 7, 10, 10, 11, 11, 11, 11]
-            tnam = TRIM(dn)//'lessi_impa';  o_dtr_lessi_impa(itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-            tnam = TRIM(dn)//'lessi_nucl';  o_dtr_lessi_nucl(itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-            tnam = TRIM(dn)//'insc';        o_dtr_insc      (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-            tnam = TRIM(dn)//'bcscav';      o_dtr_bcscav    (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-            tnam = TRIM(dn)//'evapls';      o_dtr_evapls    (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-            tnam = TRIM(dn)//'ls';          o_dtr_ls        (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-            tnam = TRIM(dn)//'trsp';        o_dtr_trsp      (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-            tnam = TRIM(dn)//'sscav';       o_dtr_sscav     (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-            tnam = TRIM(dn)//'sat';         o_dtr_sat       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-            tnam = TRIM(dn)//'uscav';       o_dtr_uscav     (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-
-            lnam = 'tracer tendency dry deposition'//TRIM(tracers(iq)%longName)
-            tnam = 'cum'//TRIM(dn)//'dry';  o_dtr_dry       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-
-            flag = [1, 4, 10, 10, 10, 10, 11, 11, 11, 11]
-            lnam = 'Cumulated tracer '//TRIM(tracers(iq)%longName)
-            tnam = 'cum'//TRIM(tracers(iq)%name); o_trac_cum(itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
-          ENDDO
-
-   ENDDO !  iff
-
-#ifdef ISO
-    write(*,*) 'phys_output_mid 589'
-    do ixt=1,ntraciso
-      outiso = TRIM(isoName(ixt))
-      i = INDEX(outiso, '_', .TRUE.)
-      outiso = outiso(1:i-1)//outiso(i+1:LEN_TRIM(outiso))
-
-      flag = [1,  1,  1, 10,  5, 10, 11, 11, 11, 11]; unit = 'kg/(s*m2)'
-      o_xtprecip(ixt)=ctrl_out(flag, 'precip'//TRIM(outiso), 'Precip Totale liq+sol', unit, [('',i=1,nfiles)])
-      o_xtpluc  (ixt)=ctrl_out(flag,   'pluc'//TRIM(outiso),    'Convective Precip.', unit, [('',i=1,nfiles)])
-
-      flag = [1,  1,  1, 10, 10, 10, 11, 11, 11, 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'
-      o_xtovap  (ixt)=ctrl_out(flag,   'ovap'//TRIM(outiso),     'Specific humidity', unit, [('',i=1,nfiles)])
-      o_xtoliq  (ixt)=ctrl_out(flag,   'oliq'//TRIM(outiso),          'Liquid water', unit, [('',i=1,nfiles)])
-      o_xtcond  (ixt)=ctrl_out(flag,  'ocond'//TRIM(outiso),       'Condensed water', unit, [('',i=1,nfiles)])
-
-      flag = [4, 10, 10, 10, 10, 10, 11, 11, 11, 11]; unit = '(kg/kg)/s'
-      o_dxtdyn  (ixt)=ctrl_out(flag,  'dqdyn'//TRIM(outiso),           'Dynamics dQ', unit, [('',i=1,nfiles)])
-      o_dxtldyn (ixt)=ctrl_out(flag, 'dqldyn'//TRIM(outiso),          'Dynamics dQL', unit, [('',i=1,nfiles)])
-      o_dxtcon  (ixt)=ctrl_out(flag,  'dqcon'//TRIM(outiso),         'Convection dQ', unit, [('',i=1,nfiles)])
-      o_dxteva  (ixt)=ctrl_out(flag,  'dqeva'//TRIM(outiso),      'Reevaporation dQ', unit, [('',i=1,nfiles)])
-      o_dxtlsc  (ixt)=ctrl_out(flag,  'dqlsc'//TRIM(outiso),       'Condensation dQ', unit, [('',i=1,nfiles)])
-      o_dxtajs  (ixt)=ctrl_out(flag,  'dqajs'//TRIM(outiso),        'Dry adjust. dQ', unit, [('',i=1,nfiles)])
-      o_dxtvdf  (ixt)=ctrl_out(flag,  'dqvdf'//TRIM(outiso),     'Boundary-layer dQ', unit, [('',i=1,nfiles)])
-      o_dxtthe  (ixt)=ctrl_out(flag,  'dqthe'//TRIM(outiso),            'Thermal dQ', unit, [('',i=1,nfiles)])
-
-      IF(ok_qch4) o_dxtch4(ixt)=ctrl_out(flag, 'dqch4'//TRIM(outiso), 'H2O due to CH4 oxidation & photolysis', &
-                                                                                      unit, [('',i=1,nfiles)])
-      IF(ixt == iso_HTO) THEN
-      o_dxtprod_nucl(ixt)=ctrl_out(flag, 'dqprodnucl'//TRIM(outiso), 'dHTO/dt due to nuclear production',      &
-                                                                                      unit, [('',i=1,nfiles)])
-      o_dxtcosmo    (ixt)=ctrl_out(flag,    'dqcosmo'//TRIM(outiso), 'dHTO/dt due to cosmogenic production',   &
-                                                                                      unit, [('',i=1,nfiles)])
-      o_dxtdecroiss (ixt)=ctrl_out(flag, 'dqdecroiss'//TRIM(outiso), 'dHTO/dt due to radiative destruction',   &
-                                                                                      unit, [('',i=1,nfiles)])
-      END IF
-    enddo !do ixt=1,niso
-    write(*,*) 'phys_output_mid 596'
-#endif
-
-
-    ! Updated write frequencies due to phys_out_filetimesteps. 
-    ! Write frequencies are now in seconds.  
-    ecrit_mth = ecrit_files(1)
-    ecrit_day = ecrit_files(2)
-    ecrit_hf  = ecrit_files(3)
-    ecrit_ins = ecrit_files(4)
-    ecrit_LES = ecrit_files(5)
-    ecrit_ins = ecrit_files(6)
-
-    IF (prt_level >= 10) THEN
-      WRITE(lunout,*)'swaerofree_diag=',swaerofree_diag
-      WRITE(lunout,*)'swaero_diag=',swaero_diag
-      WRITE(lunout,*)'dryaod_diag=',dryaod_diag
-      WRITE(lunout,*)'ok_4xCO2atm=',ok_4xCO2atm
-      WRITE(lunout,*)'phys_output_open: ends here'
-    ENDIF
-
-  END SUBROUTINE phys_output_open
-
-  SUBROUTINE convers_timesteps(str,dtime,timestep)
-
-    use ioipsl
-    USE phys_cal_mod
-    USE time_phylmdz_mod, ONLY: day_ref, annee_ref
-    USE print_control_mod, ONLY: lunout
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=20)   :: str
-    CHARACTER(LEN=10)   :: type
-    INTEGER             :: ipos,il
-    real                :: ttt,xxx,timestep,dayseconde,dtime
-    parameter (dayseconde=86400.)
-
-    ipos=scan(str,'0123456789.',.TRUE.)
-    !  
-    il=len_trim(str)
-    WRITE(lunout,*) "ipos = ", ipos
-    WRITE(lunout,*) "il = ", il
-    IF (ipos == 0) CALL abort_physic("convers_timesteps", "bad str", 1)
-    read(str(1:ipos),*) ttt
-    WRITE(lunout,*)ttt
-    type=str(ipos+1:il)
-
-    IF ( il == ipos ) THEN
-       type='day'
-    ENDIF
-
-    IF ( type == 'day'.or.type == 'days'.or.type == 'jours'.or.type == 'jour' ) timestep = ttt * dayseconde
-    IF ( type == 'mounths'.or.type == 'mth'.or.type == 'mois' ) THEN
-       WRITE(lunout,*)'annee_ref,day_ref mon_len',annee_ref,day_ref,mth_len
-       timestep = ttt * dayseconde * mth_len
-    ENDIF
-    IF ( type == 'hours'.or.type == 'hr'.or.type == 'heurs') timestep = ttt * dayseconde / 24.
-    IF ( type == 'mn'.or.type == 'minutes'  ) timestep = ttt * 60.
-    IF ( type == 's'.or.type == 'sec'.or.type == 'secondes'   ) timestep = ttt
-    IF ( type == 'TS' ) timestep = ttt * dtime
-
-    WRITE(lunout,*)'type =      ',type
-    WRITE(lunout,*)'nb j/h/m =  ',ttt
-    WRITE(lunout,*)'timestep(s)=',timestep
-
-  END SUBROUTINE convers_timesteps
-
-END MODULE phys_output_mod
+link ../phylmd/phys_output_mod.F90
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/phys_output_var_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/phys_output_var_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/phys_output_var_mod.F90	(revision 5202)
@@ -1,319 +1,1 @@
-!
-! phys_local_var_mod.F90 1327 2010-03-17 15:33:56Z idelkadi $
-
-MODULE phys_output_var_mod
-
-  USE dimphy
-  ! Variables outputs pour les ecritures des sorties
-  !======================================================================
-  !
-  !
-  !======================================================================
-  ! Declaration des variables
-
-  REAL, SAVE, ALLOCATABLE :: snow_o(:), zfra_o(:)
-  !$OMP THREADPRIVATE(snow_o, zfra_o)
-  REAL, SAVE, ALLOCATABLE :: sza_o(:) ! solar zenithal angle
-  !$OMP THREADPRIVATE(sza_o)
-  INTEGER, SAVE, ALLOCATABLE ::  itau_con(:)       ! Nombre de pas ou rflag <= 1
-  !$OMP THREADPRIVATE(itau_con)
-  REAL, SAVE, ALLOCATABLE :: bils_ec(:) ! Contribution of energy conservation
-  REAL, SAVE, ALLOCATABLE :: bils_ech(:) ! Contribution of energy conservation
-  REAL, SAVE, ALLOCATABLE :: bils_tke(:) ! Contribution of energy conservation
-  REAL, SAVE, ALLOCATABLE :: bils_diss(:) ! Contribution of energy conservation
-  REAL, SAVE, ALLOCATABLE :: bils_kinetic(:) ! bilan de chaleur au sol, kinetic
-  REAL, SAVE, ALLOCATABLE :: bils_enthalp(:) ! bilan de chaleur au sol
-  REAL, SAVE, ALLOCATABLE :: bils_latent(:) ! bilan de chaleur au sol
-  !$OMP THREADPRIVATE(bils_ec,bils_ech,bils_tke,bils_diss,bils_kinetic,bils_enthalp,bils_latent)
-  ! output variables for energy conservation tests, computed in add_phys_tend
-  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(:)      ! 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)
-  REAL, SAVE, ALLOCATABLE :: d_h_dair_col(:)  ! enthalpy budget of dry air for each column (W/m2)
-  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 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_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 
-  ! vertical PDFs
-  REAL, SAVE, ALLOCATABLE :: cloudth_sth(:,:),cloudth_senv(:,:)
-  !$OMP THREADPRIVATE(cloudth_sth,cloudth_senv)
-  REAL, SAVE, ALLOCATABLE :: cloudth_sigmath(:,:),cloudth_sigmaenv(:,:)
-  !$OMP THREADPRIVATE(cloudth_sigmath,cloudth_sigmaenv)
-
-! Marine
-! Variables de sortie du simulateur AIRS
-
-  REAL, SAVE, ALLOCATABLE :: map_prop_hc(:),map_prop_hist(:),alt_tropo(:)
-  !$OMP THREADPRIVATE(map_prop_hc,map_prop_hist,alt_tropo)
-  REAL, SAVE, ALLOCATABLE :: map_emis_hc(:),map_iwp_hc(:),map_deltaz_hc(:), &
-                       map_pcld_hc(:),map_tcld_hc(:)
-  !$OMP THREADPRIVATE(map_emis_hc,map_iwp_hc,map_deltaz_hc,map_pcld_hc,map_tcld_hc)
-  REAL, SAVE, ALLOCATABLE :: map_emis_hist(:),map_iwp_hist(:),map_deltaz_hist(:),map_rad_hist(:)         
-  !$OMP THREADPRIVATE(map_emis_hist,map_iwp_hist,map_deltaz_hist,map_rad_hist)
-  REAL, SAVE, ALLOCATABLE :: map_ntot(:),map_hc(:),map_hist(:)
-  REAL, SAVE, ALLOCATABLE :: map_Cb(:),map_ThCi(:),map_Anv(:)
-  !$OMP THREADPRIVATE(map_ntot,map_hc,map_hist,map_Cb,map_ThCi,map_Anv)
-  REAL, SAVE, ALLOCATABLE :: map_emis_Cb(:),map_pcld_Cb(:),map_tcld_Cb(:)
-  REAL, SAVE, ALLOCATABLE :: map_emis_ThCi(:),map_pcld_ThCi(:),map_tcld_ThCi(:)
-  !$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)
-
-  ! 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)  
-   
-
-  ! ug Plein de variables venues de phys_output_mod
-  INTEGER, PARAMETER                           :: nfiles = 10
-  LOGICAL, DIMENSION(nfiles), SAVE             :: clef_files
-  LOGICAL, DIMENSION(nfiles), SAVE             :: clef_stations
-  INTEGER, DIMENSION(nfiles), SAVE             :: lev_files
-  INTEGER, DIMENSION(nfiles), SAVE             :: nid_files
-  INTEGER, DIMENSION(nfiles), SAVE  :: nnid_files
-  !$OMP THREADPRIVATE(clef_files, clef_stations, lev_files,nid_files,nnid_files)
-  INTEGER, DIMENSION(nfiles), SAVE :: nnhorim
-
-  INTEGER, DIMENSION(nfiles), SAVE :: nhorim, nvertm
-  INTEGER, DIMENSION(nfiles), SAVE :: nvertap, nvertbp, nvertAlt
-  REAL, DIMENSION(nfiles), SAVE                :: zoutm
-  CHARACTER(LEN=20), DIMENSION(nfiles), SAVE   :: type_ecri
-  !$OMP THREADPRIVATE(nnhorim, nhorim, nvertm, zoutm,type_ecri)
-  CHARACTER(LEN=20), DIMENSION(nfiles), SAVE  :: type_ecri_files, phys_out_filetypes
-  !$OMP THREADPRIVATE(type_ecri_files, phys_out_filetypes)
-  CHARACTER(LEN=20), DIMENSION(nfiles), SAVE  :: phys_out_filenames
-  !$OMP THREADPRIVATE(phys_out_filenames)
-
-  ! swaero_diag : flag indicates if it is necessary to do calculation for some aerosol diagnostics
-  ! swaerofree_diag : flag indicates if it is necessary to do calculation for some aerosol diagnostics
-  ! dryaod_diag : flag indicates if it is necessary to do calculation for some aerosol diagnostics
-  !--OB: this needs to be set to TRUE by default and changed back to FALSE after first radiation call
-  !--    and corrected back to TRUE based on output requests
-  LOGICAL, SAVE                                :: swaerofree_diag=.TRUE.
-  LOGICAL, SAVE                                :: swaero_diag=.TRUE.
-  LOGICAL, SAVE                                :: dryaod_diag=.TRUE.
-  !$OMP THREADPRIVATE(swaerofree_diag, swaero_diag, dryaod_diag)
-  ! ok_4xCO2atm : flag indicates if it is necessary to do a second call of
-  ! radiation code with a 4xCO2 or another different GES to assess SW/LW
-  ! in this case
-  !--IM: as for swaero_diag or dryaod_diag this needs to be set to TRUE by default and
-  !--    changed back to FALSE after first radiation call and corrected back to TRUE 
-  !--    based on output requests
-  LOGICAL, SAVE                                :: ok_4xCO2atm=.TRUE.
-  !$OMP THREADPRIVATE(ok_4xCO2atm)
-
-  INTEGER, SAVE:: levmin(nfiles) = 1
-  INTEGER, SAVE:: levmax(nfiles)
-  !$OMP THREADPRIVATE(levmin, levmax)
-
-  REAL, SAVE                :: zdtime_moy
-  !$OMP THREADPRIVATE(zdtime_moy)
-
-  LOGICAL, SAVE :: vars_defined = .FALSE. ! ug PAS THREADPRIVATE ET C'EST NORMAL
-
-  REAL, allocatable:: zustr_gwd_hines(:), zvstr_gwd_hines(:) ! (klon)
-  REAL, allocatable:: zustr_gwd_front(:), zvstr_gwd_front(:) ! (klon)
-  REAL, allocatable:: zustr_gwd_rando(:), zvstr_gwd_rando(:) ! (klon)
-  !$OMP THREADPRIVATE(zustr_gwd_hines, zvstr_gwd_hines)
-  !$OMP THREADPRIVATE(zustr_gwd_front, zvstr_gwd_front)
-  !$OMP THREADPRIVATE(zustr_gwd_rando, zvstr_gwd_rando)
-
-  TYPE ctrl_out
-     INTEGER,DIMENSION(nfiles)            :: flag
-     CHARACTER(len=20)                    :: name
-     CHARACTER(len=150)                   :: description
-     CHARACTER(len=20)                    :: unit
-     CHARACTER(len=20),DIMENSION(nfiles)  :: type_ecrit
-  END TYPE ctrl_out
-
-  REAL, SAVE, ALLOCATABLE :: sens_prec_liq_o(:,:), sens_prec_sol_o(:,:)
-  REAL, SAVE, ALLOCATABLE :: lat_prec_liq_o(:,:), lat_prec_sol_o(:,:)
- !$OMP THREADPRIVATE(sens_prec_liq_o, sens_prec_sol_o,lat_prec_liq_o,lat_prec_sol_o)
-
-  ! Ocean-atmosphere interface, subskin ocean and near-surface ocean:
-  
-  REAL, SAVE, ALLOCATABLE:: tkt(:) ! (klon)
-  ! épaisseur (m) de la couche de diffusion thermique (microlayer)
-  ! cool skin thickness
-
-  REAL, SAVE, ALLOCATABLE:: tks(:) ! (klon)
-  ! épaisseur (m) de la couche de diffusion de masse (microlayer)
-  
-  REAL, SAVE, ALLOCATABLE:: taur(:) ! (klon) momentum flux due to rain, in Pa
-
-  REAL, SAVE, ALLOCATABLE:: sss(:) ! (klon)
-  ! bulk salinity of the surface layer of the ocean, in ppt
-  
-  !$OMP THREADPRIVATE(tkt, tks, taur, sss)
-
-  !AI. cloud_cover_sw, cloud_cover_sw_s2 from Ecrad (1rt and 2 call)
-  REAL, SAVE, ALLOCATABLE:: cloud_cover_sw(:), cloud_cover_sw_s2(:)
-  !$OMP THREADPRIVATE(cloud_cover_sw, cloud_cover_sw_s2)
-
-CONTAINS
-
-  !======================================================================
-  SUBROUTINE phys_output_var_init
-    use dimphy
-    use config_ocean_skin_m, only: activate_ocean_skin
-
-    IMPLICIT NONE
-
-    include "clesphys.h"
-
-    !------------------------------------------------
-
-    allocate(snow_o(klon), zfra_o(klon))
-    allocate(sza_o(klon) )
-    allocate(itau_con(klon))
-    allocate(sens_prec_liq_o(klon,2))
-    allocate(sens_prec_sol_o(klon,2))
-    allocate(lat_prec_liq_o(klon,2))
-    allocate(lat_prec_sol_o(klon,2))
-    sens_prec_liq_o = 0.0 ; sens_prec_sol_o = 0.0
-    lat_prec_liq_o = 0.0 ; lat_prec_sol_o = 0.0
-
-    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_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
-    allocate(cloudth_sth(klon,klev))
-    allocate(cloudth_senv(klon,klev))
-    cloudth_sth = 0. ; cloudth_senv = 0. 
-    allocate(cloudth_sigmath(klon,klev))
-    allocate(cloudth_sigmaenv(klon,klev))
-    cloudth_sigmath = 0. ; cloudth_sigmaenv = 0.
-
-! Marine
-! Variables de sortie simulateur AIRS
-
-!     if (ok_airs) then
-      allocate (map_prop_hc(klon),map_prop_hist(klon))
-      allocate (alt_tropo(klon))
-      allocate (map_emis_hc(klon),map_iwp_hc(klon),map_deltaz_hc(klon))
-      allocate (map_pcld_hc(klon),map_tcld_hc(klon))
-      allocate (map_emis_hist(klon),map_iwp_hist(klon),map_deltaz_hist(klon))
-      allocate (map_rad_hist(klon))
-      allocate (map_ntot(klon),map_hc(klon),map_hist(klon))
-      allocate (map_Cb(klon),map_ThCi(klon),map_Anv(klon))
-      allocate (map_emis_Cb(klon),map_pcld_Cb(klon),map_tcld_Cb(klon))
-      allocate (map_emis_ThCi(klon),map_pcld_ThCi(klon),map_tcld_ThCi(klon))
-      allocate (map_emis_Anv(klon),map_pcld_Anv(klon),map_tcld_Anv(klon))
-!     endif
-
-    IF (ok_hines) allocate(zustr_gwd_hines(klon), zvstr_gwd_hines(klon))
-    IF (.not.ok_hines.and.ok_gwd_rando) &
-                  allocate(zustr_gwd_front(klon), zvstr_gwd_front(klon))
-    IF (ok_gwd_rando) allocate(zustr_gwd_rando(klon), zvstr_gwd_rando(klon))
-
-    if (activate_ocean_skin >= 1) allocate(tkt(klon), tks(klon), taur(klon), &
-         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))
-
-    ! cloud_cover_sw, cloud_cover_sw_s2 from Ecrad
-    ALLOCATE(cloud_cover_sw(klon))
-    ALLOCATE(cloud_cover_sw_s2(klon))
-
-  END SUBROUTINE phys_output_var_init
-
-  !======================================================================
-  SUBROUTINE phys_output_var_end
-    USE dimphy
-    IMPLICIT NONE
-
-    include "clesphys.h"
-
-    deallocate(snow_o,zfra_o,itau_con)
-    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_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
-    deallocate(cloudth_sth)
-    deallocate(cloudth_senv)
-    deallocate(cloudth_sigmath)
-    deallocate(cloudth_sigmaenv)
-
-! Marine
-! Variables de sortie simulateur AIRS
-
- !    if (ok_airs) then
-      deallocate (map_prop_hc,map_prop_hist)
-      deallocate (alt_tropo)
-      deallocate (map_emis_hc,map_iwp_hc,map_deltaz_hc)
-      deallocate (map_pcld_hc,map_tcld_hc)
-      deallocate (map_emis_hist,map_iwp_hist,map_deltaz_hist)
-      deallocate (map_rad_hist)
-      deallocate (map_ntot,map_hc,map_hist)
-      deallocate (map_Cb,map_ThCi,map_Anv)
-      deallocate (map_emis_Cb,map_pcld_Cb,map_tcld_Cb)
-      deallocate (map_emis_ThCi,map_pcld_ThCi,map_tcld_ThCi)
-      deallocate (map_emis_Anv,map_pcld_Anv,map_tcld_Anv)
-  !   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)
-
-    !AI cloud_cover_sw, cloud_cover_sw_s2 from Ecrad
-    DEALLOCATE(cloud_cover_sw, cloud_cover_sw_s2)
-
-  END SUBROUTINE phys_output_var_end
-
-END MODULE phys_output_var_mod
+link ../phylmd/phys_output_var_mod.F90
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/physiq_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/physiq_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/physiq_mod.F90	(revision 5202)
@@ -39,5 +39,5 @@
     USE ioipsl_getin_p_mod, ONLY : getin_p
     USE indice_sol_mod
-    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac
+    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac,ivap,iliq,isol
     USE readTracFiles_mod, ONLY: addPhase
     USE strings_mod,  ONLY: strIdx
@@ -93,4 +93,5 @@
     USE phys_output_var_mod, ONLY : cloud_cover_sw, cloud_cover_sw_s2
 
+
     !USE cmp_seri_mod
 !    USE add_phys_tend_mod, only : add_pbl_tend, add_phys_tend, diag_phys_tend, prt_enerbil, &
@@ -117,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
@@ -131,9 +134,9 @@
 
 #ifdef CPP_StratAer
+    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
-
 
     USE lmdz_xios, ONLY: xios_update_calendar, xios_context_finalize
@@ -153,5 +156,5 @@
         & modif_ratqs,essai_convergence,iso_init,ridicule_rain,tnat, &
         & ridicule,ridicule_snow
-    USE isotopes_routines_mod, ONLY: iso_tritium
+    USE isotopes_routines_mod, ONLY: iso_tritium,dispatch,together
 #ifdef ISOVERIF
     USE isotopes_verif_mod, ONLY: errmax,errmaxrel, &
@@ -188,4 +191,5 @@
 !!!!!!!!!!!!!!!!!!  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]
@@ -193,4 +197,6 @@
        t_seri,q_seri,ql_seri,qs_seri,qbs_seri, &
        u_seri,v_seri,cf_seri,rvc_seri,tr_seri, &
+       rhcl, &        
+       qx_seri, & ! CR
        rhcl, &        
        ! Dynamic tendencies (diagnostics)
@@ -209,4 +215,5 @@
        !
        d_t_eva,d_q_eva,d_ql_eva,d_qi_eva, &
+       d_qx_eva, &
        d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc, &
        d_t_lscst,d_q_lscst, &
@@ -219,5 +226,5 @@
        d_ts, &
        !
-       d_t_bs,d_q_bs,d_qbs_bs, &
+       d_t_bsss,d_q_bsss,d_qbs_bsss, &
        !
 !       d_t_oli,d_u_oli,d_v_oli, &
@@ -247,4 +254,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,       &
@@ -265,4 +283,15 @@
        toplwai_aerop, sollwai_aerop,   &
        toplwad0_aerop, sollwad0_aerop, &
+       !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, &
        !
        ptstar, pt0, slp, &
@@ -346,6 +375,6 @@
        !
        rneblsvol, &
-       pfraclr,pfracld, &
-       distcltop,temp_cltop, &
+       pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb,  &
+       distcltop, temp_cltop,  &
        !-- LSCP - condensation and ice supersaturation variables
        qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, &
@@ -384,7 +413,7 @@
 
 #ifdef ISO
-       USE phys_local_var_mod, ONLY: xt_seri,xtl_seri,xts_seri, &
+       USE phys_local_var_mod, ONLY: xt_seri,xtl_seri,xts_seri,xtbs_seri, &
        d_xt_eva,d_xtl_eva,d_xti_eva,           &
-       d_xt_dyn,d_xtl_dyn,d_xts_dyn,           &
+       d_xt_dyn,d_xtl_dyn,d_xts_dyn,d_xtbs_dyn, &
        d_xt_con, d_xt_wake,                    &
        d_xt_ajsb, d_xt_ajs,                    &
@@ -412,4 +441,5 @@
        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
 
 
@@ -556,7 +586,13 @@
     !
     ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional), blowing snow (optional)
-    INTEGER,SAVE :: ivap, iliq, isol, ibs, icf, irvc
-!$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, irvc)
-    !
+!    INTEGER,SAVE :: ivap, iliq, isol, irneb, ibs
+!!$OMP THREADPRIVATE(ivap, iliq, isol, irneb, ibs)
+! Camille Risi 25 juillet 2023: ivap,iliq,isol deja definis dans infotrac_phy. 
+! Et ils sont utiles ailleurs que dans physiq_mod (ex:
+! reevap -> je commente les 2 lignes au dessus et je laisse la definition
+! plutot dans infotrac_phy
+    INTEGER,SAVE :: irneb, ibs, icf,irvc
+!$OMP THREADPRIVATE(irneb, ibs, icf,irvc)
+!
     !
     ! Variables argument:
@@ -812,4 +848,6 @@
     real therm_tke_max0(klon)   ! TKE dans les thermiques au LCL 
     real env_tke_max0(klon)     ! TKE dans l'environnement au LCL 
+    INTEGER, SAVE :: iflag_thermcell_tke ! transtport TKE by thermals
+    !$OMP THREADPRIVATE(iflag_thermcell_tke)
 
 !JLD    !---D\'eclenchement stochastique
@@ -900,11 +938,5 @@
     EXTERNAL ajsec     ! ajustement sec
     EXTERNAL conlmd    ! convection (schema LMD)
-    !KE43
     EXTERNAL conema3  ! convect4.3
-    !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
@@ -960,7 +992,4 @@
     REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
     !
-#ifdef INCA
-    REAL zxsnow_dummy(klon)
-#endif
     REAL zsav_tsol(klon)
     !
@@ -1068,4 +1097,8 @@
     !$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)
     !
     !********************************************************
@@ -1205,4 +1238,5 @@
     REAL, DIMENSION(klon,klev)     :: mass_solu_aero_pi
     ! - " - (pre-industrial value)
+    REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
 
     ! Parameters
@@ -1271,4 +1305,11 @@
     ! Declarations pour Simulateur COSP
     !============================================================
+    ! AI 10-22
+#ifdef CPP_COSP
+    include "ini_COSP.h"
+#endif
+#ifdef CPP_COSPV2
+    include "ini_COSP.h"
+#endif
     real :: mr_ozone(klon,klev), phicosp(klon,klev)
 
@@ -1346,4 +1387,7 @@
 
     REAL, dimension(klon,klev) :: t_env,q_env
+#ifdef ISO
+    real, dimension(ntraciso,klon,klev) ::  xt_env
+#endif
 
     REAL, dimension(klon) :: pr_et
@@ -1356,4 +1400,29 @@
     !AI namelist pour gerer le double appel de Ecrad
     CHARACTER(len=512) :: namelist_ecrad_file
+
+    !======================================================================!
+    ! 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
+#ifdef ISO
+       abort_message='isotopes pas encore dans physiqex'
+       CALL abort_physic(modname,abort_message,1)
+#endif
+       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.)
@@ -1372,11 +1441,12 @@
     phys_tstep=NINT(pdtphys)
     IF (.NOT. using_xios) missing_val=nf90_fill_real
-#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)
+
+    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
-#endif
 
     !======================================================================
@@ -1384,5 +1454,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
@@ -1441,8 +1511,15 @@
             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
        IF (read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) & 
           CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
+
+#ifdef REPROBUS
+       CALL strataer_init
+       CALL strataer_emiss_init
+#endif
 
 #ifdef CPP_StratAer
@@ -1488,4 +1565,5 @@
 
         IF (ok_bs) THEN
+#ifdef ISO
           abort_message='blowing snow cannot be activated with water isotopes yet'
           CALL abort_physic(modname,abort_message, 1)
@@ -1497,4 +1575,5 @@
          ENDIF
         ENDIF
+
        Ncvpaseq1 = 0
        dnwd0=0.0
@@ -1538,4 +1617,6 @@
        tau_gl=86400.*tau_gl
        WRITE(lunout,*) 'debut physiq_mod tau_gl=',tau_gl
+       iflag_thermcell_tke=0
+       call getin_p('iflag_thermcell_tke', iflag_thermcell_tke)                          !
 
        CALL getin_p('iflag_alp_wk_cond', iflag_alp_wk_cond) 
@@ -1560,4 +1641,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)
@@ -1596,4 +1678,5 @@
        CALL infocfields_init
 
+       !AI 08 2023
 #ifdef CPP_ECRAD
        ok_3Deffect=.false.
@@ -1875,69 +1958,48 @@
       IF (.NOT. create_etat0_limit) CALL init_readaerosolstrato(flag_aerosol_strat)  !! initialise aero strato from file for XIOS interpolation (unstructured_grid)
 
+      ! A.I : Initialisations pour le 1er passage a Cosp
+      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
+        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, &
                ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
                klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
-               JrNt,ref_liq,ref_ice, &
-               pctsrf(:,is_ter)+pctsrf(:,is_lic), &
-               zu10m,zv10m,pphis, &
-               zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
-               qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
-               prfl(:,1:klev),psfl(:,1:klev), &
-               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, &
-               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
-               klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
-               JrNt,ref_liq,ref_ice, &
-               pctsrf(:,is_ter)+pctsrf(:,is_lic), &
-               zu10m,zv10m,pphis, &
-               zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
-               qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
-               prfl(:,1:klev),psfl(:,1:klev), &
-               pmflxr(:,1:klev),pmflxs(:,1:klev), &
-               mr_ozone,cldtau, cldemi)
-       ENDIF
+               JrNt_cosp0,ref_liq_cosp0,ref_ice_cosp0, &
+               pctsrf_cosp0, &
+               zu10m_cosp0,zv10m_cosp0,pphis, &
+               pphi,paprs(:,1:klev),pplay,zxtsol_cosp0,t, &
+               qx(:,:,ivap),zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0,fiwc_cosp0, &
+               prfl_cosp0(:,1:klev),psfl_cosp0(:,1:klev), &
+               pmflxr_cosp0(:,1:klev),pmflxs_cosp0(:,1:klev), &
+               mr_ozone_cosp0,cldtau_cosp0, cldemi_cosp0)
 #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 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 lmdz_cosp_interface(itap,phys_tstep,freq_cosp, &
                ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
                ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
                klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
-               JrNt,ref_liq,ref_ice, &
-               pctsrf(:,is_ter)+pctsrf(:,is_lic), &
-               zu10m,zv10m,pphis, &
-               phicosp,paprs(:,1:klev),pplay,zxtsol,t_seri, &
-               qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
-               prfl(:,1:klev),psfl(:,1:klev), &
-               pmflxr(:,1:klev),pmflxs(:,1:klev), &
-               mr_ozone,cldtau, cldemi)
-       ENDIF
-#endif
+               JrNt_cosp0,ref_liq_cosp0,ref_ice_cosp0, &
+               pctsrf_cosp0, &
+               zu10m_cosp0,zv10m_cosp0,pphis, &
+               pphi,paprs(:,1:klev),pplay,zxtsol_cosp0,t, &
+               qx(:,:,ivap),zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0,fiwc_cosp0, &
+               prfl_cosp0(:,1:klev),psfl_cosp0(:,1:klev), &
+               pmflxr_cosp0(:,1:klev),pmflxs_cosp0(:,1:klev), &
+               mr_ozone_cosp0,cldtau_cosp0, cldemi_cosp0)
+#endif
+
+      endif !ok_cosp
 
        !
@@ -2014,7 +2076,8 @@
 
 
-#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
@@ -2213,54 +2276,51 @@
        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)
-       
+       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 !using_xios 
-
+           !--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, &
@@ -2549,4 +2609,5 @@
           u_seri(i,k)  = u(i,k)
           v_seri(i,k)  = v(i,k)
+          qx_seri(i,k,:)  = qx(i,k,:)
           q_seri(i,k)  = qx(i,k,ivap)
           ql_seri(i,k) = qx(i,k,iliq)
@@ -2590,4 +2651,5 @@
       DO k = 1, klev
        DO i = 1, klon
+          xtbs_seri(ixt,i,k) = 0.
           xt_seri(ixt,i,k)  = qx(i,k,iqIsoPha(ixt,ivap))
           xtl_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,iliq))
@@ -2610,16 +2672,25 @@
     qql1(:)=0.0
     DO k = 1, klev
-      qql1(:)=qql1(:)+(q_seri(:,k)+ql_seri(:,k)+qs_seri(:,k)+qbs_seri(:,k))*zmasse(:,k)
+      qql1(:)=qql1(:)+(q_seri(:,k)+ql_seri(:,k))*zmasse(:,k)
+      IF (nqo >= 3) THEN
+        qql1(:)=qql1(:)+qs_seri(:,k)*zmasse(:,k)
+      ENDIF
+      IF (ok_bs) THEN
+        qql1(:)=qql1(:)+qbs_seri(:,k)*zmasse(:,k)
+      ENDIF
     ENDDO
 #ifdef ISO
-#ifdef ISOVERIF
-        write(*,*) 'physiq tmp 1913'
-#endif
-    do ixt=1,ntraciso
+    DO ixt=1,ntraciso
     xtql1(ixt,:)=0.0
     DO k = 1, klev
-      xtql1(ixt,:)=xtql1(ixt,:)+(xt_seri(ixt,:,k)+xtl_seri(ixt,:,k)+xts_seri(ixt,:,k))*zmasse(:,k)
-    ENDDO
-    enddo !do ixt=1,ntraciso
+      xtql1(ixt,:)=xtql1(ixt,:)+(xt_seri(ixt,:,k)+xtl_seri(ixt,:,k))*zmasse(:,k)
+      IF (nqo >= 3) THEN
+        xtql1(ixt,:)=xtql1(ixt,:)+xts_seri(ixt,:,k)*zmasse(:,k)
+      ENDIF
+      IF (ok_bs) THEN
+        xtql1(ixt,:)=xtql1(ixt,:)+xtbs_seri(ixt,:,k)*zmasse(:,k)
+      ENDIF
+    ENDDO !DO k = 1, klev
+    ENDDO !DO ixt=1,ntraciso
 #endif
     ENDIF
@@ -2633,9 +2704,5 @@
          IF(.NOT.tracers(iq)%isInPhysics) CYCLE
          itr = itr+1
-!#ifdef ISOVERIF
-!         write(*,*) 'physiq 1973: itr,iq=',itr,iq
-!         write(*,*) 'qx(1,1,iq)=',qx(1,1,iq)
-!#endif
-         DO  k = 1, klev
+          DO  k = 1, klev
              DO  i = 1, klon
                 tr_seri(i,k,itr) = qx(i,k,iq)
@@ -2752,4 +2819,6 @@
               d_xts_dyn(ixt,i,k) =  &
      &           (xts_seri(ixt,i,k)-xts_ancien(ixt,i,k))/phys_tstep
+              d_xtbs_dyn(ixt,i,k) =  &
+     &           (xtbs_seri(ixt,i,k)-xtbs_ancien(ixt,i,k))/phys_tstep
             enddo ! do ixt=1,ntraciso
          ENDDO
@@ -2765,4 +2834,5 @@
            call iso_verif_noNaN(d_xtl_dyn(ixt,i,k),'physiq 2220d')
            call iso_verif_noNaN(d_xts_dyn(ixt,i,k),'physiq 2220e')
+           call iso_verif_noNaN(d_xtbs_dyn(ixt,i,k),'physiq 2220f')
            enddo ! do ixt=1,ntraciso
          enddo
@@ -2848,4 +2918,7 @@
        ! !! RomP <<<
        ancien_ok = .TRUE.
+#ifdef ISO
+       d_xtbs_dyn(:,:,:)=0.0
+#endif
     ENDIF
     !
@@ -2986,10 +3059,53 @@
     ! Re-evaporer l'eau liquide nuageuse
     !
-     CALL reevap (klon,klev,iflag_ice_thermo,t_seri,q_seri,ql_seri,qs_seri, &
-   &         d_t_eva,d_q_eva,d_ql_eva,d_qi_eva &
-#ifdef ISO
-             ,xt_seri,xtl_seri,xts_seri,d_xt_eva,d_xtl_eva,d_xti_eva &
-#endif
-   &     )
+     CALL reevap (klon,klev,iflag_ice_thermo,t_seri,qx_seri, &
+   &         d_t_eva,d_qx_eva)
+
+     call dispatch(klon,klev,qx_seri,q_seri,xt_seri,ql_seri,xtl_seri,qs_seri,xts_seri)
+     call dispatch(klon,klev,d_qx_eva,d_q_eva,d_xt_eva,d_ql_eva,d_xtl_eva,d_qi_eva,d_xti_eva)
+
+
+#ifdef ISO
+#ifdef ISOVERIF
+ DO k = 1, klev 
+     DO i = 1, klon
+      do ixt=1,ntraciso
+      call iso_verif_noNaN(xt_seri(ixt,i,k), &
+     &     '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), &
+     &          'reevap 1891, après réévap totale',errmax,errmaxrel)
+              call iso_verif_egalite_choix( &
+     &           xtl_seri(iso_eau,i,k),ql_seri(i,k), &
+     &          'reevap 2209, après réévap totale',errmax,errmaxrel)
+              call iso_verif_egalite_choix( &
+     &           xts_seri(iso_eau,i,k),qs_seri(i,k), &
+     &          'reevap 2209b, après réévap totale',errmax,errmaxrel)
+       endif !if (iso_eau.gt.0) then
+     
+      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then  
+            if (q_seri(i,k).gt.ridicule) then  
+               if (iso_verif_o18_aberrant_nostop( &
+     &              xt_seri(iso_HDO,i,k)/q_seri(i,k), &
+     &              xt_seri(iso_O18,i,k)/q_seri(i,k), &
+     &              'reevap 2408: apres reevap totale').eq.1) then
+                  write(*,*) 'i,k,q_seri(i,k)=',i,k,q_seri(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        
+#ifdef ISOTRAC      
+             call iso_verif_traceur(xt_seri(1,i,k), &
+     &           'reevap 2165c')
+             call iso_verif_traceur_pbidouille(xt_seri(1,i,k), &
+     &           'reevap 2165d')
+#endif
+       ENDDO
+    ENDDO               
+#endif                  
+#endif
+
 
      CALL add_phys_tend &
@@ -3123,4 +3239,27 @@
     ! 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)   
+#ifdef ISO
+              do ixt=1,ntraciso
+                xt_env(ixt,i,k)=xt_seri(ixt,i,k)
+              enddo
+#endif
+           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 -------------------------------
 
 
@@ -3311,5 +3450,5 @@
           d_deltaq_vdf(:,:) = d_q_vdf_w(:,:)-d_q_vdf_x(:,:)
           CALL add_wake_tend &
-             (d_deltat_vdf, d_deltaq_vdf, dsig0, ddens0, ddens0, wkoccur1, 'vdf', abortphy &
+             (d_deltat_vdf, d_deltaq_vdf, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'vdf', abortphy &
 #ifdef ISO
                ,d_deltaxt_vdf &
@@ -3344,9 +3483,6 @@
      &   )
        ENDIF
-#ifdef ISOVERIF
-        write(*,*) 'physiq tmp 2736'
-#endif
-
        CALL prt_enerbil('vdf',itap)
+
        !--------------------------------------------------------------------
 
@@ -3403,7 +3539,7 @@
     ! Blowing snow sublimation and sedimentation
 
-    d_t_bs(:,:)=0.
-    d_q_bs(:,:)=0.
-    d_qbs_bs(:,:)=0.
+    d_t_bsss(:,:)=0.
+    d_q_bsss(:,:)=0.
+    d_qbs_bsss(:,:)=0.
     bsfl(:,:)=0.
     bs_fall(:)=0.
@@ -3411,8 +3547,8 @@
 
      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)
+                                        d_t_bsss,d_q_bsss,d_qbs_bsss,bsfl,bs_fall)
 
      CALL add_phys_tend &
-               (du0,dv0,d_t_bs,d_q_bs,dql0,dqi0,d_qbs_bs,paprs,&
+               (du0,dv0,d_t_bsss,d_q_bsss,dql0,dqi0,d_qbs_bsss,paprs,&
                'bs',abortphy,flag_inhib_tend,itap,0  &
 #ifdef ISO                                       
@@ -3713,12 +3849,12 @@
                 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 &
+                 (d_deltat_ajs_cv, d_deltaq_ajs_cv, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'ajs_cv', abortphy &
 #ifdef ISO
                       ,d_deltaxt_ajs_cv  &
 #endif
                  ) 
-             ENDIF  ! (iflag_adjwk == 2)
+             ENDIF  ! (iflag_adjwk == 2 .AND. OK_bug_ajs_cv)
           ENDIF  ! (iflag_adjwk >= 1)
        ENDIF ! (iflag_wake>=1)
@@ -4424,4 +4560,13 @@
        !  ====
        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
 
 
@@ -4515,4 +4660,45 @@
 
        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)                                     !
+#ifdef ISO
+                  do ixt=1,ntraciso
+                        xt_env(ixt,i,k)=xt_seri(ixt,i,k)
+                  enddo
+#endif
+               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)                                     !
+#ifdef ISO
+                  do ixt=1,ntraciso
+                        xt_env(ixt,i,k)=xt_seri(ixt,i,k)
+                  enddo
+#endif
+               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)                                       !
+#ifdef ISO
+                  do ixt=1,ntraciso
+                        xt_env(ixt,i,k)=xt_seri(ixt,i,k)
+                  enddo
+#endif
+               enddo                                                         !
+            enddo                                                            !
+          endif                                                              !
+! Tests Fredho, instensibilite au pas de temps ------------------------------
+
           !jyg<
 !!       IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
@@ -4523,4 +4709,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)
@@ -4528,4 +4716,5 @@
                    do ixt=1,ntraciso
                      xt_therm(ixt,i,k) = xt_seri(ixt,i,k) - wake_s(i)*wake_deltaxt(ixt,i,k)
+                     xt_env(ixt,i,k) = xt_env(ixt,i,k) - wake_s(i)*wake_deltaxt(ixt,i,k)
                    enddo !do ixt=1,ntraciso
 #endif
@@ -4570,5 +4759,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,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 &
@@ -4589,5 +4778,5 @@
                ,zqla,ztva &
 #ifdef ISO         
-     &      ,xt_therm,d_xt_ajs &
+     &      ,xt_env,d_xt_ajs &
 #ifdef DIAGISO         
      &      ,q_the,xt_the &
@@ -4624,5 +4813,5 @@
              IF (ok_bug_split_th) THEN
                CALL add_wake_tend &
-                   (d_deltat_the, d_deltaq_the, dsig0, ddens0, ddens0, wkoccur1, 'the', abortphy &
+                   (d_deltat_the, d_deltaq_the, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'the', abortphy &
 #ifdef ISO
                    ,d_deltaxt_the &
@@ -4631,5 +4820,5 @@
              ELSE
                CALL add_wake_tend &
-                   (d_deltat_the, d_deltaq_the, dsig0, ddens0, ddens0, wake_k, 'the', abortphy &
+                   (d_deltat_the, d_deltaq_the, dsig0, dsig0, ddens0, ddens0, wake_k, 'the', abortphy &
 #ifdef ISO
                    ,d_deltaxt_the &
@@ -4660,8 +4849,7 @@
           ! Transport de la TKE par les panaches thermiques.
           ! FH : 2010/02/01
-          !     if (iflag_pbl.eq.10) then
-          !     call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm,
-          !    s           rg,paprs,pbl_tke)
-          !     endif
+               if (iflag_thermcell_tke==1) then
+               call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm,rg,paprs,pbl_tke)
+               endif
           ! -------------------------------------------------------------------
 
@@ -4902,13 +5090,15 @@
 
     CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay, &
-         t_seri, q_seri,ptconv,ratqs, &
+         t_seri, q_seri,qs_ancien,ptconv,ratqs, &
          d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, & 
-         pfraclr,pfracld, &
+         pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb,  &
          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, distcltop, temp_cltop, cell_area, &
-         cf_seri, rvc_seri, u_seri, v_seri, pbl_eps(:,:,is_ave), &
+         iflag_ice_thermo, distcltop, temp_cltop, 
+         pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), &
+         cell_area, &
+         cf_seri, rvc_seri, u_seri, v_seri, &
          qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, &
          dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, &
@@ -4923,4 +5113,5 @@
     ELSE
 
+    ! Camille Risi mai 2024: on ne met pas à jour ici pour ne pas s'mbêter à modifier fisrtilp
     CALL fisrtilp(phys_tstep,paprs,pplay, &
          t_seri, q_seri,ptconv,ratqs, &
@@ -5522,5 +5713,5 @@
                      tausum_aero, tau3d_aero)
              ENDIF
-          ELSE                       ! RRTM radiation
+          ELSE IF (iflag_rrtm .EQ.1) THEN  ! RRTM radiation
              IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
                 abort_message='config_inca=aero et rrtm=1 impossible'
@@ -5588,4 +5779,15 @@
                 !
              ENDIF
+          ELSE IF (iflag_rrtm .EQ.2) THEN    ! ecrad RADIATION
+#ifdef CPP_ECRAD
+             !--climatologies or INCA aerosols
+             CALL readaerosol_optic_ecrad( debut, aerosol_couple, ok_alw, ok_volcan, &
+                  flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
+                  pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
+                  tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer)
+#else
+                abort_message='You should compile with -rad ecrad if running with iflag_rrtm=2'
+                CALL abort_physic(modname,abort_message,1)
+#endif
           ENDIF
        ELSE   !--flag_aerosol = 0 
@@ -5828,5 +6030,5 @@
                ! Rajoute par OB pour RRTM
                tau_aero_lw_rrtm, & 
-               cldtaupirad, &
+               cldtaupirad, m_allaer, &
 !              zqsat, flwcrad, fiwcrad, &
                zqsat, flwc, fiwc, &
@@ -5907,5 +6109,5 @@
                                 ! Rajoute par OB pour RRTM
                      tau_aero_lw_rrtm, &
-                     cldtaupi, &
+                     cldtaupi, m_allaer, &
 !                    zqsat, flwcrad, fiwcrad, &
                      zqsat, flwc, fiwc, &
@@ -5934,4 +6136,52 @@
                      cloud_cover_sw)
           ENDIF !ok_4xCO2atm
+
+! 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 &
+                     (debut, dist, rmu0, fract,  &
+                     paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
+                     t_seri,q_seri,wo, &
+                     cldfrarad, cldemirad, cldtaurad, &
+                     ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie,  ok_volcan, flag_volc_surfstrat, &
+                     flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
+                     tau_aero, piz_aero, cg_aero, &
+                     tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
+                     tau_aero_lw_rrtm, &
+                     cldtaupi, &
+                     zqsat, flwc, fiwc, &
+                     ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
+                     namelist_ecrad_file, &
+! A modifier              
+                     heat_s2,heat0_s2,cool_s2,cool0_s2,albpla_s2, &
+                     heat_volc,cool_volc, &
+                     topsw_s2,toplw_s2,solsw_s2,solswfdiff_s2,sollw_s2, &
+                     sollwdown_s2, &
+                     topsw0_s2,toplw0_s2,solsw0_s2,sollw0_s2, &
+                     lwdnc0_s2, lwdn0_s2, lwdn_s2, lwupc0_s2, lwup0_s2, lwup_s2,  &
+                     swdnc0_s2, swdn0_s2, swdn_s2, swupc0_s2, swup0_s2, swup_s2, &
+                     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, &
+                                !-C. Kleinschmitt for LW diagnostics
+                     toplwad_aero_s2, sollwad_aero_s2,&
+                     toplwai_aero_s2, sollwai_aero_s2, &
+                     toplwad0_aero_s2, sollwad0_aero_s2,&
+                                !-end
+                     ZLWFT0_i, ZFLDN0, ZFLUP0, &
+                     ZSWFT0_i, ZFSDN0, ZFSUP0, &
+                     cloud_cover_sw_s2)
+          ENDIF ! ok_3Deffect
+#endif
+
        ENDIF ! aerosol_couple
        itaprad = 0
@@ -6157,5 +6407,5 @@
        d_t_hin(:, :)=0.
        CALL add_phys_tend(du_gwd_hines, dv_gwd_hines, d_t_hin, dq0, dql0, &
-            dqi0, dqbs0,paprs, 'hin', abortphy,flag_inhib_tend,itap,0 &
+            dqi0, dqbs0, paprs, 'hin', abortphy,flag_inhib_tend,itap,0 &
 #ifdef ISO
      &    ,dxt0,dxtl0,dxti0 &
@@ -6280,5 +6530,5 @@
        
        SELECT CASE(flag_emit)
-       CASE(1) ! emission volc H2O dans LMDZ
+       CASE(1) ! emission volc H2O in LMDZ
           DO ieru=1, nErupt
              IF (year_cur==year_emit_vol(ieru).AND.&
@@ -6288,5 +6538,5 @@
                 
                 IF(flag_verbose_strataer) print *,'IN physiq_mod: date=',year_cur,mth_cur,day_cur
-                ! initialisation tendance q emission
+                ! initialisation of q tendency emission
                 d_q_emiss(:,:)=0.
                 ! daily injection mass emission - NL
@@ -6295,11 +6545,10 @@
                 !
                 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)
+                    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=',&
@@ -6315,5 +6564,4 @@
     ENDIF
 #endif
-
 
 !===============================================================
@@ -6754,46 +7002,106 @@
     t_seri(:,:)=t_seri(:,:)+d_t_ec(:,:)
 
-    !=======================================================================
-    !   SORTIES
-    !=======================================================================
-    !
-    !IM initialisation + calculs divers diag AMIP2
-    !
-    include "calcul_divers.h"
-    !
-    !IM Interpolation sur les niveaux de pression du NMC
-    !   -------------------------------------------------
-    !
-    include "calcul_STDlev.h"
-    !
-    ! slp sea level pressure derived from Arpege-IFS : CALL ctstar + CALL pppmer
-    CALL diag_slp(klon,t_seri,paprs,pplay,pphis,ptstar,pt0,slp)
-    !
+    !==================================================================
+    !--OB water mass fixer for the physics
+    !--water profiles are corrected to force mass conservation of water
+    !--currently flag is turned off
+    !==================================================================
+    IF (mass_fixer) THEN
+#ifdef ISO
+      CALL abort_gcm('physiq 6936','isos pas prevus dans le mass fixer',1)
+      ! Camille Risi mai 2024: on attend d'avoir la 4e dimension qui rendra tout plus simple.
+#endif
+    qql2(:)=0.0
+    DO k = 1, klev
+      qql2(:)=qql2(:)+(q_seri(:,k)+ql_seri(:,k))*zmasse(:,k)
+      IF (nqo >= 3) THEN
+        qql2(:)=qql2(:)+qs_seri(:,k)*zmasse(:,k)
+      ENDIF
+      IF (ok_bs) THEN
+        qql2(:)=qql2(:)+qbs_seri(:,k)*zmasse(:,k)
+      ENDIF
+    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
+      IF (ok_bs) THEN
+        corrqql=(qql1(i)+(evap(i)-rain_fall(i)-snow_fall(i)-bs_fall(i))*pdtphys)/qql2(i)
+      ELSE
+        corrqql=(qql1(i)+(evap(i)-rain_fall(i)-snow_fall(i))*pdtphys)/qql2(i)
+      ENDIF
+      DO k = 1, klev
+        q_seri(i,k) =q_seri(i,k)*corrqql
+        ql_seri(i,k)=ql_seri(i,k)*corrqql
+        IF (nqo >= 3) THEN
+          qs_seri(i,k)=qs_seri(i,k)*corrqql
+        ENDIF
+        IF (ok_bs) THEN
+          qbs_seri(i,k)=qbs_seri(i,k)*corrqql
+        ENDIF
+      ENDDO
+    ENDDO
+    ENDIF
+    !--fin mass fixer
+
     !cc prw  = eau precipitable
     !   prlw = colonne eau liquide 
     !   prlw = colonne eau solide
     !   prbsw = colonne neige soufflee
+    !   water_budget = non-conservation residual from the LMDZ physics
+    !                  (should be equal to machine precision if mass fixer is activated)
     prw(:) = 0.
     prlw(:) = 0.
     prsw(:) = 0.
     prbsw(:) = 0.
+    water_budget(:) = 0.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)
+       water_budget(:) = water_budget(:) + (q_seri(:,k)-qx(:,k,ivap)+ql_seri(:,k)-qx(:,k,iliq))*zmasse(:,k)
+       IF (nqo >= 3) THEN
+         prsw(:) = prsw(:) + qs_seri(:,k)*zmasse(:,k)
+         water_budget(:) = water_budget(:) + (qs_seri(:,k)-qx(:,k,isol))*zmasse(:,k)
+       ENDIF
+       IF (nqo >= 4 .AND. ok_bs) THEN
+         prbsw(:)= prbsw(:) + qbs_seri(:,k)*zmasse(:,k)
+         water_budget(:) = water_budget(:) + (qbs_seri(:,k)-qx(:,k,ibs))*zmasse(:,k)
+       ENDIF
     ENDDO
-
-#ifdef ISO
-      DO i = 1, klon
-      do ixt=1,ntraciso
-       xtprw(ixt,i) = 0. 
-       DO k = 1, klev
-        xtprw(ixt,i) = xtprw(ixt,i) + &
-     &           xt_seri(ixt,i,k)*(paprs(i,k)-paprs(i,k+1))/RG
-       ENDDO !DO k = 1, klev
-      enddo !do ixt=1,ntraciso
-      enddo !DO i = 1, klon
-#endif
+    water_budget(:)=water_budget(:)+(rain_fall(:)+snow_fall(:)-evap(:))*pdtphys
+    IF (ok_bs) THEN
+      water_budget(:)=water_budget(:)+bs_fall(:)*pdtphys
+    ENDIF
+    ! Camille Risi mai 2024: pour les isotopes, on attend d'avoir la 4e dimension, ça rendra tout plus facile
+    ! ces variables sont diagnostiques, donc pas indispensables
+
+    !=======================================================================
+    !   SORTIES
+    !=======================================================================
+    !
+    !IM initialisation + calculs divers diag AMIP2
+    !
+    include "calcul_divers.h"
+    !
+    !IM Interpolation sur les niveaux de pression du NMC
+    !   -------------------------------------------------
+    !
+    include "calcul_STDlev.h"
+    !
+    ! slp sea level pressure derived from Arpege-IFS : CALL ctstar + CALL pppmer
+    CALL diag_slp(klon,t_seri,paprs,pplay,pphis,ptstar,pt0,slp)
+    !
     !
     IF (ANY(type_trac == ['inca','inco'])) THEN
@@ -6898,53 +7206,4 @@
     !IM global posePB      include "write_bilKP_ave.h"
     !
-
-    !--OB mass fixer 
-    !--profile is corrected to force mass conservation of water
-    IF (mass_fixer) THEN
-    qql2(:)=0.0
-    DO k = 1, klev
-      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
-      corrqql=(qql1(i)+(evap(i)-rain_fall(i)-snow_fall(i))*pdtphys)/qql2(i)
-      DO k = 1, klev
-        q_seri(i,k) =q_seri(i,k)*corrqql
-        ql_seri(i,k)=ql_seri(i,k)*corrqql
-      ENDDO
-    ENDDO
-#ifdef ISO
-    do ixt=1,ntraciso
-    xtql2(ixt,:)=0.0
-    DO k = 1, klev
-      xtql2(ixt,:)=xtql2(ixt,:)+(xt_seri(ixt,:,k)+xtl_seri(ixt,:,k)+xts_seri(ixt,:,k))*zmasse(:,k)
-    ENDDO
-    DO i = 1, klon
-      !--compute ratio of what q+ql should be with conservation to what it is
-      corrxtql(ixt)=(xtql1(ixt,i)+(xtevap(ixt,i)-xtrain_fall(ixt,i)-xtsnow_fall(ixt,i))*pdtphys)/xtql2(ixt,i)
-      DO k = 1, klev
-        xt_seri(ixt,i,k) =xt_seri(ixt,i,k)*corrxtql(ixt)
-        xtl_seri(ixt,i,k)=xtl_seri(ixt,i,k)*corrxtql(ixt)
-      ENDDO
-    ENDDO   
-    enddo !do ixt=1,ntraciso 
-#endif
-    ENDIF
-    !--fin mass fixer
-
     ! Sauvegarder les valeurs de t et q a la fin de la physique:
     !
@@ -6962,4 +7221,5 @@
     xtl_ancien(:,:,:)=xtl_seri(:,:,:)
     xts_ancien(:,:,:)=xts_seri(:,:,:)
+    xtbs_ancien(:,:,:)=xtbs_seri(:,:,:)
 #endif
     CALL water_int(klon,klev,q_ancien,zmasse,prw_ancien)
@@ -7098,63 +7358,16 @@
          ok_sync, ptconv, read_climoz, clevSTD,          &
          ptconvth, d_u, d_t, qx, d_qx, zmasse,           &
-         flag_aerosol, flag_aerosol_strat, ok_cdnc,t,u1,v1)
+         flag_aerosol, flag_aerosol_strat, ok_cdnc,t, u1, v1)
 #endif
 
 #ifndef CPP_XIOS
-    CALL write_paramLMDZ_phy(itap,nid_ctesGCM,ok_sync)
-#endif
-
-#endif
-
-! Pour XIOS : On remet des variables a .false. apres un premier appel
-    IF (debut) THEN
-
-      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
+      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
 
     !====================================================================
@@ -7200,4 +7413,5 @@
     ! Disabling calls to the prt_alerte function
     alert_first_call = .FALSE.
+
     
     IF (lafin) THEN
@@ -7212,22 +7426,25 @@
          IF (read_climoz >= 1) THEN
            IF (is_mpi_root) CALL nf95_close(ncid_climoz)
-            DEALLOCATE(press_edg_climoz) ! pointer
-            DEALLOCATE(press_cen_climoz) ! pointer
+            DEALLOCATE(press_edg_climoz)
+            DEALLOCATE(press_cen_climoz)
          ENDIF
        
        ENDIF
+
+       IF (using_xios) THEN
+
+#ifdef INCA
+          IF (type_trac == 'inca') THEN 
+             IF (is_omp_master .AND. grid_type==unstructured) THEN 
+                CALL finalize_inca
+             ENDIF
+          ENDIF
+#endif
+
+          IF (is_omp_master .and. grid_type==unstructured) CALL xios_context_finalize
+       ENDIF
+
+       WRITE(lunout,*) ' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
        
-       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 !using_xios
-       WRITE(lunout,*) ' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
     ENDIF
 
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/physiqex_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/physiqex_mod.F90	(revision 5202)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/physiqex_mod.F90	(revision 5202)
@@ -0,0 +1,1 @@
+link ../phylmd/physiqex_mod.F90
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/reevap.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/reevap.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/reevap.F90	(revision 5202)
@@ -1,13 +1,9 @@
-  SUBROUTINE reevap (klon,klev,iflag_ice_thermo,t_seri,q_seri,ql_seri,qs_seri, &
-   &         d_t_eva,d_q_eva,d_ql_eva,d_qs_eva &
-#ifdef ISO
-             ,xt_seri,xtl_seri,xts_seri,d_xt_eva,d_xtl_eva,d_xts_eva &
-#endif
-   &     )
+  SUBROUTINE reevap (klon,klev,iflag_ice_thermo,t_seri,qx, &
+   &         d_t_eva,d_qx_eva)
 
     ! 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: ntiso   
+    USE infotrac_phy, ONLY: ntiso,nqtot,ivap,iliq,isol,iqWIsoPha
 #ifdef ISOVERIF
     USE isotopes_verif_mod
@@ -23,15 +19,12 @@
 
     INTEGER klon,klev,iflag_ice_thermo
-    REAL, DIMENSION(klon,klev), INTENT(in) :: t_seri,q_seri,ql_seri,qs_seri
-    REAL, DIMENSION(klon,klev), INTENT(out) :: d_t_eva,d_q_eva,d_ql_eva,d_qs_eva
+    REAL, DIMENSION(klon,klev), INTENT(in) :: t_seri
+    REAL, DIMENSION(klon,klev,nqtot), INTENT(in) ::     qx
+    REAL, DIMENSION(klon,klev), INTENT(out) :: d_t_eva
+    REAL, DIMENSION(klon,klev,nqtot), INTENT(out) ::    d_qx_eva
 
     REAL za,zb,zdelta,zlvdcp,zlsdcp
-    INTEGER i,k
+    INTEGER i,k,ixt,ivapcur,iliqcur,isolcur    
 
-#ifdef ISO
-    REAL, DIMENSION(ntiso,klon,klev), INTENT(in) :: xt_seri,xtl_seri,xts_seri
-    REAL, DIMENSION(ntiso,klon,klev), INTENT(out) :: d_xt_eva,d_xtl_eva,d_xts_eva
-    integer ixt
-#endif
 
     !--------Stochastic Boundary Layer Triggering: ALE_BL--------
@@ -42,83 +35,49 @@
     !IM 100106 BEG : pouvoir sortir les ctes de la physique
     !
+    DO ixt = 1, 1+ntiso
     ! Re-evaporer l'eau liquide nuageuse
     !
+    iliqcur= iqWIsoPha(ixt,iliq)    
+    ivapcur= iqWIsoPha(ixt,ivap)    
+    isolcur= iqWIsoPha(ixt,isol)   
 !print *,'rrevap ; fl_cor_ebil:',fl_cor_ebil,' iflag_ice_thermo:',iflag_ice_thermo,' RVTMP2',RVTMP2
     DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
-       DO i = 1, klon
-        if (fl_cor_ebil .GT. 0) then
-          zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
-          zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
-        else
-          zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
-          !jyg<
-          !  Attention : Arnaud a propose des formules completement differentes
-          !                  A verifier !!!
-          zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
-        end if
-          IF (iflag_ice_thermo .EQ. 0) THEN
-             zlsdcp=zlvdcp
+      DO i = 1, klon
+
+        IF (ixt == 1) THEN ! water
+          IF (fl_cor_ebil > 0) THEN
+            !zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
+            !zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
+            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(qx(i,k,ivapcur)+qx(i,k,iliqcur)+qx(i,k,isolcur)))
+            zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(qx(i,k,ivapcur)+qx(i,k,iliqcur)+qx(i,k,isolcur)))
+          ELSE
+            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*qx(i,k,ivapcur))
+            !jyg<
+            !  Attention : Arnaud a propose des formules completement differentes
+            !                  A verifier !!!
+            zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*qx(i,k,ivapcur))
+         ENDIF
+          IF (iflag_ice_thermo == 0) THEN
+            zlsdcp=zlvdcp
           ENDIF
           !>jyg
+        ENDIF
+        IF (iflag_ice_thermo == 0) THEN   
+           !pas necessaire a priori
 
-          IF (iflag_ice_thermo.eq.0) THEN   
-             !pas necessaire a priori
+            zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
+            zdelta = 0.
+            zb = MAX(0.0,qx(i,k,iliqcur))
+            IF (ixt == 1) THEN
+              za = - MAX(0.0,qx(i,k,iliqcur)) &
+                   * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
+              d_t_eva(i,k) = za
+            ENDIF
+            d_qx_eva(i,k,ivapcur)  = zb
+            d_qx_eva(i,k,iliqcur) = -qx(i,k,iliqcur)
+            d_qx_eva(i,k,isolcur) = 0.
 
-             zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
-  zdelta = 0.
-             zb = MAX(0.0,ql_seri(i,k))
-             za = - MAX(0.0,ql_seri(i,k)) &
-                  * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
-             d_t_eva(i,k) = za
-             d_q_eva(i,k) = zb
-             d_ql_eva(i,k) = -ql_seri(i,k)
-             d_qs_eva(i,k) = 0.
-
-#ifdef ISO
-         do ixt=1,ntiso
-            zb = MAX(0.0,xtl_seri(ixt,i,k))
-            d_xt_eva(ixt,i,k) = zb
-            d_xtl_eva(ixt,i,k) = -xtl_seri(ixt,i,k)
-            d_xts_eva(ixt,i,k) = 0.
-         enddo
-#ifdef ISOVERIF
-      do ixt=1,ntiso
-        call iso_verif_noNaN(xt_seri(ixt,i,k), &
-     &     '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), &
-     &          'reevap 1891+, après reevap totale',errmax,errmaxrel)
-              call iso_verif_egalite_choix( &
-     &           xtl_seri(iso_eau,i,k),ql_seri(i,k), &
-     &          '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  
-            if (q_seri(i,k).gt.ridicule) then  
-               if (iso_verif_o18_aberrant_nostop( &
-     &              xt_seri(iso_HDO,i,k)/q_seri(i,k), &
-     &              xt_seri(iso_O18,i,k)/q_seri(i,k), &
-     &              '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)
-                  write(*,*) 'deltaD(d_q_eva(i,k))=',deltaD(d_xt_eva(iso_HDO,i,k)/d_q_eva(i,k))
-                  write(*,*) 'deltaO18(d_q_eva(i,k))=',deltaO(d_xt_eva(iso_O18,i,k)/d_q_eva(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 
-#ifdef ISOTRAC      
-             call iso_verif_traceur(xt_seri(1,i,k), &
-     &           'reevap 2165a')
-             call iso_verif_traceur_pbidouille(xt_seri(1,i,k), &
-     &           'reevap 2165b')
-#endif               
-         
-#endif           
-#endif
-
-          ELSE
-
+        ELSE
+              
              !CR: on r\'e-\'evapore eau liquide et glace
 
@@ -127,61 +86,25 @@
              !        za = - MAX(0.0,ql_seri(i,k)) &
              !             * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
-             zb = MAX(0.0,ql_seri(i,k)+qs_seri(i,k))
-             za = - MAX(0.0,ql_seri(i,k))*zlvdcp & 
-                  - MAX(0.0,qs_seri(i,k))*zlsdcp
-             d_t_eva(i,k) = za
-             d_q_eva(i,k) = zb
-             d_ql_eva(i,k) = -ql_seri(i,k)
-             d_qs_eva(i,k) = -qs_seri(i,k)
+            IF (ixt == 1) THEN
+              za = - MAX(0.0,qx(i,k,iliqcur))*zlvdcp & 
+                   - MAX(0.0,qx(i,k,iliqcur))*zlsdcp
+              d_t_eva(i,k) = za
+            ENDIF
+            !zb = MAX(0.0,ql_seri(i,k)+qs_seri(i,k))
+            !d_q_eva(i,k) = zb
+            !d_ql_eva(i,k) = -ql_seri(i,k)
+            !d_qs_eva(i,k) = -qs_seri(i,k)
 
-#ifdef ISO
-         do ixt=1,ntiso
-            zb = MAX(0.0,xtl_seri(ixt,i,k)+xts_seri(ixt,i,k))
-            d_xt_eva(ixt,i,k) = zb
-            d_xtl_eva(ixt,i,k) = -xtl_seri(ixt,i,k)
-            d_xts_eva(ixt,i,k) = -xts_seri(ixt,i,k)
-         enddo
+            zb = MAX(0.0,qx(i,k,iliqcur)+qx(i,k,isolcur))
+            d_qx_eva(i,k,ivapcur) = zb
+            d_qx_eva(i,k,iliqcur) = -qx(i,k,iliqcur)
+            d_qx_eva(i,k,isolcur) = -qx(i,k,isolcur)
+        ENDIF
 
-#ifdef ISOVERIF
-      do ixt=1,ntiso
-      call iso_verif_noNaN(xt_seri(ixt,i,k), &
-     &     '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), &
-     &          'reevap 1891, après réévap totale',errmax,errmaxrel)
-              call iso_verif_egalite_choix( &
-     &           xtl_seri(iso_eau,i,k),ql_seri(i,k), &
-     &          'reevap 2209, après réévap totale',errmax,errmaxrel)
-              call iso_verif_egalite_choix( &
-     &           xts_seri(iso_eau,i,k),qs_seri(i,k), &
-     &          'reevap 2209b, après réévap totale',errmax,errmaxrel)
-       endif !if (iso_eau.gt.0) then
-     
-      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then  
-            if (q_seri(i,k).gt.ridicule) then  
-               if (iso_verif_o18_aberrant_nostop( &
-     &              xt_seri(iso_HDO,i,k)/q_seri(i,k), &
-     &              xt_seri(iso_O18,i,k)/q_seri(i,k), &
-     &              'reevap 2408: apres reevap totale').eq.1) then
-                  write(*,*) 'i,k,q_seri(i,k)=',i,k,q_seri(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        
-#ifdef ISOTRAC      
-             call iso_verif_traceur(xt_seri(1,i,k), &
-     &           'reevap 2165c')
-             call iso_verif_traceur_pbidouille(xt_seri(1,i,k), &
-     &           'reevap 2165d')
-#endif                  
-#endif                  
-#endif
 
-          ENDIF
+      ENDDO
+    ENDDO
 
-       ENDDO
-    ENDDO
+    ENDDO ! DO ixt = 1, 1+niso*(nzone +1)
 
 RETURN
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/surf_land_bucket_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/surf_land_bucket_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/surf_land_bucket_mod.F90	(revision 5202)
@@ -1,357 +1,1 @@
-!
-MODULE surf_land_bucket_mod
-!
-! Surface land bucket module
-!
-! This module is used when no external land model is choosen.
-!
-  IMPLICIT NONE
-
-CONTAINS
-
-  SUBROUTINE surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
-       tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, &
-       spechum, petAcoef, peqAcoef, petBcoef, peqBcoef, pref, &
-       u1, v1, gustiness, rugoro, swnet, lwnet, &
-       snow, qsol, agesno, tsoil, &
-       qsurf, z0_new, alb1_new, alb2_new, evap, &
-       fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l &
-#ifdef ISO
-       ,xtprecip_rain, xtprecip_snow,xtspechum, &
-       xtsnow, xtsol,xtevap,h1, &
-       runoff_diag,xtrunoff_diag,Rland_ice &
-#endif           
-            )
-
-    USE limit_read_mod
-    USE surface_data
-    USE fonte_neige_mod
-    USE calcul_fluxs_mod
-    USE cpl_mod
-    USE dimphy
-    USE geometry_mod, ONLY: longitude,latitude 
-    USE mod_grid_phy_lmdz
-    USE mod_phys_lmdz_para
-    USE indice_sol_mod
-#ifdef ISO
-    use infotrac_phy, ONLY: ntiso,niso
-    USE isotopes_mod, ONLY: iso_eau, iso_HDO, iso_O18, iso_O17, &
-        ridicule_qsol
-    USE isotopes_routines_mod, ONLY: calcul_iso_surf_ter_vectall
-#ifdef ISOVERIF
-    USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_noNaN, &
-        iso_verif_aberrant_o17,iso_verif_egalite_choix,iso_verif_egalite
-#endif
-#endif
-!****************************************************************************************
-! Bucket calculations for surface. 
-!
-    INCLUDE "clesphys.h"
-    INCLUDE "dimsoil.h"
-    INCLUDE "YOMCST.h"
-
-! Input variables  
-!****************************************************************************************
-    INTEGER, INTENT(IN)                     :: itime, jour, knon
-    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
-    LOGICAL, INTENT(IN)                     :: debut
-    REAL, INTENT(IN)                        :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)       :: tsurf
-    REAL, DIMENSION(klon), INTENT(IN)       :: p1lay
-    REAL, DIMENSION(klon), INTENT(IN)       :: tq_cdrag
-    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow
-    REAL, DIMENSION(klon), INTENT(IN)       :: temp_air, spechum
-    REAL, DIMENSION(klon), INTENT(IN)       :: petAcoef, peqAcoef
-    REAL, DIMENSION(klon), INTENT(IN)       :: petBcoef, peqBcoef
-    REAL, DIMENSION(klon), INTENT(IN)       :: pref
-    REAL, DIMENSION(klon), INTENT(IN)       :: u1, v1, gustiness
-    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
-    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
-#ifdef ISO
-    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
-    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum    
-#endif
-
-! In/Output variables
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
-    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
-    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
-#ifdef ISO
-    REAL, DIMENSION(niso,klon), INTENT(INOUT)       :: xtsnow,xtsol
-#endif
-
-! Output variables
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
-    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
-    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
-    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l         
-#ifdef ISO
-    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
-    REAL, DIMENSION(klon),       INTENT(OUT) :: h1
-    REAL, DIMENSION(niso,klon),  INTENT(OUT) :: xtrunoff_diag
-    REAL, DIMENSION(klon),       INTENT(OUT) :: runoff_diag
-    REAL, DIMENSION(niso,klon),  INTENT(IN)  :: Rland_ice
-#endif
-
-! Local variables
-!****************************************************************************************
-    REAL, DIMENSION(klon) :: soilcap, soilflux
-    REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol
-    REAL, DIMENSION(klon) :: alb_neig, alb_lim
-    REAL, DIMENSION(klon) :: zfra
-    REAL, DIMENSION(klon) :: radsol       ! total net radiance at surface
-    REAL, DIMENSION(klon) :: u0, v0, u1_lay, v1_lay
-    REAL, DIMENSION(klon) :: dummy_riverflow,dummy_coastalflow 
-    INTEGER               :: i
-
-#ifdef ISO
-    integer ixt
-    REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec
-    REAL, DIMENSION(klon) :: snow_prec,qsol_prec
-    real, parameter :: t_coup = 273.15
-    real, dimension(klon) :: fq_fonte_diag
-    real, dimension(klon) :: fqfonte_diag
-    real, dimension(klon) ::  snow_evap_diag 
-    real, dimension(klon) ::  fqcalving_diag 
-    real max_eau_sol_diag  
-    real, dimension(klon) ::  run_off_lic_diag 
-    real :: coeff_rel_diag
-!    real, dimension(klon), intent(out) ::  runoff_diag   
-#endif       
-!
-!****************************************************************************************
-
-#ifdef ISO
-#ifdef ISOVERIF
-        !write(*,*) 'surf_land_bucket 152'
-        do i=1,knon
-          if (iso_eau.gt.0) then
-            call iso_verif_egalite_choix(precip_snow(i), &
-     &          xtprecip_snow(iso_eau,i),'surf_land_bucket 131', &
-     &          errmax,errmaxrel)
-            call iso_verif_egalite_choix(qsol(i), &
-     &          xtsol(iso_eau,i),'surf_land_bucket 134', &
-     &          errmax,errmaxrel)
-          endif  
-        enddo
-#endif 
-#ifdef ISOVERIF
-        do i=1,knon
-         do ixt=1,niso
-          call iso_verif_noNaN(xtsol(ixt,i),'surf_land_mod_bucket 142')
-         enddo !do ixt=1,niso
-        enddo !do i=1,knon
-        !write(*,*) 'surf_land_bucket 152'
-#endif
-#endif
-
-!
-!* Read from limit.nc : albedo(alb_lim), length of rugosity(z0_new)
-!
-    CALL limit_read_rug_alb(itime, dtime, jour,&
-         knon, knindex, &
-         z0_new, alb_lim)
-!        write(*,*) 'surf_land_bucket 166'
-!
-!* Calcultaion of fluxes 
-!
-
-! calculate total absorbed radiance at surface
-       radsol(:) = 0.0
-       radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
-
-! calculate constants
-!        write(*,*) 'surf_land_bucket 176'
-    CALL calbeta(dtime, is_ter, knon, snow, qsol, beta, capsol, dif_grnd)
-    if (type_veget=='betaclim') then
-       CALL calbeta_clim(knon,jour,latitude(knindex(1:knon)),beta)
-    endif
-       
-! calculate temperature, heat capacity and conduction flux in soil
-!        write(*,*) 'surf_land_bucket 183: soil_model=',soil_model
-    IF (soil_model) THEN 
-!       write(*,*) 'surf_land_bucket 185'
-       CALL soil(dtime, is_ter, knon, snow, tsurf, qsol,  &
-      & longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil, soilcap, soilflux)
-
-!       write(*,*) 'surf_land_bucket 187'
-       DO i=1, knon
-          cal(i) = RCPD / soilcap(i)
-          radsol(i) = radsol(i)  + soilflux(i)
-       END DO
-    ELSE 
-       cal(:) = RCPD * capsol(:)
-       IF (klon_glo .EQ. 1) THEN
-         cal(:) = 0.
-       ENDIF
-    ENDIF
-    
-! Suppose zero surface speed
-!        write(*,*) 'surf_land_bucket 198'
-    u0(:)=0.0
-    v0(:)=0.0
-    u1_lay(:) = u1(:) - u0(:)
-    v1_lay(:) = v1(:) - v0(:)
-
-!        write(*,*) 'surf_land_bucket 201'
-    CALL calcul_fluxs(knon, is_ter, dtime, &
-         tsurf, p1lay, cal, beta, tq_cdrag, tq_cdrag, pref, &
-         precip_rain, precip_snow, snow, qsurf,  &
-         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
-         1.,petAcoef, peqAcoef, petBcoef, peqBcoef, &
-         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
-    
-
-
-#ifdef ISO
-   ! verif
-#ifdef ISOVERIF
-    !write(*,*) 'surf_land_bucket 211'
-    do i=1,knon
-      if (iso_eau.gt.0) then
-        call iso_verif_egalite_choix(xtsnow(iso_eau,i), &
-     &           snow(i),'surf_land_bucket 522', &
-     &           errmax,errmaxrel) 
-       endif !if (iso_eau.gt.0) then
-    enddo !do i=1,knon 
-#endif
-   ! end verif
-#endif         
-#ifdef ISO
-    do i=1,knon
-      snow_prec(i)=snow(i)
-      qsol_prec(i)=qsol(i)
-      do ixt=1,niso
-        xtsnow_prec(ixt,i)=xtsnow(ixt,i)
-        xtsol_prec(ixt,i)=xtsol(ixt,i)
-      enddo !do ixt=1,niso
-      ! initialisation:
-      fqfonte_diag(i)=0.0
-      fq_fonte_diag(i)=0.0
-      snow_evap_diag(i)=0.0
-   enddo !do i=1,knon 
-#ifdef ISOVERIF
-       ! write(*,*) 'surf_land_bucket 235'
-       do i=1,knon  
-        if (iso_eau.gt.0) then
-            call iso_verif_egalite(qsol_prec(i),xtsol_prec(iso_eau,i), &
-    &            'surf_land_bucket 141')
-        endif
-      enddo !do i=1,knon
-#endif    
-#endif    
-!
-!* Calculate snow height, run_off, age of snow
-!      
-    CALL fonte_neige( knon, is_ter, knindex, dtime, &
-         tsurf, precip_rain, precip_snow, &
-         snow, qsol, tsurf_new, evap &
-#ifdef ISO    
-     & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
-     & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag   &
-#endif
-     &   )
-
-#ifdef ISO
-#ifdef ISOVERIF
-        do i=1,knon
-         do ixt=1,niso
-          call iso_verif_noNaN(xtsol_prec(ixt,i),'surf_land_burcket 237')
-         enddo
-        enddo
-#endif
-#ifdef ISOVERIF
-        !write(*,*) 'surf_land_bucket 235'
-        do i=1,knon
-          if (iso_eau.gt.0) then
-            call iso_verif_egalite_choix(qsol_prec(i), &
-     &          xtsol_prec(iso_eau,i),'surf_land_bucket 628', &
-     &          errmax,errmaxrel)
-            call iso_verif_egalite_choix(precip_snow(i), &
-     &          xtprecip_snow(iso_eau,i),'surf_land_bucket 227', &
-     &          errmax,errmaxrel)
-             ! attention, dans fonte_neige, on modifie snow sans modifier
-             ! xtsnow
-             ! c'est fait plus tard dans gestion_neige
-!            write(*,*) 'surf_land_bucket 287: i=',i
-!            write(*,*) 'snow(i)=',snow(i)
-            call iso_verif_egalite_choix(xtsnow(iso_eau,i), &
-     &           snow_prec(i),'surf_land_bucket 245', &
-     &           errmax,errmaxrel) 
-          endif  
-          if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
-              if (qsol_prec(i).gt.ridicule_qsol) then
-                call iso_verif_aberrant_o17(xtsol_prec(iso_O17,i) &
-     &           /qsol_prec(i),xtsol_prec(iso_O18,i) &
-     &           /qsol_prec(i),'surf_land_bucket 642')
-              endif !if ((qsol_prec(i).gt.ridicule_qsol) &
-          endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
-        enddo  !do i=1,knon 
-        !write(*,*) 'surf_land_mod 291'
-        !write(*,*) 'snow_evap_diag(1)=',snow_evap_diag(1)
-#endif          
-        call calcul_iso_surf_ter_vectall(klon,knon, &
-     &           evap,snow_evap_diag,snow, &
-     &           fq_fonte_diag,fqfonte_diag,dtime,precip_rain,xtprecip_rain, &
-     &           precip_snow,xtprecip_snow, snow_prec,xtsnow_prec, &
-     &           tsurf_new,xtspechum,pref,spechum,t_coup,u1_lay,v1_lay,p1lay, &
-     &           qsol,xtsol,qsol_prec,xtsol_prec, &
-     &           max_eau_sol_diag, &
-     &           xtevap,xtsnow,h1,runoff_diag,xtrunoff_diag,fqcalving_diag, &
-     &           knindex,is_ter,run_off_lic_diag,coeff_rel_diag,Rland_ice &
-     &   )
-!#ifdef ISOVERIF
-!        write(*,*) 'surf_land_bucket 303'
-!#endif
-#endif
-
-!
-!* Calculate the age of snow
-!
-    CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))  
-    
-    WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
-    
-    DO i=1, knon
-       zfra(i) = MAX(0.0,MIN(1.0, snow(i)/(snow(i)+10.0)))
-       alb_lim(i)  = alb_neig(i) *zfra(i) + alb_lim(i)*(1.0-zfra(i))
-    END DO
-
-!
-!* Return albedo : 
-!    alb1_new and alb2_new are here given the same values
-!
-    alb1_new(:) = 0.0
-    alb2_new(:) = 0.0
-    alb1_new(1:knon) = alb_lim(1:knon)
-    alb2_new(1:knon) = alb_lim(1:knon)
-       
-!
-!* Calculate the rugosity
-!
-    DO i = 1, knon
-       z0_new(i) = MAX(1.5e-05,SQRT(z0_new(i)**2 + rugoro(i)**2))
-    END DO
-
-!* Send to coupler
-!  The run-off from river and coast are not calculated in the bucket modele.
-!  For testing purpose of the coupled modele we put the run-off to zero.
-    IF (type_ocean=='couple') THEN
-       dummy_riverflow(:)   = 0.0
-       dummy_coastalflow(:) = 0.0
-       CALL cpl_send_land_fields(itime, knon, knindex, &
-            dummy_riverflow, dummy_coastalflow)
-    ENDIF
-
-!
-!* End
-!
-  END SUBROUTINE surf_land_bucket
-!
-!****************************************************************************************
-!
-END MODULE surf_land_bucket_mod
+link ../phylmd/surf_land_bucket_mod.F90
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/surf_land_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/surf_land_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/surf_land_mod.F90	(revision 5202)
@@ -1,436 +1,1 @@
-!
-MODULE surf_land_mod
-
-  IMPLICIT NONE
-
-CONTAINS
-!
-!****************************************************************************************
-!  
-  SUBROUTINE surf_land(itime, dtime, date0, jour, knon, knindex, &
-       rlon, rlat, yrmu0, &
-       debut, lafin, zlev, ccanopy, swnet, lwnet, albedo, &
-       tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, precip_bs, temp_air, spechum, &
-       AcoefH, AcoefQ, BcoefH, BcoefQ, &
-       AcoefU, AcoefV, BcoefU, BcoefV, & 
-       pref, u1, v1, gustiness, rugoro, pctsrf, &
-       lwdown_m, q2m, t2m, &
-       snow, qsol, agesno, tsoil, &
-       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, fluxbs, &   
-       qsurf, tsurf_new, dflux_s, dflux_l, &
-       flux_u1, flux_v1 , & 
-       veget,lai,height &
-#ifdef ISO
-       ,xtprecip_rain, xtprecip_snow,xtspechum, &
-       xtsnow, xtsol,xtevap,h1, &
-       runoff_diag,xtrunoff_diag,Rland_ice &
-#endif               
-               )
-
-    USE dimphy
-    USE surface_data, ONLY    : ok_veget
-    USE carbon_cycle_mod 
-
-    ! See comments in each module surf_land_orchidee_xxx for compatiblity with ORCHIDEE
-#ifdef ORCHIDEE_NOOPENMP
-    ! Compilation with cpp key ORCHIDEE NOOPENMP
-    USE surf_land_orchidee_noopenmp_mod
-#else
-#if ORCHIDEE_NOZ0H
-    ! Compilation with cpp key ORCHIDEE NOZ0H
-    USE surf_land_orchidee_noz0h_mod
-#else
-#if ORCHIDEE_NOFREIN
-    ! Compilation with cpp key ORCHIDEE_NOFREIN
-    USE surf_land_orchidee_nofrein_mod
-#else
-#if ORCHIDEE_NOUNSTRUCT
-    ! Compilation with cpp key ORCHIDEE_NOUNSTRUCT
-    USE surf_land_orchidee_nounstruct_mod
-#else
-#if ORCHIDEE_NOLIC
-    ! Compilation with cpp key ORCHIDEE_NOLIC
-    USE surf_land_orchidee_nolic_mod
-#else
-    ! Default version#else
-    USE surf_land_orchidee_mod
-#endif
-#endif
-#endif
-#endif
-#endif
-
-    USE surf_land_bucket_mod
-    USE calcul_fluxs_mod
-    USE indice_sol_mod
-#ifdef ISO
-    use infotrac_phy, ONLY: ntiso,niso
-    use isotopes_mod, ONLY: nudge_qsol, iso_eau
-#ifdef ISOVERIF
-    use isotopes_verif_mod
-#endif
-#endif
-    
-    USE print_control_mod, ONLY: lunout
-
-    INCLUDE "dimsoil.h"
-    INCLUDE "YOMCST.h"
-    INCLUDE "clesphys.h"
-    INCLUDE "dimpft.h"
-
-! Input variables  
-!****************************************************************************************
-    INTEGER, INTENT(IN)                     :: itime, jour, knon
-    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
-    REAL, INTENT(IN)                        :: date0
-    REAL, DIMENSION(klon), INTENT(IN)       :: rlon, rlat
-    REAL, DIMENSION(klon), INTENT(IN)       :: yrmu0  ! cosine of solar zenith angle
-    LOGICAL, INTENT(IN)                     :: debut, lafin
-    REAL, INTENT(IN)                        :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)       :: zlev, ccanopy
-    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
-    REAL, DIMENSION(klon), INTENT(IN)       :: albedo  ! albedo for whole short-wave interval
-    REAL, DIMENSION(klon), INTENT(IN)       :: tsurf
-    REAL, DIMENSION(klon), INTENT(IN)       :: p1lay
-    REAL, DIMENSION(klon), INTENT(IN)       :: cdragh, cdragm
-    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
-    REAL, DIMENSION(klon), INTENT(IN)       :: AcoefU, AcoefV, BcoefU, BcoefV
-    REAL, DIMENSION(klon), INTENT(IN)       :: pref   ! pressure reference
-    REAL, DIMENSION(klon), INTENT(IN)       :: u1, v1, gustiness
-    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
-    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
-    REAL, DIMENSION(klon), INTENT(IN)       :: lwdown_m  ! downwelling longwave radiation at mean surface
-                                                         ! corresponds to previous sollwdown
-    REAL, DIMENSION(klon), INTENT(IN)       :: q2m, t2m
-#ifdef ISO
-    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtprecip_rain, xtprecip_snow
-    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtspechum
-#endif 
-
-! In/Output variables
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
-    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
-    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
-#ifdef ISO
-    REAL, DIMENSION(niso,klon), INTENT(INOUT)    :: xtsnow, xtsol
-#endif
-
-! Output variables
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
-!albedo SB >>>
-!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new ! albdeo for shortwave interval 1(visible)
-!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new ! albedo for shortwave interval 2(near infrared)
-    REAL, DIMENSION(6), INTENT(IN) :: SFRWL
-    REAL, DIMENSION(klon,nsw), INTENT(OUT)       :: alb_dir_new,alb_dif_new
-!albedo SB <<<
-    REAL, DIMENSION(klon), INTENT(OUT)       :: evap
-    REAL, DIMENSION(klon), INTENT(OUT)       :: fluxsens, fluxlat, fluxbs
-    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l      
-    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1  ! flux for U and V at first model level
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget,lai
-    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height
-#ifdef ISO
-    REAL, DIMENSION(ntiso,klon), INTENT(OUT)      :: xtevap
-    REAL, DIMENSION(klon), INTENT(OUT)      :: h1
-    REAL, DIMENSION(niso,klon), INTENT(OUT)      :: xtrunoff_diag
-    REAL, DIMENSION(klon), INTENT(OUT)      :: runoff_diag
-    REAL, DIMENSION(niso,klon), INTENT(IN)        :: Rland_ice
-#endif
-
-! Local variables
-!****************************************************************************************
-    REAL, DIMENSION(klon) :: p1lay_tmp
-    REAL, DIMENSION(klon) :: pref_tmp
-    REAL, DIMENSION(klon) :: swdown     ! downwelling shortwave radiation at land surface
-    REAL, DIMENSION(klon) :: epot_air           ! potential air temperature
-    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
-
-!albedo SB >>>
-    REAL, DIMENSION(klon)      :: alb1_new,alb2_new
-!albedo SB <<<
-
-#ifdef ISO       
-      real, parameter :: t_coup = 273.15
-      real, dimension(klon) :: fqfonte_diag
-      real, dimension(klon) ::  snow_evap_diag 
-      real, dimension(klon) ::  fqcalving_diag 
-      integer :: ixt
-#endif  
-
-!****************************************************************************************
-!Total solid precip
-
-IF (ok_bs) THEN
-precip_totsnow(:)=precip_snow(:)+precip_bs(:)
-ELSE
-precip_totsnow(:)=precip_snow(:)
-ENDIF
-!****************************************************************************************
-#ifdef ISO
-#ifdef ISOVERIF
-!        write(*,*) 'surf_land_mod 162'
-        do i=1,knon
-          if (iso_eau.gt.0) then
-            call iso_verif_egalite_choix(precip_snow(i), &
-     &          xtprecip_snow(iso_eau,i),'surf_land_mod 129', &
-     &          errmax,errmaxrel)
-            call iso_verif_egalite_choix(qsol(i), &
-     &          xtsol(iso_eau,i),'surf_land_mod 139', &
-     &          errmax,errmaxrel)
-          endif  
-        enddo
-#endif 
-#ifdef ISOVERIF
-!       write(*,*) 'surf_land 169: ok_veget=',ok_veget
-        do i=1,knon
-         do ixt=1,ntiso
-           call iso_verif_noNaN(xtprecip_snow(ixt,i),'surf_land 146')
-         enddo
-        enddo
-#endif
-#endif
-
-
-!**************************************************************************************** 
-! Choice between call to vegetation model (ok_veget=true) or simple calculation below
-!
-!****************************************************************************************
-   IF (ok_veget) THEN
-!****************************************************************************************
-!  Call model sechiba in model ORCHIDEE
-!
-!****************************************************************************************
-       p1lay_tmp(:)      = 0.0
-       pref_tmp(:)       = 0.0
-       p1lay_tmp(1:knon) = p1lay(1:knon)/100.
-       pref_tmp(1:knon)  = pref(1:knon)/100.
-! 
-!* Calculate incoming flux for SW and LW interval: swdown
-!
-       swdown(:) = 0.0
-       DO i = 1, knon
-          swdown(i) = swnet(i)/(1-albedo(i))
-       END DO
-!
-!* Calculate potential air temperature
-!
-       epot_air(:) = 0.0
-       DO i = 1, knon
-          epot_air(i) = RCPD*temp_air(i)*(pref(i)/p1lay(i))**RKAPPA
-       END DO
-
-#ifdef ISO
-      CALL abort_gcm('surf_land_mod 220','isos pas prevus dans orchidee',1)
-#endif
-       ! temporary for keeping same results using lwdown_m instead of lwdown
-       CALL surf_land_orchidee(itime, dtime, date0, knon, &
-            knindex, rlon, rlat, yrmu0, pctsrf, &
-            debut, lafin, &
-            zlev,  u1, v1, gustiness, temp_air, spechum, epot_air, ccanopy, & 
-            cdragh, AcoefH, AcoefQ, BcoefH, BcoefQ, &
-            precip_rain, precip_totsnow, lwdown_m, swnet, swdown, &
-            pref_tmp, q2m, t2m, &
-            evap, fluxsens, fluxlat,  &              
-            tsol_rad, tsurf_new, alb1_new, alb2_new, &
-            emis_new, z0m, z0h, qsurf, &
-            veget, lai, height &
-!#ifdef ISO
-!            , xtprecip_rain, xtprecip_snow, xtspechum, xtevap &
-!#endif
-            )                  
-
-#ifdef ISO
-#ifdef ISOVERIF
-     write(*,*) 'surf_land 193: apres surf_land_orchidee'   
-     do i=1,knon
-        if (iso_eau.gt.0) then
-             call iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
-    &            'surf_land 197',errmax,errmaxrel)
-        endif !if (iso_eau.gt.0) then      
-      enddo !do i=1,knon  
-#endif
-#endif
-!  
-!* Add contribution of relief to surface roughness
-!  
-       DO i=1,knon
-          z0m(i) = MAX(1.5e-05,SQRT(z0m(i)**2 + rugoro(i)**2))
-       ENDDO
-
-    ELSE  ! not ok_veget
-!****************************************************************************************
-! No extern vegetation model choosen, call simple bucket calculations instead.
-!
-!****************************************************************************************
-#ifdef ISO
-#ifdef ISOVERIF
-!       write(*,*) 'surf_land 247'
-        call iso_verif_egalite_vect1D( &
-     &           xtsnow,snow,'surf_land_mod 207',niso,klon)
-#endif
-#endif
-
-#ifdef ISO
-        if (nudge_qsol.eq.1) then
-          call surf_land_nudge_qsol(knon,rlat,rlon,qsol,xtsol,knindex)
-        endif
-        !write(*,*) 'surf_land 258'
-#endif
-       CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
-            tsurf, p1lay, cdragh, precip_rain, precip_totsnow, temp_air, &
-            spechum, AcoefH, AcoefQ, BcoefH, BcoefQ, pref, &
-            u1, v1, gustiness, rugoro, swnet, lwnet, &
-            snow, qsol, agesno, tsoil, &
-            qsurf, z0m, alb1_new, alb2_new, evap, &
-            fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l &
-#ifdef ISO
-            ,xtprecip_rain, xtprecip_snow,xtspechum, &
-            xtsnow, xtsol,xtevap,h1, &
-     &      runoff_diag, xtrunoff_diag,Rland_ice &
-#endif           
-     &       )
-        z0h(1:knon)=z0m(1:knon) ! En attendant mieux
-
-    ENDIF ! ok_veget
-
-        ! blowing snow not treated yet over land
-        fluxbs(:)=0.
-!****************************************************************************************
-! Calculation for all land models
-! - Flux calculation at first modele level for U and V
-!****************************************************************************************
-! Suppose zero surface speed
-    u0(:)=0.0
-    v0(:)=0.0
-    CALL calcul_flux_wind(knon, dtime, &
-         u0, v0, u1, v1, gustiness, cdragm, &
-         AcoefU, AcoefV, BcoefU, BcoefV, &
-         p1lay, temp_air, &
-         flux_u1, flux_v1)
-
-#ifdef ISO
-#ifdef ISOVERIF
-!     write(*,*) 'surf_land 237: sortie'   
-     do i=1,knon
-        if (iso_eau.gt.0) then
-             call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
-    &            'surf_land 241',errmax,errmaxrel)
-        endif !if (iso_eau.gt.0) then      
-      enddo !do i=1,knon  
-#endif
-#endif
-
-!albedo SB >>>
-     SELECT CASE(NSW)
-     CASE(2)
-       alb_dir_new(1:knon,1)=alb1_new(1:knon)
-       alb_dir_new(1:knon,2)=alb2_new(1:knon)
-     CASE(4)
-       alb_dir_new(1:knon,1)=alb1_new(1:knon)
-       alb_dir_new(1:knon,2)=alb2_new(1:knon)
-       alb_dir_new(1:knon,3)=alb2_new(1:knon)
-       alb_dir_new(1:knon,4)=alb2_new(1:knon)
-     CASE(6)
-       alb_dir_new(1:knon,1)=alb1_new(1:knon)
-       alb_dir_new(1:knon,2)=alb1_new(1:knon)
-       alb_dir_new(1:knon,3)=alb1_new(1:knon)
-       alb_dir_new(1:knon,4)=alb2_new(1:knon)
-       alb_dir_new(1:knon,5)=alb2_new(1:knon)
-       alb_dir_new(1:knon,6)=alb2_new(1:knon)
-     END SELECT
-
-     alb_dif_new=alb_dir_new
-!albedo SB <<<
-    
-  END SUBROUTINE surf_land
-
-
-#ifdef ISO
-    SUBROUTINE surf_land_nudge_qsol(knon,rlat,rlon,qsol,xtsol,knindex)
-
-    USE dimphy   
-    USE infotrac_phy, ONLY: niso
-    use isotopes_mod, ONLY: region_nudge_qsol    
-    INTEGER, INTENT(IN)                     ::  knon         
-    REAL, DIMENSION(klon), INTENT(IN)       :: rlon, rlat
-    REAL, DIMENSION(klon), INTENT(INOUT)    :: qsol
-    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex    
-    REAL, DIMENSION(niso,klon), INTENT(INOUT)    :: xtsol 
-    real lat_min_nudge_qsol,lat_max_nudge_qsol
-    real lon_min_nudge_qsol,lon_max_nudge_qsol
-    integer i,ixt
-    real qsol_new
-
-  if (region_nudge_qsol.eq.1) then
-        ! Aamzonie du Sud
-        lat_min_nudge_qsol=-15.0
-        lat_max_nudge_qsol=-5.0
-        lon_min_nudge_qsol=-70.0
-        lon_max_nudge_qsol=-50.0
-  else if (region_nudge_qsol.eq.2) then
-        ! Aamzonie du Nord
-        lat_min_nudge_qsol=-5.0
-        lat_max_nudge_qsol=5.0
-        lon_min_nudge_qsol=-70.0
-        lon_max_nudge_qsol=-50.0
-  else
-        write(*,*) 'surf_land 298: cas pas prevu'
-        write(*,*) 'region_nudge_qsol=',region_nudge_qsol
-        stop
-  endif
-
-!  write(*,*) 'surf_land 314: knon=',knon
-!  write(*,*) 'rlat=',rlat
-!  write(*,*) 'rlon=',rlon
-!  write(*,*) 'region_nudge_qsol=',region_nudge_qsol
-
-    do i=1,knon
-     if ((rlat(knindex(i)).ge.lat_min_nudge_qsol).and. &
-  &    (rlat(knindex(i)).le.lat_max_nudge_qsol).and. &
-  &    (rlon(knindex(i)).ge.lon_min_nudge_qsol).and. &
-  &    (rlon(knindex(i)).le.lon_max_nudge_qsol)) then
-!        write(*,*) 'surf_land 324: bon domaine: rlat,rlon,qsol=', &
-!  &             rlat(knindex(i)),rlon(knindex(i)),qsol(knindex(i))
-        qsol_new=qsol(i)
-        if (region_nudge_qsol.eq.1) then        
-           qsol_new=max(qsol(i),50.0)   
-        else if (region_nudge_qsol.eq.2) then      
-           qsol_new=max(qsol(i),120.0)
-        else !if (region_nudge_qsol.eq.1) then
-          write(*,*) 'surf_land 317: cas pas prevu'
-          write(*,*) 'region_nudge_qsol=',region_nudge_qsol
-          stop
-        endif !if (region_nudge_qsol.eq.1) then
-        if (qsol(i).gt.0.0) then
-          do ixt=1,niso
-           xtsol(ixt,i)=xtsol(ixt,i)*qsol_new/qsol(i)
-          enddo
-        else !if (qsol(i).gt.0.0) then
-          do ixt=1,niso
-           xtsol(ixt,i)=0.0
-          enddo
-        endif !if (qsol(i).gt.0.0) then
-        qsol(i)=qsol_new
-        write(*,*) 'surf_land 346: qsol_new=',qsol(i)      
-     endif ! if ((rlat(i).ge.lat_min_nudge_qsol).and.
-  enddo !do i=1,knon
-
-  END SUBROUTINE surf_land_nudge_qsol
-#endif
-
-!
-!****************************************************************************************
-!  
-END MODULE surf_land_mod
-!
-!****************************************************************************************
-!  
+link ../phylmd/surf_land_mod.F90
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/surf_landice_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/surf_landice_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/surf_landice_mod.F90	(revision 5202)
@@ -1,667 +1,1 @@
-!
-MODULE surf_landice_mod
-  
-  IMPLICIT NONE
-
-CONTAINS
-!
-!****************************************************************************************
-!
-  SUBROUTINE surf_landice(itime, dtime, knon, knindex, &
-       rlon, rlat, debut, lafin, &
-       rmu0, lwdownm, albedo, pphi1, &
-       swnet, lwnet, tsurf, p1lay, &
-       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, qbs1, agesno, &
-       tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, fluxbs, &
-       tsurf_new, dflux_s, dflux_l, &
-       alt, slope, cloudf, &
-       snowhgt, qsnow, to_ice, sissnow, &
-       alb3, runoff, &
-       flux_u1, flux_v1 &
-#ifdef ISO
-         &      ,xtprecip_rain, xtprecip_snow,xtspechum,Rland_ice &
-         &      ,xtsnow,xtsol,xtevap &
-#endif               
-           &    )
-
-    USE dimphy
-    USE surface_data,     ONLY : type_ocean, calice, calsno, landice_opt, iflag_albcalc
-    USE fonte_neige_mod,  ONLY : fonte_neige,run_off_lic,fqcalving_global,ffonte_global,fqfonte_global,runofflic_global
-    USE cpl_mod,          ONLY : cpl_send_landice_fields
-    USE calcul_fluxs_mod
-    USE phys_local_var_mod, ONLY : zxrhoslic, zxustartlic, zxqsaltlic
-    USE phys_output_var_mod, ONLY : snow_o,zfra_o
-#ifdef ISO   
-    USE fonte_neige_mod,  ONLY : xtrun_off_lic
-    USE infotrac_phy, ONLY : ntiso,niso
-    USE isotopes_routines_mod, ONLY: calcul_iso_surf_lic_vectall
-#ifdef ISOVERIF
-    use isotopes_mod, ONLY: iso_eau,ridicule
-    use isotopes_verif_mod
-#endif
-#endif
-    USE geometry_mod,     ONLY : longitude,latitude
-
-!FC
-    USE ioipsl_getin_p_mod, ONLY : getin_p
-    USE lmdz_blowing_snow_ini, ONLY : c_esalt_bs, zeta_bs, pbst_bs, prt_bs, rhoice_bs, rhohard_bs
-    USE lmdz_blowing_snow_ini, ONLY : rhofresh_bs, tau_eqsalt_bs, tau_dens0_bs, tau_densmin_bs
-#ifdef CPP_INLANDSIS
-    USE surf_inlandsis_mod,  ONLY : surf_inlandsis
-#endif
-
-    USE indice_sol_mod
-
-!    INCLUDE "indicesol.h"
-    INCLUDE "dimsoil.h"
-    INCLUDE "YOMCST.h"
-    INCLUDE "clesphys.h"
-
-! Input variables 
-!****************************************************************************************
-    INTEGER, INTENT(IN)                           :: itime, knon
-    INTEGER, DIMENSION(klon), INTENT(in)          :: knindex
-    REAL, INTENT(in)                              :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)             :: swnet ! net shortwave radiance
-    REAL, DIMENSION(klon), INTENT(IN)             :: lwnet ! net longwave radiance
-    REAL, DIMENSION(klon), INTENT(IN)             :: tsurf
-    REAL, DIMENSION(klon), INTENT(IN)             :: p1lay
-    REAL, DIMENSION(klon), INTENT(IN)             :: cdragh, cdragm
-    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, qbs1
-    REAL, DIMENSION(klon), INTENT(IN)             :: rugoro
-    REAL, DIMENSION(klon,nbsrf), INTENT(IN)       :: pctsrf
-#ifdef ISO
-    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtprecip_rain, xtprecip_snow 
-    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtspechum 
-#endif
-
-    LOGICAL,  INTENT(IN)                          :: debut   !true if first step
-    LOGICAL,  INTENT(IN)                          :: lafin   !true if last step
-    REAL, DIMENSION(klon), INTENT(IN)             :: rlon, rlat
-    REAL, DIMENSION(klon), INTENT(IN)             :: rmu0
-    REAL, DIMENSION(klon), INTENT(IN)             :: lwdownm !ylwdown
-    REAL, DIMENSION(klon), INTENT(IN)             :: albedo  !mean albedo
-    REAL, DIMENSION(klon), INTENT(IN)             :: pphi1    
-    REAL, DIMENSION(klon), INTENT(IN)             :: alt   !mean altitude of the grid box  
-    REAL, DIMENSION(klon), INTENT(IN)             :: slope   !mean slope in grid box  
-    REAL, DIMENSION(klon), INTENT(IN)             :: cloudf  !total cloud fraction
-
-! In/Output variables
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
-    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
-    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
-#ifdef ISO
-    REAL, DIMENSION(niso,klon), INTENT(INOUT)          :: xtsnow, xtsol 
-    REAL, DIMENSION(niso,klon), INTENT(INOUT)        :: Rland_ice
-#endif
-
-! Output variables
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
-    REAL, DIMENSION(klon), INTENT(OUT)            :: z0m, z0h
-!albedo SB >>>
-!    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1  ! new albedo in visible SW interval
-!    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2  ! new albedo in near IR interval
-    REAL, DIMENSION(6), INTENT(IN)                :: SFRWL
-    REAL, DIMENSION(klon,nsw), INTENT(OUT)        :: alb_dir,alb_dif
-!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      
-    REAL, DIMENSION(klon), INTENT(OUT)            :: flux_u1, flux_v1
-
-    REAL, DIMENSION(klon), INTENT(OUT)           :: alb3
-    REAL, DIMENSION(klon), INTENT(OUT)           :: qsnow   !column water in snow [kg/m2]
-    REAL, DIMENSION(klon), INTENT(OUT)           :: snowhgt !Snow height (m)
-    REAL, DIMENSION(klon), INTENT(OUT)           :: to_ice
-    REAL, DIMENSION(klon), INTENT(OUT)           :: sissnow
-    REAL, DIMENSION(klon), INTENT(OUT)           :: runoff  !Land ice runoff
-#ifdef ISO
-    REAL, DIMENSION(ntiso,klon), INTENT(OUT)     :: xtevap     
-!    real, DIMENSION(niso,klon) :: xtrun_off_lic_0_diag ! est une variable globale de
-!    fonte_neige
-#endif
- 
-
-! Local variables
-!****************************************************************************************
-    REAL, DIMENSION(klon)    :: soilcap, soilflux
-    REAL, DIMENSION(klon)    :: cal, beta, dif_grnd
-    REAL, DIMENSION(klon)    :: zfra, alb_neig
-    REAL, DIMENSION(klon)    :: radsol
-    REAL, DIMENSION(klon)    :: u0, v0, u1_lay, v1_lay, ustar
-    INTEGER                  :: i,j,nt
-    REAL, DIMENSION(klon)    :: fqfonte,ffonte
-    REAL, DIMENSION(klon)    :: run_off_lic_frac
-#ifdef ISO       
-      real, parameter :: t_coup = 273.15
-      real, dimension(klon) :: fqfonte_diag
-      real, dimension(klon) :: fq_fonte_diag
-      real, dimension(klon) ::  snow_evap_diag 
-      real, dimension(klon) ::  fqcalving_diag 
-      real max_eau_sol_diag  
-      real, dimension(klon) ::  runoff_diag 
-      real, dimension(klon) ::    run_off_lic_diag 
-      real ::  coeff_rel_diag
-      integer ixt
-      REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec
-      REAL, DIMENSION(klon) :: snow_prec,qsol_prec
-!      real, DIMENSION(klon) :: run_off_lic_0_diag
-#endif
-
-    REAL, DIMENSION(klon)    :: emis_new                  !Emissivity
-    REAL, DIMENSION(klon)    :: swdown,lwdown
-    REAL, DIMENSION(klon)    :: precip_snow_adv, snow_adv !Snow Drift precip./advection (not used in inlandsis)
-    REAL, DIMENSION(klon)    :: erod                      !erosion of surface snow (flux, kg/m2/s like evap)
-    REAL, DIMENSION(klon)    :: zsl_height, wind_velo     !surface layer height, wind spd
-    REAL, DIMENSION(klon)    :: dens_air,  snow_cont_air  !air density; snow content air
-    REAL, DIMENSION(klon)    :: alb_soil                  !albedo of underlying ice
-    REAL, DIMENSION(klon)    :: pexner                    !Exner potential
-    REAL                     :: pref
-    REAL, DIMENSION(klon,nsoilmx) :: tsoil0               !modif
-    REAL                          :: dtis                ! subtimestep
-    LOGICAL                       :: debut_is, lafin_is  ! debut and lafin for inlandsis
-
-    CHARACTER (len = 20)                      :: modname = 'surf_landice'
-    CHARACTER (len = 80)                      :: abort_message
-
-
-    REAL,DIMENSION(klon) :: alb1,alb2
-    REAL,DIMENSION(klon) :: precip_totsnow, evap_totsnow
-    REAL, DIMENSION (klon,6) :: alb6
-    REAL                   :: esalt
-    REAL                   :: lambdasalt,fluxsalt, csalt, nunu, aa, bb, cc
-    REAL                   :: tau_dens, maxerosion, fluxbs_2
-    REAL, DIMENSION(klon)  :: ws1, rhod, rhos, ustart0, ustart, qsalt, hsalt
-
-! End definition
-!****************************************************************************************
-!FC 
-!FC
-   REAL,SAVE :: alb_vis_sno_lic
-  !$OMP THREADPRIVATE(alb_vis_sno_lic)
-   REAL,SAVE :: alb_nir_sno_lic
-  !$OMP THREADPRIVATE(alb_nir_sno_lic)
-  LOGICAL, SAVE :: firstcall = .TRUE.
-  !$OMP THREADPRIVATE(firstcall)
-
-
-!FC firtscall initializations
-!******************************************************************************************
-#ifdef ISO
-#ifdef ISOVERIF
-!     write(*,*) 'surf_land_ice 1499'   
-     do i=1,knon
-        if (iso_eau.gt.0) then
-             call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
-    &            'surf_land_ice 126',errmax,errmaxrel)
-        endif !if (iso_eau.gt.0) then      
-      enddo !do i=1,knon  
-#endif
-#endif
-
-  IF (firstcall) THEN
-  alb_vis_sno_lic=0.77
-  CALL getin_p('alb_vis_sno_lic',alb_vis_sno_lic)
-           PRINT*, 'alb_vis_sno_lic',alb_vis_sno_lic
-  alb_nir_sno_lic=0.77
-  CALL getin_p('alb_nir_sno_lic',alb_nir_sno_lic)
-           PRINT*, 'alb_nir_sno_lic',alb_nir_sno_lic
-  
-  firstcall=.false.
-  ENDIF
-!******************************************************************************************
-
-! Initialize output variables
-    alb3(:) = 999999.
-    alb2(:) = 999999.
-    alb1(:) = 999999.
-    fluxbs(:)=0.  
-    runoff(:) = 0.
-!****************************************************************************************
-! Calculate total absorbed radiance at surface
-!
-!****************************************************************************************
-    radsol(:) = 0.0
-    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
-
-!****************************************************************************************
-
-!****************************************************************************************
-!  landice_opt = 0 : soil_model, calcul_flux, fonte_neige, ...  
-!  landice_opt = 1  : prepare and call INterace Lmdz SISvat (INLANDSIS)
-!****************************************************************************************
-
-
-    IF (landice_opt .EQ. 1) THEN
-
-!****************************************************************************************    
-! CALL to INLANDSIS interface
-!****************************************************************************************
-#ifdef CPP_INLANDSIS
-
-#ifdef ISO
-        CALL abort_gcm('surf_landice 235','isotopes pas dans INLANDSIS',1)
-#endif
-
-        debut_is=debut
-        lafin_is=.false.
-        ! Suppose zero surface speed
-        u0(:)            = 0.0
-        v0(:)            = 0.0
-
-
-        CALL calcul_flux_wind(knon, dtime, &
-         u0, v0, u1, v1, gustiness, cdragm, &
-         AcoefU, AcoefV, BcoefU, BcoefV, &
-         p1lay, temp_air, &
-         flux_u1, flux_v1)
-
-       
-       ! Set constants and compute some input for SISVAT
-       ! = 1000 hPa
-       ! and calculate incoming flux for SW and LW interval: swdown, lwdown
-       swdown(:)        = 0.0
-       lwdown(:)        = 0.0
-       snow_cont_air(:) = 0.  ! the snow content in air is not a prognostic variable of the model      
-       alb_soil(:)      = 0.4 ! before albedo(:) but here it is the ice albedo that we have to set
-       ustar(:)         = 0.
-       pref             = 100000.       
-       DO i = 1, knon
-          swdown(i)        = swnet(i)/(1-albedo(i))
-          lwdown(i)        = lwdownm(i)
-          wind_velo(i)     = u1(i)**2 + v1(i)**2
-          wind_velo(i)     = wind_velo(i)**0.5
-          pexner(i)        = (p1lay(i)/pref)**(RD/RCPD)
-          dens_air(i)      = p1lay(i)/RD/temp_air(i)  ! dry air density
-          zsl_height(i)    = pphi1(i)/RG      
-          tsoil0(i,:)      = tsoil(i,:)  
-          ustar(i)= (cdragm(i)*(wind_velo(i)**2))**0.5   
-       END DO
-       
-
-
-        dtis=dtime
-
-          IF (lafin) THEN
-            lafin_is=.true.
-          END IF
-
-          CALL surf_inlandsis(knon, rlon, rlat, knindex, itime, dtis, debut_is, lafin_is,&
-            rmu0, swdown, lwdown, albedo, pexner, ps, p1lay, precip_rain, precip_snow,   &
-            zsl_height, wind_velo, ustar, temp_air, dens_air, spechum, tsurf,&
-            rugoro, snow_cont_air, alb_soil, alt, slope, cloudf, &
-            radsol, qsol, tsoil0, snow, zfra, snowhgt, qsnow, to_ice, sissnow,agesno,   &
-            AcoefH, AcoefQ, BcoefH, BcoefQ, cdragm, cdragh, &
-            run_off_lic, fqfonte, ffonte, evap, erod, fluxsens, fluxlat,dflux_s, dflux_l, &
-            tsurf_new, alb1, alb2, alb3, alb6, &
-            emis_new, z0m, z0h, qsurf)
-
-          debut_is=.false.
-
-
-        ! Treatment of snow melting and calving
-
-        ! for consistency with standard LMDZ, add calving to run_off_lic
-        run_off_lic(:)=run_off_lic(:) + to_ice(:)
-
-        DO i = 1, knon
-           ffonte_global(knindex(i),is_lic)    = ffonte(i)
-           fqfonte_global(knindex(i),is_lic)   = fqfonte(i)! net melting= melting - refreezing
-           fqcalving_global(knindex(i),is_lic) = to_ice(i) ! flux
-           runofflic_global(knindex(i)) = run_off_lic(i)
-        ENDDO
-        ! Here, we assume that the calving term is equal to the to_ice term
-        ! (no ice accumulation)
-
-
-#else
-       abort_message='Pb de coherence: landice_opt = 1  mais CPP_INLANDSIS = .false.'
-       CALL abort_physic(modname,abort_message,1)
-#endif
-
-
-    ELSE 
-
-!****************************************************************************************
-! Soil calculations
-! 
-!****************************************************************************************
-
-    ! EV: use calbeta
-    CALL calbeta(dtime, is_lic, knon, snow, qsol, beta, cal, dif_grnd)
-
-
-    ! use soil model and recalculate properly cal
-    IF (soil_model) THEN 
-       CALL soil(dtime, is_lic, knon, snow, tsurf, qsol, &
-        & 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)
-    ELSE 
-       cal = RCPD * calice
-       WHERE (snow > 0.0) cal = RCPD * calsno
-    ENDIF
-
-
-!****************************************************************************************
-! Calulate fluxes
-!
-!****************************************************************************************
-!    beta(:) = 1.0
-!    dif_grnd(:) = 0.0
-
-! Suppose zero surface speed
-    u0(:)=0.0
-    v0(:)=0.0
-    u1_lay(:) = u1(:) - u0(:)
-    v1_lay(:) = v1(:) - v0(:)
-
-    CALL calcul_fluxs(knon, is_lic, dtime, &
-         tsurf, p1lay, cal, beta, cdragh, cdragh, ps, &
-         precip_rain, precip_snow, snow, qsurf,  &
-         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
-         1.,AcoefH, AcoefQ, BcoefH, BcoefQ, &
-         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
-
-
-#ifdef ISO
-   ! verif
-#ifdef ISOVERIF
-     !write(*,*) 'surf_land_ice 1499'   
-     do i=1,knon
-       if (iso_eau.gt.0) then
-           if (snow(i).gt.ridicule) then
-             call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
-    &            'surf_land_ice 1151',errmax,errmaxrel)
-            endif !if ((snow(i).gt.ridicule)) then
-        endif !if (iso_eau.gt.0) then      
-      enddo !do i=1,knon  
-#endif
-!#ifdef ISOVERIF
-
-    do i=1,knon
-      snow_prec(i)=snow(i)
-      do ixt=1,niso
-      xtsnow_prec(ixt,i)=xtsnow(ixt,i)
-      enddo !do ixt=1,niso
-      ! initialisation:
-      fq_fonte_diag(i)=0.0
-      fqfonte_diag(i)=0.0
-      snow_evap_diag(i)=0.0 
-    enddo !do i=1,knon 
-#endif         
-!#ifdef ISO
-    CALL calcul_flux_wind(knon, dtime, &
-         u0, v0, u1, v1, gustiness, cdragm, &
-         AcoefU, AcoefV, BcoefU, BcoefV, &
-         p1lay, temp_air, &
-         flux_u1, flux_v1)
-
-
-!****************************************************************************************
-! Calculate albedo
-!
-!****************************************************************************************
-
-!
-!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
-!****************************************************************************************
-! we proceed in 2 steps:
-! first we erode - if possible -the accumulated snow during the time step
-! then we update the density of the underlying layer and see if we can also erode
-! this layer
-
-
-   if (ok_bs) then
-       fluxbs(:)=0.
-       do j=1,klon
-          ws1(j)=(u1(j)**2+v1(j)**2)**0.5
-          ustar(j)=(cdragm(j)*(u1(j)**2+v1(j)**2))**0.5
-          rhod(j)=p1lay(j)/RD/temp_air(j)
-          ustart0(j) =(log(2.868)-log(1.625))/0.085*sqrt(cdragm(j))
-       enddo
-
-       ! 1st step: erosion of fresh snow accumulated during the time step
-       do j=1, knon
-
-           rhos(j)=rhofresh_bs
-           ! blowing snow flux formula used in MAR
-           ustart(j)=ustart0(j)*exp(max(rhoice_bs/rhofresh_bs-rhoice_bs/rhos(j),0.))*exp(max(0.,rhos(j)-rhohard_bs))
-           ! we have multiplied by exp to prevent erosion when rhos>rhohard_bs 
-           ! computation of qbs at the top of the saltation layer
-           ! default formulation from MAR model (Amory et al. 2021, Gallee et al. 2001)
-           esalt=1./(c_esalt_bs*max(1.e-6,ustar(j)))
-           hsalt(j)=0.08436*(max(1.e-6,ustar(j))**1.27)
-           qsalt(j)=(max(ustar(j)**2-ustart(j)**2,0.))/(RG*hsalt(j))*esalt
-           ! calculation of erosion (flux positive towards the surface here) 
-           ! consistent with implicit resolution of turbulent mixing equation
-           ! Nemoto and Nishimura 2004 show that steady-state saltation is achieved within a time tau_eqsalt_bs of about 10s
-           ! we thus prevent snowerosion (snow particle transfer from the saltation layer to the first model level)
-           ! integrated over tau_eqsalt_bs to exceed the total mass of snow particle in the saltation layer
-           ! (rho*qsalt*hsalt)
-           ! during this first step we also lower bound the erosion to the amount of fresh snow accumulated during the time step
-           maxerosion=min(precip_snow(j),hsalt(j)*qsalt(j)*rhod(j)/tau_eqsalt_bs)
-
-           fluxbs(j)=rhod(j)*ws1(j)*cdragm(j)*(AcoefQBS(j)-qsalt(j)) &
-                   / (1.-rhod(j)*ws1(j)*cdragm(j)*BcoefQBS(j)*dtime)
-           !fluxbs(j)= rhod*ws1(j)*cdragm(j)*(qbs1(j)-qsalt(j))
-           fluxbs(j)=max(-maxerosion,fluxbs(j))
-       enddo
-
-
-       ! we now compute the snow age of the overlying layer (snow surface after erosion of the fresh snow accumulated during the time step)
-       ! this is done through the routine albsno
-       CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)+fluxbs(:))
-
-       ! 2nd step:
-       ! 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_bs, tau_dens0_bs*exp(-abs(precip_bs(j))/pbst_bs - & 
-                    abs(precip_rain(j))/prt_bs)*exp(-max(tsurf(j)-RTT,0.)))
-           rhos(j)=rhofresh_bs+(rhohard_bs-rhofresh_bs)*(1.-exp(-agesno(j)*86400.0/tau_dens))
-           ! blowing snow flux formula used in MAR
-           ustart(j)=ustart0(j)*exp(max(rhoice_bs/rhofresh_bs-rhoice_bs/rhos(j),0.))*exp(max(0.,rhos(j)-rhohard_bs)) 
-           ! we have multiplied by exp to prevent erosion when rhos>rhohard_bs 
-           ! computation of qbs at the top of the saltation layer
-           ! default formulation from MAR model (Amory et al. 2021, Gallee et al. 2001)
-           esalt=c_esalt_bs*ustar(j)
-           hsalt(j)=0.08436*(max(1.e-6,ustar(j))**1.27)
-           qsalt(j)=(max(ustar(j)**2-ustart(j)**2,0.))/(RG*hsalt(j))*esalt
-           ! calculation of erosion (flux positive towards the surface here) 
-           ! consistent with implicit resolution of turbulent mixing equation
-           ! Nemoto and Nishimura 2004 show that steady-state saltation is achieved within a time tau_eqsalt_bs of about 10s
-           ! we thus prevent snowerosion (snow particle transfer from the saltation layer to the first model level)
-           ! integrated over tau_eqsalt_bs to exceed the total mass of snow particle in the saltation layer
-           ! (rho*qsalt*hsalt)
-           maxerosion=hsalt(j)*qsalt(j)*rhod(j)/tau_eqsalt_bs
-           fluxbs_2=rhod(j)*ws1(j)*cdragm(j)*(AcoefQBS(j)-qsalt(j)) &
-                   / (1.-rhod(j)*ws1(j)*cdragm(j)*BcoefQBS(j)*dtime)
-           !fluxbs_2= rhod*ws1(j)*cdragm(j)*(qbs1(j)-qsalt(j))
-           fluxbs_2=max(-maxerosion,fluxbs_2)
-           fluxbs(j)=fluxbs(j)+fluxbs_2
-       enddo
-
-       ! for outputs       
-        do j=1, knon
-              i = knindex(j)
-              zxustartlic(i) = ustart(j)
-              zxrhoslic(i) = rhos(j)
-              zxqsaltlic(i)=qsalt(j)
-        enddo
-
-
-  else
-  ! those lines are useful to calculate the snow age
-       CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))
-
-  endif ! if ok_bs
-
-
-
-
-
-
-!****************************************************************************************
-! 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 &
-#ifdef ISO    
-     & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
-     & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag   &
-#endif
-     &   )
-
-
-#ifdef ISO
-#ifdef ISOVERIF
-      do i=1,knon  
-       if (iso_eau.gt.0) then  
-          call iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
-     &         'surf_landice_mod 217',errmax,errmaxrel)
-       endif !if (iso_eau.gt.0) then   
-      enddo !do i=1,knon  
-#endif
-!#ifdef ISOVERIF
-
-       call calcul_iso_surf_lic_vectall(klon,knon, &
-     &           evap,snow_evap_diag,Tsurf_new,snow, &
-     &           fq_fonte_diag,fqfonte_diag,dtime,t_coup, &
-     &           precip_snow,xtprecip_snow,precip_rain,xtprecip_rain, snow_prec,xtsnow_prec, &
-     &           xtspechum,spechum,ps,Rland_ice, &
-     &           xtevap,xtsnow,fqcalving_diag, &
-     &           knindex,is_lic,run_off_lic_diag,coeff_rel_diag &
-     &  ) 
-
-!        call fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
-
-#endif
-!#ifdef ISO
-
-
-    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)))  
-
-
-    END IF ! landice_opt
-
-
-!****************************************************************************************
-! Send run-off on land-ice to coupler if coupled ocean.
-! run_off_lic has been calculated in fonte_neige or surf_inlandsis
-! If landice_opt>=2, corresponding call is done from surf_land_orchidee
-!****************************************************************************************
-    IF (type_ocean=='couple' .AND. landice_opt .LT. 2) THEN
-       ! Compress fraction where run_off_lic is active (here all pctsrf(is_lic))
-       run_off_lic_frac(:)=0.0
-       DO j = 1, knon
-          i = knindex(j)
-          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
-
- ! transfer runoff rate [kg/m2/s](!) to physiq for output
-    runoff(1:knon)=run_off_lic(1:knon)/dtime
-
-       snow_o=0.
-       zfra_o = 0.
-       DO j = 1, knon
-           i = knindex(j)
-           snow_o(i) = snow(j)
-           zfra_o(i) = zfra(j)
-       ENDDO
-
-
-!albedo SB >>>
-     select case(NSW)
-     case(2)
-       alb_dir(1:knon,1)=alb1(1:knon)
-       alb_dir(1:knon,2)=alb2(1:knon)
-     case(4)
-       alb_dir(1:knon,1)=alb1(1:knon)
-       alb_dir(1:knon,2)=alb2(1:knon)
-       alb_dir(1:knon,3)=alb2(1:knon)
-       alb_dir(1:knon,4)=alb2(1:knon)
-     case(6)
-       alb_dir(1:knon,1)=alb1(1:knon)
-       alb_dir(1:knon,2)=alb1(1:knon)
-       alb_dir(1:knon,3)=alb1(1:knon)
-       alb_dir(1:knon,4)=alb2(1:knon)
-       alb_dir(1:knon,5)=alb2(1:knon)
-       alb_dir(1:knon,6)=alb2(1:knon)
-
-       IF ((landice_opt .EQ. 1) .AND. (iflag_albcalc .EQ. 2)) THEN
-       alb_dir(1:knon,1)=alb6(1:knon,1)
-       alb_dir(1:knon,2)=alb6(1:knon,2)
-       alb_dir(1:knon,3)=alb6(1:knon,3)
-       alb_dir(1:knon,4)=alb6(1:knon,4)
-       alb_dir(1:knon,5)=alb6(1:knon,5)
-       alb_dir(1:knon,6)=alb6(1:knon,6)
-       ENDIF
-
-     end select
-alb_dif=alb_dir
-!albedo SB <<<
-
-
-  END SUBROUTINE surf_landice
-!
-!****************************************************************************************
-!
-END MODULE surf_landice_mod
-
-
-
+link ../phylmd/surf_landice_mod.F90
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/surf_ocean_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/surf_ocean_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/surf_ocean_mod.F90	(revision 5202)
@@ -1,401 +1,1 @@
-!
-! $Id: surf_ocean_mod.F90 3395 2018-09-25 15:22:13Z lguez $
-!
-MODULE surf_ocean_mod
-
-  IMPLICIT NONE
-
-CONTAINS
-  !
-  !******************************************************************************
-  !
-  SUBROUTINE surf_ocean(rlon, rlat, swnet, lwnet, alb1, &
-       windsp, rmu0, fder, tsurf_in, &
-       itime, dtime, jour, knon, knindex, &
-       p1lay, z1lay, cdragh, cdragm, precip_rain, precip_snow, precip_bs, temp_air, spechum, &
-       AcoefH, AcoefQ, BcoefH, BcoefQ, &
-       AcoefU, AcoefV, BcoefU, BcoefV, &
-       ps, u1, v1, gustiness, rugoro, pctsrf, &
-       snow, qsurf, agesno, &
-       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, & 
-       tsurf_new, dflux_s, dflux_l, lmt_bils, &
-       flux_u1, flux_v1, delta_sst, delta_sal, ds_ns, dt_ns, dter, dser, &
-       dt_ds, tkt, tks, taur, sss &
-#ifdef ISO
-        &       ,xtprecip_rain, xtprecip_snow,xtspechum,Roce, &
-        &       xtsnow,xtevap,h1 &
-#endif               
-        &       )
-
-    use albedo, only: alboc, alboc_cd
-    use bulk_flux_m, only: bulk_flux
-    USE dimphy, ONLY: klon, zmasq
-    USE surface_data, ONLY     : type_ocean
-    USE ocean_forced_mod, ONLY : ocean_forced_noice
-    USE ocean_slab_mod, ONLY   : ocean_slab_noice
-    USE ocean_cpl_mod, ONLY    : ocean_cpl_noice
-    USE indice_sol_mod, ONLY : nbsrf, is_oce
-#ifdef ISO
-  USE infotrac_phy, ONLY : ntraciso=>ntiso,niso
-#ifdef ISOVERIF
-    USE isotopes_mod, ONLY: iso_eau,ridicule
-    USE isotopes_verif_mod
-#endif
-#endif
-    USE limit_read_mod
-    use config_ocean_skin_m, only: activate_ocean_skin
-    !
-    ! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force, 
-    ! slab or couple). The calculations of albedo and rugosity for the ocean surface are 
-    ! done in here because they are identical for the different modes of ocean. 
-
-
-    INCLUDE "YOMCST.h"
-
-    include "clesphys.h"
-    ! for cycle_diurne and for iflag_z0_oce==-1 (prescribed z0)
-
-    ! Input variables
-    !******************************************************************************
-    INTEGER, INTENT(IN)                      :: itime, jour, knon
-    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
-    REAL, INTENT(IN)                         :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
-    REAL, DIMENSION(klon), INTENT(IN)        :: swnet  ! net shortwave radiation at surface  
-    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface  
-    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
-    REAL, DIMENSION(klon), INTENT(IN)        :: windsp ! wind at 10 m, in m s-1
-    REAL, DIMENSION(klon), INTENT(IN)        :: rmu0  
-    REAL, DIMENSION(klon), INTENT(IN)        :: fder
-    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in     ! defined only for subscripts 1:knon
-    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay,z1lay ! pression (Pa) et altitude (m) du premier niveau
-    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh
-    REAL, DIMENSION(klon), INTENT(IN)        :: cdragm
-    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
-    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
-    REAL, DIMENSION(klon), INTENT(IN)        :: ps
-    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
-    REAL, DIMENSION(klon), INTENT(IN)        :: rugoro
-    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
-#ifdef ISO
-    REAL, DIMENSION(ntraciso,klon), INTENT(IN)        :: xtprecip_rain, xtprecip_snow 
-    REAL, DIMENSION(ntraciso,klon), INTENT(IN)        :: xtspechum
-#endif
-
-    ! In/Output variables
-    !******************************************************************************
-    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
-    REAL, DIMENSION(klon), INTENT(INOUT)     :: qsurf
-    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
-    REAL, DIMENSION(klon), INTENT(inOUT)     :: z0h
-#ifdef ISO
-    REAL, DIMENSION(niso,klon), INTENT(IN)        :: xtsnow 
-    REAL, DIMENSION(niso,klon), INTENT(INOUT)        :: Roce  
-#endif
-
-    REAL, intent(inout):: delta_sst(:) ! (knon)
-    ! Ocean-air interface temperature minus bulk SST, in K. Defined
-    ! only if activate_ocean_skin >= 1.
-
-    real, intent(inout):: delta_sal(:) ! (knon)
-    ! Ocean-air interface salinity minus bulk salinity, in ppt. Defined
-    ! only if activate_ocean_skin >= 1.
-
-    REAL, intent(inout):: ds_ns(:) ! (knon)
-    ! "delta salinity near surface". Salinity variation in the
-    ! near-surface turbulent layer. That is subskin salinity minus
-    ! foundation salinity. In ppt.
-
-    REAL, intent(inout):: dt_ns(:) ! (knon)
-    ! "delta temperature near surface". Temperature variation in the
-    ! near-surface turbulent layer. That is subskin temperature
-    ! minus foundation temperature. (Can be negative.) In K.
-
-    REAL, intent(inout):: dter(:) ! (knon)
-    ! Temperature variation in the diffusive microlayer, that is
-    ! ocean-air interface temperature minus subskin temperature. In
-    ! K.
-
-    REAL, intent(inout):: dser(:) ! (knon)
-    ! Salinity variation in the diffusive microlayer, that is
-    ! ocean-air interface salinity minus subskin salinity. In ppt.
-
-    real, intent(inout):: dt_ds(:) ! (knon)
-    ! (tks / tkt) * dTer, in K
-
-    ! Output variables
-    !**************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m
-    !albedo SB >>>
-    !    REAL, DIMENSION(klon), INTENT(OUT)  :: alb1_new  ! new albedo in visible SW interval
-    !    REAL, DIMENSION(klon), INTENT(OUT)  :: alb2_new  ! new albedo in near IR interval
-    REAL, DIMENSION(6), INTENT(IN)           :: SFRWL 
-    REAL, DIMENSION(klon,nsw), INTENT(OUT)   :: alb_dir_new,alb_dif_new
-    !albedo SB <<<     
-    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
-    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new    ! sea surface temperature, in K
-    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l      
-    REAL, DIMENSION(klon), INTENT(OUT)       :: lmt_bils
-    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
-
-    REAL, intent(out):: tkt(:) ! (knon)
-    ! épaisseur (m) de la couche de diffusion thermique (microlayer)
-    ! cool skin thickness
-
-    REAL, intent(out):: tks(:) ! (knon)
-    ! épaisseur (m) de la couche de diffusion de masse (microlayer)
-
-    REAL, intent(out):: taur(:) ! (knon)
-    ! momentum flux due to rain, in Pa
-
-    real, intent(out):: sss(:) ! (klon)
-    ! Bulk salinity of the surface layer of the ocean, in ppt. (Only
-    ! defined for subscripts 1:knon, but we have to declare it with
-    ! size klon because of the coupling machinery.)
-
-#ifdef ISO
-    REAL, DIMENSION(ntraciso,klon), INTENT(out)        :: xtevap ! isotopes in surface evaporation flux 
-    REAL, DIMENSION(klon), INTENT(out)        :: h1 ! just a diagnostic, not useful for the simulation   
-#endif
-
-    ! Local variables
-    !*************************************************************************
-    INTEGER               :: i, k
-    REAL                  :: tmp
-    REAL, PARAMETER       :: cepdu2=(0.1)**2
-    REAL, DIMENSION(klon) :: alb_eau, z0_lim
-    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)
-    REAL sens_prec_liq(knon)
-
-    REAL t_int(knon) ! ocean-air interface temperature, in K
-    real s_int(knon) ! ocean-air interface salinity, in ppt
-
-    !**************************************************************************
-
-#ifdef ISO
-#ifdef ISOVERIF
-        do i=1,knon
-          if (iso_eau.gt.0) then         
-                 call iso_verif_egalite_choix(xtspechum(iso_eau,i), &
-     &                  spechum(i),'surf_ocean_mod 117', &
-     &                  errmax,errmaxrel)          
-                 call iso_verif_egalite_choix(xtsnow(iso_eau,i), &
-     &                  snow(i),'surf_ocean_mod 127', &
-     &                  errmax,errmaxrel) 
-           endif !if (iso_eau.gt.0) then
-        enddo !do i=1,klon
-#endif      
-#endif
-
-    !******************************************************************************
-    ! Calculate total net radiance at surface
-    !
-    !******************************************************************************
-    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
-
-    !******************************************************************************
-    ! Cdragq computed from cdrag
-    ! The difference comes only from a factor (f_z0qh_oce) on z0, so that
-    ! it can be computed inside surf_ocean
-    ! More complicated appraches may require the propagation through
-    ! pbl_surface of an independant cdragq variable.
-    !******************************************************************************
-
-    IF ( f_z0qh_oce .ne. 1.) THEN
-       ! Si on suit les formulations par exemple de Tessel, on 
-       ! a z0h=0.4*nu/u*, z0q=0.62*nu/u*, d'ou f_z0qh_oce=0.62/0.4=1.55
-       cdragq(1:knon)=cdragh(1:knon)*                                      &
-            log(z1lay(1:knon)/z0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*z0h(1:knon)))
-    ELSE
-       cdragq(1:knon)=cdragh(1:knon)
-    ENDIF
-
-    rhoa = PS(:KNON) / (Rd * temp_air(:knon) * (1. + retv * spechum(:knon)))
-    !******************************************************************************
-    ! Switch according to type of ocean (couple, slab or forced)
-    !******************************************************************************
-    SELECT CASE(type_ocean)
-    CASE('couple')
-       CALL ocean_cpl_noice( &
-            swnet, lwnet, alb1, &
-            windsp, fder, & 
-            itime, dtime, knon, knindex, &
-            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_totsnow,temp_air,spechum,& 
-            AcoefH, AcoefQ, BcoefH, BcoefQ, &
-            AcoefU, AcoefV, BcoefU, BcoefV, &
-            ps, u1, v1, gustiness, tsurf_in, &
-            radsol, snow, agesno, &
-            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l, sens_prec_liq, sss, delta_sal, rhoa, &
-            delta_sst, dTer, dSer, dt_ds)
-
-    CASE('slab')
-       CALL ocean_slab_noice( &
-            itime, dtime, jour, knon, knindex, &
-            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_totsnow, temp_air, spechum,&
-            AcoefH, AcoefQ, BcoefH, BcoefQ, &
-            AcoefU, AcoefV, BcoefU, BcoefV, &
-            ps, u1, v1, gustiness, tsurf_in, &
-            radsol, snow, &
-            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l, lmt_bils)
-
-    CASE('force')
-       CALL ocean_forced_noice( &
-            itime, dtime, jour, knon, knindex, &
-            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_totsnow, &
-            temp_air, spechum, &
-            AcoefH, AcoefQ, BcoefH, BcoefQ, &
-            AcoefU, AcoefV, BcoefU, BcoefV, &
-            ps, u1, v1, gustiness, tsurf_in, &
-            radsol, snow, agesno, &
-            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa &
-#ifdef ISO
-            ,xtprecip_rain, xtprecip_snow, xtspechum,Roce,rlat, &
-            xtsnow,xtevap,h1 &  
-#endif            
-            )
-    END SELECT
-
-    !******************************************************************************
-    ! fcodron: compute lmt_bils  forced case (same as wfbils_oce / 1.-contfracatm)
-    !******************************************************************************
-    IF (type_ocean.NE.'slab') THEN
-       lmt_bils(1:klon)=0.
-       DO i=1,knon
-          lmt_bils(knindex(i))=(swnet(i)+lwnet(i)+fluxsens(i)+fluxlat(i)) &
-               *pctsrf(knindex(i),is_oce)/(1.-zmasq(knindex(i))) 
-       END DO
-    END IF
-
-    !******************************************************************************
-    ! Calculate ocean surface albedo
-    !******************************************************************************
-    !albedo SB >>>
-    IF (iflag_albedo==0) THEN
-       !--old parametrizations of ocean surface albedo
-       !
-       IF (iflag_cycle_diurne.GE.1) THEN
-          !
-          CALL alboc_cd(rmu0,alb_eau)
-          !
-          !--ad-hoc correction for model radiative balance tuning
-          !--now outside alboc_cd routine
-          alb_eau(1:klon) = fmagic*alb_eau(1:klon) + pmagic
-          alb_eau(1:klon)=MIN(MAX(alb_eau(1:klon),0.0),1.0)
-          !
-       ELSE
-          !
-          CALL alboc(REAL(jour),rlat,alb_eau)
-          !--ad-hoc correction for model radiative balance tuning
-          !--now outside alboc routine
-          alb_eau(1:klon) = fmagic*alb_eau(1:klon) + pmagic
-          alb_eau(1:klon)=MIN(MAX(alb_eau(1:klon),0.04),0.60)
-          !
-       ENDIF
-       !
-       DO i =1, knon
-          DO  k=1,nsw
-             alb_dir_new(i,k) = alb_eau(knindex(i))
-          ENDDO
-       ENDDO
-       !IM 09122015 next line corresponds to the old way of doing in LMDZ5A/IPSLCM5A versions 
-       !albedo for diffuse radiation is taken the same as for direct radiation
-       alb_dif_new(1:knon,:)=alb_dir_new(1:knon,:)
-       !IM 09122015 end
-       !
-    ELSE IF (iflag_albedo==1) THEN
-       !--new parametrization of ocean surface albedo by Sunghye Baek
-       !--albedo for direct and diffuse radiation are different
-       !
-       CALL ocean_albedo(knon,rmu0,knindex,windsp,SFRWL,alb_dir_new,alb_dif_new)
-       !
-       !--ad-hoc correction for model radiative balance tuning
-       alb_dir_new(1:knon,:) = fmagic*alb_dir_new(1:knon,:) + pmagic
-       alb_dif_new(1:knon,:) = fmagic*alb_dif_new(1:knon,:) + pmagic
-       alb_dir_new(1:knon,:)=MIN(MAX(alb_dir_new(1:knon,:),0.0),1.0)
-       alb_dif_new(1:knon,:)=MIN(MAX(alb_dif_new(1:knon,:),0.0),1.0)
-       !
-    ELSE IF (iflag_albedo==2) THEN
-       ! F. Codron albedo read from limit.nc
-       CALL limit_read_rug_alb(itime, dtime, jour,&
-            knon, knindex, z0_lim, alb_eau)
-       DO i =1, knon
-          DO  k=1,nsw
-             alb_dir_new(i,k) = alb_eau(i)
-          ENDDO
-       ENDDO
-       alb_dif_new=alb_dir_new
-    ENDIF
-    !albedo SB <<<
-
-    !******************************************************************************
-    ! Calculate the rugosity
-    !******************************************************************************
-    IF (iflag_z0_oce==0) THEN
-       DO i = 1, knon
-          tmp = MAX(cepdu2,gustiness(i)+u1(i)**2+v1(i)**2)
-          z0m(i) = 0.018*cdragm(i) * (gustiness(i)+u1(i)**2+v1(i)**2)/RG  &
-               +  0.11*14e-6 / SQRT(cdragm(i) * tmp)
-          z0m(i) = MAX(1.5e-05,z0m(i))
-       ENDDO
-       z0h(1:knon)=z0m(1:knon) ! En attendant mieux
-
-    ELSE IF (iflag_z0_oce==1) THEN
-       DO i = 1, knon
-          tmp = MAX(cepdu2,gustiness(i)+u1(i)**2+v1(i)**2)
-          z0m(i) = 0.018*cdragm(i) * (gustiness(i)+u1(i)**2+v1(i)**2)/RG  &
-               + 0.11*14e-6 / SQRT(cdragm(i) * tmp)
-          z0m(i) = MAX(1.5e-05,z0m(i))
-          z0h(i)=0.4*14e-6 / SQRT(cdragm(i) * tmp)
-       ENDDO
-    ELSE IF (iflag_z0_oce==-1) THEN
-       DO i = 1, knon
-          z0m(i) = z0min
-          z0h(i) = z0min
-       ENDDO
-    ELSE
-       CALL abort_physic(modname,'version non prevue',1)
-    ENDIF
-
-    if (activate_ocean_skin >= 1) then
-       if (type_ocean /= 'couple') sss(:knon) = 35.
-       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_totsnow(:knon), &
-            hf = - fluxsens(:knon), hlb = - fluxlat(:knon), &
-            rnl = - lwnet(:knon), &
-            tau = sqrt(flux_u1(:knon)**2 + flux_v1(:knon)**2), rhoa = rhoa, &
-            xlv = [(rlvtt, i = 1, knon)], rf = - sens_prec_liq, dtime = dtime, &
-            rns = swnet(:knon))
-       delta_sst = t_int - tsurf_new(:knon)
-       delta_sal = s_int - sss(:knon)
-
-       if (activate_ocean_skin == 2) then
-          tsurf_new(:knon) = t_int
-          if (type_ocean == 'couple') dt_ds = (tks / tkt) * dter
-       end if
-    end if
-    
-  END SUBROUTINE surf_ocean
-  !****************************************************************************
-  !
-END MODULE surf_ocean_mod
+link ../phylmd/surf_ocean_mod.F90
Index: /LMDZ6/branches/cirrus/libf/phylmdiso/surf_seaice_mod.F90
===================================================================
--- /LMDZ6/branches/cirrus/libf/phylmdiso/surf_seaice_mod.F90	(revision 5201)
+++ /LMDZ6/branches/cirrus/libf/phylmdiso/surf_seaice_mod.F90	(revision 5202)
@@ -1,219 +1,1 @@
-!
-! $Id: surf_seaice_mod.F90 3102 2017-12-03 20:27:42Z oboucher $
-!
-MODULE surf_seaice_mod
-
-  IMPLICIT NONE
-
-CONTAINS
-!
-!****************************************************************************************
-!
-  SUBROUTINE surf_seaice( & 
-       rlon, rlat, swnet, lwnet, alb1, fder, &
-       itime, dtime, jour, knon, knindex, &
-       lafin, &
-       tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
-       AcoefH, AcoefQ, BcoefH, BcoefQ, &
-       AcoefU, AcoefV, BcoefU, BcoefV, &
-       ps, u1, v1, gustiness, pctsrf, &
-       snow, qsurf, qsol, agesno, tsoil, &
-       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &  
-       tsurf_new, dflux_s, dflux_l, &
-       flux_u1, flux_v1 &
-#ifdef ISO
-         &      ,xtprecip_rain, xtprecip_snow,xtspechum,Roce, &
-         &      xtsnow,xtsol,xtevap,Rland_ice &
-#endif               
-         &      )
-
-  USE dimphy
-  USE surface_data
-  USE ocean_forced_mod, ONLY : ocean_forced_ice
-  USE ocean_cpl_mod, ONLY    : ocean_cpl_ice
-  USE ocean_slab_mod, ONLY   : ocean_slab_ice
-  USE indice_sol_mod
-#ifdef ISO
-  USE infotrac_phy, ONLY : ntiso,niso
-#endif
-
-!
-! This subroutine will make a call to ocean_XXX_ice according to the ocean mode (force, 
-! slab or couple). The calculation of rugosity for the sea-ice surface is also done
-! in here because it is the same calculation for the different modes of ocean.
-!
-    INCLUDE "dimsoil.h"
-    INCLUDE "clesphys.h"
-
-    INCLUDE "YOMCST.h"
-    ! for rd and retv
-
-! Input arguments
-!****************************************************************************************
-    INTEGER, INTENT(IN)                      :: itime, jour, knon
-    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
-    LOGICAL, INTENT(IN)                      :: lafin
-    REAL, INTENT(IN)                         :: dtime
-    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
-    REAL, DIMENSION(klon), INTENT(IN)        :: swnet  ! net shortwave radiation at surface  
-    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface  
-    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
-    REAL, DIMENSION(klon), INTENT(IN)        :: fder
-    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf
-    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)        :: temp_air, spechum
-    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
-    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
-    REAL, DIMENSION(klon), INTENT(IN)        :: ps
-    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
-    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
-#ifdef ISO
-    REAL, DIMENSION(ntiso,klon), INTENT(IN)        :: xtprecip_rain, xtprecip_snow 
-    REAL, DIMENSION(klon), INTENT(IN)        :: xtspechum
-    REAL, DIMENSION(niso,klon), INTENT(IN)        :: Roce
-    REAL, DIMENSION(niso,klon), INTENT(IN)        :: Rland_ice
-#endif
-
-! In/Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsurf, qsol
-    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
-    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
-#ifdef ISO
-    REAL, DIMENSION(niso,klon), INTENT(INOUT)        :: xtsnow  
-    REAL, DIMENSION(niso,klon), INTENT(IN)        :: xtsol 
-#endif
-
-! Output arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
-!albedo SB >>>
-!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
-!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
-    REAL, DIMENSION(6), INTENT(IN)    :: SFRWL
-    REAL, DIMENSION(klon,nsw), INTENT(OUT)   :: alb_dir_new,alb_dif_new
-!albedo SB <<<
-    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
-    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
-    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l      
-    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
-#ifdef ISO
-    REAL, DIMENSION(ntiso,klon), INTENT(OUT)        :: xtevap  
-#endif
-
-! Local arguments
-!****************************************************************************************
-    REAL, DIMENSION(klon)  :: radsol
-#ifdef ISO
-#ifdef ISOVERIF
-    integer j
-#endif
-#endif
-
-!albedo SB >>>
-    REAL, DIMENSION(klon) :: alb1_new,alb2_new
-!albedo SB <<<
-
-    real rhoa(knon) ! density of moist air  (kg / m3)
-
-! End definitions
-!****************************************************************************************
-
-
-!****************************************************************************************
-! Calculate total net radiance at surface
-!
-!****************************************************************************************
-    radsol(:) = 0.0
-    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
-
-    rhoa = PS(:KNON) / (Rd * temp_air(:knon) * (1. + retv * spechum(:knon)))
-
-!****************************************************************************************
-! Switch according to type of ocean (couple, slab or forced)
-!
-!****************************************************************************************
-    IF (type_ocean == 'couple') THEN
-       
-       CALL ocean_cpl_ice( &
-            rlon, rlat, swnet, lwnet, alb1, & 
-            fder, & 
-            itime, dtime, knon, knindex, &
-            lafin,&
-            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
-            AcoefH, AcoefQ, BcoefH, BcoefQ, &
-            AcoefU, AcoefV, BcoefU, BcoefV, &
-            ps, u1, v1, gustiness, pctsrf, &
-            radsol, snow, qsurf, &
-            alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l, rhoa)
-       
-    ELSE IF (type_ocean == 'slab'.AND.version_ocean=='sicINT') THEN
-       CALL ocean_slab_ice( & 
-          itime, dtime, jour, knon, knindex, &
-          tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
-          AcoefH, AcoefQ, BcoefH, BcoefQ, &
-            AcoefU, AcoefV, BcoefU, BcoefV, &
-          ps, u1, v1, gustiness, &
-          radsol, snow, qsurf, qsol, agesno, &
-          alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-          tsurf_new, dflux_s, dflux_l, swnet)
-
-      ELSE ! type_ocean=force or slab +sicOBS or sicNO
-       CALL ocean_forced_ice( &
-            itime, dtime, jour, knon, knindex, &
-            tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
-            AcoefH, AcoefQ, BcoefH, BcoefQ, &
-            AcoefU, AcoefV, BcoefU, BcoefV, &
-            ps, u1, v1, gustiness, &
-            radsol, snow, qsol, agesno, tsoil, &
-            qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
-            tsurf_new, dflux_s, dflux_l, rhoa &
-#ifdef ISO
-            ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
-            xtsnow, xtsol,xtevap,Rland_ice &  
-#endif            
-            )
-
-    END IF
-
-!****************************************************************************************
-! Calculate rugosity
-!
-!****************************************************************************************
-
-    z0m=z0m_seaice
-    z0h = z0h_seaice
-
-!albedo SB >>>
-     select case(NSW)
-     case(2)
-       alb_dir_new(1:knon,1)=alb1_new(1:knon)
-       alb_dir_new(1:knon,2)=alb2_new(1:knon)
-     case(4)
-       alb_dir_new(1:knon,1)=alb1_new(1:knon)
-       alb_dir_new(1:knon,2)=alb2_new(1:knon)
-       alb_dir_new(1:knon,3)=alb2_new(1:knon)
-       alb_dir_new(1:knon,4)=alb2_new(1:knon)
-     case(6)
-       alb_dir_new(1:knon,1)=alb1_new(1:knon)
-       alb_dir_new(1:knon,2)=alb1_new(1:knon)
-       alb_dir_new(1:knon,3)=alb1_new(1:knon)
-       alb_dir_new(1:knon,4)=alb2_new(1:knon)
-       alb_dir_new(1:knon,5)=alb2_new(1:knon)
-       alb_dir_new(1:knon,6)=alb2_new(1:knon)
-     end select
-alb_dif_new=alb_dir_new
-!albedo SB <<<
-
-
-
-
-  END SUBROUTINE surf_seaice
-!
-!****************************************************************************************
-!
-END MODULE surf_seaice_mod
-
+link ../phylmd/surf_seaice_mod.F90
Index: /LMDZ6/branches/cirrus/makelmdz
===================================================================
--- /LMDZ6/branches/cirrus/makelmdz	(revision 5201)
+++ /LMDZ6/branches/cirrus/makelmdz	(revision 5202)
@@ -32,4 +32,6 @@
 cosp2=false
 cospv2=false
+force_compile=false
+
 
 full=""
@@ -141,4 +143,5 @@
 [-ext_src path]            : path to an additional set of routines to compile with the model
 [-arch_path path]          : path to architecture files (default: $arch_default_path)
+[-force_compile]           : recompile although there seems to be an on-going compilation
  -arch nom_arch            : target architecture 
  exec                      : executable to build
@@ -232,4 +235,7 @@
       "-arch_path")
 	  arch_path=$2 ; arch_path_defined="TRUE"; shift ; shift ;;
+
+      "-force_compile")
+          force_compile=true ; shift ;;
 
       *)
@@ -585,31 +591,22 @@
 if [[ -f dimensions.h ]]
 then
-  echo 'ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs'
-  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
-  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
-  echo  vous pouvez continuer en repondant oui.
-  echo "Voulez-vous vraiment continuer?"
-  echo ""
-  echo "WARNING: you are probably already compiling the model somewhere else."
-  echo "Wait until the first compilation is finished before launching this one."
-  echo "If you are sure that you are not compiling elsewhere, just answer "
-  echo "yes (or 'oui') to the question below to proceed."
-  echo "Do you wish to continue?"
-  read reponse
-  if [[ $reponse == "oui" || $reponse == "yes" ]]
-  then
-    \rm -f $LIBFGCM/grid/dimensions.h
-  else
-    exit
-  fi
-fi
+    if [[ $force_compile == true ]]
+    then
+        \rm -f $LIBFGCM/grid/dimensions.h
+    else
+        echo "WARNING: you are probably already compiling the model somewhere else."
+        echo "Wait until the first compilation is finished before launching this one."
+        echo "If you are sure that you are not compiling elsewhere, "
+        echo "If you are sure that you are not compiling elsewhere, then"
+        echo rm -f $LIBFGCM/grid/dimensions.h
+        echo "before reruning the compilation"
+        echo "or run makelmdz with option -force_compile"
+        exit 1
+    fi
+fi
+
 
 cd $LIBFGCM/grid/dimension
 ./makdim $dim
-if (($? != 0))
-then
-    exit 1
-fi
-
 cat $LIBFGCM/grid/dimensions.h
 cd $LMDGCM
Index: /LMDZ6/branches/cirrus/makelmdz_fcm
===================================================================
--- /LMDZ6/branches/cirrus/makelmdz_fcm	(revision 5201)
+++ /LMDZ6/branches/cirrus/makelmdz_fcm	(revision 5202)
@@ -474,17 +474,16 @@
 then
    CPP_KEY="$CPP_KEY CPP_INLANDSIS"
-   INLANDSIS_PATH="$LIBFGCM/%PHYS/inlandsis"
-fi
-
+   INLANDSIS_PATH="$LIBFGCM/phy${physique}/inlandsis"
+fi
 
 if [[ "$rad" == "rrtm" ]]
 then
    CPP_KEY="$CPP_KEY CPP_RRTM"
-   RAD_PATH="$LIBFGCM/%PHYS/rrtm"
+   RAD_PATH="$LIBFGCM/phy${physique}/rrtm"
 fi
 if [[ "$rad" == "ecrad" ]]
 then
    CPP_KEY="$CPP_KEY CPP_ECRAD"
-   RAD_PATH="$LIBFGCM/%PHYS/ecrad"
+   RAD_PATH="$LIBFGCM/phy${physique}/ecrad"
 fi
 
@@ -492,5 +491,5 @@
 then
    CPP_KEY="$CPP_KEY CPP_Dust"
-   DUST_PATH="$LIBFGCM/%PHYS/Dust"
+   DUST_PATH="$LIBFGCM/phy${physique}/Dust"
 fi
 
@@ -498,5 +497,5 @@
 then
    CPP_KEY="$CPP_KEY CPP_StratAer"
-   STRATAER_PATH="$LIBFGCM/%PHYS/StratAer"
+   STRATAER_PATH="$LIBFGCM/phy${physique}/StratAer"
 fi
 
@@ -577,13 +576,17 @@
     if [[ $force_compile == true ]]
     then
-	\rm -f $LIBFGCM/grid/dimensions.h
+        \rm -f $LIBFGCM/grid/dimensions.h
     else
-	echo "WARNING: you are probably already compiling the model somewhere else."
-	echo "Wait until the first compilation is finished before launching this one."
-	echo "If you are sure that you are not compiling elsewhere, "
-	echo "run makelmdz_fcm with option -force_compile"
-	exit 1
+        echo "WARNING: you are probably already compiling the model somewhere else."
+        echo "Wait until the first compilation is finished before launching this one."
+        echo "If you are sure that you are not compiling elsewhere, "
+        echo "If you are sure that you are not compiling elsewhere, then"
+        echo rm -f $LIBFGCM/grid/dimensions.h
+        echo "before reruning the compilation"
+        echo "or run makelmdz_fcm with option -force_compile"
+        exit 1
     fi
 fi
+
 
 
