Index: LMDZ5/branches/testing/DefLists/field_def_lmdz.xml
===================================================================
--- LMDZ5/branches/testing/DefLists/field_def_lmdz.xml	(revision 2220)
+++ LMDZ5/branches/testing/DefLists/field_def_lmdz.xml	(revision 2258)
@@ -25,4 +25,5 @@
         <field id="t2m_oce"    long_name="Temp 2m oce"    unit="K" />
         <field id="t2m_sic"    long_name="Temp 2m sic"    unit="K" />
+        <field id="gusts"    long_name="surface gustiness"    unit="m2/s2" />
         <field id="wind10m"    long_name="10-m wind speed"      unit="m/s" />
         <field id="wind10max"  long_name="10m wind speed max"   unit="m/s" />
@@ -107,4 +108,8 @@
         <field id="bils_enthalp"    long_name="Surf. total heat flux"    unit="W/m2" />
         <field id="bils_latent"    long_name="Surf. total heat flux"    unit="W/m2" />
+	<field id="bils_ech"    long_name="peu importe"    unit="W/m2" />
+	<field id="du_gwd_rando"    long_name="peu importe"    unit="W/m2" />
+	<field id="dv_gwd_rando"    long_name="peu importe"    unit="W/m2" />
+	<field id="vstr_gwd_rando"    long_name="peu importe"    unit="W/m2" />
         <field id="sens"    long_name="Sensible heat flux"    unit="W/m2" />
         <field id="fder"    long_name="Heat flux derivation"    unit="W/m2" />
@@ -179,5 +184,5 @@
         <field id="ptop"    long_name="Cld top pressure"    unit="Pa" />
         <field id="fbase"    long_name="Cld base mass flux"    unit="kg/m2/s" />
-        <field id="plcl"    long_name="Lifting Condensation Level"    unit="hPa" />
+        <field id="plcl"    long_name="Lifting Condensation Level"    unit="hPa" enabled=".false." />
         <field id="plfc"    long_name="Level of Free Convection"    unit="hPa" />
         <field id="wbeff"    long_name="Conv. updraft velocity at LFC (inf100)"    unit="m/s" />
@@ -277,4 +282,6 @@
         <field id="dtsvdfi"    long_name="Boundary-layer dTs(g)"    unit="K/s" />
         <field id="rugs"    long_name="rugosity"    unit="-" />
+        <field id="z0m"    long_name="roughness length, momentum"    unit="-" />
+        <field id="z0h"    long_name="roughness length, enthalpy"    unit="-" />
         <field id="topswad"    long_name="ADE at TOA"    unit="W/m2" />
         <field id="topswad0"    long_name="ADE clear-sky at TOA"    unit="W/m2" />
@@ -344,8 +351,20 @@
         <field id="ages_oce"    long_name="Snow age oce"    unit="day" />
         <field id="ages_sic"    long_name="Snow age sic"    unit="day" />
+        <field id="snow_ter"    long_name="Snow"    unit="kg/m2" />
+        <field id="snow_lic"    long_name="Snow"    unit="kg/m2" />
+        <field id="snow_oce"    long_name="Snow"    unit="kg/m2" />
+        <field id="snow_sic"    long_name="Snow"    unit="kg/m2" />
         <field id="rugs_ter"    long_name="Surface roughness ter"    unit="m" />
         <field id="rugs_lic"    long_name="Surface roughness lic"    unit="m" />
         <field id="rugs_oce"    long_name="Surface roughness oce"    unit="m" />
         <field id="rugs_sic"    long_name="Surface roughness sic"    unit="m" />
+        <field id="z0m_ter"    long_name="roughness length, momentum ter"    unit="m" />
+        <field id="z0m_lic"    long_name="roughness length, momentum lic"    unit="m" />
+        <field id="z0m_oce"    long_name="roughness length, momentum oce"    unit="m" />
+        <field id="z0m_sic"    long_name="roughness length, momentum sic"    unit="m" />
+        <field id="z0h_ter"    long_name="roughness length, enthalpy ter"    unit="m" />
+        <field id="z0h_lic"    long_name="roughness length, enthalpy lic"    unit="m" />
+        <field id="z0h_oce"    long_name="roughness length, enthalpy oce"    unit="m" />
+        <field id="z0h_sic"    long_name="roughness length, enthalpy sic"    unit="m" />
         <field id="alb1"    long_name="Surface VIS albedo"    unit="-" />
         <field id="alb2"    long_name="Surface Near IR albedo"    unit="-" />
@@ -375,4 +394,8 @@
         <field id="tke_max_oce"    long_name="Max Turb. Kinetic Energy oce"    unit="-" />
         <field id="tke_max_sic"    long_name="Max Turb. Kinetic Energy sic"    unit="-" />
+        <field id="dltpbltke_ter"    long_name="TKE difference (w - x)"    unit="-" />
+        <field id="dltpbltke_lic"    long_name="TKE difference (w - x)"    unit="-" />
+        <field id="dltpbltke_oce"    long_name="TKE difference (w - x)"    unit="-" />
+        <field id="dltpbltke_sic"    long_name="TKE difference (w - x)"    unit="-" />
         <field id="cldtau"    long_name="Cloud optical thickness"    unit="1" />
         <field id="cldemi"    long_name="Cloud optical emissivity"    unit="1" />
Index: LMDZ5/branches/testing/DefLists/file_def_histLES_lmdz.xml
===================================================================
--- LMDZ5/branches/testing/DefLists/file_def_histLES_lmdz.xml	(revision 2220)
+++ LMDZ5/branches/testing/DefLists/file_def_histLES_lmdz.xml	(revision 2258)
@@ -27,4 +27,5 @@
                 <field field_ref="t2m_oce" level="10" />
                 <field field_ref="t2m_sic" level="10" />
+                <field field_ref="gusts" level="10" />
                 <field field_ref="wind10m" level="10" />
                 <field field_ref="wind10max" level="10" operation="maximum" />
@@ -286,4 +287,6 @@
                 <field field_ref="dtsvdfi" level="10" />
                 <field field_ref="rugs" level="10" />
+                <field field_ref="z0m" level="10" />
+                <field field_ref="z0h" level="10" />
                 <field field_ref="topswad" level="10" />
                 <field field_ref="topswad0" level="10" />
@@ -345,8 +348,20 @@
                 <field field_ref="ages_oce" level="10" />
                 <field field_ref="ages_sic" level="10" />
+                <field field_ref="snow_ter" level="10" />
+                <field field_ref="snow_lic" level="10" />
+                <field field_ref="snow_oce" level="10" />
+                <field field_ref="snow_sic" level="10" />
                 <field field_ref="rugs_ter" level="10" />
                 <field field_ref="rugs_lic" level="10" />
                 <field field_ref="rugs_oce" level="10" />
                 <field field_ref="rugs_sic" level="10" />
+                <field field_ref="z0m_ter" level="10" />
+                <field field_ref="z0m_lic" level="10" />
+                <field field_ref="z0m_oce" level="10" />
+                <field field_ref="z0m_sic" level="10" />
+                <field field_ref="z0h_ter" level="10" />
+                <field field_ref="z0h_lic" level="10" />
+                <field field_ref="z0h_oce" level="10" />
+                <field field_ref="z0h_sic" level="10" />
                 <field field_ref="alb1" level="10" />
                 <field field_ref="alb2" level="10" />
Index: LMDZ5/branches/testing/DefLists/file_def_histday_lmdz.xml
===================================================================
--- LMDZ5/branches/testing/DefLists/file_def_histday_lmdz.xml	(revision 2220)
+++ LMDZ5/branches/testing/DefLists/file_def_histday_lmdz.xml	(revision 2258)
@@ -1,5 +1,5 @@
 <file_definition>
     <file_group id="defile">
-        <file id="histday" name="Xhistday" output_freq="1d" output_level="5" enabled=".FALSE.">
+        <file id="histday" name="histday" output_freq="1d" output_level="2" enabled=".FALSE.">
             
             <!-- VARS 1D -->
@@ -27,4 +27,5 @@
                 <field field_ref="t2m_oce" level="6" />
                 <field field_ref="t2m_sic" level="6" />
+                <field field_ref="gusts" level="1" />
                 <field field_ref="wind10m" level="1" />
                 <field field_ref="wind10max" level="1" operation="maximum" />
@@ -286,4 +287,6 @@
                 <field field_ref="dtsvdfi" level="10" />
                 <field field_ref="rugs" level="10" />
+                <field field_ref="z0m" level="10" />
+                <field field_ref="z0h" level="10" />
                 <field field_ref="topswad" level="10" />
                 <field field_ref="topswad0" level="10" />
@@ -345,8 +348,20 @@
                 <field field_ref="ages_oce" level="10" />
                 <field field_ref="ages_sic" level="10" />
+                <field field_ref="snow_ter" level="10" />
+                <field field_ref="snow_lic" level="10" />
+                <field field_ref="snow_oce" level="10" />
+                <field field_ref="snow_sic" level="10" />
                 <field field_ref="rugs_ter" level="6" />
                 <field field_ref="rugs_lic" level="6" />
                 <field field_ref="rugs_oce" level="6" />
                 <field field_ref="rugs_sic" level="6" />
+                <field field_ref="z0m_ter" level="6" />
+                <field field_ref="z0m_lic" level="6" />
+                <field field_ref="z0m_oce" level="6" />
+                <field field_ref="z0m_sic" level="6" />
+                <field field_ref="z0h_ter" level="6" />
+                <field field_ref="z0h_lic" level="6" />
+                <field field_ref="z0h_oce" level="6" />
+                <field field_ref="z0h_sic" level="6" />
                 <field field_ref="alb1" level="10" />
                 <field field_ref="alb2" level="10" />
Index: LMDZ5/branches/testing/DefLists/file_def_histhf_lmdz.xml
===================================================================
--- LMDZ5/branches/testing/DefLists/file_def_histhf_lmdz.xml	(revision 2220)
+++ LMDZ5/branches/testing/DefLists/file_def_histhf_lmdz.xml	(revision 2258)
@@ -1,5 +1,5 @@
 <file_definition>
     <file_group id="defile">
-        <file id="histhf" name="Xhisthf" output_freq="1h" output_level="5" enabled=".FALSE.">
+        <file id="histhf" name="histhf" output_freq="6h" output_level="5" enabled=".FALSE.">
             
             <!-- VARS 1D -->
@@ -27,4 +27,5 @@
                 <field field_ref="t2m_oce" level="10" />
                 <field field_ref="t2m_sic" level="10" />
+                <field field_ref="gusts" level="10" />
                 <field field_ref="wind10m" level="10" />
                 <field field_ref="wind10max" level="10" operation="maximum" />
@@ -286,4 +287,6 @@
                 <field field_ref="dtsvdfi" level="10" />
                 <field field_ref="rugs" level="10" />
+                <field field_ref="z0m" level="10" />
+                <field field_ref="z0h" level="10" />
                 <field field_ref="topswad" level="10" />
                 <field field_ref="topswad0" level="10" />
@@ -345,8 +348,20 @@
                 <field field_ref="ages_oce" level="10" />
                 <field field_ref="ages_sic" level="10" />
+                <field field_ref="snow_ter" level="10" />
+                <field field_ref="snow_lic" level="10" />
+                <field field_ref="snow_oce" level="10" />
+                <field field_ref="snow_sic" level="10" />
                 <field field_ref="rugs_ter" level="10" />
                 <field field_ref="rugs_lic" level="10" />
                 <field field_ref="rugs_oce" level="10" />
                 <field field_ref="rugs_sic" level="10" />
+                <field field_ref="z0m_ter" level="10" />
+                <field field_ref="z0m_lic" level="10" />
+                <field field_ref="z0m_oce" level="10" />
+                <field field_ref="z0m_sic" level="10" />
+                <field field_ref="z0h_ter" level="10" />
+                <field field_ref="z0h_lic" level="10" />
+                <field field_ref="z0h_oce" level="10" />
+                <field field_ref="z0h_sic" level="10" />
                 <field field_ref="alb1" level="10" />
                 <field field_ref="alb2" level="10" />
Index: LMDZ5/branches/testing/DefLists/file_def_histins_lmdz.xml
===================================================================
--- LMDZ5/branches/testing/DefLists/file_def_histins_lmdz.xml	(revision 2220)
+++ LMDZ5/branches/testing/DefLists/file_def_histins_lmdz.xml	(revision 2258)
@@ -27,4 +27,5 @@
                 <field field_ref="t2m_oce" level="10" />
                 <field field_ref="t2m_sic" level="10" />
+                <field field_ref="gusts" level="1" />
                 <field field_ref="wind10m" level="1" />
                 <field field_ref="wind10max" level="10" operation="maximum" />
@@ -286,4 +287,6 @@
                 <field field_ref="dtsvdfi" level="10" />
                 <field field_ref="rugs" level="10" />
+                <field field_ref="z0m" level="10" />
+                <field field_ref="z0h" level="10" />
                 <field field_ref="topswad" level="10" />
                 <field field_ref="topswad0" level="10" />
@@ -345,8 +348,20 @@
                 <field field_ref="ages_oce" level="10" />
                 <field field_ref="ages_sic" level="10" />
+                <field field_ref="snow_ter" level="10" />
+                <field field_ref="snow_lic" level="10" />
+                <field field_ref="snow_oce" level="10" />
+                <field field_ref="snow_sic" level="10" />
                 <field field_ref="rugs_ter" level="10" />
                 <field field_ref="rugs_lic" level="10" />
                 <field field_ref="rugs_oce" level="10" />
                 <field field_ref="rugs_sic" level="10" />
+                <field field_ref="z0m_ter" level="10" />
+                <field field_ref="z0m_lic" level="10" />
+                <field field_ref="z0m_oce" level="10" />
+                <field field_ref="z0m_sic" level="10" />
+                <field field_ref="z0h_ter" level="10" />
+                <field field_ref="z0h_lic" level="10" />
+                <field field_ref="z0h_oce" level="10" />
+                <field field_ref="z0h_sic" level="10" />
                 <field field_ref="alb1" level="10" />
                 <field field_ref="alb2" level="10" />
Index: LMDZ5/branches/testing/DefLists/file_def_histmth_lmdz.xml
===================================================================
--- LMDZ5/branches/testing/DefLists/file_def_histmth_lmdz.xml	(revision 2220)
+++ LMDZ5/branches/testing/DefLists/file_def_histmth_lmdz.xml	(revision 2258)
@@ -1,5 +1,5 @@
 <file_definition>
         <file_group id="defile">
-        <file id="histmth" name="Xhistmth" output_freq="5d" output_level="10"  enabled=".FALSE.">
+        <file id="histmth" name="histmth" output_freq="1d" output_level="5"  enabled=".FALSE.">
 
             <!-- VARS 1D -->
@@ -27,4 +27,5 @@
                 <field field_ref="t2m_oce" level="10" />
                 <field field_ref="t2m_sic" level="10" />
+                <field field_ref="gusts" level="1" />
                 <field field_ref="wind10m" level="1" />
                 <field field_ref="wind10max" level="10" operation="maximum" />
@@ -286,4 +287,6 @@
                 <field field_ref="dtsvdfi" level="10" />
                 <field field_ref="rugs" level="10" />
+                <field field_ref="z0m" level="10" />
+                <field field_ref="z0h" level="10" />
                 <field field_ref="topswad" level="2" />
                 <field field_ref="topswad0" level="2" />
@@ -345,8 +348,20 @@
                 <field field_ref="ages_oce" level="10" />
                 <field field_ref="ages_sic" level="3" />
+                <field field_ref="snow_ter" level="10" />
+                <field field_ref="snow_lic" level="3" />
+                <field field_ref="snow_oce" level="10" />
+                <field field_ref="snow_sic" level="3" />
                 <field field_ref="rugs_ter" level="3" />
                 <field field_ref="rugs_lic" level="3" />
                 <field field_ref="rugs_oce" level="3" />
                 <field field_ref="rugs_sic" level="3" />
+                <field field_ref="z0m_ter" level="3" />
+                <field field_ref="z0m_lic" level="3" />
+                <field field_ref="z0m_oce" level="3" />
+                <field field_ref="z0m_sic" level="3" />
+                <field field_ref="z0h_ter" level="3" />
+                <field field_ref="z0h_lic" level="3" />
+                <field field_ref="z0h_oce" level="3" />
+                <field field_ref="z0h_sic" level="3" />
                 <field field_ref="alb1" level="3" />
                 <field field_ref="alb2" level="3" />
Index: LMDZ5/branches/testing/DefLists/file_def_histstn_lmdz.xml
===================================================================
--- LMDZ5/branches/testing/DefLists/file_def_histstn_lmdz.xml	(revision 2220)
+++ LMDZ5/branches/testing/DefLists/file_def_histstn_lmdz.xml	(revision 2258)
@@ -27,4 +27,5 @@
                 <field field_ref="t2m_oce" level="10" />
                 <field field_ref="t2m_sic" level="10" />
+                <field field_ref="gusts" level="10" />
                 <field field_ref="wind10m" level="10" />
                 <field field_ref="wind10max" level="10" />
@@ -286,4 +287,6 @@
                 <field field_ref="dtsvdfi" level="10" />
                 <field field_ref="rugs" level="10" />
+                <field field_ref="z0m" level="10" />
+                <field field_ref="z0h" level="10" />
                 <field field_ref="topswad" level="10" />
                 <field field_ref="topswad0" level="10" />
@@ -345,8 +348,20 @@
                 <field field_ref="ages_oce" level="10" />
                 <field field_ref="ages_sic" level="10" />
+                <field field_ref="snow_ter" level="10" />
+                <field field_ref="snow_lic" level="10" />
+                <field field_ref="snow_oce" level="10" />
+                <field field_ref="snow_sic" level="10" />
                 <field field_ref="rugs_ter" level="10" />
                 <field field_ref="rugs_lic" level="10" />
                 <field field_ref="rugs_oce" level="10" />
                 <field field_ref="rugs_sic" level="10" />
+                <field field_ref="z0m_ter" level="10" />
+                <field field_ref="z0m_lic" level="10" />
+                <field field_ref="z0m_oce" level="10" />
+                <field field_ref="z0m_sic" level="10" />
+                <field field_ref="z0h_ter" level="10" />
+                <field field_ref="z0h_lic" level="10" />
+                <field field_ref="z0h_oce" level="10" />
+                <field field_ref="z0h_sic" level="10" />
                 <field field_ref="alb1" level="10" />
                 <field field_ref="alb2" level="10" />
Index: LMDZ5/branches/testing/arch/arch-X64_ADA.fcm
===================================================================
--- LMDZ5/branches/testing/arch/arch-X64_ADA.fcm	(revision 2220)
+++ LMDZ5/branches/testing/arch/arch-X64_ADA.fcm	(revision 2258)
@@ -7,6 +7,7 @@
 %BASE_FFLAGS         -auto -mcmodel=large -integer-size 32 -real-size 64 -align all 
 %PROD_FFLAGS         -O2 -ip -fp-model strict -axAVX,SSE4.2
-%DEV_FFLAGS          -p -g -O1 -fpe0 -traceback
+%DEV_FFLAGS          -p -g -O0 -fpe0 -traceback
 %DEBUG_FFLAGS        -p -g -O0 -fpe-all=0 -traceback -ftrapuv -fp-stack-check -check all -debug
+#%DEBUG_FFLAGS        -p -g -O0 -fpe-all=0 -traceback -ftrapuv -fp-stack-check -debug
 %MPI_FFLAGS
 %OMP_FFLAGS          -openmp
Index: LMDZ5/branches/testing/libf/bibio/arth.F90
===================================================================
--- LMDZ5/branches/testing/libf/bibio/arth.F90	(revision 2220)
+++ 	(revision )
@@ -1,82 +1,0 @@
-MODULE arth_m
-
-  IMPLICIT NONE
-
-  INTEGER, PARAMETER, private:: NPAR_ARTH=16, NPAR2_ARTH=8
-
-  INTERFACE arth
-     ! Returns an arithmetic progression, given a first term "first", an
-     ! increment and a number of terms "n".
-
-     MODULE PROCEDURE arth_r, arth_i
-     ! The difference between the procedures is the type of
-     ! arguments "first" and "increment" and of function result.
-  END INTERFACE
-
-  private arth_r, arth_i
-
-CONTAINS
-
-  pure FUNCTION arth_r(first,increment,n)
-
-    REAL, INTENT(IN) :: first,increment
-    INTEGER, INTENT(IN) :: n
-    REAL, DIMENSION(n) :: arth_r
-
-    ! Variables local to the procedure:
-
-    INTEGER :: k,k2
-    REAL :: temp
-
-    !---------------------------------------
-
-    if (n > 0) arth_r(1)=first
-    if (n <= NPAR_ARTH) then
-       do k=2,n
-          arth_r(k)=arth_r(k-1)+increment
-       end do
-    else
-       do k=2,NPAR2_ARTH
-          arth_r(k)=arth_r(k-1)+increment
-       end do
-       temp=increment*NPAR2_ARTH
-       k=NPAR2_ARTH
-       do
-          if (k >= n) exit
-          k2=k+k
-          arth_r(k+1:min(k2,n)) = temp + arth_r(1:min(k,n-k))
-          temp=temp+temp
-          k=k2
-       end do
-    end if
-  END FUNCTION arth_r
-
-  !*************************************
-
-  pure FUNCTION arth_i(first,increment,n)
-
-    INTEGER, INTENT(IN) :: first,increment,n
-    INTEGER, DIMENSION(n) :: arth_i
-    INTEGER :: k,k2,temp
-    if (n > 0) arth_i(1)=first
-    if (n <= NPAR_ARTH) then
-       do k=2,n
-          arth_i(k)=arth_i(k-1)+increment
-       end do
-    else
-       do k=2,NPAR2_ARTH
-          arth_i(k)=arth_i(k-1)+increment
-       end do
-       temp=increment*NPAR2_ARTH
-       k=NPAR2_ARTH
-       do
-          if (k >= n) exit
-          k2=k+k
-          arth_i(k+1:min(k2,n))=temp+arth_i(1:min(k,n-k))
-          temp=temp+temp
-          k=k2
-       end do
-    end if
-  END FUNCTION arth_i
-
-END MODULE arth_m
Index: LMDZ5/branches/testing/libf/bibio/arth_m.F90
===================================================================
--- LMDZ5/branches/testing/libf/bibio/arth_m.F90	(revision 2258)
+++ LMDZ5/branches/testing/libf/bibio/arth_m.F90	(revision 2258)
@@ -0,0 +1,88 @@
+MODULE arth_m
+
+  IMPLICIT NONE
+
+  INTEGER, PARAMETER, private:: NPAR_ARTH=16, NPAR2_ARTH=8
+
+  INTERFACE arth
+     ! Returns an arithmetic progression, given a first term "first", an
+     ! increment and a number of terms "n" (including "first").
+
+     MODULE PROCEDURE arth_r, arth_i
+     ! The difference between the procedures is the kind and type of
+     ! arguments first and increment and of function result.
+  END INTERFACE
+
+  private arth_r, arth_i
+
+CONTAINS
+
+  pure FUNCTION arth_r(first,increment,n)
+
+    REAL, INTENT(IN) :: first,increment
+    INTEGER, INTENT(IN) :: n
+    REAL arth_r(n)
+
+    ! Local:
+    INTEGER :: k,k2
+    REAL :: temp
+
+    !---------------------------------------
+
+    if (n > 0) arth_r(1)=first
+    if (n <= NPAR_ARTH) then
+       do k=2,n
+          arth_r(k)=arth_r(k-1)+increment
+       end do
+    else
+       do k=2,NPAR2_ARTH
+          arth_r(k)=arth_r(k-1)+increment
+       end do
+       temp=increment*NPAR2_ARTH
+       k=NPAR2_ARTH
+       do
+          if (k >= n) exit
+          k2=k+k
+          arth_r(k+1:min(k2,n)) = temp + arth_r(1:min(k,n-k))
+          temp=temp+temp
+          k=k2
+       end do
+    end if
+
+  END FUNCTION arth_r
+
+  !*************************************
+
+  pure FUNCTION arth_i(first,increment,n)
+
+    INTEGER, INTENT(IN) :: first,increment,n
+    INTEGER arth_i(n)
+
+    ! Local:
+    INTEGER :: k,k2,temp
+
+    !---------------------------------------
+
+    if (n > 0) arth_i(1)=first
+    if (n <= NPAR_ARTH) then
+       do k=2,n
+          arth_i(k)=arth_i(k-1)+increment
+       end do
+    else
+       do k=2,NPAR2_ARTH
+          arth_i(k)=arth_i(k-1)+increment
+       end do
+       temp=increment*NPAR2_ARTH
+       k=NPAR2_ARTH
+       do
+          if (k >= n) exit
+          k2=k+k
+          arth_i(k+1:min(k2,n))=temp+arth_i(1:min(k,n-k))
+          temp=temp+temp
+          k=k2
+       end do
+    end if
+
+  END FUNCTION arth_i
+
+END MODULE arth_m
Index: LMDZ5/branches/testing/libf/bibio/nrtype.F90
===================================================================
--- LMDZ5/branches/testing/libf/bibio/nrtype.F90	(revision 2258)
+++ LMDZ5/branches/testing/libf/bibio/nrtype.F90	(revision 2258)
@@ -0,0 +1,22 @@
+MODULE nrtype
+
+  implicit none
+
+  integer, parameter:: k8 = selected_real_kind(13)
+
+  ! Frequently used mathematical constants (with precision to spare):
+
+  REAL, PARAMETER :: PI=3.141592653589793238462643383279502884197
+  REAL, PARAMETER :: PIO2=1.57079632679489661923132169163975144209858
+  REAL, PARAMETER :: TWOPI=6.283185307179586476925286766559005768394
+  REAL, PARAMETER :: SQRT2=1.41421356237309504880168872420969807856967
+  REAL, PARAMETER :: EULER=0.5772156649015328606065120900824024310422
+
+  REAL(K8), PARAMETER:: &
+       PI_D = 3.141592653589793238462643383279502884197_k8
+  REAL(K8), PARAMETER:: &
+       PIO2_D=1.57079632679489661923132169163975144209858_k8
+  REAL(K8), PARAMETER:: &
+       TWOPI_D=6.283185307179586476925286766559005768394_k8
+
+END MODULE nrtype
Index: LMDZ5/branches/testing/libf/dyn3d/calfis.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/calfis.F	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3d/calfis.F	(revision 2258)
@@ -21,5 +21,4 @@
      $                  pdq,
      $                  flxw,
-     $                  clesphy0,
      $                  pdufi,
      $                  pdvfi,
@@ -131,7 +130,4 @@
       REAL,INTENT(OUT) :: pdpsfi(iip1,jjp1) ! tendency on surface pressure (Pa/s)
 
-      INTEGER,PARAMETER :: longcles = 20
-      REAL,INTENT(IN) :: clesphy0( longcles ) ! unused
-
 
 c    Local variables :
@@ -465,5 +461,4 @@
      .             zphis,
      .             presnivs,
-     .             clesphy0,
      .             zufi,
      .             zvfi,
Index: LMDZ5/branches/testing/libf/dyn3d/ce0l.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/ce0l.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3d/ce0l.F90	(revision 2258)
@@ -41,11 +41,9 @@
 #include "temps.h"
 #include "logic.h"
-  INTEGER, PARAMETER            :: longcles=20
-  REAL,    DIMENSION(longcles)  :: clesphy0
   REAL,    DIMENSION(iip1,jjp1) :: masque
   CHARACTER(LEN=15)             :: calnd
   REAL,    DIMENSION(iip1,jjp1) :: phis ! geopotentiel au sol
 !-------------------------------------------------------------------------------
-  CALL conf_gcm( 99, .TRUE. , clesphy0 )
+  CALL conf_gcm( 99, .TRUE. )
 
   CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
Index: LMDZ5/branches/testing/libf/dyn3d/conf_gcm.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/conf_gcm.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3d/conf_gcm.F90	(revision 2258)
@@ -2,5 +2,5 @@
 ! $Id$
 
-SUBROUTINE conf_gcm( tapedef, etatinit, clesphy0 )
+SUBROUTINE conf_gcm( tapedef, etatinit )
 
   USE control_mod
@@ -23,12 +23,7 @@
   !     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para- 
   !     -metres  du zoom  avec  celles lues sur le fichier start .
-  !      clesphy0 :  sortie  .
-
-  LOGICAL etatinit
-  INTEGER tapedef
-
-  INTEGER        longcles
-  PARAMETER(     longcles = 20 )
-  REAL clesphy0( longcles )
+
+  LOGICAL,INTENT(IN) :: etatinit
+  INTEGER,INTENT(IN) :: tapedef
 
   !   Declarations :
@@ -41,7 +36,4 @@
   include "temps.h"
   include "comconst.h"
-
-  ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
-  ! include "clesphys.h"
   include "iniprint.h"
 
@@ -381,8 +373,4 @@
   ip_ebil_dyn = 0
   CALL getin('ip_ebil_dyn',ip_ebil_dyn)
-
-  DO i = 1, longcles
-     clesphy0(i) = 0.
-  ENDDO
 
   !cc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
@@ -734,6 +722,7 @@
      !Config  Help = extension en longitude  de la zone du zoom  
      !Config         ( fraction de la zone totale)
-     dzoomx = 0.0
+     dzoomx = 0.2
      CALL getin('dzoomx',dzoomx)
+     call assert(dzoomx < 1, "conf_gcm: dzoomx must be < 1")
 
      !Config  Key  = dzoomy
@@ -742,6 +731,7 @@
      !Config  Help = extension en latitude de la zone  du zoom  
      !Config         ( fraction de la zone totale)
-     dzoomy = 0.0
+     dzoomy = 0.2
      CALL getin('dzoomy',dzoomy)
+     call assert(dzoomy< 1, "conf_gcm: dzoomy must be < 1")
 
      !Config  Key  = taux
Index: LMDZ5/branches/testing/libf/dyn3d/fxhyp.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/fxhyp.F	(revision 2220)
+++ 	(revision )
@@ -1,470 +1,0 @@
-!
-! $Id$
-!
-c
-c
-       SUBROUTINE fxhyp ( xzoomdeg,grossism,dzooma,tau ,
-     , rlonm025,xprimm025,rlonv,xprimv,rlonu,xprimu,rlonp025,xprimp025,
-     , champmin,champmax                                               )
-
-c      Auteur :  P. Le Van 
-
-       IMPLICIT NONE
-
-c    Calcule les longitudes et derivees dans la grille du GCM pour une
-c     fonction f(x) a tangente  hyperbolique  .
-c
-c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois,etc.)
-c     dzoom  etant  la distance totale de la zone du zoom
-c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom
-c
-c    On doit avoir grossism x dzoom <  pi ( radians )   , en longitude.
-c   ********************************************************************
-
-
-       INTEGER nmax, nmax2
-       PARAMETER (  nmax = 30000, nmax2 = 2*nmax )
-c
-       LOGICAL scal180
-       PARAMETER ( scal180 = .TRUE. )
-
-c      scal180 = .TRUE.  si on veut avoir le premier point scalaire pour   
-c      une grille reguliere ( grossism = 1.,tau=0.,clon=0. ) a -180. degres.
-c      sinon scal180 = .FALSE.
-
-#include "dimensions.h"
-#include "paramet.h"
-       
-c     ......  arguments  d'entree   .......
-c
-       REAL xzoomdeg,dzooma,tau,grossism
-
-c    ......   arguments  de  sortie  ......
-
-       REAL rlonm025(iip1),xprimm025(iip1),rlonv(iip1),xprimv(iip1),
-     ,  rlonu(iip1),xprimu(iip1),rlonp025(iip1),xprimp025(iip1)
-
-c     .... variables locales  ....
-c
-       REAL   dzoom
-       REAL(KIND=8) xlon(iip1),xprimm(iip1),xuv
-       REAL(KIND=8) xtild(0:nmax2)
-       REAL(KIND=8) fhyp(0:nmax2),ffdx,beta,Xprimt(0:nmax2)
-       REAL(KIND=8) Xf(0:nmax2),xxpr(0:nmax2)
-       REAL(KIND=8) xvrai(iip1),xxprim(iip1) 
-       REAL(KIND=8) pi,depi,epsilon,xzoom,fa,fb
-       REAL(KIND=8) Xf1, Xfi , a0,a1,a2,a3,xi2
-       INTEGER i,it,ik,iter,ii,idif,ii1,ii2
-       REAL(KIND=8) xi,xo1,xmoy,xlon2,fxm,Xprimin
-       REAL(KIND=8) champmin,champmax,decalx
-       INTEGER is2
-       SAVE is2
-
-       REAL(KIND=8) heavyside
-
-       pi       = 2. * ASIN(1.)
-       depi     = 2. * pi
-       epsilon  = 1.e-3
-       xzoom    = xzoomdeg * pi/180. 
-c
-       if (iim==1) then
-
-          rlonm025(1)=-pi/2.
-          rlonv(1)=0.
-          rlonu(1)=pi
-          rlonp025(1)=pi/2.
-          rlonm025(2)=rlonm025(1)+depi
-          rlonv(2)=rlonv(1)+depi
-          rlonu(2)=rlonu(1)+depi
-          rlonp025(2)=rlonp025(1)+depi
-
-          xprimm025(:)=1.
-          xprimv(:)=1.
-          xprimu(:)=1.
-          xprimp025(:)=1.
-          champmin=depi
-          champmax=depi
-          return
-
-       endif
-
-           decalx   = .75
-       IF( grossism.EQ.1..AND.scal180 )  THEN
-           decalx   = 1.
-       ENDIF
-
-       WRITE(6,*) 'FXHYP scal180,decalx', scal180,decalx
-c
-       IF( dzooma.LT.1.)  THEN
-         dzoom = dzooma * depi
-       ELSEIF( dzooma.LT. 25. ) THEN
-         WRITE(6,*) ' Le param. dzoomx pour fxhyp est trop petit ! L aug
-     ,menter et relancer ! '
-         STOP 1
-       ELSE
-         dzoom = dzooma * pi/180.
-       ENDIF
-
-       WRITE(6,*) ' xzoom( rad.),grossism,tau,dzoom (radians)'
-       WRITE(6,24) xzoom,grossism,tau,dzoom
-
-       DO i = 0, nmax2 
-        xtild(i) = - pi + REAL(i) * depi /nmax2
-       ENDDO
-
-       DO i = nmax, nmax2
-
-       fa  = tau*  ( dzoom/2.  - xtild(i) )
-       fb  = xtild(i) *  ( pi - xtild(i) )
-
-         IF( 200.* fb .LT. - fa )   THEN
-           fhyp ( i) = - 1.
-         ELSEIF( 200. * fb .LT. fa ) THEN
-           fhyp ( i) =   1.
-         ELSE
-            IF( ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13)  THEN
-                IF(   200.*fb + fa.LT.1.e-10 )  THEN
-                    fhyp ( i ) = - 1.
-                ELSEIF( 200.*fb - fa.LT.1.e-10 )  THEN
-                    fhyp ( i )  =   1.
-                ENDIF
-            ELSE
-                    fhyp ( i )  =  TANH ( fa/fb )
-            ENDIF
-         ENDIF
-        IF ( xtild(i).EQ. 0. )  fhyp(i) =  1.
-        IF ( xtild(i).EQ. pi )  fhyp(i) = -1.
-
-       ENDDO
-
-cc  ....  Calcul  de  beta  ....
-
-       ffdx = 0.
-
-       DO i = nmax +1,nmax2
-
-       xmoy    = 0.5 * ( xtild(i-1) + xtild( i ) )
-       fa  = tau*  ( dzoom/2.  - xmoy )
-       fb  = xmoy *  ( pi - xmoy )
-
-       IF( 200.* fb .LT. - fa )   THEN
-         fxm = - 1.
-       ELSEIF( 200. * fb .LT. fa ) THEN
-         fxm =   1.
-       ELSE
-            IF( ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13)  THEN
-                IF(   200.*fb + fa.LT.1.e-10 )  THEN
-                    fxm   = - 1.
-                ELSEIF( 200.*fb - fa.LT.1.e-10 )  THEN
-                    fxm   =   1.
-                ENDIF
-            ELSE
-                    fxm   =  TANH ( fa/fb )
-            ENDIF
-       ENDIF
-
-       IF ( xmoy.EQ. 0. )  fxm  =  1.
-       IF ( xmoy.EQ. pi )  fxm  = -1.
-
-       ffdx = ffdx + fxm * ( xtild(i) - xtild(i-1) )
-
-       ENDDO
-
-        beta  = ( grossism * ffdx - pi ) / ( ffdx - pi )
-
-       IF( 2.*beta - grossism.LE. 0.)  THEN
-        WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou
-     ,tine fxhyp est mauvaise ! '
-        WRITE(6,*)'Modifier les valeurs de  grossismx ,tau ou dzoomx ',
-     , ' et relancer ! ***  '
-        CALL ABORT_GCM("FXHYP", "", 1)
-       ENDIF
-c
-c   .....  calcul  de  Xprimt   .....
-c
-       
-       DO i = nmax, nmax2
-        Xprimt(i) = beta  + ( grossism - beta ) * fhyp(i)
-       ENDDO
-c   
-       DO i =  nmax+1, nmax2
-        Xprimt( nmax2 - i ) = Xprimt( i )
-       ENDDO
-c
-
-c   .....  Calcul  de  Xf     ........
-
-       Xf(0) = - pi
-
-       DO i =  nmax +1, nmax2
-
-       xmoy    = 0.5 * ( xtild(i-1) + xtild( i ) )
-       fa  = tau*  ( dzoom/2.  - xmoy )
-       fb  = xmoy *  ( pi - xmoy )
-
-       IF( 200.* fb .LT. - fa )   THEN
-         fxm = - 1.
-       ELSEIF( 200. * fb .LT. fa ) THEN
-         fxm =   1.
-       ELSE
-         fxm =  TANH ( fa/fb )
-       ENDIF
-
-       IF ( xmoy.EQ. 0. )  fxm =  1.
-       IF ( xmoy.EQ. pi )  fxm = -1.
-       xxpr(i)    = beta + ( grossism - beta ) * fxm
-
-       ENDDO
-
-       DO i = nmax+1, nmax2
-        xxpr(nmax2-i+1) = xxpr(i)
-       ENDDO
-
-        DO i=1,nmax2
-         Xf(i)   = Xf(i-1) + xxpr(i) * ( xtild(i) - xtild(i-1) )
-        ENDDO
-
-
-c    *****************************************************************
-c
-
-c     .....  xuv = 0.   si  calcul  aux pts   scalaires   ........
-c     .....  xuv = 0.5  si  calcul  aux pts      U        ........
-c
-      WRITE(6,18)
-c
-      DO 5000  ik = 1, 4
-
-       IF( ik.EQ.1 )        THEN
-         xuv =  -0.25
-       ELSE IF ( ik.EQ.2 )  THEN
-         xuv =   0.
-       ELSE IF ( ik.EQ.3 )  THEN
-         xuv =   0.50
-       ELSE IF ( ik.EQ.4 )  THEN
-         xuv =   0.25
-       ENDIF
-
-      xo1   = 0.
-
-      ii1=1
-      ii2=iim
-      IF(ik.EQ.1.and.grossism.EQ.1.) THEN
-        ii1 = 2 
-        ii2 = iim+1
-      ENDIF
-      DO 1500 i = ii1, ii2
-
-      xlon2 = - pi + (REAL(i) + xuv - decalx) * depi / REAL(iim) 
-
-      Xfi    = xlon2
-c
-      DO 250 it =  nmax2,0,-1
-      IF( Xfi.GE.Xf(it))  GO TO 350
-250   CONTINUE
-
-      it = 0
-
-350   CONTINUE
-
-c    ......  Calcul de   Xf(xi)    ...... 
-c
-      xi  = xtild(it)
-
-      IF(it.EQ.nmax2)  THEN
-       it       = nmax2 -1
-       Xf(it+1) = pi
-      ENDIF
-c  .....................................................................
-c
-c   Appel de la routine qui calcule les coefficients a0,a1,a2,a3 d'un
-c   polynome de degre 3  qui passe  par les points (Xf(it),xtild(it) )
-c          et (Xf(it+1),xtild(it+1) )
-
-       CALL coefpoly ( Xf(it),Xf(it+1),Xprimt(it),Xprimt(it+1),
-     ,                xtild(it),xtild(it+1),  a0, a1, a2, a3  )
-
-       Xf1     = Xf(it)
-       Xprimin = a1 + 2.* a2 * xi + 3.*a3 * xi *xi
-
-       DO 500 iter = 1,300
-        xi = xi - ( Xf1 - Xfi )/ Xprimin
-
-        IF( ABS(xi-xo1).LE.epsilon)  GO TO 550
-         xo1      = xi
-         xi2      = xi * xi
-         Xf1      = a0 +  a1 * xi +     a2 * xi2  +     a3 * xi2 * xi
-         Xprimin  =       a1      + 2.* a2 *  xi  + 3.* a3 * xi2
-500   CONTINUE
-        WRITE(6,*) ' Pas de solution ***** ',i,xlon2,iter
-          STOP 6
-550   CONTINUE
-
-       xxprim(i) = depi/ ( REAL(iim) * Xprimin )
-       xvrai(i)  =  xi + xzoom
-
-1500   CONTINUE
-
-
-       IF(ik.EQ.1.and.grossism.EQ.1.)  THEN
-         xvrai(1)    = xvrai(iip1)-depi
-         xxprim(1)   = xxprim(iip1)
-       ENDIF
-
-       DO i = 1 , iim
-        xlon(i)     = xvrai(i)
-        xprimm(i)   = xxprim(i)
-       ENDDO
-       DO i = 1, iim -1
-        IF( xvrai(i+1). LT. xvrai(i) )  THEN
-         WRITE(6,*) ' PBS. avec rlonu(',i+1,') plus petit que rlonu(',i,
-     ,  ')'
-        STOP 7
-        ENDIF
-       ENDDO
-c
-c   ... Reorganisation  des  longitudes  pour les avoir  entre - pi et pi ..
-c   ........................................................................
-
-       champmin =  1.e12
-       champmax = -1.e12
-       DO i = 1, iim
-        champmin = MIN( champmin,xvrai(i) )
-        champmax = MAX( champmax,xvrai(i) )
-       ENDDO
-
-      IF(champmin .GE.-pi-0.10.and.champmax.LE.pi+0.10 )  THEN
-                GO TO 1600
-      ELSE
-       WRITE(6,*) 'Reorganisation des longitudes pour avoir entre - pi',
-     ,  ' et pi '
-c
-        IF( xzoom.LE.0.)  THEN
-          IF( ik.EQ. 1 )  THEN
-          DO i = 1, iim
-           IF( xvrai(i).GE. - pi )  GO TO 80
-          ENDDO
-            WRITE(6,*)  ' PBS. 1 !  Xvrai plus petit que  - pi ! '
-            STOP 8
- 80       CONTINUE
-          is2 = i
-          ENDIF
-
-          IF( is2.NE. 1 )  THEN
-            DO ii = is2 , iim
-             xlon  (ii-is2+1) = xvrai(ii)
-             xprimm(ii-is2+1) = xxprim(ii)
-            ENDDO
-            DO ii = 1 , is2 -1
-             xlon  (ii+iim-is2+1) = xvrai(ii) + depi
-             xprimm(ii+iim-is2+1) = xxprim(ii) 
-            ENDDO
-          ENDIF
-        ELSE 
-          IF( ik.EQ.1 )  THEN
-           DO i = iim,1,-1
-             IF( xvrai(i).LE. pi ) GO TO 90
-           ENDDO
-             WRITE(6,*) ' PBS.  2 ! Xvrai plus grand  que   pi ! '
-              STOP 9
- 90        CONTINUE
-            is2 = i
-          ENDIF
-           idif = iim -is2
-           DO ii = 1, is2
-            xlon  (ii+idif) = xvrai(ii)
-            xprimm(ii+idif) = xxprim(ii)
-           ENDDO
-           DO ii = 1, idif
-            xlon (ii)  = xvrai (ii+is2) - depi
-            xprimm(ii) = xxprim(ii+is2) 
-           ENDDO
-         ENDIF
-      ENDIF
-c
-c     .........   Fin  de la reorganisation   ............................
-
- 1600    CONTINUE
-
-
-         xlon  ( iip1)  = xlon(1) + depi
-         xprimm( iip1 ) = xprimm (1 )
-       
-         DO i = 1, iim+1
-         xvrai(i) = xlon(i)*180./pi
-         ENDDO
-
-         IF( ik.EQ.1 )  THEN
-c          WRITE(6,*)  ' XLON aux pts. V-0.25   apres ( en  deg. ) '
-c          WRITE(6,18) 
-c          WRITE(6,68) xvrai
-c          WRITE(6,*) ' XPRIM k ',ik
-c          WRITE(6,566)  xprimm
-
-           DO i = 1,iim +1
-             rlonm025(i) = xlon( i )
-            xprimm025(i) = xprimm(i)
-           ENDDO
-         ELSE IF( ik.EQ.2 )  THEN
-c          WRITE(6,18) 
-c          WRITE(6,*)  ' XLON aux pts. V   apres ( en  deg. ) '
-c          WRITE(6,68) xvrai
-c          WRITE(6,*) ' XPRIM k ',ik
-c          WRITE(6,566)  xprimm
-
-           DO i = 1,iim + 1
-             rlonv(i) = xlon( i )
-            xprimv(i) = xprimm(i)
-           ENDDO
-
-         ELSE IF( ik.EQ.3)   THEN
-c          WRITE(6,18) 
-c          WRITE(6,*)  ' XLON aux pts. U   apres ( en  deg. ) '
-c          WRITE(6,68) xvrai
-c          WRITE(6,*) ' XPRIM ik ',ik
-c          WRITE(6,566)  xprimm
-
-           DO i = 1,iim + 1
-             rlonu(i) = xlon( i )
-            xprimu(i) = xprimm(i)
-           ENDDO
-
-         ELSE IF( ik.EQ.4 )  THEN
-c          WRITE(6,18) 
-c          WRITE(6,*)  ' XLON aux pts. V+0.25   apres ( en  deg. ) '
-c          WRITE(6,68) xvrai
-c          WRITE(6,*) ' XPRIM ik ',ik
-c          WRITE(6,566)  xprimm
-
-           DO i = 1,iim + 1
-             rlonp025(i) = xlon( i )
-            xprimp025(i) = xprimm(i)
-           ENDDO
-
-         ENDIF
-
-5000    CONTINUE
-c
-       WRITE(6,18)
-c
-c    ...........  fin  de la boucle  do 5000      ............
-
-        DO i = 1, iim
-         xlon(i) = rlonv(i+1) - rlonv(i)
-        ENDDO
-        champmin =  1.e12
-        champmax = -1.e12
-        DO i = 1, iim
-         champmin = MIN( champmin, xlon(i) )
-         champmax = MAX( champmax, xlon(i) )
-        ENDDO
-         champmin = champmin * 180./pi
-         champmax = champmax * 180./pi
-
-18     FORMAT(/)
-24     FORMAT(2x,'Parametres xzoom,gross,tau ,dzoom pour fxhyp ',4f8.3)
-68     FORMAT(1x,7f9.2)
-566    FORMAT(1x,7f9.4)
-
-       RETURN
-       END
Index: LMDZ5/branches/testing/libf/dyn3d/gcm.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/gcm.F	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3d/gcm.F	(revision 2258)
@@ -26,4 +26,5 @@
 ! Only INCA needs these informations (from the Earth's physics)
       USE indice_sol_mod
+      USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
 #endif
 
@@ -33,7 +34,6 @@
 ! dynamique -> physique pour l'initialisation
 #ifdef CPP_PHYS
-      USE dimphy
-      USE comgeomphy
-      USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
+!      USE dimphy
+!      USE comgeomphy
 #endif
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -90,10 +90,4 @@
 !#include "indicesol.h"
 #endif
-      INTEGER         longcles
-      PARAMETER     ( longcles = 20 )
-      REAL  clesphy0( longcles )
-      SAVE  clesphy0
-
-
 
       REAL zdtvr
@@ -125,6 +119,6 @@
       LOGICAL first
 
-      LOGICAL call_iniphys
-      data call_iniphys/.true./
+!      LOGICAL call_iniphys
+!      data call_iniphys/.true./
 
 c+jld variables test conservation energie
@@ -147,15 +141,4 @@
       REAL :: heure
 
-
-c-----------------------------------------------------------------------
-c    variables pour l'initialisation de la physique :
-c    ------------------------------------------------
-      INTEGER ngridmx
-      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
-      REAL zcufi(ngridmx),zcvfi(ngridmx)
-      REAL latfi(ngridmx),lonfi(ngridmx)
-      REAL airefi(ngridmx)
-      SAVE latfi, lonfi, airefi
-
 c-----------------------------------------------------------------------
 c   Initialisations:
@@ -175,12 +158,7 @@
 c  ---------------------------------------
 c
-! Ehouarn: dump possibility of using defrun
-!#ifdef CPP_IOIPSL
-      CALL conf_gcm( 99, .TRUE. , clesphy0 )
+      CALL conf_gcm( 99, .TRUE.)
       if (mod(iphysiq, iperiod) /= 0) call abort_gcm("conf_gcm",
      s "iphysiq must be a multiple of iperiod", 1)
-!#else
-!      CALL defrun( 99, .TRUE. , clesphy0 )
-!#endif
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -199,5 +177,5 @@
 #ifdef CPP_PHYS
       CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
-      call InitComgeomphy
+!      call InitComgeomphy ! now done in iniphysiq
 #endif
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -215,5 +193,5 @@
         call ioconf_calendar('noleap')
         write(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
-      else if (calend == 'earth_366d') then
+      else if (calend == 'gregorian') then
         call ioconf_calendar('gregorian')
         write(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
@@ -316,9 +294,9 @@
 
 C
-C on remet le calendrier à zero si demande
+C on remet le calendrier \`a zero si demande
 c
       IF (start_time /= starttime) then
         WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le'
-     &,' fichier restart ne correspond pas à celle lue dans le run.def'
+     &,' fichier restart ne correspond pas a celle lue dans le run.def'
         IF (raz_date == 1) then
           WRITE(lunout,*)'Je prends l''heure lue dans run.def'
@@ -428,32 +406,12 @@
 c   -------------------------------
 
-      IF (call_iniphys.and.(iflag_phys==1.or.iflag_phys>=100)) THEN
-         latfi(1)=rlatu(1)
-         lonfi(1)=0.
-         zcufi(1) = cu(1)
-         zcvfi(1) = cv(1)
-         DO j=2,jjm
-            DO i=1,iim
-               latfi((j-2)*iim+1+i)= rlatu(j)
-               lonfi((j-2)*iim+1+i)= rlonv(i)
-               zcufi((j-2)*iim+1+i) = cu((j-1)*iip1+i)
-               zcvfi((j-2)*iim+1+i) = cv((j-1)*iip1+i)
-            ENDDO
-         ENDDO
-         latfi(ngridmx)= rlatu(jjp1)
-         lonfi(ngridmx)= 0.
-         zcufi(ngridmx) = cu(ip1jm+1)
-         zcvfi(ngridmx) = cv(ip1jm-iim)
-         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
-         WRITE(lunout,*)
-     .       'GCM: WARNING!!! vitesse verticale nulle dans la physique'
+      IF ((iflag_phys==1).or.(iflag_phys>=100)) THEN
 ! Physics:
 #ifdef CPP_PHYS
-         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys,
-     &                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp,
+         CALL iniphysiq(iim,jjm,llm,daysec,day_ini,dtphys/nsplit_phys,
+     &                rlatu,rlonv,aire,cu,cv,rad,g,r,cpp,
      &                iflag_phys)
 #endif
-         call_iniphys=.false.
-      ENDIF ! of IF (call_iniphys.and.(iflag_phys.eq.1))
+      ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
 
 c  numero de stockage pour les fichiers de redemarrage:
@@ -530,6 +488,5 @@
 
 
-      CALL leapfrog(ucov,vcov,teta,ps,masse,phis,q,clesphy0,
-     .              time_0)
+      CALL leapfrog(ucov,vcov,teta,ps,masse,phis,q,time_0)
 
       END
Index: LMDZ5/branches/testing/libf/dyn3d/leapfrog.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/leapfrog.F	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3d/leapfrog.F	(revision 2258)
@@ -4,6 +4,5 @@
 c
 c
-      SUBROUTINE leapfrog(ucov,vcov,teta,ps,masse,phis,q,clesphy0,
-     &                    time_0)
+      SUBROUTINE leapfrog(ucov,vcov,teta,ps,masse,phis,q,time_0)
 
 
@@ -70,9 +69,4 @@
 #include "academic.h"
 
-! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
-! #include "clesphys.h"
-
-      INTEGER,PARAMETER :: longcles = 20
-      REAL,INTENT(IN) :: clesphy0( longcles ) ! not used
       REAL,INTENT(IN) :: time_0 ! not used
 
@@ -446,6 +440,5 @@
      $               ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
      $               du,dv,dteta,dq,
-     $               flxw,
-     $               clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi  )
+     $               flxw,dufi,dvfi,dtetafi,dqfi,dpfi  )
 
 c      ajout des tendances physiques:
Index: LMDZ5/branches/testing/libf/dyn3d_common/coefpoly.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d_common/coefpoly.F	(revision 2220)
+++ 	(revision )
@@ -1,40 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE coefpoly ( Xf1, Xf2, Xprim1, Xprim2, xtild1,xtild2 ,
-     ,                                          a0,a1,a2,a3         )
-      IMPLICIT NONE
-c
-c   ...  Auteur :   P. Le Van  ...
-c
-c
-c    Calcul des coefficients a0, a1, a2, a3 du polynome de degre 3 qui
-c      satisfait aux 4 equations  suivantes :
-
-c    a0 + a1*xtild1 + a2*xtild1*xtild1 + a3*xtild1*xtild1*xtild1 = Xf1
-c    a0 + a1*xtild2 + a2*xtild2*xtild2 + a3*xtild2*xtild2*xtild2 = Xf2
-c               a1  +     2.*a2*xtild1 +     3.*a3*xtild1*xtild1 = Xprim1
-c               a1  +     2.*a2*xtild2 +     3.*a3*xtild2*xtild2 = Xprim2
-
-c  On en revient a resoudre un systeme de 4 equat.a 4 inconnues a0,a1,a2,a3
-
-      REAL(KIND=8) Xf1, Xf2,Xprim1,Xprim2, xtild1,xtild2, xi 
-      REAL(KIND=8) Xfout, Xprim
-      REAL(KIND=8) a1,a2,a3,a0, xtil1car, xtil2car,derr,x1x2car
-
-      xtil1car = xtild1 * xtild1
-      xtil2car = xtild2 * xtild2 
-
-      derr= 2. *(Xf2-Xf1)/( xtild1-xtild2)
-
-      x1x2car = ( xtild1-xtild2)*(xtild1-xtild2)
-
-      a3 = (derr + Xprim1+Xprim2 )/x1x2car
-      a2     = ( Xprim1 - Xprim2 + 3.* a3 * ( xtil2car-xtil1car ) )    /
-     /           (  2.* ( xtild1 - xtild2 )  )
-
-      a1     = Xprim1 -3.* a3 * xtil1car     -2.* a2 * xtild1
-      a0     =  Xf1 - a3 * xtild1* xtil1car -a2 * xtil1car - a1 *xtild1
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3d_common/coefpoly_m.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d_common/coefpoly_m.F90	(revision 2258)
+++ LMDZ5/branches/testing/libf/dyn3d_common/coefpoly_m.F90	(revision 2258)
@@ -0,0 +1,52 @@
+module coefpoly_m
+
+  IMPLICIT NONE
+
+contains
+
+  SUBROUTINE coefpoly(xf1, xf2, xprim1, xprim2, xtild1, xtild2, a0, a1, a2, a3)
+
+    ! From LMDZ4/libf/dyn3d/coefpoly.F, version 1.1.1.1 2004/05/19 12:53:05
+
+    ! Author: P. Le Van
+
+    ! Calcul des coefficients a0, a1, a2, a3 du polynôme de degré 3 qui
+    ! satisfait aux 4 équations suivantes :
+
+    ! a0 + a1 * xtild1 + a2 * xtild1**2 + a3 * xtild1**3 = Xf1
+    ! a0 + a1 * xtild2 + a2 * xtild2**2 + a3 * xtild2**3 = Xf2
+    ! a1 + 2. * a2 * xtild1 + 3. * a3 * xtild1**2 = Xprim1
+    ! a1 + 2. * a2 * xtild2 + 3. * a3 * xtild2**2 = Xprim2
+
+    ! (passe par les points (Xf(it), xtild(it)) et (Xf(it + 1),
+    ! xtild(it + 1))
+
+    ! On en revient à resoudre un système de 4 équations à 4 inconnues
+    ! a0, a1, a2, a3.
+
+    use nrtype, only: k8
+
+    REAL(K8), intent(in):: xf1, xf2, xprim1, xprim2, xtild1, xtild2
+    REAL(K8), intent(out):: a0, a1, a2, a3
+
+    ! Local:
+    REAL(K8) xtil1car, xtil2car, derr, x1x2car
+
+    !------------------------------------------------------------
+
+    xtil1car = xtild1 * xtild1
+    xtil2car = xtild2 * xtild2
+
+    derr = 2. * (xf2-xf1)/(xtild1-xtild2)
+
+    x1x2car = (xtild1-xtild2) * (xtild1-xtild2)
+
+    a3 = (derr+xprim1+xprim2)/x1x2car
+    a2 = (xprim1-xprim2+3. * a3 * (xtil2car-xtil1car))/(2. * (xtild1-xtild2))
+
+    a1 = xprim1 - 3. * a3 * xtil1car - 2. * a2 * xtild1
+    a0 = xf1 - a3 * xtild1 * xtil1car - a2 * xtil1car - a1 * xtild1
+
+  END SUBROUTINE coefpoly
+
+end module coefpoly_m
Index: LMDZ5/branches/testing/libf/dyn3d_common/defrun.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d_common/defrun.F	(revision 2220)
+++ 	(revision )
@@ -1,496 +1,0 @@
-!
-! $Id$
-!
-c
-c
-      SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
-c
-      USE control_mod
- 
-      IMPLICIT NONE
-c-----------------------------------------------------------------------
-c     Auteurs :   L. Fairhead , P. Le Van  .
-c
-c     Arguments :
-c
-c     tapedef   :
-c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para- 
-c     -metres  du zoom  avec  celles lues sur le fichier start .
-c      clesphy0 :  sortie  .
-c
-       LOGICAL etatinit
-       INTEGER tapedef
-
-       INTEGER        longcles
-       PARAMETER(     longcles = 20 )
-       REAL clesphy0( longcles )
-c
-c   Declarations :
-c   --------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "logic.h"
-#include "serre.h"
-#include "comdissnew.h"
-#include "clesph0.h"
-c
-c
-c   local:
-c   ------
-
-      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
-      INTEGER   tapeout
-      REAL clonn,clatt,grossismxx,grossismyy
-      REAL dzoomxx,dzoomyy,tauxx,tauyy
-      LOGICAL  fxyhypbb, ysinuss
-      INTEGER i
-      
-c
-c  -------------------------------------------------------------------
-c
-c       .........     Version  du 29/04/97       ..........
-c
-c   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
-c      tetatemp   ajoutes  pour la dissipation   .
-c
-c   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb ** 
-c
-c  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
-c    Sinon , choix de fxynew  , a derivee sinusoidale  ..
-c
-c   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
-c         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
-c                de limit.dat ( dic)                        ...........
-c           Sinon  etatinit = . FALSE .
-c
-c   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
-c    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
-c   celles passees  par run.def ,  au debut du gcm, apres l'appel a 
-c    lectba .  
-c   Ces parmetres definissant entre autres la grille et doivent etre
-c   pareils et coherents , sinon il y aura  divergence du gcm .
-c
-c-----------------------------------------------------------------------
-c   initialisations:
-c   ----------------
-
-      tapeout = 6
-
-c-----------------------------------------------------------------------
-c  Parametres de controle du run:
-c-----------------------------------------------------------------------
-
-      OPEN( tapedef,file ='gcm.def',status='old',form='formatted')
-
-
-      READ (tapedef,9000) ch1,ch2,ch3
-      WRITE(tapeout,9000) ch1,ch2,ch3
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dayref
-      WRITE(tapeout,9001) ch1,'dayref'
-      WRITE(tapeout,*)    dayref
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    anneeref
-      WRITE(tapeout,9001) ch1,'anneeref'
-      WRITE(tapeout,*)    anneeref
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nday
-      WRITE(tapeout,9001) ch1,'nday'
-      WRITE(tapeout,*)    nday
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    day_step
-      WRITE(tapeout,9001) ch1,'day_step'
-      WRITE(tapeout,*)    day_step
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iperiod
-      WRITE(tapeout,9001) ch1,'iperiod'
-      WRITE(tapeout,*)    iperiod
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iapp_tracvl
-      WRITE(tapeout,9001) ch1,'iapp_tracvl'
-      WRITE(tapeout,*)    iapp_tracvl
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iconser
-      WRITE(tapeout,9001) ch1,'iconser'
-      WRITE(tapeout,*)    iconser
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iecri
-      WRITE(tapeout,9001) ch1,'iecri'
-      WRITE(tapeout,*)    iecri
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    periodav
-      WRITE(tapeout,9001) ch1,'periodav'
-      WRITE(tapeout,*)    periodav
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dissip_period
-      WRITE(tapeout,9001) ch1,'dissip_period'
-      WRITE(tapeout,*)    dissip_period
-
-ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
-ccc
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    lstardis
-      WRITE(tapeout,9001) ch1,'lstardis'
-      WRITE(tapeout,*)    lstardis
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nitergdiv
-      WRITE(tapeout,9001) ch1,'nitergdiv'
-      WRITE(tapeout,*)    nitergdiv
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nitergrot
-      WRITE(tapeout,9001) ch1,'nitergrot'
-      WRITE(tapeout,*)    nitergrot
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    niterh
-      WRITE(tapeout,9001) ch1,'niterh'
-      WRITE(tapeout,*)    niterh
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetagdiv
-      WRITE(tapeout,9001) ch1,'tetagdiv'
-      WRITE(tapeout,*)    tetagdiv
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetagrot
-      WRITE(tapeout,9001) ch1,'tetagrot'
-      WRITE(tapeout,*)    tetagrot
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetatemp
-      WRITE(tapeout,9001) ch1,'tetatemp'
-      WRITE(tapeout,*)    tetatemp
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    coefdis
-      WRITE(tapeout,9001) ch1,'coefdis'
-      WRITE(tapeout,*)    coefdis
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    purmats
-      WRITE(tapeout,9001) ch1,'purmats'
-      WRITE(tapeout,*)    purmats
-
-c    ...............................................................
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iflag_phys
-      WRITE(tapeout,9001) ch1,'iflag_phys'
-      WRITE(tapeout,*)    iflag_phys
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iphysiq
-      WRITE(tapeout,9001) ch1,'iphysiq'
-      WRITE(tapeout,*)    iphysiq
-
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    cycle_diurne
-      WRITE(tapeout,9001) ch1,'cycle_diurne'
-      WRITE(tapeout,*)    cycle_diurne
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    soil_model
-      WRITE(tapeout,9001) ch1,'soil_model'
-      WRITE(tapeout,*)    soil_model
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    new_oliq
-      WRITE(tapeout,9001) ch1,'new_oliq'
-      WRITE(tapeout,*)    new_oliq
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_orodr
-      WRITE(tapeout,9001) ch1,'ok_orodr'
-      WRITE(tapeout,*)    ok_orodr
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_orolf
-      WRITE(tapeout,9001) ch1,'ok_orolf'
-      WRITE(tapeout,*)    ok_orolf
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_limitvrai
-      WRITE(tapeout,9001) ch1,'ok_limitvrai'
-      WRITE(tapeout,*)    ok_limitvrai
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nbapp_rad
-      WRITE(tapeout,9001) ch1,'nbapp_rad'
-      WRITE(tapeout,*)    nbapp_rad
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iflag_con
-      WRITE(tapeout,9001) ch1,'iflag_con'
-      WRITE(tapeout,*)    iflag_con
-
-      DO i = 1, longcles
-       clesphy0(i) = 0.
-      ENDDO
-                          clesphy0(1) = REAL( iflag_con )
-                          clesphy0(2) = REAL( nbapp_rad )
-
-       IF( cycle_diurne  ) clesphy0(3) =  1.
-       IF(   soil_model  ) clesphy0(4) =  1.
-       IF(     new_oliq  ) clesphy0(5) =  1.
-       IF(     ok_orodr  ) clesphy0(6) =  1.
-       IF(     ok_orolf  ) clesphy0(7) =  1.
-       IF(  ok_limitvrai ) clesphy0(8) =  1.
-
-
-ccc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
-c     .........   (  modif  le 17/04/96 )   .........
-c
-      IF( etatinit ) GO TO 100
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clonn
-      WRITE(tapeout,9001) ch1,'clon'
-      WRITE(tapeout,*)    clonn
-      IF( ABS(clon - clonn).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de clon passee par run.def est diffe
-     *rente de  celle lue sur le fichier  start '
-        STOP
-      ENDIF
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clatt
-      WRITE(tapeout,9001) ch1,'clat'
-      WRITE(tapeout,*)    clatt
-
-      IF( ABS(clat - clatt).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de clat passee par run.def est diffe
-     *rente de  celle lue sur le fichier  start '
-        STOP
-      ENDIF
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismxx
-      WRITE(tapeout,9001) ch1,'grossismx'
-      WRITE(tapeout,*)    grossismxx
-
-      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de grossismx passee par run.def est
-     , differente de celle lue sur le fichier  start '
-        STOP
-      ENDIF
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismyy
-      WRITE(tapeout,9001) ch1,'grossismy'
-      WRITE(tapeout,*)    grossismyy
-
-      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de grossismy passee par run.def est
-     , differente de celle lue sur le fichier  start '
-        STOP
-      ENDIF
-      
-      IF( grossismx.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismx < 1 .   *** '
-         STOP
-      ELSE
-         alphax = 1. - 1./ grossismx
-      ENDIF
-
-
-      IF( grossismy.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
-         STOP
-      ELSE
-         alphay = 1. - 1./ grossismy
-      ENDIF
-
-c
-c    alphax et alphay sont les anciennes formulat. des grossissements
-c
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    fxyhypbb
-      WRITE(tapeout,9001) ch1,'fxyhypbb'
-      WRITE(tapeout,*)    fxyhypbb
-
-      IF( .NOT.fxyhypb )  THEN
-           IF( fxyhypbb )     THEN
-            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
-            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est F'
-     *,      '                   alors  qu il est  T  sur  run.def  ***'
-              STOP
-           ENDIF
-      ELSE
-           IF( .NOT.fxyhypbb )   THEN
-            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
-            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est t'
-     *,      '                   alors  qu il est  F  sur  run.def  ***'
-              STOP
-           ENDIF
-      ENDIF
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomxx
-      WRITE(tapeout,9001) ch1,'dzoomx'
-      WRITE(tapeout,*)    dzoomxx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomyy
-      WRITE(tapeout,9001) ch1,'dzoomy'
-      WRITE(tapeout,*)    dzoomyy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauxx
-      WRITE(tapeout,9001) ch1,'taux'
-      WRITE(tapeout,*)    tauxx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauyy
-      WRITE(tapeout,9001) ch1,'tauy'
-      WRITE(tapeout,*)    tauyy
-
-      IF( fxyhypb )  THEN
-
-       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
-        WRITE(tapeout,*)' La valeur de dzoomx passee par run.def est dif
-     *ferente de celle lue sur le fichier  start '
-        CALL ABORT_gcm("defrun", "", 1)
-       ENDIF
-
-       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
-        WRITE(tapeout,*)' La valeur de dzoomy passee par run.def est dif
-     *ferente de celle lue sur le fichier  start '
-        CALL ABORT_gcm("defrun", "", 1)
-       ENDIF
-
-       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
-        WRITE(6,*)' La valeur de taux passee par run.def est differente
-     *  de celle lue sur le fichier  start '
-        CALL ABORT_gcm("defrun", "", 1)
-       ENDIF
-
-       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
-        WRITE(6,*)' La valeur de tauy passee par run.def est differente
-     *  de celle lue sur le fichier  start '
-        CALL ABORT_gcm("defrun", "", 1)
-       ENDIF
-
-      ENDIF
-      
-cc
-      IF( .NOT.fxyhypb  )  THEN
-        READ (tapedef,9001) ch1,ch4
-        READ (tapedef,*)    ysinuss
-        WRITE(tapeout,9001) ch1,'ysinus'
-        WRITE(tapeout,*)    ysinuss
-
-
-        IF( .NOT.ysinus )  THEN
-           IF( ysinuss )     THEN
-              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
-              WRITE(tapeout,*)'** ysinus lu sur le fichier start est F',
-     *       ' alors  qu il est  T  sur  run.def  ***'
-              STOP
-           ENDIF
-        ELSE
-           IF( .NOT.ysinuss )   THEN
-              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
-              WRITE(tapeout,*)'** ysinus lu sur le fichier start est T',
-     *       ' alors  qu il est  F  sur  run.def  ***'
-              STOP
-           ENDIF
-        ENDIF
-      ENDIF
-c
-      WRITE(6,*) ' alphax alphay defrun ',alphax,alphay
-
-      CLOSE(tapedef)
-
-      RETURN
-c   ...............................................
-c
-100   CONTINUE
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clon
-      WRITE(tapeout,9001) ch1,'clon'
-      WRITE(tapeout,*)    clon
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clat
-      WRITE(tapeout,9001) ch1,'clat'
-      WRITE(tapeout,*)    clat
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismx
-      WRITE(tapeout,9001) ch1,'grossismx'
-      WRITE(tapeout,*)    grossismx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismy
-      WRITE(tapeout,9001) ch1,'grossismy'
-      WRITE(tapeout,*)    grossismy
-
-      IF( grossismx.LT.1. )  THEN
-        WRITE(tapeout,*) '***  ATTENTION !! grossismx < 1 .   *** '
-         STOP
-      ELSE
-         alphax = 1. - 1./ grossismx
-      ENDIF
-
-      IF( grossismy.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
-         STOP
-      ELSE
-         alphay = 1. - 1./ grossismy
-      ENDIF
-
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    fxyhypb
-      WRITE(tapeout,9001) ch1,'fxyhypb'
-      WRITE(tapeout,*)    fxyhypb
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomx
-      WRITE(tapeout,9001) ch1,'dzoomx'
-      WRITE(tapeout,*)    dzoomx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomy
-      WRITE(tapeout,9001) ch1,'dzoomy'
-      WRITE(tapeout,*)    dzoomy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    taux
-      WRITE(tapeout,9001) ch1,'taux'
-      WRITE(tapeout,*)    taux
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauy
-      WRITE(tapeout,9001) ch1,'tauy'
-      WRITE(tapeout,*)    tauy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ysinus
-      WRITE(tapeout,9001) ch1,'ysinus'
-      WRITE(tapeout,*)    ysinus
-       
-      WRITE(tapeout,*) ' alphax alphay defrun ',alphax,alphay
-c
-9000  FORMAT(3(/,a72))
-9001  FORMAT(/,a72,/,a12)
-cc
-      CLOSE(tapedef)
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3d_common/fxhyp_m.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d_common/fxhyp_m.F90	(revision 2258)
+++ LMDZ5/branches/testing/libf/dyn3d_common/fxhyp_m.F90	(revision 2258)
@@ -0,0 +1,250 @@
+module fxhyp_m
+
+  IMPLICIT NONE
+
+contains
+
+  SUBROUTINE fxhyp(xprimm025, rlonv, xprimv, rlonu, xprimu, xprimp025)
+
+    ! From LMDZ4/libf/dyn3d/fxhyp.F, version 1.2, 2005/06/03 09:11:32
+    ! Author: P. Le Van, from formulas by R. Sadourny
+
+    ! Calcule les longitudes et dérivées dans la grille du GCM pour
+    ! une fonction f(x) à dérivée tangente hyperbolique.
+
+    ! Il vaut mieux avoir : grossismx \times dzoom < pi
+
+    ! Le premier point scalaire pour une grille regulière (grossismx =
+    ! 1., taux=0., clon=0.) est à - 180 degrés.
+
+    use arth_m, only: arth
+    use invert_zoom_x_m, only: invert_zoom_x, nmax
+    use nrtype, only: pi, pi_d, twopi, twopi_d, k8
+    use principal_cshift_m, only: principal_cshift
+
+    include "dimensions.h"
+    ! for iim
+
+    include "serre.h"
+    ! for clon, grossismx, dzoomx, taux
+
+    REAL, intent(out):: xprimm025(:), rlonv(:), xprimv(:) ! (iim + 1)
+    real, intent(out):: rlonu(:), xprimu(:), xprimp025(:) ! (iim + 1)
+
+    ! Local:
+    real rlonm025(iim + 1), rlonp025(iim + 1)
+    REAL dzoom, step
+    real d_rlonv(iim)
+    REAL(K8) xtild(0:2 * nmax)
+    REAL(K8) fhyp(nmax:2 * nmax), ffdx, beta, Xprimt(0:2 * nmax)
+    REAL(K8) Xf(0:2 * nmax), xxpr(2 * nmax)
+    REAL(K8) fa, fb
+    INTEGER i, is2
+    REAL(K8) xmoy, fxm
+
+    !----------------------------------------------------------------------
+
+    print *, "Call sequence information: fxhyp"
+
+    test_iim: if (iim==1) then
+       rlonv(1)=0.
+       rlonu(1)=pi
+       rlonv(2)=rlonv(1)+twopi
+       rlonu(2)=rlonu(1)+twopi
+
+       xprimm025(:)=1.
+       xprimv(:)=1.
+       xprimu(:)=1.
+       xprimp025(:)=1.
+    else test_iim
+       test_grossismx: if (grossismx == 1.) then
+          step = twopi / iim
+
+          xprimm025(:iim) = step
+          xprimp025(:iim) = step
+          xprimv(:iim) = step
+          xprimu(:iim) = step
+
+          rlonv(:iim) = arth(- pi + clon / 180. * pi, step, iim)
+          rlonm025(:iim) = rlonv(:iim) - 0.25 * step
+          rlonp025(:iim) = rlonv(:iim) + 0.25 * step
+          rlonu(:iim) = rlonv(:iim) + 0.5 * step
+       else test_grossismx
+          dzoom = dzoomx * twopi_d
+          xtild = arth(- pi_d, pi_d / nmax, 2 * nmax + 1)
+
+          ! Compute fhyp:
+          DO i = nmax, 2 * nmax
+             fa = taux * (dzoom / 2. - xtild(i))
+             fb = xtild(i) * (pi_d - xtild(i))
+
+             IF (200. * fb < - fa) THEN
+                fhyp(i) = - 1.
+             ELSE IF (200. * fb < fa) THEN
+                fhyp(i) = 1.
+             ELSE
+                IF (ABS(fa) < 1e-13 .AND. ABS(fb) < 1e-13) THEN
+                   IF (200. * fb + fa < 1e-10) THEN
+                      fhyp(i) = - 1.
+                   ELSE IF (200. * fb - fa < 1e-10) THEN
+                      fhyp(i) = 1.
+                   END IF
+                ELSE
+                   fhyp(i) = TANH(fa / fb)
+                END IF
+             END IF
+
+             IF (xtild(i) == 0.) fhyp(i) = 1.
+             IF (xtild(i) == pi_d) fhyp(i) = -1.
+          END DO
+
+          ! Calcul de beta 
+
+          ffdx = 0.
+
+          DO i = nmax + 1, 2 * nmax
+             xmoy = 0.5 * (xtild(i-1) + xtild(i))
+             fa = taux * (dzoom / 2. - xmoy)
+             fb = xmoy * (pi_d - xmoy)
+
+             IF (200. * fb < - fa) THEN
+                fxm = - 1.
+             ELSE IF (200. * fb < fa) THEN
+                fxm = 1.
+             ELSE
+                IF (ABS(fa) < 1e-13 .AND. ABS(fb) < 1e-13) THEN
+                   IF (200. * fb + fa < 1e-10) THEN
+                      fxm = - 1.
+                   ELSE IF (200. * fb - fa < 1e-10) THEN
+                      fxm = 1.
+                   END IF
+                ELSE
+                   fxm = TANH(fa / fb)
+                END IF
+             END IF
+
+             IF (xmoy == 0.) fxm = 1.
+             IF (xmoy == pi_d) fxm = -1.
+
+             ffdx = ffdx + fxm * (xtild(i) - xtild(i-1))
+          END DO
+
+          print *, "ffdx = ", ffdx
+          beta = (grossismx * ffdx - pi_d) / (ffdx - pi_d)
+          print *, "beta = ", beta
+
+          IF (2. * beta - grossismx <= 0.) THEN
+             print *, 'Bad choice of grossismx, taux, dzoomx.'
+             print *, 'Decrease dzoomx or grossismx.'
+             STOP 1
+          END IF
+
+          ! calcul de Xprimt 
+          Xprimt(nmax:2 * nmax) = beta + (grossismx - beta) * fhyp
+          xprimt(:nmax - 1) = xprimt(2 * nmax:nmax + 1:- 1)
+
+          ! Calcul de Xf
+
+          DO i = nmax + 1, 2 * nmax
+             xmoy = 0.5 * (xtild(i-1) + xtild(i))
+             fa = taux * (dzoom / 2. - xmoy)
+             fb = xmoy * (pi_d - xmoy)
+
+             IF (200. * fb < - fa) THEN
+                fxm = - 1.
+             ELSE IF (200. * fb < fa) THEN
+                fxm = 1.
+             ELSE
+                fxm = TANH(fa / fb)
+             END IF
+
+             IF (xmoy == 0.) fxm = 1.
+             IF (xmoy == pi_d) fxm = -1.
+             xxpr(i) = beta + (grossismx - beta) * fxm
+          END DO
+
+          xxpr(:nmax) = xxpr(2 * nmax:nmax + 1:- 1)
+
+          Xf(0) = - pi_d
+
+          DO i=1, 2 * nmax - 1
+             Xf(i) = Xf(i-1) + xxpr(i) * (xtild(i) - xtild(i-1))
+          END DO
+
+          Xf(2 * nmax) = pi_d
+
+          call invert_zoom_x(xf, xtild, Xprimt, rlonm025(:iim), &
+               xprimm025(:iim), xuv = - 0.25_k8)
+          call invert_zoom_x(xf, xtild, Xprimt, rlonv(:iim), xprimv(:iim), &
+               xuv = 0._k8)
+          call invert_zoom_x(xf, xtild, Xprimt, rlonu(:iim), xprimu(:iim), &
+               xuv = 0.5_k8)
+          call invert_zoom_x(xf, xtild, Xprimt, rlonp025(:iim), &
+               xprimp025(:iim), xuv = 0.25_k8)
+       end if test_grossismx
+
+       is2 = 0
+
+       IF (MINval(rlonm025(:iim)) < - pi - 0.1 &
+            .or. MAXval(rlonm025(:iim)) > pi + 0.1) THEN
+          IF (clon <= 0.) THEN
+             is2 = 1
+
+             do while (rlonm025(is2) < - pi .and. is2 < iim)
+                is2 = is2 + 1
+             end do
+
+             if (rlonm025(is2) < - pi) then
+                print *, 'Rlonm025 plus petit que - pi !'
+                STOP 1
+             end if
+          ELSE
+             is2 = iim
+
+             do while (rlonm025(is2) > pi .and. is2 > 1)
+                is2 = is2 - 1
+             end do
+
+             if (rlonm025(is2) > pi) then
+                print *, 'Rlonm025 plus grand que pi !'
+                STOP 1
+             end if
+          END IF
+       END IF
+
+       call principal_cshift(is2, rlonm025, xprimm025)
+       call principal_cshift(is2, rlonv, xprimv)
+       call principal_cshift(is2, rlonu, xprimu)
+       call principal_cshift(is2, rlonp025, xprimp025)
+
+       forall (i = 1: iim) d_rlonv(i) = rlonv(i + 1) - rlonv(i)
+       print *, "Minimum longitude step:", MINval(d_rlonv) * 180. / pi, &
+            "degrees"
+       print *, "Maximum longitude step:", MAXval(d_rlonv) * 180. / pi, &
+            "degrees"
+
+       ! Check that rlonm025 <= rlonv <= rlonp025 <= rlonu:
+       DO i = 1, iim + 1
+          IF (rlonp025(i) < rlonv(i)) THEN
+             print *, 'rlonp025(', i, ') = ', rlonp025(i)
+             print *, "< rlonv(", i, ") = ", rlonv(i)
+             STOP 1
+          END IF
+
+          IF (rlonv(i) < rlonm025(i)) THEN 
+             print *, 'rlonv(', i, ') = ', rlonv(i)
+             print *, "< rlonm025(", i, ") = ", rlonm025(i)
+             STOP 1
+          END IF
+
+          IF (rlonp025(i) > rlonu(i)) THEN
+             print *, 'rlonp025(', i, ') = ', rlonp025(i)
+             print *, "> rlonu(", i, ") = ", rlonu(i)
+             STOP 1
+          END IF
+       END DO
+    end if test_iim
+
+  END SUBROUTINE fxhyp
+
+end module fxhyp_m
Index: LMDZ5/branches/testing/libf/dyn3d_common/fxyhyper.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d_common/fxyhyper.F	(revision 2220)
+++ 	(revision )
@@ -1,139 +1,0 @@
-!
-! $Header$
-!
-c
-c
-       SUBROUTINE fxyhyper ( yzoom, grossy, dzoomy,tauy  ,   
-     ,                       xzoom, grossx, dzoomx,taux  ,
-     , rlatu,yprimu,rlatv,yprimv,rlatu1,  yprimu1,  rlatu2,  yprimu2  , 
-     , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
-
-       IMPLICIT NONE
-c
-c      Auteur :  P. Le Van .
-c
-c      d'apres  formulations de R. Sadourny .
-c
-c
-c     Ce spg calcule les latitudes( routine fyhyp ) et longitudes( fxhyp )
-c            par des  fonctions  a tangente hyperbolique .
-c
-c     Il y a 3 parametres ,en plus des coordonnees du centre du zoom (xzoom
-c                      et  yzoom )   :  
-c
-c     a) le grossissement du zoom  :  grossy  ( en y ) et grossx ( en x )
-c     b) l' extension     du zoom  :  dzoomy  ( en y ) et dzoomx ( en x )
-c     c) la raideur de la transition du zoom  :   taux et tauy   
-c
-c  N.B : Il vaut mieux avoir   :   grossx * dzoomx <  pi    ( radians )
-c ******
-c                  et              grossy * dzoomy <  pi/2  ( radians )
-c
-#include "dimensions.h"
-#include "paramet.h"
-
-
-c   .....  Arguments  ...
-c
-       REAL xzoom,yzoom,grossx,grossy,dzoomx,dzoomy,taux,tauy
-       REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm),
-     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
-       REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),
-     , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
-       REAL(KIND=8)  dxmin, dxmax , dymin, dymax
-
-c   ....   var. locales   .....
-c
-       INTEGER i,j
-c
-
-       CALL fyhyp ( yzoom, grossy, dzoomy,tauy  , 
-     ,  rlatu, yprimu,rlatv,yprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
-     ,  dymin,dymax                                               )
-
-       CALL fxhyp(xzoom,grossx,dzoomx,taux,rlonm025,xprimm025,rlonv,
-     , xprimv,rlonu,xprimu,rlonp025,xprimp025 , dxmin,dxmax         )
-
-
-        DO i = 1, iip1
-          IF(rlonp025(i).LT.rlonv(i))  THEN
-           WRITE(6,*) ' Attention !  rlonp025 < rlonv',i
-            STOP
-          ENDIF
-
-          IF(rlonv(i).LT.rlonm025(i))  THEN 
-           WRITE(6,*) ' Attention !  rlonm025 > rlonv',i
-            STOP
-          ENDIF
-
-          IF(rlonp025(i).GT.rlonu(i))  THEN
-           WRITE(6,*) ' Attention !  rlonp025 > rlonu',i
-            STOP
-          ENDIF
-        ENDDO
-
-        WRITE(6,*) '  *** TEST DE COHERENCE  OK    POUR   FX **** '
-
-c
-       DO j = 1, jjm
-c
-       IF(rlatu1(j).LE.rlatu2(j))   THEN
-         WRITE(6,*)'Attention ! rlatu1 < rlatu2 ',rlatu1(j), rlatu2(j),j
-         STOP 13
-       ENDIF
-c
-       IF(rlatu2(j).LE.rlatu(j+1))  THEN
-        WRITE(6,*)'Attention ! rlatu2 < rlatup1 ',rlatu2(j),rlatu(j+1),j
-        STOP 14
-       ENDIF
-c
-       IF(rlatu(j).LE.rlatu1(j))    THEN
-        WRITE(6,*)' Attention ! rlatu < rlatu1 ',rlatu(j),rlatu1(j),j
-        STOP 15
-       ENDIF
-c
-       IF(rlatv(j).LE.rlatu2(j))    THEN
-        WRITE(6,*)' Attention ! rlatv < rlatu2 ',rlatv(j),rlatu2(j),j
-        STOP 16
-       ENDIF
-c
-       IF(rlatv(j).ge.rlatu1(j))    THEN
-        WRITE(6,*)' Attention ! rlatv > rlatu1 ',rlatv(j),rlatu1(j),j
-        STOP 17
-       ENDIF
-c
-       IF(rlatv(j).ge.rlatu(j))     THEN
-        WRITE(6,*) ' Attention ! rlatv > rlatu ',rlatv(j),rlatu(j),j
-        STOP 18
-       ENDIF
-c
-       ENDDO
-c
-       WRITE(6,*) '  *** TEST DE COHERENCE  OK    POUR   FY **** '
-c
-        WRITE(6,18)
-        WRITE(6,*) '  Latitudes  '
-        WRITE(6,*) ' *********** '
-        WRITE(6,18)
-        WRITE(6,3)  dymin, dymax
-        WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par
-     ,ametres  grossism , tau , dzoom pour Y et repasser ! '
-c
-        WRITE(6,18)
-        WRITE(6,*) '  Longitudes  '
-        WRITE(6,*) ' ************ '
-        WRITE(6,18)
-        WRITE(6,3)  dxmin, dxmax
-        WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par
-     ,ametres  grossism , tau , dzoom pour Y et repasser ! '
-        WRITE(6,18)
-c
-3      Format(1x, ' Au centre du zoom , la longueur de la maille est',
-     ,  ' d environ ',f8.2 ,' degres  ',
-     , ' alors que la maille en dehors de la zone du zoom est d environ
-     , ', f8.2,' degres ' )
-18      FORMAT(/)
-
-       RETURN
-       END
-
Index: LMDZ5/branches/testing/libf/dyn3d_common/fyhyp.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d_common/fyhyp.F	(revision 2220)
+++ 	(revision )
@@ -1,378 +1,0 @@
-!
-! $Id$
-!
-c
-c
-       SUBROUTINE fyhyp ( yzoomdeg, grossism, dzooma,tau  ,  
-     ,  rrlatu,yyprimu,rrlatv,yyprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
-     ,  champmin,champmax                                            ) 
-
-cc    ...  Version du 01/04/2001 ....
-
-       IMPLICIT NONE
-c
-c    ...   Auteur :  P. Le Van  ... 
-c
-c    .......    d'apres  formulations  de R. Sadourny  .......
-c
-c     Calcule les latitudes et derivees dans la grille du GCM pour une
-c     fonction f(y) a tangente  hyperbolique  .
-c
-c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois , etc)
-c     dzoom  etant  la distance totale de la zone du zoom ( en radians )
-c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom   
-c
-c
-c N.B : Il vaut mieux avoir : grossism * dzoom  <  pi/2  (radians) ,en lati.
-c      ********************************************************************
-c
-c
-#include "dimensions.h"
-#include "paramet.h"
-
-       INTEGER      nmax , nmax2
-       PARAMETER (  nmax = 30000, nmax2 = 2*nmax )
-c
-c
-c     .......  arguments  d'entree    .......
-c
-       REAL yzoomdeg, grossism,dzooma,tau 
-c         ( rentres  par  run.def )
-
-c     .......  arguments  de sortie   .......
-c
-       REAL rrlatu(jjp1), yyprimu(jjp1),rrlatv(jjm), yyprimv(jjm),
-     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
-
-c
-c     .....     champs  locaux    .....
-c
-     
-       REAL   dzoom
-       REAL(KIND=8) ylat(jjp1), yprim(jjp1)
-       REAL(KIND=8) yuv
-       REAL(KIND=8) yt(0:nmax2)
-       REAL(KIND=8) fhyp(0:nmax2),beta,Ytprim(0:nmax2),fxm(0:nmax2)
-       SAVE Ytprim, yt,Yf
-       REAL(KIND=8) Yf(0:nmax2),yypr(0:nmax2)
-       REAL(KIND=8) yvrai(jjp1), yprimm(jjp1),ylatt(jjp1)
-       REAL(KIND=8) pi,depi,pis2,epsilon,y0,pisjm
-       REAL(KIND=8) yo1,yi,ylon2,ymoy,Yprimin,champmin,champmax
-       REAL(KIND=8) yfi,Yf1,ffdy
-       REAL(KIND=8) ypn,deply,y00
-       SAVE y00, deply
-
-       INTEGER i,j,it,ik,iter,jlat
-       INTEGER jpn,jjpn
-       SAVE jpn
-       REAL(KIND=8) a0,a1,a2,a3,yi2,heavyy0,heavyy0m
-       REAL(KIND=8) fa(0:nmax2),fb(0:nmax2)
-       REAL y0min,y0max
-
-       REAL(KIND=8)     heavyside
-
-       pi       = 2. * ASIN(1.)
-       depi     = 2. * pi
-       pis2     = pi/2.
-       pisjm    = pi/ REAL(jjm)
-       epsilon  = 1.e-3
-       y0       =  yzoomdeg * pi/180. 
-
-       IF( dzooma.LT.1.)  THEN
-         dzoom = dzooma * pi
-       ELSEIF( dzooma.LT. 12. ) THEN
-         WRITE(6,*) ' Le param. dzoomy pour fyhyp est trop petit ! L aug
-     ,menter et relancer ! '
-         STOP 1
-       ELSE
-         dzoom = dzooma * pi/180.
-       ENDIF
-
-       WRITE(6,18)
-       WRITE(6,*) ' yzoom( rad.),grossism,tau,dzoom (radians)'
-       WRITE(6,24) y0,grossism,tau,dzoom
-
-       DO i = 0, nmax2 
-        yt(i) = - pis2  + REAL(i)* pi /nmax2
-       ENDDO
-
-       heavyy0m = heavyside( -y0 )
-       heavyy0  = heavyside(  y0 )
-       y0min    = 2.*y0*heavyy0m - pis2
-       y0max    = 2.*y0*heavyy0  + pis2
-
-       fa = 999.999
-       fb = 999.999
-       
-       DO i = 0, nmax2 
-        IF( yt(i).LT.y0 )  THEN
-         fa (i) = tau*  (yt(i)-y0+dzoom/2. )
-         fb(i) =   (yt(i)-2.*y0*heavyy0m +pis2) * ( y0 - yt(i) )
-        ELSEIF ( yt(i).GT.y0 )  THEN
-         fa(i) =   tau *(y0-yt(i)+dzoom/2. )
-         fb(i) = (2.*y0*heavyy0 -yt(i)+pis2) * ( yt(i) - y0 ) 
-       ENDIF
-        
-       IF( 200.* fb(i) .LT. - fa(i) )   THEN
-         fhyp ( i) = - 1.
-       ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
-         fhyp ( i) =   1.
-       ELSE  
-         fhyp(i) =  TANH ( fa(i)/fb(i) )
-       ENDIF
-
-       IF( yt(i).EQ.y0 )  fhyp(i) = 1.
-       IF(yt(i).EQ. y0min. OR.yt(i).EQ. y0max ) fhyp(i) = -1.
-
-       ENDDO
-
-cc  ....  Calcul  de  beta  ....
-c
-       ffdy   = 0.
-
-       DO i = 1, nmax2
-        ymoy    = 0.5 * ( yt(i-1) + yt( i ) )
-        IF( ymoy.LT.y0 )  THEN
-         fa(i)= tau * ( ymoy-y0+dzoom/2.) 
-         fb(i) = (ymoy-2.*y0*heavyy0m +pis2) * ( y0 - ymoy )
-        ELSEIF ( ymoy.GT.y0 )  THEN
-         fa(i)= tau * ( y0-ymoy+dzoom/2. ) 
-         fb(i) = (2.*y0*heavyy0 -ymoy+pis2) * ( ymoy - y0 )
-        ENDIF
-
-        IF( 200.* fb(i) .LT. - fa(i) )    THEN
-         fxm ( i) = - 1.
-        ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
-         fxm ( i) =   1.
-        ELSE
-         fxm(i) =  TANH ( fa(i)/fb(i) )
-        ENDIF
-         IF( ymoy.EQ.y0 )  fxm(i) = 1.
-         IF (ymoy.EQ. y0min. OR.yt(i).EQ. y0max ) fxm(i) = -1.
-         ffdy = ffdy + fxm(i) * ( yt(i) - yt(i-1) )
-
-        ENDDO
-
-        beta  = ( grossism * ffdy - pi ) / ( ffdy - pi )
-
-       IF( 2.*beta - grossism.LE. 0.)  THEN
-
-        WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou
-     ,tine fyhyp est mauvaise ! '
-        WRITE(6,*)'Modifier les valeurs de  grossismy ,tauy ou dzoomy',
-     , ' et relancer ! ***  '
-        CALL ABORT_GCM("FYHYP", "", 1)
-
-       ENDIF
-c
-c   .....  calcul  de  Ytprim   .....
-c
-       
-       DO i = 0, nmax2
-        Ytprim(i) = beta  + ( grossism - beta ) * fhyp(i)
-       ENDDO
-
-c   .....  Calcul  de  Yf     ........
-
-       Yf(0) = - pis2
-       DO i = 1, nmax2
-        yypr(i)    = beta + ( grossism - beta ) * fxm(i)
-       ENDDO
-
-       DO i=1,nmax2
-        Yf(i)   = Yf(i-1) + yypr(i) * ( yt(i) - yt(i-1) )
-       ENDDO
-
-c    ****************************************************************
-c
-c   .....   yuv  = 0.   si calcul des latitudes  aux pts.  U  .....
-c   .....   yuv  = 0.5  si calcul des latitudes  aux pts.  V  .....
-c
-      WRITE(6,18)
-c
-      DO 5000  ik = 1,4
-
-       IF( ik.EQ.1 )  THEN
-         yuv  = 0.
-         jlat = jjm + 1
-       ELSE IF ( ik.EQ.2 )  THEN
-         yuv  = 0.5
-         jlat = jjm 
-       ELSE IF ( ik.EQ.3 )  THEN
-         yuv  = 0.25
-         jlat = jjm 
-       ELSE IF ( ik.EQ.4 )  THEN
-         yuv  = 0.75
-         jlat = jjm 
-       ENDIF
-c
-       yo1   = 0.
-       DO 1500 j =  1,jlat
-        yo1   = 0.
-        ylon2 =  - pis2 + pisjm * ( REAL(j)  + yuv  -1.)  
-        yfi    = ylon2
-c
-       DO 250 it =  nmax2,0,-1
-        IF( yfi.GE.Yf(it))  GO TO 350
-250    CONTINUE
-       it = 0
-350    CONTINUE
-
-       yi = yt(it)
-       IF(it.EQ.nmax2)  THEN
-        it       = nmax2 -1
-        Yf(it+1) = pis2
-       ENDIF
-c  .................................................................
-c  ....  Interpolation entre  yi(it) et yi(it+1)   pour avoir Y(yi)  
-c      .....           et   Y'(yi)                             .....
-c  .................................................................
-
-       CALL coefpoly ( Yf(it),Yf(it+1),Ytprim(it), Ytprim(it+1),   
-     ,                  yt(it),yt(it+1) ,   a0,a1,a2,a3   )      
-
-       Yf1     = Yf(it)
-       Yprimin = a1 + 2.* a2 * yi + 3.*a3 * yi *yi
-
-       DO 500 iter = 1,300
-         yi = yi - ( Yf1 - yfi )/ Yprimin
-
-        IF( ABS(yi-yo1).LE.epsilon)  GO TO 550
-         yo1      = yi
-         yi2      = yi * yi
-         Yf1      = a0 +  a1 * yi +     a2 * yi2  +     a3 * yi2 * yi
-         Yprimin  =       a1      + 2.* a2 *  yi  + 3.* a3 * yi2
-500   CONTINUE
-        WRITE(6,*) ' Pas de solution ***** ',j,ylon2,iter
-         STOP 2
-550   CONTINUE
-c
-       Yprimin   = a1  + 2.* a2 *  yi   + 3.* a3 * yi* yi
-       yprim(j)  = pi / ( jjm * Yprimin )
-       yvrai(j)  = yi 
-
-1500    CONTINUE
-
-       DO j = 1, jlat -1
-        IF( yvrai(j+1). LT. yvrai(j) )  THEN
-         WRITE(6,*) ' PBS. avec  rlat(',j+1,') plus petit que rlat(',j,
-     ,  ')'
-         STOP 3
-        ENDIF
-       ENDDO
-
-       WRITE(6,*) 'Reorganisation des latitudes pour avoir entre - pi/2'
-     , ,' et  pi/2 '
-c
-        IF( ik.EQ.1 )   THEN
-           ypn = pis2 
-          DO j = jlat,1,-1
-           IF( yvrai(j).LE. ypn ) GO TO 1502
-          ENDDO
-1502     CONTINUE
-
-         jpn   = j
-         y00   = yvrai(jpn)
-         deply = pis2 -  y00
-        ENDIF
-
-         DO  j = 1, jjm +1 - jpn
-           ylatt (j)  = -pis2 - y00  + yvrai(jpn+j-1)
-           yprimm(j)  = yprim(jpn+j-1)
-         ENDDO
-
-         jjpn  = jpn
-         IF( jlat.EQ. jjm ) jjpn = jpn -1
-
-         DO j = 1,jjpn 
-          ylatt (j + jjm+1 -jpn) = yvrai(j) + deply
-          yprimm(j + jjm+1 -jpn) = yprim(j)
-         ENDDO
-
-c      ***********   Fin de la reorganisation     *************
-c
- 1600   CONTINUE
-
-       DO j = 1, jlat
-          ylat(j) =  ylatt( jlat +1 -j )
-         yprim(j) = yprimm( jlat +1 -j )
-       ENDDO
-  
-        DO j = 1, jlat
-         yvrai(j) = ylat(j)*180./pi
-        ENDDO
-
-        IF( ik.EQ.1 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT  en U   apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rrlatu(j) =  ylat( j )
-           yyprimu(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 2 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*) ' YLAT   en V  apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*)' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rrlatv(j) =  ylat( j )
-           yyprimv(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 3 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT  en U + 0.75  apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rlatu2(j) =  ylat( j )
-           yprimu2(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 4 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT en U + 0.25  apres ( en  deg. ) '
-c         WRITE(6,68)(yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,68) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rlatu1(j) =  ylat( j )
-           yprimu1(j) = yprim( j )
-          ENDDO
-
-        ENDIF
-
-5000   CONTINUE
-c
-        WRITE(6,18)
-c
-c  .....     fin de la boucle  do 5000 .....
-
-        DO j = 1, jjm
-         ylat(j) = rrlatu(j) - rrlatu(j+1)
-        ENDDO
-        champmin =  1.e12
-        champmax = -1.e12
-        DO j = 1, jjm
-         champmin = MIN( champmin, ylat(j) )
-         champmax = MAX( champmax, ylat(j) )
-        ENDDO
-         champmin = champmin * 180./pi
-         champmax = champmax * 180./pi
-
-24     FORMAT(2x,'Parametres yzoom,gross,tau ,dzoom pour fyhyp ',4f8.3)
-18      FORMAT(/)
-68      FORMAT(1x,7f9.2)
-
-        RETURN
-        END
Index: LMDZ5/branches/testing/libf/dyn3d_common/fyhyp_m.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d_common/fyhyp_m.F90	(revision 2258)
+++ LMDZ5/branches/testing/libf/dyn3d_common/fyhyp_m.F90	(revision 2258)
@@ -0,0 +1,342 @@
+module fyhyp_m
+
+  IMPLICIT NONE
+
+contains
+
+  SUBROUTINE fyhyp(rlatu, yyprimu, rlatv, rlatu2, yprimu2, rlatu1, yprimu1)
+
+    ! From LMDZ4/libf/dyn3d/fyhyp.F, version 1.2, 2005/06/03 09:11:32
+
+    ! Author: P. Le Van, from analysis by R. Sadourny 
+
+    ! Calcule les latitudes et dérivées dans la grille du GCM pour une
+    ! fonction f(y) à dérivée tangente hyperbolique.
+
+    ! Il vaut mieux avoir : grossismy * dzoom < pi / 2
+
+    use coefpoly_m, only: coefpoly
+    use nrtype, only: k8
+
+    include "dimensions.h"
+    ! for jjm
+
+    include "serre.h"
+    ! for clat, grossismy, dzoomy, tauy
+
+    REAL, intent(out):: rlatu(jjm + 1), yyprimu(jjm + 1)
+    REAL, intent(out):: rlatv(jjm)
+    real, intent(out):: rlatu2(jjm), yprimu2(jjm), rlatu1(jjm), yprimu1(jjm)
+
+    ! Local: 
+
+    REAL(K8) champmin, champmax
+    INTEGER, PARAMETER:: nmax=30000, nmax2=2*nmax
+    REAL dzoom ! distance totale de la zone du zoom (en radians)
+    REAL(K8) ylat(jjm + 1), yprim(jjm + 1)
+    REAL(K8) yuv
+    REAL(K8), save:: yt(0:nmax2)
+    REAL(K8) fhyp(0:nmax2), beta
+    REAL(K8), save:: ytprim(0:nmax2)
+    REAL(K8) fxm(0:nmax2)
+    REAL(K8), save:: yf(0:nmax2)
+    REAL(K8) yypr(0:nmax2)
+    REAL(K8) yvrai(jjm + 1), yprimm(jjm + 1), ylatt(jjm + 1)
+    REAL(K8) pi, pis2, epsilon, y0, pisjm
+    REAL(K8) yo1, yi, ylon2, ymoy, yprimin
+    REAL(K8) yfi, yf1, ffdy
+    REAL(K8) ypn, deply, y00
+    SAVE y00, deply
+
+    INTEGER i, j, it, ik, iter, jlat
+    INTEGER jpn, jjpn
+    SAVE jpn
+    REAL(K8) a0, a1, a2, a3, yi2, heavyy0, heavyy0m
+    REAL(K8) fa(0:nmax2), fb(0:nmax2)
+    REAL y0min, y0max
+
+    REAL(K8) heavyside
+
+    !-------------------------------------------------------------------
+
+    print *, "Call sequence information: fyhyp"
+
+    pi = 2.*asin(1.)
+    pis2 = pi/2.
+    pisjm = pi/real(jjm)
+    epsilon = 1e-3
+    y0 = clat*pi/180.
+    dzoom = dzoomy*pi
+    print *, 'yzoom(rad), grossismy, tauy, dzoom (rad):'
+    print *, y0, grossismy, tauy, dzoom
+
+    DO i = 0, nmax2
+       yt(i) = -pis2 + real(i)*pi/nmax2
+    END DO
+
+    heavyy0m = heavyside(-y0)
+    heavyy0 = heavyside(y0)
+    y0min = 2.*y0*heavyy0m - pis2
+    y0max = 2.*y0*heavyy0 + pis2
+
+    fa = 999.999
+    fb = 999.999
+
+    DO i = 0, nmax2
+       IF (yt(i)<y0) THEN
+          fa(i) = tauy*(yt(i)-y0 + dzoom/2.)
+          fb(i) = (yt(i)-2.*y0*heavyy0m + pis2)*(y0-yt(i))
+       ELSE IF (yt(i)>y0) THEN
+          fa(i) = tauy*(y0-yt(i) + dzoom/2.)
+          fb(i) = (2.*y0*heavyy0-yt(i) + pis2)*(yt(i)-y0)
+       END IF
+
+       IF (200.*fb(i)<-fa(i)) THEN
+          fhyp(i) = -1.
+       ELSE IF (200.*fb(i)<fa(i)) THEN
+          fhyp(i) = 1.
+       ELSE
+          fhyp(i) = tanh(fa(i)/fb(i))
+       END IF
+
+       IF (yt(i)==y0) fhyp(i) = 1.
+       IF (yt(i)==y0min .OR. yt(i)==y0max) fhyp(i) = -1.
+    END DO
+
+    ! Calcul de beta 
+
+    ffdy = 0.
+
+    DO i = 1, nmax2
+       ymoy = 0.5*(yt(i-1) + yt(i))
+       IF (ymoy<y0) THEN
+          fa(i) = tauy*(ymoy-y0 + dzoom/2.)
+          fb(i) = (ymoy-2.*y0*heavyy0m + pis2)*(y0-ymoy)
+       ELSE IF (ymoy>y0) THEN
+          fa(i) = tauy*(y0-ymoy + dzoom/2.)
+          fb(i) = (2.*y0*heavyy0-ymoy + pis2)*(ymoy-y0)
+       END IF
+
+       IF (200.*fb(i)<-fa(i)) THEN
+          fxm(i) = -1.
+       ELSE IF (200.*fb(i)<fa(i)) THEN
+          fxm(i) = 1.
+       ELSE
+          fxm(i) = tanh(fa(i)/fb(i))
+       END IF
+       IF (ymoy==y0) fxm(i) = 1.
+       IF (ymoy==y0min .OR. yt(i)==y0max) fxm(i) = -1.
+       ffdy = ffdy + fxm(i)*(yt(i)-yt(i-1))
+    END DO
+
+    beta = (grossismy*ffdy-pi)/(ffdy-pi)
+
+    IF (2. * beta - grossismy <= 0.) THEN
+       print *, 'Attention ! La valeur beta calculee dans la routine fyhyp ' &
+            // 'est mauvaise. Modifier les valeurs de grossismy, tauy ou ' &
+            // 'dzoomy et relancer.'
+       STOP 1
+    END IF
+
+    ! calcul de Ytprim 
+
+    DO i = 0, nmax2
+       ytprim(i) = beta + (grossismy-beta)*fhyp(i)
+    END DO
+
+    ! Calcul de Yf 
+
+    yf(0) = -pis2
+    DO i = 1, nmax2
+       yypr(i) = beta + (grossismy-beta)*fxm(i)
+    END DO
+
+    DO i = 1, nmax2
+       yf(i) = yf(i-1) + yypr(i)*(yt(i)-yt(i-1))
+    END DO
+
+    ! yuv = 0. si calcul des latitudes aux pts. U 
+    ! yuv = 0.5 si calcul des latitudes aux pts. V 
+
+    loop_ik: DO ik = 1, 4
+       IF (ik==1) THEN
+          yuv = 0.
+          jlat = jjm + 1
+       ELSE IF (ik==2) THEN
+          yuv = 0.5
+          jlat = jjm
+       ELSE IF (ik==3) THEN
+          yuv = 0.25
+          jlat = jjm
+       ELSE IF (ik==4) THEN
+          yuv = 0.75
+          jlat = jjm
+       END IF
+
+       yo1 = 0.
+       DO j = 1, jlat
+          yo1 = 0.
+          ylon2 = -pis2 + pisjm*(real(j) + yuv-1.)
+          yfi = ylon2
+
+          it = nmax2
+          DO while (it >= 1 .and. yfi < yf(it))
+             it = it - 1
+          END DO
+
+          yi = yt(it)
+          IF (it==nmax2) THEN
+             it = nmax2 - 1
+             yf(it + 1) = pis2
+          END IF
+
+          ! Interpolation entre yi(it) et yi(it + 1) pour avoir Y(yi)
+          ! et Y'(yi) 
+
+          CALL coefpoly(yf(it), yf(it + 1), ytprim(it), ytprim(it + 1), &
+               yt(it), yt(it + 1), a0, a1, a2, a3)
+
+          yf1 = yf(it)
+          yprimin = a1 + 2.*a2*yi + 3.*a3*yi*yi
+
+          iter = 1
+          DO
+             yi = yi - (yf1-yfi)/yprimin
+             IF (abs(yi-yo1)<=epsilon .or. iter == 300) exit
+             yo1 = yi
+             yi2 = yi*yi
+             yf1 = a0 + a1*yi + a2*yi2 + a3*yi2*yi
+             yprimin = a1 + 2.*a2*yi + 3.*a3*yi2
+          END DO
+          if (abs(yi-yo1) > epsilon) then
+             print *, 'Pas de solution.', j, ylon2
+             STOP 1
+          end if
+
+          yprimin = a1 + 2.*a2*yi + 3.*a3*yi*yi
+          yprim(j) = pi/(jjm*yprimin)
+          yvrai(j) = yi
+       END DO
+
+       DO j = 1, jlat - 1
+          IF (yvrai(j + 1)<yvrai(j)) THEN
+             print *, 'Problème avec rlat(', j + 1, ') plus petit que rlat(', &
+                  j, ')'
+             STOP 1
+          END IF
+       END DO
+
+       print *, 'Reorganisation des latitudes pour avoir entre - pi/2 et pi/2'
+
+       IF (ik==1) THEN
+          ypn = pis2
+          DO j = jjm + 1, 1, -1
+             IF (yvrai(j)<=ypn) exit
+          END DO
+
+          jpn = j
+          y00 = yvrai(jpn)
+          deply = pis2 - y00
+       END IF
+
+       DO j = 1, jjm + 1 - jpn
+          ylatt(j) = -pis2 - y00 + yvrai(jpn + j-1)
+          yprimm(j) = yprim(jpn + j-1)
+       END DO
+
+       jjpn = jpn
+       IF (jlat==jjm) jjpn = jpn - 1
+
+       DO j = 1, jjpn
+          ylatt(j + jjm + 1-jpn) = yvrai(j) + deply
+          yprimm(j + jjm + 1-jpn) = yprim(j)
+       END DO
+
+       ! Fin de la reorganisation
+
+       DO j = 1, jlat
+          ylat(j) = ylatt(jlat + 1-j)
+          yprim(j) = yprimm(jlat + 1-j)
+       END DO
+
+       DO j = 1, jlat
+          yvrai(j) = ylat(j)*180./pi
+       END DO
+
+       IF (ik==1) THEN
+          DO j = 1, jjm + 1
+             rlatu(j) = ylat(j)
+             yyprimu(j) = yprim(j)
+          END DO
+       ELSE IF (ik==2) THEN
+          DO j = 1, jjm
+             rlatv(j) = ylat(j)
+          END DO
+       ELSE IF (ik==3) THEN
+          DO j = 1, jjm
+             rlatu2(j) = ylat(j)
+             yprimu2(j) = yprim(j)
+          END DO
+       ELSE IF (ik==4) THEN
+          DO j = 1, jjm
+             rlatu1(j) = ylat(j)
+             yprimu1(j) = yprim(j)
+          END DO
+       END IF
+    END DO loop_ik
+
+    DO j = 1, jjm
+       ylat(j) = rlatu(j) - rlatu(j + 1)
+    END DO
+    champmin = 1e12
+    champmax = -1e12
+    DO j = 1, jjm
+       champmin = min(champmin, ylat(j))
+       champmax = max(champmax, ylat(j))
+    END DO
+    champmin = champmin*180./pi
+    champmax = champmax*180./pi
+
+    DO j = 1, jjm
+       IF (rlatu1(j) <= rlatu2(j)) THEN
+          print *, 'Attention ! rlatu1 < rlatu2 ', rlatu1(j), rlatu2(j), j
+          STOP 13
+       ENDIF
+
+       IF (rlatu2(j) <= rlatu(j+1)) THEN
+          print *, 'Attention ! rlatu2 < rlatup1 ', rlatu2(j), rlatu(j+1), j
+          STOP 14
+       ENDIF
+
+       IF (rlatu(j) <= rlatu1(j)) THEN
+          print *, ' Attention ! rlatu < rlatu1 ', rlatu(j), rlatu1(j), j
+          STOP 15
+       ENDIF
+
+       IF (rlatv(j) <= rlatu2(j)) THEN
+          print *, ' Attention ! rlatv < rlatu2 ', rlatv(j), rlatu2(j), j
+          STOP 16
+       ENDIF
+
+       IF (rlatv(j) >= rlatu1(j)) THEN
+          print *, ' Attention ! rlatv > rlatu1 ', rlatv(j), rlatu1(j), j
+          STOP 17
+       ENDIF
+
+       IF (rlatv(j) >= rlatu(j)) THEN
+          print *, ' Attention ! rlatv > rlatu ', rlatv(j), rlatu(j), j
+          STOP 18
+       ENDIF
+    ENDDO
+
+    print *, 'Latitudes'
+    print 3, champmin, champmax
+
+3   Format(1x, ' Au centre du zoom, la longueur de la maille est', &
+         ' d environ ', f0.2, ' degres ', /, &
+         ' alors que la maille en dehors de la zone du zoom est ', &
+         "d'environ ", f0.2, ' degres ')
+
+  END SUBROUTINE fyhyp
+
+end module fyhyp_m
Index: LMDZ5/branches/testing/libf/dyn3d_common/grilles_gcm_netcdf_sub.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d_common/grilles_gcm_netcdf_sub.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3d_common/grilles_gcm_netcdf_sub.F90	(revision 2258)
@@ -31,7 +31,4 @@
   INTEGER out_latudim,out_latvdim,out_dim(3)
   INTEGER out_levdim
-
-  INTEGER, PARAMETER :: longcles = 20
-  REAL  clesphy0(longcles)
 
   INTEGER start(4),COUNT(4)
@@ -60,5 +57,5 @@
   pa= 50000.
 
-  CALL conf_gcm( 99, .TRUE. , clesphy0 )
+  CALL conf_gcm( 99, .TRUE. )
   CALL iniconst
   CALL inigeom
Index: LMDZ5/branches/testing/libf/dyn3d_common/inigeom.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d_common/inigeom.F	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3d_common/inigeom.F	(revision 2258)
@@ -16,4 +16,6 @@
 c
 c
+      use fxhyp_m, only: fxhyp
+      use fyhyp_m, only: fyhyp
       IMPLICIT NONE
 c
@@ -264,9 +266,6 @@
       WRITE(6,*)'*** Inigeom , Y = Latitude  , der.tg. hyperbolique ***'
  
-       CALL fxyhyper( clat, grossismy, dzoomy, tauy    , 
-     ,                clon, grossismx, dzoomx, taux    ,
-     , rlatu,yprimu,rlatv, yprimv,rlatu1, yprimu1,rlatu2,yprimu2  ,
-     , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025 )
-
+      CALL fyhyp(rlatu, yprimu, rlatv, rlatu2, yprimu2, rlatu1, yprimu1)
+      CALL fxhyp(xprimm025, rlonv, xprimv, rlonu, xprimu, xprimp025)
   
       ENDIF
Index: LMDZ5/branches/testing/libf/dyn3d_common/invert_zoom_x_m.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d_common/invert_zoom_x_m.F90	(revision 2258)
+++ LMDZ5/branches/testing/libf/dyn3d_common/invert_zoom_x_m.F90	(revision 2258)
@@ -0,0 +1,90 @@
+module invert_zoom_x_m
+
+  implicit none
+
+  INTEGER, PARAMETER:: nmax = 30000
+
+contains
+
+  subroutine invert_zoom_x(xf, xtild, Xprimt, xlon, xprimm, xuv)
+
+    use coefpoly_m, only: coefpoly
+    use nrtype, only: pi, pi_d, twopi_d, k8
+
+    include "dimensions.h"
+    ! for iim
+
+    include "serre.h"
+    ! for clon
+
+    REAL(K8), intent(in):: Xf(0:), xtild(0:), Xprimt(0:) ! (0:2 * nmax)
+    real, intent(out):: xlon(:), xprimm(:) ! (iim)
+
+    REAL(K8), intent(in):: xuv
+    ! 0. si calcul aux points scalaires 
+    ! 0.5 si calcul aux points U 
+
+    ! Local:
+    REAL(K8) xo1, Xfi, a0, a1, a2, a3, Xf1, Xprimin
+    integer i, it, iter
+    REAL(K8), parameter:: my_eps = 1e-6_k8
+
+    REAL(K8) xxprim(iim), xvrai(iim) 
+    ! intermediary variables because xlon and xprimm are simple precision
+
+    !------------------------------------------------------------------
+
+    DO i = 1, iim
+       Xfi = - pi_d + (i + xuv - 0.75_k8) * twopi_d / iim
+
+       it = 2 * nmax
+       do while (xfi < xf(it) .and. it >= 1)
+          it = it - 1
+       end do
+
+       ! Calcul de Xf(xvrai(i)) 
+
+       xvrai(i) = xtild(it)
+
+       IF (it == 2 * nmax) THEN
+          it = 2 * nmax -1
+       END IF
+
+       CALL coefpoly(Xf(it), Xf(it + 1), Xprimt(it), Xprimt(it + 1), &
+            xtild(it), xtild(it + 1), a0, a1, a2, a3)
+       Xf1 = Xf(it)
+       Xprimin = a1 + xvrai(i) * (2._k8 * a2 + xvrai(i) * 3._k8 * a3)
+       xo1 = xvrai(i)
+       iter = 1
+
+       do
+          xvrai(i) = xvrai(i) - (Xf1 - Xfi) / Xprimin
+          IF (ABS(xvrai(i) - xo1) <= my_eps .or. iter == 300) exit
+          xo1 = xvrai(i)
+          Xf1 = a0 + xvrai(i) * (a1 + xvrai(i) * (a2 + xvrai(i) * a3))
+          Xprimin = a1 + xvrai(i) * (2._k8 * a2 + xvrai(i) * 3._k8 * a3)
+       end DO
+
+       if (ABS(xvrai(i) - xo1) > my_eps) then
+          ! iter == 300
+          print *, 'Pas de solution.'
+          print *, i, xfi
+          STOP 1
+       end if
+
+       xxprim(i) = twopi_d / (iim * Xprimin)
+    end DO
+
+    DO i = 1, iim -1
+       IF (xvrai(i + 1) < xvrai(i)) THEN
+          print *, 'xvrai(', i + 1, ') < xvrai(', i, ')'
+          STOP 1
+       END IF
+    END DO
+
+    xlon = xvrai + clon / 180. * pi
+    xprimm = xxprim
+
+  end subroutine invert_zoom_x
+
+end module invert_zoom_x_m
Index: LMDZ5/branches/testing/libf/dyn3d_common/principal_cshift_m.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d_common/principal_cshift_m.F90	(revision 2258)
+++ LMDZ5/branches/testing/libf/dyn3d_common/principal_cshift_m.F90	(revision 2258)
@@ -0,0 +1,45 @@
+module principal_cshift_m
+
+  implicit none
+
+contains
+
+  subroutine principal_cshift(is2, xlon, xprimm)
+
+    ! Add or subtract 2 pi so that xlon is near [-pi, pi], then cshift
+    ! so that xlon is in ascending order. Make the same cshift on
+    ! xprimm.
+
+    use nrtype, only: twopi
+
+    include "dimensions.h"
+    ! for iim
+
+    include "serre.h"
+    ! for clon
+
+    integer, intent(in):: is2
+    real, intent(inout):: xlon(:), xprimm(:) ! (iim + 1)
+
+    !-----------------------------------------------------
+
+    if (is2 /= 0) then
+       IF (clon <= 0.) THEN
+          IF (is2 /= 1) THEN
+             xlon(:is2 - 1) = xlon(:is2 - 1) + twopi
+             xlon(:iim) = cshift(xlon(:iim), shift = is2 - 1)
+             xprimm(:iim) = cshift(xprimm(:iim), shift = is2 - 1)
+          END IF
+       else
+          xlon(is2 + 1:iim) = xlon(is2 + 1:iim) - twopi
+          xlon(:iim) = cshift(xlon(:iim), shift = is2)
+          xprimm(:iim) = cshift(xprimm(:iim), shift = is2)
+       end IF
+    end if
+
+    xlon(iim + 1) = xlon(1) + twopi
+    xprimm(iim + 1) = xprimm(1)
+
+  end subroutine principal_cshift
+
+end module principal_cshift_m
Index: LMDZ5/branches/testing/libf/dyn3dmem/calfis_loc.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/calfis_loc.F	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3dmem/calfis_loc.F	(revision 2258)
@@ -21,5 +21,4 @@
      $                  pdq,
      $                  flxw,
-     $                  clesphy0,
      $                  pdufi,
      $                  pdvfi,
@@ -141,8 +140,4 @@
       REAL,INTENT(OUT) :: pdqfi(iip1,jjb_u:jje_u,llm,nqtot) ! tendency on tracers
       REAL,INTENT(OUT) :: pdpsfi(iip1,jjb_u:jje_u) ! tendency on surface pressure (Pa/s)
-
-      INTEGER,PARAMETER :: longcles = 20
-      REAL,INTENT(IN) :: clesphy0( longcles ) ! unused
-
 
 #ifdef CPP_PHYS
@@ -674,12 +669,9 @@
      .             zphis_omp,
      .             presnivs_omp,
-     .             clesphy0,
      .             zufi_omp,
      .             zvfi_omp,
      .             ztfi_omp,
      .             zqfi_omp,
-c#ifdef INCA
      .             flxwfi_omp,
-c#endif
      .             zdufi_omp,
      .             zdvfi_omp,
Index: LMDZ5/branches/testing/libf/dyn3dmem/call_calfis_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/call_calfis_mod.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3dmem/call_calfis_mod.F90	(revision 2258)
@@ -68,5 +68,5 @@
   
   
-  SUBROUTINE call_calfis(itau,lafin,clesphy0,ucov_dyn,vcov_dyn,teta_dyn,masse_dyn,ps_dyn, &
+  SUBROUTINE call_calfis(itau,lafin,ucov_dyn,vcov_dyn,teta_dyn,masse_dyn,ps_dyn, &
                          phis_dyn,q_dyn,flxw_dyn)
   USE dimensions_mod
@@ -91,5 +91,4 @@
     INTEGER,INTENT(IN) :: itau ! (time) iteration step number
     LOGICAL,INTENT(IN) :: lafin ! .true. if final time step
-    REAL,INTENT(IN) :: clesphy0( : ) ! not used    
     REAL,INTENT(INOUT) :: ucov_dyn(ijb_u:ije_u,llm) ! covariant zonal wind
     REAL,INTENT(INOUT) :: vcov_dyn(ijb_v:ije_v,llm) ! covariant meridional wind
@@ -231,6 +230,5 @@
                      ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,   &
                      du,dv,dteta,dq,                             &
-                     flxw,                                       &
-                     clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi  )
+                     flxw, dufi,dvfi,dtetafi,dqfi,dpfi  )
 
     ijb=ij_begin
Index: LMDZ5/branches/testing/libf/dyn3dmem/ce0l.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/ce0l.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3dmem/ce0l.F90	(revision 2258)
@@ -48,12 +48,10 @@
 #endif
 
-  INTEGER, PARAMETER            :: longcles=20
   INTEGER                       :: ierr
-  REAL,    DIMENSION(longcles)  :: clesphy0
   REAL,    DIMENSION(iip1,jjp1) :: masque
   CHARACTER(LEN=15)             :: calnd
   REAL,    DIMENSION(iip1,jjp1) :: phis ! geopotentiel au sol
 !-------------------------------------------------------------------------------
-  CALL conf_gcm( 99, .TRUE. , clesphy0 )
+  CALL conf_gcm( 99, .TRUE. )
 
 #ifdef CPP_MPI
Index: LMDZ5/branches/testing/libf/dyn3dmem/conf_gcm.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/conf_gcm.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3dmem/conf_gcm.F90	(revision 2258)
@@ -2,5 +2,5 @@
 ! $Id$
 
-SUBROUTINE conf_gcm( tapedef, etatinit, clesphy0 )
+SUBROUTINE conf_gcm( tapedef, etatinit )
 
   USE control_mod
@@ -27,12 +27,7 @@
   !     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para- 
   !     -metres  du zoom  avec  celles lues sur le fichier start .
-  !      clesphy0 :  sortie  .
-
-  LOGICAL etatinit
-  INTEGER tapedef
-
-  INTEGER        longcles
-  PARAMETER(     longcles = 20 )
-  REAL clesphy0( longcles )
+
+  LOGICAL,INTENT(IN) :: etatinit
+  INTEGER,INTENT(IN) :: tapedef
 
   !   Declarations :
@@ -45,7 +40,4 @@
   include "temps.h"
   include "comconst.h"
-
-  ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
-  ! include "clesphys.h"
   include "iniprint.h"
 
@@ -768,6 +760,7 @@
      !Config  Help = extension en longitude  de la zone du zoom  
      !Config         ( fraction de la zone totale)
-     dzoomx = 0.0
+     dzoomx = 0.2
      CALL getin('dzoomx',dzoomx)
+     call assert(dzoomx < 1, "conf_gcm: dzoomx must be < 1")
 
      !Config  Key  = dzoomy
@@ -776,6 +769,7 @@
      !Config  Help = extension en latitude de la zone  du zoom  
      !Config         ( fraction de la zone totale)
-     dzoomy = 0.0
+     dzoomy = 0.2
      CALL getin('dzoomy',dzoomy)
+     call assert(dzoomy < 1, "conf_gcm: dzoomy must be < 1")
 
      !Config  Key  = taux
Index: LMDZ5/branches/testing/libf/dyn3dmem/fxhyp.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/fxhyp.F	(revision 2220)
+++ 	(revision )
@@ -1,449 +1,0 @@
-!
-! $Id: fxhyp.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-c
-c
-       SUBROUTINE fxhyp ( xzoomdeg,grossism,dzooma,tau ,
-     , rlonm025,xprimm025,rlonv,xprimv,rlonu,xprimu,rlonp025,xprimp025,
-     , champmin,champmax                                               )
-
-c      Auteur :  P. Le Van 
-
-       IMPLICIT NONE
-
-c    Calcule les longitudes et derivees dans la grille du GCM pour une
-c     fonction f(x) a tangente  hyperbolique  .
-c
-c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois,etc.)
-c     dzoom  etant  la distance totale de la zone du zoom
-c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom
-c
-c    On doit avoir grossism x dzoom <  pi ( radians )   , en longitude.
-c   ********************************************************************
-
-
-       INTEGER nmax, nmax2
-       PARAMETER (  nmax = 30000, nmax2 = 2*nmax )
-c
-       LOGICAL scal180
-       PARAMETER ( scal180 = .TRUE. )
-
-c      scal180 = .TRUE.  si on veut avoir le premier point scalaire pour   
-c      une grille reguliere ( grossism = 1.,tau=0.,clon=0. ) a -180. degres.
-c      sinon scal180 = .FALSE.
-
-#include "dimensions.h"
-#include "paramet.h"
-       
-c     ......  arguments  d'entree   .......
-c
-       REAL xzoomdeg,dzooma,tau,grossism
-
-c    ......   arguments  de  sortie  ......
-
-       REAL rlonm025(iip1),xprimm025(iip1),rlonv(iip1),xprimv(iip1),
-     ,  rlonu(iip1),xprimu(iip1),rlonp025(iip1),xprimp025(iip1)
-
-c     .... variables locales  ....
-c
-       REAL   dzoom
-       REAL(KIND=8) xlon(iip1),xprimm(iip1),xuv
-       REAL(KIND=8) xtild(0:nmax2)
-       REAL(KIND=8) fhyp(0:nmax2),ffdx,beta,Xprimt(0:nmax2)
-       REAL(KIND=8) Xf(0:nmax2),xxpr(0:nmax2)
-       REAL(KIND=8) xvrai(iip1),xxprim(iip1) 
-       REAL(KIND=8) pi,depi,epsilon,xzoom,fa,fb
-       REAL(KIND=8) Xf1, Xfi , a0,a1,a2,a3,xi2
-       INTEGER i,it,ik,iter,ii,idif,ii1,ii2
-       REAL(KIND=8) xi,xo1,xmoy,xlon2,fxm,Xprimin
-       REAL(KIND=8) champmin,champmax,decalx
-       INTEGER is2
-       SAVE is2
-
-       REAL(KIND=8) heavyside
-
-       pi       = 2. * ASIN(1.)
-       depi     = 2. * pi
-       epsilon  = 1.e-3
-       xzoom    = xzoomdeg * pi/180. 
-c
-           decalx   = .75
-       IF( grossism.EQ.1..AND.scal180 )  THEN
-           decalx   = 1.
-       ENDIF
-
-       WRITE(6,*) 'FXHYP scal180,decalx', scal180,decalx
-c
-       IF( dzooma.LT.1.)  THEN
-         dzoom = dzooma * depi
-       ELSEIF( dzooma.LT. 25. ) THEN
-         WRITE(6,*) ' Le param. dzoomx pour fxhyp est trop petit ! L aug
-     ,menter et relancer ! '
-         STOP 1
-       ELSE
-         dzoom = dzooma * pi/180.
-       ENDIF
-
-       WRITE(6,*) ' xzoom( rad.),grossism,tau,dzoom (radians)'
-       WRITE(6,24) xzoom,grossism,tau,dzoom
-
-       DO i = 0, nmax2 
-        xtild(i) = - pi + REAL(i) * depi /nmax2
-       ENDDO
-
-       DO i = nmax, nmax2
-
-       fa  = tau*  ( dzoom/2.  - xtild(i) )
-       fb  = xtild(i) *  ( pi - xtild(i) )
-
-         IF( 200.* fb .LT. - fa )   THEN
-           fhyp ( i) = - 1.
-         ELSEIF( 200. * fb .LT. fa ) THEN
-           fhyp ( i) =   1.
-         ELSE
-            IF( ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13)  THEN
-                IF(   200.*fb + fa.LT.1.e-10 )  THEN
-                    fhyp ( i ) = - 1.
-                ELSEIF( 200.*fb - fa.LT.1.e-10 )  THEN
-                    fhyp ( i )  =   1.
-                ENDIF
-            ELSE
-                    fhyp ( i )  =  TANH ( fa/fb )
-            ENDIF
-         ENDIF
-        IF ( xtild(i).EQ. 0. )  fhyp(i) =  1.
-        IF ( xtild(i).EQ. pi )  fhyp(i) = -1.
-
-       ENDDO
-
-cc  ....  Calcul  de  beta  ....
-
-       ffdx = 0.
-
-       DO i = nmax +1,nmax2
-
-       xmoy    = 0.5 * ( xtild(i-1) + xtild( i ) )
-       fa  = tau*  ( dzoom/2.  - xmoy )
-       fb  = xmoy *  ( pi - xmoy )
-
-       IF( 200.* fb .LT. - fa )   THEN
-         fxm = - 1.
-       ELSEIF( 200. * fb .LT. fa ) THEN
-         fxm =   1.
-       ELSE
-            IF( ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13)  THEN
-                IF(   200.*fb + fa.LT.1.e-10 )  THEN
-                    fxm   = - 1.
-                ELSEIF( 200.*fb - fa.LT.1.e-10 )  THEN
-                    fxm   =   1.
-                ENDIF
-            ELSE
-                    fxm   =  TANH ( fa/fb )
-            ENDIF
-       ENDIF
-
-       IF ( xmoy.EQ. 0. )  fxm  =  1.
-       IF ( xmoy.EQ. pi )  fxm  = -1.
-
-       ffdx = ffdx + fxm * ( xtild(i) - xtild(i-1) )
-
-       ENDDO
-
-        beta  = ( grossism * ffdx - pi ) / ( ffdx - pi )
-
-       IF( 2.*beta - grossism.LE. 0.)  THEN
-        WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou
-     ,tine fxhyp est mauvaise ! '
-        WRITE(6,*)'Modifier les valeurs de  grossismx ,tau ou dzoomx ',
-     , ' et relancer ! ***  '
-        CALL ABORT_GCM("FXHYP", "", 1)
-       ENDIF
-c
-c   .....  calcul  de  Xprimt   .....
-c
-       
-       DO i = nmax, nmax2
-        Xprimt(i) = beta  + ( grossism - beta ) * fhyp(i)
-       ENDDO
-c   
-       DO i =  nmax+1, nmax2
-        Xprimt( nmax2 - i ) = Xprimt( i )
-       ENDDO
-c
-
-c   .....  Calcul  de  Xf     ........
-
-       Xf(0) = - pi
-
-       DO i =  nmax +1, nmax2
-
-       xmoy    = 0.5 * ( xtild(i-1) + xtild( i ) )
-       fa  = tau*  ( dzoom/2.  - xmoy )
-       fb  = xmoy *  ( pi - xmoy )
-
-       IF( 200.* fb .LT. - fa )   THEN
-         fxm = - 1.
-       ELSEIF( 200. * fb .LT. fa ) THEN
-         fxm =   1.
-       ELSE
-         fxm =  TANH ( fa/fb )
-       ENDIF
-
-       IF ( xmoy.EQ. 0. )  fxm =  1.
-       IF ( xmoy.EQ. pi )  fxm = -1.
-       xxpr(i)    = beta + ( grossism - beta ) * fxm
-
-       ENDDO
-
-       DO i = nmax+1, nmax2
-        xxpr(nmax2-i+1) = xxpr(i)
-       ENDDO
-
-        DO i=1,nmax2
-         Xf(i)   = Xf(i-1) + xxpr(i) * ( xtild(i) - xtild(i-1) )
-        ENDDO
-
-
-c    *****************************************************************
-c
-
-c     .....  xuv = 0.   si  calcul  aux pts   scalaires   ........
-c     .....  xuv = 0.5  si  calcul  aux pts      U        ........
-c
-      WRITE(6,18)
-c
-      DO 5000  ik = 1, 4
-
-       IF( ik.EQ.1 )        THEN
-         xuv =  -0.25
-       ELSE IF ( ik.EQ.2 )  THEN
-         xuv =   0.
-       ELSE IF ( ik.EQ.3 )  THEN
-         xuv =   0.50
-       ELSE IF ( ik.EQ.4 )  THEN
-         xuv =   0.25
-       ENDIF
-
-      xo1   = 0.
-
-      ii1=1
-      ii2=iim
-      IF(ik.EQ.1.and.grossism.EQ.1.) THEN
-        ii1 = 2 
-        ii2 = iim+1
-      ENDIF
-      DO 1500 i = ii1, ii2
-
-      xlon2 = - pi + (REAL(i) + xuv - decalx) * depi / REAL(iim) 
-
-      Xfi    = xlon2
-c
-      DO 250 it =  nmax2,0,-1
-      IF( Xfi.GE.Xf(it))  GO TO 350
-250   CONTINUE
-
-      it = 0
-
-350   CONTINUE
-
-c    ......  Calcul de   Xf(xi)    ...... 
-c
-      xi  = xtild(it)
-
-      IF(it.EQ.nmax2)  THEN
-       it       = nmax2 -1
-       Xf(it+1) = pi
-      ENDIF
-c  .....................................................................
-c
-c   Appel de la routine qui calcule les coefficients a0,a1,a2,a3 d'un
-c   polynome de degre 3  qui passe  par les points (Xf(it),xtild(it) )
-c          et (Xf(it+1),xtild(it+1) )
-
-       CALL coefpoly ( Xf(it),Xf(it+1),Xprimt(it),Xprimt(it+1),
-     ,                xtild(it),xtild(it+1),  a0, a1, a2, a3  )
-
-       Xf1     = Xf(it)
-       Xprimin = a1 + 2.* a2 * xi + 3.*a3 * xi *xi
-
-       DO 500 iter = 1,300
-        xi = xi - ( Xf1 - Xfi )/ Xprimin
-
-        IF( ABS(xi-xo1).LE.epsilon)  GO TO 550
-         xo1      = xi
-         xi2      = xi * xi
-         Xf1      = a0 +  a1 * xi +     a2 * xi2  +     a3 * xi2 * xi
-         Xprimin  =       a1      + 2.* a2 *  xi  + 3.* a3 * xi2
-500   CONTINUE
-        WRITE(6,*) ' Pas de solution ***** ',i,xlon2,iter
-          STOP 6
-550   CONTINUE
-
-       xxprim(i) = depi/ ( REAL(iim) * Xprimin )
-       xvrai(i)  =  xi + xzoom
-
-1500   CONTINUE
-
-
-       IF(ik.EQ.1.and.grossism.EQ.1.)  THEN
-         xvrai(1)    = xvrai(iip1)-depi
-         xxprim(1)   = xxprim(iip1)
-       ENDIF
-
-       DO i = 1 , iim
-        xlon(i)     = xvrai(i)
-        xprimm(i)   = xxprim(i)
-       ENDDO
-       DO i = 1, iim -1
-        IF( xvrai(i+1). LT. xvrai(i) )  THEN
-         WRITE(6,*) ' PBS. avec rlonu(',i+1,') plus petit que rlonu(',i,
-     ,  ')'
-        STOP 7
-        ENDIF
-       ENDDO
-c
-c   ... Reorganisation  des  longitudes  pour les avoir  entre - pi et pi ..
-c   ........................................................................
-
-       champmin =  1.e12
-       champmax = -1.e12
-       DO i = 1, iim
-        champmin = MIN( champmin,xvrai(i) )
-        champmax = MAX( champmax,xvrai(i) )
-       ENDDO
-
-      IF(champmin .GE.-pi-0.10.and.champmax.LE.pi+0.10 )  THEN
-                GO TO 1600
-      ELSE
-       WRITE(6,*) 'Reorganisation des longitudes pour avoir entre - pi',
-     ,  ' et pi '
-c
-        IF( xzoom.LE.0.)  THEN
-          IF( ik.EQ. 1 )  THEN
-          DO i = 1, iim
-           IF( xvrai(i).GE. - pi )  GO TO 80
-          ENDDO
-            WRITE(6,*)  ' PBS. 1 !  Xvrai plus petit que  - pi ! '
-            STOP 8
- 80       CONTINUE
-          is2 = i
-          ENDIF
-
-          IF( is2.NE. 1 )  THEN
-            DO ii = is2 , iim
-             xlon  (ii-is2+1) = xvrai(ii)
-             xprimm(ii-is2+1) = xxprim(ii)
-            ENDDO
-            DO ii = 1 , is2 -1
-             xlon  (ii+iim-is2+1) = xvrai(ii) + depi
-             xprimm(ii+iim-is2+1) = xxprim(ii) 
-            ENDDO
-          ENDIF
-        ELSE 
-          IF( ik.EQ.1 )  THEN
-           DO i = iim,1,-1
-             IF( xvrai(i).LE. pi ) GO TO 90
-           ENDDO
-             WRITE(6,*) ' PBS.  2 ! Xvrai plus grand  que   pi ! '
-              STOP 9
- 90        CONTINUE
-            is2 = i
-          ENDIF
-           idif = iim -is2
-           DO ii = 1, is2
-            xlon  (ii+idif) = xvrai(ii)
-            xprimm(ii+idif) = xxprim(ii)
-           ENDDO
-           DO ii = 1, idif
-            xlon (ii)  = xvrai (ii+is2) - depi
-            xprimm(ii) = xxprim(ii+is2) 
-           ENDDO
-         ENDIF
-      ENDIF
-c
-c     .........   Fin  de la reorganisation   ............................
-
- 1600    CONTINUE
-
-
-         xlon  ( iip1)  = xlon(1) + depi
-         xprimm( iip1 ) = xprimm (1 )
-       
-         DO i = 1, iim+1
-         xvrai(i) = xlon(i)*180./pi
-         ENDDO
-
-         IF( ik.EQ.1 )  THEN
-c          WRITE(6,*)  ' XLON aux pts. V-0.25   apres ( en  deg. ) '
-c          WRITE(6,18) 
-c          WRITE(6,68) xvrai
-c          WRITE(6,*) ' XPRIM k ',ik
-c          WRITE(6,566)  xprimm
-
-           DO i = 1,iim +1
-             rlonm025(i) = xlon( i )
-            xprimm025(i) = xprimm(i)
-           ENDDO
-         ELSE IF( ik.EQ.2 )  THEN
-c          WRITE(6,18) 
-c          WRITE(6,*)  ' XLON aux pts. V   apres ( en  deg. ) '
-c          WRITE(6,68) xvrai
-c          WRITE(6,*) ' XPRIM k ',ik
-c          WRITE(6,566)  xprimm
-
-           DO i = 1,iim + 1
-             rlonv(i) = xlon( i )
-            xprimv(i) = xprimm(i)
-           ENDDO
-
-         ELSE IF( ik.EQ.3)   THEN
-c          WRITE(6,18) 
-c          WRITE(6,*)  ' XLON aux pts. U   apres ( en  deg. ) '
-c          WRITE(6,68) xvrai
-c          WRITE(6,*) ' XPRIM ik ',ik
-c          WRITE(6,566)  xprimm
-
-           DO i = 1,iim + 1
-             rlonu(i) = xlon( i )
-            xprimu(i) = xprimm(i)
-           ENDDO
-
-         ELSE IF( ik.EQ.4 )  THEN
-c          WRITE(6,18) 
-c          WRITE(6,*)  ' XLON aux pts. V+0.25   apres ( en  deg. ) '
-c          WRITE(6,68) xvrai
-c          WRITE(6,*) ' XPRIM ik ',ik
-c          WRITE(6,566)  xprimm
-
-           DO i = 1,iim + 1
-             rlonp025(i) = xlon( i )
-            xprimp025(i) = xprimm(i)
-           ENDDO
-
-         ENDIF
-
-5000    CONTINUE
-c
-       WRITE(6,18)
-c
-c    ...........  fin  de la boucle  do 5000      ............
-
-        DO i = 1, iim
-         xlon(i) = rlonv(i+1) - rlonv(i)
-        ENDDO
-        champmin =  1.e12
-        champmax = -1.e12
-        DO i = 1, iim
-         champmin = MIN( champmin, xlon(i) )
-         champmax = MAX( champmax, xlon(i) )
-        ENDDO
-         champmin = champmin * 180./pi
-         champmax = champmax * 180./pi
-
-18     FORMAT(/)
-24     FORMAT(2x,'Parametres xzoom,gross,tau ,dzoom pour fxhyp ',4f8.3)
-68     FORMAT(1x,7f9.2)
-566    FORMAT(1x,7f9.4)
-
-       RETURN
-       END
Index: LMDZ5/branches/testing/libf/dyn3dmem/gcm.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/gcm.F	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3dmem/gcm.F	(revision 2258)
@@ -1,4 +1,4 @@
 !
-! $Id$
+! $Id: $
 !
 c
@@ -23,12 +23,12 @@
 ! Only INCA needs these informations (from the Earth's physics)
       USE indice_sol_mod
+      USE mod_phys_lmdz_omp_data, ONLY: klon_omp 
 #endif
 
 #ifdef CPP_PHYS
-      USE mod_grid_phy_lmdz
-      USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
-      USE mod_phys_lmdz_omp_data, ONLY: klon_omp 
-      USE dimphy
-      USE comgeomphy
+!      USE mod_grid_phy_lmdz
+!      USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
+!      USE dimphy
+!      USE comgeomphy
 #endif
       IMPLICIT NONE
@@ -83,11 +83,4 @@
 #endif
 
-      INTEGER         longcles
-      PARAMETER     ( longcles = 20 )
-      REAL  clesphy0( longcles )
-      SAVE  clesphy0
-
-
-
       REAL zdtvr
 
@@ -111,13 +104,6 @@
 
       LOGICAL lafin
-c      INTEGER ij,iq,l,i,j
-      INTEGER i,j
-
 
       real time_step, t_wrt, t_ops
-
-
-      LOGICAL call_iniphys
-      data call_iniphys/.true./
 
 c+jld variables test conservation energie
@@ -142,17 +128,4 @@
 
 c-----------------------------------------------------------------------
-c    variables pour l'initialisation de la physique :
-c    ------------------------------------------------
-      INTEGER ngridmx
-      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
-      REAL zcufi(ngridmx),zcvfi(ngridmx)
-      REAL latfi(ngridmx),lonfi(ngridmx)
-      REAL airefi(ngridmx)
-      SAVE latfi, lonfi, airefi
-      
-      INTEGER :: ierr
-
-
-c-----------------------------------------------------------------------
 c   Initialisations:
 c   ----------------
@@ -171,12 +144,7 @@
 c  ---------------------------------------
 c
-! Ehouarn: dump possibility of using defrun
-!#ifdef CPP_IOIPSL
-      CALL conf_gcm( 99, .TRUE. , clesphy0 )
+      CALL conf_gcm( 99, .TRUE. )
       if (mod(iphysiq, iperiod) /= 0) call abort_gcm("conf_gcm",
      s "iphysiq must be a multiple of iperiod", 1)
-!#else
-!      CALL defrun( 99, .TRUE. , clesphy0 )
-!#endif
 c
 c
@@ -192,11 +160,12 @@
 #ifdef CPP_PHYS
         CALL Init_Phys_lmdz(iim,jjp1,llm,mpi_size,distrib_phys)
-#endif
+!#endif
+!      CALL set_bands
+!#ifdef CPP_PHYS
+      CALL Init_interface_dyn_phys
+#endif
+      CALL barrier
+
       CALL set_bands
-#ifdef CPP_PHYS
-      CALL Init_interface_dyn_phys
-#endif
-      CALL barrier
-
       if (mpi_rank==0) call WriteBands
       call Set_Distrib(distrib_caldyn)
@@ -206,9 +175,9 @@
 c$OMP END PARALLEL
 
-#ifdef CPP_PHYS
-c$OMP PARALLEL
-      call InitComgeomphy
-c$OMP END PARALLEL 
-#endif
+!#ifdef CPP_PHYS
+!c$OMP PARALLEL
+!      call InitComgeomphy ! now done in iniphysiq
+!c$OMP END PARALLEL 
+!#endif
 
 c-----------------------------------------------------------------------
@@ -225,5 +194,5 @@
         call ioconf_calendar('noleap')
         write(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
-      else if (calend == 'earth_366d') then
+      else if (calend == 'gregorian') then
         call ioconf_calendar('gregorian')
         write(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
@@ -321,9 +290,9 @@
 
 C
-C on remet le calendrier à zero si demande
+C on remet le calendrier \`a zero si demande
 c
       IF (start_time /= starttime) then
         WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le'
-     &,' fichier restart ne correspond pas à celle lue dans le run.def'
+     &,' fichier restart ne correspond pas a celle lue dans le run.def'
         IF (raz_date == 1) then
           WRITE(lunout,*)'Je prends l''heure lue dans run.def'
@@ -431,33 +400,12 @@
 c   Initialisation de la physique :
 c   -------------------------------
-      IF (call_iniphys.and.(iflag_phys==1.or.iflag_phys>=100)) THEN
-         latfi(1)=rlatu(1)
-         lonfi(1)=0.
-         zcufi(1) = cu(1)
-         zcvfi(1) = cv(1)
-         DO j=2,jjm
-            DO i=1,iim
-               latfi((j-2)*iim+1+i)= rlatu(j)
-               lonfi((j-2)*iim+1+i)= rlonv(i)
-               zcufi((j-2)*iim+1+i) = cu((j-1)*iip1+i)
-               zcvfi((j-2)*iim+1+i) = cv((j-1)*iip1+i)
-            ENDDO
-         ENDDO
-         latfi(ngridmx)= rlatu(jjp1)
-         lonfi(ngridmx)= 0.
-         zcufi(ngridmx) = cu(ip1jm+1)
-         zcvfi(ngridmx) = cv(ip1jm-iim)
-         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
-
-         WRITE(lunout,*)
-     .       'GCM: WARNING!!! vitesse verticale nulle dans la physique'
+      IF ((iflag_phys==1).or.(iflag_phys>=100)) THEN
 ! Physics:
 #ifdef CPP_PHYS
-         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys, 
-     &                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp, 
-     &                iflag_phys) 
-#endif
-         call_iniphys=.false.
-      ENDIF ! of IF (call_iniphys.and.(iflag_phys==1.or.iflag_phys>=100))
+         CALL iniphysiq(iim,jjm,llm,daysec,day_ini,dtphys/nsplit_phys,
+     &                rlatu,rlonv,aire,cu,cv,rad,g,r,cpp,
+     &                iflag_phys)
+#endif
+      ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
 
 
@@ -547,6 +495,5 @@
 
 c$OMP PARALLEL DEFAULT(SHARED) COPYIN(/temps/,/logici/,/logicl/)
-      CALL leapfrog_loc(ucov,vcov,teta,ps,masse,phis,q,clesphy0,
-     .              time_0)
+      CALL leapfrog_loc(ucov,vcov,teta,ps,masse,phis,q,time_0)
 c$OMP END PARALLEL
 
Index: LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_loc.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_loc.F	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_loc.F	(revision 2258)
@@ -9,6 +9,5 @@
 
       SUBROUTINE leapfrog_loc(ucov0,vcov0,teta0,ps0,
-     &                        masse0,phis0,q0,clesphy0,
-     &                        time_0)
+     &                        masse0,phis0,q0,time_0)
 
        USE misc_mod
@@ -82,6 +81,4 @@
 !      include "mpif.h"
       
-      INTEGER,PARAMETER :: longcles = 20
-      REAL,INTENT(IN) :: clesphy0( longcles ) ! not used
       REAL,INTENT(IN) :: time_0 ! not used
 
@@ -757,5 +754,5 @@
        IF( apphys )  THEN
        
-         CALL call_calfis(itau,lafin,clesphy0,ucov,vcov,teta,masse,ps,  
+         CALL call_calfis(itau,lafin,ucov,vcov,teta,masse,ps,  
      &                     phis,q,flxw)
 ! #ifdef DEBUG_IO    
@@ -882,5 +879,5 @@
 !      $               du,dv,dteta,dq,
 !      $               flxw,
-!      $               clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi  )
+!      $               dufi,dvfi,dtetafi,dqfi,dpfi  )
 ! !        CALL FTRACE_REGION_END("calfis")
 ! !        ijb=ij_begin
Index: LMDZ5/branches/testing/libf/dyn3dpar/calfis_p.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/calfis_p.F	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3dpar/calfis_p.F	(revision 2258)
@@ -21,5 +21,4 @@
      $                  pdq,
      $                  flxw,
-     $                  clesphy0,
      $                  pdufi,
      $                  pdvfi,
@@ -140,7 +139,4 @@
       REAL,INTENT(OUT) :: pdqfi(iip1,jjp1,llm,nqtot) ! tendency on tracers
       REAL,INTENT(OUT) :: pdpsfi(iip1,jjp1) ! tendency on surface pressure (Pa/s)
-
-      INTEGER,PARAMETER :: longcles = 20
-      REAL,INTENT(IN) :: clesphy0( longcles ) ! unused
 
 #ifdef CPP_PHYS
@@ -636,12 +632,9 @@
      .             zphis_omp,
      .             presnivs_omp,
-     .             clesphy0,
      .             zufi_omp,
      .             zvfi_omp,
      .             ztfi_omp,
      .             zqfi_omp,
-c#ifdef INCA
      .             flxwfi_omp,
-c#endif
      .             zdufi_omp,
      .             zdvfi_omp,
Index: LMDZ5/branches/testing/libf/dyn3dpar/ce0l.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/ce0l.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3dpar/ce0l.F90	(revision 2258)
@@ -48,12 +48,10 @@
 #endif
 
-  INTEGER, PARAMETER            :: longcles=20
   INTEGER                       :: ierr
-  REAL,    DIMENSION(longcles)  :: clesphy0
   REAL,    DIMENSION(iip1,jjp1) :: masque
   CHARACTER(LEN=15)             :: calnd
   REAL,    DIMENSION(iip1,jjp1) :: phis ! geopotentiel au sol
 !-------------------------------------------------------------------------------
-  CALL conf_gcm( 99, .TRUE. , clesphy0 )
+  CALL conf_gcm( 99, .TRUE. )
 
 #ifdef CPP_MPI
Index: LMDZ5/branches/testing/libf/dyn3dpar/conf_gcm.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/conf_gcm.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3dpar/conf_gcm.F90	(revision 2258)
@@ -2,5 +2,5 @@
 ! $Id$
 
-SUBROUTINE conf_gcm( tapedef, etatinit, clesphy0 )
+SUBROUTINE conf_gcm( tapedef, etatinit )
 
   USE control_mod
@@ -26,12 +26,7 @@
   !     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para- 
   !     -metres  du zoom  avec  celles lues sur le fichier start .
-  !      clesphy0 :  sortie  .
-
-  LOGICAL etatinit
-  INTEGER tapedef
-
-  INTEGER        longcles
-  PARAMETER(     longcles = 20 )
-  REAL clesphy0( longcles )
+
+  LOGICAL,INTENT(IN) :: etatinit
+  INTEGER,INTENT(IN) :: tapedef
 
   !   Declarations :
@@ -44,7 +39,4 @@
   include "temps.h"
   include "comconst.h"
-
-  ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
-  ! include "clesphys.h"
   include "iniprint.h"
 
Index: LMDZ5/branches/testing/libf/dyn3dpar/gcm.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/gcm.F	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3dpar/gcm.F	(revision 2258)
@@ -24,12 +24,12 @@
 ! Only INCA needs these informations (from the Earth's physics)
       USE indice_sol_mod
+      USE mod_phys_lmdz_omp_data, ONLY: klon_omp 
 #endif
 
 #ifdef CPP_PHYS
-      USE mod_grid_phy_lmdz
-      USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
-      USE mod_phys_lmdz_omp_data, ONLY: klon_omp 
-      USE dimphy
-      USE comgeomphy
+!      USE mod_grid_phy_lmdz
+!      USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
+!      USE dimphy
+!      USE comgeomphy
 #endif
       IMPLICIT NONE
@@ -84,11 +84,4 @@
 #endif
 
-      INTEGER         longcles
-      PARAMETER     ( longcles = 20 )
-      REAL  clesphy0( longcles )
-      SAVE  clesphy0
-
-
-
       REAL zdtvr
 
@@ -112,13 +105,7 @@
 
       LOGICAL lafin
-c      INTEGER ij,iq,l,i,j
-      INTEGER i,j
-
 
       real time_step, t_wrt, t_ops
 
-
-      LOGICAL call_iniphys
-      data call_iniphys/.true./
 
 c+jld variables test conservation energie
@@ -143,17 +130,4 @@
 
 c-----------------------------------------------------------------------
-c    variables pour l'initialisation de la physique :
-c    ------------------------------------------------
-      INTEGER ngridmx
-      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
-      REAL zcufi(ngridmx),zcvfi(ngridmx)
-      REAL latfi(ngridmx),lonfi(ngridmx)
-      REAL airefi(ngridmx)
-      SAVE latfi, lonfi, airefi
-      
-      INTEGER :: ierr
-
-
-c-----------------------------------------------------------------------
 c   Initialisations:
 c   ----------------
@@ -172,12 +146,7 @@
 c  ---------------------------------------
 c
-! Ehouarn: dump possibility of using defrun
-!#ifdef CPP_IOIPSL
-      CALL conf_gcm( 99, .TRUE. , clesphy0 )
+      CALL conf_gcm( 99, .TRUE. )
       if (mod(iphysiq, iperiod) /= 0) call abort_gcm("conf_gcm",
      s "iphysiq must be a multiple of iperiod", 1)
-!#else
-!      CALL defrun( 99, .TRUE. , clesphy0 )
-!#endif
 c
 c
@@ -193,11 +162,12 @@
 #ifdef CPP_PHYS
         CALL Init_Phys_lmdz(iim,jjp1,llm,mpi_size,distrib_phys)
-#endif
+!#endif
+!      CALL set_bands
+!#ifdef CPP_PHYS
+      CALL Init_interface_dyn_phys
+#endif
+      CALL barrier
+
       CALL set_bands
-#ifdef CPP_PHYS
-      CALL Init_interface_dyn_phys
-#endif
-      CALL barrier
-
       if (mpi_rank==0) call WriteBands
       call SetDistrib(jj_Nb_Caldyn)
@@ -207,9 +177,9 @@
 c$OMP END PARALLEL
 
-#ifdef CPP_PHYS
-c$OMP PARALLEL
-      call InitComgeomphy
-c$OMP END PARALLEL 
-#endif
+!#ifdef CPP_PHYS
+!c$OMP PARALLEL
+!      call InitComgeomphy ! now done in iniphysiq
+!c$OMP END PARALLEL 
+!#endif
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -431,33 +401,12 @@
 c   Initialisation de la physique :
 c   -------------------------------
-      IF (call_iniphys.and.(iflag_phys==1.or.iflag_phys>=100)) THEN
-         latfi(1)=rlatu(1)
-         lonfi(1)=0.
-         zcufi(1) = cu(1)
-         zcvfi(1) = cv(1)
-         DO j=2,jjm
-            DO i=1,iim
-               latfi((j-2)*iim+1+i)= rlatu(j)
-               lonfi((j-2)*iim+1+i)= rlonv(i)
-               zcufi((j-2)*iim+1+i) = cu((j-1)*iip1+i)
-               zcvfi((j-2)*iim+1+i) = cv((j-1)*iip1+i)
-            ENDDO
-         ENDDO
-         latfi(ngridmx)= rlatu(jjp1)
-         lonfi(ngridmx)= 0.
-         zcufi(ngridmx) = cu(ip1jm+1)
-         zcvfi(ngridmx) = cv(ip1jm-iim)
-         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
-
-         WRITE(lunout,*)
-     .       'GCM: WARNING!!! vitesse verticale nulle dans la physique'
+      IF ((iflag_phys==1).or.(iflag_phys>=100)) THEN
 ! Physics:
 #ifdef CPP_PHYS
-         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys,
-     &                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp,
+         CALL iniphysiq(iim,jjm,llm,daysec,day_ini,dtphys/nsplit_phys,
+     &                rlatu,rlonv,aire,cu,cv,rad,g,r,cpp,
      &                iflag_phys)
 #endif
-         call_iniphys=.false.
-      ENDIF ! of IF (call_iniphys.and.(iflag_phys==1.or.iflag_phys>=100))
+      ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
 
 
@@ -550,6 +499,5 @@
 
 c$OMP PARALLEL DEFAULT(SHARED) COPYIN(/temps/,/logici/,/logicl/)
-      CALL leapfrog_p(ucov,vcov,teta,ps,masse,phis,q,clesphy0,
-     .              time_0)
+      CALL leapfrog_p(ucov,vcov,teta,ps,masse,phis,q,time_0)
 c$OMP END PARALLEL
 
Index: LMDZ5/branches/testing/libf/dyn3dpar/leapfrog_p.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/leapfrog_p.F	(revision 2220)
+++ LMDZ5/branches/testing/libf/dyn3dpar/leapfrog_p.F	(revision 2258)
@@ -5,6 +5,5 @@
 c
 
-      SUBROUTINE leapfrog_p(ucov,vcov,teta,ps,masse,phis,q,clesphy0,
-     &                    time_0)
+      SUBROUTINE leapfrog_p(ucov,vcov,teta,ps,masse,phis,q,time_0)
 
       use exner_hyb_m, only: exner_hyb
@@ -77,6 +76,4 @@
 #include "academic.h"
       
-      INTEGER,PARAMETER :: longcles = 20
-      REAL,INTENT(IN) :: clesphy0( longcles ) ! not used
       REAL,INTENT(IN) :: time_0 ! not used
 
@@ -831,6 +828,5 @@
      $               ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
      $               du,dv,dteta,dq,
-     $               flxw,
-     $               clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi  )
+     $               flxw, dufi,dvfi,dtetafi,dqfi,dpfi  )
 !        CALL FTRACE_REGION_END("calfis")
         ijb=ij_begin
Index: LMDZ5/branches/testing/libf/phydev/iniphysiq.F90
===================================================================
--- LMDZ5/branches/testing/libf/phydev/iniphysiq.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phydev/iniphysiq.F90	(revision 2258)
@@ -2,26 +2,30 @@
 ! $Id: iniphysiq.F 1403 2010-07-01 09:02:53Z fairhead $
 !
-SUBROUTINE iniphysiq(ngrid, nlayer, punjours, pdayref, ptimestep, plat, plon, &
-    parea, pcu, pcv, prad, pg, pr, pcpp, iflag_phys)
-  USE dimphy, ONLY: klev
-  USE mod_grid_phy_lmdz, ONLY: klon_glo
-  USE mod_phys_lmdz_para, ONLY: klon_omp, klon_omp_begin, klon_omp_end, &
-    klon_mpi_begin
-  USE comgeomphy, ONLY: airephy, cuphy, cvphy, rlond, rlatd
-  USE comcstphy, ONLY: rradius, rg, rr, rcpp
+SUBROUTINE iniphysiq(iim,jjm,nlayer,punjours, pdayref,ptimestep,         &
+                     rlatu,rlonv,aire,cu,cv,                             &
+                     prad,pg,pr,pcpp,iflag_phys)
+  USE dimphy, ONLY: klev ! number of atmospheric levels
+  USE mod_grid_phy_lmdz, ONLY: klon_glo ! number of atmospheric columns
+                                        ! (on full grid)
+  USE mod_phys_lmdz_para, ONLY: klon_omp, & ! number of columns (on local omp grid)
+                                klon_omp_begin, & ! start index of local omp subgrid
+                                klon_omp_end, & ! end index of local omp subgrid
+                                klon_mpi_begin ! start indes of columns (on local mpi grid)
+  USE comgeomphy, ONLY: initcomgeomphy, &
+                        airephy, & ! physics grid area (m2)
+                        cuphy, & ! cu coeff. (u_covariant = cu * u)
+                        cvphy, & ! cv coeff. (v_covariant = cv * v)
+                        rlond, & ! longitudes
+                        rlatd ! latitudes
+  USE comcstphy, ONLY: rradius, & ! planet radius (m)
+                       rr, & ! recuced gas constant: R/molar mass of atm
+                       rg, & ! gravity
+                       rcpp  ! specific heat of the atmosphere
   USE phyaqua_mod, ONLY: iniaqua
   IMPLICIT NONE
   !
   !=======================================================================
-  !
   !   Initialisation of the physical constants and some positional and 
   !   geometrical arrays for the physics
-  !
-  !
-  !    ngrid                 Size of the horizontal grid.
-  !                          All internal loops are performed on that grid.
-  !    nlayer                Number of vertical layers.
-  !    pdayref               Day of reference for the simulation
-  !
   !=======================================================================
  
@@ -34,19 +38,30 @@
   REAL,INTENT(IN) :: pcpp ! specific heat Cp
   REAL,INTENT(IN) :: punjours ! length (in s) of a standard day
-  INTEGER,INTENT(IN) :: ngrid ! number of horizontal grid points in the physics
-  INTEGER,INTENT(IN) :: nlayer ! number of atmospheric layers
-  REAL,INTENT(IN) :: plat(ngrid) ! latitudes of the physics grid
-  REAL,INTENT(IN) :: plon(ngrid) ! longitudes of the physics grid
-  REAL,INTENT(IN) :: parea(klon_glo) ! area (m2)
-  REAL,INTENT(IN) :: pcu(klon_glo) ! cu coeff. (u_covariant = cu * u)
-  REAL,INTENT(IN) :: pcv(klon_glo) ! cv coeff. (v_covariant = cv * v)
-  INTEGER,INTENT(IN) :: pdayref ! reference day of for the simulation
+  INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers
+  INTEGER, INTENT (IN) :: iim ! number of atmospheric coulumns along longitudes
+  INTEGER, INTENT (IN) :: jjm  ! number of atompsheric columns along latitudes
+  REAL, INTENT (IN) :: rlatu(jjm+1) ! latitudes of the physics grid
+  REAL, INTENT (IN) :: rlonv(iim+1) ! longitudes of the physics grid
+  REAL, INTENT (IN) :: aire(iim+1,jjm+1) ! area of the dynamics grid (m2)
+  REAL, INTENT (IN) :: cu((iim+1)*(jjm+1)) ! cu coeff. (u_covariant = cu * u)
+  REAL, INTENT (IN) :: cv((iim+1)*jjm) ! cv coeff. (v_covariant = cv * v)
+  INTEGER, INTENT (IN) :: pdayref ! reference day of for the simulation
   REAL,INTENT(IN) :: ptimestep !physics time step (s)
   INTEGER,INTENT(IN) :: iflag_phys ! type of physics to be called
 
   INTEGER :: ibegin,iend,offset
+  INTEGER :: i,j
   CHARACTER (LEN=20) :: modname='iniphysiq'
   CHARACTER (LEN=80) :: abort_message
- 
+  REAL :: total_area_phy, total_area_dyn
+
+
+  ! global array, on full physics grid:
+  REAL,ALLOCATABLE :: latfi(:)
+  REAL,ALLOCATABLE :: lonfi(:)
+  REAL,ALLOCATABLE :: cufi(:)
+  REAL,ALLOCATABLE :: cvfi(:)
+  REAL,ALLOCATABLE :: airefi(:)
+
   IF (nlayer.NE.klev) THEN
     WRITE(lunout,*) 'STOP in ',trim(modname)
@@ -58,22 +73,59 @@
   ENDIF
 
-  IF (ngrid.NE.klon_glo) THEN
-    WRITE(lunout,*) 'STOP in ',trim(modname)
-    WRITE(lunout,*) 'Problem with dimensions :'
-    WRITE(lunout,*) 'ngrid     = ',ngrid
-    WRITE(lunout,*) 'klon   = ',klon_glo
-    abort_message = ''
-    CALL abort_gcm (modname,abort_message,1)
-  ENDIF
+  !call init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
+  
+  ! Generate global arrays on full physics grid
+  ALLOCATE(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
+  ALLOCATE(airefi(klon_glo))
 
-  !$OMP PARALLEL PRIVATE(ibegin,iend) &
-  !$OMP          SHARED(parea,pcu,pcv,plon,plat)
-      
+    ! North pole
+    latfi(1)=rlatu(1)
+    lonfi(1)=0.
+    cufi(1) = cu(1)
+    cvfi(1) = cv(1)
+    DO j=2,jjm
+      DO i=1,iim
+        latfi((j-2)*iim+1+i)= rlatu(j)
+        lonfi((j-2)*iim+1+i)= rlonv(i)
+        cufi((j-2)*iim+1+i) = cu((j-1)*iim+1+i)
+        cvfi((j-2)*iim+1+i) = cv((j-1)*iim+1+i)
+      ENDDO
+    ENDDO
+    ! South pole
+    latfi(klon_glo)= rlatu(jjm+1)
+    lonfi(klon_glo)= 0.
+    cufi(klon_glo) = cu((iim+1)*jjm+1)
+    cvfi(klon_glo) = cv((iim+1)*jjm-iim)
+
+    ! build airefi(), mesh area on physics grid
+    CALL gr_dyn_fi(1,iim+1,jjm+1,klon_glo,aire,airefi)
+    ! Poles are single points on physics grid
+    airefi(1)=sum(aire(1:iim,1))
+    airefi(klon_glo)=sum(aire(1:iim,jjm+1))
+
+    ! Sanity check: do total planet area match between physics and dynamics?
+    total_area_dyn=sum(aire(1:iim,1:jjm+1))
+    total_area_phy=sum(airefi(1:klon_glo))
+    IF (total_area_dyn/=total_area_phy) THEN
+      WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
+      WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
+      WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
+      IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
+        ! stop here if the relative difference is more than 0.001%
+        abort_message = 'planet total surface discrepancy'
+        CALL abort_gcm(modname, abort_message, 1)
+      ENDIF
+    ENDIF
+
+!$OMP PARALLEL 
+  ! Now generate local lon/lat/cu/cv/area arrays
+  CALL initcomgeomphy
+
   offset = klon_mpi_begin - 1
-  airephy(1:klon_omp) = parea(offset+klon_omp_begin:offset+klon_omp_end)
-  cuphy(1:klon_omp) = pcu(offset+klon_omp_begin:offset+klon_omp_end)
-  cvphy(1:klon_omp) = pcv(offset+klon_omp_begin:offset+klon_omp_end)
-  rlond(1:klon_omp) = plon(offset+klon_omp_begin:offset+klon_omp_end)
-  rlatd(1:klon_omp) = plat(offset+klon_omp_begin:offset+klon_omp_end)
+  airephy(1:klon_omp) = airefi(offset+klon_omp_begin:offset+klon_omp_end)
+  cuphy(1:klon_omp) = cufi(offset+klon_omp_begin:offset+klon_omp_end)
+  cvphy(1:klon_omp) = cvfi(offset+klon_omp_begin:offset+klon_omp_end)
+  rlond(1:klon_omp) = lonfi(offset+klon_omp_begin:offset+klon_omp_end)
+  rlatd(1:klon_omp) = latfi(offset+klon_omp_begin:offset+klon_omp_end)
 
   ! copy some fundamental parameters to physics
@@ -83,12 +135,12 @@
   rcpp=pcpp
 
-  !$OMP END PARALLEL
+!$OMP END PARALLEL
 
   ! Additional initializations for aquaplanets 
-  !$OMP PARALLEL
+!$OMP PARALLEL
   IF (iflag_phys>=100) THEN
     CALL iniaqua(klon_omp,rlatd,rlond,iflag_phys)
   ENDIF
-  !$OMP END PARALLEL
+!$OMP END PARALLEL
 
 END SUBROUTINE iniphysiq
Index: LMDZ5/branches/testing/libf/phydev/physiq.F90
===================================================================
--- LMDZ5/branches/testing/libf/phydev/physiq.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phydev/physiq.F90	(revision 2258)
@@ -4,5 +4,5 @@
       SUBROUTINE physiq (nlon,nlev, &
      &            debut,lafin,jD_cur, jH_cur,pdtphys, &
-     &            paprs,pplay,pphi,pphis,presnivs,clesphy0, &
+     &            paprs,pplay,pphi,pphis,presnivs, &
      &            u,v,t,qx, &
      &            flxmass_w, &
@@ -45,6 +45,4 @@
       real,intent(in) :: pphis(klon) ! surface geopotential
       real,intent(in) :: presnivs(klev) ! pseudo-pressure (Pa) of mid-layers
-      integer,parameter :: longcles=20
-      real,intent(in) :: clesphy0(longcles) ! Not used
       real,intent(in) :: u(klon,klev) ! eastward zonal wind (m/s)
       real,intent(in) :: v(klon,klev) ! northward meridional wind (m/s)
Index: LMDZ5/branches/testing/libf/phylmd/add_pbl_tend.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/add_pbl_tend.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/add_pbl_tend.F90	(revision 2258)
@@ -1,3 +1,3 @@
-SUBROUTINE add_pbl_tend(zdu, zdv, zdt, zdq, zdql, zdqi, paprs, text)
+SUBROUTINE add_pbl_tend(zdu, zdv, zdt, zdq, zdql, zdqi, paprs, text,abortphy)
   ! ======================================================================
   ! Ajoute les tendances de couche limite, soit determinees par la
@@ -20,4 +20,5 @@
   REAL hqturb_gcssold(llm)
   REAL dtime_frcg
+  INTEGER abortphy
   LOGICAL turb_fcg_gcssold
   COMMON /turb_forcing/dtime_frcg, hthturb_gcssold, hqturb_gcssold, &
@@ -46,7 +47,7 @@
     PRINT *, ' add_pbl_tend, zzdt ', zzdt
     PRINT *, ' add_pbl_tend, zzdq ', zzdq
-    CALL add_phys_tend(zdu, zdv, zzdt, zzdq, zdql, zdqi, paprs, text)
+    CALL add_phys_tend(zdu, zdv, zzdt, zzdq, zdql, zdqi, paprs, text,abortphy)
   ELSE
-    CALL add_phys_tend(zdu, zdv, zdt, zdq, zdql, zdqi, paprs, text)
+    CALL add_phys_tend(zdu, zdv, zdt, zdq, zdql, zdqi, paprs, text,abortphy)
   END IF
 
Index: LMDZ5/branches/testing/libf/phylmd/add_phys_tend.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/add_phys_tend.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/add_phys_tend.F90	(revision 2258)
@@ -2,5 +2,5 @@
 ! $Id$
 !
-SUBROUTINE add_phys_tend (zdu,zdv,zdt,zdq,zdql,zdqi,paprs,text)
+SUBROUTINE add_phys_tend (zdu,zdv,zdt,zdq,zdql,zdqi,paprs,text,abortphy)
 !======================================================================
 ! Ajoute les tendances des variables physiques aux variables 
@@ -28,4 +28,5 @@
 REAL paprs(klon,klev+1)
 CHARACTER*(*) text
+INTEGER abortphy
 
 ! Local :
@@ -52,5 +53,8 @@
 ! Initialisations
 
-debug_level=10
+      IF (abortphy==1) RETURN ! on n ajoute pas les tendance si le modele
+                              ! a deja plante.
+
+     debug_level=10
      if (first) then
         itap=0
@@ -230,5 +234,23 @@
 ENDIF
 
-      CALL hgardfou(t_seri,ftsol,text)
+
+!======================================================================
+! Contrôle des min/max pour arrêt du modèle
+! Si le modele est en mode abortphy, on retire les tendances qu'on
+! vient d'ajouter. Pas exactement parce qu'on ne tient pas compte des
+! seuils.
+!======================================================================
+
+      CALL hgardfou(t_seri,ftsol,text,abortphy) 
+      IF (abortphy==1) THEN
+        Print*,'ERROR ABORT hgardfou dans ',text
+        u_seri(:,:)=u_seri(:,:)-zdu(:,:)
+        v_seri(:,:)=v_seri(:,:)-zdv(:,:)
+        ql_seri(:,:)=ql_seri(:,:)-zdql(:,:)
+        qs_seri(:,:)=qs_seri(:,:)-zdqi(:,:)
+      ENDIF
+
+
+
       RETURN
       END
Index: LMDZ5/branches/testing/libf/phylmd/calcratqs.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/calcratqs.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/calcratqs.F90	(revision 2258)
@@ -1,4 +1,4 @@
 SUBROUTINE calcratqs(klon,klev,prt_level,lunout,       &
-           iflag_ratqs,iflag_con,iflag_cldth,pdtphys, &
+           iflag_ratqs,iflag_con,iflag_cld_th,pdtphys, &
            ratqsbas,ratqshaut,tau_ratqs,fact_cldcon,   &
            ptconv,ptconvth,clwcon0th, rnebcon0th,      &
@@ -19,5 +19,5 @@
 ! Input
 integer,intent(in) :: klon,klev,prt_level,lunout
-integer,intent(in) :: iflag_con,iflag_cldth,iflag_ratqs
+integer,intent(in) :: iflag_con,iflag_cld_th,iflag_ratqs
 real,intent(in) :: pdtphys,ratqsbas,ratqshaut,fact_cldcon,tau_ratqs
 real, dimension(klon,klev+1),intent(in) :: paprs
@@ -43,5 +43,5 @@
 !   ----------------
 !   on ecrase le tableau ratqsc calcule par clouds_gno
-      if (iflag_cldth.eq.1) then
+      if (iflag_cld_th.eq.1) then
          do k=1,klev
          do i=1,klon
@@ -58,5 +58,5 @@
 !  par nversion de la fonction log normale
 !-----------------------------------------------------------------------
-      else if (iflag_cldth.eq.4) then
+      else if (iflag_cld_th.eq.4) then
          ptconvth(:,:)=.false.
          ratqsc(:,:)=0.
@@ -136,5 +136,5 @@
 !  -----------
 
-      if (iflag_cldth.eq.1 .or.iflag_cldth.eq.2.or.iflag_cldth.eq.4) then
+      if (iflag_cld_th.eq.1 .or.iflag_cld_th.eq.2.or.iflag_cld_th.eq.4) then
 
 ! On ajoute une constante au ratqsc*2 pour tenir compte de 
@@ -165,5 +165,5 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
          ratqs(:,:)=max(ratqs(:,:),ratqss(:,:))
-      else if (iflag_cldth<=6) then
+      else if (iflag_cld_th<=6) then
 !   on ne prend que le ratqs stable pour fisrtilp
          ratqs(:,:)=ratqss(:,:)
@@ -174,5 +174,5 @@
              do i=1,klon
                 if (ratqsc(i,k).gt.1.e-10) then
-                   ratqs(i,k)=ratqs(i,k)*zfratqs2+(iflag_cldth/100.)*ratqsc(i,k)*(1.-zfratqs2)
+                   ratqs(i,k)=ratqs(i,k)*zfratqs2+(iflag_cld_th/100.)*ratqsc(i,k)*(1.-zfratqs2)
                 endif
                 ratqs(i,k)=min(ratqs(i,k)*zfratqs1+ratqss(i,k)*(1.-zfratqs1),0.5)
Index: LMDZ5/branches/testing/libf/phylmd/cdrag.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/cdrag.F90	(revision 2258)
+++ LMDZ5/branches/testing/libf/phylmd/cdrag.F90	(revision 2258)
@@ -0,0 +1,225 @@
+!
+!$Id: cdrag.F90 ???? 2015-??-?? ??:??:??Z ? $
+!
+ SUBROUTINE cdrag( knon,  nsrf,   &
+     speed, t1,    q1,    zgeop1, &
+     psol,  tsurf, qsurf, rugos,  &
+     pcfm,  pcfh,  zri,   pref )
+
+  USE dimphy
+  USE indice_sol_mod
+  IMPLICIT NONE
+! ================================================================= c
+!
+! Objet : calcul des cdrags pour le moment (pcfm) et 
+!         les flux de chaleur sensible et latente (pcfh).   
+!
+! Modified histroy: 
+!   27-Jan-2014: richardson number inconsistant between
+!   coefcdrag.F90 and clcdrag.F90, Fuxing WANG wrote this subroutine
+!   by merging coefcdrag and clcdrag.
+!
+! References:
+!   Louis, J. F., 1979: A parametric model of vertical eddy fluxes in the
+!     atmosphere. Boundary-Layer Meteorology. 01/1979; 17(2):187-202. 
+!   Louis, J. F., Tiedtke, M. and Geleyn, J. F., 1982: `A short history of the
+!     operational PBL parametrization at ECMWF'. Workshop on boundary layer
+!     parametrization, November 1981, ECMWF, Reading, England. 
+!     Page: 19. Equations in Table 1.
+!   Anton Beljaars. May 1992. The parametrization of the planetary boundary layer.  
+!     European Centre for Medium-Range Weather Forecasts.
+!     Equations: 110-113. Page 40.
+!   Miller,M.J., A.C.M.Beljaars, T.N.Palmer. 1992. The sensitivity of the ECMWF
+!     model to the parameterization of evaporation from the tropical oceans. J.
+!     Climate, 5:418-434.
+!
+! ================================================================= c
+!
+! knon----input-I- nombre de points pour un type de surface
+! nsrf----input-I- indice pour le type de surface; voir indicesol.h
+! speed---input-R- module du vent au 1er niveau du modele
+! t1------input-R- temperature de l'air au 1er niveau du modele
+! q1------input-R- humidite de l'air au 1er niveau du modele
+! zgeop---input-R- geopotentiel au 1er niveau du modele
+! psol----input-R- pression au sol
+! tsurf---input-R- temperature de l'air a la surface 
+! qsurf---input-R- humidite de l'air a la surface
+! rugos---input-R- rugosite
+!! u1, v1 are removed, speed is used. Fuxing WANG, 04/03/2015,
+!! u1------input-R- vent zonal au 1er niveau du modele
+!! v1------input-R- vent meridien au 1er niveau du modele
+!
+! pcfm---output-R- cdrag pour le moment 
+! pcfh---output-R- cdrag pour les flux de chaleur latente et sensible
+! zri----output-R- Richardson number
+! pref---output-R- pression au niveau zgeop/RG
+!
+! Parameters: 
+! ckap-----Karman constant
+! cb,cc,cd-parameters in Louis et al., 1982
+! ================================================================= c
+!
+!
+! Parametres d'entree
+!***************************************************************** 
+  INTEGER, INTENT(IN)                      :: knon, nsrf
+  REAL, DIMENSION(klon), INTENT(IN)        :: speed ! module du vent au 1er niveau du modele
+  REAL, DIMENSION(klon), INTENT(IN)        :: zgeop1! geopotentiel au 1er niveau du modele
+  REAL, DIMENSION(klon), INTENT(IN)        :: psol  ! pression au sol
+  REAL, DIMENSION(klon), INTENT(IN)        :: t1    ! temperature at 1st level
+  REAL, DIMENSION(klon), INTENT(IN)        :: q1    ! humidity at 1st level
+  REAL, DIMENSION(klon), INTENT(IN)        :: tsurf ! Surface temperature (K)
+  REAL, DIMENSION(klon), INTENT(IN)        :: qsurf ! Surface humidity (Kg/Kg)
+  REAL, DIMENSION(klon), INTENT(IN)        :: rugos ! Rugosity at surface (m) 
+!  paprs, pplay u1, v1: to be deleted
+!  they were in the old clcdrag. Fuxing WANG, 04/03/2015
+!  REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
+!  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
+!  REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
+
+! Parametres de sortie
+!******************************************************************
+  REAL, DIMENSION(klon), INTENT(OUT)       :: pcfm  ! Drag coefficient for heat flux
+  REAL, DIMENSION(klon), INTENT(OUT)       :: pcfh  ! Drag coefficient for momentum
+  REAL, DIMENSION(klon), INTENT(OUT)       :: zri   ! Richardson number
+  REAL, DIMENSION(klon), INTENT(OUT)       :: pref  ! Pression au niveau zgeop/RG
+
+! Parametres local
+  INTEGER                                  :: ng_q1    ! Number of grids that q1 < 0.0
+  INTEGER                                  :: ng_qsurf ! Number of grids that qsurf < 0.0
+!  zgeop1, psol: to be deleted, they are inputs now. Fuxing WANG, 04/03/2015
+!  REAL, DIMENSION(klon)                    :: zgeop1! geopotentiel au 1er niveau du modele
+!  REAL, DIMENSION(klon)                    :: psol  ! pression au sol
+!
+! ================================================================= c
+!
+  INCLUDE "YOMCST.h"
+  INCLUDE "YOETHF.h"
+!  INCLUDE "indicesol.h"
+  INCLUDE "clesphys.h"
+  INCLUDE "iniprint.h"
+!
+! Quelques constantes et options:
+!!$PB      REAL, PARAMETER :: ckap=0.35, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2
+  REAL, PARAMETER :: CKAP=0.40, CB=5.0, CC=5.0, CD=5.0, CEPDU2 = (0.1)**2
+!
+! Variables locales :
+  INTEGER               :: i
+  REAL                  :: zdu2, ztsolv
+  REAL                  :: ztvd, zscf
+  REAL                  :: zucf, zcr
+  REAL                  :: friv, frih
+  REAL, DIMENSION(klon) :: zcfm1, zcfm2 ! Drag coefficient for momentum
+  REAL, DIMENSION(klon) :: zcfh1, zcfh2 ! Drag coefficient for heat flux
+  LOGICAL, PARAMETER    :: zxli=.FALSE. ! calcul des cdrags selon Laurent Li
+  REAL, DIMENSION(klon) :: zcdn         ! Drag coefficient in neutral conditions
+!
+! Fonctions thermodynamiques et fonctions d'instabilite
+  REAL                  :: fsta, fins, x
+  fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
+  fins(x) = SQRT(1.0-18.0*x)
+
+! ================================================================= c
+! Fuxing WANG, 04/03/2015, delete the calculation of zgeop1 
+! (le geopotentiel du premier couche de modele).
+! zgeop1 is an input ivariable in this subroutine.
+!  DO i = 1, knon
+!     zgeop1(i) = RD * t1(i) / (0.5*(paprs(i,1)+pplay(i,1))) &
+!          * (paprs(i,1)-pplay(i,1))
+!  END DO
+! ================================================================= c
+!
+! Fuxing WANG, 04/03/2015
+! To check if there are negative q1, qsurf values.
+  ng_q1 = 0     ! Initialization
+  ng_qsurf = 0  ! Initialization
+  DO i = 1, knon
+     IF (q1(i).LT.0.0)     ng_q1 = ng_q1 + 1
+     IF (qsurf(i).LT.0.0)  ng_qsurf = ng_qsurf + 1
+  ENDDO
+  IF (ng_q1.GT.0) THEN
+      WRITE(lunout,*)" *** Warning: Negative q1(humidity at 1st level) values in cdrag.F90 !"
+      WRITE(lunout,*)" The total number of the grids is: ", ng_q1
+      WRITE(lunout,*)" The negative q1 is set to zero "
+!      abort_message="voir ci-dessus"
+!      CALL abort_gcm(modname,abort_message,1)
+  ENDIF
+  IF (ng_qsurf.GT.0) THEN
+      WRITE(lunout,*)" *** Warning: Negative qsurf(humidity at surface) values in cdrag.F90 !"
+      WRITE(lunout,*)" The total number of the grids is: ", ng_qsurf
+      WRITE(lunout,*)" The negative qsurf is set to zero "
+!      abort_message="voir ci-dessus"
+!      CALL abort_gcm(modname,abort_message,1)
+  ENDIF
+
+! Calculer le frottement au sol (Cdrag)
+  DO i = 1, knon
+!------------------------------------------------------------
+! u1, v1 are replaced by speed. Fuxing WANG, 04/03/2015,
+!     zdu2 = MAX(CEPDU2,u1(i)**2+v1(i)**2)
+!------------------------------------------------------------
+     zdu2 = MAX(CEPDU2, speed(i)**2)
+!     psol(i) = paprs(i,1)
+     pref(i) = EXP(LOG(psol(i)) - zgeop1(i)/(RD*t1(i)* &
+                 (1.+ RETV * max(q1(i),0.0))))  ! negative q1 set to zero
+!------------ the old calculations in clcdrag----------------
+!     ztsolv = tsurf(i) * (1.0+RETV*qsurf(i)) 
+!     ztvd = (t1(i)+zgeop1(i)/RCPD/(1.+RVTMP2*q1(i))) &
+!          *(1.+RETV*q1(i)) 
+!------------------------------------------------------------
+! Fuxing WANG, 04/03/2015, in this revised version, 
+! the negative qsurf and q1 are set to zero (as in coefcdrag)
+     ztsolv = tsurf(i) * (1.0+RETV*max(qsurf(i),0.0)) ! negative qsurf set to zero
+     ztvd = (t1(i)+zgeop1(i)/RCPD/(1.+RVTMP2*q1(i))) &
+          *(1.+RETV*max(q1(i),0.0)) ! negative q1 set to zero
+     zri(i) = zgeop1(i)*(ztvd-ztsolv)/(zdu2*ztvd)
+     zcdn(i) = (CKAP/LOG(1.+zgeop1(i)/(RG*rugos(i))))**2
+
+     IF (zri(i) .GT. 0.) THEN      ! situation stable
+        zri(i) = MIN(20.,zri(i))
+        IF (.NOT.zxli) THEN
+           zscf = SQRT(1.+CD*ABS(zri(i)))
+           friv = AMAX1(1. / (1.+2.*CB*zri(i)/ZSCF), f_ri_cd_min)
+           zcfm1(i) = zcdn(i) * friv
+           frih = AMAX1(1./ (1.+3.*CB*zri(i)*ZSCF), f_ri_cd_min )
+!!$ PB     zcfh1(i) = zcdn(i) * frih
+!!$ PB     zcfh1(i) = f_cdrag_stable * zcdn(i) * frih
+           zcfh1(i) = f_cdrag_ter * zcdn(i) * frih
+           IF(nsrf.EQ.is_oce) zcfh1(i) = f_cdrag_oce * zcdn(i) * frih
+!!$ PB
+           pcfm(i) = zcfm1(i)
+           pcfh(i) = zcfh1(i)
+        ELSE
+           pcfm(i) = zcdn(i)* fsta(zri(i))
+           pcfh(i) = zcdn(i)* fsta(zri(i))
+        ENDIF
+     ELSE                          ! situation instable
+        IF (.NOT.zxli) THEN
+           zucf = 1./(1.+3.0*CB*CC*zcdn(i)*SQRT(ABS(zri(i)) &
+                *(1.0+zgeop1(i)/(RG*rugos(i)))))
+           zcfm2(i) = zcdn(i)*amax1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min)
+!!$ PB     zcfh2(i) = zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),f_ri_cd_min)
+           zcfh2(i) = f_cdrag_ter*zcdn(i)*amax1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min)
+           pcfm(i) = zcfm2(i)
+           pcfh(i) = zcfh2(i)
+        ELSE
+           pcfm(i) = zcdn(i)* fins(zri(i))
+           pcfh(i) = zcdn(i)* fins(zri(i))
+        ENDIF
+! cdrah sur l'ocean cf. Miller et al. (1992)
+        zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
+        IF(nsrf.EQ.is_oce) pcfh(i) =f_cdrag_oce* zcdn(i)*(1.0+zcr**1.25)**(1./1.25)
+     ENDIF
+  END DO
+
+! ================================================================= c
+     
+  ! IM cf JLD : on seuille cdrag_m et cdrag_h
+  IF (nsrf == is_oce) THEN
+     DO i=1,knon
+        pcfm(i)=MIN(pcfm(i),cdmmax)
+        pcfh(i)=MIN(pcfh(i),cdhmax)
+     END DO
+  END IF
+
+END SUBROUTINE cdrag
Index: LMDZ5/branches/testing/libf/phylmd/change_srf_frac_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/change_srf_frac_mod.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/change_srf_frac_mod.F90	(revision 2258)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 MODULE change_srf_frac_mod
@@ -12,5 +12,11 @@
 
   SUBROUTINE change_srf_frac(itime, dtime, jour, &
-       pctsrf, alb1, alb2, tsurf, ustar, u10m, v10m, pbl_tke)
+!albedo SB >>>
+!       pctsrf, alb1, alb2, tsurf, ustar, u10m, v10m, pbl_tke)
+        pctsrf, alb_dir, alb_dif, tsurf, ustar, u10m, v10m, pbl_tke)
+!albedo SB <<<
+   
+
+
 !
 ! This subroutine is called from physiq.F at each timestep. 
@@ -32,4 +38,9 @@
     INCLUDE "iniprint.h"
     INCLUDE "YOMCST.h"
+!albedo SB >>>
+    include "clesphys.h"
+!albedo SB <<<
+
+
 
 ! Input arguments
@@ -43,6 +54,10 @@
    
     REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf ! sub-surface fraction
-    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: alb1   ! albedo first interval in SW spektrum
-    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: alb2   ! albedo second interval in SW spektrum
+!albedo SB >>>
+!   REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: alb1   ! albedo first interval in SW spektrum
+!   REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: alb2   ! albedo second interval in SW spektrum
+    REAL, DIMENSION(klon,nsw,nbsrf), INTENT(INOUT) :: alb_dir,alb_dif
+!albedo SB <<<
+
     REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: tsurf
     REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: ustar
@@ -160,5 +175,12 @@
 ! 
 !****************************************************************************************
-       CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old, tsurf, alb1, alb2, ustar, u10m, v10m, pbl_tke)
+
+!albedo SB >>>
+! CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old, tsurf, alb1, alb2, ustar,
+! u10m, v10m, pbl_tke)
+       CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old, tsurf, alb_dir,alb_dif, ustar, u10m, v10m, pbl_tke)
+!albedo SB <<<
+
+
 
     ELSE
Index: LMDZ5/branches/testing/libf/phylmd/clcdrag.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/clcdrag.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/clcdrag.F90	(revision 2258)
@@ -61,4 +61,9 @@
   REAL, DIMENSION(klon) :: zgeop1       ! geopotentiel au 1er niveau du modele
   LOGICAL, PARAMETER    :: zxli=.FALSE. ! calcul des cdrags selon Laurent Li
+
+  CHARACTER (LEN=80) :: abort_message
+  CHARACTER (LEN=20) :: modname = 'clcdrag'
+
+
 !
 ! Fonctions thermodynamiques et fonctions d'instabilite
@@ -66,4 +71,9 @@
   fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
   fins(x) = SQRT(1.0-18.0*x)
+
+  abort_message='obsolete, remplace par cdrag, use at you own risk'
+  CALL abort_gcm(modname,abort_message,1)
+
+
 
 ! ================================================================= c
Index: LMDZ5/branches/testing/libf/phylmd/clesphys.h
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/clesphys.h	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/clesphys.h	(revision 2258)
@@ -74,5 +74,6 @@
        REAL freq_COSP
        LOGICAL :: ok_cosp,ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP
-       INTEGER :: ip_ebil_phy, iflag_rrtm, iflag_ice_thermo,NSW
+       INTEGER :: ip_ebil_phy, iflag_rrtm, iflag_ice_thermo, NSW, iflag_albedo
+       LOGICAL :: ok_chlorophyll
        LOGICAL :: ok_strato
        LOGICAL :: ok_hines, ok_gwd_rando
@@ -116,6 +117,6 @@
      &     , ok_lic_melt,           aer_type                            &
      &     , iflag_rrtm, ok_strato,ok_hines, ok_qch4                    &
-     &     , iflag_ice_thermo, ok_gwd_rando, NSW                        &
-     &     , ok_conserv_q, ok_all_xml
+     &     , iflag_ice_thermo, ok_gwd_rando, NSW, iflag_albedo          &
+     &     , ok_chlorophyll,ok_conserv_q, ok_all_xml
      
        save /clesphys/
Index: LMDZ5/branches/testing/libf/phylmd/coefcdrag.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/coefcdrag.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/coefcdrag.F90	(revision 2258)
@@ -64,4 +64,11 @@
       REAL, dimension(klon) :: trm0, trm1
 
+  CHARACTER (LEN=80) :: abort_message
+  CHARACTER (LEN=20) :: modname = 'coefcdra'
+
+
+!
+
+
 !-------------------------------------------------------------------------
       REAL :: fsta, fins, x
@@ -69,4 +76,8 @@
       fins(x) = SQRT(1.0-18.0*x)
 !-------------------------------------------------------------------------
+
+  abort_message='obsolete, remplace par cdrag, use at you own risk'
+  CALL abort_gcm(modname,abort_message,1)
+
 !
       DO i = 1, knon
Index: LMDZ5/branches/testing/libf/phylmd/conf_phys_m.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/conf_phys_m.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/conf_phys_m.F90	(revision 2258)
@@ -15,5 +15,5 @@
        solarlong0,seuil_inversion, &
        fact_cldcon, facttemps,ok_newmicro,iflag_radia,&
-       iflag_cldth, &
+       iflag_cld_th, &
        iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
        ok_ade, ok_aie, ok_cdnc, aerosol_couple, &
@@ -81,5 +81,5 @@
     REAL                 :: bl95_b0, bl95_b1
     real                 :: fact_cldcon, facttemps,ratqsbas,ratqshaut,tau_ratqs
-    integer              :: iflag_cldth
+    integer              :: iflag_cld_th
     integer              :: iflag_ratqs
 
@@ -110,6 +110,8 @@
     integer,SAVE        :: iflag_radia_omp
     integer,SAVE        :: iflag_rrtm_omp
+    integer,SAVE        :: iflag_albedo_omp !albedo SB
+    logical,save        :: ok_chlorophyll_omp ! albedo SB  
     integer,SAVE        :: NSW_omp
-    integer,SAVE        :: iflag_cldth_omp, ip_ebil_phy_omp
+    integer,SAVE        :: iflag_cld_th_omp, ip_ebil_phy_omp
     integer,SAVE        :: iflag_ratqs_omp
 
@@ -889,25 +891,25 @@
     NSW_omp = 6
     call getin('NSW',NSW_omp)
-
-    !
-    !Config Key  = iflag_cldth 
+!albedo SB >>>
+    iflag_albedo_omp = 0
+    call getin('iflag_albedo',iflag_albedo_omp)
+
+    ok_chlorophyll_omp=.false.
+    call getin('ok_chlorophyll',ok_chlorophyll_omp)
+!albedo SB <<<
+
+    !
+    !Config Key  = iflag_cld_th 
     !Config Desc =  
     !Config Def  = 1
     !Config Help = 
     !
-    iflag_cldth_omp = 1
+    iflag_cld_th_omp = 1
 ! On lit deux fois avec l'ancien et le nouveau nom 
 ! pour assurer une retrocompatiblite.
 ! A abandonner un jour
-    call getin('iflag_cldcon',iflag_cldth_omp)
-    call getin('iflag_cldth',iflag_cldth_omp)
-
-    !
-    !Config Key  = iflag_cld_cv
-    !Config Desc =
-    !Config Def  = 1
-    !Config Help =
-    !
-    iflag_cld_cv_omp = 1
+    call getin('iflag_cldcon',iflag_cld_th_omp)
+    call getin('iflag_cld_th',iflag_cld_th_omp)
+    iflag_cld_cv_omp = 0 
     call getin('iflag_cld_cv',iflag_cld_cv_omp)
 
@@ -1973,5 +1975,5 @@
     iflag_rrtm = iflag_rrtm_omp
     NSW = NSW_omp
-    iflag_cldth = iflag_cldth_omp
+    iflag_cld_th = iflag_cld_th_omp
     iflag_cld_cv = iflag_cld_cv_omp
     tau_cld_cv = tau_cld_cv_omp
@@ -2128,5 +2130,5 @@
     write(lunout,*)' reevap_ice = ', reevap_ice
     write(lunout,*)' iflag_pdf = ', iflag_pdf
-    write(lunout,*)' iflag_cldth = ', iflag_cldth
+    write(lunout,*)' iflag_cld_th = ', iflag_cld_th
     write(lunout,*)' iflag_cld_cv = ', iflag_cld_cv
     write(lunout,*)' tau_cld_cv = ', tau_cld_cv
@@ -2135,4 +2137,6 @@
     write(lunout,*)' iflag_rrtm = ', iflag_rrtm
     write(lunout,*)' NSW = ', NSW
+    write(lunout,*)' iflag_albedo = ', iflag_albedo !albedo SB
+    write(lunout,*)' ok_chlorophyll =',ok_chlorophyll ! albedo SB
     write(lunout,*)' iflag_ratqs = ', iflag_ratqs
     write(lunout,*)' seuil_inversion = ', seuil_inversion
Index: LMDZ5/branches/testing/libf/phylmd/cv3p1_closure.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/cv3p1_closure.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/cv3p1_closure.F90	(revision 2258)
@@ -53,5 +53,5 @@
 
   ! local variables:
-  INTEGER il, i, j, k, icbmax, i0(nloc), klfc
+  INTEGER il, i, j, k, icbmax, i0(nloc), klfc(nloc)
   REAL deltap, fac, w, amu
   REAL rhodp
@@ -525,8 +525,11 @@
 
 !CR:Compute k at plfc
+  DO il=1,ncum
+           klfc(il)=nl
+  ENDDO
   DO k=1,nl
      DO il=1,ncum
         if ((plfc(il).lt.ph(il,k)).and.(plfc(il).ge.ph(il,k+1))) then
-           klfc=k
+           klfc(il)=k
         endif
      ENDDO
@@ -540,6 +543,6 @@
 !CR: Add large-scale component to the mass-flux
 !encore connu sous le nom "Experience du tube de dentifrice"
-    if (coef_clos_ls.gt.0.) then 
-       cbmf1(il) = cbmf1(il) - coef_clos_ls*min(0.,1./RG*omega(il,klfc))
+    if ((coef_clos_ls.gt.0.).and.(plfc(il).gt.0.)) then 
+       cbmf1(il) = cbmf1(il) - coef_clos_ls*min(0.,1./RG*omega(il,klfc(il)))
     endif
 !RC
Index: LMDZ5/branches/testing/libf/phylmd/cv3p_mixing.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/cv3p_mixing.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/cv3p_mixing.F90	(revision 2258)
@@ -58,5 +58,6 @@
   REAL, DIMENSION (nloc)             :: Smid, Sjmin, Sjmax
   REAL, DIMENSION (nloc)             :: Sbef, sup, smin
-  REAL, DIMENSION (nloc)             :: ASij, smax, Scrit
+!jyg  REAL, DIMENSION (nloc)             :: ASij, smax, Scrit
+  REAL, DIMENSION (nloc)             :: ASij, ASij_inv, smax, Scrit
   REAL, DIMENSION (nloc, nd, nd)     :: Sij
   REAL, DIMENSION (nloc, nd)         :: csum
@@ -524,5 +525,10 @@
       IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il)) THEN
         ASij(il) = amax1(1.0E-16, ASij(il))
-        ASij(il) = 1.0/ASij(il)
+!jyg+lluis<
+!!        ASij(il) = 1.0/ASij(il)
+        ASij_inv(il) = 1.0/ASij(il)
+!   IF the F-interval spanned by possible mixtures is less than 0.01, no mixing occurs
+        IF (ASij_inv(il) > 100.)  ASij_inv(il) = 0.
+!>jyg+lluis
         csum(il, i) = 0.0
       END IF
@@ -533,5 +539,6 @@
         IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
             j>=(icb(il)-1) .AND. j<=inb(il)) THEN
-          Ment(il, i, j) = Ment(il, i, j)*ASij(il)
+!jyg          Ment(il, i, j) = Ment(il, i, j)*ASij(il)
+          Ment(il, i, j) = Ment(il, i, j)*ASij_inv(il)
         END IF
       END DO
Index: LMDZ5/branches/testing/libf/phylmd/etat0_netcdf.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/etat0_netcdf.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/etat0_netcdf.F90	(revision 2258)
@@ -482,4 +482,8 @@
   falb1(:,is_oce) = 0.5;  falb1(:,is_sic) = 0.6
   falb2 = falb1
+!albedo SB >>>
+  falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
+  falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
+!albedo SB <<<
   evap(:,:) = 0.
   DO i=1,nbsrf; qsolsrf(:,i)=150.; END DO
Index: LMDZ5/branches/testing/libf/phylmd/fisrtilp.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/fisrtilp.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/fisrtilp.F90	(revision 2258)
@@ -8,5 +8,5 @@
      frac_impa, frac_nucl, beta,                        &
      prfl, psfl, rhcl, zqta, fraca,                     &
-     ztv, zpspsk, ztla, zthl, iflag_cldth,             &
+     ztv, zpspsk, ztla, zthl, iflag_cld_th,             &
      iflag_ice_thermo)
 
@@ -82,5 +82,5 @@
   INTEGER ninter ! sous-intervals pour la precipitation
   INTEGER ncoreczq  
-  INTEGER iflag_cldth
+  INTEGER iflag_cld_th
   INTEGER iflag_ice_thermo
   PARAMETER (ninter=5)
@@ -545,5 +545,5 @@
            enddo
 
-           if (iflag_cldth>=5) then
+           if (iflag_cld_th>=5) then
 
               call cloudth(klon,klev,k,ztv, &
@@ -559,11 +559,11 @@
            endif
 
-           if (iflag_cldth <= 4) then
+           if (iflag_cld_th <= 4) then
               lognormale = .true.
-           elseif (iflag_cldth >= 6) then
+           elseif (iflag_cld_th >= 6) then
               ! lognormale en l'absence des thermiques
               lognormale = fraca(:,k) < 1e-10
            else
-              ! Dans le cas iflag_cldth=5, on prend systématiquement la
+              ! Dans le cas iflag_cld_th=5, on prend systématiquement la
               ! bi-gaussienne
               lognormale = .false.
@@ -783,9 +783,5 @@
         else if (iflag_fisrtilp_qsat.gt.0) then
            DO i= 1, klon
-             if (lognormale(i)) then
-             zt(i)=Tbef(i)
-             else
              zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i)))
-             endif
            ENDDO
         endif
@@ -800,5 +796,5 @@
 !                                     t_glace_max, exposant_glace)
               if (iflag_t_glace.eq.0) then
-                    zfice(i) = 1.0 - (Tbef(i)-t_glace_min_old) / (RTT-t_glace_min_old)
+                    zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
                     zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
                     zfice(i) = zfice(i)**exposant_glace_old
@@ -809,12 +805,9 @@
          else
            DO i=1, klon
-              if (lognormale(i)) then
-                 zt(i)=Tbef(i)
-              else
 ! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
 !              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
 !                                     t_glace_max, exposant_glace)
               if (iflag_t_glace.eq.0) then
-                    zfice(i) = 1.0 - (Tbef(i)-t_glace_min_old) / (RTT-t_glace_min_old)
+                    zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
                     zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
                     zfice(i) = zfice(i)**exposant_glace_old
@@ -822,5 +815,4 @@
               zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i))) &
                        +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i)))
-              endif
            ENDDO
          endif
Index: LMDZ5/branches/testing/libf/phylmd/hgardfou.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/hgardfou.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/hgardfou.F90	(revision 2258)
@@ -1,5 +1,5 @@
 
 ! $Id$
-SUBROUTINE hgardfou(t, tsol, text)
+SUBROUTINE hgardfou(t, tsol, text,abortphy)
   USE dimphy
   USE phys_state_var_mod
@@ -15,4 +15,5 @@
   CHARACTER(len=*), intent(in):: text
   CHARACTER (LEN=20) :: modname = 'hgardfou'
+  INTEGER abortphy
 
   INTEGER i, k, nsrf
@@ -128,5 +129,6 @@
   END DO
 
-  IF (.NOT. ok) CALL abort_gcm(modname, text, 1)
+!  IF (.NOT. ok) CALL abort_gcm(modname, text, 1)
+  IF (.NOT. ok) abortphy=1
 
 END SUBROUTINE hgardfou
Index: LMDZ5/branches/testing/libf/phylmd/iniphysiq.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/iniphysiq.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/iniphysiq.F90	(revision 2258)
@@ -3,31 +3,28 @@
 
 
-
-SUBROUTINE iniphysiq(ngrid, nlayer, punjours, pdayref, ptimestep, plat, plon, &
-    parea, pcu, pcv, prad, pg, pr, pcpp, iflag_phys)
-  USE dimphy, ONLY: klev
-  USE mod_grid_phy_lmdz, ONLY: klon_glo
-  USE mod_phys_lmdz_para, ONLY: klon_omp, klon_omp_begin, klon_omp_end, &
-    klon_mpi_begin
-  USE comgeomphy, ONLY: airephy, cuphy, cvphy, rlond, rlatd
+SUBROUTINE iniphysiq(iim,jjm,nlayer,punjours, pdayref,ptimestep,         &
+                     rlatu,rlonv,aire,cu,cv,                             &
+                     prad,pg,pr,pcpp,iflag_phys)
+  USE dimphy, ONLY: klev ! number of atmospheric levels
+  USE mod_grid_phy_lmdz, ONLY: klon_glo ! number of atmospheric columns
+                                        ! (on full grid)
+  USE mod_phys_lmdz_para, ONLY: klon_omp, & ! number of columns (on local omp grid)
+                                klon_omp_begin, & ! start index of local omp subgrid
+                                klon_omp_end, & ! end index of local omp subgrid
+                                klon_mpi_begin ! start indes of columns (on local mpi grid)
+  USE comgeomphy, ONLY: initcomgeomphy, &
+                        airephy, & ! physics grid area (m2)
+                        cuphy, & ! cu coeff. (u_covariant = cu * u)
+                        cvphy, & ! cv coeff. (v_covariant = cv * v)
+                        rlond, & ! longitudes
+                        rlatd ! latitudes
   USE phyaqua_mod, ONLY: iniaqua
   IMPLICIT NONE
 
   ! =======================================================================
-
   ! Initialisation of the physical constants and some positional and
   ! geometrical arrays for the physics
-
-
-  ! ngrid                 Size of the horizontal grid.
-  ! All internal loops are performed on that grid.
-  ! nlayer                Number of vertical layers.
-  ! pdayref               Day of reference for the simulation
-
   ! =======================================================================
 
-  ! ym#include "dimensions.h"
-  ! ym#include "dimphy.h"
-  ! ym#include "comgeomphy.h"
   include "YOMCST.h"
   include "iniprint.h"
@@ -38,11 +35,12 @@
   REAL, INTENT (IN) :: pcpp ! specific heat Cp
   REAL, INTENT (IN) :: punjours ! length (in s) of a standard day
-  INTEGER, INTENT (IN) :: ngrid ! number of horizontal grid points in the physics
   INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers
-  REAL, INTENT (IN) :: plat(ngrid) ! latitudes of the physics grid
-  REAL, INTENT (IN) :: plon(ngrid) ! longitudes of the physics grid
-  REAL, INTENT (IN) :: parea(klon_glo) ! area (m2)
-  REAL, INTENT (IN) :: pcu(klon_glo) ! cu coeff. (u_covariant = cu * u)
-  REAL, INTENT (IN) :: pcv(klon_glo) ! cv coeff. (v_covariant = cv * v)
+  INTEGER, INTENT (IN) :: iim ! number of atmospheric columns along longitudes
+  INTEGER, INTENT (IN) :: jjm ! number of atompsheric columns along latitudes
+  REAL, INTENT (IN) :: rlatu(jjm+1) ! latitudes of the physics grid
+  REAL, INTENT (IN) :: rlonv(iim+1) ! longitudes of the physics grid
+  REAL, INTENT (IN) :: aire(iim+1,jjm+1) ! area of the dynamics grid (m2)
+  REAL, INTENT (IN) :: cu((iim+1)*(jjm+1)) ! cu coeff. (u_covariant = cu * u)
+  REAL, INTENT (IN) :: cv((iim+1)*jjm) ! cv coeff. (v_covariant = cv * v)
   INTEGER, INTENT (IN) :: pdayref ! reference day of for the simulation
   REAL, INTENT (IN) :: ptimestep !physics time step (s)
@@ -50,6 +48,16 @@
 
   INTEGER :: ibegin, iend, offset
+  INTEGER :: i,j
   CHARACTER (LEN=20) :: modname = 'iniphysiq'
   CHARACTER (LEN=80) :: abort_message
+  REAL :: total_area_phy, total_area_dyn
+
+
+  ! global array, on full physics grid:
+  REAL,ALLOCATABLE :: latfi(:)
+  REAL,ALLOCATABLE :: lonfi(:)
+  REAL,ALLOCATABLE :: cufi(:)
+  REAL,ALLOCATABLE :: cvfi(:)
+  REAL,ALLOCATABLE :: airefi(:)
 
   IF (nlayer/=klev) THEN
@@ -62,22 +70,68 @@
   END IF
 
-  IF (ngrid/=klon_glo) THEN
-    WRITE (lunout, *) 'STOP in ', trim(modname)
-    WRITE (lunout, *) 'Problem with dimensions :'
-    WRITE (lunout, *) 'ngrid     = ', ngrid
-    WRITE (lunout, *) 'klon   = ', klon_glo
-    abort_message = ''
-    CALL abort_gcm(modname, abort_message, 1)
-  END IF
-
-  !$OMP PARALLEL PRIVATE(ibegin,iend) &
-  !$OMP          SHARED(parea,pcu,pcv,plon,plat)
+  !call init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
+  
+  ! Generate global arrays on full physics grid
+  ALLOCATE(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
+  ALLOCATE(airefi(klon_glo))
+
+  IF (klon_glo>1) THEN ! general case
+    ! North pole
+    latfi(1)=rlatu(1)
+    lonfi(1)=0.
+    cufi(1) = cu(1)
+    cvfi(1) = cv(1)
+    DO j=2,jjm
+      DO i=1,iim
+        latfi((j-2)*iim+1+i)= rlatu(j)
+        lonfi((j-2)*iim+1+i)= rlonv(i)
+        cufi((j-2)*iim+1+i) = cu((j-1)*iim+1+i)
+        cvfi((j-2)*iim+1+i) = cv((j-1)*iim+1+i)
+      ENDDO
+    ENDDO
+    ! South pole
+    latfi(klon_glo)= rlatu(jjm+1)
+    lonfi(klon_glo)= 0.
+    cufi(klon_glo) = cu((iim+1)*jjm+1)
+    cvfi(klon_glo) = cv((iim+1)*jjm-iim)
+
+    ! build airefi(), mesh area on physics grid
+    CALL gr_dyn_fi(1,iim+1,jjm+1,klon_glo,aire,airefi)
+    ! Poles are single points on physics grid
+    airefi(1)=sum(aire(1:iim,1))
+    airefi(klon_glo)=sum(aire(1:iim,jjm+1))
+
+    ! Sanity check: do total planet area match between physics and dynamics?
+    total_area_dyn=sum(aire(1:iim,1:jjm+1))
+    total_area_phy=sum(airefi(1:klon_glo))
+    IF (total_area_dyn/=total_area_phy) THEN
+      WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
+      WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
+      WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
+      IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
+        ! stop here if the relative difference is more than 0.001%
+        abort_message = 'planet total surface discrepancy'
+        CALL abort_gcm(modname, abort_message, 1)
+      ENDIF
+    ENDIF
+  ELSE ! klon_glo==1, running the 1D model
+    ! just copy over input values
+    latfi(1)=rlatu(1)
+    lonfi(1)=rlonv(1)
+    cufi(1)=cu(1)
+    cvfi(1)=cv(1)
+    airefi(1)=aire(1,1)
+  ENDIF ! of IF (klon_glo>1)
+
+!$OMP PARALLEL 
+  ! Now generate local lon/lat/cu/cv/area arrays
+  CALL initcomgeomphy
 
   offset = klon_mpi_begin - 1
-  airephy(1:klon_omp) = parea(offset+klon_omp_begin:offset+klon_omp_end)
-  cuphy(1:klon_omp) = pcu(offset+klon_omp_begin:offset+klon_omp_end)
-  cvphy(1:klon_omp) = pcv(offset+klon_omp_begin:offset+klon_omp_end)
-  rlond(1:klon_omp) = plon(offset+klon_omp_begin:offset+klon_omp_end)
-  rlatd(1:klon_omp) = plat(offset+klon_omp_begin:offset+klon_omp_end)
+  airephy(1:klon_omp) = airefi(offset+klon_omp_begin:offset+klon_omp_end)
+  cuphy(1:klon_omp) = cufi(offset+klon_omp_begin:offset+klon_omp_end)
+  cvphy(1:klon_omp) = cvfi(offset+klon_omp_begin:offset+klon_omp_end)
+  rlond(1:klon_omp) = lonfi(offset+klon_omp_begin:offset+klon_omp_end)
+  rlatd(1:klon_omp) = latfi(offset+klon_omp_begin:offset+klon_omp_end)
 
     ! suphel => initialize some physical constants (orbital parameters,
@@ -86,8 +140,8 @@
   CALL suphel
 
-  !$OMP END PARALLEL
-
-    ! check that physical constants set in 'suphel' are coherent
-    ! with values set in the dynamics:
+!$OMP END PARALLEL
+
+  ! check that physical constants set in 'suphel' are coherent
+  ! with values set in the dynamics:
   IF (rday/=punjours) THEN
     WRITE (lunout, *) 'iniphysiq: length of day discrepancy!!!'
@@ -142,15 +196,9 @@
 
   ! Additional initializations for aquaplanets
-  !$OMP PARALLEL
+!$OMP PARALLEL
   IF (iflag_phys>=100) THEN
     CALL iniaqua(klon_omp, rlatd, rlond, iflag_phys)
   END IF
-  !$OMP END PARALLEL
-
-  ! RETURN
-  ! 9999  CONTINUE
-  ! abort_message ='Cette version demande les fichier rnatur.dat
-  ! & et surf.def'
-  ! CALL abort_gcm (modname,abort_message,1)
+!$OMP END PARALLEL
 
 END SUBROUTINE iniphysiq
Index: LMDZ5/branches/testing/libf/phylmd/lmdz1d.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/lmdz1d.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/lmdz1d.F90	(revision 2258)
@@ -10,5 +10,4 @@
       USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar
       use phys_state_var_mod
-      use comgeomphy
       use dimphy
       use surface_data, only : type_ocean,ok_veget
@@ -203,9 +202,7 @@
 !  Call to physiq
 !---------------------------------------------------------------------
-      integer, parameter :: longcles=20
       logical :: firstcall=.true.
       logical :: lastcall=.false.
       real :: phis    = 0.0
-      real :: clesphy0(longcles) = 0.0
       real :: dpsrf 
 
@@ -365,5 +362,5 @@
 !---------------------------------------------------------------------
 
-      call conf_gcm( 99, .TRUE. , clesphy0 )
+      call conf_gcm( 99, .TRUE. )
 !-----------------------------------------------------------------------
 !   Choix du calendrier
@@ -473,5 +470,4 @@
       call init_phys_lmdz(1,1,llm,1,(/1/))
       call suphel
-      call initcomgeomphy
       call infotrac_init 
 
@@ -608,5 +604,5 @@
       rlon_rad(:)=rlon(:)*rpi/180.
 
-      call iniphysiq(ngrid,llm,rday,day_ini,timestep,                        &
+      call iniphysiq(iim,jjm,llm,rday,day_ini,timestep,                        &
      &     rlat_rad,rlon_rad,airefi,zcufi,zcvfi,ra,rg,rd,rcpd,(/1/))
       print*,'apres iniphysiq'
@@ -618,5 +614,4 @@
 ! Ecriture du startphy avant le premier appel a la physique.
 ! On le met juste avant pour avoir acces a tous les champs
-! NB: les clesphy0 seront remplies dans phyredem d'apres les flags lus dans gcm.def
 
       if (ok_writedem) then
@@ -673,6 +668,11 @@
         zpic = zpicinp
         ftsol=tsurf
+        nsw=6 ! on met le nb de bandes SW=6, pour initialiser
+              ! 6 albedo, mais on peut quand meme tourner avec
+              ! moins. Seules les 2 ou 4 premiers seront lus
         falb1 = albedo                            
         falb2 = albedo                            
+        falb_dir=albedo
+        falb_dif=albedo
         rugoro=rugos 
         t_ancien(1,:)=temp(:)
@@ -859,5 +859,5 @@
      &              firstcall,lastcall,                                     &
      &              day,time,timestep,                                      &
-     &              plev,play,phi,phis,presnivs,clesphy0,                   &
+     &              plev,play,phi,phis,presnivs,                            &
      &              u,v,temp,q,omega2,                                      &
      &              du_phys,dv_phys,dt_phys,dq,dpsrf,                        &
Index: LMDZ5/branches/testing/libf/phylmd/ocean_albedo.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/ocean_albedo.F90	(revision 2258)
+++ LMDZ5/branches/testing/libf/phylmd/ocean_albedo.F90	(revision 2258)
@@ -0,0 +1,287 @@
+!
+! $Id$
+!
+
+!     #########
+
+subroutine ocean_albedo(knon,zrmu0,knindex,pwind,SFRWL,alb_dir_new,alb_dif_new)
+
+
+!     ##################################################################
+!
+!!****  *ALBEDO_RS14*  
+!!
+!!    PURPOSE
+!!    -------
+!       computes the direct & diffuse albedo over open water
+!
+!     
+!!**  METHOD
+!!    ------
+!
+!!    EXTERNAL
+!!    --------
+!!
+!!    IMPLICIT ARGUMENTS
+!!    ------------------ 
+!!
+!!      
+!!    REFERENCE
+!!    ---------
+!!
+!!      
+!!    AUTHOR
+!!    ------
+!!	R. Séférian           * Meteo-France *
+!!
+!!    MODIFICATIONS
+!!    -------------
+!!      Original    03/2014
+!                   05/2014 R. Séférian & B. Decharme :: Adaptation to spectral
+!                   computation for diffuse and direct albedo
+!                   08/2014 S. Baek :: for wider wavelength range 200-4000nm and
+!                   adaptation to LMDZ + whitecap effect by Koepke + chrolophyll
+!                   map from climatology file
+!       
+!-------------------------------------------------------------------------------
+!
+!*           DECLARATIONS
+!            ------------
+!
+USE ocean_albedo_para
+use dimphy
+!LF USE PARKIND1  ,ONLY : JPIM     ,JPRB
+use phys_state_var_mod, only : chl_con
+!
+!
+IMPLICIT NONE
+!
+!*      0.1    declarations of arguments
+!              -------------------------
+!
+
+include "clesphys.h"
+
+integer, intent(in) :: knon
+integer, dimension(klon), intent(in) :: knindex
+real, dimension(klon), intent(in) :: zrmu0,pwind
+real, dimension(klon,nsw), intent(out) ::  alb_dir_new,alb_dif_new
+real, dimension(6),intent(in) :: SFRWL
+
+
+!=== LOCAL VARIABLES
+
+REAL, parameter :: XPI=4.*atan(1.)
+
+!
+!*      0.2    declarations of local variables
+!              -------------------------
+!
+REAL, DIMENSION(klon)               :: ZCHL        ! surface chlorophyll
+REAL, DIMENSION(klon,NNWL)               :: ZDIR_ALB    ! direct  ocean surface albedo (spectral)
+REAL, DIMENSION(klon,NNWL)               :: ZSCA_ALB    ! diffuse ocean surface albedo (spectral)
+!
+INTEGER                         :: JI, JWL                  ! indexes
+REAL                            :: ZWL                      ! input parameter: wavelength and diffuse/direct fraction of light
+REAL:: ZSIG, ZREFM, ZXX2, ZR00, ZRR0, ZRRR                        ! computation variables
+REAL:: ZR22, ZUE, ZUE2, ZR11DF, ZALBT, ZFWC                       ! computation variables
+REAL:: ZCHLABS, ZAW, ZBW, ZAP, ZYLMD, ZBP550                      ! computation variables
+REAL:: ZBBP, ZNU, ZHB                                       ! computation variables
+REAL:: ZCOSZEN                                              ! Cosine of the zenith solar angle
+REAL:: ZR11, ZRW, ZRWDF, ZRDF                                   ! 4 components of the OSA
+! new damping coefficient
+REAL:: ZDAMP     
+
+! 
+REAL            :: ZWORK                           ! dummy variable
+! 
+!LF REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+!
+
+
+
+!
+alb_dir_new(:,:) = 0. 
+alb_dif_new(:,:) = 0. 
+!
+ZDIR_ALB(:,:) = 0. 
+ZSCA_ALB(:,:) = 0.
+!
+!
+
+!ZCHL(:) = CHL_CON!0.05 ! averaged global values for surface chlorophyll
+if(ok_chlorophyll)then
+  do ji=1,knon
+  ZCHL(ji)=CHL_CON(knindex(ji))
+  enddo
+else 
+  ZCHL(:) = 0.05
+endif
+
+
+!
+DO JWL=1,NNWL           ! loop over the wavelength
+!
+  DO JI=1,knon  ! loop over the grid points
+
+
+    !---------------------------------------------------------------------------------
+    ! 0- Compute baseline values
+    !---------------------------------------------------------------------------------
+    
+    ! Get refractive index for the correspoding wavelength
+    ZWL=XAKWL(JWL) !!!----------  wavelength value
+    ZREFM= XAKREFM(JWL) !!!--------- refraction index value
+  
+
+    ! compute the cosine of the solar zenith angle
+!    ZCOSZEN = COS(XPI/2 - PZENITH(JI))
+     ZCOSZEN = zrmu0(knindex(JI))
+    ! Compute sigma derived from wind speed (Cox & Munk reflectance model)
+    ZSIG=SQRT(0.003+0.00512*PWIND(JI))
+
+    
+    !---------------------------------------------------------------------------------
+    ! 1- Compute direct surface albedo (ZR11)
+    !---------------------------------------------------------------------------------
+    !
+    ZXX2=SQRT(1.0-(1.0-ZCOSZEN**2)/ZREFM**2)
+    ZRR0=0.50*(((ZXX2-ZREFM*ZCOSZEN)/(ZXX2+ZREFM*ZCOSZEN))**2 +((ZCOSZEN-ZREFM*ZXX2)/(ZCOSZEN+ZREFM*ZXX2))**2)
+    ZRRR=0.50*(((ZXX2-1.34*ZCOSZEN)/(ZXX2+1.34*ZCOSZEN))**2 +((ZCOSZEN-1.34*ZXX2)/(ZCOSZEN+1.34*ZXX2))**2)
+    ZR11=ZRR0-(0.0152-1.7873*ZCOSZEN+6.8972*ZCOSZEN**2-8.5778*ZCOSZEN**3+4.071*ZSIG-7.6446*ZCOSZEN*ZSIG) &
+        & * EXP(0.1643-7.8409*ZCOSZEN-3.5639*ZCOSZEN**2-2.3588*ZSIG+10.0538*ZCOSZEN*ZSIG)*ZRR0/ZRRR
+    ! 
+    !---------------------------------------------------------------------------------
+    ! 2- Compute surface diffuse albedo (ZRDF)
+    !---------------------------------------------------------------------------------
+    ! Diffuse albedo from Jin et al., 2006 + estimation from diffuse fraction of
+    ! light (relying later on AOD)
+    ZRDF=-0.1482-0.012*ZSIG+0.1609*ZREFM-0.0244*ZSIG*ZREFM ! surface diffuse (Eq 5a-5b)
+   
+    !---------------------------------------------------------------------------------
+    ! *- Determine absorption and backscattering
+    ! coefficients to determine reflectance below the surface (Ro) once for all
+    !
+    ! *.1- Absorption by chlorophyll
+    ZCHLABS= XAKACHL(JWL) 
+    ! *.2- Absorption by seawater 
+    ZAW= XAKAW3(JWL) 
+    ! *.3- Backscattering by seawater
+    ZBW= XAKBW(JWL) 
+    ! *.4- Backscattering by chlorophyll
+    ZYLMD = EXP(0.014*(440.0-ZWL))
+    ZWORK= EXP(LOG(ZCHL(JI))*0.65)
+    ZAP = 0.06*ZCHLABS*ZWORK +0.2*(XAW440+0.06*ZWORK)*ZYLMD
+    ZBP550 = 0.416 * EXP(LOG(ZCHL(JI))*0.766)
+   
+    IF ( ZCHL(JI) > 2. ) THEN
+      ZNU=0.
+    ELSE
+      IF ( ZCHL(JI) > 0.02 ) THEN
+        ZWORK=LOG10(ZCHL(JI))
+        ZNU=0.5*(ZWORK-0.3)
+        ZBBP=(0.002+0.01*(0.5-0.25*ZWORK)*(ZWL/550.)**ZNU)*ZBP550
+      ELSE
+        ZBBP=0.019*(550./ZWL)*ZBP550       !ZBBPf=0.0113 at chl<=0.02
+      ENDIF
+    ENDIF
+   
+    ! Morel-Gentili(1991), Eq (12)
+    ! ZHB=h/(h+2*ZBBPf*(1.-h))        
+    ZHB=0.5*ZBW/(0.5*ZBW+ZBBP)
+   
+    !---------------------------------------------------------------------------------
+    ! 3- Compute direct water-leaving albedo (ZRW)
+    !---------------------------------------------------------------------------------
+    ! Based on Morel & Gentilli 1991 parametrization
+    ZR22=0.48168549-0.014894708*ZSIG-0.20703885*ZSIG**2
+    ! Use Morel 91 formula to compute the direct reflectance
+    ! below the surface
+    ZR00=(0.5*ZBW+ZBBP)/(ZAW+ZAP) *(0.6279-0.2227*ZHB-0.0513*ZHB**2 + (-0.3119+0.2465*ZHB)*ZCOSZEN)
+    ZRW=ZR00*(1.-ZR22)*(1.-ZR11)/(1.-ZR00*ZR22)
+
+    ZRW=ZR00*(1.-ZR22)/(1.-ZR00*ZR22)
+    !---------------------------------------------------------------------------------
+    ! 4- Compute diffuse water-leaving albedo (ZRWDF)
+    !---------------------------------------------------------------------------------
+    ! as previous water-leaving computation but assumes a uniform incidence of
+    ! shortwave at surface (ue)
+    ZUE=0.676               ! equivalent u_unif for diffuse incidence
+    ZUE2=SQRT(1.0-(1.0-ZUE**2)/ZREFM**2)
+    ZRR0=0.50*(((ZUE2-ZREFM*ZUE)/(ZUE2+ZREFM*ZUE))**2 +((ZUE-ZREFM*ZUE2)/(ZUE+ZREFM*ZUE2))**2)
+    ZRRR=0.50*(((ZUE2-1.34*ZUE)/(ZUE2+1.34*ZUE))**2 +((ZUE-1.34*ZUE2)/(ZUE+1.34*ZUE2))**2)
+    ZR11DF=ZRR0-(0.0152-1.7873*ZUE+6.8972*ZUE**2-8.5778*ZUE**3+4.071*ZSIG-7.6446*ZUE*ZSIG) &
+          & * EXP(0.1643-7.8409*ZUE-3.5639*ZUE**2-2.3588*ZSIG+10.0538*ZUE*ZSIG)*ZRR0/ZRRR
+    ! Use Morel 91 formula to compute the diffuse
+    ! reflectance below the surface
+    ZR00=(0.5*ZBW+ZBBP)/(ZAW+ZAP) *(0.6279-0.2227*ZHB-0.0513*ZHB**2 + (-0.3119+0.2465*ZHB)*ZUE)
+    ZRWDF=ZR00*(1.-ZR22)*(1.-ZR11DF)/(1.-ZR00*ZR22)
+   
+    ! original : correction for foam (Eq 16-17)
+    ZFWC=3.97e-4*PWIND(JI)**(1.59) ! Salisbury 2014 eq(2) at 37GHz, value in fraction
+    ! has to be update once we have information from wave model (discussion with G. Madec)
+     
+    ! --------------------------------------------------------------------
+    !  *- OSA estimation
+    ! --------------------------------------------------------------------
+    ! partitionning direct and diffuse albedo
+    !
+
+    ! excluding diffuse albedo ZRW on ZDIR_ALB
+      ZDIR_ALB(JI,JWL) =  XFRWL(JWL) *((1.-ZFWC) * (ZR11+ZRW) +ZFWC*XRWC(JWL))
+      ZSCA_ALB(JI,JWL) =  XFRWL(JWL) *((1.-ZFWC) * (ZRDF+ZRWDF) + ZFWC*XRWC(JWL))
+
+    !  print*,ji,ZFWC,ZDIR_ALB(JI,JWL),ZSCA_ALB(JI,JWL),pwind(ji)
+    ENDDO ! end of the loop over grid points
+
+ENDDO ! ending loop over wavelengths
+
+
+! integral for each nsw band
+
+select case(nsw)
+case(2)
+  do ji=1,knon
+   alb_dir_new(ji,1)=sum(zdir_alb(ji,1:49))/SFRWL(1) ! from 200nm to 680nm 
+   alb_dir_new(ji,2)=sum(zdir_alb(ji,50:381))/SFRWL(2) ! from 690nm to 4000 nm
+
+   alb_dif_new(ji,1)=sum(zsca_alb(ji,1:49))/SFRWL(1) ! from 200nm to 680nm 
+   alb_dif_new(ji,2)=sum(zsca_alb(ji,50:381))/SFRWL(2) ! from 690nm to 4000 nm
+  enddo
+case(4)
+  do ji=1,knon
+   alb_dir_new(ji,1)=sum(zdir_alb(ji,1:49))/SFRWL(1) ! from 200nm to 680nm 
+   alb_dir_new(ji,2)=sum(zdir_alb(ji,50:99))/SFRWL(2) ! from 690nm to 1180 nm
+   alb_dir_new(ji,3)=sum(zdir_alb(ji,100:218))/SFRWL(3) ! from 1190nm to 2370 nm
+   alb_dir_new(ji,4)=sum(zdir_alb(ji,219:381))/SFRWL(4) ! from 2380nm to 4000 nm
+
+   alb_dif_new(ji,1)=sum(zsca_alb(ji,1:49))/SFRWL(1) ! from 200nm to 680nm 
+   alb_dif_new(ji,2)=sum(zsca_alb(ji,50:99))/SFRWL(2) ! from 690nm to 1180 nm
+   alb_dif_new(ji,3)=sum(zsca_alb(ji,100:218))/SFRWL(3) ! from 1190nm to 2370 nm
+   alb_dif_new(ji,4)=sum(zsca_alb(ji,219:381))/SFRWL(4) ! from 2380nm to 4000 nm
+  enddo
+case(6)
+ do ji=1,knon
+   alb_dir_new(ji,1)=sum(zdir_alb(ji,1:5))/SFRWL(1) ! from 200nm to 240nm 
+   alb_dir_new(ji,2)=sum(zdir_alb(ji,6:24))/SFRWL(2) ! from 250nm to 430 nm
+   alb_dir_new(ji,3)=sum(zdir_alb(ji,25:49))/SFRWL(3) ! from 440nm to 680 nm
+   alb_dir_new(ji,4)=sum(zdir_alb(ji,50:99))/SFRWL(4) ! from 690nm to 1180 nm
+   alb_dir_new(ji,5)=sum(zdir_alb(ji,100:218))/SFRWL(5) ! from 1190nm to 2370 nm
+   alb_dir_new(ji,6)=sum(zdir_alb(ji,219:381))/SFRWL(6) ! from 2380nm to 4000 nm
+
+   alb_dif_new(ji,1)=sum(zsca_alb(ji,1:5))/SFRWL(1) ! from 200nm to 240nm 
+   alb_dif_new(ji,2)=sum(zsca_alb(ji,6:24))/SFRWL(2) ! from 250nm to 430 nm
+   alb_dif_new(ji,3)=sum(zsca_alb(ji,25:49))/SFRWL(3) ! from 440nm to 680 nm
+   alb_dif_new(ji,4)=sum(zsca_alb(ji,50:99))/SFRWL(4) ! from 690nm to 1180 nm
+   alb_dif_new(ji,5)=sum(zsca_alb(ji,100:218))/SFRWL(5) ! from 1190nm to 2370 nm
+   alb_dif_new(ji,6)=sum(zsca_alb(ji,219:381))/SFRWL(6) ! from 2380nm to 4000 nm
+ enddo
+end select
+
+
+
+END subroutine ocean_albedo
+
Index: LMDZ5/branches/testing/libf/phylmd/ocean_albedo_para.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/ocean_albedo_para.F90	(revision 2258)
+++ LMDZ5/branches/testing/libf/phylmd/ocean_albedo_para.F90	(revision 2258)
@@ -0,0 +1,646 @@
+!
+! $Id$
+!
+!     ######################
+MODULE ocean_albedo_para
+!     ######################
+!
+!!****  *MOD_DALBEDO_RS14* - declaration of ISBA parameters
+!!
+!!    PURPOSE
+!!    -------
+!       The purpose of this declarative module is to specify  the 
+!     parameters related to direct & diffuse albedo over open water 
+!
+!!
+!!      
+!!
+!!    AUTHOR
+!!    ------
+!!	R. Séférian           * Meteo-France *
+!!
+!!    MODIFICATIONS
+!!    -------------
+!       S. Baek : extention from 200-800nm to 200-40000nm 
+!-------------------------------------------------------------------------------
+!
+!*       0.   DECLARATIONS
+!             ------------
+!
+
+IMPLICIT NONE
+!
+INTEGER, PARAMETER   :: NNWL = 381                ! number of wavelength
+!
+! absorption coefficients for seawater et 440 nm
+REAL, PARAMETER      :: XAW440 =  0.00635
+!
+!! white-caps reflectance (Koepke , 1983 estimation)
+!REAL, PARAMETER      :: XRWC   =  0.55
+!
+! table of wavelength discretization
+REAL, PARAMETER, DIMENSION(NNWL)::  XAKWL= &
+    (/ 200.0, 210.0, 220.0, 230.0, 240.0, 250.0, 260.0, 270.0, 280.0,  &
+    290.0, 300.0, 310.0, 320.0, 330.0, 340.0, 350.0, 360.0, 370.0,            &
+    380.0, 390.0, 400.0, 410.0, 420.0, 430.0, 440.0, 450.0, 460.0,            &
+    470.0, 480.0, 490.0, 500.0, 510.0, 520.0, 530.0, 540.0, 550.0,            &
+    560.0, 570.0, 580.0, 590.0, 600.0, 610.0, 620.0, 630.0, 640.0,            &
+    650.0, 660.0, 670.0, 680.0, 690.0, 700.0, 710.0, 720.0, 730.0,            &
+    740.0, 750.0, 760.0, 770.0, 780.0, 790.0, 800.0, 810.0, 820.0,            &
+    830.0, 840.0, 850.0, 860.0, 870.0, 880.0, 890.0, 900.0, 910.0,            &
+    920.0, 930.0, 940.0, 950.0, 960.0, 970.0, 980.0, 990.0, 1000.0, 1010.0,   &
+    1020.0, 1030.0, 1040.0, 1050.0, 1060.0, 1070.0, 1080.0, 1090.0, 1100.0,   &
+    1110.0, 1120.0, 1130.0, 1140.0, 1150.0, 1160.0, 1170.0, 1180.0, 1190.0,   &
+    1200.0, 1210.0, 1220.0, 1230.0, 1240.0, 1250.0, 1260.0, 1270.0, 1280.0,   &
+    1290.0, 1300.0, 1310.0, 1320.0, 1330.0, 1340.0, 1350.0, 1360.0, 1370.0,   &
+    1380.0, 1390.0, 1400.0, 1410.0, 1420.0, 1430.0, 1440.0, 1450.0, 1460.0,   &
+    1470.0, 1480.0, 1490.0, 1500.0, 1510.0, 1520.0, 1530.0, 1540.0, 1550.0,   &
+    1560.0, 1570.0, 1580.0, 1590.0, 1600.0, 1610.0, 1620.0, 1630.0, 1640.0,   &
+    1650.0, 1660.0, 1670.0, 1680.0, 1690.0, 1700.0, 1710.0, 1720.0, 1730.0,   &
+    1740.0, 1750.0, 1760.0, 1770.0, 1780.0, 1790.0, 1800.0, 1810.0, 1820.0,   &
+    1830.0, 1840.0, 1850.0, 1860.0, 1870.0, 1880.0, 1890.0, 1900.0, 1910.0,   &
+1920.0, 1930.0, 1940.0, 1950.0, 1960.0, 1970.0, 1980.0, 1990.0, 2000.0, 2010.0,& 
+2020.0, 2030.0, 2040.0, 2050.0, 2060.0, 2070.0, 2080.0, 2090.0, 2100.0, 2110.0,&
+2120.0, 2130.0, 2140.0, 2150.0, 2160.0, 2170.0, 2180.0, 2190.0, 2200.0, 2210.0,&
+2220.0, 2230.0, 2240.0, 2250.0, 2260.0, 2270.0, 2280.0, 2290.0, 2300.0, 2310.0,&
+2320.0, 2330.0, 2340.0, 2350.0, 2360.0, 2370.0, 2380.0, 2390.0, 2400.0, 2410.0,&
+2420.0, 2430.0, 2440.0, 2450.0, 2460.0, 2470.0, 2480.0, 2490.0, 2500.0, 2510.0,&
+2520.0, 2530.0, 2540.0, 2550.0, 2560.0, 2570.0, 2580.0, 2590.0, 2600.0, 2610.0,&
+2620.0, 2630.0, 2640.0, 2650.0, 2660.0, 2670.0, 2680.0, 2690.0, 2700.0, 2710.0,&
+2720.0, 2730.0, 2740.0, 2750.0, 2760.0, 2770.0, 2780.0, 2790.0, 2800.0, 2810.0,&
+2820.0, 2830.0, 2840.0, 2850.0, 2860.0, 2870.0, 2880.0, 2890.0, 2900.0, 2910.0,&
+2920.0, 2930.0, 2940.0, 2950.0, 2960.0, 2970.0, 2980.0, 2990.0, 3000.0, 3010.0,&
+3020.0, 3030.0, 3040.0, 3050.0, 3060.0, 3070.0, 3080.0, 3090.0, 3100.0, 3110.0,&
+3120.0, 3130.0, 3140.0, 3150.0, 3160.0, 3170.0, 3180.0, 3190.0, 3200.0, 3210.0,&
+3220.0, 3230.0, 3240.0, 3250.0, 3260.0, 3270.0, 3280.0, 3290.0, 3300.0, 3310.0,&
+3320.0, 3330.0, 3340.0, 3350.0, 3360.0, 3370.0, 3380.0, 3390.0, 3400.0, 3410.0,&
+3420.0, 3430.0, 3440.0, 3450.0, 3460.0, 3470.0, 3480.0, 3490.0, 3500.0, 3510.0,&
+3520.0, 3530.0, 3540.0, 3550.0, 3560.0, 3570.0, 3580.0, 3590.0, 3600.0, 3610.0,&
+3620.0, 3630.0, 3640.0, 3650.0, 3660.0, 3670.0, 3680.0, 3690.0, 3700.0, 3710.0,&
+3720.0, 3730.0, 3740.0, 3750.0, 3760.0, 3770.0, 3780.0, 3790.0, 3800.0, 3810.0,&
+3820.0, 3830.0, 3840.0, 3850.0, 3860.0, 3870.0, 3880.0, 3890.0, 3900.0, 3910.0,&
+3920.0, 3930.0, 3940.0, 3950.0, 3960.0, 3970.0, 3980.0, 3990.0, 4000.0 /) 
+
+
+ 
+!
+! proportion of each wavelength
+REAL, PARAMETER, DIMENSION(NNWL)::  XFRWL= &
+(/0.5399519E-04, 0.2057802E-03, 0.3488387E-03, 0.3841427E-03, 0.2915711E-03, &
+0.4429581E-03, 0.6302387E-03, 0.1970095E-02, 0.6974564E-03, 0.4431792E-02,   &
+0.3095547E-02, 0.4587307E-02, 0.5933870E-02, 0.7488277E-02, 0.7421943E-02,   &
+0.7738869E-02, 0.7155137E-02, 0.8394831E-02, 0.8859162E-02, 0.9190828E-02,   &
+0.1239693E-01, 0.1129138E-01, 0.1294971E-01, 0.8365349E-02, 0.1262541E-01,&
+0.1580203E-01, 0.1503552E-01, 0.1383415E-01, 0.1499867E-01, 0.1479230E-01,&
+0.1368674E-01, 0.1435007E-01, 0.1349511E-01, 0.1438693E-01, 0.1303815E-01,&
+0.1372359E-01, 0.1358356E-01, 0.1303815E-01, 0.1354671E-01, 0.1336245E-01,&
+0.1286863E-01, 0.1255171E-01, 0.1278019E-01, 0.1208001E-01, 0.1189575E-01,&
+0.1183678E-01, 0.1157882E-01, 0.1117345E-01, 0.1099656E-01, 0.1067227E-01,&
+0.1021531E-01, 0.1020794E-01, 0.9809937E-02, 0.9773086E-02, 0.9271902E-02,&
+0.9301383E-02, 0.9117125E-02, 0.8873903E-02, 0.8748608E-02, 0.8534866E-02,&
+0.8416941E-02, 0.8210571E-02, 0.7959980E-02, 0.7834683E-02, 0.7665165E-02,&
+0.7119759E-02, 0.7347503E-02, 0.7183881E-02, 0.7041634E-02, 0.7023945E-02,&
+0.6749768E-02, 0.6571406E-02, 0.6565509E-02, 0.6395254E-02, 0.6219103E-02,&
+0.6168247E-02, 0.6007574E-02, 0.5866062E-02, 0.5709074E-02, 0.5557982E-02,&
+0.5512286E-02, 0.5389938E-02, 0.5189464E-02, 0.5112813E-02, 0.4983095E-02,&
+0.4880646E-02, 0.4728080E-02, 0.4599837E-02, 0.4604259E-02, 0.4568881E-02,&
+0.4453166E-02, 0.4352930E-02, 0.4231319E-02, 0.4166460E-02, 0.4075804E-02,&
+0.4045586E-02, 0.3921027E-02, 0.3888597E-02, 0.3861327E-02, 0.3747823E-02,&
+0.3687387E-02, 0.3598206E-02, 0.3593046E-02, 0.3531872E-02, 0.3429424E-02,&
+0.3408050E-02, 0.3338769E-02, 0.3282018E-02, 0.3210525E-02, 0.3136085E-02,&
+0.3085229E-02, 0.3026266E-02, 0.2959933E-02, 0.2858222E-02, 0.2793363E-02,&
+0.2744719E-02, 0.2707130E-02, 0.2652589E-02, 0.2637849E-02, 0.2584045E-02,&
+0.2525819E-02, 0.2519186E-02, 0.2474227E-02, 0.2400524E-02, 0.2349668E-02,&
+0.2348931E-02, 0.2326083E-02, 0.2286283E-02, 0.2261224E-02, 0.2222161E-02,&
+0.2219213E-02, 0.2172043E-02, 0.2112343E-02, 0.2037902E-02, 0.2012106E-02,&
+0.1999576E-02, 0.1977465E-02, 0.1949458E-02, 0.1953143E-02, 0.1772569E-02,&
+0.1851432E-02, 0.1768884E-02, 0.1746036E-02, 0.1763725E-02, 0.1667173E-02,&
+0.1674544E-02, 0.1654644E-02, 0.1639903E-02, 0.1533033E-02, 0.1551459E-02,&
+0.1520504E-02, 0.1483652E-02, 0.1468911E-02, 0.1462278E-02, 0.1404052E-02,&
+0.1369411E-02, 0.1349511E-02, 0.1320030E-02, 0.1294234E-02, 0.1277282E-02,&
+0.1252223E-02, 0.1242641E-02, 0.1176308E-02, 0.1183679E-02, 0.1151249E-02,&
+0.1139456E-02, 0.1107764E-02, 0.1111449E-02, 0.1077545E-02, 0.1049538E-02,&
+0.1029638E-02, 0.1015634E-02, 0.9824679E-03, 0.9677272E-03, 0.9574086E-03,&
+0.9294013E-03, 0.9294013E-03, 0.9131865E-03, 0.8814940E-03, 0.8829681E-03,&
+0.8623311E-03, 0.8468534E-03, 0.8225312E-03, 0.8004201E-03, 0.7945239E-03,&
+0.7805202E-03, 0.7576721E-03, 0.7392463E-03, 0.7280433E-03, 0.7214100E-03,&
+0.7079960E-03, 0.6925183E-03, 0.6836001E-03, 0.6787357E-03, 0.6694490E-03,&
+0.6601624E-03, 0.6471906E-03, 0.6306809E-03, 0.6262587E-03, 0.6120340E-03,&
+0.6091595E-03, 0.5955244E-03, 0.5894070E-03, 0.5771722E-03, 0.5630211E-03,&
+0.5557982E-03, 0.5469538E-03, 0.5378146E-03, 0.5280857E-03, 0.5240319E-03,&
+0.5124605E-03, 0.5063431E-03, 0.4988254E-03, 0.4876225E-03, 0.4805469E-03,&
+0.4756088E-03, 0.4649218E-03, 0.4577725E-03, 0.4548981E-03, 0.4443585E-03,&
+0.4380937E-03, 0.4349982E-03, 0.4252693E-03, 0.4209945E-03, 0.4156141E-03,&
+0.4025686E-03, 0.4022001E-03, 0.3895231E-03, 0.3815631E-03, 0.3851009E-03,&
+0.3799416E-03, 0.3736400E-03, 0.3673383E-03, 0.3610735E-03, 0.3548087E-03,&
+0.3495758E-03, 0.3443428E-03, 0.3398469E-03, 0.3353510E-03, 0.3319237E-03,&
+0.3284966E-03, 0.3228951E-03, 0.3172936E-03, 0.3138296E-03, 0.3103655E-03,&
+0.3055011E-03, 0.3006366E-03, 0.2965461E-03, 0.2924555E-03, 0.2887335E-03,&
+0.2850115E-03, 0.2811789E-03, 0.2773463E-03, 0.2736611E-03, 0.2699760E-03,&
+0.2656643E-03, 0.2613527E-03, 0.2584782E-03, 0.2556038E-03, 0.2525451E-03,&
+0.2494864E-03, 0.2462434E-03, 0.2430005E-03, 0.2397575E-03, 0.2365146E-03,&
+0.2331979E-03, 0.2298813E-03, 0.2266752E-03, 0.2234690E-03, 0.2211474E-03,&
+0.2188257E-03, 0.2159144E-03, 0.2130031E-03, 0.2103130E-03, 0.2076228E-03,&
+0.2051537E-03, 0.2026847E-03, 0.2001787E-03, 0.1976728E-03, 0.1950932E-03,&
+0.1925136E-03, 0.1901182E-03, 0.1877228E-03, 0.1847010E-03, 0.1816792E-03,&
+0.1800945E-03, 0.1785099E-03, 0.1763725E-03, 0.1742351E-03, 0.1720977E-03,&
+0.1699603E-03, 0.1677492E-03, 0.1655381E-03, 0.1637692E-03, 0.1620003E-03,&
+0.1600103E-03, 0.1580203E-03, 0.1562514E-03, 0.1544826E-03, 0.1527137E-03,&
+0.1509448E-03, 0.1491759E-03, 0.1474070E-03, 0.1456013E-03, 0.1437956E-03,&
+0.1421741E-03, 0.1405526E-03, 0.1387469E-03, 0.1369411E-03, 0.1348774E-03,&
+0.1328137E-03, 0.1315608E-03, 0.1303078E-03, 0.1291654E-03, 0.1280230E-03,&
+0.1265489E-03, 0.1250749E-03, 0.1236745E-03, 0.1222741E-03, 0.1206526E-03,&
+0.1190312E-03, 0.1178888E-03, 0.1167464E-03, 0.1156408E-03, 0.1145353E-03,&
+0.1132823E-03, 0.1120294E-03, 0.1107764E-03, 0.1095234E-03, 0.1084179E-03,&
+0.1073123E-03, 0.1061699E-03, 0.1050275E-03, 0.1038483E-03, 0.1026690E-03,&
+0.1015266E-03, 0.1003842E-03, 0.9935234E-04, 0.9832049E-04, 0.9732549E-04,&
+0.9633049E-04, 0.9537235E-04, 0.9441420E-04, 0.9330864E-04, 0.9220310E-04,&
+0.9113440E-04, 0.9006570E-04, 0.8899700E-04, 0.8792829E-04, 0.8678589E-04,&
+0.8564349E-04, 0.8501700E-04, 0.8439052E-04, 0.8302701E-04, 0.8166349E-04,&
+0.8122127E-04, 0.8077905E-04, 0.8011572E-04, 0.7945239E-04, 0.7867850E-04,&
+0.7790462E-04, 0.7720443E-04, 0.7650425E-04, 0.7580406E-04, 0.7510388E-04,&
+0.7434105E-04, 0.7357822E-04, 0.7283750E-04, 0.7209678E-04, 0.7142239E-04,&
+0.7074801E-04, 0.7011415E-04, 0.6948030E-04, 0.6876537E-04, 0.6805045E-04,&
+0.6730973E-04, 0.6656901E-04, 0.6592411E-04, 0.6527920E-04, 0.6458639E-04,&
+0.6389357E-04 /) 
+
+
+!
+! Table for computing Reflectance just below ocean surface (bounded to 200-800 nm)
+! table of refractive index as function of wavelength
+REAL, PARAMETER, DIMENSION(NNWL)::  XAKREFM= &
+(/ 1.4517,  1.4345,  1.4214,  1.4108,  1.4022,  1.3950,  1.3889,  1.3836,      &
+1.3790,  1.3750,  1.3714,  1.3682,  1.3653,  1.3627,  1.3604,  1.3582,  1.3562,&
+1.3544,  1.3528,  1.3512,  1.3498,  1.3484,  1.3472,  1.3460,  1.3449,  1.3439,&
+1.3429,  1.3420,  1.3411,  1.3402,  1.3394,  1.3387,  1.3379,  1.3372,  1.3366,&
+1.3359,  1.3353,  1.3347,  1.3342,  1.3336,  1.3331,  1.3326,  1.3321,  1.3316,&
+1.3311,  1.3307,  1.3303,  1.3299,  1.3295,  1.3291,  1.3288,  1.3284,  1.3281,&
+1.3278,  1.3275,  1.3272,  1.3269,  1.3266,  1.3264,  1.3261,  1.3259,  1.3256,&
+1.3254,  1.3252,  1.3249,  1.3247,  1.3245,  1.3243,  1.3241,  1.3238,  1.3236,&
+1.3234,  1.3232,  1.3230,  1.3228,  1.3226,  1.3225,  1.3223,  1.3221,  1.3219,&
+1.3217,  1.3215,  1.3213,  1.3211,  1.3210,  1.3208,  1.3206,  1.3204,  1.3202,&
+1.3200,  1.3198,  1.3197,  1.3195,  1.3193,  1.3191,  1.3189,  1.3187,  1.3186,&
+1.3184,  1.3182,  1.3180,  1.3178,  1.3176,  1.3174,  1.3172,  1.3170,  1.3169,&
+1.3167,  1.3165,  1.3163,  1.3161,  1.3159,  1.3156,  1.3154,  1.3152,  1.3150,&
+1.3148,  1.3146,  1.3143,  1.3141,  1.3139,  1.3137,  1.3135,  1.3134,  1.3132,&
+1.3130,  1.3129,  1.3127,  1.3125,  1.3123,  1.3121,  1.3119,  1.3116,  1.3114,&
+1.3111,  1.3109,  1.3106,  1.3104,  1.3101,  1.3099,  1.3096,  1.3094,  1.3091,&
+1.3088,  1.3086,  1.3083,  1.3080,  1.3077,  1.3074,  1.3071,  1.3068,  1.3065,&
+1.3061,  1.3058,  1.3055,  1.3051,  1.3048,  1.3044,  1.3041,  1.3037,  1.3034,&
+1.3030,  1.3026,  1.3022,  1.3017,  1.3013,  1.3007,  1.3002,  1.2998,  1.2995,&
+1.2990,  1.2988,  1.2988,  1.2987,  1.2986,  1.2985,  1.2983,  1.2980,  1.2977,&
+1.2973,  1.2969,  1.2965,  1.2960,  1.2955,  1.2950,  1.2945,  1.2940,  1.2935,&
+1.2929,  1.2924,  1.2918,  1.2913,  1.2907,  1.2901,  1.2895,  1.2889,  1.2883,&
+1.2876,  1.2870,  1.2863,  1.2856,  1.2849,  1.2842,  1.2835,  1.2828,  1.2820,&
+1.2812,  1.2804,  1.2796,  1.2788,  1.2779,  1.2770,  1.2761,  1.2751,  1.2741,&
+1.2731,  1.2721,  1.2711,  1.2699,  1.2688,  1.2676,  1.2664,  1.2652,  1.2639,&
+1.2625,  1.2612,  1.2597,  1.2582,  1.2567,  1.2552,  1.2535,  1.2518,  1.2499,&
+1.2480,  1.2459,  1.2436,  1.2413,  1.2388,  1.2361,  1.2331,  1.2299,  1.2263,&
+1.2223,  1.2182,  1.2140,  1.2091,  1.2034,  1.1973,  1.1910,  1.1850,  1.1780,&
+1.1691,  1.1564,  1.1489,  1.1430,  1.1351,  1.1318,  1.1323,  1.1308,  1.1277,&
+1.1294,  1.1286,  1.1255,  1.1271,  1.1348,  1.1417,  1.1480,  1.1612,  1.1736,&
+1.1847,  1.2008,  1.2177,  1.2336,  1.2505,  1.2678,  1.2840,  1.3007,  1.3149,&
+1.3281,  1.3407,  1.3539,  1.3661,  1.3782,  1.3903,  1.4024,  1.4136,  1.4217,&
+1.4299,  1.4380,  1.4461,  1.4528,  1.4557,  1.4587,  1.4616,  1.4645,  1.4665,&
+1.4655,  1.4645,  1.4634,  1.4624,  1.4613,  1.4589,  1.4566,  1.4543,  1.4519,&
+1.4496,  1.4465,  1.4433,  1.4401,  1.4369,  1.4338,  1.4304,  1.4271,  1.4237,&
+1.4203,  1.4170,  1.4144,  1.4117,  1.4091,  1.4065,  1.4041,  1.4020,  1.3999,&
+1.3977,  1.3956,  1.3936,  1.3916,  1.3897,  1.3879,  1.3860,  1.3841,  1.3824,&
+1.3808,  1.3791,  1.3774,  1.3758,  1.3743,  1.3729,  1.3714,  1.3700,  1.3685,&
+1.3673,  1.3660,  1.3647,  1.3635,  1.3623,  1.3612,  1.3601,  1.3589,  1.3578,&
+1.3568,  1.3558,  1.3548,  1.3538,  1.3528,  1.3519,  1.3510,  1.3501,  1.3493,&
+1.3484,  1.3476,  1.3468,  1.3460,  1.3452,  1.3444,  1.3437,  1.3430,  1.3422,&
+1.3415,  1.3408,  1.3401,  1.3395,  1.3388,  1.3382,  1.3375,  1.3369,  1.3363,&
+1.3357,  1.3351,  1.3345,  1.3339 /)
+
+
+
+
+!
+! table of chlorophyll absorption coefficient as function of wavelength
+REAL, PARAMETER, DIMENSION(NNWL)::  XAKACHL= &
+(/0.4629505E+00, 0.4694205E+00, 0.4758904E+00, 0.4823604E+00, 0.4888304E+00,&
+0.4953003E+00, 0.5017703E+00, 0.5082403E+00, 0.5147102E+00, 0.5211802E+00,&
+0.5276502E+00, 0.5341201E+00, 0.5405901E+00, 0.5470601E+00, 0.5535300E+00,&
+0.5600000E+00, 0.5700000E+00, 0.5900000E+00, 0.6100000E+00, 0.6600000E+00,&
+0.6870000E+00, 0.8280000E+00, 0.9130000E+00, 0.9730000E+00, 0.1000000E+01,&
+0.9440000E+00, 0.9170000E+00, 0.8700000E+00, 0.7980000E+00, 0.7500000E+00,&
+0.6680000E+00, 0.6180000E+00, 0.5280000E+00, 0.4740000E+00, 0.4160000E+00,&
+0.3570000E+00, 0.2940000E+00, 0.2760000E+00, 0.2910000E+00, 0.2820000E+00,&
+0.2360000E+00, 0.2520000E+00, 0.2760000E+00, 0.3170000E+00, 0.3340000E+00,&
+0.3560000E+00, 0.4410000E+00, 0.5950000E+00, 0.5020000E+00, 0.3290000E+00,&
+0.2150000E+00, 0.2150000E+00, 0.2083276E+00, 0.2016552E+00, 0.1949828E+00,&
+0.1883103E+00, 0.1816379E+00, 0.1749655E+00, 0.1682931E+00, 0.1616207E+00,&
+0.1549483E+00, 0.1482759E+00, 0.1416035E+00, 0.1349310E+00, 0.1282586E+00,&
+0.1215862E+00, 0.1149138E+00, 0.1082414E+00, 0.1015690E+00, 0.9489655E-01,&
+0.8822414E-01, 0.8155172E-01, 0.7487931E-01, 0.6820690E-01, 0.6153448E-01,&
+0.5486207E-01, 0.4818965E-01, 0.4151724E-01, 0.3484483E-01, 0.2817241E-01,&
+0.2150000E-01, 0.2143550E-01, 0.2137100E-01, 0.2130650E-01, 0.2124200E-01,&
+0.2117750E-01, 0.2111300E-01, 0.2104850E-01, 0.2098400E-01, 0.2091950E-01,&
+0.2085500E-01, 0.2079050E-01, 0.2072600E-01, 0.2066150E-01, 0.2059700E-01,&
+0.2053250E-01, 0.2046800E-01, 0.2040350E-01, 0.2033900E-01, 0.2027450E-01,&
+0.2021000E-01, 0.2014550E-01, 0.2008100E-01, 0.2001650E-01, 0.1995200E-01,&
+0.1988750E-01, 0.1982300E-01, 0.1975850E-01, 0.1969400E-01, 0.1962950E-01,&
+0.1956500E-01, 0.1950050E-01, 0.1943600E-01, 0.1937150E-01, 0.1930700E-01,&
+0.1924250E-01, 0.1917800E-01, 0.1911350E-01, 0.1904900E-01, 0.1898450E-01,&
+0.1892000E-01, 0.1885550E-01, 0.1879100E-01, 0.1872650E-01, 0.1866200E-01,&
+0.1859750E-01, 0.1853300E-01, 0.1846850E-01, 0.1840400E-01, 0.1833950E-01,&
+0.1827500E-01, 0.1821050E-01, 0.1814600E-01, 0.1808150E-01, 0.1801700E-01,&
+0.1795250E-01, 0.1788800E-01, 0.1782350E-01, 0.1775900E-01, 0.1769450E-01,&
+0.1763000E-01, 0.1756550E-01, 0.1750100E-01, 0.1743650E-01, 0.1737200E-01,&
+0.1730750E-01, 0.1724300E-01, 0.1717850E-01, 0.1711400E-01, 0.1704950E-01,&
+0.1698500E-01, 0.1692050E-01, 0.1685600E-01, 0.1679150E-01, 0.1672700E-01,&
+0.1666250E-01, 0.1659800E-01, 0.1653350E-01, 0.1646900E-01, 0.1640450E-01,&
+0.1634000E-01, 0.1627550E-01, 0.1621100E-01, 0.1614650E-01, 0.1608200E-01,&
+0.1601750E-01, 0.1595300E-01, 0.1588850E-01, 0.1582400E-01, 0.1575950E-01,&
+0.1569500E-01, 0.1563050E-01, 0.1556600E-01, 0.1550150E-01, 0.1543700E-01,&
+0.1537250E-01, 0.1530800E-01, 0.1524350E-01, 0.1517900E-01, 0.1511450E-01,&
+0.1505000E-01, 0.1498550E-01, 0.1492100E-01, 0.1485650E-01, 0.1479200E-01,&
+0.1472750E-01, 0.1466300E-01, 0.1459850E-01, 0.1453400E-01, 0.1446950E-01,&
+0.1440500E-01, 0.1434050E-01, 0.1427600E-01, 0.1421150E-01, 0.1414700E-01,&
+0.1408250E-01, 0.1401800E-01, 0.1395350E-01, 0.1388900E-01, 0.1382450E-01,&
+0.1376000E-01, 0.1369550E-01, 0.1363100E-01, 0.1356650E-01, 0.1350200E-01,&
+0.1343750E-01, 0.1337300E-01, 0.1330850E-01, 0.1324400E-01, 0.1317950E-01,&
+0.1311500E-01, 0.1305050E-01, 0.1298600E-01, 0.1292150E-01, 0.1285700E-01,&
+0.1279250E-01, 0.1272800E-01, 0.1266350E-01, 0.1259900E-01, 0.1253450E-01,&
+0.1247000E-01, 0.1240550E-01, 0.1234100E-01, 0.1227650E-01, 0.1221200E-01,&
+0.1214750E-01, 0.1208300E-01, 0.1201850E-01, 0.1195400E-01, 0.1188950E-01,&
+0.1182500E-01, 0.1176050E-01, 0.1169600E-01, 0.1163150E-01, 0.1156700E-01,&
+0.1150250E-01, 0.1143800E-01, 0.1137350E-01, 0.1130900E-01, 0.1124450E-01,&
+0.1118000E-01, 0.1111550E-01, 0.1105100E-01, 0.1098650E-01, 0.1092200E-01,&
+0.1085750E-01, 0.1079300E-01, 0.1072850E-01, 0.1066400E-01, 0.1059950E-01,&
+0.1053500E-01, 0.1047050E-01, 0.1040600E-01, 0.1034150E-01, 0.1027700E-01,&
+0.1021250E-01, 0.1014800E-01, 0.1008350E-01, 0.1001900E-01, 0.9954500E-02,&
+0.9890000E-02, 0.9825500E-02, 0.9761000E-02, 0.9696500E-02, 0.9632000E-02,&
+0.9567500E-02, 0.9503000E-02, 0.9438500E-02, 0.9374000E-02, 0.9309500E-02,&
+0.9245000E-02, 0.9180500E-02, 0.9116000E-02, 0.9051500E-02, 0.8987000E-02,&
+0.8922500E-02, 0.8858000E-02, 0.8793500E-02, 0.8729000E-02, 0.8664500E-02,&
+0.8600000E-02, 0.8535500E-02, 0.8471000E-02, 0.8406500E-02, 0.8342000E-02,&
+0.8277500E-02, 0.8213000E-02, 0.8148500E-02, 0.8084000E-02, 0.8019500E-02,&
+0.7955000E-02, 0.7890500E-02, 0.7826000E-02, 0.7761500E-02, 0.7697000E-02,&
+0.7632500E-02, 0.7568000E-02, 0.7503500E-02, 0.7439000E-02, 0.7374500E-02,&
+0.7310000E-02, 0.7245500E-02, 0.7181000E-02, 0.7116500E-02, 0.7052000E-02,&
+0.6987500E-02, 0.6923000E-02, 0.6858500E-02, 0.6794000E-02, 0.6729500E-02,&
+0.6665000E-02, 0.6600500E-02, 0.6536000E-02, 0.6471500E-02, 0.6407000E-02,&
+0.6342500E-02, 0.6278000E-02, 0.6213500E-02, 0.6149000E-02, 0.6084500E-02,&
+0.6020000E-02, 0.5955500E-02, 0.5891000E-02, 0.5826500E-02, 0.5762000E-02,&
+0.5697500E-02, 0.5633000E-02, 0.5568500E-02, 0.5504000E-02, 0.5439500E-02,&
+0.5375000E-02, 0.5310500E-02, 0.5246000E-02, 0.5181500E-02, 0.5117000E-02,&
+0.5052500E-02, 0.4988000E-02, 0.4923500E-02, 0.4859000E-02, 0.4794500E-02,&
+0.4730000E-02, 0.4665500E-02, 0.4601000E-02, 0.4536500E-02, 0.4472000E-02,&
+0.4407500E-02, 0.4343000E-02, 0.4278500E-02, 0.4214000E-02, 0.4149500E-02,&
+0.4085000E-02, 0.4020500E-02, 0.3956000E-02, 0.3891500E-02, 0.3827000E-02,&
+0.3762500E-02, 0.3698000E-02, 0.3633500E-02, 0.3569000E-02, 0.3504500E-02,&
+0.3440000E-02, 0.3375500E-02, 0.3311000E-02, 0.3246500E-02, 0.3182000E-02,&
+0.3117500E-02, 0.3053000E-02, 0.2988500E-02, 0.2924000E-02, 0.2859500E-02,&
+0.2795000E-02, 0.2730500E-02, 0.2666000E-02, 0.2601500E-02, 0.2537000E-02,&
+0.2472500E-02, 0.2408000E-02, 0.2343500E-02, 0.2279000E-02, 0.2214500E-02,&
+0.2150000E-02 /)
+
+REAL, PARAMETER, DIMENSION(NNWL)::  XAKACHL2= &
+(/0.7745835E+00,  0.7522619E+00,  0.7299404E+00,  0.7076188E+00, 0.6852972E+00,&
+0.6629756E+00,  0.5767828E+00,  0.5011461E+00,  0.4285168E+00,  0.3946458E+00,&
+0.4330427E+00,  0.5309876E+00,  0.6371105E+00,  0.7297136E+00,  0.7904093E+00,&
+0.8097131E+00,  0.8760642E+00,  0.9381161E+00,  0.9457293E+00,  0.9258360E+00,&
+0.9025422E+00,  0.9252829E+00,  0.9270173E+00,  0.9995731E+00,  0.8171211E+00,&
+0.5353835E+00,  0.5329482E+00,  0.5348938E+00,  0.3804893E+00,  0.2089162E+00,&
+0.1108572E+00,  0.7056972E-01,  0.6340462E-01,  0.7044097E-01,  0.8182860E-01,&
+0.9896376E-01,  0.1267309E+00,  0.1598070E+00,  0.1993082E+00,  0.2502128E+00,&
+0.3026099E+00,  0.3196909E+00,  0.2917686E+00,  0.2666667E+00,  0.3314760E+00,&
+0.5711130E+00,  0.7452133E+00,  0.5497976E+00,  0.2406984E+00,  0.1315954E+00,&
+0.1197734E+00,  0.1258391E+00,  0.1367452E+00,  0.1552781E+00,  0.1936057E+00,&
+0.2571016E+00,  0.3363165E+00,  0.4064784E+00,  0.4289439E+00,  0.3819179E+00,&
+0.2987019E+00,  0.2160145E+00,  0.1343931E+00,  0.6321464E-01,  0.2241001E-01,&
+0.5134957E-02, -0.1242093E-02, -0.2531676E-02, -0.4085609E-02, -0.4713067E-02,&
+-0.5693497E-02, -0.1090849E-01, -0.1407841E-01, -0.1816251E-01, -0.2587014E-01,&
+-0.3565745E-01, -0.4546714E-01, -0.5446691E-01, -0.5650476E-01, -0.5981312E-01,&
+-0.5981312E-01, -0.6451318E-01, -0.4835265E-01, -0.4864828E-01, -0.4876773E-01,&
+-0.4840301E-01, -0.4866588E-01, -0.4836091E-01, -0.4851014E-01, -0.4860595E-01,&
+-0.4852568E-01, -0.4805798E-01, -0.4859427E-01, -0.4795901E-01, -0.4846919E-01,&
+-0.4850669E-01, -0.4854093E-01, -0.4849193E-01, -0.4841270E-01, -0.4855558E-01,&
+-0.4827924E-01, -0.4906723E-01, -0.4822920E-01, -0.4818162E-01, -0.4854826E-01,&
+-0.4875536E-01, -0.4863250E-01, -0.4843162E-01, -0.4836087E-01, -0.4913286E-01,&
+-0.4884187E-01, -0.4864121E-01, -0.4865143E-01, -0.4821299E-01, -0.4880581E-01,&
+-0.4887014E-01, -0.4868441E-01, -0.4861962E-01, -0.4806854E-01, -0.4918258E-01,&
+-0.4813463E-01, -0.4876416E-01, -0.4831872E-01, -0.4867297E-01, -0.4862849E-01,&
+-0.4836460E-01, -0.4858448E-01, -0.4886762E-01, -0.4875397E-01, -0.4863992E-01,&
+-0.4862744E-01, -0.4887019E-01, -0.4816946E-01, -0.4892569E-01, -0.4864310E-01,&
+-0.4881326E-01, -0.4819329E-01, -0.4852681E-01, -0.4803719E-01, -0.4831237E-01,&
+-0.4866472E-01, -0.4815419E-01, -0.4873738E-01, -0.4851730E-01, -0.4848577E-01,&
+-0.4881878E-01, -0.4878175E-01, -0.4839409E-01, -0.4850954E-01, -0.4846783E-01,&
+-0.4847389E-01, -0.4833271E-01, -0.4859281E-01, -0.4863393E-01, -0.4839972E-01,&
+-0.4851298E-01, -0.4831513E-01, -0.4842690E-01, -0.4784760E-01, -0.4914954E-01,&
+-0.4866549E-01, -0.4890948E-01, -0.4834954E-01, -0.4830681E-01, -0.4859897E-01,&
+-0.4838582E-01, -0.4851704E-01, -0.4866422E-01, -0.4881537E-01, -0.4851842E-01,&
+-0.4877209E-01, -0.4873482E-01, -0.4825956E-01, -0.4852063E-01, -0.4867407E-01,&
+-0.4878135E-01, -0.4830102E-01, -0.4826979E-01, -0.4870005E-01, -0.4902764E-01,&
+-0.4871316E-01, -0.4853799E-01, -0.4867663E-01, -0.4823785E-01, -0.4855946E-01,&
+-0.4875993E-01, -0.4846177E-01, -0.4886679E-01, -0.4859700E-01, -0.4809872E-01,&
+-0.4822881E-01, -0.4837712E-01, -0.4855768E-01, -0.4867230E-01, -0.4838317E-01,&
+-0.4876311E-01, -0.4812689E-01, -0.4820772E-01, -0.4904227E-01, -0.4871970E-01,&
+-0.4853304E-01, -0.4859587E-01, -0.4845879E-01, -0.4837155E-01, -0.4874718E-01,&
+-0.4873789E-01, -0.4851343E-01, -0.4851316E-01, -0.4901856E-01, -0.4836449E-01,&
+-0.4880954E-01, -0.4853077E-01, -0.4898909E-01, -0.4812662E-01, -0.4832583E-01,&
+-0.4847423E-01, -0.4846226E-01, -0.4844360E-01, -0.4835512E-01, -0.4893025E-01,&
+-0.4853777E-01, -0.4873621E-01, -0.4832436E-01, -0.4854396E-01, -0.4848187E-01,&
+-0.4850079E-01, -0.4843526E-01, -0.4818938E-01, -0.4874043E-01, -0.4847353E-01,&
+-0.4865320E-01, -0.4853667E-01, -0.4859223E-01, -0.4872705E-01, -0.4821515E-01,&
+-0.4844453E-01, -0.4870005E-01, -0.4881809E-01, -0.4865348E-01, -0.4871232E-01,&
+-0.4859998E-01, -0.4833980E-01, -0.4860161E-01, -0.4839900E-01, -0.4853466E-01,&
+-0.4864573E-01, -0.4863669E-01, -0.4901951E-01, -0.4832310E-01, -0.4890333E-01,&
+-0.4880714E-01, -0.4855986E-01, -0.4852934E-01, -0.4818182E-01, -0.4795438E-01,&
+-0.4834752E-01, -0.4810626E-01, -0.4861891E-01, -0.4872801E-01, -0.4814039E-01,&
+-0.4894429E-01, -0.4881275E-01, -0.4903332E-01, -0.4835438E-01, -0.4865217E-01,&
+-0.4853667E-01, -0.4841790E-01, -0.4869760E-01, -0.4900452E-01, -0.4856053E-01,&
+-0.4825166E-01, -0.4837719E-01, -0.4872088E-01, -0.4873605E-01, -0.4868101E-01,&
+-0.4883375E-01, -0.4870022E-01, -0.4875332E-01, -0.4836111E-01, -0.4863061E-01,&
+-0.4875719E-01, -0.4874192E-01, -0.4847357E-01, -0.4867528E-01, -0.4836407E-01,&
+-0.4828474E-01, -0.4860063E-01, -0.4861546E-01, -0.4864795E-01, -0.4844943E-01,&
+-0.4904242E-01, -0.4843469E-01, -0.4866992E-01, -0.4900254E-01, -0.4864337E-01,&
+-0.4844130E-01, -0.4837940E-01, -0.4855977E-01, -0.4874923E-01, -0.4906257E-01,&
+-0.4864537E-01, -0.4834532E-01, -0.4869347E-01, -0.4858449E-01, -0.4877963E-01,&
+-0.4863986E-01, -0.4848931E-01, -0.4836552E-01, -0.4849740E-01, -0.4887220E-01,&
+-0.4904565E-01, -0.4872388E-01, -0.4810480E-01, -0.4806256E-01, -0.4874242E-01,&
+-0.4819115E-01, -0.4862189E-01, -0.4871701E-01, -0.4839065E-01, -0.4877597E-01,&
+-0.4905847E-01, -0.4861049E-01, -0.4812144E-01, -0.4872767E-01, -0.4891870E-01,&
+-0.4890406E-01, -0.4818467E-01, -0.4847043E-01, -0.4841457E-01, -0.4821321E-01,&
+-0.4847127E-01, -0.4868549E-01, -0.4910397E-01, -0.4863713E-01, -0.4831791E-01,&
+-0.4807175E-01, -0.4877013E-01, -0.4882632E-01, -0.4808306E-01, -0.4848078E-01,&
+-0.4849469E-01, -0.4864521E-01, -0.4823979E-01, -0.4866831E-01, -0.4870176E-01,&
+-0.4837111E-01, -0.4899544E-01, -0.4904284E-01, -0.4913362E-01, -0.4821655E-01,&
+-0.4833322E-01, -0.4831560E-01, -0.4840073E-01, -0.4852060E-01, -0.4897843E-01,&
+-0.4829322E-01, -0.4884781E-01, -0.4827255E-01, -0.4827960E-01, -0.4864042E-01,&
+-0.4828514E-01, -0.4897902E-01, -0.4855954E-01, -0.4855975E-01, -0.4858216E-01,&
+-0.4827806E-01, -0.4847189E-01, -0.4860275E-01, -0.4906456E-01, -0.4853636E-01,&
+-0.4862808E-01, -0.4848551E-01, -0.4869109E-01, -0.4848604E-01, -0.4866388E-01,&
+-0.4846765E-01, -0.4875867E-01, -0.4807435E-01, -0.4867530E-01, -0.4888080E-01,&
+-0.4844930E-01 /)
+
+
+
+
+
+
+
+!
+! table of seawater absorption coefficient as function of wavelength
+REAL, PARAMETER, DIMENSION(NNWL)::  XAKAW3= &
+(/0.3067439E+01, 0.1993737E+01, 0.1309263E+01, 0.9275307E+00, 0.7183294E+00,&
+0.5608010E+00, 0.4552411E+00, 0.3738498E+00, 0.2879400E+00, 0.2145172E+00,&
+0.1415658E+00, 0.1048958E+00, 0.8411996E-01, 0.6814662E-01, 0.5585442E-01,&
+0.4638546E-01, 0.3791143E-01, 0.2984669E-01, 0.2234093E-01, 0.1870175E-01,&
+0.1737227E-01, 0.1609624E-01, 0.1530537E-01, 0.1443961E-01, 0.1437088E-01,&
+0.1480803E-01, 0.1517563E-01, 0.1592806E-01, 0.1743279E-01, 0.1967369E-01,&
+0.2564243E-01, 0.3598580E-01, 0.4703195E-01, 0.5145027E-01, 0.5534469E-01,&
+0.6400512E-01, 0.7030880E-01, 0.8172981E-01, 0.1033439E+00, 0.1638825E+00,&
+0.2387544E+00, 0.2908335E+00, 0.3086321E+00, 0.3193000E+00, 0.3277702E+00,&
+0.3523264E+00, 0.3957919E+00, 0.4326377E+00, 0.4485145E+00, 0.5016078E+00,&
+0.6481431E+00, 0.8408502E+00, 0.1165249E+01, 0.1810640E+01, 0.2364421E+01,&
+0.2479177E+01, 0.2547112E+01, 0.2511108E+01, 0.2356959E+01, 0.2164139E+01,&
+0.2068389E+01, 0.2334173E+01, 0.3101571E+01, 0.3715746E+01, 0.4069374E+01,&
+0.4055130E+01, 0.3662220E+01, 0.3265983E+01, 0.3338288E+01, 0.4351006E+01,&
+0.6776006E+01, 0.1092508E+02, 0.1646968E+02, 0.2292120E+02, 0.2979101E+02,&
+0.3659049E+02, 0.4255537E+02, 0.4581877E+02, 0.4488433E+02, 0.4084045E+02,&
+0.3542173E+02, 0.3008784E+02, 0.2519888E+02, 0.2084002E+02, 0.1709645E+02,&
+0.1405336E+02, 0.1179592E+02, 0.1051821E+02, 0.1084989E+02, 0.1352949E+02,&
+0.1929556E+02, 0.2856379E+02, 0.4045844E+02, 0.5378094E+02, 0.6733270E+02,&
+0.7991512E+02, 0.9045451E+02, 0.9837671E+02, 0.1032324E+03, 0.1045724E+03,&
+0.1024582E+03, 0.9870555E+02, 0.9448188E+02, 0.9066481E+02, 0.8813195E+02,&
+0.8776093E+02, 0.9009315E+02, 0.9432506E+02, 0.9931691E+02, 0.1039289E+03,&
+0.1070213E+03, 0.1091415E+03, 0.1175854E+03, 0.1413362E+03, 0.1893769E+03,&
+0.2706907E+03, 0.3927593E+03, 0.5570592E+03, 0.7635654E+03, 0.1012253E+04,&
+0.1303097E+04, 0.1629710E+04, 0.1960254E+04, 0.2256530E+04, 0.2480335E+04,&
+0.2593472E+04, 0.2570322E+04, 0.2435603E+04, 0.2226617E+04, 0.1980665E+04,&
+0.1735048E+04, 0.1520186E+04, 0.1338970E+04, 0.1187410E+04, 0.1061517E+04,&
+0.9572996E+03, 0.8707689E+03, 0.7979346E+03, 0.7348066E+03, 0.6773950E+03,&
+0.6217097E+03, 0.5658621E+03, 0.5163686E+03, 0.4818471E+03, 0.4709154E+03,&
+0.4921914E+03, 0.5339673E+03, 0.5283995E+03, 0.4879842E+03, 0.4503842E+03,&
+0.4532622E+03, 0.5219655E+03, 0.6325787E+03, 0.7488713E+03, 0.8346125E+03,&
+0.8535717E+03, 0.7823218E+03, 0.6486514E+03, 0.4931527E+03, 0.3564180E+03,&
+0.2790396E+03, 0.2973530E+03, 0.4306661E+03, 0.6940303E+03, 0.1102497E+04,&
+0.1671116E+04, 0.2414941E+04, 0.3349021E+04, 0.4488408E+04, 0.5848154E+04,&
+0.7443309E+04, 0.9216590E+04, 0.1082137E+05, 0.1183869E+05, 0.1184960E+05,&
+0.1078493E+05, 0.9686200E+04, 0.8790378E+04, 0.8045845E+04, 0.7400985E+04,&
+0.6804181E+04, 0.6214741E+04, 0.5635665E+04, 0.5080881E+04, 0.4564313E+04,&
+0.4099888E+04, 0.3697940E+04, 0.3354440E+04, 0.3061767E+04, 0.2812299E+04,&
+0.2598416E+04, 0.2413350E+04, 0.2253741E+04, 0.2117085E+04, 0.2000874E+04,&
+0.1902603E+04, 0.1819767E+04, 0.1749858E+04, 0.1690372E+04, 0.1638801E+04,&
+0.1592640E+04, 0.1555394E+04, 0.1548293E+04, 0.1573317E+04, 0.1626133E+04,&
+0.1702405E+04, 0.1797857E+04, 0.1908438E+04, 0.2030156E+04, 0.2159016E+04,&
+0.2291026E+04, 0.2423482E+04, 0.2558843E+04, 0.2700856E+04, 0.2853272E+04,&
+0.3019837E+04, 0.3204129E+04, 0.3409039E+04, 0.3637285E+04, 0.3891587E+04,&
+0.4174664E+04, 0.4489235E+04, 0.4838020E+04, 0.5223737E+04, 0.5649106E+04,&
+0.6116846E+04, 0.6622627E+04, 0.7133928E+04, 0.7611180E+04, 0.8014812E+04,&
+0.8305254E+04, 0.8466704E+04, 0.8578431E+04, 0.8743467E+04, 0.9064849E+04,&
+0.9645611E+04, 0.1051240E+05, 0.1138630E+05, 0.1191200E+05, 0.1173420E+05,&
+0.1049759E+05, 0.8305364E+04, 0.7094721E+04, 0.9142031E+04, 0.1397930E+05,&
+0.1839416E+05, 0.1986234E+05, 0.1908920E+05, 0.1758752E+05, 0.1687005E+05,&
+0.1844957E+05, 0.2383885E+05, 0.3455066E+05, 0.5209777E+05, 0.7799295E+05,&
+0.1137490E+06, 0.1602886E+06, 0.2161751E+06, 0.2793814E+06, 0.3478807E+06,&
+0.4196461E+06, 0.4928405E+06, 0.5663854E+06, 0.6393920E+06, 0.7109715E+06,&
+0.7802351E+06, 0.8462941E+06, 0.9082596E+06, 0.9652429E+06, 0.1016355E+07,&
+0.1060708E+07, 0.1097549E+07, 0.1126679E+07, 0.1148035E+07, 0.1161554E+07,&
+0.1167173E+07, 0.1164996E+07, 0.1155796E+07, 0.1140514E+07, 0.1120088E+07,&
+0.1095461E+07, 0.1067479E+07, 0.1036628E+07, 0.1003298E+07, 0.9678839E+06,&
+0.9307769E+06, 0.8923695E+06, 0.8530543E+06, 0.8132238E+06, 0.7732703E+06,&
+0.7335864E+06, 0.6945089E+06, 0.6561521E+06, 0.6185746E+06, 0.5818354E+06,&
+0.5459929E+06, 0.5111060E+06, 0.4772333E+06, 0.4444336E+06, 0.4127655E+06,&
+0.3822878E+06, 0.3530592E+06, 0.3251383E+06, 0.2985839E+06, 0.2734547E+06,&
+0.2498094E+06, 0.2277067E+06, 0.2072053E+06, 0.1883639E+06, 0.1712413E+06,&
+0.1558960E+06, 0.1423474E+06, 0.1304565E+06, 0.1200447E+06, 0.1109338E+06,&
+0.1029451E+06, 0.9590033E+05, 0.8962092E+05, 0.8392845E+05, 0.7864446E+05,&
+0.7359050E+05, 0.6862405E+05, 0.6374646E+05, 0.5899502E+05, 0.5440700E+05,&
+0.5001969E+05, 0.4587039E+05, 0.4199638E+05, 0.3843495E+05, 0.3522339E+05,&
+0.3239897E+05, 0.2998538E+05, 0.2795181E+05, 0.2625384E+05, 0.2484704E+05,&
+0.2368700E+05, 0.2272929E+05, 0.2192950E+05, 0.2124319E+05, 0.2062596E+05,&
+0.2003338E+05, 0.1942931E+05, 0.1881074E+05, 0.1818297E+05, 0.1755126E+05,&
+0.1692090E+05, 0.1629717E+05, 0.1568535E+05, 0.1509072E+05, 0.1451856E+05,&
+0.1397415E+05, 0.1346277E+05, 0.1298970E+05, 0.1256022E+05, 0.1217961E+05,&
+0.1185315E+05, 0.1158473E+05, 0.1137272E+05, 0.1121409E+05, 0.1110580E+05,&
+0.1104483E+05, 0.1102816E+05, 0.1105274E+05, 0.1111556E+05, 0.1121359E+05,&
+0.1134380E+05, 0.1150316E+05, 0.1168864E+05, 0.1189722E+05, 0.1212586E+05,&
+0.1237155E+05, 0.1263124E+05, 0.1290192E+05, 0.1318056E+05, 0.1346412E+05,&
+0.1374958E+05, 0.1403392E+05, 0.1431409E+05, 0.1458709E+05, 0.1484987E+05,&
+0.1509941E+05 /)
+
+
+
+!
+! table of seawater backscattering coefficient as function of wavelength
+REAL, PARAMETER, DIMENSION(NNWL)::  XAKBW= &
+(/0.1510000E+00, 0.1190000E+00, 0.9950015E-01, 0.8199944E-01, 0.6850207E-01,&
+0.5749506E-01, 0.4850663E-01, 0.4149505E-01, 0.3530210E-01, 0.3049935E-01,&
+0.2620052E-01, 0.2289856E-01, 0.2000336E-01, 0.1749553E-01, 0.1530325E-01,&
+0.1339897E-01, 0.1199900E-01, 0.1060502E-01, 0.9387780E-02, 0.8416411E-02,&
+0.7587748E-02, 0.6805146E-02, 0.6098530E-02, 0.5500733E-02, 0.4898538E-02,&
+0.4503288E-02, 0.4095613E-02, 0.3703303E-02, 0.3398477E-02, 0.3100964E-02,&
+0.2897666E-02, 0.2608371E-02, 0.2380034E-02, 0.2226757E-02, 0.2080041E-02,&
+0.1908345E-02, 0.1797763E-02, 0.1700603E-02, 0.1599833E-02, 0.1500036E-02,&
+0.1400066E-02, 0.1299673E-02, 0.1201250E-02, 0.1095326E-02, 0.1017446E-02,&
+0.9582712E-03, 0.8559384E-03, 0.7582711E-03, 0.7174466E-03, 0.6953252E-03,&
+0.7012525E-03, 0.6996646E-03, 0.6000893E-03, 0.5999768E-03, 0.6000058E-03,&
+0.4999986E-03, 0.5000004E-03, 0.4999999E-03, 0.4000000E-03, 0.4000000E-03,&
+0.4000000E-03, 0.4000000E-03, 0.3987586E-03, 0.3975172E-03, 0.3962759E-03,&
+0.3950345E-03, 0.3937931E-03, 0.3925517E-03, 0.3913103E-03, 0.3900690E-03,&
+0.3888276E-03, 0.3875862E-03, 0.3863448E-03, 0.3851035E-03, 0.3838621E-03,&
+0.3826207E-03, 0.3813793E-03, 0.3801379E-03, 0.3788965E-03, 0.3776552E-03,&
+0.3764138E-03, 0.3751724E-03, 0.3739310E-03, 0.3726897E-03, 0.3714483E-03,&
+0.3702069E-03, 0.3689655E-03, 0.3677241E-03, 0.3664828E-03, 0.3652414E-03,&
+0.3640000E-03, 0.3627586E-03, 0.3615172E-03, 0.3602759E-03, 0.3590345E-03,&
+0.3577931E-03, 0.3565517E-03, 0.3553103E-03, 0.3540690E-03, 0.3528276E-03,&
+0.3515862E-03, 0.3503448E-03, 0.3491034E-03, 0.3478621E-03, 0.3466207E-03,&
+0.3453793E-03, 0.3441379E-03, 0.3428966E-03, 0.3416552E-03, 0.3404138E-03,&
+0.3391724E-03, 0.3379310E-03, 0.3366896E-03, 0.3354483E-03, 0.3342069E-03,&
+0.3329655E-03, 0.3317241E-03, 0.3304828E-03, 0.3292414E-03, 0.3280000E-03,&
+0.3267586E-03, 0.3255172E-03, 0.3242759E-03, 0.3230345E-03, 0.3217931E-03,&
+0.3205517E-03, 0.3193103E-03, 0.3180690E-03, 0.3168276E-03, 0.3155862E-03,&
+0.3143448E-03, 0.3131035E-03, 0.3118621E-03, 0.3106207E-03, 0.3093793E-03,&
+0.3081379E-03, 0.3068965E-03, 0.3056552E-03, 0.3044138E-03, 0.3031724E-03,&
+0.3019310E-03, 0.3006897E-03, 0.2994483E-03, 0.2982069E-03, 0.2969655E-03,&
+0.2957241E-03, 0.2944828E-03, 0.2932414E-03, 0.2920000E-03, 0.2907586E-03,&
+0.2895173E-03, 0.2882759E-03, 0.2870345E-03, 0.2857931E-03, 0.2845517E-03,&
+0.2833103E-03, 0.2820690E-03, 0.2808276E-03, 0.2795862E-03, 0.2783448E-03,&
+0.2771034E-03, 0.2758621E-03, 0.2746207E-03, 0.2733793E-03, 0.2721379E-03,&
+0.2708966E-03, 0.2696552E-03, 0.2684138E-03, 0.2671724E-03, 0.2659310E-03,&
+0.2646896E-03, 0.2634483E-03, 0.2622069E-03, 0.2609655E-03, 0.2597241E-03,&
+0.2584828E-03, 0.2572414E-03, 0.2560000E-03, 0.2547586E-03, 0.2535172E-03,&
+0.2522759E-03, 0.2510345E-03, 0.2497931E-03, 0.2485517E-03, 0.2473104E-03,&
+0.2460690E-03, 0.2448276E-03, 0.2435862E-03, 0.2423448E-03, 0.2411035E-03,&
+0.2398621E-03, 0.2386207E-03, 0.2373793E-03, 0.2361379E-03, 0.2348965E-03,&
+0.2336552E-03, 0.2324138E-03, 0.2311724E-03, 0.2299310E-03, 0.2286896E-03,&
+0.2274483E-03, 0.2262069E-03, 0.2249655E-03, 0.2237241E-03, 0.2224828E-03,&
+0.2212414E-03, 0.2200000E-03, 0.2187586E-03, 0.2175172E-03, 0.2162759E-03,&
+0.2150345E-03, 0.2137931E-03, 0.2125517E-03, 0.2113103E-03, 0.2100690E-03,&
+0.2088276E-03, 0.2075862E-03, 0.2063448E-03, 0.2051035E-03, 0.2038621E-03,&
+0.2026207E-03, 0.2013793E-03, 0.2001379E-03, 0.1988966E-03, 0.1976552E-03,&
+0.1964138E-03, 0.1951724E-03, 0.1939310E-03, 0.1926897E-03, 0.1914483E-03,&
+0.1902069E-03, 0.1889655E-03, 0.1877241E-03, 0.1864828E-03, 0.1852414E-03,&
+0.1840000E-03, 0.1827586E-03, 0.1815172E-03, 0.1802759E-03, 0.1790345E-03,&
+0.1777931E-03, 0.1765517E-03, 0.1753103E-03, 0.1740690E-03, 0.1728276E-03,&
+0.1715862E-03, 0.1703448E-03, 0.1691034E-03, 0.1678621E-03, 0.1666207E-03,&
+0.1653793E-03, 0.1641379E-03, 0.1628966E-03, 0.1616552E-03, 0.1604138E-03,&
+0.1591724E-03, 0.1579310E-03, 0.1566897E-03, 0.1554483E-03, 0.1542069E-03,&
+0.1529655E-03, 0.1517241E-03, 0.1504828E-03, 0.1492414E-03, 0.1480000E-03,&
+0.1467586E-03, 0.1455172E-03, 0.1442759E-03, 0.1430345E-03, 0.1417931E-03,&
+0.1405517E-03, 0.1393103E-03, 0.1380690E-03, 0.1368276E-03, 0.1355862E-03,&
+0.1343448E-03, 0.1331034E-03, 0.1318621E-03, 0.1306207E-03, 0.1293793E-03,&
+0.1281379E-03, 0.1268966E-03, 0.1256552E-03, 0.1244138E-03, 0.1231724E-03,&
+0.1219310E-03, 0.1206897E-03, 0.1194483E-03, 0.1182069E-03, 0.1169655E-03,&
+0.1157241E-03, 0.1144828E-03, 0.1132414E-03, 0.1120000E-03, 0.1107586E-03,&
+0.1095172E-03, 0.1082759E-03, 0.1070345E-03, 0.1057931E-03, 0.1045517E-03,&
+0.1033103E-03, 0.1020690E-03, 0.1008276E-03, 0.9958621E-04, 0.9834483E-04,&
+0.9710345E-04, 0.9586207E-04, 0.9462069E-04, 0.9337931E-04, 0.9213793E-04,&
+0.9089655E-04, 0.8965517E-04, 0.8841379E-04, 0.8717241E-04, 0.8593103E-04,&
+0.8468966E-04, 0.8344828E-04, 0.8220690E-04, 0.8096552E-04, 0.7972414E-04,&
+0.7848276E-04, 0.7724138E-04, 0.7600000E-04, 0.7475862E-04, 0.7351724E-04,&
+0.7227586E-04, 0.7103448E-04, 0.6979310E-04, 0.6855172E-04, 0.6731034E-04,&
+0.6606896E-04, 0.6482759E-04, 0.6358621E-04, 0.6234483E-04, 0.6110345E-04,&
+0.5986207E-04, 0.5862069E-04, 0.5737931E-04, 0.5613793E-04, 0.5489655E-04,&
+0.5365517E-04, 0.5241379E-04, 0.5117241E-04, 0.4993103E-04, 0.4868966E-04,&
+0.4744828E-04, 0.4620690E-04, 0.4496552E-04, 0.4372414E-04, 0.4248276E-04,&
+0.4124138E-04, 0.4000000E-04, 0.3875862E-04, 0.3751724E-04, 0.3627586E-04,&
+0.3503448E-04, 0.3379311E-04, 0.3255172E-04, 0.3131034E-04, 0.3006897E-04,&
+0.2882759E-04, 0.2758621E-04, 0.2634483E-04, 0.2510345E-04, 0.2386207E-04,&
+0.2262069E-04, 0.2137931E-04, 0.2013793E-04, 0.1889655E-04, 0.1765517E-04,&
+0.1641379E-04, 0.1517241E-04, 0.1393103E-04, 0.1268965E-04, 0.1144828E-04,&
+0.1020690E-04, 0.8965517E-05, 0.7724138E-05, 0.6482759E-05, 0.5241379E-05,&
+0.4000000E-05 /)
+
+! white-caps reflectance (Koepke and Whitlock)
+! Whitlock fit varid 400nm - 2.4nm. set albedo 0 otherwise 
+REAL, PARAMETER, DIMENSION(NNWL)::  XRWC   = &
+(/0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.1986623E+00, 0.1968392E+00, 0.1955961E+00, 0.1941208E+00, 0.1939980E+00,&
+0.1947642E+00, 0.1953830E+00, 0.1965826E+00, 0.1987437E+00, 0.2014820E+00,&
+0.2068586E+00, 0.2125197E+00, 0.2160829E+00, 0.2171109E+00, 0.2178881E+00,&
+0.2192886E+00, 0.2200949E+00, 0.2212391E+00, 0.2227055E+00, 0.2247944E+00,&
+0.2262073E+00, 0.2270383E+00, 0.2273185E+00, 0.2274869E+00, 0.2276210E+00,&
+0.2280129E+00, 0.2287211E+00, 0.2293381E+00, 0.2296089E+00, 0.2305354E+00,&
+0.2332379E+00, 0.2370188E+00, 0.2373674E+00, 0.2314480E+00, 0.2291741E+00,&
+0.2288465E+00, 0.2286684E+00, 0.2287614E+00, 0.2291967E+00, 0.2298426E+00,&
+0.2302154E+00, 0.2292666E+00, 0.2275362E+00, 0.2266957E+00, 0.2263213E+00,&
+0.2263353E+00, 0.2267580E+00, 0.2272800E+00, 0.2271755E+00, 0.2260595E+00,&
+0.2243821E+00, 0.2219912E+00, 0.2188027E+00, 0.2151597E+00, 0.2114653E+00,&
+0.2080255E+00, 0.2051811E+00, 0.2036894E+00, 0.2041120E+00, 0.2059829E+00,&
+0.2086015E+00, 0.2113106E+00, 0.2139111E+00, 0.2163195E+00, 0.2184435E+00,&
+0.2201926E+00, 0.2214916E+00, 0.2222242E+00, 0.2220343E+00, 0.2204943E+00,&
+0.2171906E+00, 0.2121093E+00, 0.2061633E+00, 0.2002262E+00, 0.1948388E+00,&
+0.1903174E+00, 0.1868275E+00, 0.1843590E+00, 0.1829052E+00, 0.1825115E+00,&
+0.1831341E+00, 0.1842591E+00, 0.1855570E+00, 0.1867604E+00, 0.1875755E+00,&
+0.1876960E+00, 0.1869431E+00, 0.1856059E+00, 0.1840741E+00, 0.1827001E+00,&
+0.1818000E+00, 0.1811922E+00, 0.1788437E+00, 0.1727826E+00, 0.1624180E+00,&
+0.1487052E+00, 0.1334511E+00, 0.1185638E+00, 0.1049801E+00, 0.9298412E-01,&
+0.8257660E-01, 0.7379698E-01, 0.6696978E-01, 0.6208307E-01, 0.5897739E-01,&
+0.5756657E-01, 0.5784728E-01, 0.5956322E-01, 0.6253327E-01, 0.6660015E-01,&
+0.7143353E-01, 0.7647427E-01, 0.8148541E-01, 0.8635699E-01, 0.9099500E-01,&
+0.9533520E-01, 0.9935633E-01, 0.1030906E+00, 0.1066306E+00, 0.1101345E+00,&
+0.1138333E+00, 0.1178890E+00, 0.1218228E+00, 0.1247853E+00, 0.1257652E+00,&
+0.1238772E+00, 0.1203841E+00, 0.1208343E+00, 0.1242444E+00, 0.1276640E+00,&
+0.1273930E+00, 0.1213602E+00, 0.1130860E+00, 0.1058152E+00, 0.1011666E+00,&
+0.1002071E+00, 0.1039381E+00, 0.1120040E+00, 0.1237937E+00, 0.1375058E+00,&
+0.1474928E+00, 0.1449352E+00, 0.1295643E+00, 0.1090889E+00, 0.8941860E-01,&
+0.7284467E-01, 0.5983944E-01, 0.5022947E-01, 0.4366299E-01, 0.3977196E-01,&
+0.3822227E-01, 0.3867308E-01, 0.4026759E-01, 0.4166813E-01, 0.4168444E-01,&
+0.4022229E-01, 0.3904642E-01, 0.3841435E-01, 0.3817649E-01, 0.3823472E-01,&
+0.3855810E-01, 0.3919018E-01, 0.4018588E-01, 0.4157600E-01, 0.4335490E-01,&
+0.4545942E-01, 0.4776782E-01, 0.5018748E-01, 0.5264894E-01, 0.5509888E-01,&
+0.5750712E-01, 0.5986086E-01, 0.6212466E-01, 0.6426051E-01, 0.6623940E-01,&
+0.6804333E-01, 0.6966664E-01, 0.7111643E-01, 0.7241227E-01, 0.7358521E-01,&
+0.7467659E-01, 0.7558735E-01, 0.7576417E-01, 0.7514564E-01, 0.7388073E-01,&
+0.7214532E-01, 0.7011285E-01, 0.6793264E-01, 0.6572567E-01, 0.6358425E-01,&
+0.6157472E-01, 0.5972482E-01, 0.5798797E-01, 0.5631501E-01, 0.5467161E-01,&
+0.5303634E-01, 0.5140076E-01, 0.4977145E-01, 0.4816243E-01, 0.4659231E-01,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,&
+0.0000000E+00 /)
+
+
+!
+!--------------------------------------------------------------------------------
+!
+END MODULE 
+
+
+
+
+
+
+
+
+
+
+
+
Index: LMDZ5/branches/testing/libf/phylmd/pbl_surface_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/pbl_surface_mod.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/pbl_surface_mod.F90	(revision 2258)
@@ -181,7 +181,13 @@
 !!!
        pplay,     paprs,     pctsrf,                  &
-       ts,        alb1, alb2,ustar, u10m, v10m,wstar, &
+!albedo SB >>>
+!       ts,        alb1, alb2,ustar, u10m, v10m,wstar, &
+       ts,SFRWL,   alb_dir, alb_dif,ustar, u10m, v10m,wstar, &
+!albedo SB <<<
        cdragh,    cdragm,   zu1,    zv1,              &
-       alb1_m,    alb2_m,    zxsens,   zxevap,        &
+!albedo SB >>>
+!       alb1_m,    alb2_m,    zxsens,   zxevap,        &
+       alb_dir_m,    alb_dif_m,  zxsens,   zxevap,    &
+!albedo SB <<<
        alb3_lic,  runoff,    snowhgt,   qsnow,     to_ice,    sissnow,  &
        zxtsol,    zxfluxlat, zt2m,     qsat2m,        &
@@ -349,6 +355,10 @@
     REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: delta_tsurf !surface temperature difference between
                                                                    !wake and off-wake regions
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: alb1    ! albedo in visible SW interval
-    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: alb2    ! albedo in near infra-red SW interval
+!albedo SB >>>
+!    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: alb1    ! albedo in visible SW interval
+!    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: alb2    ! albedo in near infra-red SW interval
+    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)
@@ -371,6 +381,11 @@
     REAL, DIMENSION(klon),        INTENT(OUT)       :: zu1        ! u wind speed in first layer
     REAL, DIMENSION(klon),        INTENT(OUT)       :: zv1        ! v wind speed in first layer
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: alb1_m     ! mean albedo in visible SW interval
-    REAL, DIMENSION(klon),        INTENT(OUT)       :: alb2_m     ! mean albedo in near IR SW interval
+!albedo SB >>>
+!    REAL, DIMENSION(klon),        INTENT(OUT)       :: alb1_m     ! mean albedo
+!    in visible SW interval
+!    REAL, DIMENSION(klon),        INTENT(OUT)       :: alb2_m     ! mean albedo
+!    in near IR SW interval
+    REAL, DIMENSION(klon, nsw),        INTENT(OUT)       :: alb_dir_m,alb_dif_m
+!albedo SB <<<
     ! Martin
     REAL, DIMENSION(klon),        INTENT(OUT)       :: alb3_lic
@@ -505,5 +520,8 @@
     REAL, DIMENSION(klon)              :: r_co2_ppm     ! taux CO2 atmosphere
     REAL, DIMENSION(klon)              :: yts, yrugos, ypct, yz0_new
-    REAL, DIMENSION(klon)              :: yalb, yalb1, yalb2
+!albedo SB >>>
+!   REAL, DIMENSION(klon)              :: yalb, yalb1, yalb2
+    REAL, DIMENSION(klon)              :: yalb,yalb_vis
+!albedo SB <<<
     REAL, DIMENSION(klon)              :: yu1, yv1
     REAL, DIMENSION(klon)              :: ysnow, yqsurf, yagesno, yqsol
@@ -535,5 +553,5 @@
     REAL, DIMENSION(klon)              :: tair1, qair1, tairsol
     REAL, DIMENSION(klon)              :: psfce, patm
-    REAL, DIMENSION(klon)              :: qairsol, zgeo1
+    REAL, DIMENSION(klon)              :: qairsol, zgeo1, speed, zri1, pref !speed, zri1, pref, added by Fuxing WANG, 04/03/2015
     REAL, DIMENSION(klon)              :: rugo1
     REAL, DIMENSION(klon)              :: yfluxsens
@@ -542,4 +560,7 @@
     REAL, DIMENSION(klon)              :: ypsref
     REAL, DIMENSION(klon)              :: yevap, ytsurf_new, yalb1_new, yalb2_new, yalb3_new
+!albedo SB >>>
+    REAL, DIMENSION(klon,nsw)          :: yalb_dir_new, yalb_dif_new
+!albedo SB <<<
     REAL, DIMENSION(klon)              :: ztsol
     REAL, DIMENSION(klon)              :: alb_m  ! mean albedo for whole SW interval
@@ -693,8 +714,8 @@
     REAL, DIMENSION(klon)       :: ytrmb3_w
 !
-    REAL, DIMENSION(klon)              :: uzon_x, vmer_x
+    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
+    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
 
@@ -855,5 +876,8 @@
  cdragh(:)=0. ; cdragm(:)=0.
  zu1(:)=0. ; zv1(:)=0.
- alb1_m(:)=0. ; alb2_m(:)=0. ; alb3_lic(:)=0.
+!albedo SB >>>
+! alb1_m(:)=0. ; alb2_m(:)=0. ; alb3_lic(:)=0.
+  alb_dir_m=0. ; alb_dif_m=0. ; alb3_lic(:)=0.
+!albedo SB <<<
  zxsens(:)=0. ; zxevap(:)=0. ; zxtsol(:)=0.
  d_t_w(:,:)=0. ; d_q_w(:,:)=0. ; d_t_x(:,:)=0. ; d_q_x(:,:)=0.
@@ -920,5 +944,8 @@
     ypct = 0.0    ; yts = 0.0        ; ysnow = 0.0
 !!    zv1 = 0.0     ; yqsurf = 0.0     ; yalb1 = 0.0     ; yalb2 = 0.0    
-    yqsurf = 0.0  ; yalb1 = 0.0      ; yalb2 = 0.0    
+!albedo SB >>>
+!    yqsurf = 0.0  ; yalb1 = 0.0      ; yalb2 = 0.0    
+    yqsurf = 0.0  ; yalb = 0.0 ; yalb_vis = 0.0
+!albedo SB <<<
     yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0    
     ysollw = 0.0  ; yrugos = 0.0     ; yu1 = 0.0    
@@ -1070,27 +1097,60 @@
 ! * alb_m  : mean albedo at whole SW interval
 
-    alb1_m(:) = 0.0
-    alb2_m(:) = 0.0
-    DO nsrf = 1, nbsrf
+!albedo SB >>>
+!    alb1_m(:) = 0.0
+!    alb2_m(:) = 0.0
+!    DO nsrf = 1, nbsrf
+!       DO i = 1, klon
+!          alb1_m(i) = alb1_m(i) + alb1(i,nsrf) * pctsrf(i,nsrf)
+!          alb2_m(i) = alb2_m(i) + alb2(i,nsrf) * pctsrf(i,nsrf)
+!       ENDDO
+!    ENDDO
+
+    alb_dir_m(:,:) = 0.0
+    alb_dif_m(:,:) = 0.0
+    DO k = 1, nsw
+     DO nsrf = 1, nbsrf
        DO i = 1, klon
-          alb1_m(i) = alb1_m(i) + alb1(i,nsrf) * pctsrf(i,nsrf)
-          alb2_m(i) = alb2_m(i) + alb2(i,nsrf) * pctsrf(i,nsrf)
+          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 = 0.5
 !    f1 = 1    ! put f1=1 to recreate old calculations
 
-    DO nsrf = 1, nbsrf
-       DO i = 1, klon
-          alb(i,nsrf) = f1*alb1(i,nsrf) + (1-f1)*alb2(i,nsrf)
-       ENDDO
+!    DO nsrf = 1, nbsrf
+!       DO i = 1, klon
+!          alb(i,nsrf) = f1*alb1(i,nsrf) + (1-f1)*alb2(i,nsrf)
+!       ENDDO
+!    ENDDO
+!
+!    DO i = 1, klon
+!       alb_m(i) = f1*alb1_m(i) + (1-f1)*alb2_m(i)
+!    END DO
+
+
+!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
 
-    DO i = 1, klon
-       alb_m(i) = f1*alb1_m(i) + (1-f1)*alb2_m(i)
-    END DO
+    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)
+      END DO
+    ENDDO
+!albedo SB <<<
+
+
 
 ! Calculation of mean temperature at surface grid points
@@ -1170,6 +1230,13 @@
           yqsurf(j)  = qsurf(i,nsrf)
           yalb(j)    = alb(i,nsrf)
-          yalb1(j)   = alb1(i,nsrf)
-          yalb2(j)   = alb2(i,nsrf)
+!albedo SB >>>
+!         yalb1(j)   = alb1(i,nsrf)
+!         yalb2(j)   = alb2(i,nsrf)
+          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)
@@ -1295,8 +1362,22 @@
 !!!
 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012
-        CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
-            yu(:,1), yv(:,1), yt(:,1), yq(:,1), &
+! 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)
+        END DO
+        CALL cdrag(knon, nsrf, &
+            speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1),&
             yts, yqsurf, yrugos, &
-            ycdragm, ycdragh )
+            ycdragm, ycdragh, zri1, pref )
+
 ! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
      IF (ok_prescr_ust) then
@@ -1313,8 +1394,21 @@
         IF (prt_level >=10) print *,'clcdrag -> ycdragh ', ycdragh
        ELSE  !(iflag_split .eq.0)
-        CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
-            yu_x(:,1), yv_x(:,1), yt_x(:,1), yq_x(:,1), &
+
+! 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)
+        END DO
+        CALL cdrag(knon, nsrf, &
+            speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),&
             yts_x, yqsurf, yrugos, &
-            ycdragm_x, ycdragh_x )
+            ycdragm_x, ycdragh_x, zri1_x, pref_x )
+
 ! --- special Dice. JYG+MPL 25112013
         IF (ok_prescr_ust) then
@@ -1710,5 +1804,8 @@
                ylwdown, yq2m, yt2m, &
                ysnow, yqsol, yagesno, ytsoil, &
-               yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
+!albedo SB >>>
+!              yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
+               yz0_new, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
+!albedo SB <<<
                yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
                y_flux_u1, y_flux_v1 )
@@ -1746,5 +1843,8 @@
                ypsref, yu1, yv1, yrugoro, pctsrf, &
                ysnow, yqsurf, yqsol, yagesno, &
-               ytsoil, yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
+!albedo SB >>>
+!              ytsoil, yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
+               ytsoil, yz0_new, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
+!albedo SB <<<
                ytsurf_new, y_dflux_t, y_dflux_q, &
                yzsig, ycldt, &
@@ -1778,5 +1878,8 @@
           
        CASE(is_oce)
-          CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb1, &
+!albedo SB >>>
+!          CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb1, &
+           CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb_vis, &
+!albedo SB <<<
                yrugos, ywindsp, rmu0, yfder, yts, &
                itap, dtime, jour, knon, ni, &
@@ -1786,5 +1889,8 @@
                ypsref, yu1, yv1, yrugoro, pctsrf, &
                ysnow, yqsurf, yagesno, &
-               yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
+!albedo SB >>>
+!              yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
+               yz0_new, SFRWL,yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat,&
+!albedo SB <<<
                ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, &
                y_flux_u1, y_flux_v1)
@@ -1807,5 +1913,8 @@
        CASE(is_sic)
           CALL surf_seaice( &
-               rlon, rlat, ysolsw, ysollw, yalb1, yfder, &
+!albedo SB >>>
+!               rlon, rlat, ysolsw, ysollw, yalb1, yfder, &
+               rlon, rlat, ysolsw, ysollw, yalb_vis, yfder, &
+!albedo SB <<<
                itap, dtime, jour, knon, ni, &
                lafin, &
@@ -1815,5 +1924,8 @@
                ypsref, yu1, yv1, yrugoro, pctsrf, &
                ysnow, yqsurf, yqsol, yagesno, ytsoil, &
-               yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
+!albedo SB >>>
+!               yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
+               yz0_new, 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)
@@ -2185,6 +2297,12 @@
           evap(i,nsrf) = - flux_q(i,1,nsrf)                  !jyg
           d_ts(i,nsrf) = y_d_ts(j)
-          alb1(i,nsrf) = yalb1_new(j)  
-          alb2(i,nsrf) = yalb2_new(j)
+!albedo SB >>>
+!          alb1(i,nsrf) = yalb1_new(j)  
+!          alb2(i,nsrf) = yalb2_new(j)
+          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)
@@ -2930,6 +3048,9 @@
 !****************************************************************************************
 ! 
-  SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, tsurf, alb1, alb2, ustar, u10m, v10m, tke)
-
+
+!albedo SB >>>
+!  SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, tsurf, alb1, alb2, ustar, u10m, v10m, tke)
+SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke)  
+!albedo SB <<<
     ! Give default values where new fraction has appread
 
@@ -2948,5 +3069,9 @@
 !****************************************************************************************
     REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: tsurf
-    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: alb1, alb2
+!albedo SB >>>
+!   REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: alb1, alb2
+    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,klev+1,nbsrf+1), INTENT(INOUT) :: tke
@@ -2993,6 +3118,12 @@
                 rugos(i,nsrf) = rugos(i,nsrf_comp1)
                 tsurf(i,nsrf) = tsurf(i,nsrf_comp1)
-                alb1(i,nsrf)  = alb1(i,nsrf_comp1)
-                alb2(i,nsrf)  = alb2(i,nsrf_comp1)
+!albedo SB >>>
+!                alb1(i,nsrf)  = alb1(i,nsrf_comp1)
+!                alb2(i,nsrf)  = alb2(i,nsrf_comp1)
+                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)
@@ -3008,6 +3139,14 @@
                 rugos(i,nsrf) = rugos(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + rugos(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)
-                alb1(i,nsrf)  = alb1(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + alb1(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
-                alb2(i,nsrf)  = alb2(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + alb2(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
+!albedo SB >>>
+!                alb1(i,nsrf)  = alb1(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + alb1(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
+!                alb2(i,nsrf)  = alb2(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + alb2(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
+                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)
Index: LMDZ5/branches/testing/libf/phylmd/phyetat0.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/phyetat0.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/phyetat0.F90	(revision 2258)
@@ -11,4 +11,5 @@
   USE phys_state_var_mod, ONLY : ancien_ok, clwcon, detr_therm, dtime, &
        du_gwd_rando, dv_gwd_rando, entr_therm, f0, falb1, falb2, fm_therm, &
+       falb_dir, falb_dif, &
        ftsol, pbl_tke, pctsrf, q_ancien, radpas, radsol, rain_fall, ratqs, &
        rlat, rlon, rnebcon, rugoro, sig1, snow_fall, solaire_etat0, sollw, sollwdown, &
@@ -69,5 +70,5 @@
   INTEGER length
   PARAMETER (length=100)
-  INTEGER it, iiq
+  INTEGER it, iiq, isw
   REAL tab_cntrl(length), tabcntr0(length)
   CHARACTER*7 str7
@@ -243,4 +244,35 @@
   ENDIF
 
+!===================================================================
+  ! Lecture des albedo difus et direct
+
+  DO nsrf = 1, nbsrf
+     DO isw=1, nsw
+        IF (isw.GT.99 .AND. nsrf.GT.99) THEN
+           PRINT*, "Trop de bandes SW ou sous-mailles"
+           call abort_gcm("phyetat0", "", 1)
+        ENDIF
+        WRITE(str7, '(i2.2, "srf", i2.2)') isw, nsrf
+
+        CALL get_field('A_dir_SW'//str7, falb_dir(:, isw, nsrf), found)
+        IF (.NOT. found) THEN
+           PRINT*, "phyetat0: Le champ <A_dir_SW"//str7//"> est absent"
+           PRINT*, "          Il prend donc la valeur de surface"
+           DO i=1, klon
+              falb_dir(i, isw, nsrf)=0.2
+           ENDDO
+        ENDIF
+        CALL get_field('A_dif_SW'//str7, falb_dif(:, isw, nsrf), found)
+        IF (.NOT. found) THEN
+           PRINT*, "phyetat0: Le champ <A_dif_SW"//str7//"> est absent"
+           PRINT*, "          Il prend donc la valeur de surface"
+           DO i=1, klon
+              falb_dif(i, isw, nsrf)=0.2
+           ENDDO
+        ENDIF
+     ENDDO
+  ENDDO
+
+!===================================================================
   ! Lecture des temperatures du sol profond:
 
@@ -264,4 +296,5 @@
   ENDDO
 
+!===================================================================
   ! Lecture de l'humidite de l'air juste au dessus du sol:
 
Index: LMDZ5/branches/testing/libf/phylmd/phyredem.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/phyredem.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/phyredem.F90	(revision 2258)
@@ -51,5 +51,5 @@
   REAL tab_cntrl(length)
 
-  INTEGER isoil, nsrf
+  INTEGER isoil, nsrf,isw
   CHARACTER (len=7) :: str7
   CHARACTER (len=2) :: str2
@@ -142,4 +142,23 @@
   ENDDO
 
+! ================== Albedo =======================================
+  print*,'PHYREDEM NOUVEAU'
+  DO nsrf = 1, nbsrf
+     DO isw=1, nsw
+        IF (isw.LE.99 .AND. nsrf.LE.99) THEN
+           WRITE(str7, '(i2.2, "srf", i2.2)') isw, nsrf
+  print*,'PHYREDEM ',"A_dir_SW"//str7
+           CALL put_field("A_dir_SW"//str7, "Albedo direct du sol bande "//str7, &
+                falb_dir(:, isw, nsrf))
+           CALL put_field("A_dif_SW"//str7, "Albedo difus du sol bande "//str7, &
+                falb_dif(:, isw, nsrf))
+        ELSE
+           PRINT*, "Trop de couches"
+           call abort_gcm("phyredem", "", 1)
+        ENDIF
+     ENDDO
+  ENDDO
+
+! ================== Tsoil =======================================
   DO nsrf = 1, nbsrf
      DO isoil=1, nsoilmx
Index: LMDZ5/branches/testing/libf/phylmd/phys_state_var_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/phys_state_var_mod.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/phys_state_var_mod.F90	(revision 2258)
@@ -30,4 +30,12 @@
       REAL, ALLOCATABLE, SAVE :: falb1(:,:), falb2(:,:)
 !$OMP THREADPRIVATE(falb1, falb2)
+
+!albedo SB >>>
+      REAL, ALLOCATABLE, SAVE :: falb_dif(:,:,:), falb_dir(:,:,:)
+      real, allocatable, save :: chl_con(:)
+!$OMP THREADPRIVATE(falb_dir,falb_dif,chl_con)
+!albedo SB <<<
+
+
       REAL, ALLOCATABLE, SAVE :: rain_fall(:), snow_fall(:)
 !$OMP THREADPRIVATE( rain_fall, snow_fall)
@@ -261,4 +269,10 @@
 !$OMP THREADPRIVATE(albsol1,albsol2)
 
+!albedo SB >>>
+      REAL,ALLOCATABLE,SAVE :: albsol_dif(:,:),albsol_dir(:,:)
+!$OMP THREADPRIVATE(albsol_dif,albsol_dir)
+!albedo SB <<<
+
+
       REAL, ALLOCATABLE, SAVE:: wo(:, :, :)
       ! column-density of ozone in a layer, in kilo-Dobsons
@@ -404,4 +418,8 @@
       ALLOCATE(falb1(klon,nbsrf))
       ALLOCATE(falb2(klon,nbsrf))
+!albedo SB >>> 
+      ALLOCATE(falb_dir(klon,nsw,nbsrf),falb_dif(klon,nsw,nbsrf))
+      ALLOCATE(chl_con(klon))
+!albedo SB <<<
       ALLOCATE(rain_fall(klon))
       ALLOCATE(snow_fall(klon))
@@ -501,4 +519,7 @@
       ALLOCATE(paire_ter(klon))
       ALLOCATE(albsol1(klon), albsol2(klon))
+!albedo SB >>>
+      ALLOCATE(albsol_dir(klon,nsw),albsol_dif(klon,nsw))
+!albedo SB <<<
 
       if (read_climoz <= 1) then
@@ -634,4 +655,7 @@
       deallocate(paire_ter)
       deallocate(albsol1, albsol2)
+!albedo SB >>>
+      deallocate(albsol_dir,albsol_dif,falb_dir,falb_dif,chl_con)
+!albedo SB <<<
       deallocate(wo)
       deallocate(clwcon0,rnebcon0)
Index: LMDZ5/branches/testing/libf/phylmd/physiq.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/physiq.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/physiq.F90	(revision 2258)
@@ -4,5 +4,5 @@
 SUBROUTINE physiq (nlon,nlev, &
      debut,lafin,jD_cur, jH_cur,pdtphys, &
-     paprs,pplay,pphi,pphis,presnivs,clesphy0, &
+     paprs,pplay,pphi,pphis,presnivs, &
      u,v,t,qx, &
      flxmass_w, &
@@ -283,7 +283,7 @@
   !$OMP THREADPRIVATE(ok_hf)
 
-  INTEGER        longcles
-  PARAMETER    ( longcles = 20 )
-  REAL clesphy0( longcles      )
+  INTEGER,PARAMETER :: longcles=20
+  REAL,SAVE :: clesphy0(longcles)
+  !$OMP THREADPRIVATE(clesphy0)
   !
   ! Variables propres a la physique
@@ -291,4 +291,7 @@
   SAVE itap                   ! compteur pour la physique
   !$OMP THREADPRIVATE(itap)
+
+  INTEGER, SAVE :: abortphy=0   ! Reprere si on doit arreter en fin de phys
+  !$OMP THREADPRIVATE(abortphy)
   !
   REAL,save ::  solarlong0
@@ -636,7 +639,7 @@
   !$OMP THREADPRIVATE(fact_cldcon,facttemps)
 
-  integer iflag_cldth
-  save iflag_cldth
-  !$OMP THREADPRIVATE(iflag_cldth)
+  integer iflag_cld_th
+  save iflag_cld_th
+  !$OMP THREADPRIVATE(iflag_cld_th)
   logical ptconv(klon,klev)
   !IM cf. AM 081204 BEG
@@ -865,4 +868,7 @@
 
   REAL zzz
+!albedo SB >>>
+  real,dimension(6),save :: SFRWL
+!albedo SB <<<
 
   !======================================================================
@@ -913,5 +919,5 @@
           solarlong0,seuil_inversion, &
           fact_cldcon, facttemps,ok_newmicro,iflag_radia, &
-          iflag_cldth,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
+          iflag_cld_th,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
           ok_ade, ok_aie, ok_cdnc, aerosol_couple,  &
           flag_aerosol, flag_aerosol_strat, new_aod, &
@@ -924,4 +930,11 @@
      print*, '================================================='
      !
+!CR: check sur le nb de traceurs de l eau
+     if ((iflag_ice_thermo.gt.0).and.(nqo==2)) then
+          WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers (H2Ov, H2Ol, H2Oi)', ' but nqo=', nqo, &
+          '. Might as well stop here.'
+          STOP
+     endif
+
      dnwd0=0.0
      ftd=0.0
@@ -1014,6 +1027,6 @@
      print*,'CYCLE_DIURNE', cycle_diurne
      !
-     IF (iflag_con.EQ.2.AND.iflag_cldth.GT.-1) THEN
-        abort_message = 'Tiedtke needs iflag_cldth=-2 or -1'
+     IF (iflag_con.EQ.2.AND.iflag_cld_th.GT.-1) THEN
+        abort_message = 'Tiedtke needs iflag_cld_th=-2 or -1'
         CALL abort_gcm (modname,abort_message,1)
      ENDIF
@@ -1130,5 +1143,5 @@
                 ,alp_bl_prescr, ale_bl_prescr)
            ! 11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU)
-           !        print*,'apres ini_wake iflag_cldth=', iflag_cldth
+           !        print*,'apres ini_wake iflag_cld_th=', iflag_cld_th
         endif
 
@@ -1342,4 +1355,26 @@
      mskocean_beta=.FALSE.
 
+!albedo SB >>>
+     select case(nsw)
+     case(2)
+     SFRWL(1)=0.45538747
+     SFRWL(2)=0.54461211
+     case(4)
+     SFRWL(1)=0.45538747
+     SFRWL(2)=0.32870591
+     SFRWL(3)=0.18568763
+     SFRWL(4)=3.02191470E-02
+     case(6)
+     SFRWL(1)=1.28432794E-03
+     SFRWL(2)=0.12304168
+     SFRWL(3)=0.33106142
+     SFRWL(4)=0.32870591
+     SFRWL(5)=0.18568763
+     SFRWL(6)=3.02191470E-02
+     end select
+
+
+!albedo SB <<<
+
      OPEN(99,file='beta_crf.data',status='old', &
           form='formatted',err=9999)
@@ -1378,6 +1413,8 @@
   !
   CALL change_srf_frac(itap, dtime, days_elapsed+1,  &
-       pctsrf, falb1, falb2, ftsol, ustar, u10m, v10m, pbl_tke)
-
+!albedo SB >>>
+!       pctsrf, falb1, falb2, ftsol, ustar, u10m, v10m, pbl_tke)
+       pctsrf, falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke)
+!albedo SB <<<
 
   ! Update time and other variables in Reprobus
@@ -1569,5 +1606,7 @@
   !IM END
   !
-  CALL hgardfou(t_seri,ftsol,'debutphy')
+  CALL hgardfou(t_seri,ftsol,'debutphy',abortphy)
+  IF (abortphy==1) Print*,'ERROR ABORT hgardfou debutphy'
+
   !
   !IM BEG
@@ -1813,7 +1852,13 @@
 !>nrlmd+jyg
           pplay,     paprs,     pctsrf,             &
-          ftsol,falb1,falb2,ustar,u10m,v10m,wstar,  &
+!albedo SB >>>
+!          ftsol,falb1,falb2,ustar,u10m,v10m,wstar,  &
+          ftsol,SFRWL,falb_dir,falb_dif,ustar,u10m,v10m,wstar, &
+!albedo SB <<<
           cdragh,    cdragm,  u1,    v1,            &
-          albsol1,   albsol2,   sens,    evap,      &
+!albedo SB >>>
+!          albsol1,   albsol2,   sens,    evap,      &
+          albsol_dir,   albsol_dif,   sens,    evap,   &  
+!albedo SB <<<
           albsol3_lic,runoff,   snowhgt,   qsnow, to_ice, sissnow, &
           zxtsol,    zxfluxlat, zt2m,    qsat2m,  &
@@ -1868,8 +1913,8 @@
      IF (klon_glo==1) THEN
         CALL add_pbl_tend &
-             (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,'vdf')
+        (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,'vdf',abortphy)
      ELSE
         CALL add_phys_tend &
-             (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,'vdf')
+        (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,'vdf',abortphy)
      ENDIF
      !--------------------------------------------------------------------
@@ -1881,4 +1926,36 @@
         call writefield_phy('q_seri',q_seri,llm)
      endif
+
+
+!albedo SB >>>
+ albsol1=0.
+ albsol2=0.
+ falb1=0.
+ falb2=0.
+select case(nsw)
+case(2)
+ albsol1=albsol_dir(:,1)
+ albsol2=albsol_dir(:,2)
+ falb1=falb_dir(:,1,:)
+ falb2=falb_dir(:,2,:)
+case(4)
+ albsol1=albsol_dir(:,1)
+ albsol2=albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3)+albsol_dir(:,4)*SFRWL(4)
+ albsol2=albsol2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
+ falb1=falb_dir(:,1,:)
+ falb2=falb_dir(:,2,:)*SFRWL(2)+falb_dir(:,3,:)*SFRWL(3)+falb_dir(:,4,:)*SFRWL(4)
+ falb2=falb2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
+case(6)
+ albsol1=albsol_dir(:,1)*SFRWL(1)+albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3)
+ albsol1=albsol1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
+ albsol2=albsol_dir(:,4)*SFRWL(4)+albsol_dir(:,5)*SFRWL(5)+albsol_dir(:,6)*SFRWL(6)
+ albsol2=albsol2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
+ falb1=falb_dir(:,1,:)*SFRWL(1)+falb_dir(:,2,:)*SFRWL(2)+falb_dir(:,3,:)*SFRWL(3)
+ falb1=falb1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
+ falb2=falb_dir(:,4,:)*SFRWL(4)+falb_dir(:,5,:)*SFRWL(5)+falb_dir(:,6,:)*SFRWL(6)
+ falb2=falb2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
+end select
+!albedo SB <<<
+
 
      CALL evappot(klon,nbsrf,ftsol,pplay(:,1),cdragh, &
@@ -2221,5 +2298,5 @@
      !   calcul des proprietes des nuages convectifs
      clwcon0(:,:)=fact_cldcon*clwcon0(:,:)
-     IF (iflag_cld_cv <= 1) THEN
+     IF (iflag_cld_cv == 0) THEN
      call clouds_gno &
           (klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0)
@@ -2273,5 +2350,6 @@
 
   CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, paprs, &
-       'convection')
+       'convection',abortphy)
+
   !----------------------------------------------------------------------------
 
@@ -2442,5 +2520,5 @@
      d_t_wake(:,:)=dt_wake(:,:)*dtime
      d_q_wake(:,:)=dq_wake(:,:)*dtime
-     CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,paprs,'wake')
+     CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,paprs,'wake',abortphy)
      !------------------------------------------------------------------------
 
@@ -2461,5 +2539,5 @@
   END IF
 
-  !      print*,'apres callwake iflag_cldth=', iflag_cldth
+  !      print*,'apres callwake iflag_cld_th=', iflag_cld_th
   !
   !===================================================================
@@ -2753,5 +2831,5 @@
         !-----------------------------------------------------------------------
         ! ajout des tendances de l'ajustement sec ou des thermiques
-        CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,paprs,'ajsb')
+        CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,paprs,'ajsb',abortphy)
         d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_ajsb(:,:)
         d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_ajsb(:,:)
@@ -2782,5 +2860,5 @@
   ! water distribution
   CALL  calcratqs(klon,klev,prt_level,lunout,        &
-       iflag_ratqs,iflag_con,iflag_cldth,pdtphys,  &
+       iflag_ratqs,iflag_con,iflag_cld_th,pdtphys,  &
        ratqsbas,ratqshaut,tau_ratqs,fact_cldcon,   &
        ptconv,ptconvth,clwcon0th, rnebcon0th,     &
@@ -2804,5 +2882,5 @@
        frac_impa, frac_nucl, beta_prec_fisrt, &
        prfl, psfl, rhcl,  &
-       zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cldth, &
+       zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
        iflag_ice_thermo)
   !
@@ -2810,5 +2888,5 @@
   WHERE (snow_lsc < 0) snow_lsc = 0.
 
-  CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,paprs,'lsc')
+  CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,paprs,'lsc',abortphy)
   !---------------------------------------------------------------------------
   DO k = 1, klev
@@ -2860,10 +2938,10 @@
   !
   !IM cf FH
-  !     IF (iflag_cldth.eq.-1) THEN ! seulement pour Tiedtke
-  IF (iflag_cldth.le.-1) THEN ! seulement pour Tiedtke
+  !     IF (iflag_cld_th.eq.-1) THEN ! seulement pour Tiedtke
+  IF (iflag_cld_th.le.-1) THEN ! seulement pour Tiedtke
      snow_tiedtke=0.
      !     print*,'avant calcul de la pseudo precip '
-     !     print*,'iflag_cldth',iflag_cldth
-     if (iflag_cldth.eq.-1) then
+     !     print*,'iflag_cld_th',iflag_cld_th
+     if (iflag_cld_th.eq.-1) then
         rain_tiedtke=rain_con
      else
@@ -2898,5 +2976,5 @@
      ENDDO
 
-  ELSE IF (iflag_cldth.ge.3) THEN
+  ELSE IF (iflag_cld_th.ge.3) THEN
      !  On prend pour les nuages convectifs le max du calcul de la
      !  convection et du calcul du pas de temps precedent diminue d'un facteur
@@ -2954,11 +3032,12 @@
         tausum_aero(:,:,:) = 0.
         IF (iflag_rrtm .EQ. 0) THEN !--old radiation
-           tau_aero(:,:,:,:) = 0.
-           piz_aero(:,:,:,:) = 0.
+           tau_aero(:,:,:,:) = 1.e-15
+           piz_aero(:,:,:,:) = 1.
            cg_aero(:,:,:,:)  = 0.
         ELSE
-           tau_aero_sw_rrtm(:,:,:,:)=0.0
-           piz_aero_sw_rrtm(:,:,:,:)=0.0
-           cg_aero_sw_rrtm(:,:,:,:)=0.0
+           tau_aero_sw_rrtm(:,:,:,:) = 1.e-15
+           tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
+           piz_aero_sw_rrtm(:,:,:,:) = 1.0
+           cg_aero_sw_rrtm(:,:,:,:)  = 0.0
         ENDIF
      ENDIF
@@ -2987,5 +3066,5 @@
      !   On prend la somme des fractions nuageuses et des contenus en eau
 
-     if (iflag_cldth>=5) then
+     if (iflag_cld_th>=5) then
 
         do k=1,klev
@@ -3293,14 +3372,26 @@
   IF (MOD(itaprad,radpas).EQ.0) THEN
 
-     DO i = 1, klon
-        albsol1(i) = falb1(i,is_oce) * pctsrf(i,is_oce) &
-             + falb1(i,is_lic) * pctsrf(i,is_lic) &
-             + falb1(i,is_ter) * pctsrf(i,is_ter) &
-             + falb1(i,is_sic) * pctsrf(i,is_sic)
-        albsol2(i) = falb2(i,is_oce) * pctsrf(i,is_oce) &
-             + falb2(i,is_lic) * pctsrf(i,is_lic) &
-             + falb2(i,is_ter) * pctsrf(i,is_ter) &
-             + falb2(i,is_sic) * pctsrf(i,is_sic)
-     ENDDO
+!albedo SB >>>  
+  if(ok_chlorophyll)then
+  print*,"-- reading chlorophyll"
+  call readchlorophyll(debut)
+  endif
+  !do i=1,klon
+  !if(chl_con(i)>1.) print*,i,chl_con(i),pctsrf(i,is_ter)
+  !enddo
+!albedo SB <<<
+
+!albedo SB >>>
+!     DO i = 1, klon
+!        albsol1(i) = falb1(i,is_oce) * pctsrf(i,is_oce) &
+!             + falb1(i,is_lic) * pctsrf(i,is_lic) &
+!             + falb1(i,is_ter) * pctsrf(i,is_ter) &
+!             + falb1(i,is_sic) * pctsrf(i,is_sic)
+!        albsol2(i) = falb2(i,is_oce) * pctsrf(i,is_oce) &
+!             + falb2(i,is_lic) * pctsrf(i,is_lic) &
+!             + falb2(i,is_ter) * pctsrf(i,is_ter) &
+!             + falb2(i,is_sic) * pctsrf(i,is_sic)
+!     ENDDO
+!albedo SB <<<
 
      if (mydebug) then
@@ -3350,5 +3441,8 @@
         CALL radlwsw &
              (dist, rmu0, fract,  &
-             paprs, pplay,zxtsol,albsol1, albsol2,  &
+!albedo SB >>>
+!             paprs, pplay,zxtsol,albsol1, albsol2,  &
+             paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif,  &
+!albedo SB <<<
              t_seri,q_seri,wo, &
              cldfrarad, cldemirad, cldtaurad, &
@@ -3403,5 +3497,8 @@
               CALL radlwsw &
                    (dist, rmu0, fract,  &
-                   paprs, pplay,zxtsol,albsol1, albsol2,  &
+!albedo SB >>>
+!                   paprs, pplay,zxtsol,albsol1, albsol2,  &
+                   paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, & 
+!albedo SB <<<
                    t_seri,q_seri,wo, &
                    cldfra, cldemi, cldtau, &
@@ -3470,6 +3567,6 @@
   d_t_sw0(:,:)=heat0(:,:)*dtime/RDAY
   d_t_lw0(:,:)=-cool0(:,:)*dtime/RDAY
-  CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,paprs,'SW')
-  CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,paprs,'LW')
+  CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,paprs,'SW',abortphy)
+  CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,paprs,'LW',abortphy)
 
   !
@@ -3554,5 +3651,5 @@
      !-----------------------------------------------------------------------------------------
      ! ajout des tendances de la trainee de l'orographie
-     CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,paprs,'oro')
+     CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,paprs,'oro',abortphy)
      !-----------------------------------------------------------------------------------------
      !
@@ -3600,5 +3697,5 @@
      !-----------------------------------------------------------------------------------------
      ! ajout des tendances de la portance de l'orographie
-     CALL add_phys_tend(d_u_lif,d_v_lif,d_t_lif,dq0,dql0,dqi0,paprs,'lif')
+     CALL add_phys_tend(d_u_lif,d_v_lif,d_t_lif,dq0,dql0,dqi0,paprs,'lif',abortphy)
      !-----------------------------------------------------------------------------------------
      !
@@ -3614,5 +3711,5 @@
      !
      !  ajout des tendances
-     CALL add_phys_tend(d_u_hin,d_v_hin,d_t_hin,dq0,dql0,dqi0,paprs,'hin')
+     CALL add_phys_tend(d_u_hin,d_v_hin,d_t_hin,dq0,dql0,dqi0,paprs,'hin',abortphy)
 
   ENDIF
@@ -3623,5 +3720,5 @@
           du_gwd_rando, dv_gwd_rando)
      CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0,dqi0,paprs, &
-          'flott_gwd_rando')
+          'flott_gwd_rando',abortphy)
   end if
 
@@ -3677,5 +3774,5 @@
      CALL METHOX(1,klon,klon,klev,q_seri,d_q_ch4,pplay)
   ! ajout de la tendance d'humidite due au methane
-     CALL add_phys_tend(du0,dv0,dt0,d_q_ch4*dtime,dql0,'q_ch4')
+     CALL add_phys_tend(du0,dv0,dt0,d_q_ch4*dtime,dql0,'q_ch4',abortphy)
   END IF
   !
@@ -4058,5 +4155,5 @@
   !On effectue les sorties:
 
-  CALL phys_output_write(itap, pdtphys, paprs, pphis,               &
+  CALL phys_output_write(itap, pdtphys, paprs, pphis,  &
        pplay, lmax_th, aerosol_couple,                 &
        ok_ade, ok_aie, ivap, new_aod, ok_sync,         &
@@ -4067,5 +4164,4 @@
 
 
-
   include "write_histday_seri.h"
 
@@ -4073,4 +4169,16 @@
 
 #endif
+
+
+!====================================================================
+! Arret du modele apres hgardfou en cas de detection d'un
+! plantage par hgardfou
+!====================================================================
+
+    IF (abortphy==1) THEN
+       abort_message ='Plantage hgardfou'
+       CALL abort_gcm (modname,abort_message,1)
+    ENDIF
+
 
   ! 22.03.04 END
Index: LMDZ5/branches/testing/libf/phylmd/radlwsw_m.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/radlwsw_m.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/radlwsw_m.F90	(revision 2258)
@@ -10,5 +10,8 @@
 SUBROUTINE radlwsw( &
    dist, rmu0, fract, &
-   paprs, pplay,tsol,alb1, alb2, &
+!albedo SB >>>
+!  paprs, pplay,tsol,alb1, alb2, &
+   paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, &
+!albedo SB <<<
    t,q,wo,&
    cldfra, cldemi, cldtaupd,&
@@ -174,5 +177,10 @@
   REAL,    INTENT(in)  :: rmu0(KLON), fract(KLON)
   REAL,    INTENT(in)  :: paprs(KLON,KLEV+1), pplay(KLON,KLEV)
-  REAL,    INTENT(in)  :: alb1(KLON), alb2(KLON), tsol(KLON)
+!albedo SB >>>
+! REAL,    INTENT(in)  :: alb1(KLON), alb2(KLON), tsol(KLON)
+  REAL,    INTENT(in)  :: tsol(KLON)
+  REAL,    INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW)
+  real, intent(in) :: SFRWL(6)
+!albedo SB <<<
   REAL,    INTENT(in)  :: t(KLON,KLEV), q(KLON,KLEV)
 
@@ -418,18 +426,58 @@
 !     zfract(i) = 1.     !!!!!!  essai MPL 19052010
       zrmu0(i) = rmu0(iof+i)
-      PALBD(i,1) = alb1(iof+i)
-      PALBD(i,2) = alb2(iof+i)
-!
-         PALBD_NEW(i,1) = alb1(iof+i)   !!!!! A REVOIR (MPL) PALBD_NEW en fonction bdes SW
-         do kk=2,NSW
-           PALBD_NEW(i,kk) = alb2(iof+i)
-         enddo
-      PALBP(i,1) = alb1(iof+i)
-      PALBP(i,2) = alb2(iof+i)
-!
-         PALBP_NEW(i,1) = alb1(iof+i)     !!!!! A REVOIR (MPL) PALBP_NEW en fonction bdes SW
-         do kk=2,NSW
-           PALBP_NEW(i,kk) = alb2(iof+i)
-         enddo
+
+
+!albedo SB >>>
+!      PALBD(i,1) = alb1(iof+i)
+!      PALBD(i,2) = alb2(iof+i)
+!         PALBD_NEW(i,1) = alb1(iof+i)   !!!!! A REVOIR (MPL) PALBD_NEW en
+!         fonction bdes SW
+!         do kk=2,NSW
+!           PALBD_NEW(i,kk) = alb2(iof+i)
+!         enddo
+!      PALBP(i,1) = alb1(iof+i)
+!      PALBP(i,2) = alb2(iof+i)
+!
+!         PALBP_NEW(i,1) = alb1(iof+i)     !!!!! A REVOIR (MPL) PALBP_NEW en
+!         fonction bdes SW
+!         do kk=2,NSW
+!           PALBP_NEW(i,kk) = alb2(iof+i)
+!         enddo
+
+      if(iflag_rrtm==0)then
+        select case(nsw)
+        case(2)
+          PALBD(i,1)=alb_dif(iof+i,1)
+          PALBD(i,2)=alb_dif(iof+i,2)
+          PALBP(i,1)=alb_dir(iof+i,1)
+          PALBP(i,2)=alb_dir(iof+i,2)
+        case(4)
+          PALBD(i,1)=alb_dif(iof+i,1)
+          PALBD(i,2)=(alb_dif(iof+i,2)*SFRWL(2)+alb_dif(iof+i,3)*SFRWL(3) &
+                 +alb_dif(iof+i,4)*SFRWL(4))/(SFRWL(2)+SFRWL(3)+SFRWL(4))
+          PALBP(i,1)=alb_dir(iof+i,1)
+          PALBP(i,2)=(alb_dir(iof+i,2)*SFRWL(2)+alb_dir(iof+i,3)*SFRWL(3) &
+                 +alb_dir(iof+i,4)*SFRWL(4))/(SFRWL(2)+SFRWL(3)+SFRWL(4))
+        case(6)
+          PALBD(i,1)=(alb_dif(iof+i,1)*SFRWL(1)+alb_dif(iof+i,2)*SFRWL(2) &
+                 +alb_dif(iof+i,3)*SFRWL(3))/(SFRWL(1)+SFRWL(2)+SFRWL(3))
+          PALBD(i,2)=(alb_dif(iof+i,4)*SFRWL(4)+alb_dif(iof+i,5)*SFRWL(5) &
+                 +alb_dif(iof+i,6)*SFRWL(6))/(SFRWL(4)+SFRWL(5)+SFRWL(6))
+          PALBP(i,1)=(alb_dir(iof+i,1)*SFRWL(1)+alb_dir(iof+i,2)*SFRWL(2)  &
+                 +alb_dir(iof+i,3)*SFRWL(3))/(SFRWL(1)+SFRWL(2)+SFRWL(3))
+          PALBP(i,2)=(alb_dir(iof+i,4)*SFRWL(4)+alb_dir(iof+i,5)*SFRWL(5)  &
+                 +alb_dir(iof+i,6)*SFRWL(6))/(SFRWL(4)+SFRWL(5)+SFRWL(6))
+        end select
+      elseif(iflag_rrtm==1)then
+        DO kk=1,NSW
+         PALBD_NEW(i,kk)=alb_dif(iof+i,kk)
+         PALBP_NEW(i,kk)=alb_dir(iof+i,kk)
+        ENDDO
+      endif
+!albedo SB <<<
+
+
+
+
       PEMIS(i) = 1.0    !!!!! A REVOIR (MPL) 
       PVIEW(i) = 1.66
Index: LMDZ5/branches/testing/libf/phylmd/readchlorophyll.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/readchlorophyll.F90	(revision 2258)
+++ LMDZ5/branches/testing/libf/phylmd/readchlorophyll.F90	(revision 2258)
@@ -0,0 +1,131 @@
+!
+! $Id$
+!
+
+subroutine readchlorophyll(debut)
+
+    use netcdf95, only: nf95_close, nf95_gw_var, nf95_inq_dimid, & 
+                        nf95_inq_varid, nf95_open
+    use netcdf, only: nf90_get_var, nf90_noerr, nf90_nowrite
+
+    USE phys_cal_mod, ONLY : mth_cur
+    USE mod_grid_phy_lmdz
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    USE mod_phys_lmdz_para 
+    USE phys_state_var_mod
+    USE phys_local_var_mod
+    USE dimphy
+
+    implicit none
+
+    include "YOMCST.h"
+    include "dimensions.h"
+
+! Variable input
+    logical debut
+
+! Variables locales
+    integer n_lat   ! number of latitudes in the input data
+    integer n_lon   ! number of longitudes in the input data
+    integer n_lev   ! number of levels in the input data
+    integer n_month ! number of months in the input data
+    real, pointer:: latitude(:)
+    real, pointer:: longitude(:)
+    real, pointer:: time(:)
+    integer i, k
+    integer, save :: mth_pre
+!$OMP THREADPRIVATE(mth_pre)
+
+! Champs reconstitues
+    real, allocatable:: chlorocon(:, :, :)
+    real, allocatable:: chlorocon_mois(:, :)
+    real, allocatable:: chlorocon_mois_glo(:)
+
+! For NetCDF:
+    integer ncid_in  ! IDs for input files
+    integer varid, ncerr
+
+
+!--------------------------------------------------------
+
+
+!--only read file if beginning of run or start of new month
+    IF (debut.OR.mth_cur.NE.mth_pre) THEN
+
+    IF (is_mpi_root) THEN
+
+
+    CALL nf95_open("chlorophyll.nc", nf90_nowrite, ncid_in)
+
+    CALL nf95_inq_varid(ncid_in, "lon", varid)
+    CALL nf95_gw_var(ncid_in, varid, longitude)
+    n_lon = size(longitude)
+!    print *, 'LON chlorophyll=', n_lon, longitude
+    IF (n_lon.NE.iim) THEN
+       print *,'Le nombre de lon n est pas egal a iim'
+       STOP
+    ENDIF
+
+
+    CALL nf95_inq_varid(ncid_in, "lat", varid)
+    CALL nf95_gw_var(ncid_in, varid, latitude)
+    n_lat = size(latitude)
+!    print *, 'LAT chlorophyll=', n_lat, latitude
+    IF (n_lat.NE.jjm+1) THEN 
+       print *,'Le nombre de lat n est pas egal a jjm+1'
+       STOP
+    ENDIF
+
+    CALL nf95_inq_varid(ncid_in, "time", varid)
+    CALL nf95_gw_var(ncid_in, varid, time)
+    n_month = size(time)
+!    print *, 'TIME aerosol strato=', n_month, time
+    IF (n_month.NE.12) THEN 
+       print *,'Le nombre de month n est pas egal a 12'
+       STOP
+    ENDIF
+
+    IF (.not.ALLOCATED(chlorocon))          ALLOCATE(chlorocon(n_lon, n_lat, n_month))
+    IF (.not.ALLOCATED(chlorocon_mois))     ALLOCATE(chlorocon_mois(n_lon, n_lat))
+    IF (.not.ALLOCATED(chlorocon_mois_glo)) ALLOCATE(chlorocon_mois_glo(klon_glo))
+
+!--reading stratospheric AOD at 550 nm
+    CALL nf95_inq_varid(ncid_in, "CHL", varid)
+    ncerr = nf90_get_var(ncid_in, varid, chlorocon)
+    print *,'code erreur readaerosolstrato=', ncerr, varid
+
+    CALL nf95_close(ncid_in)
+
+!---select the correct month
+    IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN
+      print *,'probleme avec le mois dans readaerosolstrat =', mth_cur
+    ENDIF
+    chlorocon_mois(:,:) = chlorocon(:,:,mth_cur)
+
+!---reduce to a klon_glo grid 
+    CALL grid2dTo1d_glo(chlorocon_mois,chlorocon_mois_glo)
+
+
+    print*,"chrolophyll current month",mth_cur
+    do i=1,klon_glo
+      if(isnan(chlorocon_mois_glo(i)))then
+         chlorocon_mois_glo(i)=0.
+      endif
+      !print*,"high chl con",i,chlorocon_mois_glo(i)
+    enddo
+
+!    DEALLOCATE(chlorocon)
+!    DEALLOCATE(chlorocon_mois)
+!    DEALLOCATE(chlorocon_mois_glo)
+  
+    ENDIF !--is_mpi_root
+
+!--scatter on all proc
+    CALL scatter(chlorocon_mois_glo,chl_con)
+
+!--keep memory of previous month
+    mth_pre=mth_cur
+
+    ENDIF !--debut ou nouveau mois
+
+end subroutine readchlorophyll
Index: LMDZ5/branches/testing/libf/phylmd/rrtm/aeropt_6bands_rrtm.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/rrtm/aeropt_6bands_rrtm.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/rrtm/aeropt_6bands_rrtm.F90	(revision 2258)
@@ -473,5 +473,5 @@
                                tau_ae(i,k,id_ASSSM_phy,inu)+tau_ae(i,k,id_CSSSM_phy,inu)+   &
                                tau_ae(i,k,id_SSSSM_phy,inu)+ tau_ae(i,k,id_CIDUSTM_phy,inu)
-         tau_allaer(i,k,2,inu)=MAX(tau_allaer(i,k,2,inu),1e-5)
+         tau_allaer(i,k,2,inu)=MAX(tau_allaer(i,k,2,inu),1e-15)
 
          piz_allaer(i,k,2,inu)=(tau_ae(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)+ &
@@ -486,5 +486,5 @@
                                 tau_ae(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)) &
                                 /tau_allaer(i,k,2,inu)
-         piz_allaer(i,k,2,inu)=MAX(piz_allaer(i,k,2,inu),0.1)
+         piz_allaer(i,k,2,inu)=MAX(piz_allaer(i,k,2,inu),0.01)
 
          cg_allaer(i,k,2,inu)=(tau_ae(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)*cg_ae(i,k,id_ASSO4M_phy,inu)+ &
@@ -506,5 +506,5 @@
                                tau_ae_pi(i,k,id_ASSSM_phy,inu)+tau_ae_pi(i,k,id_CSSSM_phy,inu)+   &
                                tau_ae_pi(i,k,id_SSSSM_phy,inu)+ tau_ae_pi(i,k,id_CIDUSTM_phy,inu)
-         tau_allaer(i,k,1,inu)=MAX(tau_allaer(i,k,1,inu),1e-5)
+         tau_allaer(i,k,1,inu)=MAX(tau_allaer(i,k,1,inu),1e-15)
 
          piz_allaer(i,k,1,inu)=(tau_ae_pi(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)+ &
@@ -519,5 +519,5 @@
                                 tau_ae_pi(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)) &
                                 /tau_allaer(i,k,1,inu)
-         piz_allaer(i,k,1,inu)=MAX(piz_allaer(i,k,1,inu),0.1)
+         piz_allaer(i,k,1,inu)=MAX(piz_allaer(i,k,1,inu),0.01)
 
          cg_allaer(i,k,1,inu)=(tau_ae_pi(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)*cg_ae(i,k,id_ASSO4M_phy,inu)+ &
Index: LMDZ5/branches/testing/libf/phylmd/rrtm/aeropt_lw_rrtm.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/rrtm/aeropt_lw_rrtm.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/rrtm/aeropt_lw_rrtm.F90	(revision 2258)
@@ -9,5 +9,5 @@
   IMPLICIT NONE
 
-  tau_aero_lw_rrtm(:,:,:,:)=0.0
+  tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
 
 END SUBROUTINE AEROPT_LW_RRTM
Index: LMDZ5/branches/testing/libf/phylmd/rrtm/readaerosolstrato_rrtm.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/rrtm/readaerosolstrato_rrtm.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/rrtm/readaerosolstrato_rrtm.F90	(revision 2258)
@@ -211,3 +211,15 @@
     ENDDO
 
+!--default SSA value if there is no aerosol
+!--to avoid 0 values that seems to cause some problem to RRTM
+    WHERE (tau_aero_sw_rrtm.LT.1.e-14)
+      piz_aero_sw_rrtm = 1.0
+    ENDWHERE
+
+!--in principle this should not be necessary 
+!--as these variables have min values already but just in case
+!--put 1e-15 min value to both SW and LW AOD
+    tau_aero_sw_rrtm = MAX(tau_aero_sw_rrtm,1.e-15)
+    tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15)
+
 end subroutine readaerosolstrato_rrtm
Index: LMDZ5/branches/testing/libf/phylmd/screenc.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/screenc.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/screenc.F90	(revision 2258)
@@ -66,11 +66,15 @@
 ! Richardson at reference level 
 !
-      CALL coefcdrag (klon, knon, nsrf, zxli, &
+!      CALL coefcdrag (klon, knon, nsrf, zxli, &
+!                    speed, temp, q_zref, gref, &
+!                    psol, ts, qsurf, rugos, &
+!                    okri, ri1, &
+!                    cdram, cdrah, cdran, zri1, &
+!                    pref)
+! Fuxing WANG, 04/03/2015, replace the coefcdrag by the merged version: cdrag
+      CALL cdrag (knon, nsrf, &
                     speed, temp, q_zref, gref, &
                     psol, ts, qsurf, rugos, &
-                    okri, ri1, &
-                    cdram, cdrah, cdran, zri1, &
-                    pref)
-!
+                    cdram, cdrah, zri1, pref)
       DO i = 1, knon
         delu(i) = ustar(i)/sqrt(cdram(i))
Index: LMDZ5/branches/testing/libf/phylmd/stdlevvar.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/stdlevvar.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/stdlevvar.F90	(revision 2258)
@@ -98,8 +98,14 @@
 !
       okri=.FALSE.
-      CALL coefcdrag(klon, knon, nsrf, zxli, &
- &                   speed, t1, q1, z1, psol, &
- &                   ts1, qsurf, rugos, okri, ri1,  &         
- &                   cdram, cdrah, cdran, zri1, pref)            
+!      CALL coefcdrag(klon, knon, nsrf, zxli, &
+! &                   speed, t1, q1, z1, psol, &
+! &                   ts1, qsurf, rugos, okri, ri1,  &         
+! &                   cdram, cdrah, cdran, zri1, pref)            
+! Fuxing WANG, 04/03/2015, replace the coefcdrag by the merged version: cdrag
+      CALL cdrag(knon, nsrf, &
+ &                   speed, t1, q1, z1, &
+ &                   psol, ts1, qsurf, rugos, &
+ &                   cdram, cdrah, zri1, pref)
+
 ! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
      IF (ok_prescr_ust) then
Index: LMDZ5/branches/testing/libf/phylmd/surf_land_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/surf_land_mod.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/surf_land_mod.F90	(revision 2258)
@@ -17,5 +17,8 @@
        lwdown_m, q2m, t2m, &
        snow, qsol, agesno, tsoil, &
-       z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
+!albedo SB >>>
+!      z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
+       z0_new, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &   
+!albedo SB <<<
        qsurf, tsurf_new, dflux_s, dflux_l, &
        flux_u1, flux_v1 ) 
@@ -35,4 +38,7 @@
     INCLUDE "dimsoil.h"
     INCLUDE "YOMCST.h"
+!albedo SB >>>
+    INCLUDE "clesphys.h"
+!albedo SB <<<
 
 ! Input variables  
@@ -71,6 +77,10 @@
 !****************************************************************************************
     REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
-    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)
+!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
@@ -89,4 +99,8 @@
     REAL, DIMENSION(klon) :: u0, v0     ! surface speed
     INTEGER               :: i
+
+!albedo SB >>>
+    REAL, DIMENSION(klon)      :: alb1_new,alb2_new
+!albedo SB <<<
 
 
@@ -165,4 +179,29 @@
          p1lay, temp_air, &
          flux_u1, flux_v1)
+
+!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
Index: LMDZ5/branches/testing/libf/phylmd/surf_landice_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/surf_landice_mod.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/surf_landice_mod.F90	(revision 2258)
@@ -17,5 +17,8 @@
        ps, u1, v1, rugoro, pctsrf, &
        snow, qsurf, qsol, agesno, &
-       tsoil, z0_new, alb1, alb2, evap, fluxsens, fluxlat, &
+!albedo SB >>>
+!      tsoil, z0_new, alb1, alb2, evap, fluxsens, fluxlat, &
+       tsoil, z0_new, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, &
+!albedo SB <<<
        tsurf_new, dflux_s, dflux_l, &
        slope, cloudf, &
@@ -80,6 +83,10 @@
     REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
     REAL, DIMENSION(klon), INTENT(OUT)            :: z0_new
-    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1  ! new albedo in visible SW interval
-    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2  ! new albedo in near IR interval
+!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)            :: tsurf_new
@@ -116,4 +123,8 @@
     CHARACTER (len = 20)                      :: modname = 'surf_landice'
     CHARACTER (len = 80)                      :: abort_message
+
+!albedo SB >>>
+    real,dimension(klon) :: alb1,alb2
+!albedo SB <<<
 
 ! End definition
@@ -315,4 +326,28 @@
 
 
+!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)
+     end select
+alb_dif=alb_dir
+!albedo SB <<<
+
+
+
+
   END SUBROUTINE surf_landice
 !
Index: LMDZ5/branches/testing/libf/phylmd/surf_ocean_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/surf_ocean_mod.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/surf_ocean_mod.F90	(revision 2258)
@@ -16,5 +16,8 @@
        ps, u1, v1, rugoro, pctsrf, &
        snow, qsurf, agesno, &
-       z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
+!albedo SB >>>
+!      z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
+       z0_new, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, & 
+!albedo SB <<<
        tsurf_new, dflux_s, dflux_l, lmt_bils, &
        flux_u1, flux_v1)
@@ -72,6 +75,10 @@
 !****************************************************************************************
     REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
-    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
+!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
@@ -82,5 +89,5 @@
 ! Local variables
 !****************************************************************************************
-    INTEGER               :: i
+    INTEGER               :: i, k
     REAL                  :: tmp
     REAL, PARAMETER       :: cepdu2=(0.1)**2
@@ -155,4 +162,10 @@
 !
 !****************************************************************************************
+!albedo SB >>>
+
+
+  if(iflag_albedo==1)then
+    call ocean_albedo(knon,rmu0,knindex,windsp,SFRWL,alb_dir_new,alb_dif_new)
+  else
     IF (cycle_diurne) THEN
        CALL alboc_cd(rmu0,alb_eau)
@@ -162,7 +175,12 @@
 
     DO i =1, knon
-       alb1_new(i) = alb_eau(knindex(i))
+      do  k=1,nsw
+       alb_dir_new(i,k) = alb_eau(knindex(i))
+      enddo
     ENDDO
-    alb2_new(1:knon) = alb1_new(1:knon)
+     alb_dif_new=0.05 !alb_dir_new
+endif
+
+!albedo SB <<<
 
 !****************************************************************************************
Index: LMDZ5/branches/testing/libf/phylmd/surf_seaice_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/surf_seaice_mod.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phylmd/surf_seaice_mod.F90	(revision 2258)
@@ -1,2 +1,4 @@
+!
+! $Id$
 !
 MODULE surf_seaice_mod
@@ -17,5 +19,8 @@
        ps, u1, v1, rugoro, pctsrf, &
        snow, qsurf, qsol, agesno, tsoil, &
-       z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
+!albedo SB >>>
+!      z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
+       z0_new, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &  
+!albedo SB <<<
        tsurf_new, dflux_s, dflux_l, &
        flux_u1, flux_v1)
@@ -34,4 +39,5 @@
 !
     INCLUDE "dimsoil.h"
+    INCLUDE "clesphys.h"
 
 ! Input arguments
@@ -67,6 +73,10 @@
 !****************************************************************************************
     REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
-    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
+!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
@@ -78,4 +88,7 @@
     REAL, DIMENSION(klon)  :: radsol
 
+!albedo SB >>>
+    REAL, DIMENSION(klon) :: alb1_new,alb2_new
+!albedo SB <<<
 !
 ! End definitions
@@ -140,4 +153,29 @@
     z0_new = SQRT(z0_new**2+rugoro**2)
 
+
+!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
 !
Index: LMDZ5/branches/testing/libf/phymar/iniphysiq.F
===================================================================
--- LMDZ5/branches/testing/libf/phymar/iniphysiq.F	(revision 2220)
+++ 	(revision )
@@ -1,110 +1,0 @@
-!
-! $Id: iniphysiq.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      SUBROUTINE iniphysiq(ngrid,nlayer,
-     $           punjours,
-     $           pdayref,ptimestep,
-     $           plat,plon,parea,pcu,pcv,
-     $           prad,pg,pr,pcpp,iflag_phys)
-      USE dimphy, only : klev
-      USE mod_grid_phy_lmdz, only : klon_glo
-      USE mod_phys_lmdz_para, only : klon_omp,klon_omp_begin,
-     &                               klon_omp_end,klon_mpi_begin
-      USE comgeomphy, only : airephy,cuphy,cvphy,rlond,rlatd
-      USE comcstphy, only : rradius,rg,rr,rcpp
-
-      IMPLICIT NONE
-c
-c=======================================================================
-c
-c   Initialisation of the physical constants and some positional and 
-c   geometrical arrays for the physics
-c
-c
-c    ngrid                 Size of the horizontal grid.
-c                          All internal loops are performed on that grid.
-c    nlayer                Number of vertical layers.
-c    pdayref               Day of reference for the simulation
-c
-c=======================================================================
- 
- 
-cym#include "dimensions.h"
-cym#include "dimphy.h"
-cym#include "comgeomphy.h"
-#include "iniprint.h"
-
-      REAL,INTENT(IN) :: prad ! radius of the planet (m)
-      REAL,INTENT(IN) :: pg ! gravitational acceleration (m/s2)
-      REAL,INTENT(IN) :: pr ! ! reduced gas constant R/mu
-      REAL,INTENT(IN) :: pcpp ! specific heat Cp
-      REAL,INTENT(IN) :: punjours ! length (in s) of a standard day
-      INTEGER,INTENT(IN) :: ngrid ! number of horizontal grid points in the physics
-      INTEGER,INTENT(IN) :: nlayer ! number of atmospheric layers
-      REAL,INTENT(IN) :: plat(ngrid) ! latitudes of the physics grid
-      REAL,INTENT(IN) :: plon(ngrid) ! longitudes of the physics grid
-      REAL,INTENT(IN) :: parea(klon_glo) ! area (m2)
-      REAL,INTENT(IN) :: pcu(klon_glo) ! cu coeff. (u_covariant = cu * u)
-      REAL,INTENT(IN) :: pcv(klon_glo) ! cv coeff. (v_covariant = cv * v)
-      INTEGER,INTENT(IN) :: pdayref ! reference day of for the simulation
-      REAL,INTENT(IN) :: ptimestep !physics time step (s)
-      INTEGER,INTENT(IN) :: iflag_phys ! type of physics to be called
-
-      INTEGER :: ibegin,iend,offset
-      CHARACTER (LEN=20) :: modname='iniphysiq'
-      CHARACTER (LEN=80) :: abort_message
- 
-      IF (nlayer.NE.klev) THEN
-         write(lunout,*) 'STOP in ',trim(modname)
-         write(lunout,*) 'Problem with dimensions :'
-         write(lunout,*) 'nlayer     = ',nlayer
-         write(lunout,*) 'klev   = ',klev
-         abort_message = ''
-         CALL abort_gcm (modname,abort_message,1)
-      ENDIF
-
-      IF (ngrid.NE.klon_glo) THEN
-         write(lunout,*) 'STOP in ',trim(modname)
-         write(lunout,*) 'Problem with dimensions :'
-         write(lunout,*) 'ngrid     = ',ngrid
-         write(lunout,*) 'klon   = ',klon_glo
-         abort_message = ''
-         CALL abort_gcm (modname,abort_message,1)
-      ENDIF
-
-!$OMP PARALLEL PRIVATE(ibegin,iend) 
-!$OMP+         SHARED(parea,pcu,pcv,plon,plat)
-      
-      offset=klon_mpi_begin-1
-      airephy(1:klon_omp)=parea(offset+klon_omp_begin:
-     &                          offset+klon_omp_end)
-      cuphy(1:klon_omp)=pcu(offset+klon_omp_begin:offset+klon_omp_end)
-      cvphy(1:klon_omp)=pcv(offset+klon_omp_begin:offset+klon_omp_end)
-      rlond(1:klon_omp)=plon(offset+klon_omp_begin:offset+klon_omp_end)
-      rlatd(1:klon_omp)=plat(offset+klon_omp_begin:offset+klon_omp_end)
-
-! copy some fundamental parameters to physics
-      rradius=prad
-      rg=pg
-      rr=pr
-      rcpp=pcpp
-
-!$OMP END PARALLEL
-
-!      print*,'ATTENTION !!! TRAVAILLER SUR INIPHYSIQ'
-!      print*,'CONTROLE DES LATITUDES, LONGITUDES, PARAMETRES ...'
-
-! Additional initializations for aquaplanets 
-!$OMP PARALLEL
-      if (iflag_phys>=100) then
-        call iniaqua(klon_omp,rlatd,rlond,iflag_phys)
-      endif
-!$OMP END PARALLEL
-
-!      RETURN
-!9999  CONTINUE
-!      abort_message ='Cette version demande les fichier rnatur.dat
-!     & et surf.def'
-!      CALL abort_gcm (modname,abort_message,1)
-
-      END
Index: LMDZ5/branches/testing/libf/phymar/iniphysiq.F90
===================================================================
--- LMDZ5/branches/testing/libf/phymar/iniphysiq.F90	(revision 2258)
+++ LMDZ5/branches/testing/libf/phymar/iniphysiq.F90	(revision 2258)
@@ -0,0 +1,157 @@
+!
+! $Id: iniphysiq.F 1403 2010-07-01 09:02:53Z fairhead $
+!
+SUBROUTINE iniphysiq(iim,jjm,nlayer,punjours, pdayref,ptimestep,         &
+                     rlatu,rlonv,aire,cu,cv,                             &
+                     prad,pg,pr,pcpp,iflag_phys)
+  USE dimphy, ONLY: klev ! number of atmospheric levels
+  USE mod_grid_phy_lmdz, ONLY: klon_glo ! number of atmospheric columns
+                                        ! (on full grid)
+  USE mod_phys_lmdz_para, ONLY: klon_omp, & ! number of columns (on local omp grid)
+                                klon_omp_begin, & ! start index of local omp subgrid
+                                klon_omp_end, & ! end index of local omp subgrid
+                                klon_mpi_begin ! start indes of columns (on local mpi grid)
+  USE comgeomphy, ONLY: initcomgeomphy, &
+                        airephy, & ! physics grid area (m2)
+                        cuphy, & ! cu coeff. (u_covariant = cu * u)
+                        cvphy, & ! cv coeff. (v_covariant = cv * v)
+                        rlond, & ! longitudes
+                        rlatd ! latitudes
+  USE comcstphy, ONLY: rradius, & ! planet radius (m)
+                       rr, & ! recuced gas constant: R/molar mass of atm
+                       rg, & ! gravity
+                       rcpp  ! specific heat of the atmosphere
+  USE phyaqua_mod, ONLY: iniaqua
+  IMPLICIT NONE
+  !
+  !=======================================================================
+  !   Initialisation of the physical constants and some positional and 
+  !   geometrical arrays for the physics
+  !=======================================================================
+ 
+ 
+  include "iniprint.h"
+
+  REAL,INTENT(IN) :: prad ! radius of the planet (m)
+  REAL,INTENT(IN) :: pg ! gravitational acceleration (m/s2)
+  REAL,INTENT(IN) :: pr ! ! reduced gas constant R/mu
+  REAL,INTENT(IN) :: pcpp ! specific heat Cp
+  REAL,INTENT(IN) :: punjours ! length (in s) of a standard day
+  INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers
+  INTEGER, INTENT (IN) :: iim ! number of atmospheric coulumns along longitudes
+  INTEGER, INTENT (IN) :: jjm  ! number of atompsheric columns along latitudes
+  REAL, INTENT (IN) :: rlatu(jjm+1) ! latitudes of the physics grid
+  REAL, INTENT (IN) :: rlonv(iim+1) ! longitudes of the physics grid
+  REAL, INTENT (IN) :: aire(iim+1,jjm+1) ! area of the dynamics grid (m2)
+  REAL, INTENT (IN) :: cu((iim+1)*(jjm+1)) ! cu coeff. (u_covariant = cu * u)
+  REAL, INTENT (IN) :: cv((iim+1)*jjm) ! cv coeff. (v_covariant = cv * v)
+  INTEGER, INTENT (IN) :: pdayref ! reference day of for the simulation
+  REAL,INTENT(IN) :: ptimestep !physics time step (s)
+  INTEGER,INTENT(IN) :: iflag_phys ! type of physics to be called
+
+  INTEGER :: ibegin,iend,offset
+  INTEGER :: i,j
+  CHARACTER (LEN=20) :: modname='iniphysiq'
+  CHARACTER (LEN=80) :: abort_message
+  REAL :: total_area_phy, total_area_dyn
+
+
+  ! global array, on full physics grid:
+  REAL,ALLOCATABLE :: latfi(:)
+  REAL,ALLOCATABLE :: lonfi(:)
+  REAL,ALLOCATABLE :: cufi(:)
+  REAL,ALLOCATABLE :: cvfi(:)
+  REAL,ALLOCATABLE :: airefi(:)
+ 
+  IF (nlayer.NE.klev) THEN
+    WRITE(lunout,*) 'STOP in ',trim(modname)
+    WRITE(lunout,*) 'Problem with dimensions :'
+    WRITE(lunout,*) 'nlayer     = ',nlayer
+    WRITE(lunout,*) 'klev   = ',klev
+    abort_message = ''
+    CALL abort_gcm (modname,abort_message,1)
+  ENDIF
+
+
+  ! Generate global arrays on full physics grid
+  ALLOCATE(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
+  ALLOCATE(airefi(klon_glo))
+
+  IF (klon_glo>1) THEN ! general case
+    ! North pole
+    latfi(1)=rlatu(1)
+    lonfi(1)=0.
+    cufi(1) = cu(1)
+    cvfi(1) = cv(1)
+    DO j=2,jjm
+      DO i=1,iim
+        latfi((j-2)*iim+1+i)= rlatu(j)
+        lonfi((j-2)*iim+1+i)= rlonv(i)
+        cufi((j-2)*iim+1+i) = cu((j-1)*iim+1+i)
+        cvfi((j-2)*iim+1+i) = cv((j-1)*iim+1+i)
+      ENDDO
+    ENDDO
+    ! South pole
+    latfi(klon_glo)= rlatu(jjm+1)
+    lonfi(klon_glo)= 0.
+    cufi(klon_glo) = cu((iim+1)*jjm+1)
+    cvfi(klon_glo) = cv((iim+1)*jjm-iim)
+
+    ! build airefi(), mesh area on physics grid
+    CALL gr_dyn_fi(1,iim+1,jjm+1,klon_glo,aire,airefi)
+    ! Poles are single points on physics grid
+    airefi(1)=sum(aire(1:iim,1))
+    airefi(klon_glo)=sum(aire(1:iim,jjm+1))
+
+    ! Sanity check: do total planet area match between physics and dynamics?
+    total_area_dyn=sum(aire(1:iim,1:jjm+1))
+    total_area_phy=sum(airefi(1:klon_glo))
+    IF (total_area_dyn/=total_area_phy) THEN
+      WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
+      WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
+      WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
+      IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
+        ! stop here if the relative difference is more than 0.001%
+        abort_message = 'planet total surface discrepancy'
+        CALL abort_gcm(modname, abort_message, 1)
+      ENDIF
+    ENDIF
+  ELSE ! klon_glo==1, running the 1D model
+    ! just copy over input values
+    latfi(1)=rlatu(1)
+    lonfi(1)=rlonv(1)
+    cufi(1)=cu(1)
+    cvfi(1)=cv(1)
+    airefi(1)=aire(1,1)
+  ENDIF ! of IF (klon_glo>1)
+
+!$OMP PARALLEL
+  ! Now generate local lon/lat/cu/cv/area arrays
+  CALL initcomgeomphy
+      
+  offset = klon_mpi_begin - 1
+  airephy(1:klon_omp) = airefi(offset+klon_omp_begin:offset+klon_omp_end)
+  cuphy(1:klon_omp) = cufi(offset+klon_omp_begin:offset+klon_omp_end)
+  cvphy(1:klon_omp) = cvfi(offset+klon_omp_begin:offset+klon_omp_end)
+  rlond(1:klon_omp) = lonfi(offset+klon_omp_begin:offset+klon_omp_end)
+  rlatd(1:klon_omp) = latfi(offset+klon_omp_begin:offset+klon_omp_end)
+
+! copy some fundamental parameters to physics
+  rradius=prad
+  rg=pg
+  rr=pr
+  rcpp=pcpp
+
+!$OMP END PARALLEL
+
+!      print*,'ATTENTION !!! TRAVAILLER SUR INIPHYSIQ'
+!      print*,'CONTROLE DES LATITUDES, LONGITUDES, PARAMETRES ...'
+
+! Additional initializations for aquaplanets 
+!$OMP PARALLEL
+      if (iflag_phys>=100) then
+        call iniaqua(klon_omp,rlatd,rlond,iflag_phys)
+      endif
+!$OMP END PARALLEL
+
+      END
Index: LMDZ5/branches/testing/libf/phymar/physiq.F90
===================================================================
--- LMDZ5/branches/testing/libf/phymar/physiq.F90	(revision 2220)
+++ LMDZ5/branches/testing/libf/phymar/physiq.F90	(revision 2258)
@@ -10,5 +10,5 @@
       SUBROUTINE physiq (nlon,nlev, &
      &            debut,lafin,jD_cur, jH_cur,pdtphys, &
-     &            paprs,pplay,pphi,pphis,ppresnivs,clesphy0, &
+     &            paprs,pplay,pphi,pphis,ppresnivs, &
      &            u,v,t,qx, &
      &            flxmass_w, &
@@ -118,6 +118,4 @@
       real,intent(in) :: pphis(klon) ! surface geopotential
       real,intent(in) :: ppresnivs(klev) ! pseudo-pressure (Pa) of mid-layers
-      integer,parameter :: longcles=20
-      real,intent(in) :: clesphy0(longcles) ! Not used
       real,intent(in) :: u(klon,klev) ! eastward zonal wind (m/s)
       real,intent(in) :: v(klon,klev) ! northward meridional wind (m/s)
