Index: LMDZ5/trunk/libf/dyn3d/dynetat0.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3d/dynetat0.F90	(revision 2298)
+++ 	(revision )
@@ -1,208 +1,0 @@
-SUBROUTINE dynetat0(fichnom,vcov,ucov,teta,q,masse,ps,phis,time)
-!
-!-------------------------------------------------------------------------------
-! Authors: P. Le Van , L.Fairhead
-!-------------------------------------------------------------------------------
-! Purpose: Initial state reading.
-!-------------------------------------------------------------------------------
-  USE infotrac
-  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQ_VARID, NF90_NoErr, &
-                         NF90_CLOSE, NF90_GET_VAR
-  USE control_mod, ONLY: planet_type
-  USE assert_eq_m, ONLY: assert_eq
-  IMPLICIT NONE
-  include "dimensions.h"
-  include "paramet.h"
-  include "temps.h"
-  include "comconst.h"
-  include "comvert.h"
-  include "comgeom2.h"
-  include "ener.h"
-  include "description.h"
-  include "serre.h"
-  include "logic.h"
-  include "iniprint.h"
-!===============================================================================
-! Arguments:
-  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
-  REAL, INTENT(OUT) ::  vcov(iip1,jjm, llm)        !--- V COVARIANT WIND
-  REAL, INTENT(OUT) ::  ucov(iip1,jjp1,llm)        !--- U COVARIANT WIND
-  REAL, INTENT(OUT) ::  teta(iip1,jjp1,llm)        !--- POTENTIAL TEMP.
-  REAL, INTENT(OUT) ::     q(iip1,jjp1,llm,nqtot)  !--- TRACERS
-  REAL, INTENT(OUT) :: masse(iip1,jjp1,llm)        !--- MASS PER CELL
-  REAL, INTENT(OUT) ::    ps(iip1,jjp1)            !--- GROUND PRESSURE
-  REAL, INTENT(OUT) ::  phis(iip1,jjp1)            !--- GEOPOTENTIAL
-!===============================================================================
-! Local variables:
-  CHARACTER(LEN=256) :: msg, var, modname
-  INTEGER, PARAMETER :: length=100
-  INTEGER :: iq, fID, vID, idecal!, iml, jml, lml, nqt
-  REAL    :: time, tab_cntrl(length)               !--- RUN PARAMS TABLE
-!-------------------------------------------------------------------------------
-  modname="dynetat0"
-
-!--- Initial state file opening
-  var=fichnom
-  CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var)
-  CALL get_var1("controle",tab_cntrl)
-
-!!! AS: idecal is a hack to be able to read planeto starts...
-!!!     .... while keeping everything OK for LMDZ EARTH
-  IF(planet_type=="generic") THEN
-    WRITE(lunout,*)'NOTE NOTE NOTE : Planeto-like start files'
-    idecal = 4
-    annee_ref  = 2000
-  ELSE
-    WRITE(lunout,*)'NOTE NOTE NOTE : Earth-like start files'
-    idecal = 5
-    annee_ref  = tab_cntrl(5)
-  END IF
-  im         = tab_cntrl(1)
-  jm         = tab_cntrl(2)
-  lllm       = tab_cntrl(3)
-  day_ref    = tab_cntrl(4)
-  rad        = tab_cntrl(idecal+1)
-  omeg       = tab_cntrl(idecal+2)
-  g          = tab_cntrl(idecal+3)
-  cpp        = tab_cntrl(idecal+4)
-  kappa      = tab_cntrl(idecal+5)
-  daysec     = tab_cntrl(idecal+6)
-  dtvr       = tab_cntrl(idecal+7)
-  etot0      = tab_cntrl(idecal+8)
-  ptot0      = tab_cntrl(idecal+9)
-  ztot0      = tab_cntrl(idecal+10)
-  stot0      = tab_cntrl(idecal+11)
-  ang0       = tab_cntrl(idecal+12)
-  pa         = tab_cntrl(idecal+13)
-  preff      = tab_cntrl(idecal+14)
-!
-  clon       = tab_cntrl(idecal+15)
-  clat       = tab_cntrl(idecal+16)
-  grossismx  = tab_cntrl(idecal+17)
-  grossismy  = tab_cntrl(idecal+18)
-!
-  IF ( tab_cntrl(idecal+19)==1. )  THEN
-    fxyhypb  = .TRUE.
-!   dzoomx   = tab_cntrl(25)
-!   dzoomy   = tab_cntrl(26)
-!   taux     = tab_cntrl(28)
-!   tauy     = tab_cntrl(29)
-  ELSE
-    fxyhypb = .FALSE.
-    ysinus  = tab_cntrl(idecal+22)==1.
-  END IF
-
-  day_ini    = tab_cntrl(30)
-  itau_dyn   = tab_cntrl(31)
-  start_time = tab_cntrl(32)
-
-!-------------------------------------------------------------------------------
-  WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
-  CALL check_dim(im,iim,'im','im')
-  CALL check_dim(jm,jjm,'jm','jm')
-  CALL check_dim(lllm,llm,'lm','lllm')
-  CALL get_var1("rlonu",rlonu)
-  CALL get_var1("rlatu",rlatu)
-  CALL get_var1("rlonv",rlonv)
-  CALL get_var1("rlatv",rlatv)
-  CALL get_var2("cu"   ,cu)
-  CALL get_var2("cv"   ,cv)
-  CALL get_var2("aire" ,aire)
-  CALL get_var2("phisinit",phis)
-  var="temps"
-  IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN
-    WRITE(lunout,*)TRIM(modname)//": missing field <temps>"
-    WRITE(lunout,*)TRIM(modname)//": trying with <Time>"; var="Time"
-    CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
-  END IF
-  CALL err(NF90_GET_VAR(fID,vID,time),"get",var)
-  CALL get_var3("ucov",ucov)
-  CALL get_var3("vcov",vcov)
-  CALL get_var3("teta",teta)
-  CALL get_var3("masse",masse)
-  CALL get_var2("ps",ps)
-
-!--- Tracers
-  DO iq=1,nqtot
-    var=tname(iq)
-    IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN
-      WRITE(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing"
-      WRITE(lunout,*)"         It is hence initialized to zero"
-      q(:,:,:,iq)=0.
-    ELSE
-      CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var)
-    END IF
-  END DO
-
-  CALL err(NF90_CLOSE(fID),"close",fichnom)
-  day_ini=day_ini+INT(time)
-  time=time-INT(time)
-
-
-  CONTAINS
-
-
-SUBROUTINE check_dim(n1,n2,str1,str2)
-  INTEGER,          INTENT(IN) :: n1, n2
-  CHARACTER(LEN=*), INTENT(IN) :: str1, str2
-  CHARACTER(LEN=256) :: s1, s2
-  IF(n1/=n2) THEN
-    s1='value of '//TRIM(str1)//' ='
-    s2=' read in starting file differs from parametrized '//TRIM(str2)//' ='
-    WRITE(msg,'(10x,a,i4,2x,a,i4)'),s1,n1,s2,n2
-    CALL ABORT_gcm(TRIM(modname),TRIM(msg),1)
-  END IF
-END SUBROUTINE check_dim
-
-
-SUBROUTINE get_var1(var,v)
-  CHARACTER(LEN=*), INTENT(IN)  :: var
-#ifdef NC_DOUBLE
-  DOUBLE PRECISION, INTENT(OUT) :: v(:)
-#else
-  REAL,             INTENT(OUT) :: v(:)
-#endif
-  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
-  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
-END SUBROUTINE get_var1
-
-
-SUBROUTINE get_var2(var,v)
-  CHARACTER(LEN=*), INTENT(IN)  :: var
-#ifdef NC_DOUBLE
-  DOUBLE PRECISION, INTENT(OUT) :: v(:,:)
-#else
-  REAL,             INTENT(OUT) :: v(:,:)
-#endif
-  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
-  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
-END SUBROUTINE get_var2
-
-
-SUBROUTINE get_var3(var,v)
-  CHARACTER(LEN=*), INTENT(IN)  :: var
-#ifdef NC_DOUBLE
-  DOUBLE PRECISION, INTENT(OUT) :: v(:,:,:)
-#else
-  REAL,             INTENT(OUT) :: v(:,:,:)
-#endif
-  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
-  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
-END SUBROUTINE get_var3
-
-
-SUBROUTINE err(ierr,typ,nam)
-  INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
-  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
-  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
-  IF(ierr==NF90_NoERR) RETURN
-  SELECT CASE(typ)
-    CASE('inq');   msg="Field <"//TRIM(nam)//"> is missing"
-    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
-    CASE('open');  msg="File opening failed for <"//TRIM(nam)//">"
-    CASE('close'); msg="File closing failed for <"//TRIM(nam)//">"
-  END SELECT
-  CALL ABORT_gcm(TRIM(modname),TRIM(msg),ierr)
-END SUBROUTINE err
-
-END SUBROUTINE dynetat0
Index: LMDZ5/trunk/libf/dyn3d/dynetat0.f90
===================================================================
--- LMDZ5/trunk/libf/dyn3d/dynetat0.f90	(revision 2299)
+++ LMDZ5/trunk/libf/dyn3d/dynetat0.f90	(revision 2299)
@@ -0,0 +1,202 @@
+SUBROUTINE dynetat0(fichnom,vcov,ucov,teta,q,masse,ps,phis,time)
+!
+!-------------------------------------------------------------------------------
+! Authors: P. Le Van , L.Fairhead
+!-------------------------------------------------------------------------------
+! Purpose: Initial state reading.
+!-------------------------------------------------------------------------------
+  USE infotrac
+  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQ_VARID, NF90_NoErr, &
+                         NF90_CLOSE, NF90_GET_VAR
+  USE control_mod, ONLY: planet_type
+  USE assert_eq_m, ONLY: assert_eq
+  IMPLICIT NONE
+  include "dimensions.h"
+  include "paramet.h"
+  include "temps.h"
+  include "comconst.h"
+  include "comvert.h"
+  include "comgeom2.h"
+  include "ener.h"
+  include "description.h"
+  include "serre.h"
+  include "logic.h"
+  include "iniprint.h"
+!===============================================================================
+! Arguments:
+  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
+  REAL, INTENT(OUT) ::  vcov(iip1,jjm, llm)        !--- V COVARIANT WIND
+  REAL, INTENT(OUT) ::  ucov(iip1,jjp1,llm)        !--- U COVARIANT WIND
+  REAL, INTENT(OUT) ::  teta(iip1,jjp1,llm)        !--- POTENTIAL TEMP.
+  REAL, INTENT(OUT) ::     q(iip1,jjp1,llm,nqtot)  !--- TRACERS
+  REAL, INTENT(OUT) :: masse(iip1,jjp1,llm)        !--- MASS PER CELL
+  REAL, INTENT(OUT) ::    ps(iip1,jjp1)            !--- GROUND PRESSURE
+  REAL, INTENT(OUT) ::  phis(iip1,jjp1)            !--- GEOPOTENTIAL
+!===============================================================================
+! Local variables:
+  CHARACTER(LEN=256) :: msg, var, modname
+  INTEGER, PARAMETER :: length=100
+  INTEGER :: iq, fID, vID, idecal!, iml, jml, lml, nqt
+  REAL    :: time, tab_cntrl(length)               !--- RUN PARAMS TABLE
+!-------------------------------------------------------------------------------
+  modname="dynetat0"
+
+!--- Initial state file opening
+  var=fichnom
+  CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var)
+  CALL get_var1("controle",tab_cntrl)
+
+!!! AS: idecal is a hack to be able to read planeto starts...
+!!!     .... while keeping everything OK for LMDZ EARTH
+  IF(planet_type=="generic") THEN
+    WRITE(lunout,*)'NOTE NOTE NOTE : Planeto-like start files'
+    idecal = 4
+    annee_ref  = 2000
+  ELSE
+    WRITE(lunout,*)'NOTE NOTE NOTE : Earth-like start files'
+    idecal = 5
+    annee_ref  = tab_cntrl(5)
+  END IF
+  im         = tab_cntrl(1)
+  jm         = tab_cntrl(2)
+  lllm       = tab_cntrl(3)
+  day_ref    = tab_cntrl(4)
+  rad        = tab_cntrl(idecal+1)
+  omeg       = tab_cntrl(idecal+2)
+  g          = tab_cntrl(idecal+3)
+  cpp        = tab_cntrl(idecal+4)
+  kappa      = tab_cntrl(idecal+5)
+  daysec     = tab_cntrl(idecal+6)
+  dtvr       = tab_cntrl(idecal+7)
+  etot0      = tab_cntrl(idecal+8)
+  ptot0      = tab_cntrl(idecal+9)
+  ztot0      = tab_cntrl(idecal+10)
+  stot0      = tab_cntrl(idecal+11)
+  ang0       = tab_cntrl(idecal+12)
+  pa         = tab_cntrl(idecal+13)
+  preff      = tab_cntrl(idecal+14)
+!
+  clon       = tab_cntrl(idecal+15)
+  clat       = tab_cntrl(idecal+16)
+  grossismx  = tab_cntrl(idecal+17)
+  grossismy  = tab_cntrl(idecal+18)
+!
+  IF ( tab_cntrl(idecal+19)==1. )  THEN
+    fxyhypb  = .TRUE.
+!   dzoomx   = tab_cntrl(25)
+!   dzoomy   = tab_cntrl(26)
+!   taux     = tab_cntrl(28)
+!   tauy     = tab_cntrl(29)
+  ELSE
+    fxyhypb = .FALSE.
+    ysinus  = tab_cntrl(idecal+22)==1.
+  END IF
+
+  day_ini    = tab_cntrl(30)
+  itau_dyn   = tab_cntrl(31)
+  start_time = tab_cntrl(32)
+
+!-------------------------------------------------------------------------------
+  WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
+  CALL check_dim(im,iim,'im','im')
+  CALL check_dim(jm,jjm,'jm','jm')
+  CALL check_dim(lllm,llm,'lm','lllm')
+  CALL get_var1("rlonu",rlonu)
+  CALL get_var1("rlatu",rlatu)
+  CALL get_var1("rlonv",rlonv)
+  CALL get_var1("rlatv",rlatv)
+  CALL get_var2("cu"   ,cu)
+  CALL get_var2("cv"   ,cv)
+  CALL get_var2("aire" ,aire)
+  var="temps"
+  IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN
+    WRITE(lunout,*)TRIM(modname)//": missing field <temps>"
+    WRITE(lunout,*)TRIM(modname)//": trying with <Time>"; var="Time"
+    CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
+  END IF
+  CALL err(NF90_GET_VAR(fID,vID,time),"get",var)
+  CALL get_var2("phisinit",phis)
+  CALL get_var3("ucov",ucov)
+  CALL get_var3("vcov",vcov)
+  CALL get_var3("teta",teta)
+  CALL get_var3("masse",masse)
+  CALL get_var2("ps",ps)
+
+!--- Tracers
+  DO iq=1,nqtot
+    var=tname(iq)
+    IF(NF90_INQ_VARID(fID,var,vID)==NF90_NoErr) THEN
+      CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var); CYCLE
+    END IF
+    WRITE(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing"
+    WRITE(lunout,*)"         It is hence initialized to zero"
+    q(:,:,:,iq)=0.
+   !--- CRisi: for isotops, theoretical initialization using very simplified
+   !           Rayleigh distillation las.
+    IF(ok_isotopes.AND.iso_num(iq)>0) THEN
+      IF(zone_num(iq)==0) q(:,:,:,iq)=q(:,:,:,iqpere(iq))*tnat(iso_num(iq))    &
+     &             *(q(:,:,:,iqpere(iq))/30.e-3)**(alpha_ideal(iso_num(iq))-1)
+      IF(zone_num(iq)==1) q(:,:,:,iq)=q(:,:,:,iqiso(iso_indnum(iq),phase_num(iq)))
+    END IF
+  END DO
+
+  CALL err(NF90_CLOSE(fID),"close",fichnom)
+  day_ini=day_ini+INT(time)
+  time=time-INT(time)
+
+
+  CONTAINS
+
+
+SUBROUTINE check_dim(n1,n2,str1,str2)
+  INTEGER,          INTENT(IN) :: n1, n2
+  CHARACTER(LEN=*), INTENT(IN) :: str1, str2
+  CHARACTER(LEN=256) :: s1, s2
+  IF(n1/=n2) THEN
+    s1='value of '//TRIM(str1)//' ='
+    s2=' read in starting file differs from parametrized '//TRIM(str2)//' ='
+    WRITE(msg,'(10x,a,i4,2x,a,i4)'),s1,n1,s2,n2
+    CALL ABORT_gcm(TRIM(modname),TRIM(msg),1)
+  END IF
+END SUBROUTINE check_dim
+
+
+SUBROUTINE get_var1(var,v)
+  CHARACTER(LEN=*), INTENT(IN)  :: var
+  REAL,             INTENT(OUT) :: v(:)
+  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
+  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
+END SUBROUTINE get_var1
+
+
+SUBROUTINE get_var2(var,v)
+  CHARACTER(LEN=*), INTENT(IN)  :: var
+  REAL,             INTENT(OUT) :: v(:,:)
+  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
+  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
+END SUBROUTINE get_var2
+
+
+SUBROUTINE get_var3(var,v)
+  CHARACTER(LEN=*), INTENT(IN)  :: var
+  REAL,             INTENT(OUT) :: v(:,:,:)
+  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
+  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
+END SUBROUTINE get_var3
+
+
+SUBROUTINE err(ierr,typ,nam)
+  INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
+  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
+  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
+  IF(ierr==NF90_NoERR) RETURN
+  SELECT CASE(typ)
+    CASE('inq');   msg="Field <"//TRIM(nam)//"> is missing"
+    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
+    CASE('open');  msg="File opening failed for <"//TRIM(nam)//">"
+    CASE('close'); msg="File closing failed for <"//TRIM(nam)//">"
+  END SELECT
+  CALL ABORT_gcm(TRIM(modname),TRIM(msg),ierr)
+END SUBROUTINE err
+
+END SUBROUTINE dynetat0
Index: LMDZ5/trunk/libf/dyn3d/dynredem.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3d/dynredem.F90	(revision 2298)
+++ LMDZ5/trunk/libf/dyn3d/dynredem.F90	(revision 2299)
@@ -8,8 +8,7 @@
 #endif
   USE infotrac
-  USE netcdf, ONLY:   NF90_CREATE, NF90_DEF_DIM, NF90_REDEF,  NF90_INQ_VARID, &
-      NF90_CLOBBER,   NF90_CLOSE,  NF90_DEF_VAR, NF90_ENDDEF, NF90_PUT_ATT,   &
-      NF90_UNLIMITED, NF90_GLOBAL, NF90_FLOAT,   NF90_DOUBLE
-  USE netcdf95, ONLY: NF95_PUT_VAR
+  USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL,    &
+                    NF90_CLOSE,  NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER
+  USE dynredem_mod, ONLY: cre_var, put_var1, put_var2, err, modname, fil
   IMPLICIT NONE
   include "dimensions.h"
@@ -21,5 +20,4 @@
   include "ener.h"
   include "logic.h"
-  include "netcdf.inc"
   include "description.h"
   include "serre.h"
@@ -35,5 +33,4 @@
   INTEGER, PARAMETER :: length=100
   REAL    :: tab_cntrl(length)                     !--- RUN PARAMETERS TABLE
-  CHARACTER(LEN=20) :: modname
 !   For NetCDF:
   CHARACTER(LEN=30) :: unites
@@ -42,7 +39,7 @@
   INTEGER :: sID, sigID, nID, vID, timID
   INTEGER :: yyears0, jjour0, mmois0
-  REAL :: zan0, zjulian, hours
-!===============================================================================
-  modname='dynredem0'
+  REAL    :: zan0, zjulian, hours
+!===============================================================================
+  modname='dynredem0'; fil=fichnom
 #ifdef CPP_IOIPSL
   CALL ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
@@ -102,5 +99,4 @@
 ! start_time: start_time of simulation (not necessarily 0.)
   tab_cntrl(32) = start_time
-!.........................................................
 
 !--- File creation
@@ -121,33 +117,32 @@
 
 !--- Define and save invariant fields
-  CALL put_var1("controle","Parametres de controle" ,[indexID],tab_cntrl)
-  CALL put_var1("rlonu"   ,"Longitudes des points U",[rlonuID],rlonu)
-  CALL put_var1("rlatu"   ,"Latitudes des points U" ,[rlatuID],rlatu)
-  CALL put_var1("rlonv"   ,"Longitudes des points V",[rlonvID],rlonv)
-  CALL put_var1("rlatv"   ,"Latitudes des points V" ,[rlatvID],rlatv)
-  CALL put_var1("nivsigs" ,"Numero naturel des couches s"    ,[sID]  ,nivsigs)
-  CALL put_var1("nivsig"  ,"Numero naturel des couches sigma",[sigID],nivsig)
-  CALL put_var1("ap"      ,"Coefficient A pour hybride"      ,[sigID],ap)
-  CALL put_var1("bp"      ,"Coefficient B pour hybride"      ,[sigID],bp)
-  CALL put_var1("presnivs",""                                ,[sID]  ,presnivs)
+  CALL put_var1(nid,"controle","Parametres de controle" ,[indexID],tab_cntrl)
+  CALL put_var1(nid,"rlonu"   ,"Longitudes des points U",[rlonuID],rlonu)
+  CALL put_var1(nid,"rlatu"   ,"Latitudes des points U" ,[rlatuID],rlatu)
+  CALL put_var1(nid,"rlonv"   ,"Longitudes des points V",[rlonvID],rlonv)
+  CALL put_var1(nid,"rlatv"   ,"Latitudes des points V" ,[rlatvID],rlatv)
+  CALL put_var1(nid,"nivsigs" ,"Numero naturel des couches s"    ,[sID]  ,nivsigs)
+  CALL put_var1(nid,"nivsig"  ,"Numero naturel des couches sigma",[sigID],nivsig)
+  CALL put_var1(nid,"ap"      ,"Coefficient A pour hybride"      ,[sigID],ap)
+  CALL put_var1(nid,"bp"      ,"Coefficient B pour hybride"      ,[sigID],bp)
+  CALL put_var1(nid,"presnivs",""                                ,[sID]  ,presnivs)
 ! covariant <-> contravariant <-> natural conversion coefficients
-  CALL put_var2("cu","Coefficient de passage pour U",[rlonuID,rlatuID],cu)
-  CALL put_var2("cv","Coefficient de passage pour V",[rlonvID,rlatvID],cv)
-  CALL put_var2("aire","Aires de chaque maille"     ,[rlonvID,rlatuID],aire)
-  CALL put_var2("phisinit","Geopotentiel au sol"    ,[rlonvID,rlatuID],phis)
+  CALL put_var2(nid,"cu","Coefficient de passage pour U",[rlonuID,rlatuID],cu)
+  CALL put_var2(nid,"cv","Coefficient de passage pour V",[rlonvID,rlatvID],cv)
+  CALL put_var2(nid,"aire","Aires de chaque maille"     ,[rlonvID,rlatuID],aire)
+  CALL put_var2(nid,"phisinit","Geopotentiel au sol"    ,[rlonvID,rlatuID],phis)
 
 !--- Define fields saved later
   WRITE(unites,"('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')"),&
                yyears0,mmois0,jjour0
-  CALL put_var0("temps","Temps de simulation",[timID],unites)
-  CALL put_var0("ucov" ,"Vitesse U"  ,[rlonuID,rlatuID,sID,timID])
-  CALL put_var0("vcov" ,"Vitesse V"  ,[rlonvID,rlatvID,sID,timID])
-  CALL put_var0("teta" ,"Temperature",[rlonvID,rlatuID,sID,timID])
+  CALL cre_var(nid,"temps","Temps de simulation",[timID],unites)
+  CALL cre_var(nid,"ucov" ,"Vitesse U"  ,[rlonuID,rlatuID,sID,timID])
+  CALL cre_var(nid,"vcov" ,"Vitesse V"  ,[rlonvID,rlatvID,sID,timID])
+  CALL cre_var(nid,"teta" ,"Temperature",[rlonvID,rlatuID,sID,timID])
   DO iq=1,nqtot
-    CALL put_var0(tname(iq),ttext(iq) ,[rlonvID,rlatuID,sID,timID])
+    CALL cre_var(nid,tname(iq),ttext(iq),[rlonvID,rlatuID,sID,timID])
   END DO
-  CALL put_var0("masse","Masse d air"    ,[rlonvID,rlatuID,sID,timID])
-  CALL put_var0("ps"   ,"Pression au sol",[rlonvID,rlatuID    ,timID])
-  CALL err(NF90_ENDDEF(nid))
+  CALL cre_var(nid,"masse","Masse d air"    ,[rlonvID,rlatuID,sID,timID])
+  CALL cre_var(nid,"ps"   ,"Pression au sol",[rlonvID,rlatuID    ,timID])
   CALL err(NF90_CLOSE (nid))
 
@@ -155,80 +150,4 @@
   WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
 
-
-CONTAINS
-
-
-SUBROUTINE put_var0(var,title,did,units)
-  CHARACTER(LEN=*),           INTENT(IN) :: var, title
-  INTEGER,                    INTENT(IN) :: did(:)
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
-#ifdef NC_DOUBLE
-  CALL err(NF90_DEF_VAR(nid,var,NF90_DOUBLE,did,vID),var)
-#else
-  CALL err(NF90_DEF_VAR(nid,var,NF90_FLOAT,did,vID),var)
-#endif
-  IF(title/="")      CALL err(NF90_PUT_ATT(nid,vID,"title",title),var)
-  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(nid,vID,"units",units),var)
-END SUBROUTINE put_var0
-
-
-SUBROUTINE put_var1(var,title,did,v,units)
-  CHARACTER(LEN=*),           INTENT(IN) :: var, title
-  INTEGER,                    INTENT(IN) :: did(1)
-#ifdef NC_DOUBLE
-  DOUBLE PRECISION,           INTENT(IN) :: v(:)
-#else
-  REAL,                       INTENT(IN) :: v(:)
-#endif
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
-#ifdef NC_DOUBLE
-  CALL err(NF90_DEF_VAR(nid,var,NF90_DOUBLE,did,vID),var)
-#else
-  CALL err(NF90_DEF_VAR(nid,var,NF90_FLOAT,did,vID),var)
-#endif
-  IF(title/="")      CALL err(NF90_PUT_ATT(nid,vID,"title",title),var)
-  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(nid,vID,"units",units),var)
-  CALL err(NF90_ENDDEF(nid))
-  CALL NF95_PUT_VAR(nid,vID,v)
-  CALL err(NF90_REDEF(nid))
-END SUBROUTINE put_var1
-
-
-SUBROUTINE put_var2(var,title,did,v,units)
-  CHARACTER(LEN=*),           INTENT(IN) :: var, title
-  INTEGER,                    INTENT(IN) :: did(2)
-#ifdef NC_DOUBLE
-  DOUBLE PRECISION,           INTENT(IN) :: v(:,:)
-#else
-  REAL,                       INTENT(IN) :: v(:,:)
-#endif
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
-#ifdef NC_DOUBLE
-  CALL err(NF90_DEF_VAR(nid,var,NF90_DOUBLE,did,vID),var)
-#else
-  CALL err(NF90_DEF_VAR(nid,var,NF90_FLOAT,did,vID),var)
-#endif
-  IF(title/="")      CALL err(NF90_PUT_ATT(nid,vID,"title",title),var)
-  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(nid,vID,"units",units),var)
-  CALL err(NF90_ENDDEF(nid))
-  CALL NF95_PUT_VAR(nid,vID,v)
-  CALL err(NF90_REDEF(nid))
-
-END SUBROUTINE put_var2
-
-
-SUBROUTINE err(ierr,var)
-  USE netcdf, ONLY: NF90_STRERROR, NF90_NOERR
-  IMPLICIT NONE
-  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: var    !--- VARIABLE NAME
-  CHARACTER(LEN=256) :: file, msg
-  IF(ierr==NF90_NoERR) RETURN
-  msg='Error in "'//TRIM(modname)//'" for file "'//TRIM(fichnom)//'"'
-  IF(PRESENT(var)) msg=TRIM(msg)//'" and variable "'//TRIM(var)//'"'
-  WRITE(lunout,*)TRIM(msg)//': '//NF90_STRERROR(ierr)
-
-END SUBROUTINE err
-
 END SUBROUTINE dynredem0
 !
@@ -245,186 +164,83 @@
   USE infotrac
   USE control_mod
-  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQ_VARID, NF90_NoErr,    &
-                      NF90_CLOSE, NF90_WRITE,   NF90_GET_VAR
-  USE netcdf95, ONLY: NF95_PUT_VAR
-  USE assert_eq_m, ONLY: assert_eq
+  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &
+                      NF90_CLOSE, NF90_WRITE,   NF90_PUT_VAR, NF90_NoErr
+  USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, &
+                          err, modname, fil, msg
   IMPLICIT NONE
-#include "dimensions.h"
-#include "paramet.h"
-#include "description.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "iniprint.h"
+  include "dimensions.h"
+  include "paramet.h"
+  include "description.h"
+  include "comvert.h"
+  include "comgeom.h"
+  include "temps.h"
+  include "iniprint.h"
 !===============================================================================
 ! Arguments:
-  CHARACTER(LEN=*), INTENT(IN) :: fichnom           !-- FILE NAME
-  REAL, INTENT(IN) ::  time                         !-- TIME
-  REAL, INTENT(IN) ::  vcov(iip1,jjm, llm)          !-- V COVARIANT WIND
-  REAL, INTENT(IN) ::  ucov(iip1,jjp1,llm)          !-- U COVARIANT WIND
-  REAL, INTENT(IN) ::  teta(iip1,jjp1,llm)          !-- POTENTIAL TEMPERATURE
-  REAL, INTENT(IN) ::     q(iip1,jjp1,llm,nqtot)    !-- TRACERS
-  REAL, INTENT(IN) :: masse(iip1,jjp1,llm)          !-- MASS PER CELL
-  REAL, INTENT(IN) ::    ps(iip1,jjp1)              !-- GROUND PRESSURE
+  CHARACTER(LEN=*), INTENT(IN) :: fichnom              !-- FILE NAME
+  REAL, INTENT(IN)    ::  time                         !-- TIME
+  REAL, INTENT(IN)    ::  vcov(iip1,jjm, llm)          !-- V COVARIANT WIND
+  REAL, INTENT(IN)    ::  ucov(iip1,jjp1,llm)          !-- U COVARIANT WIND
+  REAL, INTENT(IN)    ::  teta(iip1,jjp1,llm)          !-- POTENTIAL TEMPERATURE
+  REAL, INTENT(INOUT) ::     q(iip1,jjp1,llm,nqtot)    !-- TRACERS
+  REAL, INTENT(IN)    :: masse(iip1,jjp1,llm)          !-- MASS PER CELL
+  REAL, INTENT(IN)    ::    ps(iip1,jjp1)              !-- GROUND PRESSURE
 !===============================================================================
 ! Local variables:
-  INTEGER :: l, iq, nid, vID, nid_trac, vID_trac
+  INTEGER :: l, iq, nid, vID, ierr, nid_trac, vID_trac
   INTEGER, SAVE :: nb=0
   INTEGER, PARAMETER :: length=100
-#ifdef NC_DOUBLE
-  DOUBLE PRECISION   :: trac_tmp(ip1jmp1,llm)
-#else
-  REAL               :: trac_tmp(ip1jmp1,llm)
-#endif
   REAL               :: tab_cntrl(length) ! tableau des parametres du run
-  CHARACTER(LEN=256) :: modname, var, fil
-  LOGICAL            :: exist_file
-!===============================================================================
-  modname='dynredem1'
-  fil=fichnom
+  CHARACTER(LEN=256) :: var, dum
+  LOGICAL            :: lread_inca
+!===============================================================================
+
+  modname='dynredem1'; fil=fichnom
   CALL err(NF90_OPEN(fil,NF90_WRITE,nid),"open",fil)
 
 !--- Write/extend time coordinate
   nb = nb + 1
-  CALL sav_var1("temps",[time],nb)
+  var="temps"
+  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
+  CALL err(NF90_PUT_VAR(nid,vID,[time]),"put",var)
   WRITE(lunout,*)TRIM(modname)//": Saving for ", nb, time
 
 !--- Rewrite control table (itaufin undefined in dynredem0)
   var="controle"
-  CALL get_var1(var,tab_cntrl); tab_cntrl(31)=DBLE(itau_dyn + itaufin)
   CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
-  CALL NF95_PUT_VAR(nid,vID,tab_cntrl)
+  CALL err(NF90_GET_VAR(nid,vID,tab_cntrl),"get",var)
+  tab_cntrl(31)=DBLE(itau_dyn + itaufin)
+  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
+  CALL err(NF90_PUT_VAR(nid,vID,tab_cntrl),"put",var)
 
 !--- Save fields
-  CALL sav_var3("ucov",ucov)
-  CALL sav_var3("vcov",vcov)
-  CALL sav_var3("teta",teta)
-  CALL sav_var3("masse",masse)
-  CALL sav_var2("ps"   ,ps)
+  CALL dynredem_write_u(nid,"ucov" ,ucov ,llm)
+  CALL dynredem_write_v(nid,"vcov" ,vcov ,llm)
+  CALL dynredem_write_u(nid,"teta" ,teta ,llm)
+  CALL dynredem_write_u(nid,"masse",masse,llm)
+  CALL dynredem_write_u(nid,"ps"   ,ps   ,1)
 
 !--- Tracers in file "start_trac.nc" (added by Anne)
-  IF (type_trac == 'inca') THEN
-    fil="start_trac.nc"; INQUIRE(FILE=fil,EXIST=exist_file)
-    IF(.NOT.exist_file) CALL war(-1,"open",fil)
-  END IF
-  DO iq=1,nqtot; var=tname(iq)
-
-  !--- Usual case
-    IF(type_trac/='inca') THEN
-      CALL sav_var3(var,q(:,:,:,iq)); CYCLE
+  lread_inca=.FALSE.; fil="start_trac.nc"
+  IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca)
+  IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")
+
+!--- Save tracers
+  DO iq=1,nqtot; var=tname(iq); ierr=-1
+    IF(lread_inca) THEN                  !--- Possibly read from "start_trac.nc"
+      fil="start_trac.nc"
+      ierr=NF90_INQ_VARID(nid_trac,var,vID_trac)
+      dum='inq'; IF(ierr==NF90_NoErr) dum='fnd'
+      WRITE(lunout,*)msg(dum,var)
+
+
+      IF(ierr==NF90_NoErr) CALL dynredem_read_u(nid_trac,var,q(:,:,:,iq),llm)
     END IF
-
-  !--- Special case for INCA tracer read from "start_trac.nc"
-    IF(NF90_INQ_VARID(nid_trac,var,vID_trac)/=NF90_NoErr) THEN
-      CALL war(-1,"inq",var,fil)
-      CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var,fil)
-      CALL NF95_PUT_VAR(nid,vID,q(:,:,:,iq))
-    ELSE
-      WRITE(lunout,*)TRIM(modname)//": <"//TRIM(var)//"> found in "//fil
-      CALL err(NF90_GET_VAR(nid_trac,vID_trac,trac_tmp),"get",var,fil)
-    END IF
-    CALL sav_var3(var,RESHAPE(trac_tmp,SHAPE=[iip1,jjp1,llm]))
+    fil=fichnom
+    CALL dynredem_write_u(nid,var,q(:,:,:,iq),llm)
   END DO
-  CALL err(NF90_CLOSE(nid),"close",fichnom)
-
-
-CONTAINS
-
-
-SUBROUTINE get_var1(var,v)
-  CHARACTER(LEN=*), INTENT(IN) :: var
-  REAL,             INTENT(OUT) :: v(:)
-  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
-  CALL err(NF90_GET_VAR(nid,vID,v),"get",var)
-END SUBROUTINE get_var1
-
-
-SUBROUTINE sav_var1(var,v,start)
-  CHARACTER(LEN=*),  INTENT(IN) :: var
-#ifdef NC_DOUBLE
-  DOUBLE PRECISION,  INTENT(IN) :: v(:)
-#else
-  REAL,              INTENT(IN) :: v(:)
-#endif
-  INTEGER, OPTIONAL, INTENT(IN) :: start
-  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
-  IF(PRESENT(start)) THEN
-    CALL NF95_PUT_VAR(nid,vID,v,start=[start])
-  ELSE
-    CALL NF95_PUT_VAR(nid,vID,v)
-  END IF
-END SUBROUTINE sav_var1
-
-
-SUBROUTINE sav_var2(var,v)
-  CHARACTER(LEN=*), INTENT(IN) :: var
-#ifdef NC_DOUBLE
-  DOUBLE PRECISION, INTENT(IN) :: v(:,:)
-#else
-  REAL,             INTENT(IN) :: v(:,:)
-#endif
-  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
-  CALL NF95_PUT_VAR(nid,vID,v)
-END SUBROUTINE sav_var2
-
-
-SUBROUTINE sav_var3(var,v)
-  CHARACTER(LEN=*), INTENT(IN) :: var
-#ifdef NC_DOUBLE
-  DOUBLE PRECISION, INTENT(IN) :: v(:,:,:)
-#else
-  REAL,             INTENT(IN) :: v(:,:,:)
-#endif
-
-print*,'var='//TRIM(var)
-print*,SHAPE(v)
-  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
-  CALL NF95_PUT_VAR(nid,vID,v)
-END SUBROUTINE sav_var3
-
-
-FUNCTION msg(typ,nam,fil)
-  IMPLICIT NONE
-  CHARACTER(LEN=256)           :: msg    !--- STANDARDIZED MESSAGE
-  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
-  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD NAME
-  CHARACTER(LEN=*), INTENT(IN) :: fil    !--- FILE  NAME
-  SELECT CASE(typ)
-    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
-    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
-    CASE('open');  msg="Opening failed for <"//TRIM(nam)//">"
-    CASE('close'); msg="Closing failed for <"//TRIM(nam)//">"
-  END SELECT
-  msg=TRIM(modname)//": "//TRIM(msg)
-  IF(typ=="inq".AND.fil/="") msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
-
-END FUNCTION msg
-
-
-SUBROUTINE err(ierr,typ,nam,fil)
-  IMPLICIT NONE
-  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
-  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
-  CHARACTER(LEN=*),           INTENT(IN) :: nam    !--- FIELD NAME
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fil    !--- FILE  NAME
-  CHARACTER(LEN=256) :: file
-  IF(ierr==NF90_NoERR) RETURN
-  file=""; IF(PRESENT(fil)) file=fil
-  CALL ABORT_gcm(modname,msg(typ,nam,file),ierr)
-END SUBROUTINE err
-
-
-SUBROUTINE war(ierr,typ,nam,fil)
-  IMPLICIT NONE
-  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
-  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
-  CHARACTER(LEN=*),           INTENT(IN) :: nam    !--- FIELD NAME
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fil    !--- FILE  NAME
-  CHARACTER(LEN=256) :: file
-  IF(ierr==NF90_NoERR) RETURN
-  file=""; IF(PRESENT(fil)) file=fil
-  WRITE(lunout,*)msg(typ,nam,file)
-END SUBROUTINE war
-
+  CALL err(NF90_CLOSE(nid),"close")
+  fil="start_trac.nc"
+  IF(lread_inca) CALL err(NF90_CLOSE(nid_trac),"close")
 
 END SUBROUTINE dynredem1
Index: LMDZ5/trunk/libf/dyn3d/dynredem_mod.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3d/dynredem_mod.F90	(revision 2299)
+++ LMDZ5/trunk/libf/dyn3d/dynredem_mod.F90	(revision 2299)
@@ -0,0 +1,219 @@
+MODULE dynredem_mod
+
+  USE netcdf
+  PRIVATE
+  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
+  PUBLIC :: cre_var, get_var1, put_var1, put_var2, fil, modname, msg
+  include "dimensions.h"
+  include "paramet.h"
+  CHARACTER(LEN=256), SAVE :: fil, modname
+  INTEGER,            SAVE :: nvarid
+
+
+CONTAINS
+
+
+!===============================================================================
+!
+SUBROUTINE dynredem_write_u(ncid,id,var,ll)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,          INTENT(IN) :: ncid
+  CHARACTER(LEN=*), INTENT(IN) :: id
+  REAL,             INTENT(IN) :: var(iip1,jjp1,ll)
+  INTEGER,          INTENT(IN) :: ll
+!===============================================================================
+! Local variables:
+  INTEGER :: start(4), count(4)
+!===============================================================================
+  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1]
+  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
+  CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)
+  
+END SUBROUTINE dynredem_write_u
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE dynredem_write_v(ncid,id,var,ll)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,          INTENT(IN) :: ncid
+  CHARACTER(LEN=*), INTENT(IN) :: id
+  REAL,             INTENT(IN) :: var(iip1,jjm,ll)
+  INTEGER,          INTENT(IN) :: ll
+!===============================================================================
+! Local variables:
+  INTEGER :: start(4), count(4)
+!===============================================================================
+  start(:)=[1,1,1,1]; count(:)=[iip1,jjm,ll,1]
+  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
+  CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)
+  
+END SUBROUTINE dynredem_write_v
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE dynredem_read_u(ncid,id,var,ll)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,          INTENT(IN)  :: ncid
+  CHARACTER(LEN=*), INTENT(IN)  :: id
+  REAL,             INTENT(OUT) :: var(iip1,jjp1,ll)
+  INTEGER,          INTENT(IN)  :: ll
+!===============================================================================
+! Local variables:
+  INTEGER :: start(4), count(4)
+!===============================================================================
+  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1]
+  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
+  CALL err(NF90_GET_VAR(ncid,nvarid,var,start,count),"get",id)
+  
+END SUBROUTINE dynredem_read_u    
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE cre_var(ncid,var,title,did,units)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,                    INTENT(IN) :: ncid
+  CHARACTER(LEN=*),           INTENT(IN) :: var, title
+  INTEGER,                    INTENT(IN) :: did(:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
+!===============================================================================
+#ifdef NC_DOUBLE
+  CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var)
+#else
+  CALL err(NF90_DEF_VAR(ncid,var,NF90_FLOAT ,did,nvarid),"inq",var)
+#endif
+  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
+  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
+
+END SUBROUTINE cre_var
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE put_var1(ncid,var,title,did,v,units)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,                    INTENT(IN) :: ncid
+  CHARACTER(LEN=*),           INTENT(IN) :: var, title
+  INTEGER,                    INTENT(IN) :: did(1)
+  REAL,                       INTENT(IN) :: v(:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
+!===============================================================================
+  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
+  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
+  CALL err(NF90_ENDDEF(ncid))
+  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
+  CALL err(NF90_REDEF(ncid))
+
+END SUBROUTINE put_var1
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE put_var2(ncid,var,title,did,v,units)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,                    INTENT(IN) :: ncid
+  CHARACTER(LEN=*),           INTENT(IN) :: var, title
+  INTEGER,                    INTENT(IN) :: did(2)
+  REAL,                       INTENT(IN) :: v(:,:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
+!===============================================================================
+  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
+  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
+  CALL err(NF90_ENDDEF(ncid))
+  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
+  CALL err(NF90_REDEF(ncid))
+
+END SUBROUTINE put_var2
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+FUNCTION msg(typ,nam)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  CHARACTER(LEN=256)                     :: msg    !--- STANDARDIZED MESSAGE
+  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
+!===============================================================================
+  SELECT CASE(typ)
+    CASE('open');  msg="Opening failed for <"//TRIM(fil)//">"
+    CASE('close'); msg="Closing failed for <"//TRIM(fil)//">"
+    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
+    CASE('put');   msg="Writting failed for <"//TRIM(nam)//">"
+    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
+    CASE('fnd');   msg="Found field <"//TRIM(nam)//">"
+  END SELECT
+  msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
+
+END FUNCTION msg
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE err(ierr,typ,nam)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
+!===============================================================================
+  IF(ierr==NF90_NoERR) RETURN
+  IF(.NOT.PRESENT(typ)) THEN
+    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
+  ELSE
+    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
+  END IF
+
+END SUBROUTINE err
+!
+!===============================================================================
+
+END MODULE dynredem_mod   
+    
+    
Index: LMDZ5/trunk/libf/dyn3d/etat0dyn_netcdf.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3d/etat0dyn_netcdf.F90	(revision 2298)
+++ LMDZ5/trunk/libf/dyn3d/etat0dyn_netcdf.F90	(revision 2299)
@@ -12,5 +12,5 @@
 !  routine (to be called after restget):
 !    CALL startget_dyn3d(varname, lon_in,  lat_in, pls, workvar,&
-!                 champ, val_exp, lon_in2, lat_in2, ibar)
+!                          champ, lon_in2, lat_in2, ibar)
 !
 !    *  Variables should have the following names in the NetCDF files:
@@ -87,5 +87,4 @@
   USE infotrac
   USE filtreg_mod
-!#endif
   IMPLICIT NONE
 !-------------------------------------------------------------------------------
@@ -120,5 +119,4 @@
 !*******************************************************************************
   CALL infotrac_init
-  ALLOCATE(q3d(iip1,jjp1,llm,nqtot))
   CALL inifilr()
 
@@ -154,12 +152,11 @@
 ! Update uvent, vvent, t3d and tpot
 !*******************************************************************************
-  uvent(:,:,:) = 0.0 ; t3d (:,:,:) = 0.0
-  vvent(:,:,:) = 0.0 ; tpot(:,:,:) = 0.0
-  CALL startget_dyn3d('u'   ,rlonu,rlatu,pls,y ,uvent,0.0,rlonv,rlatv,ib)
-  CALL startget_dyn3d('v'   ,rlonv,rlatv,pls(:,:jjm,:),y(:,:jjm,:),vvent,0.0,  &
+  uvent(:,:,:) = 0.0 ; vvent(:,:,:) = 0.0 ; t3d (:,:,:) = 0.0
+  CALL startget_dyn3d('u'   ,rlonu,rlatu,pls,y ,uvent,rlonv,rlatv,ib)
+  CALL startget_dyn3d('v'   ,rlonv,rlatv,pls(:,:jjm,:),y(:,:jjm,:),vvent,      &
  &                           rlonu,rlatu(:jjm),ib)
-  CALL startget_dyn3d('t'   ,rlonv,rlatu,pls,y ,t3d ,0.0,rlonu,rlatv,ib)
-  tpot=t3d
-  CALL startget_dyn3d('tpot',rlonv,rlatu,pls,pk,tpot,0.0,rlonu,rlatv,ib)
+  CALL startget_dyn3d('t'   ,rlonv,rlatu,pls,y ,t3d ,rlonu,rlatv,ib)
+  tpot(:,:,:)=t3d(:,:,:)
+  CALL startget_dyn3d('tpot',rlonv,rlatu,pls,pk,tpot,rlonu,rlatv,ib)
 
   WRITE(lunout,*) 'T3D min,max:',MINVAL(t3d(:,:,:)),MAXVAL(t3d(:,:,:))
@@ -174,10 +171,10 @@
 !  WRITE(lunout,*) 'QSAT :',qsat(10,20,:)
   qd (:,:,:) = 0.0
-  CALL startget_dyn3d('q',rlonv,rlatu,pls,qsat,qd,0.0,rlonu,rlatv,ib)
-  q3d(:,:,:,:) = 0.0 ; q3d(:,:,:,1) = qd(:,:,:)
-
+  CALL startget_dyn3d('q',rlonv,rlatu,pls,qsat,qd,rlonu,rlatv,ib)
+  ALLOCATE(q3d(iip1,jjp1,llm,nqtot)); q3d(:,:,:,:)=0.0 ; q3d(:,:,:,1)=qd(:,:,:)
   CALL flinclo(fid_dyn)
 
 #ifdef CPP_PHYS
+#ifdef CPP_EARTH
 ! Parameterization of ozone chemistry:
 !*******************************************************************************
@@ -190,5 +187,8 @@
     q3d(:,:,:,i)=q3d(:,:,:,i)*48./ 29.                  !--- Mole->mass fraction         
   END IF
+
 #endif
+#endif
+  q3d(iip1,:,:,:)=q3d(1,:,:,:)
 
 ! Intermediate computation
@@ -204,5 +204,4 @@
     masse(:,jjp1,l)=xps
   END DO
-  q3d(iip1,:,:,:)=q3d(1,:,:,:)
 
 ! Writing
@@ -234,5 +233,5 @@
 
 !#endif 
-!#endif of #ifdef CPP_EARTH
+! of ifdef CPP_EARTH
 
 END SUBROUTINE etat0dyn_netcdf
@@ -244,6 +243,6 @@
 !-------------------------------------------------------------------------------
 !
-SUBROUTINE startget_dyn3d(var,  lon_in,  lat_in,  pls,  workvar,&
-                champ, val_exp, lon_in2, lat_in2, ibar)
+SUBROUTINE startget_dyn3d(var, lon_in,  lat_in,  pls,  workvar,&
+                        champ, lon_in2, lat_in2, ibar)
 !-------------------------------------------------------------------------------
   IMPLICIT NONE
@@ -253,6 +252,6 @@
 !-------------------------------------------------------------------------------
 ! Note: An input auxilliary field "workvar" has to be specified in two cases:
-!     * for "q":     the saturated humidity.
-!     * for "topot": the Exner function.
+!     * for "q":    the saturated humidity.
+!     * for "tpot": the Exner function.
 !===============================================================================
 ! Arguments:
@@ -263,5 +262,4 @@
   REAL,             INTENT(IN)    :: workvar(:, :, :) ! dim (iml, jml, lml)
   REAL,             INTENT(INOUT) :: champ  (:, :, :) ! dim (iml, jml, lml)
-  REAL,             INTENT(IN)    :: val_exp
   REAL,             INTENT(IN)    :: lon_in2(:)       ! dim (iml)
   REAL,             INTENT(IN)    :: lat_in2(:)       ! dim (jml2)
@@ -274,55 +272,53 @@
   REAL               :: xppn, xpps
 !-------------------------------------------------------------------------------
-  IF(MINVAL(champ)==MAXVAL(champ).AND.MINVAL(champ)==val_exp) THEN
-    iml = assert_eq([SIZE(lon_in),SIZE(pls,1),SIZE(workvar,1),SIZE(champ,1),  &
-     &               SIZE(lon_in2)],TRIM(modname)//" iml")
-    jml = assert_eq( SIZE(lat_in),SIZE(pls,2),SIZE(workvar,2),SIZE(champ,2),  &
-     &                              TRIM(modname)//" jml")
-    lml = assert_eq(              SIZE(pls,3),SIZE(workvar,3),SIZE(champ,3),  &
-     &                              TRIM(modname)//" lml")
-    jml2 = SIZE(lat_in2)
-
-  !--- CHECK IF THE FIELD IS KNOWN
-    SELECT CASE(var)
-      CASE('u');    vname='U'
-      CASE('v');    vname='V'
-      CASE('t');    vname='TEMP'
-      CASE('q');    vname='R';    msg='humidity as the saturated humidity'
-      CASE('tpot'); vname='TEMP'; msg='potential temperature as the Exner function'
-      CASE DEFAULT;               msg='No rule to extract variable '//TRIM(var)
-        CALL abort_gcm(modname,TRIM(msg)//' from any data set',1)
-    END SELECT
-
-  !--- CHECK IF SOMETHING IS MISSING
-    IF((var=='tpot'.OR.var=='q').AND.MINVAL(workvar)==MAXVAL(workvar)) THEN
-      msg='Could not compute '//TRIM(msg)//' is missing or constant.'
-      CALL abort_gcm(modname,TRIM(msg),1)
-    END IF
-
-  !--- INTERPOLATE 3D FIELD IF NEEDED
-    IF(var/='tpot') CALL start_inter_3d(TRIM(vname),lon_in,lat_in,lon_in2,    &
-                                                    lat_in2,pls,champ,ibar)
-
-  !--- COMPUTE THE REQUIRED FILED
-    SELECT CASE(var)
-      CASE('u'); DO il=1,lml; champ(:,:,il)=champ(:,:,il)*cu(:,1:jml); END DO
-        champ(iml,:,:)=champ(1,:,:)                        !--- Eastward wind
-
-      CASE('v'); DO il=1,lml; champ(:,:,il)=champ(:,:,il)*cv(:,1:jml); END DO
-        champ(iml,:,:)=champ(1,:,:)                        !--- Northward wind
-
-      CASE('tpot','q')
-        IF(var=='tpot') THEN; champ=champ*cpp/workvar      !--- Temperature
-        ELSE;                 champ=champ*.01*workvar      !--- Relat. humidity
-          WHERE(champ<0.) champ=1.0E-10
-        END IF
-        DO il=1,lml
-          xppn = SUM(aire(:,1  )*champ(:,1  ,il))/apoln
-          xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
-          champ(:,1  ,il) = xppn
-          champ(:,jml,il) = xpps
-        END DO
-    END SELECT
+  iml=assert_eq([SIZE(lon_in),SIZE(pls,1),SIZE(workvar,1),SIZE(champ,1),       &
+     &                                    SIZE(lon_in2)], TRIM(modname)//" iml")
+  jml=assert_eq( SIZE(lat_in),SIZE(pls,2),SIZE(workvar,2),SIZE(champ,2),       &
+     &                                                    TRIM(modname)//" jml")
+  lml=assert_eq(              SIZE(pls,3),SIZE(workvar,3),SIZE(champ,3),       &
+     &                                                    TRIM(modname)//" lml")
+  jml2=SIZE(lat_in2)
+
+!--- CHECK IF THE FIELD IS KNOWN
+   SELECT CASE(var)
+    CASE('u');    vname='U'
+    CASE('v');    vname='V'
+    CASE('t');    vname='TEMP'
+    CASE('q');    vname='R';    msg='humidity as the saturated humidity'
+    CASE('tpot'); msg='potential temperature as the Exner function'
+    CASE DEFAULT; msg='No rule to extract variable '//TRIM(var)
+      CALL abort_gcm(modname,TRIM(msg)//' from any data set',1)
+  END SELECT
+
+!--- CHECK IF SOMETHING IS MISSING
+  IF((var=='tpot'.OR.var=='q').AND.MINVAL(workvar)==MAXVAL(workvar)) THEN
+    msg='Could not compute '//TRIM(msg)//' is missing or constant.'
+    CALL abort_gcm(modname,TRIM(msg),1)
   END IF
+
+!--- INTERPOLATE 3D FIELD IF NEEDED
+  IF(var/='tpot') CALL start_inter_3d(TRIM(vname),lon_in,lat_in,lon_in2,      &
+                                                  lat_in2,pls,champ,ibar)
+
+!--- COMPUTE THE REQUIRED FILED
+  SELECT CASE(var)
+    CASE('u'); DO il=1,lml; champ(:,:,il)=champ(:,:,il)*cu(:,1:jml); END DO
+      champ(iml,:,:)=champ(1,:,:)                   !--- Eastward wind
+
+    CASE('v'); DO il=1,lml; champ(:,:,il)=champ(:,:,il)*cv(:,1:jml); END DO
+      champ(iml,:,:)=champ(1,:,:)                   !--- Northward wind
+
+    CASE('tpot','q')
+      IF(var=='tpot') THEN; champ=champ*cpp/workvar !--- Potential temperature
+      ELSE;                 champ=champ*.01*workvar !--- Relative humidity
+        WHERE(champ<0.) champ=1.0E-10
+      END IF
+      DO il=1,lml
+        xppn = SUM(aire(:,1  )*champ(:,1  ,il))/apoln
+        xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
+        champ(:,1  ,il) = xppn
+        champ(:,jml,il) = xpps
+      END DO
+  END SELECT
 
 END SUBROUTINE startget_dyn3d
@@ -768,5 +764,5 @@
 
 !#endif
-! of #ifdef CPP_EARTH
+! of ifdef CPP_EARTH
 
 END MODULE etat0dyn
Index: LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.F	(revision 2298)
+++ 	(revision )
@@ -1,457 +1,0 @@
-!
-! $Id$
-!
-      SUBROUTINE dynetat0_loc(fichnom,vcov,ucov,
-     .                    teta,q,masse,ps,phis,time)
-      USE infotrac
-      use control_mod, only : planet_type
-      USE parallel_lmdz
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteur:  P. Le Van / L.Fairhead
-c   -------
-c
-c   objet:
-c   ------
-c
-c   Lecture de l'etat initial
-c
-c=======================================================================
-c-----------------------------------------------------------------------
-c   Declarations:
-c   -------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "temps.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "ener.h"
-#include "netcdf.inc"
-#include "description.h"
-#include "serre.h"
-#include "logic.h"
-#include "iniprint.h"
-
-c   Arguments:
-c   ----------
-
-      CHARACTER*(*) fichnom
-      REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
-      REAL teta(ijb_u:ije_u,llm)
-      REAL q(ijb_u:ije_u,llm,nqtot),masse(ijb_u:ije_u,llm)
-      REAL ps(ijb_u:ije_u),phis(ijb_u:ije_u)
-
-      REAL time
-
-c   Variables 
-c
-      INTEGER length,iq
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      INTEGER ierr, nid, nvarid
-      REAL,ALLOCATABLE :: vcov_glo(:,:),ucov_glo(:,:),teta_glo(:,:)
-      REAL,ALLOCATABLE :: q_glo(:,:),masse_glo(:,:),ps_glo(:)
-      REAL,ALLOCATABLE :: phis_glo(:)
-
-      INTEGER idecal
-
-c-----------------------------------------------------------------------
-c  Ouverture NetCDF du fichier etat initial
-
-      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
-      IF (ierr.NE.NF_NOERR) THEN
-        write(lunout,*)
-     &  'dynetat0_loc: Pb d''ouverture du fichier start.nc'
-        write(lunout,*)' ierr = ', ierr
-        CALL ABORT_GCM("DYNETAT0", "", 1)
-      ENDIF
-
-c
-      ierr = NF_INQ_VARID (nid, "controle", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <controle> est absent"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echoue pour <controle>"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-
-      !!! AS: idecal is a hack to be able to read planeto starts...
-      !!!     .... while keeping everything OK for LMDZ EARTH
-      if (planet_type.eq."generic") then
-          print*,'NOTE NOTE NOTE : Planeto-like start files'
-          idecal = 4
-          annee_ref  = 2000
-      else
-          print*,'NOTE NOTE NOTE : Earth-like start files'
-          idecal = 5
-          annee_ref  = tab_cntrl(5)
-      endif
-
-
-      im         = tab_cntrl(1)
-      jm         = tab_cntrl(2)
-      lllm       = tab_cntrl(3)
-      day_ref    = tab_cntrl(4)
-      rad        = tab_cntrl(idecal+1)
-      omeg       = tab_cntrl(idecal+2)
-      g          = tab_cntrl(idecal+3)
-      cpp        = tab_cntrl(idecal+4)
-      kappa      = tab_cntrl(idecal+5)
-      daysec     = tab_cntrl(idecal+6)
-      dtvr       = tab_cntrl(idecal+7)
-      etot0      = tab_cntrl(idecal+8)
-      ptot0      = tab_cntrl(idecal+9)
-      ztot0      = tab_cntrl(idecal+10)
-      stot0      = tab_cntrl(idecal+11)
-      ang0       = tab_cntrl(idecal+12)
-      pa         = tab_cntrl(idecal+13)
-      preff      = tab_cntrl(idecal+14)
-c
-      clon       = tab_cntrl(idecal+15)
-      clat       = tab_cntrl(idecal+16)
-      grossismx  = tab_cntrl(idecal+17)
-      grossismy  = tab_cntrl(idecal+18)
-c
-      IF ( tab_cntrl(idecal+19).EQ.1. )  THEN
-        fxyhypb  = . TRUE .
-c        dzoomx   = tab_cntrl(25)
-c        dzoomy   = tab_cntrl(26)
-c        taux     = tab_cntrl(28)
-c        tauy     = tab_cntrl(29)
-      ELSE
-        fxyhypb = . FALSE .
-        ysinus  = . FALSE .
-        IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE. 
-      ENDIF
-
-      day_ini = tab_cntrl(30)
-      itau_dyn = tab_cntrl(31)
-c   .................................................................
-c
-c
-      write(lunout,*)'dynetat0_loc: rad,omeg,g,cpp,kappa',
-     &               rad,omeg,g,cpp,kappa
-
-      IF(   im.ne.iim           )  THEN
-          PRINT 1,im,iim
-          STOP
-      ELSE  IF( jm.ne.jjm       )  THEN
-          PRINT 2,jm,jjm
-          STOP
-      ELSE  IF( lllm.ne.llm     )  THEN
-          PRINT 3,lllm,llm
-          STOP
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <rlonu> est absent"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonu>"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <rlatu> est absent"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlatu>"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <rlonv> est absent"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonv>"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <rlatv> est absent"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echouee pour rlatv"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "cu", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <cu> est absent"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echouee pour <cu>"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "cv", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <cv> est absent"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echouee pour <cv>"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "aire", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <aire> est absent"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echouee pour <aire>"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-      
-      ALLOCATE(phis_glo(ip1jmp1))
-      
-      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <phisinit> est absent"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis_glo)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, phis_glo)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echouee pour <phisinit>"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-      phis(ijb_u:ije_u)=phis_glo(ijb_u:ije_u)
-      DEALLOCATE(phis_glo)
-
-      ierr = NF_INQ_VARID (nid, "temps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <temps> est absent"
-         write(lunout,*)"dynetat0: J essaie <Time>"
-         ierr = NF_INQ_VARID (nid, "Time", nvarid)
-         IF (ierr .NE. NF_NOERR) THEN
-            write(lunout,*)"dynetat0: Le champ <Time> est absent"
-            CALL abort_gcm("dynetat0", "", 1)
-         ENDIF
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, time)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echouee <temps>"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <ucov> est absent"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-      
-      ALLOCATE(ucov_glo(ip1jmp1,llm))
-      
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov_glo)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, ucov_glo)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echouee pour <ucov>"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ucov(ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:)
-      DEALLOCATE(ucov_glo)
-      ALLOCATE(vcov_glo(ip1jm,llm))
-      
-      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <vcov> est absent"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov_glo)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, vcov_glo)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echouee pour <vcov>"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-      vcov(ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:)
-      DEALLOCATE(vcov_glo)
-      ALLOCATE(teta_glo(ip1jmp1,llm))
-
-      ierr = NF_INQ_VARID (nid, "teta", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <teta> est absent"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta_glo)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, teta_glo)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echouee pour <teta>"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-
-      teta(ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:)
-      DEALLOCATE(teta_glo)
-      ALLOCATE(q_glo(ip1jmp1,llm))
-
-
-      DO iq=1,nqtot
-        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
-        IF (ierr .NE. NF_NOERR) THEN
-           write(lunout,*)"dynetat0_loc: Le traceur <"                  &
-     &     //trim(tname(iq))//"> est absent"
-           write(lunout,*)"Il est donc initialise a zero"
-           q(:,:,iq)=0.
-
-           ! CRisi: pour les isotopes, on peut faire init théorique
-           ! distill de Rayleigh très simplifiée
-           if (ok_isotopes) then
-              if ((iso_num(iq).gt.0).and.(zone_num(iq).eq.0)) then
-                q(:,:,iq)=q(:,:,iqpere(iq))                             &
-     &                   *tnat(iso_num(iq))                             &
-     &                   *(q(:,:,iqpere(iq))/30.e-3)                    &
-     &                   **(alpha_ideal(iso_num(iq))-1)
-              endif
-              if ((iso_num(iq).gt.0).and.(zone_num(iq).eq.1)) then
-                  q(:,:,iq)=q(:,:,iqiso(iso_indnum(iq),phase_num(iq)))
-              endif  
-           endif !if (ok_isotopes) then        
-
-        ELSE
-#ifdef NC_DOUBLE
-          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_glo)
-#else
-          ierr = NF_GET_VAR_REAL(nid, nvarid, q_glo)
-#endif
-          IF (ierr .NE. NF_NOERR) THEN
-            write(lunout,*)
-     &      "dynetat0_loc: Lecture echouee pour "//tname(iq)
-            CALL abort_gcm("dynetat0", "", 1)
-          ENDIF
-        q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
-
-        ENDIF
-      ENDDO !DO iq=1,nqtot
-
-      if (ok_iso_verif) then
-         call check_isotopes(q,ijb_u,ije_u,'dynetat0_loc')
-      endif !if (ok_iso_verif) then
-
-      DEALLOCATE(q_glo)
-      ALLOCATE(masse_glo(ip1jmp1,llm))
-
-      ierr = NF_INQ_VARID (nid, "masse", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <masse> est absent"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse_glo)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, masse_glo)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echouee pour <masse>"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-      masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:)
-      DEALLOCATE(masse_glo)
-      ALLOCATE(ps_glo(ip1jmp1))
-
-      ierr = NF_INQ_VARID (nid, "ps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <ps> est absent"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps_glo)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, ps_glo)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Lecture echouee pour <ps>"
-         CALL abort_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ps(ijb_u:ije_u)=ps_glo(ijb_u:ije_u)
-      DEALLOCATE(ps_glo)
-
-      ierr = NF_CLOSE(nid)
-
-       day_ini=day_ini+INT(time)
-       time=time-INT(time)
-
-  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
-     *arrage est differente de la valeur parametree iim =',i4//)
-   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
-     *arrage est differente de la valeur parametree jjm =',i4//)
-   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
-     *rrage est differente de la valeur parametree llm =',i4//)
-   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
-     *rrage est differente de la valeur  dtinteg =',i4//)
-
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.f90
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.f90	(revision 2299)
+++ LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.f90	(revision 2299)
@@ -0,0 +1,241 @@
+SUBROUTINE dynetat0_loc(fichnom,vcov,ucov,teta,q,masse,ps,phis,time)
+!
+!-------------------------------------------------------------------------------
+! Authors: P. Le Van , L.Fairhead
+!-------------------------------------------------------------------------------
+! Purpose: Initial state reading.
+!-------------------------------------------------------------------------------
+  USE parallel_lmdz
+  USE infotrac
+  USE netcdf, ONLY: NF90_OPEN,  NF90_INQUIRE_DIMENSION, NF90_INQ_VARID,        &
+      NF90_NOWRITE, NF90_CLOSE, NF90_INQUIRE_VARIABLE,  NF90_GET_VAR, NF90_NoErr
+  USE control_mod, ONLY: planet_type
+  USE assert_eq_m, ONLY: assert_eq
+  IMPLICIT NONE
+  include "dimensions.h"
+  include "paramet.h"
+  include "temps.h"
+  include "comconst.h"
+  include "comvert.h"
+  include "comgeom.h"
+  include "ener.h"
+  include "description.h"
+  include "serre.h"
+  include "logic.h"
+  include "iniprint.h"
+!===============================================================================
+! Arguments:
+  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
+  REAL, INTENT(OUT) ::  vcov(ijb_v:ije_v,llm)      !--- V COVARIANT WIND
+  REAL, INTENT(OUT) ::  ucov(ijb_u:ije_u,llm)      !--- U COVARIANT WIND
+  REAL, INTENT(OUT) ::  teta(ijb_u:ije_u,llm)      !--- POTENTIAL TEMP.
+  REAL, INTENT(OUT) ::     q(ijb_u:ije_u,llm,nqtot)!--- TRACERS
+  REAL, INTENT(OUT) :: masse(ijb_u:ije_u,llm)      !--- MASS PER CELL
+  REAL, INTENT(OUT) ::    ps(ijb_u:ije_u)          !--- GROUND PRESSURE
+  REAL, INTENT(OUT) ::  phis(ijb_u:ije_u)          !--- GEOPOTENTIAL
+!===============================================================================
+! Local variables:
+  CHARACTER(LEN=256) :: msg, var, modname
+  INTEGER, PARAMETER :: length=100
+  INTEGER :: iq, fID, vID, idecal, ierr
+  REAL    :: time, tab_cntrl(length)               !--- RUN PARAMS TABLE
+  REAL,             ALLOCATABLE :: vcov_glo(:,:),masse_glo(:,:),   ps_glo(:)
+  REAL,             ALLOCATABLE :: ucov_glo(:,:),    q_glo(:,:), phis_glo(:)
+  REAL,             ALLOCATABLE :: teta_glo(:,:)
+!-------------------------------------------------------------------------------
+  modname="dynetat0_loc"
+
+!--- Initial state file opening
+  var=fichnom
+  CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var)
+  CALL get_var1("controle",tab_cntrl)
+
+!!! AS: idecal is a hack to be able to read planeto starts...
+!!!     .... while keeping everything OK for LMDZ EARTH
+  IF(planet_type=="generic") THEN
+    WRITE(lunout,*)'NOTE NOTE NOTE : Planeto-like start files'
+    idecal = 4
+    annee_ref  = 2000
+  ELSE
+    WRITE(lunout,*)'NOTE NOTE NOTE : Earth-like start files'
+    idecal = 5
+    annee_ref  = tab_cntrl(5)
+  END IF
+  im         = tab_cntrl(1)
+  jm         = tab_cntrl(2)
+  lllm       = tab_cntrl(3)
+  day_ref    = tab_cntrl(4)
+  rad        = tab_cntrl(idecal+1)
+  omeg       = tab_cntrl(idecal+2)
+  g          = tab_cntrl(idecal+3)
+  cpp        = tab_cntrl(idecal+4)
+  kappa      = tab_cntrl(idecal+5)
+  daysec     = tab_cntrl(idecal+6)
+  dtvr       = tab_cntrl(idecal+7)
+  etot0      = tab_cntrl(idecal+8)
+  ptot0      = tab_cntrl(idecal+9)
+  ztot0      = tab_cntrl(idecal+10)
+  stot0      = tab_cntrl(idecal+11)
+  ang0       = tab_cntrl(idecal+12)
+  pa         = tab_cntrl(idecal+13)
+  preff      = tab_cntrl(idecal+14)
+!
+  clon       = tab_cntrl(idecal+15)
+  clat       = tab_cntrl(idecal+16)
+  grossismx  = tab_cntrl(idecal+17)
+  grossismy  = tab_cntrl(idecal+18)
+!
+  IF ( tab_cntrl(idecal+19)==1. )  THEN
+    fxyhypb  = .TRUE.
+!   dzoomx   = tab_cntrl(25)
+!   dzoomy   = tab_cntrl(26)
+!   taux     = tab_cntrl(28)
+!   tauy     = tab_cntrl(29)
+  ELSE
+    fxyhypb = .FALSE.
+    ysinus  = tab_cntrl(idecal+22)==1.
+  END IF
+
+  day_ini    = tab_cntrl(30)
+  itau_dyn   = tab_cntrl(31)
+!  start_time = tab_cntrl(32)   ????
+
+!-------------------------------------------------------------------------------
+  WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
+  CALL check_dim(im,iim,'im','im')
+  CALL check_dim(jm,jjm,'jm','jm')
+  CALL check_dim(lllm,llm,'lm','lllm')
+  CALL get_var1("rlonu",rlonu)
+  CALL get_var1("rlatu",rlatu)
+  CALL get_var1("rlonv",rlonv)
+  CALL get_var1("rlatv",rlatv)
+  CALL get_var1("cu"  ,cu)
+  CALL get_var1("cv"  ,cv)
+  CALL get_var1("aire",aire)
+
+  var="temps"
+  IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN
+    WRITE(lunout,*)TRIM(modname)//": missing field <temps>"
+    WRITE(lunout,*)TRIM(modname)//": trying with <Time>"; var="Time"
+    CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
+  END IF
+  CALL err(NF90_GET_VAR(fID,vID,time),"get",var)
+
+  ALLOCATE(phis_glo(ip1jmp1))
+  CALL get_var1("phisinit",phis_glo)
+  phis (ijb_u:ije_u)  =phis_glo(ijb_u:ije_u);    DEALLOCATE(phis_glo)
+
+  ALLOCATE(ucov_glo(ip1jmp1,llm))
+  CALL get_var2("ucov",ucov_glo)
+  ucov (ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:);  DEALLOCATE(ucov_glo)
+
+  ALLOCATE(vcov_glo(ip1jm,llm))
+  CALL get_var2("vcov",vcov_glo)
+  vcov (ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:);  DEALLOCATE(vcov_glo)
+
+  ALLOCATE(teta_glo(ip1jmp1,llm))
+  CALL get_var2("teta",teta_glo)
+  teta (ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:);  DEALLOCATE(teta_glo)
+
+  ALLOCATE(masse_glo(ip1jmp1,llm))
+  CALL get_var2("masse",masse_glo)
+  masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:); DEALLOCATE(masse_glo)
+  
+  ALLOCATE(ps_glo(ip1jmp1))
+  CALL get_var1("ps",ps_glo)
+  ps   (ijb_u:ije_u)  =   ps_glo(ijb_u:ije_u);   DEALLOCATE(ps_glo)
+
+!--- Tracers
+  ALLOCATE(q_glo(ip1jmp1,llm))
+  DO iq=1,nqtot
+    var=tname(iq)
+    IF(NF90_INQ_VARID(fID,var,vID)==NF90_NoErr) THEN
+      CALL get_var2(var,q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:); CYCLE
+    END IF
+    WRITE(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing"
+    WRITE(lunout,*)"         It is hence initialized to zero"
+    q(ijb_u:ije_u,:,iq)=0.
+   !--- CRisi: for isotops, theoretical initialization using very simplified
+   !           Rayleigh distillation las.
+    IF(ok_isotopes.AND.iso_num(iq)>0) THEN
+      IF(zone_num(iq)==0) q(:,:,iq)=q(:,:,iqpere(iq))*tnat(iso_num(iq))        &
+     &           *(q(:,:,iqpere(iq))/30.e-3)**(alpha_ideal(iso_num(iq))-1)
+      IF(zone_num(iq)==1) q(:,:,iq)=q(:,:,iqiso(iso_indnum(iq),phase_num(iq)))
+    END IF
+  END DO
+  DEALLOCATE(q_glo)
+  CALL err(NF90_CLOSE(fID),"close",fichnom)
+  day_ini=day_ini+INT(time)
+  time=time-INT(time)
+
+
+  CONTAINS
+
+
+SUBROUTINE check_dim(n1,n2,str1,str2)
+  INTEGER,          INTENT(IN) :: n1, n2
+  CHARACTER(LEN=*), INTENT(IN) :: str1, str2
+  CHARACTER(LEN=256) :: s1, s2
+  IF(n1/=n2) THEN
+    s1='value of '//TRIM(str1)//' ='
+    s2=' read in starting file differs from parametrized '//TRIM(str2)//' ='
+    WRITE(msg,'(10x,a,i4,2x,a,i4)'),s1,n1,s2,n2
+    CALL ABORT_gcm(TRIM(modname),TRIM(msg),1)
+  END IF
+END SUBROUTINE check_dim
+
+
+SUBROUTINE get_var1(var,v)
+  CHARACTER(LEN=*), INTENT(IN)  :: var
+  REAL,             INTENT(OUT) :: v(:)
+  REAL,             ALLOCATABLE :: w2(:,:), w3(:,:,:)
+  INTEGER :: nn(3), dids(3), k, nd, ntot
+
+  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
+  ierr=NF90_INQUIRE_VARIABLE(fID,vID,ndims=nd)
+  IF(nd==1) THEN
+    CALL err(NF90_GET_VAR(fID,vID,v),"get",var); RETURN
+  END IF
+  ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids)
+  DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO
+  ntot=PRODUCT(nn(1:nd))
+  SELECT CASE(nd)
+    CASE(2); ALLOCATE(w2(nn(1),nn(2)))
+      CALL err(NF90_GET_VAR(fID,vID,w2),"get",var)
+      v=RESHAPE(w2,[ntot]); DEALLOCATE(w2)
+    CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3)))
+      CALL err(NF90_GET_VAR(fID,vID,w3),"get",var)
+      v=RESHAPE(w3,[ntot]); DEALLOCATE(w3)
+  END SELECT
+END SUBROUTINE get_var1
+
+
+SUBROUTINE get_var2(var,v)
+  CHARACTER(LEN=*), INTENT(IN)  :: var
+  REAL,             INTENT(OUT) :: v(:,:)
+  REAL,             ALLOCATABLE :: w4(:,:,:,:)
+  INTEGER :: nn(4), dids(4), k, nd
+  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
+  ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids,ndims=nd)
+  DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO
+  ALLOCATE(w4(nn(1),nn(2),nn(3),nn(4)))
+  CALL err(NF90_GET_VAR(fID,vID,w4),"get",var)
+  v=RESHAPE(w4,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w4)
+END SUBROUTINE get_var2
+
+
+SUBROUTINE err(ierr,typ,nam)
+  INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
+  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
+  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
+  IF(ierr==NF90_NoERR) RETURN
+  SELECT CASE(typ)
+    CASE('inq');   msg="Field <"//TRIM(nam)//"> is missing"
+    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
+    CASE('open');  msg="File opening failed for <"//TRIM(nam)//">"
+    CASE('close'); msg="File closing failed for <"//TRIM(nam)//">"
+  END SELECT
+  CALL ABORT_gcm(TRIM(modname),TRIM(msg),ierr)
+END SUBROUTINE err
+
+END SUBROUTINE dynetat0_loc
Index: LMDZ5/trunk/libf/dyn3dmem/dynredem_loc.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/dynredem_loc.F	(revision 2298)
+++ 	(revision )
@@ -1,688 +1,0 @@
-!
-! $Id$
-!
-c
-      SUBROUTINE dynredem0_loc(fichnom,iday_end,phis)
-#ifdef CPP_IOIPSL
-      USE IOIPSL
-#endif
-      USE parallel_lmdz
-      USE mod_hallo
-      USE infotrac
-      IMPLICIT NONE
-c=======================================================================
-c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
-c=======================================================================
-c   Declarations:
-c   -------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "ener.h"
-#include "logic.h"
-#include "netcdf.inc"
-#include "description.h"
-#include "serre.h"
-#include "iniprint.h"
-
-c   Arguments:
-c   ----------
-      INTEGER iday_end
-      REAL phis(ijb_u:ije_u)
-      CHARACTER*(*) fichnom
-
-c   Local:
-c   ------
-      INTEGER iq,l
-      INTEGER length
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      INTEGER ierr
-      character*20 modname
-      character*80 abort_message
-
-c   Variables locales pour NetCDF:
-c
-      INTEGER dims2(2), dims3(3), dims4(4)
-      INTEGER idim_index
-      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
-      INTEGER idim_s, idim_sig
-      INTEGER idim_tim
-      INTEGER nid,nvarid
-
-      REAL zan0,zjulian,hours
-      INTEGER yyears0,jjour0, mmois0
-      character*30 unites
-      REAL :: phis_glo(ip1jmp1)
-      
-      CALL Gather_field_u(phis,phis_glo,1)
-      
-      
-c-----------------------------------------------------------------------
-      if (mpi_rank==0) then
-      
-      modname='dynredem0_loc'
-
-#ifdef CPP_IOIPSL
-      call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
-      call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
-#else
-! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
-      yyears0=0
-      mmois0=1
-      jjour0=1
-#endif                
-
-      DO l=1,length
-       tab_cntrl(l) = 0.
-      ENDDO
-       tab_cntrl(1)  =  REAL(iim)
-       tab_cntrl(2)  =  REAL(jjm)
-       tab_cntrl(3)  =  REAL(llm)
-       tab_cntrl(4)  =  REAL(day_ref)
-       tab_cntrl(5)  =  REAL(annee_ref)
-       tab_cntrl(6)  = rad
-       tab_cntrl(7)  = omeg
-       tab_cntrl(8)  = g
-       tab_cntrl(9)  = cpp
-       tab_cntrl(10) = kappa
-       tab_cntrl(11) = daysec
-       tab_cntrl(12) = dtvr
-       tab_cntrl(13) = etot0
-       tab_cntrl(14) = ptot0
-       tab_cntrl(15) = ztot0
-       tab_cntrl(16) = stot0
-       tab_cntrl(17) = ang0
-       tab_cntrl(18) = pa
-       tab_cntrl(19) = preff
-c
-c    .....    parametres  pour le zoom      ......   
-
-       tab_cntrl(20)  = clon
-       tab_cntrl(21)  = clat
-       tab_cntrl(22)  = grossismx
-       tab_cntrl(23)  = grossismy
-c
-      IF ( fxyhypb )   THEN
-       tab_cntrl(24) = 1.
-       tab_cntrl(25) = dzoomx
-       tab_cntrl(26) = dzoomy
-       tab_cntrl(27) = 0.
-       tab_cntrl(28) = taux
-       tab_cntrl(29) = tauy
-      ELSE
-       tab_cntrl(24) = 0.
-       tab_cntrl(25) = dzoomx
-       tab_cntrl(26) = dzoomy
-       tab_cntrl(27) = 0.
-       tab_cntrl(28) = 0.
-       tab_cntrl(29) = 0.
-       IF( ysinus )  tab_cntrl(27) = 1.
-      ENDIF
-
-       tab_cntrl(30) =  REAL(iday_end)
-       tab_cntrl(31) =  REAL(itau_dyn + itaufin)
-c start_time: start_time of simulation (not necessarily 0.)
-       tab_cntrl(32) = start_time
-c
-c    .........................................................
-c
-c Creation du fichier:
-c
-      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
-      IF (ierr.NE.NF_NOERR) THEN
-         write(lunout,*)"dynredem0: Pb d ouverture du fichier "
-     &                  //trim(fichnom)
-         write(lunout,*)' ierr = ', ierr
-         CALL ABORT_GCM("DYNREDEM0", "", 1)
-      ENDIF
-c
-c Preciser quelques attributs globaux:
-c
-      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
-     .                       "Fichier demmarage dynamique")
-c
-c Definir les dimensions du fichiers:
-c
-      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
-      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
-      ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu)
-      ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv)
-      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
-      ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s)
-      ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig)
-      ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim)
-c
-      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
-c
-c Definir et enregistrer certains champs invariants:
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Parametres de controle")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
-     .                       "Longitudes des points U")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Latitudes des points U")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
-     .                       "Longitudes des points V")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Latitudes des points V")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
-     .                       "Numero naturel des couches s")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
-     .                       "Numero naturel des couches sigma")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
-     .                       "Coefficient A pour hybride")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
-     .                       "Coefficient B pour hybride")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
-#endif
-c
-c Coefficients de passage cov. <-> contra. <--> naturel
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonu
-      dims2(2) = idim_rlatu
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
-     .                       "Coefficient de passage pour U")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
-#endif
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonv
-      dims2(2) = idim_rlatv
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
-     .                       "Coefficient de passage pour V")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
-#endif
-c
-c Aire de chaque maille:
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonv
-      dims2(2) = idim_rlatu
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Aires de chaque maille")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
-#endif
-c
-c Geopentiel au sol:
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonv
-      dims2(2) = idim_rlatu
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
-     .                       "Geopotentiel au sol")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis_glo)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis_glo)
-#endif
-c
-c Definir les variables pour pouvoir les enregistrer plus tard:
-c
-      ierr = NF_REDEF (nid) ! entrer dans le mode de definition
-c
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
-     .                       "Temps de simulation")
-      write(unites,200)yyears0,mmois0,jjour0
-200   format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
-     .                         unites)
-
-c
-      dims4(1) = idim_rlonu
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
-     .                       "Vitesse U")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatv
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
-     .                       "Vitesse V")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
-     .                       "Temperature")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-
-      DO iq=1,nqtot
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
-      ENDDO
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
-     .                       "C est quoi ?")
-c
-      dims3(1) = idim_rlonv
-      dims3(2) = idim_rlatu
-      dims3(3) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
-     .                       "Pression au sol")
-c
-      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
-      ierr = NF_CLOSE(nid) ! fermer le fichier
-
-      write(lunout,*)'dynredem_loc: iim,jjm,llm,iday_end',
-     &               iim,jjm,llm,iday_end
-      write(lunout,*)'dynredem_loc: rad,omeg,g,cpp,kappa',
-     &        rad,omeg,g,cpp,kappa
-
-      endif  ! mpi_rank==0
-      RETURN
-      END
-      SUBROUTINE dynredem1_loc(fichnom,time,
-     .                     vcov,ucov,teta,q,masse,ps)
-      USE parallel_lmdz
-      USE mod_hallo
-      USE infotrac
-      USE control_mod
-      USE dynredem_mod
-      IMPLICIT NONE
-c=================================================================
-c  Ecriture du fichier de redemarrage sous format NetCDF
-c=================================================================
-#include "dimensions.h"
-#include "paramet.h"
-#include "description.h"
-#include "netcdf.inc"
-#include "comvert.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "iniprint.h"
-
-      INTEGER l
-      REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm) 
-      REAL teta(ijb_u:ije_u,llm)                   
-      REAL ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm)                   
-      REAL q(ijb_u:ije_u,llm,nqtot)
-      CHARACTER*(*) fichnom
-     
-      REAL time
-      INTEGER nid, nvarid, nid_trac, nvarid_trac
-      REAL trac_tmp(ijb_u:ije_u,llm)      
-      INTEGER ierr, ierr_file
-      INTEGER iq
-      INTEGER length
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      character*20 modname
-      character*80 abort_message
-c
-      INTEGER nb
-      SAVE nb
-      DATA nb / 0 /
-      REAL,SAVE,ALLOCATABLE :: ucov_glo(:,:),vcov_glo(:,:),teta_glo(:,:)
-      REAL,SAVE,ALLOCATABLE :: masse_glo(:,:),ps_glo(:),q_glo(:,:)
-      LOGICAL,SAVE :: exist_file
-      INTEGER,SAVE :: ierr_var
-      
-!      call Gather_Field(ucov,ip1jmp1,llm,0)
-!      call Gather_Field(vcov,ip1jm,llm,0)
-!      call Gather_Field(teta,ip1jmp1,llm,0)
-!      call Gather_Field(masse,ip1jmp1,llm,0)
-!      call Gather_Field(ps,ip1jmp1,1,0)
-      
-!      do iq=1,nqtot
-!        call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
- !     enddo
-      
-!$OMP MASTER      
-      if (mpi_rank==0) then
-      modname = 'dynredem1_loc'
-      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynredem1: Pb. d ouverture "//trim(fichnom)
-         CALL abort_gcm("dynredem1", "", 1)
-      ENDIF
-
-c  Ecriture/extension de la coordonnee temps
-
-      nb = nb + 1
-      ierr = NF_INQ_VARID(nid, "temps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*) NF_STRERROR(ierr)
-         abort_message='Variable temps n est pas definie'
-         CALL abort_gcm(modname,abort_message,ierr)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
-#else
-      ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
-#endif
-      write(lunout,*) "dynredem1_loc: Enregistrement pour ", nb, time
-
-c
-c  Re-ecriture du tableau de controle, itaufin n'est plus defini quand
-c  on passe dans dynredem0
-      ierr = NF_INQ_VARID (nid, "controle", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         abort_message="dynredem1: Le champ <controle> est absent"
-         ierr = 1
-         CALL abort_gcm(modname,abort_message,ierr)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
-#endif
-       tab_cntrl(31) =  REAL(itau_dyn + itaufin)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
-#endif
-      endif
-!$OMP END MASTER
-
-!     
-      CALL dynredem_write_u(nid,"ucov",ucov,llm)
-      CALL dynredem_write_v(nid,"vcov",vcov,llm)
-      CALL dynredem_write_u(nid,"teta",teta,llm)
-      CALL dynredem_write_u(nid,"masse",masse,llm)
-      CALL dynredem_write_u(nid,"ps",ps,1)
-
-      IF (type_trac /= 'inca') THEN
-        DO iq=1,nqtot
-          CALL dynredem_write_u(nid,tname(iq),q(:,:,iq),llm)
-        ENDDO
-      ELSE
-        
-!$OMP MASTER
-        INQUIRE(FILE="start_trac.nc", EXIST=exist_file) 
-        PRINT *, "EXIST", exist_file
-!$OMP END MASTER
-!$OMP BARRIER
-      
-        IF (exist_file) THEN
-!$OMP MASTER
-          ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac)
-          IF (ierr_file .NE.NF_NOERR) THEN
-            WRITE(6,*)' Pb d''ouverture du fichier start_trac.nc'
-            WRITE(6,*)' ierr = ', ierr_file 
-          ENDIF
-!$OMP END MASTER
-
-          DO iq=1,nqtot
-
-!$OMP MASTER      
-            ierr_var = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac)
-!$OMP END MASTER
-!$OMP BARRIER
-            IF (ierr == NF_NOERR) THEN
-              CALL dynredem_read_u(nid_trac,tname(iq),q(:,:,iq),llm) 
-            ENDIF
-            CALL dynredem_write_u(nid,tname(iq),q(:,:,iq),llm)  
-          ENDDO          
-          
-        ELSE ! pas de fichier start_tract
-          DO iq=1,nqtot
-            CALL dynredem_write_u(nid,tname(iq),q(:,:,iq),llm)
-          ENDDO
-        ENDIF 
-      ENDIF
-
-
-!$OMP MASTER
-      IF (mpi_rank==0) THEN
-        ierr = NF_CLOSE(nid)
-      ENDIF ! mpi_rank==0
-!$OMP END MASTER
-      
-      RETURN
-      END
-
Index: LMDZ5/trunk/libf/dyn3dmem/dynredem_loc.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/dynredem_loc.F90	(revision 2299)
+++ LMDZ5/trunk/libf/dyn3dmem/dynredem_loc.F90	(revision 2299)
@@ -0,0 +1,269 @@
+SUBROUTINE dynredem0_loc(fichnom,iday_end,phis)
+!
+!-------------------------------------------------------------------------------
+! Write the NetCDF restart file (initialization).
+!-------------------------------------------------------------------------------
+#ifdef CPP_IOIPSL
+  USE IOIPSL
+#endif
+  USE parallel_lmdz
+  USE mod_hallo
+  USE infotrac
+  USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL,    &
+                    NF90_CLOSE,  NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER
+  USE dynredem_mod, ONLY: cre_var, put_var, err, modname, fil
+  IMPLICIT NONE
+  include "dimensions.h"
+  include "paramet.h"
+  include "comconst.h"
+  include "comvert.h"
+  include "comgeom.h"
+  include "temps.h"
+  include "ener.h"
+  include "logic.h"
+  include "description.h"
+  include "serre.h"
+  include "iniprint.h"
+!===============================================================================
+! Arguments:
+  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
+  INTEGER,          INTENT(IN) :: iday_end         !--- 
+  REAL,             INTENT(IN) :: phis(ijb_u:ije_u)!--- GROUND GEOPOTENTIAL
+!===============================================================================
+! Local variables:
+  INTEGER :: iq, l
+  INTEGER, PARAMETER :: length=100
+  REAL    :: tab_cntrl(length)                     !--- RUN PARAMETERS TABLE
+  REAL    :: phis_glo(ip1jmp1)
+!   For NetCDF:
+  CHARACTER(LEN=30) :: unites
+  INTEGER :: indexID
+  INTEGER :: rlonuID, rlonvID, rlatuID, rlatvID
+  INTEGER :: sID, sigID, nID, vID, timID
+  INTEGER :: yyears0, jjour0, mmois0
+  REAL    :: zan0, zjulian, hours
+!===============================================================================
+  modname='dynredem0'; fil=fichnom
+  CALL Gather_field_u(phis,phis_glo,1)
+  IF(mpi_rank/=0) RETURN
+
+#ifdef CPP_IOIPSL
+  CALL ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
+  CALL ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
+#else
+! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
+  yyears0=0
+  mmois0=1
+  jjour0=1
+#endif        
+
+  tab_cntrl(:)  = 0.
+  tab_cntrl(1)  = REAL(iim)
+  tab_cntrl(2)  = REAL(jjm)
+  tab_cntrl(3)  = REAL(llm)
+  tab_cntrl(4)  = REAL(day_ref)
+  tab_cntrl(5)  = REAL(annee_ref)
+  tab_cntrl(6)  = rad
+  tab_cntrl(7)  = omeg
+  tab_cntrl(8)  = g
+  tab_cntrl(9)  = cpp
+  tab_cntrl(10) = kappa
+  tab_cntrl(11) = daysec
+  tab_cntrl(12) = dtvr
+  tab_cntrl(13) = etot0
+  tab_cntrl(14) = ptot0
+  tab_cntrl(15) = ztot0
+  tab_cntrl(16) = stot0
+  tab_cntrl(17) = ang0
+  tab_cntrl(18) = pa
+  tab_cntrl(19) = preff
+
+!    .....    parameters for zoom    ......   
+  tab_cntrl(20) = clon
+  tab_cntrl(21) = clat
+  tab_cntrl(22) = grossismx
+  tab_cntrl(23) = grossismy
+!
+  IF ( fxyhypb )   THEN
+    tab_cntrl(24) = 1.
+    tab_cntrl(25) = dzoomx
+    tab_cntrl(26) = dzoomy
+    tab_cntrl(27) = 0.
+    tab_cntrl(28) = taux
+    tab_cntrl(29) = tauy
+  ELSE
+    tab_cntrl(24) = 0.
+    tab_cntrl(25) = dzoomx
+    tab_cntrl(26) = dzoomy
+    tab_cntrl(27) = 0.
+    tab_cntrl(28) = 0.
+    tab_cntrl(29) = 0.
+    IF( ysinus )  tab_cntrl(27) = 1.
+  END IF
+  tab_cntrl(30) = REAL(iday_end)
+  tab_cntrl(31) = REAL(itau_dyn + itaufin)
+! start_time: start_time of simulation (not necessarily 0.)
+  tab_cntrl(32) = start_time
+
+!--- File creation
+  CALL err(NF90_CREATE(fichnom,NF90_CLOBBER,nid))
+
+!--- Some global attributes
+  CALL err(NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier demarrage dynamique"))
+
+!--- Dimensions
+  CALL err(NF90_DEF_DIM(nid,"index", length, indexID))
+  CALL err(NF90_DEF_DIM(nid,"rlonu", iip1,   rlonuID))
+  CALL err(NF90_DEF_DIM(nid,"rlatu", jjp1,   rlatuID))
+  CALL err(NF90_DEF_DIM(nid,"rlonv", iip1,   rlonvID))
+  CALL err(NF90_DEF_DIM(nid,"rlatv", jjm,    rlatvID))
+  CALL err(NF90_DEF_DIM(nid,"sigs",  llm,        sID))
+  CALL err(NF90_DEF_DIM(nid,"sig",   llmp1,    sigID))
+  CALL err(NF90_DEF_DIM(nid,"temps", NF90_UNLIMITED, timID))
+
+!--- Define and save invariant fields
+  CALL put_var(nid,"controle","Parametres de controle" ,[indexID],tab_cntrl)
+  CALL put_var(nid,"rlonu"   ,"Longitudes des points U",[rlonuID],rlonu)
+  CALL put_var(nid,"rlatu"   ,"Latitudes des points U" ,[rlatuID],rlatu)
+  CALL put_var(nid,"rlonv"   ,"Longitudes des points V",[rlonvID],rlonv)
+  CALL put_var(nid,"rlatv"   ,"Latitudes des points V" ,[rlatvID],rlatv)
+  CALL put_var(nid,"nivsigs" ,"Numero naturel des couches s"    ,[sID]  ,nivsigs)
+  CALL put_var(nid,"nivsig"  ,"Numero naturel des couches sigma",[sigID],nivsig)
+  CALL put_var(nid,"ap"      ,"Coefficient A pour hybride"      ,[sigID],ap)
+  CALL put_var(nid,"bp"      ,"Coefficient B pour hybride"      ,[sigID],bp)
+  CALL put_var(nid,"presnivs",""                                ,[sID]  ,presnivs)
+! covariant <-> contravariant <-> natural conversion coefficients
+  CALL put_var(nid,"cu","Coefficient de passage pour U",[rlonuID,rlatuID],cu)
+  CALL put_var(nid,"cv","Coefficient de passage pour V",[rlonvID,rlatvID],cv)
+  CALL put_var(nid,"aire","Aires de chaque maille"     ,[rlonvID,rlatuID],aire)
+  CALL put_var(nid,"phisinit","Geopotentiel au sol"    ,[rlonvID,rlatuID],phis_glo)
+
+!--- Define fields saved later
+  WRITE(unites,"('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')"),&
+               yyears0,mmois0,jjour0
+  CALL cre_var(nid,"temps","Temps de simulation",[timID],unites)
+  CALL cre_var(nid,"ucov" ,"Vitesse U"  ,[rlonuID,rlatuID,sID,timID])
+  CALL cre_var(nid,"vcov" ,"Vitesse V"  ,[rlonvID,rlatvID,sID,timID])
+  CALL cre_var(nid,"teta" ,"Temperature",[rlonvID,rlatuID,sID,timID])
+  DO iq=1,nqtot
+    CALL cre_var(nid,tname(iq),ttext(iq),[rlonvID,rlatuID,sID,timID])
+  END DO
+  CALL cre_var(nid,"masse","Masse d air"    ,[rlonvID,rlatuID,sID,timID])
+  CALL cre_var(nid,"ps"   ,"Pression au sol",[rlonvID,rlatuID    ,timID])
+  CALL err(NF90_CLOSE (nid))
+
+  WRITE(lunout,*)TRIM(modname)//': iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
+  WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
+
+END SUBROUTINE dynredem0_loc
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE dynredem1_loc(fichnom,time,vcov,ucov,teta,q,masse,ps)
+!
+!-------------------------------------------------------------------------------
+! Purpose: Write the NetCDF restart file (append).
+!-------------------------------------------------------------------------------
+  USE parallel_lmdz
+  USE mod_hallo
+  USE infotrac
+  USE control_mod
+  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &
+                      NF90_CLOSE, NF90_WRITE,   NF90_PUT_VAR, NF90_NoErr
+  USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, &
+                          err, modname, fil, msg
+  IMPLICIT NONE
+  include "dimensions.h"
+  include "paramet.h"
+  include "description.h"
+  include "comvert.h"
+  include "comgeom.h"
+  include "temps.h"
+  include "iniprint.h"
+!===============================================================================
+! Arguments:
+  CHARACTER(LEN=*), INTENT(IN) :: fichnom              !-- FILE NAME
+  REAL, INTENT(IN)    ::  time                         !-- TIME
+  REAL, INTENT(IN)    ::  vcov(ijb_v:ije_v,llm)        !-- V COVARIANT WIND
+  REAL, INTENT(IN)    ::  ucov(ijb_u:ije_u,llm)        !-- U COVARIANT WIND
+  REAL, INTENT(IN)    ::  teta(ijb_u:ije_u,llm)        !-- POTENTIAL TEMPERATURE
+  REAL, INTENT(INOUT) ::     q(ijb_u:ije_u,llm,nqtot)  !-- TRACERS
+  REAL, INTENT(IN)    :: masse(ijb_u:ije_u,llm)        !-- MASS PER CELL
+  REAL, INTENT(IN)    ::    ps(ijb_u:ije_u)            !-- GROUND PRESSURE
+!===============================================================================
+! Local variables:
+  INTEGER :: l, iq, nid, vID, ierr, nid_trac, vID_trac
+  INTEGER, SAVE :: nb=0
+  INTEGER, PARAMETER :: length=100
+  REAL               :: tab_cntrl(length) ! tableau des parametres du run
+  CHARACTER(LEN=256) :: var, dum
+  LOGICAL            :: lread_inca
+!===============================================================================
+
+!$OMP MASTER
+  IF(mpi_rank==0) THEN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  modname='dynredem1_loc'; fil=fichnom
+  fil=fichnom
+  CALL err(NF90_OPEN(fil,NF90_WRITE,nid),"open",fil)
+
+!--- Write/extend time coordinate
+  nb = nb + 1
+  var="temps"
+  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
+  CALL err(NF90_PUT_VAR(nid,vID,[time]),"put",var)
+  WRITE(lunout,*)TRIM(modname)//": Saving for ", nb, time
+
+!--- Rewrite control table (itaufin undefined in dynredem0)
+  var="controle"
+  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
+  CALL err(NF90_GET_VAR(nid,vID,tab_cntrl),"get",var)
+  tab_cntrl(31)=DBLE(itau_dyn + itaufin)
+  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
+  CALL err(NF90_PUT_VAR(nid,vID,tab_cntrl),"put",var)
+  END IF               !++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+!$OMP END MASTER
+
+!--- Save fields
+  CALL dynredem_write_u(nid,"ucov" ,ucov ,llm)
+  CALL dynredem_write_v(nid,"vcov" ,vcov ,llm)
+  CALL dynredem_write_u(nid,"teta" ,teta ,llm)
+  CALL dynredem_write_u(nid,"masse",masse,llm)
+  CALL dynredem_write_u(nid,"ps"   ,ps   ,1)
+
+!--- Tracers in file "start_trac.nc" (added by Anne)
+!$OMP MASTER
+  lread_inca=.FALSE.; fil="start_trac.nc"
+  IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca)
+  IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")
+!$OMP END MASTER
+!$OMP BARRIER
+
+!--- Save tracers
+  DO iq=1,nqtot; var=tname(iq); ierr=-1
+    IF(lread_inca) THEN                  !--- Possibly read from "start_trac.nc"
+!$OMP MASTER      
+      fil="start_trac.nc"
+      ierr=NF90_INQ_VARID(nid_trac,var,vID_trac)
+      dum='inq'; IF(ierr==NF90_NoErr) dum='fnd'
+      WRITE(lunout,*)msg(dum,var)
+!$OMP END MASTER
+!$OMP BARRIER
+      IF(ierr==NF90_NoErr) CALL dynredem_read_u(nid_trac,var,q(:,:,iq),llm)
+    END IF
+    fil=fichnom
+    CALL dynredem_write_u(nid,var,q(:,:,iq),llm)
+  END DO
+
+!$OMP MASTER
+  IF(mpi_rank==0) THEN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  CALL err(NF90_CLOSE(nid),"close")
+  fil="start_trac.nc"
+  IF(lread_inca) CALL err(NF90_CLOSE(nid_trac),"close")
+  END IF               !++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+!$OMP END MASTER
+
+END SUBROUTINE dynredem1_loc
+
Index: LMDZ5/trunk/libf/dyn3dmem/dynredem_mod.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/dynredem_mod.F90	(revision 2298)
+++ LMDZ5/trunk/libf/dyn3dmem/dynredem_mod.F90	(revision 2299)
@@ -1,206 +1,276 @@
-!
-! $Id$
-!
 MODULE dynredem_mod
 
-CONTAINS
-
-  SUBROUTINE dynredem_write_u(ncid,id,var,ll)
   USE dimensions_mod
   USE parallel_lmdz
   USE mod_hallo
-  IMPLICIT NONE
-    INTEGER          :: ncid
-    CHARACTER(LEN=*) :: id
-    REAL             :: var(ijb_u:ije_u,ll)
-    REAL,ALLOCATABLE,SAVE  :: var_tmp(:,:)
-    REAL,ALLOCATABLE,SAVE  :: var_glo(:)
-    INTEGER          :: ll
-    INTEGER          :: count(4)
-    INTEGER          :: start(4)
-    INTEGER          :: l
-    INTEGER          :: nvarid
-    INTEGER          :: ierr
-    INCLUDE 'netcdf.inc'    
+  USE netcdf
+  PRIVATE
+  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
+  PUBLIC :: cre_var, get_var1, put_var, fil, modname, msg
+  CHARACTER(LEN=256), SAVE :: fil, modname
+  INTEGER,            SAVE :: nvarid
+
+
+CONTAINS
+
+
+!===============================================================================
+!
+SUBROUTINE dynredem_write_u(ncid,id,var,ll)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,          INTENT(IN) :: ncid
+  CHARACTER(LEN=*), INTENT(IN) :: id
+  REAL,             INTENT(IN) :: var(ijb_u:ije_u,ll)
+  INTEGER,          INTENT(IN) :: ll
+!===============================================================================
+! Local variables:
+  REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:)
+  INTEGER :: start(4), count(4), l, ierr
+!===============================================================================
+  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,1,1]
+
+!$OMP MASTER
+  IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
+!$OMP END MASTER
+
+!$OMP MASTER
+  ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1))
+!$OMP END MASTER
+!$OMP BARRIER
+
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+  DO l=1,ll; var_tmp(:,l)=var(:,l); END DO
+  DO l=1,ll
+    CALL gather_field_u(var_tmp(:,l),var_glo,1)
+    IF(mpi_rank==0) THEN
+    !$OMP MASTER
+      start(3)=l
+      CALL err(NF90_PUT_VAR(ncid,nvarid,var_glo,start,count),"put",id)
+    !$OMP END MASTER
+    END IF
+  END DO
+!$OMP BARRIER
+!$OMP MASTER
+  DEALLOCATE(var_glo,var_tmp)
+!$OMP END MASTER
+!$OMP BARRIER
+  
+END SUBROUTINE dynredem_write_u
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE dynredem_write_v(ncid,id,var,ll)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,          INTENT(IN) :: ncid
+  CHARACTER(LEN=*), INTENT(IN) :: id
+  REAL,             INTENT(IN) :: var(ijb_v:ije_v,ll)
+  INTEGER,          INTENT(IN) :: ll
+!===============================================================================
+! Local variables:
+  REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:)
+  INTEGER :: start(4), count(4), l, ierr
+!===============================================================================
+  start(:)=[1,1,1,1]; count(:)=[iip1,jjm,1,1]
+
+!$OMP MASTER
+  IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
+!$OMP END MASTER
+
+!$OMP MASTER
+  ALLOCATE(var_tmp(ijb_v:ije_v,ll),var_glo(ip1jm))
+!$OMP END MASTER
+!$OMP BARRIER
+
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+  DO l=1,ll; var_tmp(:,l)=var(:,l); END DO
+  DO l=1,ll
+    CALL gather_field_v(var_tmp(:,l),var_glo,1)
+    IF(mpi_rank==0) THEN
+    !$OMP MASTER
+      start(3)=l
+      CALL err(NF90_PUT_VAR(ncid,nvarid,var_glo,start,count),"put",id)
+    !$OMP END MASTER
+    END IF
+  END DO
+!$OMP BARRIER
+!$OMP MASTER
+  DEALLOCATE(var_glo,var_tmp)
+!$OMP END MASTER
+!$OMP BARRIER
+  
+END SUBROUTINE dynredem_write_v
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE dynredem_read_u(ncid,id,var,ll)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,          INTENT(IN)  :: ncid
+  CHARACTER(LEN=*), INTENT(IN)  :: id
+  REAL,             INTENT(OUT) :: var(ijb_u:ije_u,ll)
+  INTEGER,          INTENT(IN)  :: ll
+!===============================================================================
+! Local variables:
+  REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:)
+  INTEGER :: start(4), count(4), l, ierr
+!===============================================================================
+  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,1,1]
+
+!$OMP MASTER
+  IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),'inq',id)
+!$OMP END MASTER
+
+!$OMP MASTER
+  ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1))
+!$OMP END MASTER
+!$OMP BARRIER
+
+  DO l=1,ll
+    IF(mpi_rank==0) THEN
+    !$OMP MASTER
+      start(3)=l
+      CALL err(NF90_GET_VAR(ncid,nvarid,var_glo,start,count),"get",id)
+    !$OMP END MASTER
+    END IF
+    CALL scatter_field_u(var_glo,var_tmp(:,l),1)
+  END DO
+
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+  DO l=1,ll; var(:,l)=var_tmp(:,l); END DO
     
-    count(:)=(/ iip1,jjp1,1,1 /)
-    start(:)=(/ 1,1,1,1 /)
-    
-!$OMP MASTER    
-   IF (mpi_rank==0) THEN
-     ierr = NF_INQ_VARID(ncid, id, nvarid)
-     IF (ierr .NE. NF_NOERR) THEN
-       PRINT*, "Variable "//id//" n est pas definie"
-       CALL abort
-     ENDIF
-   ENDIF
-!$OMP END MASTER
-
-!$OMP MASTER
-    ALLOCATE(var_tmp(ijb_u:ije_u,ll))
-    ALLOCATE(var_glo(ip1jmp1))
-!$OMP END MASTER
-!$OMP BARRIER
-
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-    DO l=1,ll
-      var_tmp(:,l)=var(:,l)
-    ENDDO
-
-    DO l=1,ll
-      CALL gather_field_u(var_tmp(:,l),var_glo,1)
-       IF (mpi_rank==0) THEN
-   !$OMP MASTER
-        start(3)=l
+!$OMP BARRIER
+!$OMP MASTER
+  DEALLOCATE(var_glo,var_tmp)
+!$OMP END MASTER
+!$OMP BARRIER
+  
+END SUBROUTINE dynredem_read_u    
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE cre_var(ncid,var,title,did,units)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,                    INTENT(IN) :: ncid
+  CHARACTER(LEN=*),           INTENT(IN) :: var, title
+  INTEGER,                    INTENT(IN) :: did(:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
+!===============================================================================
 #ifdef NC_DOUBLE
-        ierr = NF_PUT_VARA_DOUBLE (ncid,nvarid,start,count,var_glo)
+  CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var)
 #else
-        ierr = NF_PUT_VARA_REAL (ncid,nvarid,start,count,var_glo)
+  CALL err(NF90_DEF_VAR(ncid,var,NF90_FLOAT ,did,nvarid),"inq",var)
 #endif
-   !$OMP END MASTER
-       ENDIF
-    ENDDO
-    
-  !$OMP BARRIER
-  !$OMP MASTER
-    DEALLOCATE(var_tmp)
-    DEALLOCATE(var_glo)
-  !$OMP END MASTER
-  !$OMP BARRIER
-  
-  END SUBROUTINE dynredem_write_u
-      
-  SUBROUTINE dynredem_write_v(ncid,id,var,ll)
-  USE dimensions_mod
-  USE parallel_lmdz
-  USE mod_hallo
-  IMPLICIT NONE
-    INTEGER          :: ncid
-    CHARACTER(LEN=*) :: id
-    REAL             :: var(ijb_v:ije_v,ll)
-    REAL,ALLOCATABLE,SAVE  :: var_tmp(:,:)
-    REAL,ALLOCATABLE,SAVE  :: var_glo(:)
-    INTEGER          :: ll
-    INTEGER          :: count(4)
-    INTEGER          :: start(4)
-    INTEGER          :: l
-    INTEGER          :: nvarid
-    INTEGER          :: ierr
-    INCLUDE 'netcdf.inc'    
-    
-    count(:)=(/ iip1,jjm,1,1 /)
-    start(:)=(/ 1,1,1,1 /)
-    
-!$OMP MASTER    
-   IF (mpi_rank==0) THEN
-     ierr = NF_INQ_VARID(ncid, id, nvarid)
-     IF (ierr .NE. NF_NOERR) THEN
-       PRINT*, "Variable "//id//" n est pas definie"
-       CALL abort
-     ENDIF
-   ENDIF
-!$OMP END MASTER
- 
-!$OMP MASTER
-    ALLOCATE(var_tmp(ijb_v:ije_v,ll))
-    ALLOCATE(var_glo(ip1jm))
-!$OMP END MASTER
-!$OMP BARRIER
-
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-    DO l=1,ll
-      var_tmp(:,l)=var(:,l)
-    ENDDO
-
-    DO l=1,ll
-      CALL gather_field_v(var_tmp(:,l),var_glo,1)
-       IF (mpi_rank==0) THEN
-   !$OMP MASTER
-        start(3)=l
-#ifdef NC_DOUBLE
-        ierr = NF_PUT_VARA_DOUBLE (ncid,nvarid,start,count,var_glo)
-#else
-        ierr = NF_PUT_VARA_REAL (ncid,nvarid,start,count,var_glo)
-#endif
-   !$OMP END MASTER
-       ENDIF
-    ENDDO
-    
-  !$OMP BARRIER
-  !$OMP MASTER
-    DEALLOCATE(var_tmp)
-    DEALLOCATE(var_glo)
-  !$OMP END MASTER
-  !$OMP BARRIER
-  
-  END SUBROUTINE dynredem_write_v
-
-  SUBROUTINE dynredem_read_u(ncid,id,var,ll)
-  USE dimensions_mod
-  USE parallel_lmdz
-  USE mod_hallo
-  IMPLICIT NONE
-    INTEGER          :: ncid
-    CHARACTER(LEN=*) :: id
-    REAL             :: var(ijb_u:ije_u,ll)
-    REAL,ALLOCATABLE,SAVE  :: var_tmp(:,:)
-    REAL,ALLOCATABLE,SAVE  :: var_glo(:)
-    INTEGER          :: ll
-    INTEGER          :: count(4)
-    INTEGER          :: start(4)
-    INTEGER          :: l
-    INTEGER          :: nvarid
-    INTEGER          :: ierr
-    INCLUDE 'netcdf.inc'    
-    
-    count(:)=(/ iip1,jjp1,1,1 /)
-    start(:)=(/ 1,1,1,1 /)
-    
-!$OMP MASTER    
-   IF (mpi_rank==0) THEN
-     ierr = NF_INQ_VARID(ncid, id, nvarid)
-     IF (ierr .NE. NF_NOERR) THEN
-       PRINT*, "Variable "//id//" n est pas definie"
-       CALL abort
-     ENDIF
-   ENDIF
-!$OMP END MASTER
- 
-!$OMP MASTER
-    ALLOCATE(var_tmp(ijb_u:ije_u,ll))
-    ALLOCATE(var_glo(ip1jmp1))
-!$OMP END MASTER
-!$OMP BARRIER
-
-
-    DO l=1,ll
-       IF (mpi_rank==0) THEN
-   !$OMP MASTER
-        start(3)=l
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VARA_DOUBLE (ncid,nvarid,start,count,var_glo)
-#else
-        ierr = NF_GET_VARA_REAL (ncid,nvarid,start,count,var_glo)
-#endif
-   !$OMP END MASTER
-       ENDIF
-       CALL scatter_field_u(var_glo,var_tmp(:,l),1)
-    ENDDO
-
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-    DO l=1,ll
-      var(:,l)=var_tmp(:,l)
-    ENDDO
-    
-  !$OMP BARRIER
-  !$OMP MASTER
-    DEALLOCATE(var_tmp)
-    DEALLOCATE(var_glo)
-  !$OMP END MASTER
-  !$OMP BARRIER
-  
-  END SUBROUTINE dynredem_read_u    
-  
+  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
+  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
+
+END SUBROUTINE cre_var
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE put_var(ncid,var,title,did,v,units)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,                    INTENT(IN) :: ncid
+  CHARACTER(LEN=*),           INTENT(IN) :: var, title
+  INTEGER,                    INTENT(IN) :: did(:)
+  REAL,                       INTENT(IN) :: v(:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
+!===============================================================================
+  INTEGER :: nd, k, nn(2)
+  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
+  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
+  CALL err(NF90_ENDDEF(ncid))
+  nd=SIZE(did)
+  DO k=1,nd; CALL err(NF90_INQUIRE_DIMENSION(ncid,did(k),len=nn(k))); END DO
+  IF(nd==1) CALL err(NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:1))),var)
+  IF(nd==2) CALL err(NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:2))),var)
+  CALL err(NF90_REDEF(ncid))
+END SUBROUTINE put_var
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+FUNCTION msg(typ,nam)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  CHARACTER(LEN=256)                     :: msg    !--- STANDARDIZED MESSAGE
+  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
+!===============================================================================
+  SELECT CASE(typ)
+    CASE('open');  msg="Opening failed for <"//TRIM(fil)//">"
+    CASE('close'); msg="Closing failed for <"//TRIM(fil)//">"
+    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
+    CASE('put');   msg="Writting failed for <"//TRIM(nam)//">"
+    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
+    CASE('fnd');   msg="Found field <"//TRIM(nam)//">"
+  END SELECT
+  msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
+
+END FUNCTION msg
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE err(ierr,typ,nam)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
+!===============================================================================
+  IF(ierr==NF90_NoERR) RETURN
+  IF(.NOT.PRESENT(typ)) THEN
+    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
+  ELSE
+    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
+  END IF
+
+END SUBROUTINE err
+!
+!===============================================================================
+
 END MODULE dynredem_mod   
+
     
     
Index: LMDZ5/trunk/libf/dynlonlat_phylonlat/grid_atob_m.F90
===================================================================
--- LMDZ5/trunk/libf/dynlonlat_phylonlat/grid_atob_m.F90	(revision 2298)
+++ 	(revision )
@@ -1,307 +1,0 @@
-!*******************************************************************************
-!
-MODULE grid_atob_m
-!
-!*******************************************************************************
-
-  USE assert_eq_m, ONLY: assert_eq
-  REAL, SAVE :: pi, deg2rad
-
-  PRIVATE
-  PUBLIC :: grille_m, rugosite, sea_ice, rugsoro
-
-CONTAINS
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE fine2coarse(x_i, y_i, x_o, y_o, d_o1, d_i, msk, d_o2)
-!
-!-------------------------------------------------------------------------------
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL,                       INTENT(IN)  :: x_i(:), y_i(:)  !- IN  X&Y COORD.
-  REAL,                       INTENT(IN)  :: x_o(:), y_o(:)  !- OUT X&Y COORD.
-  DOUBLE PRECISION,           INTENT(OUT) :: d_o1(:,:)       !- OUT FLD (mo,no)
-  REAL,             OPTIONAL, INTENT(IN)  :: d_i (:,:)       !- INP FLD (mi,ni)
-  LOGICAL,          OPTIONAL, INTENT(IN)  :: msk (:,:)       !- MASK    (mi,ni)
-  DOUBLE PRECISION, OPTIONAL, INTENT(OUT) :: d_o2(:,:)       !- OUT FOR d_i^2
-!-------------------------------------------------------------------------------
-! Local variables:
-  CHARACTER(LEN=256) :: modname="fine2coarse"
-  DOUBLE PRECISION   :: inc
-  INTEGER :: mi, ni, ii, ji, mo, no, io, jo, nr(2), m1, n1, m2, n2, nn
-  INTEGER :: num_tot(SIZE(x_o),SIZE(y_o))
-  LOGICAL :: found(SIZE(x_o),SIZE(y_o)), li
-  LOGICAL :: mask (SIZE(x_i),SIZE(y_i)), lo
-  REAL    :: dist (SIZE(x_o),SIZE(y_o))
-  REAL    :: a(SIZE(x_o)), b(SIZE(x_o)), c(SIZE(y_o)), d(SIZE(y_o))
-  REAL, PARAMETER :: thresh=1.E-5
-!-------------------------------------------------------------------------------
-  mask(:,:)=.TRUE.; IF(PRESENT(msk)) mask(:,:)=msk(:,:)
-  mi=SIZE(x_i); m1=mi; ni=SIZE(y_i); n1=ni
-  mo=SIZE(x_o); m2=mo; no=SIZE(y_o); n2=no
-  li=PRESENT(d_i ); IF(li) THEN; m1=SIZE(d_i ,1); n1=SIZE(d_i ,2); END IF
-  lo=PRESENT(d_o2); IF(lo) THEN; m2=SIZE(d_o2,1); n2=SIZE(d_o2,2); END IF
-  mi=assert_eq(mi,m1,SIZE(mask,1),TRIM(modname)//" mi")
-  ni=assert_eq(ni,n1,SIZE(mask,2),TRIM(modname)//" ni")
-  mo=assert_eq(mo,m2,SIZE(d_o1,1),TRIM(modname)//" mo")
-  no=assert_eq(no,n2,SIZE(d_o1,2),TRIM(modname)//" no")
-
-!--- COMPUTE CELLS INTERFACES COORDINATES OF OUTPUT GRID
-  b(mo)=x_o(mo)+(x_o(mo)-x_o(mo-1))/2.0; b(1:mo-1)=(x_o(1:mo-1)+x_o(2:mo))/2.0
-  d(no)=y_o(no)+(y_o(no)-y_o(no-1))/2.0; d(1:no-1)=(y_o(1:no-1)+y_o(2:no))/2.0
-  a(1 )=x_o(1 )-(x_o(2 )-x_o(1   ))/2.0; a(2:mo  )=   b(1:mo-1)
-  c(1 )=y_o(1 )-(y_o(2 )-y_o(1   ))/2.0; c(2:no  )=   d(1:no-1)
-
-!--- ACCUMULATE INPUT POINTS ON OUTPUT GRID
-  d_o1(:,:)=0.; num_tot(:,:)=0; inc=1.0d0
-  IF(lo) d_o2(:,:)=0.
-  DO ji = 1, ni
-    DO ii = 1, mi
-      IF(li) inc=DBLE(d_i(ii,ji))
-      DO jo = 1, no
-        IF((y_i(ji)-c(jo)<thresh.OR.y_i(ji)-d(jo)>thresh).AND.   &
-           (y_i(ji)-c(jo)>thresh.OR.y_i(ji)-d(jo)<thresh)) CYCLE
-        DO io = 1, mo
-          IF((x_i(ii)-a(io)<thresh.OR.x_i(ii)-b(io)>thresh).AND. &
-             (x_i(ii)-a(io)>thresh.OR.x_i(ii)-b(io)<thresh)) CYCLE
-          num_tot(io,jo)=num_tot(io,jo)+1
-          IF(mask(ii,ji)) d_o1(io,jo)=d_o1(io,jo)+inc
-          IF(.NOT.lo) CYCLE
-          IF(mask(ii,ji)) d_o2(io,jo)=d_o2(io,jo)+inc*inc
-        END DO
-      END DO
-    END DO
-  END DO
-
-!--- CHECK INPUT POINTS HAVE BEEN FOUND IN EACH OUTPUT CELL
-  found(:,:)=num_tot(:,:)/=0
-  WHERE(found.AND.mask) d_o1(:,:)=d_o1(:,:)/DBLE(num_tot(:,:))
-  IF(PRESENT(d_o2)) THEN
-    WHERE(found.AND.mask) d_o2(:,:)=d_o2(:,:)/DBLE(num_tot(:,:))
-    RETURN
-  END IF
-  nn=COUNT(found); IF(nn==0) RETURN
-
-!--- MISSING POINTS ; USE DISTANCE ON THE SPHERE TO FIND NEAREST POINT nr(2)
-  DO io = 1, mo
-    DO jo = 1, no
-      IF(found(io,jo)) CYCLE
-!      IF(prt_level>=1) PRINT*, "Problem: point out of domain (i,j)=", io,jo
-      CALL dist_sphe(x_o(io),y_o(jo),x_i,y_i,dist(:,:))
-      nr=MINLOC(dist(:,:))!; IF(prt_level>=1) PRINT*, "Solution: ", nr
-      inc=1.0; IF(li) inc=DBLE(d_i(nr(1),nr(2)))
-      IF(mask(nr(1),nr(2))) d_o1(io,jo)=inc
-    END DO
-  END DO
-
-END SUBROUTINE fine2coarse
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE grille_m(xdata, ydata, entree, x, y, sortie)
-!
-!-------------------------------------------------------------------------------
-! Author:  Z.X. Li (april 1st 1994) (see also A. Harzallah and L. Fairhead)
-!-------------------------------------------------------------------------------
-! Purpose: Naive method to regrid on a coarser grid.
-!   Value at a new point is an average of the old points lcoated in a zone
-!   surrounding the considered new point.
-!   No ponderation is used (see grille_p)
-!
-!           (c)
-!        ----d-----
-!        | . . . .|
-!        |        |
-!     (b)a . * . .b(a)
-!        |        |
-!        | . . . .|
-!        ----c-----
-!           (d)
-!
-!-------------------------------------------------------------------------------
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(IN)  :: xdata(:), ydata(:)       !--- INPUT  FIELD X AND Y COORD.
-  REAL, INTENT(IN)  :: entree(SIZE(xdata),SIZE(ydata)) !--- INPUT  FIELD
-  REAL, INTENT(IN)  :: x(:), y(:)               !--- OUTPUT FIELD X AND Y COORD.
-  REAL, INTENT(OUT) :: sortie(SIZE(x),SIZE(y))  !--- OUTPUT FIELD 
-!-------------------------------------------------------------------------------
-! Local variable:
-  DOUBLE PRECISION  :: out(SIZE(x),SIZE(y))
-!-------------------------------------------------------------------------------
-!  CALL fine2coarse(xdata,ydata,x,y,out,DBLE(entree))
-  CALL fine2coarse(xdata,ydata,x,y,out,entree)
-  sortie=REAL(out)
-
-END SUBROUTINE grille_m
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE rugosite(xdata, ydata, entree, x, y, sortie, mask)
-!
-!-------------------------------------------------------------------------------
-! Author:  Z.X. Li (april 1st 1994)
-!-------------------------------------------------------------------------------
-! Purpose: From topography field, compute ocean/land mask (land: 1 ; ocean: 0)
-! Naive method  (see grille_m)
-!-------------------------------------------------------------------------------
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(IN)  :: xdata(:), ydata(:)      !--- INPUT  FIELD X AND Y COORD.
-  REAL, INTENT(IN)  :: entree(SIZE(xdata),SIZE(ydata)) !--- INPUT  FIELD
-  REAL, INTENT(IN)  :: x(:), y(:)              !--- OUTPUT FIELD X AND Y COORD.
-  REAL, INTENT(OUT) :: sortie(SIZE(x),SIZE(y)) !--- OUTPUT FIELD 
-  REAL, INTENT(IN)  :: mask  (SIZE(x),SIZE(y)) !--- MASK
-!-------------------------------------------------------------------------------
-! Local variable:
-  DOUBLE PRECISION  :: out   (SIZE(x),SIZE(y))
-!-------------------------------------------------------------------------------
-  CALL fine2coarse(xdata,ydata,x,y,out,LOG(entree))
-  WHERE(NINT(mask)==1)
-    out(:,:)=EXP(out(:,:))
-  ELSE WHERE
-    out(:,:)=0.001
-  END WHERE
-  sortie=REAL(out)
-
-END SUBROUTINE rugosite
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE sea_ice(xdata, ydata, glace01, x, y, frac_ice)
-!
-!-------------------------------------------------------------------------------
-! Author:  Z.X. Li (april 1st 1994)
-! Purpose: Regrid ice indicator (0 or 1) on a coarser grid to get an ice fract.
-! field (between 0 and 1).
-! Naive method  (see grille_m)
-!-------------------------------------------------------------------------------
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(IN)  :: xdata(:), ydata(:)      !--- INPUT  FIELD X AND Y COORD.
-  REAL, INTENT(IN)  :: glace01(:,:)            !--- INPUT  FIELD
-  REAL, INTENT(IN)  :: x(:), y(:)              !--- OUTPUT FIELD X AND Y COORD.
-  REAL, INTENT(OUT) :: frac_ice(SIZE(x),SIZE(y)) !--- OUTPUT FIELD 
-!-------------------------------------------------------------------------------
-! Local variable:
-  DOUBLE PRECISION  :: out     (SIZE(x),SIZE(y))
-!-------------------------------------------------------------------------------
-  CALL fine2coarse(xdata,ydata,x,y,out,msk=NINT(glace01)==1)
-  frac_ice=REAL(out)
-
-END SUBROUTINE sea_ice
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE rugsoro(xrel, yrel, relief, xmod, ymod, rugs)
-!
-!-------------------------------------------------------------------------------
-! Author:  Z.X. Li (april 1st 1994) ; Modifications: august 23rd 1995.
-! Purpose: Compute rugosity due to orography by using standard dev in a 1x1 cell
-!-------------------------------------------------------------------------------
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(IN)  :: xrel(:), yrel(:)        !--- INPUT  FIELD X AND Y COORD.
-  REAL, INTENT(IN)  :: relief(:,:)             !--- INPUT  FIELD
-  REAL, INTENT(IN)  :: xmod(:), ymod(:)        !--- OUTPUT FIELD X AND Y COORD.
-  REAL, INTENT(OUT) :: rugs(SIZE(xmod),SIZE(ymod)) !--- OUTPUT FIELD 
-!-------------------------------------------------------------------------------
-! Local variable:
-  INTEGER           :: k, nn
-  INTEGER, PARAMETER:: itmp=360, jtmp=180
-  DOUBLE PRECISION  :: out(SIZE(xmod),SIZE(xmod)), amin, amax
-  DOUBLE PRECISION  :: cham1tmp(itmp,jtmp), cham2tmp(itmp,jtmp)
-  REAL              :: xtmp(itmp), ytmp(jtmp)
-!-------------------------------------------------------------------------------
-
-!--- TEST INPUT FILE FITS FOR ONE DEGREE RESOLUTION
-  xtmp(:)=4.0*ATAN(1.0)*[(-1.0+REAL(2*k-1)/REAL(itmp),k=1,itmp)]
-  ytmp(:)=2.0*ATAN(1.0)*[(-1.0+REAL(2*k-1)/REAL(jtmp),k=1,jtmp)]
-  CALL fine2coarse(xrel,yrel,xtmp,ytmp,cham1tmp,relief,d_o2=cham2tmp)
-  cham2tmp(:,:)=cham2tmp(:,:)-cham1tmp(:,:)**2
-  nn=COUNT(cham2tmp<=-7.5)
-  IF(nn/=0) THEN
-    PRINT*,'Problem for rugsoro ; std**2 < -7.5 for several points: ',nn
-    CALL ABORT_GCM("", "", 1)
-  END IF
-  nn=COUNT(cham2tmp<0)
-  IF(nn/=0) PRINT*,'Problem for rugsoro ; std**2 < 0. for several points: ',nn
-  WHERE(cham2tmp<0.0) cham2tmp=0.0d0
-  cham2tmp(:,:)=SQRT(cham2tmp(:,:))
-  amin=MINVAL(cham2tmp); amax=MAXVAL(cham2tmp)
-  PRINT*, 'Ecart-type 1x1:', amin, amax
-
-!--- COMPUTE RUGOSITY AT REQUIRED SCALE
-  WHERE(cham2tmp<0.001d0) cham2tmp=0.001d0
-  CALL fine2coarse(xtmp,ytmp,xmod,ymod,out,REAL(LOG(cham2tmp)))
-  out=EXP(out)
-  amin=MINVAL(out); amax=MAXVAL(out)
-  PRINT*, 'Ecart-type du modele:', amin, amax
-  out=out/amax*20.0d0
-  amin=MINVAL(out); amax=MAXVAL(out)
-  PRINT*, 'Longueur de rugosite du modele:', amin, amax
-  rugs=REAL(out)
-
-END SUBROUTINE rugsoro
-!
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE dist_sphe(rf_lon,rf_lat,rlon,rlat,distance)
-!
-!-------------------------------------------------------------------------------
-! Author:  Laurent Li (december 30th 1996).
-! Purpose: Compute min. distance (along big circle) between 2 points in degrees.
-!-------------------------------------------------------------------------------
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL, INTENT(IN) :: rf_lon, rf_lat  !--- Reference point coordinates (degrees)
-  REAL, INTENT(IN) :: rlon(:), rlat(:)!--- Points longitudes/latitudes (degrees)
-  REAL, INTENT(OUT):: distance(SIZE(rlon),SIZE(rlat)) !--- Distance    (degrees)
-!-------------------------------------------------------------------------------
-! Local variables:
-  LOGICAL, SAVE :: first=.TRUE.
-  REAL    :: pa, pb, cpa, cpab, spa, spab, crlo(SIZE(rlon))
-  INTEGER :: i, j
-!-------------------------------------------------------------------------------
-  IF(first) THEN
-    pi=4.0*ATAN(1.0); deg2rad=pi/180.0; first=.FALSE.
-  END IF
-  crlo(:)=COS((rf_lon-rlon(:))*deg2rad)     !--- COS of points 1 and 2 angle
-  pa=(90.0-rf_lat)*deg2rad                  !--- North Pole - Point 1 distance
-  cpa=COS(pa); spa=SIN(pa)
-  DO j=1,SIZE(rlat)
-    pb=(90.0-rlat(j))*deg2rad               !--- North Pole - Point 2 distance
-    cpab=cpa*COS(pb); spab=spa*SIN(pb)
-    distance(:,j)=ACOS(cpab+spab*crlo(:))/deg2rad
-  END DO
-
-END SUBROUTINE dist_sphe
-!
-!-------------------------------------------------------------------------------
-
-END MODULE grid_atob_m
-!
-!*******************************************************************************
-
Index: LMDZ5/trunk/libf/dynlonlat_phylonlat/grid_atob_m.f90
===================================================================
--- LMDZ5/trunk/libf/dynlonlat_phylonlat/grid_atob_m.f90	(revision 2299)
+++ LMDZ5/trunk/libf/dynlonlat_phylonlat/grid_atob_m.f90	(revision 2299)
@@ -0,0 +1,292 @@
+!*******************************************************************************
+!
+MODULE grid_atob_m
+!
+!*******************************************************************************
+
+  USE assert_eq_m, ONLY: assert_eq
+  REAL, SAVE :: pi, deg2rad
+
+  PRIVATE
+  PUBLIC :: grille_m, rugosite, sea_ice, rugsoro
+
+CONTAINS
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE fine2coarse(x_i, y_i, x_o, y_o, d_o1, d_i, msk, d_o2)
+!
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL,              INTENT(IN)  :: x_i(:), y_i(:) !-- INPUT  X&Y COOR. (mi)(ni)
+  REAL,              INTENT(IN)  :: x_o(:), y_o(:) !-- OUTPUT X&Y COOR. (mi)(ni)
+  REAL,              INTENT(OUT) :: d_o1(:,:)      !-- OUTPUT FIELD     (mo,no)
+  REAL,    OPTIONAL, INTENT(IN)  :: d_i (:,:)      !-- INPUT FIELD      (mi,ni)
+  LOGICAL, OPTIONAL, INTENT(IN)  :: msk (:,:)      !-- MASK             (mi,ni)
+  REAL,    OPTIONAL, INTENT(OUT) :: d_o2(:,:)      !-- OUTPUT FOR d_i^2 (mo,no)
+!-------------------------------------------------------------------------------
+! Local variables:
+  CHARACTER(LEN=256) :: modname="fine2coarse"
+  INTEGER :: mi, ni, ii, ji, mo, no, io, jo, nr(2), m1, n1, m2, n2, nn
+  INTEGER :: num_tot(SIZE(x_o),SIZE(y_o))
+  LOGICAL :: found(SIZE(x_o),SIZE(y_o)), li
+  LOGICAL :: mask (SIZE(x_i),SIZE(y_i)), lo
+  REAL    :: dist (SIZE(x_o),SIZE(y_o))
+  REAL    :: a(SIZE(x_o)), b(SIZE(x_o)), c(SIZE(y_o)), d(SIZE(y_o)), inc
+  REAL, PARAMETER :: thresh=1.E-5
+!-------------------------------------------------------------------------------
+  mask(:,:)=.TRUE.; IF(PRESENT(msk)) mask(:,:)=msk(:,:)
+  mi=SIZE(x_i); m1=mi; ni=SIZE(y_i); n1=ni
+  mo=SIZE(x_o); m2=mo; no=SIZE(y_o); n2=no
+  li=PRESENT(d_i ); IF(li) THEN; m1=SIZE(d_i ,1); n1=SIZE(d_i ,2); END IF
+  lo=PRESENT(d_o2); IF(lo) THEN; m2=SIZE(d_o2,1); n2=SIZE(d_o2,2); END IF
+  mi=assert_eq(mi,m1,SIZE(mask,1),TRIM(modname)//" mi")
+  ni=assert_eq(ni,n1,SIZE(mask,2),TRIM(modname)//" ni")
+  mo=assert_eq(mo,m2,SIZE(d_o1,1),TRIM(modname)//" mo")
+  no=assert_eq(no,n2,SIZE(d_o1,2),TRIM(modname)//" no")
+
+!--- COMPUTE CELLS INTERFACES COORDINATES OF OUTPUT GRID
+  b(mo)=x_o(mo)+(x_o(mo)-x_o(mo-1))/2.0; b(1:mo-1)=(x_o(1:mo-1)+x_o(2:mo))/2.0
+  d(no)=y_o(no)+(y_o(no)-y_o(no-1))/2.0; d(1:no-1)=(y_o(1:no-1)+y_o(2:no))/2.0
+  a(1 )=x_o(1 )-(x_o(2 )-x_o(1   ))/2.0; a(2:mo  )=   b(1:mo-1)
+  c(1 )=y_o(1 )-(y_o(2 )-y_o(1   ))/2.0; c(2:no  )=   d(1:no-1)
+
+!--- ACCUMULATE INPUT POINTS ON OUTPUT GRID
+  d_o1(:,:)=0.; num_tot(:,:)=0; inc=1.0
+  IF(lo) d_o2(:,:)=0.
+  DO ji = 1, ni
+    DO ii = 1, mi
+      IF(li) inc=d_i(ii,ji)
+      DO jo = 1, no
+        IF((y_i(ji)-c(jo)<thresh.OR.y_i(ji)-d(jo)>thresh).AND.   &
+           (y_i(ji)-c(jo)>thresh.OR.y_i(ji)-d(jo)<thresh)) CYCLE
+        DO io = 1, mo
+          IF((x_i(ii)-a(io)<thresh.OR.x_i(ii)-b(io)>thresh).AND. &
+             (x_i(ii)-a(io)>thresh.OR.x_i(ii)-b(io)<thresh)) CYCLE
+          num_tot(io,jo)=num_tot(io,jo)+1
+          IF(mask(ii,ji)) d_o1(io,jo)=d_o1(io,jo)+inc
+          IF(.NOT.lo) CYCLE
+          IF(mask(ii,ji)) d_o2(io,jo)=d_o2(io,jo)+inc*inc
+        END DO
+      END DO
+    END DO
+  END DO
+
+!--- CHECK INPUT POINTS HAVE BEEN FOUND IN EACH OUTPUT CELL
+  found(:,:)=num_tot(:,:)/=0
+  WHERE(found.AND.mask) d_o1(:,:)=d_o1(:,:)/REAL(num_tot(:,:))
+  IF(PRESENT(d_o2)) THEN
+    WHERE(found.AND.mask) d_o2(:,:)=d_o2(:,:)/REAL(num_tot(:,:))
+    RETURN
+  END IF
+  nn=COUNT(found); IF(nn==0) RETURN
+
+!--- MISSING POINTS ; USE DISTANCE ON THE SPHERE TO FIND NEAREST POINT nr(2)
+  DO io = 1, mo
+    DO jo = 1, no
+      IF(found(io,jo)) CYCLE
+!      IF(prt_level>=1) PRINT*, "Problem: point out of domain (i,j)=", io,jo
+      CALL dist_sphe(x_o(io),y_o(jo),x_i,y_i,dist(:,:))
+      nr=MINLOC(dist(:,:))!; IF(prt_level>=1) PRINT*, "Solution: ", nr
+      inc=1.0; IF(li) inc=d_i(nr(1),nr(2))
+      IF(mask(nr(1),nr(2))) d_o1(io,jo)=inc
+    END DO
+  END DO
+
+END SUBROUTINE fine2coarse
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE grille_m(xdata, ydata, entree, x, y, sortie)
+!
+!-------------------------------------------------------------------------------
+! Author:  Z.X. Li (april 1st 1994) (see also A. Harzallah and L. Fairhead)
+!-------------------------------------------------------------------------------
+! Purpose: Naive method to regrid on a coarser grid.
+!   Value at a new point is an average of the old points lcoated in a zone
+!   surrounding the considered new point.
+!   No ponderation is used (see grille_p)
+!
+!           (c)
+!        ----d-----
+!        | . . . .|
+!        |        |
+!     (b)a . * . .b(a)
+!        |        |
+!        | . . . .|
+!        ----c-----
+!           (d)
+!
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)  :: xdata(:), ydata(:)       !--- INPUT  FIELD X AND Y COORD.
+  REAL, INTENT(IN)  :: entree(SIZE(xdata),SIZE(ydata)) !--- INPUT  FIELD
+  REAL, INTENT(IN)  :: x(:), y(:)               !--- OUTPUT FIELD X AND Y COORD.
+  REAL, INTENT(OUT) :: sortie(SIZE(x),SIZE(y))  !--- OUTPUT FIELD 
+!-------------------------------------------------------------------------------
+  CALL fine2coarse(xdata,ydata,x,y,sortie,entree)
+
+END SUBROUTINE grille_m
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE rugosite(xdata, ydata, entree, x, y, sortie, mask)
+!
+!-------------------------------------------------------------------------------
+! Author:  Z.X. Li (april 1st 1994)
+!-------------------------------------------------------------------------------
+! Purpose: Remap rugosity length ; constant value (0.001) on oceans.
+! Naive method  (see grille_m)
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)  :: xdata(:), ydata(:)      !--- INPUT  FIELD X AND Y COORD.
+  REAL, INTENT(IN)  :: entree(SIZE(xdata),SIZE(ydata)) !--- INPUT  FIELD
+  REAL, INTENT(IN)  :: x(:), y(:)              !--- OUTPUT FIELD X AND Y COORD.
+  REAL, INTENT(OUT) :: sortie(SIZE(x),SIZE(y)) !--- OUTPUT FIELD 
+  REAL, INTENT(IN)  :: mask  (SIZE(x),SIZE(y)) !--- MASK
+!-------------------------------------------------------------------------------
+  CALL fine2coarse(xdata,ydata,x,y,sortie,LOG(entree))
+  WHERE(NINT(mask)==1)
+    sortie(:,:)=EXP(sortie(:,:))
+  ELSE WHERE
+    sortie(:,:)=0.001
+  END WHERE
+
+END SUBROUTINE rugosite
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE sea_ice(xdata, ydata, glace01, x, y, frac_ice)
+!
+!-------------------------------------------------------------------------------
+! Author:  Z.X. Li (april 1st 1994)
+! Purpose: Regrid ice indicator (0 or 1) on a coarser grid to get an ice fract.
+! field (between 0 and 1).
+! Naive method  (see grille_m)
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)  :: xdata(:), ydata(:)      !--- INPUT  FIELD X AND Y COORD.
+  REAL, INTENT(IN)  :: glace01(:,:)            !--- INPUT  FIELD
+  REAL, INTENT(IN)  :: x(:), y(:)              !--- OUTPUT FIELD X AND Y COORD.
+  REAL, INTENT(OUT) :: frac_ice(SIZE(x),SIZE(y)) !--- OUTPUT FIELD 
+!-------------------------------------------------------------------------------
+  CALL fine2coarse(xdata,ydata,x,y,frac_ice,msk=NINT(glace01)==1)
+
+END SUBROUTINE sea_ice
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE rugsoro(xrel, yrel, relief, xmod, ymod, rugs)
+!
+!-------------------------------------------------------------------------------
+! Author:  Z.X. Li (april 1st 1994) ; Modifications: august 23rd 1995.
+! Purpose: Compute rugosity due to orography by using standard dev in a 1x1 cell
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)  :: xrel(:), yrel(:)        !--- INPUT  FIELD X AND Y COORD.
+  REAL, INTENT(IN)  :: relief(:,:)             !--- INPUT  FIELD
+  REAL, INTENT(IN)  :: xmod(:), ymod(:)        !--- OUTPUT FIELD X AND Y COORD.
+  REAL, INTENT(OUT) :: rugs(SIZE(xmod),SIZE(ymod)) !--- OUTPUT FIELD 
+!-------------------------------------------------------------------------------
+! Local variable:
+  INTEGER           :: k, nn
+  INTEGER, PARAMETER:: itmp=360, jtmp=180
+  REAL  :: out(SIZE(xmod),SIZE(xmod)), amin, amax
+  REAL  :: cham1tmp(itmp,jtmp), cham2tmp(itmp,jtmp), xtmp(itmp), ytmp(jtmp)
+!-------------------------------------------------------------------------------
+
+!--- TEST INPUT FILE FITS FOR ONE DEGREE RESOLUTION
+  xtmp(:)=4.0*ATAN(1.0)*[(-1.0+REAL(2*k-1)/REAL(itmp),k=1,itmp)]
+  ytmp(:)=2.0*ATAN(1.0)*[(-1.0+REAL(2*k-1)/REAL(jtmp),k=1,jtmp)]
+  CALL fine2coarse(xrel,yrel,xtmp,ytmp,cham1tmp,relief,d_o2=cham2tmp)
+  cham2tmp(:,:)=cham2tmp(:,:)-cham1tmp(:,:)**2
+  nn=COUNT(cham2tmp<=-7.5)
+  IF(nn/=0) THEN
+    PRINT*,'Problem for rugsoro ; std**2 < -7.5 for several points: ',nn
+    CALL ABORT_GCM("", "", 1)
+  END IF
+  nn=COUNT(cham2tmp<0)
+  IF(nn/=0) PRINT*,'Problem for rugsoro ; std**2 < 0. for several points: ',nn
+  WHERE(cham2tmp<0.0) cham2tmp=0.0
+  cham2tmp(:,:)=SQRT(cham2tmp(:,:))
+  amin=MINVAL(cham2tmp); amax=MAXVAL(cham2tmp)
+  PRINT*, 'Ecart-type 1x1:', amin, amax
+
+!--- COMPUTE RUGOSITY AT REQUIRED SCALE
+  WHERE(cham2tmp<0.001) cham2tmp=0.001
+  CALL fine2coarse(xtmp,ytmp,xmod,ymod,out,REAL(LOG(cham2tmp)))
+  out=EXP(out)
+  amin=MINVAL(out); amax=MAXVAL(out)
+  PRINT*, 'Ecart-type du modele:', amin, amax
+  out=out/amax*20.0
+  amin=MINVAL(out); amax=MAXVAL(out)
+  PRINT*, 'Longueur de rugosite du modele:', amin, amax
+  rugs=REAL(out)
+
+END SUBROUTINE rugsoro
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE dist_sphe(rf_lon,rf_lat,rlon,rlat,distance)
+!
+!-------------------------------------------------------------------------------
+! Author:  Laurent Li (december 30th 1996).
+! Purpose: Compute min. distance (along big circle) between 2 points in degrees.
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN) :: rf_lon, rf_lat  !--- Reference point coordinates (degrees)
+  REAL, INTENT(IN) :: rlon(:), rlat(:)!--- Points longitudes/latitudes (degrees)
+  REAL, INTENT(OUT):: distance(SIZE(rlon),SIZE(rlat)) !--- Distance    (degrees)
+!-------------------------------------------------------------------------------
+! Local variables:
+  LOGICAL, SAVE :: first=.TRUE.
+  REAL    :: pa, pb, cpa, cpab, spa, spab, crlo(SIZE(rlon))
+  INTEGER :: i, j
+!-------------------------------------------------------------------------------
+  IF(first) THEN
+    pi=4.0*ATAN(1.0); deg2rad=pi/180.0; first=.FALSE.
+  END IF
+  crlo(:)=COS((rf_lon-rlon(:))*deg2rad)     !--- COS of points 1 and 2 angle
+  pa=(90.0-rf_lat)*deg2rad                  !--- North Pole - Point 1 distance
+  cpa=COS(pa); spa=SIN(pa)
+  DO j=1,SIZE(rlat)
+    pb=(90.0-rlat(j))*deg2rad               !--- North Pole - Point 2 distance
+    cpab=cpa*COS(pb); spab=spa*SIN(pb)
+    distance(:,j)=ACOS(cpab+spab*crlo(:))/deg2rad
+  END DO
+
+END SUBROUTINE dist_sphe
+!
+!-------------------------------------------------------------------------------
+
+END MODULE grid_atob_m
+!
+!*******************************************************************************
+
Index: LMDZ5/trunk/libf/phylmd/etat0phys_netcdf.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/etat0phys_netcdf.F90	(revision 2298)
+++ LMDZ5/trunk/libf/phylmd/etat0phys_netcdf.F90	(revision 2299)
@@ -62,5 +62,5 @@
   REAL, SAVE :: deg2rad
   REAL, SAVE, ALLOCATABLE :: tsol(:)
-  REAL, SAVE, ALLOCATABLE :: rugo(:,:)  ! ??? COMPUTED BUT NOT USED ???
+!  REAL, SAVE, ALLOCATABLE :: rugo(:,:)  ! ??? COMPUTED BUT NOT USED ???
   INTEGER,            SAVE      :: iml_phys, jml_phys, llm_phys, ttm_phys, fid_phys
   REAL, ALLOCATABLE,  SAVE      :: lon_phys(:,:), lat_phys(:,:), levphys_ini(:)
@@ -86,5 +86,4 @@
   USE fonte_neige_mod
   USE pbl_surface_mod
-  USE filtreg_mod
   USE regr_lat_time_climoz_m, ONLY: regr_lat_time_climoz
   USE indice_sol_mod
@@ -335,5 +334,5 @@
 !===============================================================================
   USE conf_dat_m,  ONLY: conf_dat2d
-  USE grid_atob_m, ONLY: rugsoro
+!  USE grid_atob_m, ONLY: rugsoro
   USE grid_noro_m, ONLY: grid_noro
   IMPLICIT NONE
@@ -393,10 +392,11 @@
 
 !--- COMPUTE SURFACE ROUGHNESS
-  WRITE(lunout,*)
-  WRITE(lunout,*)'*** Compute surface roughness induced by the orography ***'
-  ALLOCATE(tmp_var(iml-1,jml))
-  CALL rugsoro(lon_rad, lat_rad, relief_hi, lon_in(1:iml-1), lat_in, tmp_var)
-  ALLOCATE(rugo(iml,jml)); rugo(1:iml-1,:)=tmp_var; rugo(iml,:)=tmp_var(1,:)
-  DEALLOCATE(relief_hi,tmp_var,lon_rad,lat_rad)
+!  WRITE(lunout,*)
+!  WRITE(lunout,*)'*** Compute surface roughness induced by the orography ***'
+!  ALLOCATE(tmp_var(iml-1,jml))
+!  CALL rugsoro(lon_rad, lat_rad, relief_hi, lon_in(1:iml-1), lat_in, tmp_var)
+!  ALLOCATE(rugo(iml,jml)); rugo(1:iml-1,:)=tmp_var; rugo(iml,:)=tmp_var(1,:)
+!  DEALLOCATE(tmp_var)
+  DEALLOCATE(relief_hi,lon_rad,lat_rad)
 
 !--- PUT QUANTITIES TO PHYSICAL GRID
Index: LMDZ5/trunk/libf/phylmd/phyredem.F90
===================================================================
--- LMDZ5/trunk/libf/phylmd/phyredem.F90	(revision 2298)
+++ LMDZ5/trunk/libf/phylmd/phyredem.F90	(revision 2299)
@@ -132,4 +132,7 @@
     PRINT*, "Trop de sous-surfaces"; CALL abort_gcm("phyredem", "", 1)
   END IF
+  IF(nsw>99) THEN
+    PRINT*, "Trop de bandes"; CALL abort_gcm("phyredem", "", 1)
+  END IF
 
   CALL put_field_srf1("TS","Temperature",ftsol(:,:))
@@ -149,5 +152,5 @@
   CALL put_field_srf1("EVAP", "Evaporation", fevap(:,:))
 
-  CALL put_field_srf1("SNOW", "Neige", fevap(:,:))
+  CALL put_field_srf1("SNOW", "Neige", snow(:,:))
 
   CALL put_field("RADS", "Rayonnement net a la surface", radsol)
@@ -302,5 +305,5 @@
   REAL,              INTENT(IN) :: field(:,:)
   CHARACTER(LEN=256) :: nm, lm, str
-  DO nsrf = 1, nbsrf
+  DO nsrf = 1, SIZE(field,2)
     WRITE(str, '(i2.2)') nsrf
     nm=TRIM(nam)//TRIM(str)
@@ -318,6 +321,6 @@
   REAL,              INTENT(IN) :: field(:,:,:)
   CHARACTER(LEN=256) :: nm, lm, str
-  DO nsrf = 1, nbsrf
-    DO isoil=1, nsw
+  DO nsrf = 1, SIZE(field,3)
+    DO isoil=1, SIZE(field,2)
       WRITE(str, '(i2.2,"srf",i2.2)')isoil,nsrf
 !      WRITE(lunout,*)"PHYREDEM ",TRIM(nam)//TRIM(str)
@@ -337,5 +340,5 @@
   REAL,              INTENT(IN) :: field(:,:,:)
   CHARACTER(LEN=256) :: nm, lm, str
-  DO nsrf = 1, nbsrf
+  DO nsrf = 1, SIZE(field,3)
     WRITE(str, '(i2.2)') nsrf
     nm=TRIM(nam)//TRIM(str)
