Index: LMDZ5/branches/testing/libf/bibio/initdynav.F
===================================================================
--- LMDZ5/branches/testing/libf/bibio/initdynav.F	(revision 1664)
+++ 	(revision )
@@ -1,200 +1,0 @@
-!
-! $Id$
-!
-      subroutine initdynav(day0,anne0,tstep,t_ops,t_wrt)
-
-#ifdef CPP_IOIPSL
-       USE IOIPSL
-#endif
-       USE infotrac, ONLY : nqtot, ttext
-      use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid,       &
-     &        dynhistave_file,dynhistvave_file,dynhistuave_file
-      implicit none
-
-C
-C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
-C   au format IOIPSL. Initialisation du fichier histoire moyenne.
-C
-C   Appels succesifs des routines: histbeg
-C                                  histhori
-C                                  histver
-C                                  histdef
-C                                  histend
-C
-C   Entree:
-C
-C      infile: nom du fichier histoire a creer
-C      day0,anne0: date de reference
-C      tstep : frequence d'ecriture
-C      t_ops: frequence de l'operation pour IOIPSL
-C      t_wrt: frequence d'ecriture sur le fichier
-C
-C
-C   L. Fairhead, LMD, 03/99
-C
-C =====================================================================
-C
-C   Declarations
-#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"
-
-C   Arguments
-C
-      integer day0, anne0
-      real tstep, t_ops, t_wrt
-
-#ifdef CPP_IOIPSL
-! This routine needs IOIPSL to work
-C   Variables locales
-C
-      integer tau0
-      real zjulian
-      integer iq
-      real rlong(iip1,jjp1), rlat(iip1,jjp1)
-      integer uhoriid, vhoriid, thoriid, zvertiid
-      integer ii,jj
-      integer zan, dayref
-C
-C  Initialisations
-C
-      pi = 4. * atan (1.)
-C
-C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
-C         
-
-      zan = anne0
-      dayref = day0
-      CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
-      tau0 = itau_dyn
-      
-      do jj = 1, jjp1
-        do ii = 1, iip1
-          rlong(ii,jj) = rlonv(ii) * 180. / pi
-          rlat(ii,jj)  = rlatu(jj) * 180. / pi
-        enddo
-      enddo
-       
-! Creation de 3 fichiers pour les differentes grilles horizontales
-! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
-! Grille Scalaire       
-      call histbeg(dynhistave_file, iip1, rlong(:,1), jjp1, rlat(1,:),
-     .             1, iip1, 1, jjp1,
-     .             tau0, zjulian, tstep, thoriid,histaveid)
-
-C  Creation du fichier histoire pour les grilles en V et U (oblige pour l'instant,
-C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
-C  un meme fichier)
-! Grille V
-      do jj = 1, jjm
-        do ii = 1, iip1
-          rlong(ii,jj) = rlonv(ii) * 180. / pi
-          rlat(ii,jj) = rlatv(jj) * 180. / pi
-        enddo
-      enddo
-
-      call histbeg(dynhistvave_file, iip1, rlong(:,1), jjm, rlat(1,:),
-     .             1, iip1, 1, jjm,
-     .             tau0, zjulian, tstep, vhoriid,histvaveid)
-! Grille U
-      do jj = 1, jjp1
-        do ii = 1, iip1
-          rlong(ii,jj) = rlonu(ii) * 180. / pi
-          rlat(ii,jj) = rlatu(jj) * 180. / pi
-        enddo
-      enddo
-
-      call histbeg(dynhistuave_file, iip1, rlong(:,1),jjp1, rlat(1,:),
-     .             1, iip1, 1, jjp1,
-     .             tau0, zjulian, tstep, uhoriid,histuaveid)
-C
-C  Appel a histvert pour la grille verticale
-C
-      call histvert(histaveid,'presnivs','Niveaux Pression
-     &     approximatifs','mb',llm, presnivs/100., zvertiid,'down')
-      call histvert(histuaveid,'presnivs','Niveaux Pression
-     &     approximatifs','mb',llm, presnivs/100., zvertiid,'down')
-      call histvert(histvaveid,'presnivs','Niveaux Pression
-     &     approximatifs','mb',llm, presnivs/100., zvertiid,'down')
-C
-C  Appels a histdef pour la definition des variables a sauvegarder
-C
-C  Vents U
-C
-!      write(6,*)'inithistave',tstep
-      call histdef(histuaveid, 'u', 'vent u moyen ',
-     .             'm/s', iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-
-C  Vents V
-C
-      call histdef(histvaveid, 'v', 'vent v moyen',
-     .             'm/s', iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-
-C
-C  Temperature
-C
-      call histdef(histaveid, 'temp', 'temperature moyenne', 'K',
-     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-C
-C  Temperature potentielle
-C
-      call histdef(histaveid, 'theta', 'temperature potentielle', 'K',
-     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-C
-C  Geopotentiel
-C
-      call histdef(histaveid, 'phi', 'geopotentiel moyen', '-',
-     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-C
-C  Traceurs
-C
-!        DO iq=1,nqtot
-!          call histdef(histaveid, ttext(iq), ttext(iq), '-',
-!     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
-!     .             32, 'ave(X)', t_ops, t_wrt)
-!        enddo
-C
-C  Masse
-C
-      call histdef(histaveid, 'masse', 'masse', 'kg',
-     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-C
-C  Pression au sol
-C
-      call histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa',
-     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
-     .             32, 'ave(X)', t_ops, t_wrt)
-C
-C  Geopotentiel au sol
-C
-!      call histdef(histaveid, 'phis', 'geopotentiel au sol', '-',
-!     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
-!     .             32, 'ave(X)', t_ops, t_wrt)
-!C
-C  Fin
-C
-      call histend(histaveid)
-      call histend(histuaveid)
-      call histend(histvaveid)
-#else
-! tell the user this routine should be run with ioipsl
-      write(lunout,*)"initdynav: Warning this routine should not be",
-     &               " used without ioipsl"
-#endif
-! of #ifdef CPP_IOIPSL
-      return
-      end
Index: LMDZ5/branches/testing/libf/bibio/initdynav.F90
===================================================================
--- LMDZ5/branches/testing/libf/bibio/initdynav.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/bibio/initdynav.F90	(revision 1665)
@@ -0,0 +1,194 @@
+! $Id$
+
+subroutine initdynav(day0,anne0,tstep,t_ops,t_wrt)
+
+#ifdef CPP_IOIPSL
+  USE IOIPSL
+#endif
+  USE infotrac, ONLY : nqtot, ttext
+  use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid, &
+       dynhistave_file,dynhistvave_file,dynhistuave_file
+  implicit none
+
+
+  !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
+  !   au format IOIPSL. Initialisation du fichier histoire moyenne.
+
+  !   Appels succesifs des routines: histbeg
+  !                                  histhori
+  !                                  histver
+  !                                  histdef
+  !                                  histend
+
+  !   Entree:
+
+  !      infile: nom du fichier histoire a creer
+  !      day0,anne0: date de reference
+  !      tstep : frequence d'ecriture
+  !      t_ops: frequence de l'operation pour IOIPSL
+  !      t_wrt: frequence d'ecriture sur le fichier
+
+
+  !   L. Fairhead, LMD, 03/99
+
+  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
+
+  integer day0, anne0
+  real tstep, t_ops, t_wrt
+
+#ifdef CPP_IOIPSL
+  ! This routine needs IOIPSL to work
+  !   Variables locales
+
+  integer tau0
+  real zjulian
+  integer iq
+  real rlong(iip1,jjp1), rlat(iip1,jjp1)
+  integer uhoriid, vhoriid, thoriid, zvertiid
+  integer ii,jj
+  integer zan, dayref
+
+  !--------------------------------------------------------------------
+
+  !  Initialisations
+
+  pi = 4. * atan (1.)
+
+  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
+
+
+  zan = anne0
+  dayref = day0
+  CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
+  tau0 = itau_dyn
+
+  do jj = 1, jjp1
+     do ii = 1, iip1
+        rlong(ii,jj) = rlonv(ii) * 180. / pi
+        rlat(ii,jj)  = rlatu(jj) * 180. / pi
+     enddo
+  enddo
+
+  ! Creation de 3 fichiers pour les differentes grilles horizontales
+  ! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
+  ! Grille Scalaire       
+  call histbeg(dynhistave_file, iip1, rlong(:,1), jjp1, rlat(1,:), &
+       1, iip1, 1, jjp1, &
+       tau0, zjulian, tstep, thoriid,histaveid)
+
+  ! Creation du fichier histoire pour les grilles en V et U (oblige
+  ! pour l'instant, IOIPSL ne permet pas de grilles avec des nombres
+  ! de point differents dans  un meme fichier)
+  ! Grille V
+  do jj = 1, jjm
+     do ii = 1, iip1
+        rlong(ii,jj) = rlonv(ii) * 180. / pi
+        rlat(ii,jj) = rlatv(jj) * 180. / pi
+     enddo
+  enddo
+
+  call histbeg(dynhistvave_file, iip1, rlong(:,1), jjm, rlat(1,:), &
+       1, iip1, 1, jjm, &
+       tau0, zjulian, tstep, vhoriid,histvaveid)
+  ! Grille U
+  do jj = 1, jjp1
+     do ii = 1, iip1
+        rlong(ii,jj) = rlonu(ii) * 180. / pi
+        rlat(ii,jj) = rlatu(jj) * 180. / pi
+     enddo
+  enddo
+
+  call histbeg(dynhistuave_file, iip1, rlong(:,1),jjp1, rlat(1,:), &
+       1, iip1, 1, jjp1, &
+       tau0, zjulian, tstep, uhoriid,histuaveid)
+
+  !  Appel a histvert pour la grille verticale
+
+  call histvert(histaveid,'presnivs','Niveaux Pression approximatifs','mb', &
+       llm, presnivs/100., zvertiid,'down')
+  call histvert(histuaveid,'presnivs','Niveaux Pression approximatifs','mb', &
+       llm, presnivs/100., zvertiid,'down')
+  call histvert(histvaveid,'presnivs','Niveaux Pression approximatifs','mb', &
+       llm, presnivs/100., zvertiid,'down')
+
+  !  Appels a histdef pour la definition des variables a sauvegarder
+
+  !  Vents U
+
+  call histdef(histuaveid, 'u', 'vent u moyen ', &
+       'm/s', iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
+       32, 'ave(X)', t_ops, t_wrt)
+
+  !  Vents V
+
+  call histdef(histvaveid, 'v', 'vent v moyen', &
+       'm/s', iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
+       32, 'ave(X)', t_ops, t_wrt)
+
+
+  !  Temperature
+
+  call histdef(histaveid, 'temp', 'temperature moyenne', 'K', &
+       iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
+       32, 'ave(X)', t_ops, t_wrt)
+
+  !  Temperature potentielle
+
+  call histdef(histaveid, 'theta', 'temperature potentielle', 'K', &
+       iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
+       32, 'ave(X)', t_ops, t_wrt)
+
+  !  Geopotentiel
+
+  call histdef(histaveid, 'phi', 'geopotentiel moyen', '-', &
+       iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
+       32, 'ave(X)', t_ops, t_wrt)
+
+  !  Traceurs
+
+  !        DO iq=1,nqtot
+  !          call histdef(histaveid, ttext(iq), ttext(iq), '-', &
+  !                  iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
+  !                  32, 'ave(X)', t_ops, t_wrt)
+  !        enddo
+
+  !  Masse
+
+  call histdef(histaveid, 'masse', 'masse', 'kg', &
+       iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
+       32, 'ave(X)', t_ops, t_wrt)
+
+  !  Pression au sol
+
+  call histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa', &
+       iip1, jjp1, thoriid, 1, 1, 1, -99, &
+       32, 'ave(X)', t_ops, t_wrt)
+
+  !  Geopotentiel au sol
+
+  !      call histdef(histaveid, 'phis', 'geopotentiel au sol', '-', &
+  !                  iip1, jjp1, thoriid, 1, 1, 1, -99, &
+  !                  32, 'ave(X)', t_ops, t_wrt)
+
+  call histend(histaveid)
+  call histend(histuaveid)
+  call histend(histvaveid)
+#else
+  write(lunout,*)"initdynav: Warning this routine should not be", &
+       " used without ioipsl"
+#endif
+  ! of #ifdef CPP_IOIPSL
+
+end subroutine initdynav
Index: LMDZ5/branches/testing/libf/bibio/lnblnk.F
===================================================================
--- LMDZ5/branches/testing/libf/bibio/lnblnk.F	(revision 1664)
+++ 	(revision )
@@ -1,39 +1,0 @@
-!
-! $Header$
-!
-      INTEGER FUNCTION lnblnk (letter)
-
-C--------------------------------------------------------
-C Fonction qui determine la longeur d'un string sans les
-C blancs qui suivent. Le critere pour determiner la fin du
-C string est, trois blancs de suite
-C---------------------------------------------------------
-C     ARGUMENTS
-C     +++++++++
-C     letter: CHARACTER*xxx (xxx < imax)
-C             le string dont on determine la longuer
-C     lnblnk: INTEGER
-C             le nombre de characteres
-C
-C     PARAMETER
-C     +++++++++
-C     imax : INTEGER
-C            le nombre maximale de character que peut contenir le string
-C            a traiter
-
-      IMPLICIT NONE
-      INTEGER i,imax
-      PARAMETER (imax = 256)
-      CHARACTER(*) letter
-
-      i=0
-
-10    i=i+1
-      IF (letter(i:i+3) . EQ . '   ') GOTO 20
-      GOTO 10
-
-20    lnblnk=i-1
-
-      RETURN
-      END
-
Index: LMDZ5/branches/testing/libf/bibio/new_unit.F90
===================================================================
--- LMDZ5/branches/testing/libf/bibio/new_unit.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/bibio/new_unit.F90	(revision 1665)
@@ -0,0 +1,25 @@
+module new_unit_m
+
+  implicit none
+
+contains
+
+  subroutine new_unit(unit)
+
+    integer, intent(out):: unit
+
+    ! Variables local to the procedure:
+    logical opened, exist
+
+    !------------------------------------------------------
+
+    unit = 0
+    do
+       inquire(unit=unit, opened=opened, exist=exist)
+       if (exist .and. .not. opened) exit
+       unit = unit + 1
+    end do
+
+  end subroutine new_unit
+
+end module new_unit_m
Index: LMDZ5/branches/testing/libf/bibio/writedynav.F
===================================================================
--- LMDZ5/branches/testing/libf/bibio/writedynav.F	(revision 1664)
+++ 	(revision )
@@ -1,152 +1,0 @@
-!
-! $Id$
-!
-      subroutine writedynav(time, vcov, 
-     ,                ucov,teta,ppk,phi,q,masse,ps,phis)
-
-#ifdef CPP_IOIPSL
-      USE ioipsl
-#endif
-      USE infotrac, ONLY : nqtot, ttext
-      use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid
-      implicit none
-
-C
-C   Ecriture du fichier histoire au format IOIPSL
-C
-C   Appels succesifs des routines: histwrite
-C
-C   Entree:
-C      time: temps de l'ecriture
-C      vcov: vents v covariants
-C      ucov: vents u covariants
-C      teta: temperature potentielle
-C      phi : geopotentiel instantane
-C      q   : traceurs
-C      masse: masse
-C      ps   :pression au sol
-C      phis : geopotentiel au sol
-C      
-C
-C
-C   L. Fairhead, LMD, 03/99
-C
-C =====================================================================
-C
-C   Declarations
-#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"
-
-C
-C   Arguments
-C
-
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
-      REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm)     
-      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
-      REAL phis(ip1jmp1)                  
-      REAL q(ip1jmp1,llm,nqtot)
-      integer time
-
-
-#ifdef CPP_IOIPSL
-! This routine needs IOIPSL to work
-C   Variables locales
-C
-      integer ndex2d(ip1jmp1),ndexu(ip1jmp1*llm),ndexv(ip1jm*llm)
-      INTEGER iq, ii, ll
-      real tm(ip1jmp1*llm)
-      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm) 
-      logical ok_sync
-      integer itau_w
-C
-C  Initialisations
-C
-      ndexu = 0
-      ndexv = 0
-      ndex2d = 0
-      ok_sync = .TRUE.
-      tm = 999.999
-      vnat = 999.999
-      unat = 999.999
-      itau_w = itau_dyn + time
-
-C Passage aux composantes naturelles du vent
-      call covnat(llm, ucov, vcov, unat, vnat)
-
-C
-C  Appels a histwrite pour l'ecriture des variables a sauvegarder
-C
-C  Vents U 
-C
-      call histwrite(histuaveid, 'u', itau_w, unat, 
-     .               iip1*jjp1*llm, ndexu)
-C
-C  Vents V
-C
-      call histwrite(histvaveid, 'v', itau_w, vnat, 
-     .               iip1*jjm*llm, ndexv)
-C
-C  Temperature potentielle moyennee
-C
-      call histwrite(histaveid, 'theta', itau_w, teta, 
-     .                iip1*jjp1*llm, ndexu)
-C
-C  Temperature moyennee
-C
-      do ii = 1, ijp1llm
-        tm(ii) = teta(ii) * ppk(ii)/cpp
-      enddo
-      call histwrite(histaveid, 'temp', itau_w, tm, 
-     .                iip1*jjp1*llm, ndexu)
-C
-C  Geopotentiel
-C
-      call histwrite(histaveid, 'phi', itau_w, phi, 
-     .                iip1*jjp1*llm, ndexu)
-C
-C  Traceurs
-C
-!        DO iq=1,nqtot
-!          call histwrite(histaveid, ttext(iq), itau_w, q(:,:,iq), 
-!     .                   iip1*jjp1*llm, ndexu)
-!        enddo
-C
-C  Masse
-C
-       call histwrite(histaveid, 'masse', itau_w, masse, 
-     $                   iip1*jjp1*llm, ndexu)
-C
-C  Pression au sol
-C
-       call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
-C
-C  Geopotentiel au sol
-C
-!       call histwrite(histaveid,'phis',itau_w, phis,iip1*jjp1, ndex2d)
-C
-C  Fin
-C
-      if (ok_sync) then
-          call histsync(histaveid)
-          call histsync(histvaveid)
-          call histsync(histuaveid)
-      ENDIF
-
-#else
-! tell the user this routine should be run with ioipsl
-      write(lunout,*)"writedynav: Warning this routine should not be",
-     &               " used without ioipsl"
-#endif
-! of #ifdef CPP_IOIPSL
-      return
-      end
Index: LMDZ5/branches/testing/libf/bibio/writedynav.F90
===================================================================
--- LMDZ5/branches/testing/libf/bibio/writedynav.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/bibio/writedynav.F90	(revision 1665)
@@ -0,0 +1,141 @@
+! $Id$
+
+subroutine writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
+
+#ifdef CPP_IOIPSL
+  USE ioipsl
+#endif
+  USE infotrac, ONLY : nqtot, ttext
+  use com_io_dyn_mod, only : histaveid, histvaveid, histuaveid
+
+  implicit none
+
+  !   Ecriture du fichier histoire au format IOIPSL
+
+  !   Appels succesifs des routines: histwrite
+
+  !   Entree:
+  !      time: temps de l'ecriture
+  !      vcov: vents v covariants
+  !      ucov: vents u covariants
+  !      teta: temperature potentielle
+  !      phi : geopotentiel instantane
+  !      q   : traceurs
+  !      masse: masse
+  !      ps   :pression au sol
+  !      phis : geopotentiel au sol
+
+  !   L. Fairhead, LMD, 03/99
+
+  !   Declarations
+  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
+
+  REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) 
+  REAL teta(ip1jmp1*llm), phi(ip1jmp1, llm), ppk(ip1jmp1*llm)     
+  REAL ps(ip1jmp1), masse(ip1jmp1, llm)                   
+  REAL phis(ip1jmp1)                  
+  REAL q(ip1jmp1, llm, nqtot)
+  integer time
+
+#ifdef CPP_IOIPSL
+  ! This routine needs IOIPSL to work
+  !   Variables locales
+
+  integer ndex2d(ip1jmp1), ndexu(ip1jmp1*llm), ndexv(ip1jm*llm)
+  INTEGER iq, ii, ll
+  real tm(ip1jmp1*llm)
+  REAL vnat(ip1jm, llm), unat(ip1jmp1, llm) 
+  logical ok_sync
+  integer itau_w
+
+  !-----------------------------------------------------------------
+
+  !  Initialisations
+
+  ndexu = 0
+  ndexv = 0
+  ndex2d = 0
+  ok_sync = .TRUE.
+  tm = 999.999
+  vnat = 999.999
+  unat = 999.999
+  itau_w = itau_dyn + time
+
+  ! Passage aux composantes naturelles du vent
+  call covnat(llm, ucov, vcov, unat, vnat)
+
+  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
+
+  !  Vents U 
+
+  call histwrite(histuaveid, 'u', itau_w, unat,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Vents V
+
+  call histwrite(histvaveid, 'v', itau_w, vnat,  &
+       iip1*jjm*llm, ndexv)
+
+  !  Temperature potentielle moyennee
+
+  call histwrite(histaveid, 'theta', itau_w, teta,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Temperature moyennee
+
+  do ii = 1, ijp1llm
+     tm(ii) = teta(ii) * ppk(ii)/cpp
+  enddo
+  call histwrite(histaveid, 'temp', itau_w, tm,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Geopotentiel
+
+  call histwrite(histaveid, 'phi', itau_w, phi,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Traceurs
+
+  !  DO iq=1, nqtot
+  !       call histwrite(histaveid, ttext(iq), itau_w, q(:, :, iq), &
+  !                   iip1*jjp1*llm, ndexu)
+  ! enddo
+
+  !  Masse
+
+  call histwrite(histaveid, 'masse', itau_w, masse,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Pression au sol
+
+  call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
+
+  ! Geopotentiel au sol
+
+  ! call histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
+
+  if (ok_sync) then
+     call histsync(histaveid)
+     call histsync(histvaveid)
+     call histsync(histuaveid)
+  ENDIF
+
+#else
+  write(lunout, *) "writedynav: Warning this routine should not be", &
+       " used without ioipsl"
+#endif
+  ! of #ifdef CPP_IOIPSL
+
+end subroutine writedynav
Index: LMDZ5/branches/testing/libf/dyn3d/calfis.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/calfis.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/calfis.F	(revision 1665)
@@ -165,5 +165,5 @@
       PARAMETER(ntetaSTD=3)
       REAL rtetaSTD(ntetaSTD)
-      DATA rtetaSTD/350., 380., 405./
+      DATA rtetaSTD/350., 380., 405./ ! Earth-specific values, beware !!
       REAL PVteta(ngridmx,ntetaSTD)
 c
@@ -434,5 +434,6 @@
 c
       if (planet_type=="earth") then
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
+! PVtheta calls tetalevel, which is in the physics
 cIM calcul PV a teta=350, 380, 405K
       CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta,
@@ -450,6 +451,4 @@
 
 
-      if (planet_type=="earth") then
-#ifdef CPP_EARTH
 
 !      write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
@@ -460,5 +459,8 @@
       zdqfic(:,:,:)=0.
 
-      do isplit=1,nsplit_phys
+      if (planet_type=="earth") then
+#ifdef CPP_PHYS
+
+       do isplit=1,nsplit_phys
 
          jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys)
@@ -503,5 +505,10 @@
          zdqfic(:,:,:)=zdqfic(:,:,:)+zdqfi(:,:,:)
 
-      enddo
+       enddo ! of do isplit=1,nsplit_phys
+
+#endif
+! of #ifdef CPP_PHYS
+      endif ! of if (planet_type=="earth")
+
       zdufi(:,:)=zdufic(:,:)/nsplit_phys
       zdvfi(:,:)=zdvfic(:,:)/nsplit_phys
@@ -509,6 +516,4 @@
       zdqfi(:,:,:)=zdqfic(:,:,:)/nsplit_phys
 
-#endif
-      endif !of if (planet_type=="earth")
 
 500   CONTINUE
Index: LMDZ5/branches/testing/libf/dyn3d/ce0l.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/ce0l.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/ce0l.F90	(revision 1665)
@@ -28,4 +28,5 @@
   IMPLICIT NONE
 #ifndef CPP_EARTH
+#include "iniprint.h"
   WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
 #else
Index: LMDZ5/branches/testing/libf/dyn3d/comvert.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/comvert.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/comvert.h	(revision 1665)
@@ -9,5 +9,5 @@
      &               aps(llm),bps(llm),scaleheight
 
-      common/comverti/disvert_type
+      common/comverti/disvert_type, pressure_exner
 
       real ap     ! hybrid pressure contribution at interlayers
@@ -30,3 +30,7 @@
                            !     using 'z2sig.def' (or 'esasig.def) file
 
+      logical pressure_exner
+!     compute pressure inside layers using Exner function, else use mean
+!     of pressure values at interfaces
+
  !-----------------------------------------------------------------------
Index: LMDZ5/branches/testing/libf/dyn3d/conf_gcm.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/conf_gcm.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/conf_gcm.F	(revision 1665)
@@ -155,4 +155,12 @@
       nday = 10
       CALL getin('nday',nday)
+
+!Config  Key  = starttime
+!Config  Desc = Heure de depart de la simulation
+!Config  Def  = 0
+!Config  Help = Heure de depart de la simulation
+!Config         en jour
+      starttime = 0
+      CALL getin('starttime',starttime)
 
 !Config  Key  = day_step
Index: LMDZ5/branches/testing/libf/dyn3d/control_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/control_mod.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/control_mod.F90	(revision 1665)
@@ -10,5 +10,5 @@
   IMPLICIT NONE
 
-  REAL    :: periodav
+  REAL    :: periodav, starttime
   INTEGER :: nday,day_step,iperiod,iapp_tracvl,nsplit_phys
   INTEGER :: iconser,iecri,dissip_period,iphysiq,iecrimoy
Index: LMDZ5/branches/testing/libf/dyn3d/disvert.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/disvert.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/disvert.F90	(revision 1665)
@@ -4,4 +4,7 @@
 
   ! Auteur : P. Le Van
+
+  use new_unit_m, only: new_unit
+  use ioipsl, only: getin
 
   IMPLICIT NONE
@@ -26,20 +29,28 @@
   real zk, zkm1, dzk1, dzk2, k0, k1
 
-  INTEGER l
+  INTEGER l, unit
   REAL dsigmin
   REAL alpha, beta, deltaz
-  INTEGER iostat
   REAL x
   character(len=*),parameter :: modname="disvert"
 
+  character(len=6):: vert_sampling
+  ! (allowed values are "param", "tropo", "strato" and "read")
+
   !-----------------------------------------------------------------------
+
+  print *, "Call sequence information: disvert"
 
   ! default scaleheight is 8km for earth
   scaleheight=8.
 
-  OPEN(99, file='sigma.def', status='old', form='formatted', iostat=iostat)
+  vert_sampling = merge("strato", "tropo ", ok_strato) ! default value
+  call getin('vert_sampling', vert_sampling)
+  print *, 'vert_sampling = ' // vert_sampling
 
-  IF (iostat == 0) THEN
-     ! cas 1 on lit les options dans sigma.def:
+  select case (vert_sampling)
+  case ("param")
+     ! On lit les options dans sigma.def:
+     OPEN(99, file='sigma.def', status='old', form='formatted')
      READ(99, *) scaleheight ! hauteur d'echelle 8.
      READ(99, *) deltaz ! epaiseur de la premiere couche 0.04
@@ -68,32 +79,8 @@
 
      sig(llm+1)=0.
-
-     DO l = 1, llm
-        dsig(l) = sig(l)-sig(l+1)
-     end DO
-  ELSE
-     if (ok_strato) then
-        if (llm==39) then
-           dsigmin=0.3
-        else if (llm==50) then
-           dsigmin=1.
-        else
-           write(lunout,*) trim(modname), &
-           ' ATTENTION discretisation z a ajuster'
-           dsigmin=1.
-        endif
-        write(lunout,*) trim(modname), &
-        ' Discretisation verticale DSIGMIN=',dsigmin
-     endif
-
+  case("tropo")
      DO l = 1, llm
         x = 2*asin(1.) * (l - 0.5) / (llm + 1)
-
-        IF (ok_strato) THEN
-           dsig(l) =(dsigmin + 7. * SIN(x)**2) &
-                *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2
-        ELSE
-           dsig(l) = 1.0 + 7.0 * SIN(x)**2
-        ENDIF
+        dsig(l) = 1.0 + 7.0 * SIN(x)**2
      ENDDO
      dsig = dsig / sum(dsig)
@@ -102,5 +89,37 @@
         sig(l) = sig(l+1) + dsig(l)
      ENDDO
-  ENDIF
+  case("strato")
+     if (llm==39) then
+        dsigmin=0.3
+     else if (llm==50) then
+        dsigmin=1.
+     else
+        write(lunout,*) trim(modname), ' ATTENTION discretisation z a ajuster'
+        dsigmin=1.
+     endif
+     WRITE(LUNOUT,*) trim(modname), 'Discretisation verticale DSIGMIN=',dsigmin
+
+     DO l = 1, llm
+        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
+        dsig(l) =(dsigmin + 7. * SIN(x)**2) &
+             *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2
+     ENDDO
+     dsig = dsig / sum(dsig)
+     sig(llm+1) = 0.
+     DO l = llm, 1, -1
+        sig(l) = sig(l+1) + dsig(l)
+     ENDDO
+  case("read")
+     call new_unit(unit)
+     open(unit, file="hybrid.txt", status="old", action="read", &
+          position="rewind")
+     read(unit, fmt=*) ! skip title line
+     do l = 1, llm + 1
+        read(unit, fmt=*) sig(l)
+     end do
+     close(unit)
+  case default
+     call abort_gcm("disvert", 'Wrong value for "vert_sampling"', 1)
+  END select
 
   DO l=1, llm
Index: LMDZ5/branches/testing/libf/dyn3d/dynetat0.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/dynetat0.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/dynetat0.F	(revision 1665)
@@ -119,4 +119,5 @@
       day_ini = tab_cntrl(30)
       itau_dyn = tab_cntrl(31)
+      start_time = tab_cntrl(32)
 c   .................................................................
 c
Index: LMDZ5/branches/testing/libf/dyn3d/dynredem.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/dynredem.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/dynredem.F	(revision 1665)
@@ -120,4 +120,6 @@
        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    .........................................................
Index: LMDZ5/branches/testing/libf/dyn3d/etat0_netcdf.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/etat0_netcdf.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/etat0_netcdf.F90	(revision 1665)
@@ -251,7 +251,7 @@
 !*******************************************************************************
   CALL pression(ip1jmp1, ap, bp, psol, p3d)
-  if (disvert_type.eq.1) then
+  if (pressure_exner) then
     CALL exner_hyb(ip1jmp1, psol, p3d, alpha, beta, pks, pk, y)
-  else ! we assume that we are in the disvert_type==2 case
+  else
     CALL exner_milieu(ip1jmp1,psol,p3d,beta,pks,pk,y)
   endif
Index: LMDZ5/branches/testing/libf/dyn3d/exner_hyb.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/exner_hyb.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/exner_hyb.F	(revision 1665)
@@ -56,11 +56,4 @@
       ! Sanity check
       if (firstcall) then
-        ! check that vertical discretization is compatible
-        ! with this routine
-        if (disvert_type.ne.1) then
-          call abort_gcm(modname,
-     &     "this routine should only be called if disvert_type==1",42)
-        endif
-        
         ! sanity checks for Shallow Water case (1 vertical layer)
         if (llm.eq.1) then
Index: LMDZ5/branches/testing/libf/dyn3d/exner_milieu.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/exner_milieu.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/exner_milieu.F	(revision 1665)
@@ -53,11 +53,4 @@
       ! Sanity check
       if (firstcall) then
-        ! check that vertical discretization is compatible
-        ! with this routine
-        if (disvert_type.ne.2) then
-          call abort_gcm(modname,
-     &     "this routine should only be called if disvert_type==2",42)
-        endif
-        
         ! sanity checks for Shallow Water case (1 vertical layer)
         if (llm.eq.1) then
Index: LMDZ5/branches/testing/libf/dyn3d/gcm.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/gcm.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/gcm.F	(revision 1665)
@@ -21,6 +21,5 @@
 ! A nettoyer. On ne veut qu'une ou deux routines d'interface 
 ! dynamique -> physique pour l'initialisation
-! Ehouarn: for now these only apply to Earth:
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
       USE dimphy
       USE comgeomphy
@@ -88,5 +87,4 @@
 
       REAL zdtvr
-      INTEGER nbetatmoy, nbetatdem,nbetat
 
 c   variables dynamiques
@@ -181,11 +179,8 @@
 ! A nettoyer. On ne veut qu'une ou deux routines d'interface 
 ! dynamique -> physique pour l'initialisation
-! Ehouarn : temporarily (?) keep this only for Earth
-      if (planet_type.eq."earth") then
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
       CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
       call InitComgeomphy
 #endif
-      endif
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 c-----------------------------------------------------------------------
@@ -305,4 +300,15 @@
 C on remet le calendrier à zero si demande
 c
+      IF (start_time /= starttime) then
+        WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le'
+     &,' fichier restart ne correspond pas à celle lue dans le run.def'
+        IF (raz_date == 1) then
+          WRITE(lunout,*)'Je prends l''heure lue dans run.def'
+          start_time = starttime
+        ELSE
+          WRITE(lunout,*)'Je m''arrete'
+          CALL abort
+        ENDIF
+      ENDIF
       IF (raz_date == 1) THEN
         annee_ref = anneeref
@@ -373,7 +379,4 @@
 #endif
 
-c  nombre d'etats dans les fichiers demarrage et histoire
-      nbetatdem = nday / iecri
-      nbetatmoy = nday / periodav + 1
 
       if (iflag_phys.eq.1) then
@@ -428,14 +431,11 @@
          WRITE(lunout,*)
      .       'GCM: WARNING!!! vitesse verticale nulle dans la physique'
-! Earth:
-         if (planet_type.eq."earth") then
-#ifdef CPP_EARTH
+! Physics:
+#ifdef CPP_PHYS
          CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys ,
      ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
 #endif
-         endif ! of if (planet_type.eq."earth")
          call_iniphys=.false.
       ENDIF ! of IF (call_iniphys.and.(iflag_phys.eq.1))
-!#endif
 
 c  numero de stockage pour les fichiers de redemarrage:
@@ -459,5 +459,5 @@
 #endif
 
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
 ! Create start file (startphy.nc) and boundary conditions (limit.nc) 
 ! for the Earth verstion
Index: LMDZ5/branches/testing/libf/dyn3d/guide_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/guide_mod.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/guide_mod.F90	(revision 1665)
@@ -644,7 +644,7 @@
 ! -----------------------------------------------------------------
     CALL pression( ip1jmp1, ap, bp, psi, p )
-    if (disvert_type==1) then
+    if (pressure_exner) then
       CALL exner_hyb(ip1jmp1,psi,p,alpha,beta,pks,pk,pkf)
-    else ! we assume that we are in the disvert_type==2 case
+    else
       CALL exner_milieu(ip1jmp1,psi,p,beta,pks,pk,pkf)
     endif
Index: LMDZ5/branches/testing/libf/dyn3d/iniacademic.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/iniacademic.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/iniacademic.F90	(revision 1665)
@@ -222,12 +222,8 @@
 
         CALL pression ( ip1jmp1, ap, bp, ps, p       )
-        if (disvert_type.eq.1) then
+        if (pressure_exner) then
           CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
-        elseif (disvert_type.eq.2) then
+        else
           call exner_milieu(ip1jmp1,ps,p,beta,pks,pk,pkf)
-        else
-          write(abort_message,*) "Wrong value for disvert_type: ", &
-                              disvert_type
-          call abort_gcm(modname,abort_message,0)
         endif
         CALL massdair(p,masse)
Index: LMDZ5/branches/testing/libf/dyn3d/iniconst.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/iniconst.F	(revision 1664)
+++ 	(revision )
@@ -1,84 +1,0 @@
-!
-! $Id$
-!
-      SUBROUTINE iniconst
-
-      USE control_mod
-#ifdef CPP_IOIPSL
-      use IOIPSL
-#else
-! if not using IOIPSL, we still need to use (a local version of) getin
-      use ioipsl_getincom
-#endif
-
-      IMPLICIT NONE
-c
-c      P. Le Van
-c
-c-----------------------------------------------------------------------
-c   Declarations:
-c   -------------
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "temps.h"
-#include "comvert.h"
-#include "iniprint.h"
-
-      character(len=*),parameter :: modname="iniconst"
-      character(len=80) :: abort_message
-c
-c
-c
-c-----------------------------------------------------------------------
-c   dimension des boucles:
-c   ----------------------
-
-      im      = iim
-      jm      = jjm
-      lllm    = llm
-      imp1    = iim 
-      jmp1    = jjm + 1
-      lllmm1  = llm - 1
-      lllmp1  = llm + 1
-
-c-----------------------------------------------------------------------
-
-      dtphys  = iphysiq * dtvr
-      unsim   = 1./iim
-      pi      = 2.*ASIN( 1. )
-
-c-----------------------------------------------------------------------
-c
-
-      r       = cpp * kappa
-
-      write(lunout,*) trim(modname),': R  CP  Kappa ',r,cpp,kappa
-c
-c-----------------------------------------------------------------------
-
-! vertical discretization: default behavior depends on planet_type flag
-      if (planet_type=="earth") then
-        disvert_type=1
-      else
-        disvert_type=2
-      endif
-      ! but user can also specify using one or the other in run.def:
-      call getin('disvert_type',disvert_type)
-      write(lunout,*) trim(modname),': disvert_type=',disvert_type
-      
-      if (disvert_type==1) then
-       ! standard case for Earth (automatic generation of levels)
-       call disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig,
-     &              scaleheight)
-      else if (disvert_type==2) then
-        ! standard case for planets (levels generated using z2sig.def file)
-        call disvert_noterre
-      else
-        write(abort_message,*) "Wrong value for disvert_type: ",
-     &                        disvert_type
-        call abort_gcm(modname,abort_message,0)
-      endif
-
-      END
Index: LMDZ5/branches/testing/libf/dyn3d/iniconst.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/iniconst.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/dyn3d/iniconst.F90	(revision 1665)
@@ -0,0 +1,84 @@
+!
+! $Id$
+!
+SUBROUTINE iniconst
+
+  USE control_mod
+#ifdef CPP_IOIPSL
+  use IOIPSL
+#else
+  ! if not using IOIPSL, we still need to use (a local version of) getin
+  use ioipsl_getincom
+#endif
+
+  IMPLICIT NONE
+  !
+  !      P. Le Van
+  !
+  !   Declarations:
+  !   -------------
+  !
+  include "dimensions.h"
+  include "paramet.h"
+  include "comconst.h"
+  include "temps.h"
+  include "comvert.h"
+  include "iniprint.h"
+
+  character(len=*),parameter :: modname="iniconst"
+  character(len=80) :: abort_message
+  !
+  !
+  !
+  !-----------------------------------------------------------------------
+  !   dimension des boucles:
+  !   ----------------------
+
+  im      = iim
+  jm      = jjm
+  lllm    = llm
+  imp1    = iim 
+  jmp1    = jjm + 1
+  lllmm1  = llm - 1
+  lllmp1  = llm + 1
+
+  !-----------------------------------------------------------------------
+
+  dtphys  = iphysiq * dtvr
+  unsim   = 1./iim
+  pi      = 2.*ASIN( 1. )
+
+  !-----------------------------------------------------------------------
+  !
+
+  r       = cpp * kappa
+
+  write(lunout,*) trim(modname),': R  CP  Kappa ',r,cpp,kappa
+  !
+  !-----------------------------------------------------------------------
+
+  ! vertical discretization: default behavior depends on planet_type flag
+  if (planet_type=="earth") then
+     disvert_type=1
+  else
+     disvert_type=2
+  endif
+  ! but user can also specify using one or the other in run.def:
+  call getin('disvert_type',disvert_type)
+  write(lunout,*) trim(modname),': disvert_type=',disvert_type
+
+  pressure_exner = disvert_type == 1 ! default value
+  call getin('pressure_exner', pressure_exner)
+
+  if (disvert_type==1) then
+     ! standard case for Earth (automatic generation of levels)
+     call disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig, scaleheight)
+  else if (disvert_type==2) then
+     ! standard case for planets (levels generated using z2sig.def file)
+     call disvert_noterre
+  else
+     write(abort_message,*) "Wrong value for disvert_type: ", disvert_type
+     call abort_gcm(modname,abort_message,0)
+  endif
+
+END SUBROUTINE iniconst
Index: LMDZ5/branches/testing/libf/dyn3d/inidissip.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/inidissip.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/inidissip.F90	(revision 1665)
@@ -28,7 +28,8 @@
 ! Local variables:
   REAL fact,zvert(llm),zz
-  REAL zh(ip1jmp1),zu(ip1jmp1),zv(ip1jm),deltap(ip1jmp1,llm)
+  REAL zh(ip1jmp1),zu(ip1jmp1), gx(ip1jmp1), divgra(ip1jmp1)
+  real zv(ip1jm), gy(ip1jm), deltap(ip1jmp1,llm)
   REAL ullm,vllm,umin,vmin,zhmin,zhmax
-  REAL zllm,z1llm
+  REAL zllm
 
   INTEGER l,ij,idum,ii
@@ -78,16 +79,11 @@
   DO l = 1,50
      IF(lstardis) THEN
-        CALL divgrad2(1,zh,deltap,niterh,zh)
+        CALL divgrad2(1,zh,deltap,niterh,divgra)
      ELSE
-        CALL divgrad (1,zh,niterh,zh)
+        CALL divgrad (1,zh,niterh,divgra)
      ENDIF
 
-     CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
-
-     zllm  = ABS( zhmax )
-     z1llm = 1./zllm
-     DO ij = 1,ip1jmp1
-        zh(ij) = zh(ij)* z1llm
-     ENDDO
+     zllm  = ABS(maxval(divgra))
+     zh = divgra / zllm
   ENDDO
 
@@ -123,30 +119,19 @@
            !cccc             CALL covcont( 1,zu,zv,zu,zv )
            IF(lstardis) THEN
-              CALL gradiv2( 1,zu,zv,nitergdiv,zu,zv )
+              CALL gradiv2( 1,zu,zv,nitergdiv,gx,gy )
            ELSE
-              CALL gradiv ( 1,zu,zv,nitergdiv,zu,zv )
+              CALL gradiv ( 1,zu,zv,nitergdiv,gx,gy )
            ENDIF
         ELSE
            IF(lstardis) THEN
-              CALL nxgraro2( 1,zu,zv,nitergrot,zu,zv )
+              CALL nxgraro2( 1,zu,zv,nitergrot,gx,gy )
            ELSE
-              CALL nxgrarot( 1,zu,zv,nitergrot,zu,zv )
+              CALL nxgrarot( 1,zu,zv,nitergrot,gx,gy )
            ENDIF
         ENDIF
 
-        CALL minmax(iip1*jjp1,zu,umin,ullm )
-        CALL minmax(iip1*jjm, zv,vmin,vllm )
-
-        ullm = ABS  ( ullm )
-        vllm = ABS  ( vllm )
-
-        zllm  = MAX( ullm,vllm )
-        z1llm = 1./ zllm
-        DO ij = 1, ip1jmp1
-           zu(ij) = zu(ij)* z1llm
-        ENDDO
-        DO ij = 1, ip1jm
-           zv(ij) = zv(ij)* z1llm
-        ENDDO
+        zllm = max(abs(maxval(gx)), abs(maxval(gy)))
+        zu = gx / zllm
+        zv = gy / zllm
      end DO
 
Index: LMDZ5/branches/testing/libf/dyn3d/inigrads.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/inigrads.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/inigrads.F	(revision 1665)
@@ -9,5 +9,5 @@
       implicit none
 
-      integer if,im,jm,lm,i,j,l,lnblnk
+      integer if,im,jm,lm,i,j,l
       real x(im),y(jm),z(lm),fx,fy,fz,dt
       real xmin,xmax,ymin,ymax
@@ -40,5 +40,5 @@
       ivar(if)=0
 
-      fichier(if)=file(1:lnblnk(file))
+      fichier(if)=trim(file)
 
       firsttime(if)=.true.
@@ -70,7 +70,7 @@
 
       print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if))
-      print*,file(1:lnblnk(file))//'.dat'
+      print*,trim(file)//'.dat'
 
-      OPEN (unit(if)+1,FILE=file(1:lnblnk(file))//'.dat'
+      OPEN (unit(if)+1,FILE=trim(file)//'.dat'
      s   ,FORM='unformatted',
      s   ACCESS='direct'
Index: LMDZ5/branches/testing/libf/dyn3d/integrd.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/integrd.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/integrd.F	(revision 1665)
@@ -4,5 +4,6 @@
       SUBROUTINE integrd
      $  (  nq,vcovm1,ucovm1,tetam1,psm1,massem1,
-     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis,finvmaold )
+     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis !,finvmaold
+     &  )
 
       use control_mod, only : planet_type
@@ -34,20 +35,30 @@
 #include "temps.h"
 #include "serre.h"
+#include "iniprint.h"
 
 c   Arguments:
 c   ----------
 
-      INTEGER nq
-
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
-      REAL q(ip1jmp1,llm,nq)
-      REAL ps(ip1jmp1),masse(ip1jmp1,llm),phis(ip1jmp1)
-
-      REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
-      REAL tetam1(ip1jmp1,llm),psm1(ip1jmp1),massem1(ip1jmp1,llm)
-
-      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
-      REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
-      REAL dq(ip1jmp1,llm,nq), finvmaold(ip1jmp1,llm)
+      integer,intent(in) :: nq ! number of tracers to handle in this routine
+      real,intent(inout) :: vcov(ip1jm,llm) ! covariant meridional wind
+      real,intent(inout) :: ucov(ip1jmp1,llm) ! covariant zonal wind
+      real,intent(inout) :: teta(ip1jmp1,llm) ! potential temperature
+      real,intent(inout) :: q(ip1jmp1,llm,nq) ! advected tracers
+      real,intent(inout) :: ps(ip1jmp1) ! surface pressure
+      real,intent(inout) :: masse(ip1jmp1,llm) ! atmospheric mass
+      real,intent(in) :: phis(ip1jmp1) ! ground geopotential !!! unused
+      ! values at previous time step
+      real,intent(inout) :: vcovm1(ip1jm,llm)
+      real,intent(inout) :: ucovm1(ip1jmp1,llm)
+      real,intent(inout) :: tetam1(ip1jmp1,llm)
+      real,intent(inout) :: psm1(ip1jmp1)
+      real,intent(inout) :: massem1(ip1jmp1,llm)
+      ! the tendencies to add
+      real,intent(in) :: dv(ip1jm,llm)
+      real,intent(in) :: du(ip1jmp1,llm)
+      real,intent(in) :: dteta(ip1jmp1,llm)
+      real,intent(in) :: dp(ip1jmp1)
+      real,intent(in) :: dq(ip1jmp1,llm,nq) !!! unused
+!      real,intent(out) :: finvmaold(ip1jmp1,llm) !!! unused
 
 c   Local:
@@ -55,5 +66,6 @@
 
       REAL vscr( ip1jm ),uscr( ip1jmp1 ),hscr( ip1jmp1 ),pscr(ip1jmp1)
-      REAL massescr( ip1jmp1,llm ), finvmasse(ip1jmp1,llm)
+      REAL massescr( ip1jmp1,llm )
+!      REAL finvmasse(ip1jmp1,llm)
       REAL p(ip1jmp1,llmp1)
       REAL tpn,tps,tppn(iim),tpps(iim)
@@ -61,5 +73,5 @@
       REAL deltap( ip1jmp1,llm )
 
-      INTEGER  l,ij,iq
+      INTEGER  l,ij,iq,i,j
 
       REAL SSUM
@@ -88,7 +100,12 @@
       DO ij = 1,ip1jmp1
         IF( ps(ij).LT.0. ) THEN
-         PRINT*,' Au point ij = ',ij, ' , pression sol neg. ', ps(ij)
-         print *, ' dans integrd'
-         stop 1
+         write(lunout,*) "integrd: negative surface pressure ",ps(ij)
+         write(lunout,*) " at node ij =", ij
+         ! since ij=j+(i-1)*jjp1 , we have
+         j=modulo(ij,jjp1)
+         i=1+(ij-j)/jjp1
+         write(lunout,*) " lon = ",rlonv(i)*180./pi, " deg",
+     &                   " lat = ",rlatu(j)*180./pi, " deg"
+         stop
         ENDIF
       ENDDO
@@ -110,6 +127,8 @@
       CALL massdair (     p  , masse         )
 
-      CALL   SCOPY( ijp1llm  , masse, 1, finvmasse,  1      )
-      CALL filtreg( finvmasse, jjp1, llm, -2, 2, .TRUE., 1  )
+! Ehouarn : we don't use/need finvmaold and finvmasse,
+!           so might as well not compute them
+!      CALL   SCOPY( ijp1llm  , masse, 1, finvmasse,  1      )
+!      CALL filtreg( finvmasse, jjp1, llm, -2, 2, .TRUE., 1  )
 c
 
@@ -218,6 +237,6 @@
        ENDDO
 
-
-      CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
+! Ehouarn: forget about finvmaold
+!      CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
 
       endif ! of if (planet_type.eq."earth")
Index: LMDZ5/branches/testing/libf/dyn3d/leapfrog.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/leapfrog.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/leapfrog.F	(revision 1665)
@@ -72,5 +72,4 @@
 
       real zqmin,zqmax
-      INTEGER nbetatmoy, nbetatdem,nbetat
 
 c   variables dynamiques
@@ -118,5 +117,6 @@
 
       REAL  SSUM
-      REAL time_0 , finvmaold(ip1jmp1,llm)
+      REAL time_0
+!     REAL finvmaold(ip1jmp1,llm)
 
 cym      LOGICAL  lafin
@@ -212,7 +212,7 @@
       dq(:,:,:)=0.
       CALL pression ( ip1jmp1, ap, bp, ps, p       )
-      if (disvert_type==1) then
+      if (pressure_exner) then
         CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
-      else ! we assume that we are in the disvert_type==2 case
+      else
         CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
       endif
@@ -222,9 +222,12 @@
 c   ----------------------------------
 
-   1  CONTINUE
-
-      jD_cur = jD_ref + day_ini - day_ref + int (itau * dtvr / daysec) 
-      jH_cur = jH_ref +                                                 &
-     &          (itau * dtvr / daysec - int(itau * dtvr / daysec)) 
+   1  CONTINUE ! Matsuno Forward step begins here
+
+      jD_cur = jD_ref + day_ini - day_ref +                             &
+     &          itau/day_step
+      jH_cur = jH_ref + start_time +                                    &
+     &          mod(itau,day_step)/float(day_step) 
+      jD_cur = jD_cur + int(jH_cur)
+      jH_cur = jH_cur - int(jH_cur)
 
 
@@ -255,9 +258,9 @@
 
 c   ...    P.Le Van .26/04/94  ....
-
-      CALL SCOPY   ( ijp1llm,   masse, 1, finvmaold,     1 )
-      CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
-
-   2  CONTINUE
+! Ehouarn: finvmaold is actually not used
+!      CALL SCOPY   ( ijp1llm,   masse, 1, finvmaold,     1 )
+!      CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
+
+   2  CONTINUE ! Matsuno backward or leapfrog step begins here
 
 c-----------------------------------------------------------------------
@@ -302,4 +305,5 @@
 c   --------------------------------
 
+      ! compute geopotential phi()
       CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
 
@@ -315,5 +319,6 @@
 
       IF( forward. OR . leapf )  THEN
-
+! Ehouarn: NB: at this point p with ps are not synchronized
+!              (whereas mass and ps are...)
          CALL caladvtrac(q,pbaru,pbarv,
      *        p, masse, dq,  teta,
@@ -340,6 +345,6 @@
 
        CALL integrd ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
-     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
-     $              finvmaold                                    )
+     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis )
+!     $              finvmaold                                    )
 
 
@@ -364,7 +369,7 @@
 
          CALL pression (  ip1jmp1, ap, bp, ps,  p      )
-         if (disvert_type==1) then
+         if (pressure_exner) then
            CALL exner_hyb(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
-         else ! we assume that we are in the disvert_type==2 case
+         else
            CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
          endif
@@ -372,8 +377,14 @@
 !           rdaym_ini  = itau * dtvr / daysec
 !           rdayvrai   = rdaym_ini  + day_ini
-           jD_cur = jD_ref + day_ini - day_ref
-     $        + int (itau * dtvr / daysec) 
-           jH_cur = jH_ref +                                            &
-     &              (itau * dtvr / daysec - int(itau * dtvr / daysec)) 
+!           jD_cur = jD_ref + day_ini - day_ref
+!     $        + int (itau * dtvr / daysec) 
+!           jH_cur = jH_ref +                                            &
+!     &              (itau * dtvr / daysec - int(itau * dtvr / daysec)) 
+           jD_cur = jD_ref + day_ini - day_ref +                        &
+     &          itau/day_step
+           jH_cur = jH_ref + start_time +                               &
+     &              mod(itau,day_step)/float(day_step) 
+           jD_cur = jD_cur + int(jH_cur)
+           jH_cur = jH_cur - int(jH_cur)
 !         write(lunout,*)'itau, jD_cur = ', itau, jD_cur, jH_cur
 !         call ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes)
@@ -394,6 +405,8 @@
 ! Ehouarn: be careful, diagedyn is Earth-specific (includes ../phylmd/..)!
            IF (planet_type.eq."earth") THEN
+#ifdef CPP_EARTH
             CALL diagedyn(ztit,2,1,1,dtphys
      &    , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
+#endif
            ENDIF
          ENDIF ! of IF (ip_ebil_dyn.ge.1 )
@@ -472,7 +485,7 @@
 
         CALL pression ( ip1jmp1, ap, bp, ps, p                  )
-        if (disvert_type==1) then
+        if (pressure_exner) then
           CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
-        else ! we assume that we are in the disvert_type==2 case
+        else
           CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
         endif
@@ -529,16 +542,20 @@
         ENDDO
 
-        DO ij =  1,iim
-          tppn(ij)  = aire(  ij    ) * ps (  ij    )
-          tpps(ij)  = aire(ij+ip1jm) * ps (ij+ip1jm)
-        ENDDO
-          tpn  = SSUM(iim,tppn,1)/apoln
-          tps  = SSUM(iim,tpps,1)/apols
-
-        DO ij = 1, iip1
-          ps(  ij    ) = tpn
-          ps(ij+ip1jm) = tps
-        ENDDO
-
+        if (1 == 0) then
+!!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
+!!!                     2) should probably not be here anyway
+!!! but are kept for those who would want to revert to previous behaviour
+           DO ij =  1,iim
+             tppn(ij)  = aire(  ij    ) * ps (  ij    )
+             tpps(ij)  = aire(ij+ip1jm) * ps (ij+ip1jm)
+           ENDDO
+             tpn  = SSUM(iim,tppn,1)/apoln
+             tps  = SSUM(iim,tpps,1)/apols
+
+           DO ij = 1, iip1
+             ps(  ij    ) = tpn
+             ps(ij+ip1jm) = tps
+           ENDDO
+        endif ! of if (1 == 0)
 
       END IF ! of IF(apdiss)
@@ -622,5 +639,4 @@
              ! Ehouarn: output only during LF or Backward Matsuno
 	     if (leapf.or.(.not.leapf.and.(.not.forward))) then
-              nbetat = nbetatdem
               CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
               unat=0.
@@ -652,9 +668,10 @@
 !              if (planet_type.eq."earth") then
 ! Write an Earth-format restart file
-                CALL dynredem1("restart.nc",0.0,
+                CALL dynredem1("restart.nc",start_time,
      &                         vcov,ucov,teta,q,masse,ps)
 !              endif ! of if (planet_type.eq."earth")
 
               CLOSE(99)
+              !!! Ehouarn: Why not stop here and now?
             ENDIF ! of IF (itau.EQ.itaufin)
 
@@ -740,5 +757,4 @@
               IF(MOD(itau,iecri         ).EQ.0) THEN
 c              IF(MOD(itau,iecri*day_step).EQ.0) THEN
-                nbetat = nbetatdem
                 CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
                 unat=0.
@@ -763,5 +779,5 @@
               IF(itau.EQ.itaufin) THEN
 !                if (planet_type.eq."earth") then
-                  CALL dynredem1("restart.nc",0.0,
+                  CALL dynredem1("restart.nc",start_time,
      &                           vcov,ucov,teta,q,masse,ps)
 !                endif ! of if (planet_type.eq."earth")
Index: LMDZ5/branches/testing/libf/dyn3d/temps.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/temps.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/temps.h	(revision 1665)
@@ -14,10 +14,12 @@
 
       COMMON/temps/itaufin, dt, day_ini, day_end, annee_ref, day_ref,   &
-     &             itau_dyn, itau_phy, jD_ref, jH_ref, calend
+     &             itau_dyn, itau_phy, jD_ref, jH_ref, calend,          &
+     &             start_time
+
 
       INTEGER   itaufin
       INTEGER itau_dyn, itau_phy
       INTEGER day_ini, day_end, annee_ref, day_ref
-      REAL      dt, jD_ref, jH_ref
+      REAL      dt, jD_ref, jH_ref, start_time
       CHARACTER (len=10) :: calend
 
Index: LMDZ5/branches/testing/libf/dyn3d/wrgrads.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3d/wrgrads.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3d/wrgrads.F	(revision 1665)
@@ -26,5 +26,5 @@
 c   local
 
-      integer im,jm,lm,i,j,l,lnblnk,iv,iii,iji,iif,ijf
+      integer im,jm,lm,i,j,l,iv,iii,iji,iif,ijf
 
       logical writectl
@@ -59,5 +59,5 @@
             nvar(if)=ivar(if)
             var(ivar(if),if)=name
-            tvar(ivar(if),if)=titlevar(1:lnblnk(titlevar))
+            tvar(ivar(if),if)=trim(titlevar)
             nld(ivar(if),if)=nl
 c           print*,'initialisation ecriture de ',var(ivar(if),if)
@@ -101,8 +101,8 @@
       file=fichier(if)
 c   WARNING! on reecrase le fichier .ctl a chaque ecriture
-      open(unit(if),file=file(1:lnblnk(file))//'.ctl'
+      open(unit(if),file=trim(file)//'.ctl'
      &         ,form='formatted',status='unknown')
       write(unit(if),'(a5,1x,a40)')
-     &       'DSET ','^'//file(1:lnblnk(file))//'.dat'
+     &       'DSET ','^'//trim(file)//'.dat'
 
       write(unit(if),'(a12)') 'UNDEF 1.0E30'
Index: LMDZ5/branches/testing/libf/dyn3dpar/bands.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/bands.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/bands.F90	(revision 1665)
@@ -93,6 +93,6 @@
    SUBROUTINE  Set_Bands 
      USE parallel
-#ifdef CPP_EARTH
-! Ehouarn: what follows is only related to // physics; for now only for Earth 
+#ifdef CPP_PHYS
+! Ehouarn: what follows is only related to // physics
      USE mod_phys_lmdz_para, ONLY : jj_para_begin,jj_para_end
 #endif
@@ -106,6 +106,5 @@
       enddo
           
-#ifdef CPP_EARTH
-! Ehouarn: what follows is only related to // physics; for now only for Earth          
+#ifdef CPP_PHYS
       do i=0,MPI_Size-1
         jj_Nb_physic(i)=jj_para_end(i)-jj_para_begin(i)+1
@@ -332,6 +331,6 @@
     subroutine AdjustBands_physic
       use times
-#ifdef CPP_EARTH
-! Ehouarn: what follows is only related to // physics; for now only for Earth 
+#ifdef CPP_PHYS
+! Ehouarn: what follows is only related to // physics
       USE mod_phys_lmdz_para, only : klon_mpi_para_nb
 #endif
@@ -359,6 +358,5 @@
       medium=medium/mpi_size      
       NbTot=0
-#ifdef CPP_EARTH
-! Ehouarn: what follows is only related to // physics; for now only for Earth 
+#ifdef CPP_PHYS
       do i=0,mpi_size-1
         Inc(i)=nint(klon_mpi_para_nb(i)*(medium-value(i))/value(i))
Index: LMDZ5/branches/testing/libf/dyn3dpar/calfis_p.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/calfis_p.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/calfis_p.F	(revision 1665)
@@ -27,9 +27,6 @@
      $                  pdqfi,
      $                  pdpsfi)
-#ifdef CPP_EARTH
-! Ehouarn: For now, calfis_p needs Earth physics
-c
-c    Auteur :  P. Le Van, F. Hourdin 
-c   .........
+#ifdef CPP_PHYS
+! If using physics
       USE dimphy
       USE mod_phys_lmdz_para, mpi_root_xx=>mpi_root 
@@ -146,5 +143,6 @@
       REAL clesphy0( longcles )
 
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
+! Ehouarn: for now calfis_p needs some informations from physics to compile
 c    Local variables :
 c    -----------------
@@ -222,5 +220,5 @@
       PARAMETER(ntetaSTD=3)
       REAL rtetaSTD(ntetaSTD)
-      DATA rtetaSTD/350., 380., 405./
+      DATA rtetaSTD/350., 380., 405./ ! Earth-specific values, beware !!
       REAL PVteta(klon,ntetaSTD)
       
@@ -489,6 +487,7 @@
 
 
-      IF (is_sequential) THEN
-c
+      IF (is_sequential.and.(planet_type=="earth")) THEN
+#ifdef CPP_PHYS
+! PVtheta calls tetalevel, which is in the physics
 cIM calcul PV a teta=350, 380, 405K
         CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta,
@@ -496,4 +495,5 @@
      $           ntetaSTD,rtetaSTD,PVteta)
 c
+#endif
       ENDIF
 
@@ -627,7 +627,4 @@
 c$OMP BARRIER
       
-      if (planet_type=="earth") then
-#ifdef CPP_EARTH
-
 !$OMP MASTER
 !      write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
@@ -639,4 +636,6 @@
       zdqfic_omp(:,:,:)=0.
 
+      if (planet_type=="earth") then
+#ifdef CPP_PHYS
       do isplit=1,nsplit_phys
 
@@ -687,11 +686,12 @@
       enddo
 
+#endif
+! of #ifdef CPP_PHYS
+      endif !of if (planet_type=="earth")
+
       zdufi_omp(:,:)=zdufic_omp(:,:)/nsplit_phys
       zdvfi_omp(:,:)=zdvfic_omp(:,:)/nsplit_phys
       zdtfi_omp(:,:)=zdtfic_omp(:,:)/nsplit_phys
       zdqfi_omp(:,:,:)=zdqfic_omp(:,:,:)/nsplit_phys
-
-#endif
-      endif !of if (planet_type=="earth")
 c$OMP BARRIER
 
@@ -1110,10 +1110,10 @@
       firstcal = .FALSE.
 
-#else
-      write(lunout,*)
-     & "calfis_p: for now can only work with parallel physics"
-      stop
-#endif
-! of #ifdef CPP_EARTH
+#else 
+      write(lunout,*) 
+     & "calfis_p: for now can only work with parallel physics" 
+      stop 
+#endif 
+! of #ifdef CPP_PHYS
       RETURN
       END
Index: LMDZ5/branches/testing/libf/dyn3dpar/ce0l.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/ce0l.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/ce0l.F90	(revision 1665)
@@ -19,5 +19,5 @@
   USE dimphy
   USE comgeomphy
-  USE mod_phys_lmdz_para
+  USE mod_phys_lmdz_para, mpi_root_xx=>mpi_root
   USE mod_const_mpi
   USE infotrac
@@ -31,4 +31,5 @@
   IMPLICIT NONE
 #ifndef CPP_EARTH
+#include "iniprint.h"
   WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
 #else
@@ -42,5 +43,10 @@
 #include "temps.h"
 #include "logic.h"
+#ifdef CPP_MPI
+      include 'mpif.h'
+#endif
+
   INTEGER, PARAMETER            :: longcles=20
+  INTEGER                       :: ierr
   REAL,    DIMENSION(longcles)  :: clesphy0
   REAL,    DIMENSION(iip1,jjp1) :: masque
@@ -50,5 +56,7 @@
   CALL conf_gcm( 99, .TRUE. , clesphy0 )
 
+#ifdef CPP_MPI
   CALL init_mpi
+#endif
 
   CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
@@ -115,7 +123,10 @@
   END IF
   
+#ifdef CPP_MPI
 !$OMP MASTER
-  CALL finalize_parallel
+  CALL MPI_FINALIZE(ierr)
+  IF (ierr /= 0) CALL abort_gcm('ce0l','Error in MPI_FINALIZE',1)
 !$OMP END MASTER
+#endif
 
 #endif
Index: LMDZ5/branches/testing/libf/dyn3dpar/comvert.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/comvert.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/comvert.h	(revision 1665)
@@ -9,5 +9,5 @@
      &               aps(llm),bps(llm),scaleheight
 
-      common/comverti/disvert_type
+      common/comverti/disvert_type, pressure_exner
 
       real ap     ! hybrid pressure contribution at interlayers
@@ -30,3 +30,7 @@
                            !     using 'z2sig.def' (or 'esasig.def) file
 
+      logical pressure_exner
+!     compute pressure inside layers using Exner function, else use mean
+!     of pressure values at interfaces
+
  !-----------------------------------------------------------------------
Index: LMDZ5/branches/testing/libf/dyn3dpar/conf_gcm.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/conf_gcm.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/conf_gcm.F	(revision 1665)
@@ -167,4 +167,12 @@
       nday = 10
       CALL getin('nday',nday)
+
+!Config  Key  = starttime
+!Config  Desc = Heure de depart de la simulation
+!Config  Def  = 0
+!Config  Help = Heure de depart de la simulation
+!Config         en jour
+      starttime = 0
+      CALL getin('starttime',starttime)
 
 !Config  Key  = day_step
Index: LMDZ5/branches/testing/libf/dyn3dpar/control_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/control_mod.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/control_mod.F90	(revision 1665)
@@ -10,5 +10,5 @@
   IMPLICIT NONE
 
-  REAL    :: periodav
+  REAL    :: periodav, starttime
   INTEGER :: nday,day_step,iperiod,iapp_tracvl,nsplit_phys
   INTEGER :: iconser,iecri,dissip_period,iphysiq,iecrimoy
Index: LMDZ5/branches/testing/libf/dyn3dpar/disvert.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/disvert.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/disvert.F90	(revision 1665)
@@ -4,4 +4,7 @@
 
   ! Auteur : P. Le Van
+
+  use new_unit_m, only: new_unit
+  use ioipsl, only: getin
 
   IMPLICIT NONE
@@ -26,20 +29,28 @@
   real zk, zkm1, dzk1, dzk2, k0, k1
 
-  INTEGER l
+  INTEGER l, unit
   REAL dsigmin
   REAL alpha, beta, deltaz
-  INTEGER iostat
   REAL x
   character(len=*),parameter :: modname="disvert"
 
+  character(len=6):: vert_sampling
+  ! (allowed values are "param", "tropo", "strato" and "read")
+
   !-----------------------------------------------------------------------
+
+  print *, "Call sequence information: disvert"
 
   ! default scaleheight is 8km for earth
   scaleheight=8.
 
-  OPEN(99, file='sigma.def', status='old', form='formatted', iostat=iostat)
+  vert_sampling = merge("strato", "tropo ", ok_strato) ! default value
+  call getin('vert_sampling', vert_sampling)
+  print *, 'vert_sampling = ' // vert_sampling
 
-  IF (iostat == 0) THEN
-     ! cas 1 on lit les options dans sigma.def:
+  select case (vert_sampling)
+  case ("param")
+     ! On lit les options dans sigma.def:
+     OPEN(99, file='sigma.def', status='old', form='formatted')
      READ(99, *) scaleheight ! hauteur d'echelle 8.
      READ(99, *) deltaz ! epaiseur de la premiere couche 0.04
@@ -68,32 +79,8 @@
 
      sig(llm+1)=0.
-
-     DO l = 1, llm
-        dsig(l) = sig(l)-sig(l+1)
-     end DO
-  ELSE
-     if (ok_strato) then
-        if (llm==39) then
-           dsigmin=0.3
-        else if (llm==50) then
-           dsigmin=1.
-        else
-           write(lunout,*) trim(modname), &
-           ' ATTENTION discretisation z a ajuster'
-           dsigmin=1.
-        endif
-        write(lunout,*) trim(modname), &
-        ' Discretisation verticale DSIGMIN=',dsigmin
-     endif
-
+  case("tropo")
      DO l = 1, llm
         x = 2*asin(1.) * (l - 0.5) / (llm + 1)
-
-        IF (ok_strato) THEN
-           dsig(l) =(dsigmin + 7. * SIN(x)**2) &
-                *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2
-        ELSE
-           dsig(l) = 1.0 + 7.0 * SIN(x)**2
-        ENDIF
+        dsig(l) = 1.0 + 7.0 * SIN(x)**2
      ENDDO
      dsig = dsig / sum(dsig)
@@ -102,5 +89,37 @@
         sig(l) = sig(l+1) + dsig(l)
      ENDDO
-  ENDIF
+  case("strato")
+     if (llm==39) then
+        dsigmin=0.3
+     else if (llm==50) then
+        dsigmin=1.
+     else
+        write(lunout,*) trim(modname), ' ATTENTION discretisation z a ajuster'
+        dsigmin=1.
+     endif
+     WRITE(LUNOUT,*) trim(modname), 'Discretisation verticale DSIGMIN=',dsigmin
+
+     DO l = 1, llm
+        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
+        dsig(l) =(dsigmin + 7. * SIN(x)**2) &
+             *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2
+     ENDDO
+     dsig = dsig / sum(dsig)
+     sig(llm+1) = 0.
+     DO l = llm, 1, -1
+        sig(l) = sig(l+1) + dsig(l)
+     ENDDO
+  case("read")
+     call new_unit(unit)
+     open(unit, file="hybrid.txt", status="old", action="read", &
+          position="rewind")
+     read(unit, fmt=*) ! skip title line
+     do l = 1, llm + 1
+        read(unit, fmt=*) sig(l)
+     end do
+     close(unit)
+  case default
+     call abort_gcm("disvert", 'Wrong value for "vert_sampling"', 1)
+  END select
 
   DO l=1, llm
Index: LMDZ5/branches/testing/libf/dyn3dpar/dynetat0.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/dynetat0.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/dynetat0.F	(revision 1665)
@@ -119,4 +119,5 @@
       day_ini = tab_cntrl(30)
       itau_dyn = tab_cntrl(31)
+      start_time = tab_cntrl(32)
 c   .................................................................
 c
Index: LMDZ5/branches/testing/libf/dyn3dpar/dynredem.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/dynredem.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/dynredem.F	(revision 1665)
@@ -120,4 +120,6 @@
        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    .........................................................
Index: LMDZ5/branches/testing/libf/dyn3dpar/dynredem_p.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/dynredem_p.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/dynredem_p.F	(revision 1665)
@@ -120,4 +120,6 @@
        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    .........................................................
Index: LMDZ5/branches/testing/libf/dyn3dpar/etat0_netcdf.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/etat0_netcdf.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/etat0_netcdf.F90	(revision 1665)
@@ -251,7 +251,7 @@
 !*******************************************************************************
   CALL pression(ip1jmp1, ap, bp, psol, p3d)
-  if (disvert_type.eq.1) then
+  if (pressure_exner) then
     CALL exner_hyb(ip1jmp1, psol, p3d, alpha, beta, pks, pk, y)
-  else ! we assume that we are in the disvert_type==2 case
+  else
     CALL exner_milieu(ip1jmp1,psol,p3d,beta,pks,pk,y)
   endif
Index: LMDZ5/branches/testing/libf/dyn3dpar/exner_hyb.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/exner_hyb.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/exner_hyb.F	(revision 1665)
@@ -56,11 +56,4 @@
       ! Sanity check
       if (firstcall) then
-        ! check that vertical discretization is compatible
-        ! with this routine
-        if (disvert_type.ne.1) then
-          call abort_gcm(modname,
-     &     "this routine should only be called if disvert_type==1",42)
-        endif
-        
         ! sanity checks for Shallow Water case (1 vertical layer)
         if (llm.eq.1) then
Index: LMDZ5/branches/testing/libf/dyn3dpar/exner_hyb_p.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/exner_hyb_p.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/exner_hyb_p.F	(revision 1665)
@@ -60,11 +60,4 @@
       ! Sanity check
       if (firstcall) then
-        ! check that vertical discretization is compatible
-        ! with this routine
-        if (disvert_type.ne.1) then
-          call abort_gcm(modname,
-     &     "this routine should only be called if disvert_type==1",42)
-        endif
-        
         ! sanity checks for Shallow Water case (1 vertical layer)
         if (llm.eq.1) then
Index: LMDZ5/branches/testing/libf/dyn3dpar/exner_milieu.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/exner_milieu.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/exner_milieu.F	(revision 1665)
@@ -53,11 +53,4 @@
       ! Sanity check
       if (firstcall) then
-        ! check that vertical discretization is compatible
-        ! with this routine
-        if (disvert_type.ne.2) then
-          call abort_gcm(modname,
-     &     "this routine should only be called if disvert_type==2",42)
-        endif
-        
         ! sanity checks for Shallow Water case (1 vertical layer)
         if (llm.eq.1) then
Index: LMDZ5/branches/testing/libf/dyn3dpar/exner_milieu_p.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/exner_milieu_p.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/exner_milieu_p.F	(revision 1665)
@@ -56,11 +56,4 @@
       ! Sanity check
       if (firstcall) then
-        ! check that vertical discretization is compatible
-        ! with this routine
-        if (disvert_type.ne.2) then
-          call abort_gcm(modname,
-     &     "this routine should only be called if disvert_type==2",42)
-        endif
-        
         ! sanity checks for Shallow Water case (1 vertical layer)
         if (llm.eq.1) then
Index: LMDZ5/branches/testing/libf/dyn3dpar/filtreg_p.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/filtreg_p.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/filtreg_p.F	(revision 1665)
@@ -208,24 +208,39 @@
                IF( ifiltre.EQ.-2 )   THEN
                   DO j = jdfil,jffil
+#ifdef BLAS
                      CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
      &                    matrinvn(1,1,j), iim, 
      &                    champ_loc(1,j,1), iip1*nlat, 0.0,
      &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:,j-jdfil+1,:)
+     &                    =matmul(matrinvn(:,:,j),champ_loc(:iim,j,:))
+#endif
                   ENDDO
                   
                ELSE IF ( griscal )     THEN
                   DO j = jdfil,jffil
+#ifdef BLAS
                      CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
      &                    matriceun(1,1,j), iim, 
      &                    champ_loc(1,j,1), iip1*nlat, 0.0,
      &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:,j-jdfil+1,:)
+     &                    =matmul(matriceun(:,:,j),champ_loc(:iim,j,:))
+#endif
                   ENDDO
                   
                ELSE 
                   DO j = jdfil,jffil
+#ifdef BLAS
                      CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
      &                    matricevn(1,1,j), iim, 
      &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
      &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:,j-jdfil+1,:)
+     &                    =matmul(matricevn(:,:,j),champ_loc(:iim,j,:))
+#endif
                   ENDDO
                   
@@ -236,8 +251,14 @@
                IF( ifiltre.EQ.-2 )   THEN
                   DO j = jdfil,jffil
+#ifdef BLAS
                      CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
      &                    matrinvs(1,1,j-jfiltsu+1), iim, 
      &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
      &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:,j-jdfil+1,:)
+     &                    =matmul(matrinvs(:,:,j-jfiltsu+1),
+     &                            champ_loc(:iim,j,:))
+#endif
                   ENDDO
                   
@@ -245,8 +266,14 @@
                   
                   DO j = jdfil,jffil
+#ifdef BLAS
                      CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
      &                    matriceus(1,1,j-jfiltsu+1), iim, 
      &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
      &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:,j-jdfil+1,:)
+     &                    =matmul(matriceus(:,:,j-jfiltsu+1),
+     &                            champ_loc(:iim,j,:))
+#endif
                   ENDDO
                   
@@ -254,8 +281,14 @@
                   
                   DO j = jdfil,jffil
+#ifdef BLAS
                      CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
      &                    matricevs(1,1,j-jfiltsv+1), iim, 
      &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
      &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:,j-jdfil+1,:)
+     &                    =matmul(matricevs(:,:,j-jfiltsv+1),
+     &                            champ_loc(:iim,j,:))
+#endif
                   ENDDO
                   
Index: LMDZ5/branches/testing/libf/dyn3dpar/gcm.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/gcm.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/gcm.F	(revision 1665)
@@ -20,6 +20,5 @@
       USE control_mod
 
-! Ehouarn: for now these only apply to Earth:
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
       USE mod_grid_phy_lmdz
       USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
@@ -87,6 +86,4 @@
 
       REAL zdtvr
-c      INTEGER nbetatmoy, nbetatdem,nbetat
-      INTEGER nbetatmoy, nbetatdem
 
 c   variables dynamiques
@@ -189,13 +186,10 @@
       call ini_getparam("out.def")
       call Read_Distrib
-! Ehouarn : temporarily (?) keep this only for Earth
-      if (planet_type.eq."earth") then
-#ifdef CPP_EARTH
+
+#ifdef CPP_PHYS
         CALL Init_Phys_lmdz(iim,jjp1,llm,mpi_size,distrib_phys)
 #endif
-      endif ! of if (planet_type.eq."earth")
       CALL set_bands
-#ifdef CPP_EARTH
-! Ehouarn: For now only Earth physics is parallel
+#ifdef CPP_PHYS
       CALL Init_interface_dyn_phys
 #endif
@@ -209,12 +203,9 @@
 c$OMP END PARALLEL
 
-! Ehouarn : temporarily (?) keep this only for Earth
-      if (planet_type.eq."earth") then
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
 c$OMP PARALLEL
       call InitComgeomphy
 c$OMP END PARALLEL 
 #endif
-      endif ! of if (planet_type.eq."earth")
 
 c-----------------------------------------------------------------------
@@ -323,4 +314,15 @@
 C on remet le calendrier à zero si demande
 c
+      IF (start_time /= starttime) then
+        WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le'
+     &,' fichier restart ne correspond pas à celle lue dans le run.def'
+        IF (raz_date == 1) then
+          WRITE(lunout,*)'Je prends l''heure lue dans run.def'
+          start_time = starttime
+        ELSE
+          WRITE(lunout,*)'Je m''arrete'
+          CALL abort
+        ENDIF
+      ENDIF
       IF (raz_date == 1) THEN
         annee_ref = anneeref
@@ -390,7 +392,4 @@
 #endif
 
-c  nombre d'etats dans les fichiers demarrage et histoire
-      nbetatdem = nday / iecri
-      nbetatmoy = nday / periodav + 1
 
       if (iflag_phys.eq.1) then
@@ -445,11 +444,9 @@
          WRITE(lunout,*)
      .       'GCM: WARNING!!! vitesse verticale nulle dans la physique'
-! Earth:
-         if (planet_type.eq."earth") then
-#ifdef CPP_EARTH
+! Physics:
+#ifdef CPP_PHYS
          CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys ,
      ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
 #endif
-         endif ! of if (planet_type.eq."earth")
          call_iniphys=.false.
       ENDIF ! of IF (call_iniphys.and.(iflag_phys.eq.1))
@@ -484,4 +481,12 @@
  301  FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4)
  302  FORMAT('1'/,15x,'    au ', i2,'/',i2,'/',i4)
+#endif
+
+#ifdef CPP_PHYS
+! Create start file (startphy.nc) and boundary conditions (limit.nc) 
+! for the Earth verstion
+       if (iflag_phys>=100) then
+          call iniaqua(ngridmx,latfi,lonfi,iflag_phys)
+       endif
 #endif
 
Index: LMDZ5/branches/testing/libf/dyn3dpar/gr_dyn_fi_p.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/gr_dyn_fi_p.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/gr_dyn_fi_p.F	(revision 1665)
@@ -3,7 +3,6 @@
 !
       SUBROUTINE gr_dyn_fi_p(nfield,im,jm,ngrid,pdyn,pfi)
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
 ! Interface with parallel physics,
-! for now this routine only works with Earth physics
       USE mod_interface_dyn_phys
       USE dimphy
@@ -40,10 +39,6 @@
       ENDDO
 c$OMP END DO NOWAIT
-#else
-      write(lunout,*) "gr_fi_dyn_p : This routine should not be called",
-     &   "without parallelized physics"
-      stop
 #endif
-! of #ifdef CPP_EARTH
+! of #ifdef CPP_PHYS
       RETURN
       END
Index: LMDZ5/branches/testing/libf/dyn3dpar/gr_fi_dyn_p.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/gr_fi_dyn_p.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/gr_fi_dyn_p.F	(revision 1665)
@@ -3,7 +3,6 @@
 !
       SUBROUTINE gr_fi_dyn_p(nfield,ngrid,im,jm,pfi,pdyn)
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
 ! Interface with parallel physics,
-! for now this routine only works with Earth physics
       USE mod_interface_dyn_phys
       USE dimphy
@@ -52,10 +51,6 @@
       ENDDO
 c$OMP END DO NOWAIT
-#else
-      write(lunout,*) "gr_fi_dyn_p : This routine should not be called",
-     &   "without parallelized physics"
-      stop
 #endif
-! of #ifdef CPP_EARTH
+! of #ifdef CPP_PHYS
       RETURN
       END
Index: LMDZ5/branches/testing/libf/dyn3dpar/guide_p_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/guide_p_mod.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/guide_p_mod.F90	(revision 1665)
@@ -455,5 +455,5 @@
 !       Calcul niveaux pression milieu de couches 
 	CALL pression_p( ip1jmp1, ap, bp, ps, p )
-	if (disvert_type==1) then
+	if (pressure_exner) then
           CALL exner_hyb_p(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
 	else
@@ -755,7 +755,7 @@
     ELSE
 	CALL pression_p( ip1jmp1, ap, bp, psi, p )
-	if (disvert_type==1) then
+	if (pressure_exner) then
           CALL exner_hyb_p(ip1jmp1,psi,p,alpha,beta,pks,pk,pkf)
-        else ! we assume that we are in the disvert_type==2 case
+        else
           CALL exner_milieu_p(ip1jmp1,psi,p,beta,pks,pk,pkf)
         endif
Index: LMDZ5/branches/testing/libf/dyn3dpar/iniacademic.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/iniacademic.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/iniacademic.F90	(revision 1665)
@@ -222,12 +222,8 @@
 
         CALL pression ( ip1jmp1, ap, bp, ps, p       )
-        if (disvert_type.eq.1) then
+        if (pressure_exner) then
           CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
-        elseif (disvert_type.eq.2) then
+        else
           call exner_milieu(ip1jmp1,ps,p,beta,pks,pk,pkf)
-        else
-          write(abort_message,*) "Wrong value for disvert_type: ", &
-                              disvert_type
-          call abort_gcm(modname,abort_message,0)
         endif
         CALL massdair(p,masse)
Index: LMDZ5/branches/testing/libf/dyn3dpar/iniconst.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/iniconst.F	(revision 1664)
+++ 	(revision )
@@ -1,84 +1,0 @@
-!
-! $Id$
-!
-      SUBROUTINE iniconst
-
-      USE control_mod
-#ifdef CPP_IOIPSL
-      use IOIPSL
-#else
-! if not using IOIPSL, we still need to use (a local version of) getin
-      use ioipsl_getincom
-#endif
-
-      IMPLICIT NONE
-c
-c      P. Le Van
-c
-c-----------------------------------------------------------------------
-c   Declarations:
-c   -------------
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "temps.h"
-#include "comvert.h"
-#include "iniprint.h"
-
-      character(len=*),parameter :: modname="iniconst"
-      character(len=80) :: abort_message
-c
-c
-c
-c-----------------------------------------------------------------------
-c   dimension des boucles:
-c   ----------------------
-
-      im      = iim
-      jm      = jjm
-      lllm    = llm
-      imp1    = iim 
-      jmp1    = jjm + 1
-      lllmm1  = llm - 1
-      lllmp1  = llm + 1
-
-c-----------------------------------------------------------------------
-
-      dtphys  = iphysiq * dtvr
-      unsim   = 1./iim
-      pi      = 2.*ASIN( 1. )
-
-c-----------------------------------------------------------------------
-c
-
-      r       = cpp * kappa
-
-      write(lunout,*) trim(modname),': R  CP  Kappa ',r,cpp,kappa
-c
-c-----------------------------------------------------------------------
-
-! vertical discretization: default behavior depends on planet_type flag
-      if (planet_type=="earth") then
-        disvert_type=1
-      else
-        disvert_type=2
-      endif
-      ! but user can also specify using one or the other in run.def:
-      call getin('disvert_type',disvert_type)
-      write(lunout,*) trim(modname),': disvert_type=',disvert_type
-      
-      if (disvert_type==1) then
-       ! standard case for Earth (automatic generation of levels)
-       call disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig,
-     &              scaleheight)
-      else if (disvert_type==2) then
-        ! standard case for planets (levels generated using z2sig.def file)
-        call disvert_noterre
-      else
-        write(abort_message,*) "Wrong value for disvert_type: ",
-     &                        disvert_type
-        call abort_gcm(modname,abort_message,0)
-      endif
-
-      END
Index: LMDZ5/branches/testing/libf/dyn3dpar/iniconst.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/iniconst.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/dyn3dpar/iniconst.F90	(revision 1665)
@@ -0,0 +1,84 @@
+!
+! $Id$
+!
+SUBROUTINE iniconst
+
+  USE control_mod
+#ifdef CPP_IOIPSL
+  use IOIPSL
+#else
+  ! if not using IOIPSL, we still need to use (a local version of) getin
+  use ioipsl_getincom
+#endif
+
+  IMPLICIT NONE
+  !
+  !      P. Le Van
+  !
+  !   Declarations:
+  !   -------------
+  !
+  include "dimensions.h"
+  include "paramet.h"
+  include "comconst.h"
+  include "temps.h"
+  include "comvert.h"
+  include "iniprint.h"
+
+  character(len=*),parameter :: modname="iniconst"
+  character(len=80) :: abort_message
+  !
+  !
+  !
+  !-----------------------------------------------------------------------
+  !   dimension des boucles:
+  !   ----------------------
+
+  im      = iim
+  jm      = jjm
+  lllm    = llm
+  imp1    = iim 
+  jmp1    = jjm + 1
+  lllmm1  = llm - 1
+  lllmp1  = llm + 1
+
+  !-----------------------------------------------------------------------
+
+  dtphys  = iphysiq * dtvr
+  unsim   = 1./iim
+  pi      = 2.*ASIN( 1. )
+
+  !-----------------------------------------------------------------------
+  !
+
+  r       = cpp * kappa
+
+  write(lunout,*) trim(modname),': R  CP  Kappa ',r,cpp,kappa
+  !
+  !-----------------------------------------------------------------------
+
+  ! vertical discretization: default behavior depends on planet_type flag
+  if (planet_type=="earth") then
+     disvert_type=1
+  else
+     disvert_type=2
+  endif
+  ! but user can also specify using one or the other in run.def:
+  call getin('disvert_type',disvert_type)
+  write(lunout,*) trim(modname),': disvert_type=',disvert_type
+
+  pressure_exner = disvert_type == 1 ! default value
+  call getin('pressure_exner', pressure_exner)
+
+  if (disvert_type==1) then
+     ! standard case for Earth (automatic generation of levels)
+     call disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig, scaleheight)
+  else if (disvert_type==2) then
+     ! standard case for planets (levels generated using z2sig.def file)
+     call disvert_noterre
+  else
+     write(abort_message,*) "Wrong value for disvert_type: ", disvert_type
+     call abort_gcm(modname,abort_message,0)
+  endif
+
+END SUBROUTINE iniconst
Index: LMDZ5/branches/testing/libf/dyn3dpar/inidissip.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/inidissip.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/inidissip.F90	(revision 1665)
@@ -28,7 +28,8 @@
 ! Local variables:
   REAL fact,zvert(llm),zz
-  REAL zh(ip1jmp1),zu(ip1jmp1),zv(ip1jm),deltap(ip1jmp1,llm)
+  REAL zh(ip1jmp1),zu(ip1jmp1), gx(ip1jmp1), divgra(ip1jmp1)
+  real zv(ip1jm), gy(ip1jm), deltap(ip1jmp1,llm)
   REAL ullm,vllm,umin,vmin,zhmin,zhmax
-  REAL zllm,z1llm
+  REAL zllm
 
   INTEGER l,ij,idum,ii
@@ -78,16 +79,11 @@
   DO l = 1,50
      IF(lstardis) THEN
-        CALL divgrad2(1,zh,deltap,niterh,zh)
+        CALL divgrad2(1,zh,deltap,niterh,divgra)
      ELSE
-        CALL divgrad (1,zh,niterh,zh)
+        CALL divgrad (1,zh,niterh,divgra)
      ENDIF
 
-     CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
-
-     zllm  = ABS( zhmax )
-     z1llm = 1./zllm
-     DO ij = 1,ip1jmp1
-        zh(ij) = zh(ij)* z1llm
-     ENDDO
+     zllm  = ABS(maxval(divgra))
+     zh = divgra / zllm
   ENDDO
 
@@ -123,30 +119,19 @@
            !cccc             CALL covcont( 1,zu,zv,zu,zv )
            IF(lstardis) THEN
-              CALL gradiv2( 1,zu,zv,nitergdiv,zu,zv )
+              CALL gradiv2( 1,zu,zv,nitergdiv,gx,gy )
            ELSE
-              CALL gradiv ( 1,zu,zv,nitergdiv,zu,zv )
+              CALL gradiv ( 1,zu,zv,nitergdiv,gx,gy )
            ENDIF
         ELSE
            IF(lstardis) THEN
-              CALL nxgraro2( 1,zu,zv,nitergrot,zu,zv )
+              CALL nxgraro2( 1,zu,zv,nitergrot,gx,gy )
            ELSE
-              CALL nxgrarot( 1,zu,zv,nitergrot,zu,zv )
+              CALL nxgrarot( 1,zu,zv,nitergrot,gx,gy )
            ENDIF
         ENDIF
 
-        CALL minmax(iip1*jjp1,zu,umin,ullm )
-        CALL minmax(iip1*jjm, zv,vmin,vllm )
-
-        ullm = ABS  ( ullm )
-        vllm = ABS  ( vllm )
-
-        zllm  = MAX( ullm,vllm )
-        z1llm = 1./ zllm
-        DO ij = 1, ip1jmp1
-           zu(ij) = zu(ij)* z1llm
-        ENDDO
-        DO ij = 1, ip1jm
-           zv(ij) = zv(ij)* z1llm
-        ENDDO
+        zllm = max(abs(maxval(gx)), abs(maxval(gy)))
+        zu = gx / zllm
+        zv = gy / zllm
      end DO
 
Index: LMDZ5/branches/testing/libf/dyn3dpar/inigrads.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/inigrads.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/inigrads.F	(revision 1665)
@@ -9,5 +9,5 @@
       implicit none
 
-      integer if,im,jm,lm,i,j,l,lnblnk
+      integer if,im,jm,lm,i,j,l
       real x(im),y(jm),z(lm),fx,fy,fz,dt
       real xmin,xmax,ymin,ymax
@@ -40,5 +40,5 @@
       ivar(if)=0
 
-      fichier(if)=file(1:lnblnk(file))
+      fichier(if)=trim(file)
 
       firsttime(if)=.true.
@@ -70,7 +70,7 @@
 
       print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if))
-      print*,file(1:lnblnk(file))//'.dat'
+      print*,trim(file)//'.dat'
 
-      OPEN (unit(if)+1,FILE=file(1:lnblnk(file))//'.dat'
+      OPEN (unit(if)+1,FILE=trim(file)//'.dat'
      s   ,FORM='unformatted',
      s   ACCESS='direct'
Index: LMDZ5/branches/testing/libf/dyn3dpar/integrd_p.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/integrd_p.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/integrd_p.F	(revision 1665)
@@ -4,5 +4,5 @@
       SUBROUTINE integrd_p
      $  (  nq,vcovm1,ucovm1,tetam1,psm1,massem1,
-     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis,finvmaold)
+     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis) !,finvmaold)
       USE parallel
       USE control_mod, only : planet_type
@@ -33,20 +33,30 @@
 #include "temps.h"
 #include "serre.h"
+#include "iniprint.h"
 
 c   Arguments:
 c   ----------
 
-      INTEGER nq
-
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
-      REAL q(ip1jmp1,llm,nq)
-      REAL ps0(ip1jmp1),masse(ip1jmp1,llm),phis(ip1jmp1)
-
-      REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
-      REAL tetam1(ip1jmp1,llm),psm1(ip1jmp1),massem1(ip1jmp1,llm)
-
-      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
-      REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
-      REAL dq(ip1jmp1,llm,nq), finvmaold(ip1jmp1,llm)
+      integer,intent(in) :: nq ! number of tracers to handle in this routine
+      real,intent(inout) :: vcov(ip1jm,llm) ! covariant meridional wind
+      real,intent(inout) :: ucov(ip1jmp1,llm) ! covariant zonal wind
+      real,intent(inout) :: teta(ip1jmp1,llm) ! potential temperature
+      real,intent(inout) :: q(ip1jmp1,llm,nq) ! advected tracers
+      real,intent(inout) :: ps0(ip1jmp1) ! surface pressure
+      real,intent(inout) :: masse(ip1jmp1,llm) ! atmospheric mass
+      real,intent(in) :: phis(ip1jmp1) ! ground geopotential !!! unused
+      ! values at previous time step
+      real,intent(inout) :: vcovm1(ip1jm,llm)
+      real,intent(inout) :: ucovm1(ip1jmp1,llm)
+      real,intent(inout) :: tetam1(ip1jmp1,llm)
+      real,intent(inout) :: psm1(ip1jmp1)
+      real,intent(inout) :: massem1(ip1jmp1,llm)
+      ! the tendencies to add
+      real,intent(in) :: dv(ip1jm,llm)
+      real,intent(in) :: du(ip1jmp1,llm)
+      real,intent(in) :: dteta(ip1jmp1,llm)
+      real,intent(in) :: dp(ip1jmp1)
+      real,intent(in) :: dq(ip1jmp1,llm,nq) !!! unused
+!      real,intent(out) :: finvmaold(ip1jmp1,llm) !!! unused
 
 c   Local:
@@ -54,5 +64,6 @@
 
       REAL vscr( ip1jm ),uscr( ip1jmp1 ),hscr( ip1jmp1 ),pscr(ip1jmp1)
-      REAL massescr( ip1jmp1,llm ), finvmasse(ip1jmp1,llm)
+      REAL massescr( ip1jmp1,llm )
+!      REAL finvmasse(ip1jmp1,llm)
       REAL,SAVE :: p(ip1jmp1,llmp1)
       REAL tpn,tps,tppn(iim),tpps(iim)
@@ -60,5 +71,5 @@
       REAL,SAVE :: deltap( ip1jmp1,llm )
 
-      INTEGER  l,ij,iq
+      INTEGER  l,ij,iq,i,j
 
       REAL SSUM
@@ -126,8 +137,12 @@
        
         IF( .NOT. checksum ) THEN
-         PRINT*,' Au point ij = ',stop_it, ' , pression sol neg. '
-     &         , ps(stop_it)
-         print *, ' dans integrd'
-         stop 1
+         write(lunout,*) "integrd: negative surface pressure ",
+     &                                                ps(stop_it)
+         write(lunout,*) " at node ij =", stop_it
+         ! since ij=j+(i-1)*jjp1 , we have
+         j=modulo(stop_it,jjp1)
+         i=1+(stop_it-j)/jjp1
+         write(lunout,*) " lon = ",rlonv(i)*180./pi, " deg",
+     &                   " lat = ",rlatu(j)*180./pi, " deg"
         ENDIF
 
@@ -167,17 +182,19 @@
       CALL massdair_p (     p  , masse         )
 
-c      CALL   SCOPY( ijp1llm  , masse, 1, finvmasse,  1      )
-      ijb=ij_begin
-      ije=ij_end
-      
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
-      DO  l = 1,llm
-        finvmasse(ijb:ije,l)=masse(ijb:ije,l)
-      ENDDO
-c$OMP END DO NOWAIT
-
-      jjb=jj_begin
-      jje=jj_end
-      CALL filtreg_p( finvmasse,jjb,jje, jjp1, llm, -2, 2, .TRUE., 1  )
+! Ehouarn : we don't use/need finvmaold and finvmasse,
+!           so might as well not compute them
+!c      CALL   SCOPY( ijp1llm  , masse, 1, finvmasse,  1      )
+!      ijb=ij_begin
+!      ije=ij_end
+!      
+!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
+!      DO  l = 1,llm
+!        finvmasse(ijb:ije,l)=masse(ijb:ije,l)
+!      ENDDO
+!c$OMP END DO NOWAIT
+!
+!      jjb=jj_begin
+!      jje=jj_end
+!      CALL filtreg_p( finvmasse,jjb,jje, jjp1, llm, -2, 2, .TRUE., 1  )
 c
 
@@ -330,11 +347,12 @@
       ENDIF
       
-c         CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l = 1, llm      
-        finvmaold(ijb:ije,l)=finvmasse(ijb:ije,l)        
-      ENDDO
-c$OMP END DO NOWAIT
+! Ehouarn: forget about finvmaold
+!c         CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
+!
+!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+!      DO l = 1, llm      
+!        finvmaold(ijb:ije,l)=finvmasse(ijb:ije,l)        
+!      ENDDO
+!c$OMP END DO NOWAIT
 
       endif ! of if (planet_type.eq."earth")
Index: LMDZ5/branches/testing/libf/dyn3dpar/leapfrog_p.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/leapfrog_p.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/leapfrog_p.F	(revision 1665)
@@ -75,5 +75,4 @@
 
       real zqmin,zqmax
-      INTEGER nbetatmoy, nbetatdem,nbetat
 
 c   variables dynamiques
@@ -125,5 +124,5 @@
       REAL  SSUM
       REAL time_0 
-      REAL,SAVE :: finvmaold(ip1jmp1,llm)
+!      REAL,SAVE :: finvmaold(ip1jmp1,llm)
 
 cym      LOGICAL  lafin
@@ -234,7 +233,7 @@
       dq(:,:,:)=0.
       CALL pression ( ip1jmp1, ap, bp, ps, p       )
-      if (disvert_type==1) then
+      if (pressure_exner) then
         CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
-      else ! we assume that we are in the disvert_type==2 case
+      else
         CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
       endif
@@ -245,9 +244,14 @@
 c et du parallelisme !!
 
-   1  CONTINUE
-
-      jD_cur = jD_ref + day_ini - day_ref + int (itau * dtvr / daysec) 
-      jH_cur = jH_ref +                                                 &
-     &          (itau * dtvr / daysec - int(itau * dtvr / daysec)) 
+   1  CONTINUE ! Matsuno Forward step begins here
+
+      jD_cur = jD_ref + day_ini - day_ref +                             &
+     &          itau/day_step
+      jH_cur = jH_ref + start_time +                                    &
+     &         mod(itau,day_step)/float(day_step) 
+      if (jH_cur > 1.0 ) then
+        jD_cur = jD_cur +1.
+        jH_cur = jH_cur -1.
+      endif
 
 
@@ -280,7 +284,8 @@
          massem1= masse
          psm1= ps
-         
-         finvmaold = masse
-         CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
+
+! Ehouarn: finvmaold is actually not used       
+!         finvmaold = masse
+!         CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
 c$OMP END MASTER
 c$OMP BARRIER
@@ -300,5 +305,5 @@
            tetam1   (ijb:ije,l) = teta  (ijb:ije,l)
            massem1  (ijb:ije,l) = masse (ijb:ije,l)
-           finvmaold(ijb:ije,l)=masse(ijb:ije,l)
+!           finvmaold(ijb:ije,l)=masse(ijb:ije,l)
                  
            if (pole_sud) ije=ij_end-iip1
@@ -309,7 +314,7 @@
 c$OMP ENDDO  
 
-
-          CALL filtreg_p ( finvmaold ,jj_begin,jj_end,jjp1, 
-     .                    llm, -2,2, .TRUE., 1 )
+! Ehouarn: finvmaold not used
+!          CALL filtreg_p ( finvmaold ,jj_begin,jj_end,jjp1, 
+!     .                    llm, -2,2, .TRUE., 1 )
 
        endif ! of if (FirstCaldyn)
@@ -327,5 +332,5 @@
 cym      call minmax(ijp1llm,q(:,:,3),zqmin,zqmax)
 
-   2  CONTINUE
+   2  CONTINUE ! Matsuno backward or leapfrog step begins here
 
 c$OMP MASTER
@@ -472,6 +477,6 @@
          call Register_SwapFieldHallo(phi,phi,ip1jmp1,llm,
      &                                jj_Nb_caldyn,0,0,TestRequest)
-         call Register_SwapFieldHallo(finvmaold,finvmaold,ip1jmp1,llm,
-     &                                jj_Nb_caldyn,0,0,TestRequest)
+!         call Register_SwapFieldHallo(finvmaold,finvmaold,ip1jmp1,llm,
+!     &                                jj_Nb_caldyn,0,0,TestRequest)
  
         do j=1,nqtot
@@ -555,4 +560,5 @@
       call start_timer(timer_caldyn)
 
+      ! compute geopotential phi()
       CALL geopot_p  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
 
@@ -629,6 +635,6 @@
 
        CALL integrd_p ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
-     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
-     $              finvmaold                                    )
+     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis )
+!     $              finvmaold                                    )
 
 !       CALL FTRACE_REGION_END("integrd")
@@ -693,15 +699,19 @@
 
 c$OMP BARRIER
-         if (disvert_type==1) then
+         if (pressure_exner) then
            CALL exner_hyb_p(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
-         else ! we assume that we are in the disvert_type==2 case
+         else
            CALL exner_milieu_p( ip1jmp1, ps, p, beta, pks, pk, pkf )
          endif
 c$OMP BARRIER
            jD_cur = jD_ref + day_ini - day_ref
-     $        + int (itau * dtvr / daysec) 
-           jH_cur = jH_ref +                                            &
-     &              (itau * dtvr / daysec - int(itau * dtvr / daysec)) 
+     $        + itau/day_step
+           jH_cur = jH_ref + start_time +                                &
+     &              mod(itau,day_step)/float(day_step) 
 !         call ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes)
+           if (jH_cur > 1.0 ) then
+             jD_cur = jD_cur +1.
+             jH_cur = jH_cur -1.
+           endif
 
 c rajout debug
@@ -719,6 +729,8 @@
 ! Ehouarn: be careful, diagedyn is Earth-specific (includes ../phylmd/..)!
            IF (planet_type.eq."earth") THEN
+#ifdef CPP_EARTH
             CALL diagedyn(ztit,2,1,1,dtphys
      &    , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
+#endif
            ENDIF
       ENDIF 
@@ -1036,7 +1048,7 @@
         CALL pression_p ( ip1jmp1, ap, bp, ps, p                  )
 c$OMP BARRIER
-        if (disvert_type==1) then
+        if (pressure_exner) then
           CALL exner_hyb_p( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
-        else ! we assume that we are in the disvert_type==2 case
+        else
           CALL exner_milieu_p( ip1jmp1, ps, p, beta, pks, pk, pkf )
         endif
@@ -1185,4 +1197,8 @@
 c$OMP END DO NOWAIT
 
+         if (1 == 0) then
+!!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
+!!!                     2) should probably not be here anyway
+!!! but are kept for those who would want to revert to previous behaviour
 c$OMP MASTER               
           DO ij =  1,iim
@@ -1195,5 +1211,6 @@
           ENDDO
 c$OMP END MASTER
-        endif
+         endif ! of if (1 == 0)
+        endif ! of of (pole_nord)
         
         if (pole_sud) then
@@ -1211,4 +1228,8 @@
 c$OMP END DO NOWAIT
 
+         if (1 == 0) then
+!!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
+!!!                     2) should probably not be here anyway
+!!! but are kept for those who would want to revert to previous behaviour
 c$OMP MASTER               
           DO ij =  1,iim
@@ -1221,5 +1242,6 @@
           ENDDO
 c$OMP END MASTER
-        endif
+         endif ! of if (1 == 0)
+        endif ! of if (pole_sud)
 
 
@@ -1431,5 +1453,4 @@
 c$OMP BARRIER
 c$OMP MASTER
-              nbetat = nbetatdem
               CALL geopot_p(ip1jmp1,teta,pk,pks,phis,phi)
        
@@ -1634,5 +1655,4 @@
 c$OMP BARRIER
 c$OMP MASTER
-                nbetat = nbetatdem
                 CALL geopot_p(ip1jmp1,teta,pk,pks,phis,phi)
 
Index: LMDZ5/branches/testing/libf/dyn3dpar/mod_interface_dyn_phys.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/mod_interface_dyn_phys.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/mod_interface_dyn_phys.F90	(revision 1665)
@@ -7,7 +7,6 @@
   
   
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
 ! Interface with parallel physics,
-! for now this routine only works with Earth physics
 CONTAINS
   
@@ -56,4 +55,4 @@
   END SUBROUTINE Init_interface_dyn_phys 
 #endif
-! of #ifdef CPP_EARTH
+! of #ifdef CPP_PHYS
 END MODULE mod_interface_dyn_phys
Index: LMDZ5/branches/testing/libf/dyn3dpar/temps.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/temps.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/temps.h	(revision 1665)
@@ -14,10 +14,12 @@
 
       COMMON/temps/itaufin, dt, day_ini, day_end, annee_ref, day_ref,   &
-     &             itau_dyn, itau_phy, jD_ref, jH_ref, calend
+     &             itau_dyn, itau_phy, jD_ref, jH_ref, calend,          &
+     &             start_time
+
 
       INTEGER   itaufin
       INTEGER itau_dyn, itau_phy
       INTEGER day_ini, day_end, annee_ref, day_ref
-      REAL      dt, jD_ref, jH_ref
+      REAL      dt, jD_ref, jH_ref, start_time
       CHARACTER (len=10) :: calend
 
Index: LMDZ5/branches/testing/libf/dyn3dpar/wrgrads.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dpar/wrgrads.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/dyn3dpar/wrgrads.F	(revision 1665)
@@ -22,5 +22,5 @@
 c   local
 
-      integer im,jm,lm,i,j,l,lnblnk,iv,iii,iji,iif,ijf
+      integer im,jm,lm,i,j,l,iv,iii,iji,iif,ijf
 
       logical writectl
@@ -55,5 +55,5 @@
             nvar(if)=ivar(if)
             var(ivar(if),if)=name
-            tvar(ivar(if),if)=titlevar(1:lnblnk(titlevar))
+            tvar(ivar(if),if)=trim(titlevar)
             nld(ivar(if),if)=nl
             print*,'initialisation ecriture de ',var(ivar(if),if)
@@ -96,8 +96,8 @@
       file=fichier(if)
 c   WARNING! on reecrase le fichier .ctl a chaque ecriture
-      open(unit(if),file=file(1:lnblnk(file))//'.ctl'
+      open(unit(if),file=trim(file)//'.ctl'
      &         ,form='formatted',status='unknown')
       write(unit(if),'(a5,1x,a40)')
-     &       'DSET ','^'//file(1:lnblnk(file))//'.dat'
+     &       'DSET ','^'//trim(file)//'.dat'
 
       write(unit(if),'(a12)') 'UNDEF 1.0E30'
Index: LMDZ5/branches/testing/libf/filtrez/coefils.h
===================================================================
--- LMDZ5/branches/testing/libf/filtrez/coefils.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/filtrez/coefils.h	(revision 1665)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id $
 !
       COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)&
@@ -7,5 +7,10 @@
      & ,coefilu2(iim,jjm),coefilv2(iim,jjm)
 !c
-      INTEGER jfiltnu,jfiltsu,jfiltnv,jfiltsv,modfrstu,modfrstv
+      INTEGER jfiltnu ! index of the last lat line filtered in NH (U grid)
+      INTEGER jfiltsu ! index of the first lat line filtered in SH (U grid)
+      INTEGER jfiltnv ! index of the last lat line filtered in NH (V grid)
+      INTEGER jfiltsv ! index of the first lat line filtered in SH (V grid)
+      INTEGER modfrstu ! number of retained (ie: unfiltered) modes on U grid
+      INTEGER modfrstv ! number of retained (ie: unfiltered) modes on V grid
       REAL    sddu,sddv,unsddu,unsddv,coefilu,coefilv,eignfnu,eignfnv
       REAL    coefilu2,coefilv2
Index: LMDZ5/branches/testing/libf/filtrez/filtreg_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/filtrez/filtreg_mod.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/filtrez/filtreg_mod.F90	(revision 1665)
@@ -1,2 +1,5 @@
+!
+! $Id $
+!
 MODULE filtreg_mod
 
@@ -42,5 +45,4 @@
     INTEGER ixmineq
 #endif
-    EXTERNAL  inifgn
     !
     ! ------------------------------------------------------------
@@ -71,7 +73,7 @@
     CALL inifgn(eignvl)
     !
-    PRINT *,' EIGNVL '
+    PRINT *,'inifilr: EIGNVL '
     PRINT 250,eignvl
-250 FORMAT( 1x,5e13.6)
+250 FORMAT( 1x,5e14.6)
     !
     ! compute eigenvalues and eigenfunctions
@@ -113,4 +115,10 @@
 #endif
     !
+    ! For a regular grid, we want the filter to start at latitudes
+    ! corresponding to lengths dx of the same size as dy (in terms
+    ! of angles: dx=2*dy) => at colat0=0.5 (i.e. colatitude=30 degrees
+    !  <=> latitude=60 degrees).
+    ! Same idea for the zoomed grid: start filtering polewards as soon
+    ! as length dx becomes of the same size as dy 
     !
     colat0  =  MIN( 0.5, dymin/dxmin )
@@ -158,16 +166,25 @@
     imx  = iim
     !
-    PRINT *,' TRUNCATION AT ',imx
-    !
+    PRINT *,'inifilr: TRUNCATION AT ',imx
+    !
+! Ehouarn: set up some defaults
+    jfiltnu=2 ! avoid north pole
+    jfiltsu=jjm ! avoid south pole (which is at jjm+1)
+    jfiltnv=1 ! NB: no poles on the V grid
+    jfiltsv=jjm
+
     DO j = 2, jjm/2+1
        cof = COS( rlatu(j) )/ colat0
        IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatu(j) ).LT.1. ) jfiltnu= j
+          IF( rlamda(imx) * COS(rlatu(j) ).LT.1. ) THEN
+            jfiltnu= j
+          ENDIF
        ENDIF
 
        cof = COS( rlatu(jjp1-j+1) )/ colat0
        IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ).LT.1. ) &
+          IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ).LT.1. ) THEN
                jfiltsu= jjp1-j+1
+          ENDIF
        ENDIF
     ENDDO
@@ -176,16 +193,18 @@
        cof = COS( rlatv(j) )/ colat0
        IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatv(j) ).LT.1. ) jfiltnv= j
+          IF( rlamda(imx) * COS(rlatv(j) ).LT.1. ) THEN
+            jfiltnv= j
+          ENDIF
        ENDIF
 
        cof = COS( rlatv(jjm-j+1) )/ colat0
        IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatv(jjm-j+1) ).LT.1. ) &
+          IF( rlamda(imx) * COS(rlatv(jjm-j+1) ).LT.1. ) THEN
                jfiltsv= jjm-j+1
+          ENDIF
        ENDIF
     ENDDO
     !                                 
 
-    IF ( jfiltnu.LE.0 ) jfiltnu=1
     IF( jfiltnu.GT. jjm/2 +1 )  THEN
        PRINT *,' jfiltnu en dehors des valeurs acceptables ' ,jfiltnu
@@ -193,5 +212,4 @@
     ENDIF
 
-    IF( jfiltsu.LE.0) jfiltsu=1
     IF( jfiltsu.GT.  jjm  +1 )  THEN
        PRINT *,' jfiltsu en dehors des valeurs acceptables ' ,jfiltsu
@@ -199,5 +217,4 @@
     ENDIF
 
-    IF( jfiltnv.LE.0) jfiltnv=1
     IF( jfiltnv.GT. jjm/2    )  THEN
        PRINT *,' jfiltnv en dehors des valeurs acceptables ' ,jfiltnv
@@ -205,5 +222,4 @@
     ENDIF
 
-    IF( jfiltsv.LE.0) jfiltsv=1
     IF( jfiltsv.GT.     jjm  )  THEN
        PRINT *,' jfiltsv en dehors des valeurs acceptables ' ,jfiltsv
@@ -211,14 +227,14 @@
     ENDIF
 
-    PRINT *,' jfiltnv jfiltsv jfiltnu jfiltsu ' , &
+    PRINT *,'inifilr: jfiltnv jfiltsv jfiltnu jfiltsu ' , &
          jfiltnv,jfiltsv,jfiltnu,jfiltsu
 
     IF(first_call_inifilr) THEN
        ALLOCATE(matriceun(iim,iim,jfiltnu))
-       ALLOCATE(matriceus(iim,iim,jfiltsu))
+       ALLOCATE(matriceus(iim,iim,jjm-jfiltsu+1))
        ALLOCATE(matricevn(iim,iim,jfiltnv))
-       ALLOCATE(matricevs(iim,iim,jfiltsv))
+       ALLOCATE(matricevs(iim,iim,jjm-jfiltsv+1))
        ALLOCATE( matrinvn(iim,iim,jfiltnu))
-       ALLOCATE( matrinvs(iim,iim,jfiltsu))
+       ALLOCATE( matrinvs(iim,iim,jjm-jfiltsu+1))
        first_call_inifilr = .FALSE.
     ENDIF
@@ -230,4 +246,5 @@
     !
     DO j = 1,jjm
+    !default initialization: all modes are retained (i.e. no filtering)
        modfrstu( j ) = iim
        modfrstv( j ) = iim
@@ -306,5 +323,6 @@
 
     IF(jfiltnv.GE.jjm/2 .OR. jfiltnu.GE.jjm/2)THEN
-
+! Ehouarn: and what are these for??? Trying to handle a limit case
+!          where filters extend to and meet at the equator?
        IF(jfiltnv.EQ.jfiltsv)jfiltsv=1+jfiltnv
        IF(jfiltnu.EQ.jfiltsu)jfiltsu=1+jfiltnu
@@ -334,5 +352,5 @@
              eignft(i,k) = eignfnv(k,i) * coff
           ENDDO
-       ENDDO
+       ENDDO ! of DO i=1,iim
 #ifdef CRAY
        CALL MXM( eignfnv,iim,eignft,iim,matriceun(1,1,j),iim )
@@ -350,9 +368,9 @@
              ENDDO
           ENDDO
-       ENDDO
-#endif
-#endif
-
-    ENDDO
+       ENDDO ! of DO k = 1, iim
+#endif
+#endif
+
+    ENDDO ! of DO j = 2, jfiltnu
 
     DO j = jfiltsu, jjm
@@ -364,5 +382,5 @@
              eignft(i,k) = eignfnv(k,i) * coff
           ENDDO
-       ENDDO
+       ENDDO ! of DO i=1,iim
 #ifdef CRAY
        CALL MXM(eignfnv,iim,eignft,iim,matriceus(1,1,j-jfiltsu+1),iim)
@@ -381,9 +399,9 @@
              ENDDO
           ENDDO
-       ENDDO
-#endif
-#endif
-
-    ENDDO
+       ENDDO ! of DO k = 1, iim
+#endif
+#endif
+
+    ENDDO ! of DO j = jfiltsu, jjm
 
     !   ...................................................................
@@ -421,5 +439,5 @@
 #endif
 
-    ENDDO
+    ENDDO ! of DO j = 1, jfiltnv
 
     DO j = jfiltsv, jjm
@@ -452,5 +470,5 @@
 #endif
 
-    ENDDO
+    ENDDO ! of DO j = jfiltsv, jjm
 
     !   ...................................................................
@@ -488,5 +506,5 @@
 #endif
 
-    ENDDO
+    ENDDO ! of DO j = 2, jfiltnu
 
     DO j = jfiltsu, jjm
@@ -518,5 +536,5 @@
 #endif
 
-    ENDDO
+    ENDDO ! of DO j = jfiltsu, jjm
 
     IF (use_filtre_fft) THEN
Index: LMDZ5/branches/testing/libf/grid/dimension/makdim
===================================================================
--- LMDZ5/branches/testing/libf/grid/dimension/makdim	(revision 1664)
+++ LMDZ5/branches/testing/libf/grid/dimension/makdim	(revision 1665)
@@ -1,48 +1,48 @@
-for i in $* ; do
-   list=$list.$i
+#!/bin/bash
+#set -xv
+
+# sanity check: do we have the required argument ?
+if (( $# < 1 )) || (( $# > 3 ))
+then
+ echo "Wrong number of parameters in $0 !!!"
+ echo " Usage:"
+ echo "  $0 [im] [jm] lm"
+ echo " where im, jm and lm are the dimensions"
+ exit
+fi
+
+# build "fichnom", the relevant 'dimensions.im.jm.lm' file name
+for i in $*
+  do
+  list=$list.$i
 done
 fichdim=dimensions${list}
 
-if [ ! -f $fichdim ] ; then
-# si le fichier de dimensions n'existe pas, on le cree
+if [ ! -f $fichdim ]
+    then
+#    echo "$fichdim does not exist"
 
-  if [ $# -ge 3 ] ; then
-     im=$1
-     jm=$2
-     lm=$3
-     n2=$1
-     ndm=1
+    # assign values of im, jm and lm
+    if [ $# -ge 3 ]
+        then
+        im=$1
+        jm=$2
+        lm=$3
+        ndm=1
+    elif [ $# -ge 2 ]
+        then
+        im=1
+        jm=$1
+        lm=$2
+        ndm=1
+    elif [ $# -ge 1 ]
+        then
+        im=1
+        jm=1
+        lm=$1
+        ndm=1
+    fi
 
-# Le test suivant est commente car il est inutile avec le nouveau 
-# filtre filtrez. Attention avec le "vieux" filtre (F. Forget,11/1994)
-#
-#     while [ "$n2" -gt 2 ]; do
-#       n2=`expr $n2 / 2`
-#       ndm=`expr $ndm + 1`
-#       echo $n2
-#    done
-#    if [ "$n2" != 2 ] ; then
-#       echo le nombre de longitude doit etre une puissance de 2
-#       exit
-#    fi
-
-
-  else if [ $# -ge 2 ] ; then
-      im=1
-      jm=$1
-      lm=$2
-      ndm=1
-  else if [ $# -ge 1 ] ; then
-      im=1
-      jm=1
-      lm=$1
-      ndm=1
-  else
-         echo il faut au moins une dimension
-         exit
-  fi
-fi
-fi
-
+# since the file doesn't exist, we create it
 cat << EOF > $fichdim
 !-----------------------------------------------------------------------
@@ -62,4 +62,8 @@
 fi
 
+# remove 'old' dimensions.h file (if any) and replace it with new one
+if [ -f ../dimensions.h ] ; then
 \rm ../dimensions.h
+fi
 tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimensions.h )
+# line above is a trick to preserve time of creation of dimensions.h files
Index: LMDZ5/branches/testing/libf/phy1d/1DUTILS.h_no_writelim
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/1DUTILS.h_no_writelim	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/1DUTILS.h_no_writelim	(revision 1665)
@@ -0,0 +1,2582 @@
+!
+! $Id: conf_unicol.F 1279 2010-08-04 17:20:56Z lahellec $
+!
+c
+c
+      SUBROUTINE conf_unicol( tapedef )
+c
+#ifdef CPP_IOIPSL
+      use IOIPSL
+#else
+! if not using IOIPSL, we still need to use (a local version of) getin
+      use ioipsl_getincom
+#endif
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c     Auteurs :   A. Lahellec  .
+c
+c     Arguments :
+c
+c     tapedef   :
+
+       INTEGER tapedef
+c
+c   Declarations :
+c   --------------
+
+#include "compar1d.h"
+#include "flux_arp.h"
+#include "fcg_gcssold.h"
+#include "fcg_racmo.h"
+#include "iniprint.h"
+c
+c
+c   local:
+c   ------
+
+c      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
+      
+c
+c  -------------------------------------------------------------------
+c
+c      .........    Initilisation parametres du lmdz1D      ..........
+c
+c---------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+!Config  Key  = lunout
+!Config  Desc = unite de fichier pour les impressions
+!Config  Def  = 6
+!Config  Help = unite de fichier pour les impressions 
+!Config         (defaut sortie standard = 6)
+      lunout=6
+      CALL getin('lunout', lunout)
+      IF (lunout /= 5 .and. lunout /= 6) THEN
+        OPEN(lunout,FILE='lmdz.out')
+      ENDIF
+
+!Config  Key  = prt_level
+!Config  Desc = niveau d'impressions de débogage
+!Config  Def  = 0
+!Config  Help = Niveau d'impression pour le débogage
+!Config         (0 = minimum d'impression)
+c      prt_level = 0
+c      CALL getin('prt_level',prt_level)
+
+c-----------------------------------------------------------------------
+c  Parametres de controle du run:
+c-----------------------------------------------------------------------
+
+!Config  Key  = restart
+!Config  Desc = on repart des startphy et start1dyn
+!Config  Def  = false
+!Config  Help = les fichiers restart doivent etre renomme en start
+       restart = .FALSE.
+       CALL getin('restart',restart)
+
+!Config  Key  = forcing_type
+!Config  Desc = defines the way the SCM is forced:
+!Config  Def  = 0
+!!Config  Help = 0 ==> forcing_les = .true.
+!             initial profiles from file prof.inp.001
+!             no forcing by LS convergence ; 
+!             surface temperature imposed ;
+!             radiative cooling may be imposed (iflag_radia=0 in physiq.def)
+!         = 1 ==> forcing_radconv = .true.
+!             idem forcing_type = 0, but the imposed radiative cooling 
+!             is set to 0 (hence, if iflag_radia=0 in physiq.def, 
+!             then there is no radiative cooling at all)
+!         = 2 ==> forcing_toga = .true.
+!             initial profiles from TOGA-COARE IFA files 
+!             LS convergence and SST imposed from TOGA-COARE IFA files 
+!         = 3 ==> forcing_GCM2SCM = .true.
+!             initial profiles from the GCM output
+!             LS convergence imposed from the GCM output
+!         = 4 ==> forcing_twpi = .true.
+!             initial profiles from TWPICE nc files 
+!             LS convergence and SST imposed from TWPICE nc files 
+!         = 5 ==> forcing_rico = .true.
+!             initial profiles from RICO idealized
+!             LS convergence imposed from  RICO (cst) 
+!         = 40 ==> forcing_GCSSold = .true.
+!             initial profile from GCSS file
+!             LS convergence imposed from GCSS file
+!
+       forcing_type = 0
+       CALL getin('forcing_type',forcing_type)
+         imp_fcg_gcssold   = .false.
+         ts_fcg_gcssold    = .false.  
+         Tp_fcg_gcssold    = .false.  
+         Tp_ini_gcssold    = .false.  
+         xTurb_fcg_gcssold = .false. 
+        IF (forcing_type .eq.40) THEN
+          CALL getin('imp_fcg',imp_fcg_gcssold)
+          CALL getin('ts_fcg',ts_fcg_gcssold)
+          CALL getin('tp_fcg',Tp_fcg_gcssold)
+          CALL getin('tp_ini',Tp_ini_gcssold)
+          CALL getin('turb_fcg',xTurb_fcg_gcssold)
+        ENDIF
+
+!Config  Key  = ok_flux_surf
+!Config  Desc = forcage ou non par les flux de surface
+!Config  Def  = false
+!Config  Help = forcage ou non par les flux de surface
+       ok_flux_surf = .FALSE.
+       CALL getin('ok_flux_surf',ok_flux_surf)
+
+!Config  Key  = time_ini
+!Config  Desc = meaningless in this  case
+!Config  Def  = 0.
+!Config  Help = 
+       tsurf = 0.
+       CALL getin('time_ini',time_ini)
+
+!Config  Key  = rlat et rlon
+!Config  Desc = latitude et longitude
+!Config  Def  = 0.0  0.0
+!Config  Help = fixe la position de la colonne
+       xlat = 0.
+       xlon = 0.
+       CALL getin('rlat',xlat)
+       CALL getin('rlon',xlon)
+
+!Config  Key  = airephy
+!Config  Desc = Grid cell area
+!Config  Def  = 1.e11
+!Config  Help = 
+       airefi = 1.e11
+       CALL getin('airephy',airefi)
+
+!Config  Key  = nat_surf
+!Config  Desc = surface type
+!Config  Def  = 0 (ocean)
+!Config  Help = 0=ocean,1=land,2=glacier,3=banquise
+       nat_surf = 0.
+       CALL getin('nat_surf',nat_surf)
+
+!Config  Key  = tsurf
+!Config  Desc = surface temperature
+!Config  Def  = 290.
+!Config  Help = not used if type_ts_forcing=1 in lmdz1d.F
+       tsurf = 290.
+       CALL getin('tsurf',tsurf)
+
+!Config  Key  = psurf
+!Config  Desc = surface pressure
+!Config  Def  = 102400.
+!Config  Help = 
+       psurf = 102400.
+       CALL getin('psurf',psurf)
+
+!Config  Key  = zsurf
+!Config  Desc = surface altitude
+!Config  Def  = 0.
+!Config  Help = 
+       zsurf = 0.
+       CALL getin('zsurf',zsurf)
+
+!Config  Key  = rugos
+!Config  Desc = coefficient de frottement
+!Config  Def  = 0.0001
+!Config  Help = calcul du Cdrag
+       rugos = 0.0001
+       CALL getin('rugos',rugos)
+
+!Config  Key  = wtsurf et wqsurf
+!Config  Desc = ???
+!Config  Def  = 0.0 0.0
+!Config  Help = 
+       wtsurf = 0.0
+       wqsurf = 0.0
+       CALL getin('wtsurf',wtsurf)
+       CALL getin('wqsurf',wqsurf)
+
+!Config  Key  = albedo
+!Config  Desc = albedo
+!Config  Def  = 0.09
+!Config  Help = 
+       albedo = 0.09
+       CALL getin('albedo',albedo)
+
+!Config  Key  = agesno
+!Config  Desc = age de la neige
+!Config  Def  = 30.0
+!Config  Help = 
+       xagesno = 30.0
+       CALL getin('agesno',xagesno)
+
+!Config  Key  = restart_runoff
+!Config  Desc = age de la neige
+!Config  Def  = 30.0
+!Config  Help = 
+       restart_runoff = 0.0
+       CALL getin('restart_runoff',restart_runoff)
+
+!Config  Key  = qsolinp
+!Config  Desc = initial bucket water content (kg/m2) when land (5std)
+!Config  Def  = 30.0
+!Config  Help = 
+       qsolinp = 1.
+       CALL getin('qsolinp',qsolinp)
+
+!Config  Key  = zpicinp
+!Config  Desc = denivellation orographie
+!Config  Def  = 300.
+!Config  Help =  input brise
+       zpicinp = 300.
+       CALL getin('zpicinp',zpicinp)
+
+
+      write(lunout,*)' +++++++++++++++++++++++++++++++++++++++'
+      write(lunout,*)' Configuration des parametres du gcm1D: '
+      write(lunout,*)' +++++++++++++++++++++++++++++++++++++++'
+      write(lunout,*)' restart = ', restart
+      write(lunout,*)' forcing_type = ', forcing_type
+      write(lunout,*)' time_ini = ', time_ini
+      write(lunout,*)' rlat = ', xlat
+      write(lunout,*)' rlon = ', xlon
+      write(lunout,*)' airephy = ', airefi
+      write(lunout,*)' nat_surf = ', nat_surf
+      write(lunout,*)' tsurf = ', tsurf
+      write(lunout,*)' psurf = ', psurf
+      write(lunout,*)' zsurf = ', zsurf
+      write(lunout,*)' rugos = ', rugos
+      write(lunout,*)' wtsurf = ', wtsurf
+      write(lunout,*)' wqsurf = ', wqsurf
+      write(lunout,*)' albedo = ', albedo
+      write(lunout,*)' xagesno = ', xagesno
+      write(lunout,*)' restart_runoff = ', restart_runoff
+      write(lunout,*)' qsolinp = ', qsolinp
+      write(lunout,*)' zpicinp = ', zpicinp
+      IF (forcing_type .eq.40) THEN
+        write(lunout,*) '--- Forcing type GCSS Old --- with:'
+        write(lunout,*)'imp_fcg',imp_fcg_gcssold
+        write(lunout,*)'ts_fcg',ts_fcg_gcssold
+        write(lunout,*)'tp_fcg',Tp_fcg_gcssold
+        write(lunout,*)'tp_ini',Tp_ini_gcssold
+        write(lunout,*)'xturb_fcg',xTurb_fcg_gcssold
+      ENDIF
+
+      write(lunout,*)' +++++++++++++++++++++++++++++++++++++++'
+      write(lunout,*)
+c
+      RETURN
+      END
+!
+! $Id: dyn1deta0.F 1279 2010/07/30 A Lahellec$
+!
+c
+      SUBROUTINE dyn1deta0(fichnom,plev,play,phi,phis,presnivs,
+     &                          ucov,vcov,temp,q,omega2)
+      USE dimphy
+      USE mod_grid_phy_lmdz
+      USE mod_phys_lmdz_para
+      USE iophy
+      USE phys_state_var_mod
+      USE iostart
+      USE write_field_phy
+      USE infotrac
+      use control_mod
+
+      IMPLICIT NONE
+c=======================================================
+c Ecriture du fichier de redemarrage sous format NetCDF
+c=======================================================
+c   Declarations:
+c   -------------
+#include "dimensions.h"
+#include "comconst.h"
+#include "temps.h"
+!!#include "control.h"
+#include "logic.h"
+#include "netcdf.inc"
+
+c   Arguments:
+c   ----------
+      CHARACTER*(*) fichnom
+cAl1 plev tronque pour .nc mais plev(klev+1):=0
+      real :: plev(klon,klev),play (klon,klev),phi(klon,klev)
+      real :: presnivs(klon,klev)
+      real :: ucov(klon,klev),vcov(klon,klev),temp(klon,klev)
+      real :: q(klon,klev,nqtot),omega2(klon,klev)
+c      real :: ug(klev),vg(klev),fcoriolis
+      real :: phis(klon) 
+
+c   Variables locales pour NetCDF:
+c   ------------------------------
+      INTEGER nid, nvarid
+      INTEGER idim_s
+      INTEGER ierr, ierr_file 
+      INTEGER iq
+      INTEGER length
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      character*4 nmq(nqtot)
+      character*12 modname
+      character*80 abort_message
+      LOGICAL found
+c
+      INTEGER nb
+
+      modname = 'dyn1deta0 : '
+      nmq(1)="vap"
+      nmq(2)="cond"
+      do iq=3,nqtot
+        write(nmq(iq),'("tra",i1)') iq-2
+      enddo
+      print*,'in dyn1deta0 ',fichnom,klon,klev,nqtot
+      CALL open_startphy(fichnom)
+      print*,'after open startphy ',fichnom,nmq
+
+c
+c Lecture des parametres de controle:
+c
+      CALL get_var("controle",tab_cntrl)
+       
+
+      im         = tab_cntrl(1)
+      jm         = tab_cntrl(2)
+      lllm       = tab_cntrl(3)
+      day_ref    = tab_cntrl(4)
+      annee_ref  = tab_cntrl(5)
+c      rad        = tab_cntrl(6)
+c      omeg       = tab_cntrl(7)
+c      g          = tab_cntrl(8)
+c      cpp        = tab_cntrl(9)
+c      kappa      = tab_cntrl(10)
+c      daysec     = tab_cntrl(11)
+c      dtvr       = tab_cntrl(12)
+c      etot0      = tab_cntrl(13)
+c      ptot0      = tab_cntrl(14)
+c      ztot0      = tab_cntrl(15)
+c      stot0      = tab_cntrl(16)
+c      ang0       = tab_cntrl(17)
+c      pa         = tab_cntrl(18)
+c      preff      = tab_cntrl(19)
+c
+c      clon       = tab_cntrl(20)
+c      clat       = tab_cntrl(21)
+c      grossismx  = tab_cntrl(22)
+c      grossismy  = tab_cntrl(23)
+c
+      IF ( tab_cntrl(24).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(27).EQ.1. ) ysinus = . TRUE. 
+      ENDIF
+
+      day_ini = tab_cntrl(30)
+      itau_dyn = tab_cntrl(31)
+c   .................................................................
+c
+c
+c      PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
+cAl1
+       Print*,'day_ref,annee_ref,day_ini,itau_dyn',
+     &              day_ref,annee_ref,day_ini,itau_dyn
+
+c  Lecture des champs
+c
+      plev(1,klev+1)=0.
+      CALL get_field("plev",plev,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Plev> est absent'
+      CALL get_field("play",play,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Play> est absent'
+      CALL get_field("phi",phi,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Phi> est absent'
+      CALL get_field("phis",phis,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Phis> est absent'
+      CALL get_field("presnivs",presnivs,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Presnivs> est absent'
+      CALL get_field("ucov",ucov,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <ucov> est absent'
+      CALL get_field("vcov",vcov,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <vcov> est absent'
+      CALL get_field("temp",temp,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <temp> est absent'
+      CALL get_field("omega2",omega2,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <omega2> est absent'
+
+      Do iq=1,nqtot
+        CALL get_field("q"//nmq(iq),q(:,:,iq),found)
+        IF (.NOT. found)
+     &  PRINT*, modname//'Le champ <q'//nmq//'> est absent'
+      EndDo
+
+      CALL close_startphy
+      print*,' close startphy'
+     .      ,fichnom,play(1,1),play(1,klev),temp(1,klev)
+c
+      RETURN
+      END
+!
+! $Id: dyn1dredem.F 1279 2010/07/29 A Lahellec$
+!
+c
+      SUBROUTINE dyn1dredem(fichnom,plev,play,phi,phis,presnivs,
+     &                          ucov,vcov,temp,q,omega2)
+      USE dimphy
+      USE mod_grid_phy_lmdz
+      USE mod_phys_lmdz_para
+      USE phys_state_var_mod
+      USE iostart
+      USE infotrac
+      use control_mod
+
+      IMPLICIT NONE
+c=======================================================
+c Ecriture du fichier de redemarrage sous format NetCDF
+c=======================================================
+c   Declarations:
+c   -------------
+#include "dimensions.h"
+#include "comconst.h"
+#include "temps.h"
+!!#include "control.h"
+#include "logic.h"
+#include "netcdf.inc"
+
+c   Arguments:
+c   ----------
+      CHARACTER*(*) fichnom
+      REAL time
+cAl1 plev tronque pour .nc mais plev(klev+1):=0
+      real :: plev(klon,klev),play (klon,klev),phi(klon,klev)
+      real :: presnivs(klon,klev)
+      real :: ucov(klon,klev),vcov(klon,klev),temp(klon,klev)
+      real :: q(klon,klev,nqtot)
+      real :: omega2(klon,klev),rho(klon,klev+1)
+c      real :: ug(klev),vg(klev),fcoriolis
+      real :: phis(klon) 
+
+c   Variables locales pour NetCDF:
+c   ------------------------------
+      INTEGER nid, nvarid
+      INTEGER idim_s
+      INTEGER ierr, ierr_file 
+      INTEGER iq,l
+      INTEGER length
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      character*4 nmq(nqtot)
+      character*20 modname
+      character*80 abort_message
+c
+      INTEGER nb
+      SAVE nb
+      DATA nb / 0 /
+
+      REAL zan0,zjulian,hours
+      INTEGER yyears0,jjour0, mmois0
+      character*30 unites
+
+cDbg
+      CALL open_restartphy(fichnom)
+      print*,'redm1 ',fichnom,klon,klev,nqtot
+      nmq(1)="vap"
+      nmq(2)="cond"
+      nmq(3)="tra1"
+      nmq(4)="tra2"
+
+      modname = 'dyn1dredem'
+      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Pb. d ouverture "//fichnom
+         CALL abort
+      ENDIF
+
+      DO l=1,length
+       tab_cntrl(l) = 0.
+      ENDDO
+       tab_cntrl(1)  = FLOAT(iim)
+       tab_cntrl(2)  = FLOAT(jjm)
+       tab_cntrl(3)  = FLOAT(llm)
+       tab_cntrl(4)  = FLOAT(day_ref)
+       tab_cntrl(5)  = FLOAT(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
+c       tab_cntrl(13) = etot0
+c       tab_cntrl(14) = ptot0
+c       tab_cntrl(15) = ztot0
+c       tab_cntrl(16) = stot0
+c       tab_cntrl(17) = ang0
+c       tab_cntrl(18) = pa
+c       tab_cntrl(19) = preff
+c
+c    .....    parametres  pour le zoom      ......   
+
+c       tab_cntrl(20)  = clon
+c       tab_cntrl(21)  = clat
+c       tab_cntrl(22)  = grossismx
+c       tab_cntrl(23)  = grossismy
+c
+      IF ( fxyhypb )   THEN
+       tab_cntrl(24) = 1.
+c       tab_cntrl(25) = dzoomx
+c       tab_cntrl(26) = dzoomy
+       tab_cntrl(27) = 0.
+c       tab_cntrl(28) = taux
+c       tab_cntrl(29) = tauy
+      ELSE
+       tab_cntrl(24) = 0.
+c       tab_cntrl(25) = dzoomx
+c       tab_cntrl(26) = dzoomy
+       tab_cntrl(27) = 0.
+       tab_cntrl(28) = 0.
+       tab_cntrl(29) = 0.
+       IF( ysinus )  tab_cntrl(27) = 1.
+      ENDIF
+CAl1 iday_end -> day_end
+       tab_cntrl(30) = FLOAT(day_end)
+       tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
+c
+      CALL put_var("controle","Param. de controle Dyn1D",tab_cntrl)
+c
+
+c  Ecriture/extension de la coordonnee temps
+
+      nb = nb + 1
+
+c  Ecriture des champs
+c
+      CALL put_field("plev","p interfaces sauf la nulle",plev)
+      CALL put_field("play","",play)
+      CALL put_field("phi","geopotentielle",phi)
+      CALL put_field("phis","geopotentiell de surface",phis)
+      CALL put_field("presnivs","",presnivs)
+      CALL put_field("ucov","",ucov)
+      CALL put_field("vcov","",vcov)
+      CALL put_field("temp","",temp)
+      CALL put_field("omega2","",omega2)
+
+      Do iq=1,nqtot
+        CALL put_field("q"//nmq(iq),"eau vap ou condens et traceurs",
+     .                                                      q(:,:,iq))
+      EndDo
+      CALL close_restartphy
+
+c
+      RETURN
+      END
+      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
+      IMPLICIT NONE
+!=======================================================================
+!   passage d'un champ de la grille scalaire a la grille physique
+!=======================================================================
+ 
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+ 
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+ 
+      INTEGER i,j,ifield,ig
+ 
+!-----------------------------------------------------------------------
+!   calcul:
+!   -------
+ 
+      DO ifield=1,nfield
+!   traitement des poles
+         DO i=1,im
+            pdyn(i,1,ifield)=pfi(1,ifield)
+            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
+         ENDDO
+ 
+!   traitement des point normaux
+         DO j=2,jm-1
+	    ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
+	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
+         ENDDO
+      ENDDO
+ 
+      RETURN
+      END
+ 
+ 
+
+      SUBROUTINE abort_gcm(modname, message, ierr)
+ 
+      USE IOIPSL
+!
+! Stops the simulation cleanly, closing files and printing various
+! comments
+!
+!  Input: modname = name of calling program
+!         message = stuff to print
+!         ierr    = severity of situation ( = 0 normal )
+ 
+      character*20 modname
+      integer ierr
+      character*80 message
+ 
+      write(*,*) 'in abort_gcm'
+      call histclo
+!     call histclo(2)
+!     call histclo(3)
+!     call histclo(4)
+!     call histclo(5)
+      write(*,*) 'out of histclo'
+      write(*,*) 'Stopping in ', modname
+      write(*,*) 'Reason = ',message
+      call getin_dump
+!
+      if (ierr .eq. 0) then
+        write(*,*) 'Everything is cool'
+      else
+        write(*,*) 'Houston, we have a problem ', ierr
+      endif
+      STOP
+      END
+      REAL FUNCTION fq_sat(kelvin, millibar)
+!
+      IMPLICIT none
+!======================================================================
+! Autheur(s): Z.X. Li (LMD/CNRS)
+! Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
+!======================================================================
+! Arguments:
+! kelvin---input-R: temperature en Kelvin
+! millibar--input-R: pression en mb
+!
+! fq_sat----output-R: vapeur d'eau saturante en kg/kg
+!======================================================================
+!
+      REAL kelvin, millibar
+!
+      REAL r2es
+      PARAMETER (r2es=611.14 *18.0153/28.9644)
+!
+      REAL r3les, r3ies, r3es
+      PARAMETER (R3LES=17.269)
+      PARAMETER (R3IES=21.875)
+!
+      REAL r4les, r4ies, r4es
+      PARAMETER (R4LES=35.86)
+      PARAMETER (R4IES=7.66)
+!
+      REAL rtt
+      PARAMETER (rtt=273.16)
+!
+      REAL retv
+      PARAMETER (retv=28.9644/18.0153 - 1.0)
+!
+      REAL zqsat
+      REAL temp, pres
+!     ------------------------------------------------------------------
+!
+!
+      temp = kelvin
+      pres = millibar * 100.0
+!      write(*,*)'kelvin,millibar=',kelvin,millibar
+!      write(*,*)'temp,pres=',temp,pres
+!
+      IF (temp .LE. rtt) THEN
+         r3es = r3ies
+         r4es = r4ies
+      ELSE
+         r3es = r3les
+         r4es = r4les
+      ENDIF
+!
+      zqsat=r2es/pres * EXP ( r3es*(temp-rtt) / (temp-r4es) )
+      zqsat=MIN(0.5,ZQSAT)
+      zqsat=zqsat/(1.-retv  *zqsat)
+!
+      fq_sat = zqsat
+!
+      RETURN
+      END
+      subroutine scopy(n,sx,incx,sy,incy)
+!
+      IMPLICIT NONE
+!
+      integer n,incx,incy,ix,iy,i
+      real sx((n-1)*incx+1),sy((n-1)*incy+1)
+!
+      iy=1
+      ix=1
+      do 10 i=1,n
+	 sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+!
+      return
+      end
+      subroutine wrgradsfi(if,nl,field,name,titlevar)
+      implicit none
+ 
+!   Declarations
+ 
+#include "gradsdef.h"
+ 
+!   arguments
+      integer if,nl
+      real field(imx*jmx*lmx)
+      character*10 name,file
+      character*10 titlevar
+ 
+!   local
+ 
+      integer im,jm,lm,i,j,l,iv,iii,iji,iif,ijf
+ 
+      logical writectl
+ 
+ 
+      writectl=.false.
+ 
+!     print*,if,iid(if),jid(if),ifd(if),jfd(if)
+      iii=iid(if)
+      iji=jid(if)
+      iif=ifd(if)
+      ijf=jfd(if)
+      im=iif-iii+1
+      jm=ijf-iji+1
+      lm=lmd(if)
+
+
+!     print*,'im,jm,lm,name,firsttime(if)'
+!     print*,im,jm,lm,name,firsttime(if)
+ 
+      if(firsttime(if)) then
+         if(name.eq.var(1,if)) then
+            firsttime(if)=.false.
+            ivar(if)=1
+         print*,'fin de l initialiation de l ecriture du fichier'
+         print*,file
+           print*,'fichier no: ',if
+           print*,'unit ',unit(if)
+           print*,'nvar  ',nvar(if)
+           print*,'vars ',(var(iv,if),iv=1,nvar(if))
+         else
+            ivar(if)=ivar(if)+1
+            nvar(if)=ivar(if)
+            var(ivar(if),if)=name
+            tvar(ivar(if),if)=trim(titlevar)
+            nld(ivar(if),if)=nl
+            print*,'initialisation ecriture de ',var(ivar(if),if)
+            print*,'if ivar(if) nld ',if,ivar(if),nld(ivar(if),if)
+         endif
+         writectl=.true.
+         itime(if)=1
+      else
+         ivar(if)=mod(ivar(if),nvar(if))+1
+         if (ivar(if).eq.nvar(if)) then
+            writectl=.true.
+            itime(if)=itime(if)+1
+         endif
+ 
+         if(var(ivar(if),if).ne.name) then
+           print*,'Il faut stoker la meme succession de champs a chaque'
+           print*,'pas de temps'
+           print*,'fichier no: ',if
+           print*,'unit ',unit(if)
+           print*,'nvar  ',nvar(if)
+           print*,'vars ',(var(iv,if),iv=1,nvar(if))
+ 
+           stop
+         endif
+      endif
+ 
+!     print*,'ivar(if),nvar(if),var(ivar(if),if),writectl'
+!     print*,ivar(if),nvar(if),var(ivar(if),if),writectl
+      do l=1,nl
+         irec(if)=irec(if)+1
+!        print*,'Ecrit rec=',irec(if),iii,iif,iji,ijf,
+!    s (l-1)*imd(if)*jmd(if)+(iji-1)*imd(if)+iii
+!    s ,(l-1)*imd(if)*jmd(if)+(ijf-1)*imd(if)+iif
+         write(unit(if)+1,rec=irec(if))
+     s   ((field((l-1)*imd(if)*jmd(if)+(j-1)*imd(if)+i)
+     s   ,i=iii,iif),j=iji,ijf)
+      enddo
+      if (writectl) then
+ 
+      file=fichier(if)
+!   WARNING! on reecrase le fichier .ctl a chaque ecriture
+      open(unit(if),file=trim(file)//'.ctl',
+     &         form='formatted',status='unknown')
+      write(unit(if),'(a5,1x,a40)')
+     &       'DSET ','^'//trim(file)//'.dat'
+ 
+      write(unit(if),'(a12)') 'UNDEF 1.0E30'
+      write(unit(if),'(a5,1x,a40)') 'TITLE ',title(if)
+      call formcoord(unit(if),im,xd(iii,if),1.,.false.,'XDEF')
+      call formcoord(unit(if),jm,yd(iji,if),1.,.true.,'YDEF')
+      call formcoord(unit(if),lm,zd(1,if),1.,.false.,'ZDEF')
+      write(unit(if),'(a4,i10,a30)')
+     &       'TDEF ',itime(if),' LINEAR 07AUG1998 30MN '
+      write(unit(if),'(a4,2x,i5)') 'VARS',nvar(if)
+      do iv=1,nvar(if)
+!        print*,'if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)'
+!        print*,if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)
+         write(unit(if),1000) var(iv,if),nld(iv,if)-1/nld(iv,if)
+     &     ,99,tvar(iv,if)
+      enddo
+      write(unit(if),'(a7)') 'ENDVARS'
+!
+1000  format(a5,3x,i4,i3,1x,a39)
+ 
+      close(unit(if))
+ 
+      endif ! writectl
+ 
+      return
+ 
+      END
+ 
+      subroutine inigrads(if,im
+     s  ,x,fx,xmin,xmax,jm,y,ymin,ymax,fy,lm,z,fz
+     s  ,dt,file,titlel)
+ 
+ 
+      implicit none
+ 
+      integer if,im,jm,lm,i,j,l
+      real x(im),y(jm),z(lm),fx,fy,fz,dt
+      real xmin,xmax,ymin,ymax
+      integer nf
+ 
+      character file*10,titlel*40
+ 
+#include "gradsdef.h"
+ 
+      data unit/24,32,34,36,38,40,42,44,46,48/
+      data nf/0/
+ 
+      if (if.le.nf) stop'verifier les appels a inigrads'
+ 
+      print*,'Entree dans inigrads'
+ 
+      nf=if
+      title(if)=titlel
+      ivar(if)=0
+ 
+      fichier(if)=trim(file)
+ 
+      firsttime(if)=.true.
+      dtime(if)=dt
+ 
+      iid(if)=1
+      ifd(if)=im
+      imd(if)=im
+      do i=1,im
+         xd(i,if)=x(i)*fx
+         if(xd(i,if).lt.xmin) iid(if)=i+1
+         if(xd(i,if).le.xmax) ifd(if)=i
+      enddo
+      print*,'On stoke du point ',iid(if),'  a ',ifd(if),' en x'
+ 
+      jid(if)=1
+      jfd(if)=jm
+      jmd(if)=jm
+      do j=1,jm
+         yd(j,if)=y(j)*fy
+         if(yd(j,if).gt.ymax) jid(if)=j+1
+         if(yd(j,if).ge.ymin) jfd(if)=j
+      enddo
+      print*,'On stoke du point ',jid(if),'  a ',jfd(if),' en y'
+
+      print*,'Open de dat'
+      print*,'file=',file
+      print*,'fichier(if)=',fichier(if)
+ 
+      print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if))
+      print*,trim(file)//'.dat'
+ 
+      OPEN (unit(if)+1,FILE=trim(file)//'.dat',
+     s   FORM='UNFORMATTED',
+     s   ACCESS='DIRECT'
+     s  ,RECL=4*(ifd(if)-iid(if)+1)*(jfd(if)-jid(if)+1))
+ 
+      print*,'Open de dat ok'
+ 
+      lmd(if)=lm
+      do l=1,lm
+         zd(l,if)=z(l)*fz
+      enddo
+ 
+      irec(if)=0
+!CR 
+!      print*,if,imd(if),jmd(if),lmd(if)
+!      print*,'if,imd(if),jmd(if),lmd(if)'
+ 
+      return
+      end
+      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
+      IMPLICIT NONE
+!=======================================================================
+!   passage d'un champ de la grille scalaire a la grille physique
+!=======================================================================
+ 
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+ 
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+ 
+      INTEGER j,ifield,ig
+ 
+!-----------------------------------------------------------------------
+!   calcul:
+!   -------
+ 
+      IF(ngrid.NE.2+(jm-2)*(im-1).AND.ngrid.NE.1)
+     s    STOP 'probleme de dim'
+!   traitement des poles
+      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
+      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
+ 
+!   traitement des point normaux
+      DO ifield=1,nfield
+         DO j=2,jm-1
+	    ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
+         ENDDO
+      ENDDO
+ 
+      RETURN
+      END
+ 
+      SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
+ 
+!    Auteur :  P. Le Van .
+!
+      IMPLICIT NONE
+ 
+#include "dimensions.h"
+#include "paramet.h"
+!
+!=======================================================================
+!
+!
+!    s = sigma ** kappa   :  coordonnee  verticale
+!    dsig(l)            : epaisseur de la couche l ds la coord.  s
+!    sig(l)             : sigma a l'interface des couches l et l-1
+!    ds(l)              : distance entre les couches l et l-1 en coord.s
+!
+!=======================================================================
+!
+      REAL pa,preff
+      REAL ap(llmp1),bp(llmp1),dpres(llm),nivsigs(llm),nivsig(llmp1)
+      REAL presnivs(llm)
+!
+!   declarations:
+!   -------------
+!
+      REAL sig(llm+1),dsig(llm)
+!
+      INTEGER l
+      REAL snorm
+      REAL alpha,beta,gama,delta,deltaz,h
+      INTEGER np,ierr
+      REAL pi,x
+ 
+!-----------------------------------------------------------------------
+!
+      pi=2.*ASIN(1.)
+ 
+      OPEN(99,file='sigma.def',status='old',form='formatted',
+     s   iostat=ierr)
+ 
+!-----------------------------------------------------------------------
+!   cas 1 on lit les options dans sigma.def:
+!   ----------------------------------------
+ 
+      IF (ierr.eq.0) THEN
+ 
+      print*,'WARNING!!! on lit les options dans sigma.def'
+      READ(99,*) deltaz
+      READ(99,*) h
+      READ(99,*) beta
+      READ(99,*) gama
+      READ(99,*) delta
+      READ(99,*) np
+      CLOSE(99)
+      alpha=deltaz/(llm*h)
+!
+ 
+       DO 1  l = 1, llm
+       dsig(l) = (alpha+(1.-alpha)*exp(-beta*(llm-l)))*
+     $          ( (tanh(gama*l)/tanh(gama*llm))**np +
+     $            (1.-l/FLOAT(llm))*delta )
+   1   CONTINUE
+ 
+       sig(1)=1.
+       DO 101 l=1,llm-1
+          sig(l+1)=sig(l)*(1.-dsig(l))/(1.+dsig(l))
+101    CONTINUE
+       sig(llm+1)=0.
+ 
+       DO 2  l = 1, llm
+       dsig(l) = sig(l)-sig(l+1)
+   2   CONTINUE
+!
+ 
+      ELSE
+!-----------------------------------------------------------------------
+!   cas 2 ancienne discretisation (LMD5...):
+!   ----------------------------------------
+ 
+      PRINT*,'WARNING!!! Ancienne discretisation verticale'
+ 
+      h=7.
+      snorm  = 0.
+      DO l = 1, llm
+         x = 2.*asin(1.) * (FLOAT(l)-0.5) / float(llm+1)
+         dsig(l) = 1.0 + 7.0 * SIN(x)**2
+         snorm = snorm + dsig(l)
+      ENDDO
+      snorm = 1./snorm
+      DO l = 1, llm
+         dsig(l) = dsig(l)*snorm
+      ENDDO
+      sig(llm+1) = 0.
+      DO l = llm, 1, -1
+         sig(l) = sig(l+1) + dsig(l)
+      ENDDO
+ 
+      ENDIF
+ 
+ 
+      DO l=1,llm
+        nivsigs(l) = FLOAT(l)
+      ENDDO
+ 
+      DO l=1,llmp1
+        nivsig(l)= FLOAT(l)
+      ENDDO
+ 
+!
+!    ....  Calculs  de ap(l) et de bp(l)  ....
+!    .........................................
+!
+!
+!   .....  pa et preff sont lus  sur les fichiers start par lectba  .....
+!
+ 
+      bp(llmp1) =   0.
+ 
+      DO l = 1, llm
+!c
+!cc    ap(l) = 0.
+!cc    bp(l) = sig(l)
+ 
+      bp(l) = EXP( 1. -1./( sig(l)*sig(l)) )
+      ap(l) = pa * ( sig(l) - bp(l) )
+!
+      ENDDO
+      ap(llmp1) = pa * ( sig(llmp1) - bp(llmp1) )
+ 
+      PRINT *,' BP '
+      PRINT *,  bp
+      PRINT *,' AP '
+      PRINT *,  ap
+ 
+      DO l = 1, llm
+       dpres(l) = bp(l) - bp(l+1)
+       presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
+      ENDDO
+ 
+      PRINT *,' PRESNIVS '
+      PRINT *,presnivs
+ 
+      RETURN
+      END
+
+!======================================================================
+       SUBROUTINE read_tsurf1d(knon,knindex,sst_out)
+
+! This subroutine specifies the surface temperature to be used in 1D simulations
+
+      USE dimphy, ONLY : klon
+
+      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
+      INTEGER, DIMENSION(klon), INTENT(IN) :: knindex  ! grid point number for compressed grid
+      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
+
+       INTEGER :: i
+! COMMON defined in lmdz1d.F:
+       real ts_cur
+       common /sst_forcing/ts_cur
+
+       DO i = 1, knon
+        sst_out(i) = ts_cur
+       ENDDO
+
+      END SUBROUTINE read_tsurf1d
+
+!===============================================================
+      subroutine advect_vert(llm,w,dt,q,plev)
+!===============================================================
+!   Schema amont pour l'advection verticale en 1D
+!   w est la vitesse verticale dp/dt en Pa/s
+!   Traitement en volumes finis 
+!   d / dt ( zm q ) = delta_z ( omega q )
+!   d / dt ( zm ) = delta_z ( omega )
+!   avec zm = delta_z ( p )
+!   si * designe la valeur au pas de temps t+dt
+!   zm*(l) q*(l) - zm(l) q(l) = w(l+1) q(l+1) - w(l) q(l)
+!   zm*(l) -zm(l) = w(l+1) - w(l)
+!   avec w=omega * dt
+!---------------------------------------------------------------
+      implicit none
+! arguments
+      integer llm
+      real w(llm+1),q(llm),plev(llm+1),dt
+
+! local
+      integer l
+      real zwq(llm+1),zm(llm+1),zw(llm+1)
+      real qold
+
+!---------------------------------------------------------------
+
+      do l=1,llm
+         zw(l)=dt*w(l)
+         zm(l)=plev(l)-plev(l+1)
+         zwq(l)=q(l)*zw(l)
+      enddo
+      zwq(llm+1)=0.
+      zw(llm+1)=0.
+ 
+      do l=1,llm
+         qold=q(l)
+         q(l)=(q(l)*zm(l)+zwq(l+1)-zwq(l))/(zm(l)+zw(l+1)-zw(l))
+         print*,'ADV Q ',zm(l),zw(l),zwq(l),qold,q(l)
+      enddo
+
+ 
+      return
+      end
+
+!===============================================================
+
+
+       SUBROUTINE advect_va(llm,omega,d_t_va,d_q_va,d_u_va,d_v_va,
+     !                q,temp,u,v,
+     !            play,plev)
+!itlmd 
+!----------------------------------------------------------------------
+!   Calcul de l'advection verticale (ascendance et subsidence) de 
+!   température et d'humidité. Hypothèse : ce qui rentre de l'extérieur
+!   a les mêmes caractéristiques que l'air de la colonne 1D (WTG) ou 
+!   sans WTG rajouter une advection horizontale 
+!----------------------------------------------------------------------  
+        implicit none
+#include "YOMCST.h"
+!        argument
+        integer llm
+        real  omega(llm+1),d_t_va(llm), d_q_va(llm,3)
+        real  d_u_va(llm), d_v_va(llm)
+        real  q(llm,3),temp(llm)
+        real  u(llm),v(llm)
+        real  play(llm),plev(llm+1)
+! interne
+        integer l
+        real alpha,omgdown,omgup
+
+      do l= 1,llm
+       if(l.eq.1) then
+!si omgup pour la couche 1, alors tendance nulle
+        omgdown=max(omega(2),0.0)
+        alpha = rkappa*temp(l)*(1.+q(l,1)*rv/rd)/(play(l)*
+     &           (1.+q(l,1)))
+        d_t_va(l)= alpha*(omgdown)- 
+     &              omgdown*(temp(l)-temp(l+1))
+     &              /(play(l)-play(l+1))              
+
+        d_q_va(l,:)= -omgdown*(q(l,:)-q(l+1,:))
+     &              /(play(l)-play(l+1))              
+
+        d_u_va(l)= -omgdown*(u(l)-u(l+1))
+     &              /(play(l)-play(l+1))              
+        d_v_va(l)= -omgdown*(v(l)-v(l+1))
+     &              /(play(l)-play(l+1))              
+
+        
+       elseif(l.eq.llm) then
+        omgup=min(omega(l),0.0)
+        alpha = rkappa*temp(l)*(1.+q(l,1)*rv/rd)/(play(l)*
+     &           (1.+q(l,1)))
+        d_t_va(l)= alpha*(omgup)- 
+!bug?     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-plev(l))
+     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-play(l))
+        d_q_va(l,:)= -omgup*(q(l-1,:)-q(l,:))/(play(l-1)-play(l))
+        d_u_va(l)= -omgup*(u(l-1)-u(l))/(play(l-1)-play(l))
+        d_v_va(l)= -omgup*(v(l-1)-v(l))/(play(l-1)-play(l))
+       
+       else
+        omgup=min(omega(l),0.0)
+        omgdown=max(omega(l+1),0.0)
+        alpha = rkappa*temp(l)*(1.+q(l,1)*rv/rd)/(play(l)*
+     &           (1.+q(l,1)))
+        d_t_va(l)= alpha*(omgup+omgdown)- 
+     &              omgdown*(temp(l)-temp(l+1))
+     &              /(play(l)-play(l+1))-              
+!bug?     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-plev(l))
+     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-play(l))
+!      print*, '  ??? '
+
+        d_q_va(l,:)= -omgdown*(q(l,:)-q(l+1,:))
+     &              /(play(l)-play(l+1))-              
+     &              omgup*(q(l-1,:)-q(l,:))/(play(l-1)-play(l))
+        d_u_va(l)= -omgdown*(u(l)-u(l+1))
+     &              /(play(l)-play(l+1))-              
+     &              omgup*(u(l-1)-u(l))/(play(l-1)-play(l))
+        d_v_va(l)= -omgdown*(v(l)-v(l+1))
+     &              /(play(l)-play(l+1))-              
+     &              omgup*(v(l-1)-v(l))/(play(l-1)-play(l))
+       
+      endif
+         
+      enddo
+!fin itlmd
+        return
+        end
+!       SUBROUTINE lstendH(llm,omega,d_t_va,d_q_va,d_u_va,d_v_va,
+       SUBROUTINE lstendH(llm,nqtot,omega,d_t_va,d_q_va,
+     !                q,temp,u,v,play)
+!itlmd 
+!----------------------------------------------------------------------
+!   Calcul de l'advection verticale (ascendance et subsidence) de 
+!   température et d'humidité. Hypothèse : ce qui rentre de l'extérieur
+!   a les mêmes caractéristiques que l'air de la colonne 1D (WTG) ou 
+!   sans WTG rajouter une advection horizontale 
+!----------------------------------------------------------------------  
+        implicit none
+#include "YOMCST.h"
+!        argument
+        integer llm,nqtot
+        real  omega(llm+1),d_t_va(llm), d_q_va(llm,nqtot)
+!        real  d_u_va(llm), d_v_va(llm)
+        real  q(llm,nqtot),temp(llm)
+        real  u(llm),v(llm)
+        real  play(llm)
+        real cor(llm)
+!        real dph(llm),dudp(llm),dvdp(llm),dqdp(llm),dtdp(llm)
+        real dph(llm),dqdp(llm),dtdp(llm)
+! interne
+        integer l,k
+        real alpha,omdn,omup
+
+!        dudp=0.
+!        dvdp=0.
+        dqdp=0.
+        dtdp=0.
+!        d_u_va=0.
+!        d_v_va=0.
+
+      cor(:) = rkappa*temp*(1.+q(:,1)*rv/rd)/(play*(1.+q(:,1)))
+
+
+      do k=2,llm-1
+
+       dph  (k-1) = (play(k  )- play(k-1  ))
+!       dudp (k-1) = (u   (k  )- u   (k-1  ))/dph(k-1)
+!       dvdp (k-1) = (v   (k  )- v   (k-1  ))/dph(k-1)
+       dqdp (k-1) = (q   (k,1)- q   (k-1,1))/dph(k-1)
+       dtdp (k-1) = (temp(k  )- temp(k-1  ))/dph(k-1)
+
+      enddo
+
+!      dudp (  llm  ) = dudp ( llm-1 )
+!      dvdp (  llm  ) = dvdp ( llm-1 )
+      dqdp (  llm  ) = dqdp ( llm-1 )
+      dtdp (  llm  ) = dtdp ( llm-1 )
+
+      do k=2,llm-1
+      omdn=max(0.0,omega(k+1))
+      omup=min(0.0,omega( k ))
+
+!      d_u_va(k)  = -omdn*dudp(k)-omup*dudp(k-1)
+!      d_v_va(k)  = -omdn*dvdp(k)-omup*dvdp(k-1)
+      d_q_va(k,1)= -omdn*dqdp(k)-omup*dqdp(k-1)
+      d_t_va(k)  = -omdn*dtdp(k)-omup*dtdp(k-1)
+     :              +(omup+omdn)*cor(k)
+      enddo
+
+      omdn=max(0.0,omega( 2 ))
+      omup=min(0.0,omega(llm))
+!      d_u_va( 1 )   = -omdn*dudp( 1 )
+!      d_u_va(llm)   = -omup*dudp(llm)
+!      d_v_va( 1 )   = -omdn*dvdp( 1 )
+!      d_v_va(llm)   = -omup*dvdp(llm)
+      d_q_va( 1 ,1) = -omdn*dqdp( 1 )
+      d_q_va(llm,1) = -omup*dqdp(llm)
+      d_t_va( 1 )   = -omdn*dtdp( 1 )+omdn*cor( 1 )
+      d_t_va(llm)   = -omup*dtdp(llm)!+omup*cor(llm)
+
+!      if(abs(rlat(1))>10.) then
+!     Calculate the tendency due agestrophic motions
+!      du_age = fcoriolis*(v-vg)
+!      dv_age = fcoriolis*(ug-u)
+!      endif
+
+!       call writefield_phy('d_t_va',d_t_va,llm)
+
+          return
+         end
+
+!======================================================================
+      SUBROUTINE read_togacoare(fich_toga,nlev_toga,nt_toga
+     :             ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga
+     :             ,ht_toga,vt_toga,hq_toga,vq_toga)
+      implicit none
+
+c-------------------------------------------------------------------------
+c Read TOGA-COARE forcing data 
+c-------------------------------------------------------------------------
+
+      integer nlev_toga,nt_toga
+      real ts_toga(nt_toga),plev_toga(nlev_toga,nt_toga)
+      real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
+      real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
+      real w_toga(nlev_toga,nt_toga)
+      real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+      real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+      character*80 fich_toga
+
+      integer no,l,k,ip
+      real riy,rim,rid,rih,bid
+
+      integer iy,im,id,ih
+      
+       real plev_min
+
+       plev_min = 55.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
+
+      open(21,file=trim(fich_toga),form='formatted')
+      read(21,'(a)') 
+      do ip = 1, nt_toga
+      read(21,'(a)') 
+      read(21,'(a)') 
+      read(21,223) iy, im, id, ih, bid, ts_toga(ip), bid,bid,bid,bid
+      read(21,'(a)') 
+      read(21,'(a)') 
+
+       do k = 1, nlev_toga
+         read(21,230) plev_toga(k,ip), t_toga(k,ip), q_toga(k,ip) 
+     :       ,u_toga(k,ip), v_toga(k,ip), w_toga(k,ip)
+     :       ,ht_toga(k,ip), vt_toga(k,ip), hq_toga(k,ip), vq_toga(k,ip)
+
+! conversion in SI units:
+         t_toga(k,ip)=t_toga(k,ip)+273.15     ! K
+         q_toga(k,ip)=q_toga(k,ip)*0.001      ! kg/kg
+         w_toga(k,ip)=w_toga(k,ip)*100./3600. ! Pa/s
+! no water vapour tendency above 55 hPa
+         if (plev_toga(k,ip) .lt. plev_min) then
+          q_toga(k,ip) = 0.
+          hq_toga(k,ip) = 0.
+          vq_toga(k,ip) =0.
+         endif
+       enddo
+
+         ts_toga(ip)=ts_toga(ip)+273.15       ! K
+       enddo
+       close(21)
+
+  223 format(4i3,6f8.2)
+  226 format(f7.1,1x,10f8.2)
+  227 format(f7.1,1x,1p,4e11.3)
+  230 format(6f9.3,4e11.3)
+
+          return
+          end
+
+!=====================================================================
+      subroutine read_twpice(fich_twpice,nlevel,ntime
+     :     ,T_srf,plev,T,q,u,v,omega
+     :     ,T_adv_h,T_adv_v,q_adv_h,q_adv_v)
+
+!program reading forcings of the TWP-ICE experiment
+
+!      use netcdf
+
+      implicit none
+
+#include "netcdf.inc"
+
+      integer ntime,nlevel
+      integer l,k
+      character*80 :: fich_twpice
+      real*8 time(ntime)
+      real*8 lat, lon, alt, phis	
+      real*8 lev(nlevel)
+      real*8 plev(nlevel,ntime)
+
+      real*8 T(nlevel,ntime)
+      real*8 q(nlevel,ntime),u(nlevel,ntime)
+      real*8 v(nlevel,ntime)
+      real*8 omega(nlevel,ntime), div(nlevel,ntime)
+      real*8 T_adv_h(nlevel,ntime)
+      real*8 T_adv_v(nlevel,ntime), q_adv_h(nlevel,ntime)
+      real*8 q_adv_v(nlevel,ntime)	
+      real*8 s(nlevel,ntime), s_adv_h(nlevel,ntime)
+      real*8 s_adv_v(nlevel,ntime)
+      real*8 p_srf_aver(ntime), p_srf_center(ntime)
+      real*8 T_srf(ntime)
+
+      integer nid, ierr
+      integer nbvar3d
+      parameter(nbvar3d=20)
+      integer var3didin(nbvar3d)
+
+      ierr = NF_OPEN(fich_twpice,NF_NOWRITE,nid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: Pb opening forcings cdf file '
+         write(*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+      ierr=NF_INQ_VARID(nid,"lat",var3didin(1))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lat'
+         endif
+      
+       ierr=NF_INQ_VARID(nid,"lon",var3didin(2))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lon'
+         endif
+
+       ierr=NF_INQ_VARID(nid,"alt",var3didin(3))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'alt'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"phis",var3didin(4))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'phis'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T",var3didin(5))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q",var3didin(6))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"u",var3didin(7))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'u'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"v",var3didin(8))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"omega",var3didin(9))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'omega'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"div",var3didin(10))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'div'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_adv_h",var3didin(11))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_adv_h'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_adv_v",var3didin(12))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q_adv_h",var3didin(13))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q_adv_h'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q_adv_v",var3didin(14))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"s",var3didin(15))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"s_adv_h",var3didin(16))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's_adv_h'
+         endif
+    
+      ierr=NF_INQ_VARID(nid,"s_adv_v",var3didin(17))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"p_srf_aver",var3didin(18))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'p_srf_aver'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"p_srf_center",var3didin(19))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'p_srf_center'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_srf",var3didin(20))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_srf'
+         endif
+
+!dimensions lecture
+      call catchaxis(nid,ntime,nlevel,time,lev,ierr)
+
+!pressure 
+       do l=1,ntime
+       do k=1,nlevel
+          plev(k,l)=lev(k)
+       enddo
+       enddo
+          
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),lat)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(1),lat)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture lat ok',lat
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),lon)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(2),lon)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture lon ok',lon
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),alt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(3),alt)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture alt ok',alt
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),phis)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(4),phis)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture phis ok',phis
+          
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),T)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(5),T)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),q)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(6),q)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q ok'
+!q in kg/kg
+       do l=1,ntime
+       do k=1,nlevel
+          q(k,l)=q(k,l)/1000.
+       enddo
+       enddo
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),u)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(7),u)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture u ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(8),v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture v ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),omega)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(9),omega)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture omega ok'
+!omega in mb/hour
+       do l=1,ntime
+       do k=1,nlevel
+          omega(k,l)=omega(k,l)*100./3600.
+       enddo
+       enddo
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),div)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(10),div)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture div ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),T_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(11),T_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_adv_h ok'
+!T adv in K/s
+       do l=1,ntime
+       do k=1,nlevel
+          T_adv_h(k,l)=T_adv_h(k,l)/3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),T_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(12),T_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_adv_v ok'
+!T adv in K/s
+       do l=1,ntime
+       do k=1,nlevel
+          T_adv_v(k,l)=T_adv_v(k,l)/3600.
+       enddo
+       enddo
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),q_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(13),q_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q_adv_h ok'
+!q adv in kg/kg/s
+       do l=1,ntime
+       do k=1,nlevel
+          q_adv_h(k,l)=q_adv_h(k,l)/1000./3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),q_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(14),q_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q_adv_v ok'
+!q adv in kg/kg/s
+       do l=1,ntime
+       do k=1,nlevel
+          q_adv_v(k,l)=q_adv_v(k,l)/1000./3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),s)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(15),s)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),s_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(16),s_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(17),s_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(17),s_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(18),p_srf_aver)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(18),p_srf_aver)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(19),p_srf_center)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(19),p_srf_center)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(20),T_srf)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(20),T_srf)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_srf ok', T_srf
+
+         return 
+         end subroutine read_twpice
+!=====================================================================
+         subroutine catchaxis(nid,ttm,llm,time,lev,ierr)
+
+!         use netcdf
+
+         implicit none
+#include "netcdf.inc"
+         integer nid,ttm,llm
+         real*8 time(ttm)
+         real*8 lev(llm)
+         integer ierr
+
+         integer i
+         integer timevar,levvar
+         integer timelen,levlen
+         integer timedimin,levdimin
+
+! Control & lecture on dimensions
+! ===============================
+         ierr=NF_INQ_DIMID(nid,"time",timedimin)
+         ierr=NF_INQ_VARID(nid,"time",timevar)
+         if (ierr.NE.NF_NOERR) then
+            write(*,*) 'ERROR: Field <time> is missing'
+            stop ""  
+         endif
+         ierr=NF_INQ_DIMLEN(nid,timedimin,timelen)
+
+         ierr=NF_INQ_DIMID(nid,"lev",levdimin)
+         ierr=NF_INQ_VARID(nid,"lev",levvar)
+         if (ierr.NE.NF_NOERR) then
+             write(*,*) 'ERROR: Field <lev> is lacking'
+             stop "" 
+         endif
+         ierr=NF_INQ_DIMLEN(nid,levdimin,levlen)
+
+         if((timelen/=ttm).or.(levlen/=llm)) then
+            write(*,*) 'ERROR: Not the good lenght for axis'
+            write(*,*) 'longitude: ',timelen,ttm+1
+            write(*,*) 'latitude: ',levlen,llm
+            stop ""  
+         endif
+
+!#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,timevar,time)
+         ierr = NF_GET_VAR_DOUBLE(nid,levvar,lev)
+!#else
+!        ierr = NF_GET_VAR_REAL(nid,timevar,time)
+!        ierr = NF_GET_VAR_REAL(nid,levvar,lev)
+!#endif
+
+       return
+       end
+
+!======================================================================
+      SUBROUTINE read_rico(fich_rico,nlev_rico,ps_rico,play
+     :             ,ts_rico,t_rico,q_rico,u_rico,v_rico,w_rico
+     :             ,dth_dyn,dqh_dyn)
+      implicit none
+
+c-------------------------------------------------------------------------
+c Read RICO forcing data 
+c-------------------------------------------------------------------------
+#include "dimensions.h"
+
+
+      integer nlev_rico
+      real ts_rico,ps_rico
+      real t_rico(llm),q_rico(llm)
+      real u_rico(llm),v_rico(llm)
+      real w_rico(llm)
+      real dth_dyn(llm)
+      real dqh_dyn(llm)
+      
+
+      real play(llm),zlay(llm)
+     
+
+      real prico(nlev_rico),zrico(nlev_rico)
+
+      character*80 fich_rico
+
+      integer k,l
+
+      
+      print*,fich_rico
+      open(21,file=trim(fich_rico),form='formatted')
+        do k=1,llm
+      zlay(k)=0.
+         enddo
+      
+        read(21,*) ps_rico,ts_rico
+        prico(1)=ps_rico
+        zrico(1)=0.0
+      do l=2,nlev_rico
+        read(21,*) k,prico(l),zrico(l)
+      enddo
+       close(21)
+
+      do k=1,llm
+        do l=1,80
+          if(prico(l)>play(k)) then
+              if(play(k)>prico(l+1)) then
+                zlay(k)=zrico(l)+(play(k)-prico(l)) * 
+     &              (zrico(l+1)-zrico(l))/(prico(l+1)-prico(l))
+              else
+                zlay(k)=zrico(l)+(play(k)-prico(80))* 
+     &              (zrico(81)-zrico(80))/(prico(81)-prico(80))
+              endif
+          endif
+        enddo
+        print*,k,zlay(k)
+        ! U
+        if(0 < zlay(k) .and. zlay(k) < 4000) then
+          u_rico(k)=-9.9 + (-1.9 + 9.9)*zlay(k)/4000
+        elseif(4000 < zlay(k) .and. zlay(k) < 12000) then
+       u_rico(k)=  -1.9 + (30.0 + 1.9) / 
+     :          (12000 - 4000) * (zlay(k) - 4000)
+        elseif(12000 < zlay(k) .and. zlay(k) < 13000) then
+          u_rico(k)=30.0
+        elseif(13000 < zlay(k) .and. zlay(k) < 20000) then
+          u_rico(k)=30.0 - (30.0) / 
+     : (20000 - 13000) * (zlay(k) - 13000)
+        else
+          u_rico(k)=0.0
+        endif
+
+!Q_v
+        if(0 < zlay(k) .and. zlay(k) < 740) then
+          q_rico(k)=16.0 + (13.8 - 16.0) / (740) * zlay(k)
+        elseif(740 < zlay(k) .and. zlay(k) < 3260) then
+          q_rico(k)=13.8 + (2.4 - 13.8) / 
+     :          (3260 - 740) * (zlay(k) - 740)
+        elseif(3260 < zlay(k) .and. zlay(k) < 4000) then
+          q_rico(k)=2.4 + (1.8 - 2.4) / 
+     :               (4000 - 3260) * (zlay(k) - 3260)
+        elseif(4000 < zlay(k) .and. zlay(k) < 9000) then
+          q_rico(k)=1.8 + (0 - 1.8) / 
+     :             (10000 - 4000) * (zlay(k) - 4000)
+        else
+          q_rico(k)=0.0
+        endif
+
+!T
+        if(0 < zlay(k) .and. zlay(k) < 740) then
+          t_rico(k)=299.2 + (292.0 - 299.2) / (740) * zlay(k)
+        elseif(740 < zlay(k) .and. zlay(k) < 4000) then
+          t_rico(k)=292.0 + (278.0 - 292.0) /
+     :       (4000 - 740) * (zlay(k) - 740)
+        elseif(4000 < zlay(k) .and. zlay(k) < 15000) then
+          t_rico(k)=278.0 + (203.0 - 278.0) /
+     :       (15000 - 4000) * (zlay(k) - 4000)
+        elseif(15000 < zlay(k) .and. zlay(k) < 17500) then
+          t_rico(k)=203.0 + (194.0 - 203.0) / 
+     :       (17500 - 15000)* (zlay(k) - 15000)
+        elseif(17500 < zlay(k) .and. zlay(k) < 20000) then
+          t_rico(k)=194.0 + (206.0 - 194.0) /
+     :       (20000 - 17500)* (zlay(k) - 17500)
+        elseif(20000 < zlay(k) .and. zlay(k) < 60000) then
+          t_rico(k)=206.0 + (270.0 - 206.0) / 
+     :        (60000 - 20000)* (zlay(k) - 20000)
+        endif
+
+! W
+        if(0 < zlay(k) .and. zlay(k) < 2260 ) then
+          w_rico(k)=- (0.005/2260) * zlay(k)
+        elseif(2260 < zlay(k) .and. zlay(k) < 4000 ) then
+          w_rico(k)=- 0.005
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000 ) then
+       w_rico(k)=- 0.005 + (0.005/ (5000 - 4000)) * (zlay(k) - 4000)
+        else
+          w_rico(k)=0.0
+        endif
+
+! dThrz+dTsw0+dTlw0
+        if(0 < zlay(k) .and. zlay(k) < 4000) then
+          dth_dyn(k)=- 2.51 / 86400 + (-2.18 + 2.51 )/ 
+     :               (86400*4000) * zlay(k)
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000) then
+          dth_dyn(k)=- 2.18 / 86400 + ( 2.18 ) /
+     :           (86400*(5000 - 4000)) * (zlay(k) - 4000)
+        else
+          dth_dyn(k)=0.0
+        endif
+! dQhrz
+        if(0 < zlay(k) .and. zlay(k) < 3000) then
+          dqh_dyn(k)=-1.0 / 86400 + (0.345 + 1.0)/
+     :                    (86400*3000) * (zlay(k))
+        elseif(3000 < zlay(k) .and. zlay(k) < 4000) then
+          dqh_dyn(k)=0.345 / 86400
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000) then
+          dqh_dyn(k)=0.345 / 86400 + 
+     +   (-0.345)/(86400 * (5000 - 4000)) * (zlay(k)-4000)
+        else
+          dqh_dyn(k)=0.0
+        endif
+
+!?        if(play(k)>6e4) then
+!?          ratqs0(1,k)=ratqsbas*(plev(1)-play(k))/(plev(1)-6e4)
+!?        elseif((play(k)>3e4).and.(play(k)<6e4)) then
+!?          ratqs0(1,k)=ratqsbas+(ratqshaut-ratqsbas)&
+!?                          *(6e4-play(k))/(6e4-3e4)
+!?        else
+!?          ratqs0(1,k)=ratqshaut
+!?        endif
+
+      enddo
+
+      do k=1,llm
+      q_rico(k)=q_rico(k)/1e3 
+      dqh_dyn(k)=dqh_dyn(k)/1e3
+      v_rico(k)=-3.8
+      enddo
+
+          return
+          end
+
+!=====================================================================
+c-------------------------------------------------------------------------
+      SUBROUTINE read_armcu(fich_armcu,nlev_armcu,nt_armcu,
+     : sens,flat,adv_theta,rad_theta,adv_qt)
+      implicit none
+
+c-------------------------------------------------------------------------
+c Read ARM_CU case forcing data
+c-------------------------------------------------------------------------
+
+      integer nlev_armcu,nt_armcu
+      real sens(nt_armcu),flat(nt_armcu)
+      real adv_theta(nt_armcu),rad_theta(nt_armcu),adv_qt(nt_armcu)
+      character*80 fich_armcu
+
+      integer no,l,k,ip
+      real riy,rim,rid,rih,bid
+
+      integer iy,im,id,ih,in
+
+      open(21,file=trim(fich_armcu),form='formatted')
+      read(21,'(a)')
+      do ip = 1, nt_armcu
+      read(21,'(a)')
+      read(21,'(a)')
+      read(21,223) iy, im, id, ih, in, sens(ip),flat(ip),
+     :             adv_theta(ip),rad_theta(ip),adv_qt(ip)
+      print *,'forcages=',iy,im,id,ih,in, sens(ip),flat(ip),
+     :             adv_theta(ip),rad_theta(ip),adv_qt(ip)
+      enddo
+      close(21)
+
+  223 format(5i3,5f8.3)
+  226 format(f7.1,1x,10f8.2)
+  227 format(f7.1,1x,1p,4e11.3)
+  230 format(6f9.3,4e11.3)
+
+          return
+          end
+
+!=====================================================================
+       SUBROUTINE interp_toga_vertical(play,nlev_toga,plev_prof
+     :         ,t_prof,q_prof,u_prof,v_prof,w_prof
+     :         ,ht_prof,vt_prof,hq_prof,vq_prof
+     :         ,t_mod,q_mod,u_mod,v_mod,w_mod
+     :         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+ 
+       implicit none
+ 
+#include "dimensions.h"
+
+c-------------------------------------------------------------------------
+c Vertical interpolation of TOGA-COARE forcing data onto model levels
+c-------------------------------------------------------------------------
+ 
+       integer nlevmax
+       parameter (nlevmax=41)
+       integer nlev_toga,mxcalc
+!       real play(llm), plev_prof(nlevmax) 
+!       real t_prof(nlevmax),q_prof(nlevmax)
+!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
+!       real ht_prof(nlevmax),vt_prof(nlevmax)
+!       real hq_prof(nlevmax),vq_prof(nlevmax)
+ 
+       real play(llm), plev_prof(nlev_toga) 
+       real t_prof(nlev_toga),q_prof(nlev_toga)
+       real u_prof(nlev_toga),v_prof(nlev_toga), w_prof(nlev_toga)
+       real ht_prof(nlev_toga),vt_prof(nlev_toga)
+       real hq_prof(nlev_toga),vq_prof(nlev_toga)
+ 
+       real t_mod(llm),q_mod(llm)
+       real u_mod(llm),v_mod(llm), w_mod(llm)
+       real ht_mod(llm),vt_mod(llm)
+       real hq_mod(llm),vq_mod(llm)
+ 
+       integer l,k,k1,k2,kp
+       real aa,frac,frac1,frac2,fact
+ 
+       do l = 1, llm
+
+        if (play(l).ge.plev_prof(nlev_toga)) then
+ 
+        mxcalc=l
+         k1=0
+         k2=0
+
+         if (play(l).le.plev_prof(1)) then
+
+         do k = 1, nlev_toga-1
+          if (play(l).le.plev_prof(k) 
+     :       .and. play(l).gt.plev_prof(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,play(l) = ',l,play(l)/100
+         do k = 1, nlev_toga-1
+          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
+         t_mod(l)= t_prof(k2) - frac*(t_prof(k2)-t_prof(k1))
+         q_mod(l)= q_prof(k2) - frac*(q_prof(k2)-q_prof(k1))
+         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
+         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
+         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
+         ht_mod(l)= ht_prof(k2) - frac*(ht_prof(k2)-ht_prof(k1))
+         vt_mod(l)= vt_prof(k2) - frac*(vt_prof(k2)-vt_prof(k1))
+         hq_mod(l)= hq_prof(k2) - frac*(hq_prof(k2)-hq_prof(k1))
+         vq_mod(l)= vq_prof(k2) - frac*(vq_prof(k2)-vq_prof(k1))
+     
+         else !play>plev_prof(1)
+
+         k1=1
+         k2=2
+         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
+         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
+         t_mod(l)= frac1*t_prof(k1) - frac2*t_prof(k2)
+         q_mod(l)= frac1*q_prof(k1) - frac2*q_prof(k2)
+         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
+         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
+         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
+         ht_mod(l)= frac1*ht_prof(k1) - frac2*ht_prof(k2)
+         vt_mod(l)= frac1*vt_prof(k1) - frac2*vt_prof(k2)
+         hq_mod(l)= frac1*hq_prof(k1) - frac2*hq_prof(k2)
+         vq_mod(l)= frac1*vq_prof(k1) - frac2*vq_prof(k2)
+
+         endif ! play.le.plev_prof(1)
+
+        else ! above max altitude of forcing file
+ 
+cjyg
+         fact=20.*(plev_prof(nlev_toga)-play(l))/plev_prof(nlev_toga) !jyg
+         fact = max(fact,0.)                                           !jyg
+         fact = exp(-fact)                                             !jyg
+         t_mod(l)= t_prof(nlev_toga)                                   !jyg
+         q_mod(l)= q_prof(nlev_toga)*fact                              !jyg
+         u_mod(l)= u_prof(nlev_toga)*fact                              !jyg
+         v_mod(l)= v_prof(nlev_toga)*fact                              !jyg
+         w_mod(l)= 0.0                                                 !jyg
+         ht_mod(l)= ht_prof(nlev_toga)                                 !jyg
+         vt_mod(l)= vt_prof(nlev_toga)                                 !jyg
+         hq_mod(l)= hq_prof(nlev_toga)*fact                            !jyg
+         vq_mod(l)= vq_prof(nlev_toga)*fact                            !jyg
+ 
+        endif ! play
+ 
+       enddo ! l
+
+!       do l = 1,llm
+!       print *,'t_mod(l),q_mod(l),ht_mod(l),hq_mod(l) ',
+!     $        l,t_mod(l),q_mod(l),ht_mod(l),hq_mod(l)
+!       enddo
+ 
+          return
+          end
+ 
+!======================================================================
+        SUBROUTINE interp_toga_time(day,day1,annee_ref
+     i             ,year_ini_toga,day_ini_toga,nt_toga,dt_toga,nlev_toga
+     i             ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga
+     i             ,ht_toga,vt_toga,hq_toga,vq_toga
+     o             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof
+     o             ,ht_prof,vt_prof,hq_prof,vq_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_toga: total nb of data in the forcing (e.g. 480 for TOGA-COARE)
+! dt_toga: total time interval (in sec) between 2 forcing data (e.g. 6h for TOGA-COARE)
+!---------------------------------------------------------------------------------------
+
+#include "compar1d.h"
+
+! inputs:
+        integer annee_ref
+        integer nt_toga,nlev_toga
+        integer year_ini_toga
+        real day, day1,day_ini_toga,dt_toga
+        real ts_toga(nt_toga)
+        real plev_toga(nlev_toga,nt_toga),t_toga(nlev_toga,nt_toga)
+        real q_toga(nlev_toga,nt_toga),u_toga(nlev_toga,nt_toga)
+        real v_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
+        real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+        real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+! outputs:
+        real ts_prof
+        real plev_prof(nlev_toga),t_prof(nlev_toga)
+        real q_prof(nlev_toga),u_prof(nlev_toga)
+        real v_prof(nlev_toga),w_prof(nlev_toga)
+        real ht_prof(nlev_toga),vt_prof(nlev_toga)
+        real hq_prof(nlev_toga),vq_prof(nlev_toga)
+! local:
+        integer it_toga1, it_toga2,k
+        real timeit,time_toga1,time_toga2,frac
+
+
+        if (forcing_type.eq.2) then
+! Check that initial day of the simulation consistent with TOGA-COARE period:
+       if (annee_ref.ne.1992 .and. annee_ref.ne.1993) then
+        print*,'Pour TOGA-COARE, annee_ref doit etre 1992 ou 1993'
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.1992 .and. day1.lt.day_ini_toga) then
+        print*,'TOGA-COARE a débuté le 1er Nov 1992 (jour julien=306)'
+        print*,'Changer dayref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.1993 .and. day1.gt.day_ini_toga+119) then
+        print*,'TOGA-COARE a fini le 28 Feb 1993 (jour julien=59)'
+        print*,'Changer dayref ou nday dans run.def'
+        stop
+       endif
+
+       else if (forcing_type.eq.4) then
+
+! Check that initial day of the simulation consistent with TWP-ICE period:
+       if (annee_ref.ne.2006) then
+        print*,'Pour TWP-ICE, annee_ref doit etre 2006'
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.2006 .and. day1.lt.day_ini_toga) then
+        print*,'TWP-ICE a debute le 17 Jan 2006 (jour julien=17)'
+        print*,'Changer dayref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.2006 .and. day1.gt.day_ini_toga+26) then
+        print*,'TWP-ICE a fini le 12 Feb 2006 (jour julien=43)'
+        print*,'Changer dayref ou nday dans run.def'
+        stop
+       endif
+
+       endif
+
+! Determine timestep relative to the 1st day of TOGA-COARE:
+!       timeit=(day-day1)*86400.
+!       if (annee_ref.eq.1992) then
+!        timeit=(day-day_ini_toga)*86400.
+!       else
+!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
+!       endif
+      timeit=(day-day_ini_toga)*86400
+
+! Determine the closest observation times:
+       it_toga1=INT(timeit/dt_toga)+1
+       it_toga2=it_toga1 + 1
+       time_toga1=(it_toga1-1)*dt_toga
+       time_toga2=(it_toga2-1)*dt_toga
+
+       if (it_toga1 .ge. nt_toga) then
+        write(*,*) 'PB-stop: day, it_toga1, it_toga2, timeit: '
+     :        ,day,it_toga1,it_toga2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_toga2-timeit)/(time_toga2-time_toga1)
+       frac=max(frac,0.0)
+
+       ts_prof = ts_toga(it_toga2)
+     :          -frac*(ts_toga(it_toga2)-ts_toga(it_toga1))
+
+!        print*,
+!     :'day,annee_ref,day_ini_toga,timeit,it_toga1,it_toga2,SST:',
+!     :day,annee_ref,day_ini_toga,timeit/86400.,it_toga1,it_toga2,ts_prof
+
+       do k=1,nlev_toga
+        plev_prof(k) = 100.*(plev_toga(k,it_toga2)
+     :          -frac*(plev_toga(k,it_toga2)-plev_toga(k,it_toga1)))
+        t_prof(k) = t_toga(k,it_toga2)
+     :          -frac*(t_toga(k,it_toga2)-t_toga(k,it_toga1))
+        q_prof(k) = q_toga(k,it_toga2)
+     :          -frac*(q_toga(k,it_toga2)-q_toga(k,it_toga1))
+        u_prof(k) = u_toga(k,it_toga2)
+     :          -frac*(u_toga(k,it_toga2)-u_toga(k,it_toga1))
+        v_prof(k) = v_toga(k,it_toga2)
+     :          -frac*(v_toga(k,it_toga2)-v_toga(k,it_toga1))
+        w_prof(k) = w_toga(k,it_toga2)
+     :          -frac*(w_toga(k,it_toga2)-w_toga(k,it_toga1))
+        ht_prof(k) = ht_toga(k,it_toga2)
+     :          -frac*(ht_toga(k,it_toga2)-ht_toga(k,it_toga1))
+        vt_prof(k) = vt_toga(k,it_toga2)
+     :          -frac*(vt_toga(k,it_toga2)-vt_toga(k,it_toga1))
+        hq_prof(k) = hq_toga(k,it_toga2)
+     :          -frac*(hq_toga(k,it_toga2)-hq_toga(k,it_toga1))
+        vq_prof(k) = vq_toga(k,it_toga2)
+     :          -frac*(vq_toga(k,it_toga2)-vq_toga(k,it_toga1))
+        enddo
+
+        return
+        END
+
+!======================================================================
+        SUBROUTINE interp_armcu_time(day,day1,annee_ref
+     i             ,year_ini_armcu,day_ini_armcu,nt_armcu,dt_armcu
+     i             ,nlev_armcu,fs_armcu,fl_armcu,at_armcu,rt_armcu
+     i             ,aqt_armcu,fs_prof,fl_prof,at_prof,rt_prof,aqt_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_armcu: total nb of data in the forcing (e.g. 31 for armcu)
+! dt_armcu: total time interval (in sec) between 2 forcing data (e.g. 1/2h for armcu)
+! fs= sensible flux
+! fl= latent flux
+! at,rt,aqt= advective and radiative tendencies
+!---------------------------------------------------------------------------------------
+
+! inputs:
+        integer annee_ref
+        integer nt_armcu,nlev_armcu
+        integer year_ini_armcu
+        real day, day1,day_ini_armcu,dt_armcu
+        real fs_armcu(nt_armcu),fl_armcu(nt_armcu),at_armcu(nt_armcu)
+        real rt_armcu(nt_armcu),aqt_armcu(nt_armcu)
+! outputs:
+        real fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
+! local:
+        integer it_armcu1, it_armcu2,k
+        real timeit,time_armcu1,time_armcu2,frac
+
+! Check that initial day of the simulation consistent with ARMCU period:
+       if (annee_ref.ne.1997 ) then
+        print*,'Pour ARMCU, annee_ref doit etre 1997 '
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+
+      timeit=(day-day_ini_armcu)*86400
+
+! Determine the closest observation times:
+       it_armcu1=INT(timeit/dt_armcu)+1
+       it_armcu2=it_armcu1 + 1
+       time_armcu1=(it_armcu1-1)*dt_armcu
+       time_armcu2=(it_armcu2-1)*dt_armcu
+       print *,'timeit day day_ini_armcu',timeit,day,day_ini_armcu
+       print *,'it_armcu1,it_armcu2,time_armcu1,time_armcu2',
+     .          it_armcu1,it_armcu2,time_armcu1,time_armcu2
+
+       if (it_armcu1 .ge. nt_armcu) then
+        write(*,*) 'PB-stop: day, it_armcu1, it_armcu2, timeit: '
+     :        ,day,it_armcu1,it_armcu2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_armcu2-timeit)/(time_armcu2-time_armcu1)
+       frac=max(frac,0.0)
+
+       fs_prof = fs_armcu(it_armcu2)
+     :          -frac*(fs_armcu(it_armcu2)-fs_armcu(it_armcu1))
+       fl_prof = fl_armcu(it_armcu2)
+     :          -frac*(fl_armcu(it_armcu2)-fl_armcu(it_armcu1))
+       at_prof = at_armcu(it_armcu2)
+     :          -frac*(at_armcu(it_armcu2)-at_armcu(it_armcu1))
+       rt_prof = rt_armcu(it_armcu2)
+     :          -frac*(rt_armcu(it_armcu2)-rt_armcu(it_armcu1))
+       aqt_prof = aqt_armcu(it_armcu2)
+     :          -frac*(aqt_armcu(it_armcu2)-aqt_armcu(it_armcu1))
+
+         print*,
+     :'day,annee_ref,day_ini_armcu,timeit,it_armcu1,it_armcu2,SST:',
+     :day,annee_ref,day_ini_armcu,timeit/86400.,it_armcu1,
+     :it_armcu2,fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
+
+        return
+        END
+
+!=====================================================================
+      subroutine readprofiles(nlev_max,kmax,height,
+     .           thlprof,qtprof,uprof,
+     .           vprof,e12prof,ugprof,vgprof,
+     .           wfls,dqtdxls,dqtdyls,dqtdtls,
+     .           thlpcar)
+      implicit none
+
+        integer nlev_max,kmax,kmax2
+        logical :: llesread = .true.
+
+        real height(nlev_max),thlprof(nlev_max),qtprof(nlev_max),
+     .       uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max),
+     .       ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max),
+     .       dqtdxls(nlev_max),dqtdyls(nlev_max),dqtdtls(nlev_max),
+     .           thlpcar(nlev_max)
+
+        integer, parameter :: ilesfile=1
+        integer :: ierr,irad,imax,jtot,k
+        logical :: lmoist,lcoriol,ltimedep
+        real :: xsize,ysize
+        real :: ustin,wsvsurf,timerad
+        character(80) :: chmess
+
+        if(.not.(llesread)) return
+
+       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        read (ilesfile,*) kmax
+        do k=1,kmax
+          read (ilesfile,*) height(k),thlprof(k),qtprof (k),
+     .                      uprof (k),vprof  (k),e12prof(k)
+        enddo
+        close(ilesfile)
+
+       open(ilesfile,file='lscale.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) stop 'ERROR:Lscale.inp does not exist'
+        read (ilesfile,*) kmax2
+        if (kmax .ne. kmax2) then
+          print *, 'fichiers prof.inp et lscale.inp incompatibles :'
+          print *, 'nbre de niveaux : ',kmax,' et ',kmax2
+          stop 'lecture profiles'
+        endif
+        do k=1,kmax
+          read (ilesfile,*) height(k),ugprof(k),vgprof(k),wfls(k),
+     .                      dqtdxls(k),dqtdyls(k),dqtdtls(k),thlpcar(k)
+        end do
+        close(ilesfile)
+
+        return
+        end
+
+
+!======================================================================
+      subroutine readprofile_armcu(nlev_max,kmax,height,pprof,uprof,
+     .       vprof,thetaprof,tprof,qvprof,rvprof,aprof,bprof)
+!======================================================================
+      implicit none
+
+        integer nlev_max,kmax,kmax2
+        logical :: llesread = .true.
+
+        real height(nlev_max),pprof(nlev_max),tprof(nlev_max),
+     .  thetaprof(nlev_max),rvprof(nlev_max),
+     .  qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max),
+     .  aprof(nlev_max+1),bprof(nlev_max+1)
+
+        integer, parameter :: ilesfile=1
+        integer, parameter :: ifile=2
+        integer :: ierr,irad,imax,jtot,k
+        logical :: lmoist,lcoriol,ltimedep
+        real :: xsize,ysize
+        real :: ustin,wsvsurf,timerad
+        character(80) :: chmess
+
+        if(.not.(llesread)) return
+
+! Read profiles at full levels
+       IF(nlev_max.EQ.19) THEN
+       open (ilesfile,file='prof.inp.19',status='old',iostat=ierr)
+       print *,'On ouvre prof.inp.19'
+       ELSE
+       open (ilesfile,file='prof.inp.40',status='old',iostat=ierr)
+       print *,'On ouvre prof.inp.40'
+       ENDIF
+        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        read (ilesfile,*) kmax
+        do k=1,kmax
+          read (ilesfile,*) height(k)    ,pprof(k),  uprof(k), vprof(k),
+     .                      thetaprof(k) ,tprof(k), qvprof(k),rvprof(k)
+        enddo
+        close(ilesfile)
+
+! Vertical coordinates half levels for eta-coordinates (plev = alpha + beta * psurf) 
+       IF(nlev_max.EQ.19) THEN
+       open (ifile,file='proh.inp.19',status='old',iostat=ierr)
+       print *,'On ouvre proh.inp.19'
+       if (ierr /= 0) stop 'ERROR:Proh.inp.19 does not exist'
+       ELSE
+       open (ifile,file='proh.inp.40',status='old',iostat=ierr)
+       print *,'On ouvre proh.inp.40'
+       if (ierr /= 0) stop 'ERROR:Proh.inp.40 does not exist'
+       ENDIF
+        read (ifile,*) kmax
+        do k=1,kmax
+          read (ifile,*) jtot,aprof(k),bprof(k)
+        enddo
+        close(ifile)
+
+        return
+        end
+!===============================================================
+      function ismin(n,sx,incx)
+
+      implicit none
+      integer n,i,incx,ismin,ix
+      real sx((n-1)*incx+1),sxmin
+
+      ix=1
+      ismin=1
+      sxmin=sx(1)
+      do i=1,n-1
+         ix=ix+incx
+         if(sx(ix).lt.sxmin) then
+             sxmin=sx(ix)
+             ismin=i+1
+         endif
+      enddo
+
+      return
+      end
+
+!===============================================================
+      function ismax(n,sx,incx)
+
+      implicit none
+      integer n,i,incx,ismax,ix
+      real sx((n-1)*incx+1),sxmax
+
+      ix=1
+      ismax=1
+      sxmax=sx(1)
+      do i=1,n-1
+         ix=ix+incx
+         if(sx(ix).gt.sxmax) then
+             sxmax=sx(ix)
+             ismax=i+1
+         endif
+      enddo
+
+      return
+      end
+
Index: LMDZ5/branches/testing/libf/phy1d/1DUTILS.h_with_writelim
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/1DUTILS.h_with_writelim	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/1DUTILS.h_with_writelim	(revision 1665)
@@ -0,0 +1,2705 @@
+!
+! $Id: conf_unicol.F 1279 2010-08-04 17:20:56Z lahellec $
+!
+c
+c
+      SUBROUTINE conf_unicol( tapedef )
+c
+#ifdef CPP_IOIPSL
+      use IOIPSL
+#else
+! if not using IOIPSL, we still need to use (a local version of) getin
+      use ioipsl_getincom
+#endif
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c     Auteurs :   A. Lahellec  .
+c
+c     Arguments :
+c
+c     tapedef   :
+
+       INTEGER tapedef
+c
+c   Declarations :
+c   --------------
+
+#include "compar1d.h"
+#include "flux_arp.h"
+#include "fcg_gcssold.h"
+#include "fcg_racmo.h"
+#include "iniprint.h"
+c
+c
+c   local:
+c   ------
+
+c      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
+      
+c
+c  -------------------------------------------------------------------
+c
+c      .........    Initilisation parametres du lmdz1D      ..........
+c
+c---------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+!Config  Key  = lunout
+!Config  Desc = unite de fichier pour les impressions
+!Config  Def  = 6
+!Config  Help = unite de fichier pour les impressions 
+!Config         (defaut sortie standard = 6)
+      lunout=6
+      CALL getin('lunout', lunout)
+      IF (lunout /= 5 .and. lunout /= 6) THEN
+        OPEN(lunout,FILE='lmdz.out')
+      ENDIF
+
+!Config  Key  = prt_level
+!Config  Desc = niveau d'impressions de débogage
+!Config  Def  = 0
+!Config  Help = Niveau d'impression pour le débogage
+!Config         (0 = minimum d'impression)
+c      prt_level = 0
+c      CALL getin('prt_level',prt_level)
+
+c-----------------------------------------------------------------------
+c  Parametres de controle du run:
+c-----------------------------------------------------------------------
+
+!Config  Key  = restart
+!Config  Desc = on repart des startphy et start1dyn
+!Config  Def  = false
+!Config  Help = les fichiers restart doivent etre renomme en start
+       restart = .FALSE.
+       CALL getin('restart',restart)
+
+!Config  Key  = forcing_type
+!Config  Desc = defines the way the SCM is forced:
+!Config  Def  = 0
+!!Config  Help = 0 ==> forcing_les = .true.
+!             initial profiles from file prof.inp.001
+!             no forcing by LS convergence ; 
+!             surface temperature imposed ;
+!             radiative cooling may be imposed (iflag_radia=0 in physiq.def)
+!         = 1 ==> forcing_radconv = .true.
+!             idem forcing_type = 0, but the imposed radiative cooling 
+!             is set to 0 (hence, if iflag_radia=0 in physiq.def, 
+!             then there is no radiative cooling at all)
+!         = 2 ==> forcing_toga = .true.
+!             initial profiles from TOGA-COARE IFA files 
+!             LS convergence and SST imposed from TOGA-COARE IFA files 
+!         = 3 ==> forcing_GCM2SCM = .true.
+!             initial profiles from the GCM output
+!             LS convergence imposed from the GCM output
+!         = 4 ==> forcing_twpi = .true.
+!             initial profiles from TWPICE nc files 
+!             LS convergence and SST imposed from TWPICE nc files 
+!         = 5 ==> forcing_rico = .true.
+!             initial profiles from RICO idealized
+!             LS convergence imposed from  RICO (cst) 
+!         = 40 ==> forcing_GCSSold = .true.
+!             initial profile from GCSS file
+!             LS convergence imposed from GCSS file
+!
+       forcing_type = 0
+       CALL getin('forcing_type',forcing_type)
+         imp_fcg_gcssold   = .false.
+         ts_fcg_gcssold    = .false.  
+         Tp_fcg_gcssold    = .false.  
+         Tp_ini_gcssold    = .false.  
+         xTurb_fcg_gcssold = .false. 
+        IF (forcing_type .eq.40) THEN
+          CALL getin('imp_fcg',imp_fcg_gcssold)
+          CALL getin('ts_fcg',ts_fcg_gcssold)
+          CALL getin('tp_fcg',Tp_fcg_gcssold)
+          CALL getin('tp_ini',Tp_ini_gcssold)
+          CALL getin('turb_fcg',xTurb_fcg_gcssold)
+        ENDIF
+
+!Config  Key  = ok_flux_surf
+!Config  Desc = forcage ou non par les flux de surface
+!Config  Def  = false
+!Config  Help = forcage ou non par les flux de surface
+       ok_flux_surf = .FALSE.
+       CALL getin('ok_flux_surf',ok_flux_surf)
+
+!Config  Key  = time_ini
+!Config  Desc = meaningless in this  case
+!Config  Def  = 0.
+!Config  Help = 
+       tsurf = 0.
+       CALL getin('time_ini',time_ini)
+
+!Config  Key  = rlat et rlon
+!Config  Desc = latitude et longitude
+!Config  Def  = 0.0  0.0
+!Config  Help = fixe la position de la colonne
+       xlat = 0.
+       xlon = 0.
+       CALL getin('rlat',xlat)
+       CALL getin('rlon',xlon)
+
+!Config  Key  = airephy
+!Config  Desc = Grid cell area
+!Config  Def  = 1.e11
+!Config  Help = 
+       airefi = 1.e11
+       CALL getin('airephy',airefi)
+
+!Config  Key  = nat_surf
+!Config  Desc = surface type
+!Config  Def  = 0 (ocean)
+!Config  Help = 0=ocean,1=land,2=glacier,3=banquise
+       nat_surf = 0.
+       CALL getin('nat_surf',nat_surf)
+
+!Config  Key  = tsurf
+!Config  Desc = surface temperature
+!Config  Def  = 290.
+!Config  Help = not used if type_ts_forcing=1 in lmdz1d.F
+       tsurf = 290.
+       CALL getin('tsurf',tsurf)
+
+!Config  Key  = psurf
+!Config  Desc = surface pressure
+!Config  Def  = 102400.
+!Config  Help = 
+       psurf = 102400.
+       CALL getin('psurf',psurf)
+
+!Config  Key  = zsurf
+!Config  Desc = surface altitude
+!Config  Def  = 0.
+!Config  Help = 
+       zsurf = 0.
+       CALL getin('zsurf',zsurf)
+
+!Config  Key  = rugos
+!Config  Desc = coefficient de frottement
+!Config  Def  = 0.0001
+!Config  Help = calcul du Cdrag
+       rugos = 0.0001
+       CALL getin('rugos',rugos)
+
+!Config  Key  = wtsurf et wqsurf
+!Config  Desc = ???
+!Config  Def  = 0.0 0.0
+!Config  Help = 
+       wtsurf = 0.0
+       wqsurf = 0.0
+       CALL getin('wtsurf',wtsurf)
+       CALL getin('wqsurf',wqsurf)
+
+!Config  Key  = albedo
+!Config  Desc = albedo
+!Config  Def  = 0.09
+!Config  Help = 
+       albedo = 0.09
+       CALL getin('albedo',albedo)
+
+!Config  Key  = agesno
+!Config  Desc = age de la neige
+!Config  Def  = 30.0
+!Config  Help = 
+       xagesno = 30.0
+       CALL getin('agesno',xagesno)
+
+!Config  Key  = restart_runoff
+!Config  Desc = age de la neige
+!Config  Def  = 30.0
+!Config  Help = 
+       restart_runoff = 0.0
+       CALL getin('restart_runoff',restart_runoff)
+
+!Config  Key  = qsolinp
+!Config  Desc = initial bucket water content (kg/m2) when land (5std)
+!Config  Def  = 30.0
+!Config  Help = 
+       qsolinp = 1.
+       CALL getin('qsolinp',qsolinp)
+
+!Config  Key  = zpicinp
+!Config  Desc = denivellation orographie
+!Config  Def  = 300.
+!Config  Help =  input brise
+       zpicinp = 300.
+       CALL getin('zpicinp',zpicinp)
+
+
+      write(lunout,*)' +++++++++++++++++++++++++++++++++++++++'
+      write(lunout,*)' Configuration des parametres du gcm1D: '
+      write(lunout,*)' +++++++++++++++++++++++++++++++++++++++'
+      write(lunout,*)' restart = ', restart
+      write(lunout,*)' forcing_type = ', forcing_type
+      write(lunout,*)' time_ini = ', time_ini
+      write(lunout,*)' rlat = ', xlat
+      write(lunout,*)' rlon = ', xlon
+      write(lunout,*)' airephy = ', airefi
+      write(lunout,*)' nat_surf = ', nat_surf
+      write(lunout,*)' tsurf = ', tsurf
+      write(lunout,*)' psurf = ', psurf
+      write(lunout,*)' zsurf = ', zsurf
+      write(lunout,*)' rugos = ', rugos
+      write(lunout,*)' wtsurf = ', wtsurf
+      write(lunout,*)' wqsurf = ', wqsurf
+      write(lunout,*)' albedo = ', albedo
+      write(lunout,*)' xagesno = ', xagesno
+      write(lunout,*)' restart_runoff = ', restart_runoff
+      write(lunout,*)' qsolinp = ', qsolinp
+      write(lunout,*)' zpicinp = ', zpicinp
+      IF (forcing_type .eq.40) THEN
+        write(lunout,*) '--- Forcing type GCSS Old --- with:'
+        write(lunout,*)'imp_fcg',imp_fcg_gcssold
+        write(lunout,*)'ts_fcg',ts_fcg_gcssold
+        write(lunout,*)'tp_fcg',Tp_fcg_gcssold
+        write(lunout,*)'tp_ini',Tp_ini_gcssold
+        write(lunout,*)'xturb_fcg',xTurb_fcg_gcssold
+      ENDIF
+
+      write(lunout,*)' +++++++++++++++++++++++++++++++++++++++'
+      write(lunout,*)
+c
+      RETURN
+      END
+!
+! $Id: dyn1deta0.F 1279 2010/07/30 A Lahellec$
+!
+c
+      SUBROUTINE dyn1deta0(fichnom,plev,play,phi,phis,presnivs,
+     &                          ucov,vcov,temp,q,omega2)
+      USE dimphy
+      USE mod_grid_phy_lmdz
+      USE mod_phys_lmdz_para
+      USE iophy
+      USE phys_state_var_mod
+      USE iostart
+      USE write_field_phy
+      USE infotrac
+      use control_mod
+
+      IMPLICIT NONE
+c=======================================================
+c Ecriture du fichier de redemarrage sous format NetCDF
+c=======================================================
+c   Declarations:
+c   -------------
+#include "dimensions.h"
+#include "comconst.h"
+#include "temps.h"
+!!#include "control.h"
+#include "logic.h"
+#include "netcdf.inc"
+
+c   Arguments:
+c   ----------
+      CHARACTER*(*) fichnom
+cAl1 plev tronque pour .nc mais plev(klev+1):=0
+      real :: plev(klon,klev),play (klon,klev),phi(klon,klev)
+      real :: presnivs(klon,klev)
+      real :: ucov(klon,klev),vcov(klon,klev),temp(klon,klev)
+      real :: q(klon,klev,nqtot),omega2(klon,klev)
+c      real :: ug(klev),vg(klev),fcoriolis
+      real :: phis(klon) 
+
+c   Variables locales pour NetCDF:
+c   ------------------------------
+      INTEGER nid, nvarid
+      INTEGER idim_s
+      INTEGER ierr, ierr_file 
+      INTEGER iq
+      INTEGER length
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      character*4 nmq(nqtot)
+      character*12 modname
+      character*80 abort_message
+      LOGICAL found
+c
+      INTEGER nb
+
+      modname = 'dyn1deta0 : '
+      nmq(1)="vap"
+      nmq(2)="cond"
+      do iq=3,nqtot
+        write(nmq(iq),'("tra",i1)') iq-2
+      enddo
+      print*,'in dyn1deta0 ',fichnom,klon,klev,nqtot
+      CALL open_startphy(fichnom)
+      print*,'after open startphy ',fichnom,nmq
+
+c
+c Lecture des parametres de controle:
+c
+      CALL get_var("controle",tab_cntrl)
+       
+
+      im         = tab_cntrl(1)
+      jm         = tab_cntrl(2)
+      lllm       = tab_cntrl(3)
+      day_ref    = tab_cntrl(4)
+      annee_ref  = tab_cntrl(5)
+c      rad        = tab_cntrl(6)
+c      omeg       = tab_cntrl(7)
+c      g          = tab_cntrl(8)
+c      cpp        = tab_cntrl(9)
+c      kappa      = tab_cntrl(10)
+c      daysec     = tab_cntrl(11)
+c      dtvr       = tab_cntrl(12)
+c      etot0      = tab_cntrl(13)
+c      ptot0      = tab_cntrl(14)
+c      ztot0      = tab_cntrl(15)
+c      stot0      = tab_cntrl(16)
+c      ang0       = tab_cntrl(17)
+c      pa         = tab_cntrl(18)
+c      preff      = tab_cntrl(19)
+c
+c      clon       = tab_cntrl(20)
+c      clat       = tab_cntrl(21)
+c      grossismx  = tab_cntrl(22)
+c      grossismy  = tab_cntrl(23)
+c
+      IF ( tab_cntrl(24).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(27).EQ.1. ) ysinus = . TRUE. 
+      ENDIF
+
+      day_ini = tab_cntrl(30)
+      itau_dyn = tab_cntrl(31)
+c   .................................................................
+c
+c
+c      PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
+cAl1
+       Print*,'day_ref,annee_ref,day_ini,itau_dyn',
+     &              day_ref,annee_ref,day_ini,itau_dyn
+
+c  Lecture des champs
+c
+      plev(1,klev+1)=0.
+      CALL get_field("plev",plev,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Plev> est absent'
+      CALL get_field("play",play,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Play> est absent'
+      CALL get_field("phi",phi,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Phi> est absent'
+      CALL get_field("phis",phis,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Phis> est absent'
+      CALL get_field("presnivs",presnivs,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Presnivs> est absent'
+      CALL get_field("ucov",ucov,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <ucov> est absent'
+      CALL get_field("vcov",vcov,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <vcov> est absent'
+      CALL get_field("temp",temp,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <temp> est absent'
+      CALL get_field("omega2",omega2,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <omega2> est absent'
+
+      Do iq=1,nqtot
+        CALL get_field("q"//nmq(iq),q(:,:,iq),found)
+        IF (.NOT. found)
+     &  PRINT*, modname//'Le champ <q'//nmq//'> est absent'
+      EndDo
+
+      CALL close_startphy
+      print*,' close startphy'
+     .      ,fichnom,play(1,1),play(1,klev),temp(1,klev)
+c
+      RETURN
+      END
+!
+! $Id: dyn1dredem.F 1279 2010/07/29 A Lahellec$
+!
+c
+      SUBROUTINE dyn1dredem(fichnom,plev,play,phi,phis,presnivs,
+     &                          ucov,vcov,temp,q,omega2)
+      USE dimphy
+      USE mod_grid_phy_lmdz
+      USE mod_phys_lmdz_para
+      USE phys_state_var_mod
+      USE iostart
+      USE infotrac
+      use control_mod
+
+      IMPLICIT NONE
+c=======================================================
+c Ecriture du fichier de redemarrage sous format NetCDF
+c=======================================================
+c   Declarations:
+c   -------------
+#include "dimensions.h"
+#include "comconst.h"
+#include "temps.h"
+!!#include "control.h"
+#include "logic.h"
+#include "netcdf.inc"
+
+c   Arguments:
+c   ----------
+      CHARACTER*(*) fichnom
+      REAL time
+cAl1 plev tronque pour .nc mais plev(klev+1):=0
+      real :: plev(klon,klev),play (klon,klev),phi(klon,klev)
+      real :: presnivs(klon,klev)
+      real :: ucov(klon,klev),vcov(klon,klev),temp(klon,klev)
+      real :: q(klon,klev,nqtot)
+      real :: omega2(klon,klev),rho(klon,klev+1)
+c      real :: ug(klev),vg(klev),fcoriolis
+      real :: phis(klon) 
+
+c   Variables locales pour NetCDF:
+c   ------------------------------
+      INTEGER nid, nvarid
+      INTEGER idim_s
+      INTEGER ierr, ierr_file 
+      INTEGER iq,l
+      INTEGER length
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      character*4 nmq(nqtot)
+      character*20 modname
+      character*80 abort_message
+c
+      INTEGER nb
+      SAVE nb
+      DATA nb / 0 /
+
+      REAL zan0,zjulian,hours
+      INTEGER yyears0,jjour0, mmois0
+      character*30 unites
+
+cDbg
+      CALL open_restartphy(fichnom)
+      print*,'redm1 ',fichnom,klon,klev,nqtot
+      nmq(1)="vap"
+      nmq(2)="cond"
+      nmq(3)="tra1"
+      nmq(4)="tra2"
+
+      modname = 'dyn1dredem'
+      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Pb. d ouverture "//fichnom
+         CALL abort
+      ENDIF
+
+      DO l=1,length
+       tab_cntrl(l) = 0.
+      ENDDO
+       tab_cntrl(1)  = FLOAT(iim)
+       tab_cntrl(2)  = FLOAT(jjm)
+       tab_cntrl(3)  = FLOAT(llm)
+       tab_cntrl(4)  = FLOAT(day_ref)
+       tab_cntrl(5)  = FLOAT(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
+c       tab_cntrl(13) = etot0
+c       tab_cntrl(14) = ptot0
+c       tab_cntrl(15) = ztot0
+c       tab_cntrl(16) = stot0
+c       tab_cntrl(17) = ang0
+c       tab_cntrl(18) = pa
+c       tab_cntrl(19) = preff
+c
+c    .....    parametres  pour le zoom      ......   
+
+c       tab_cntrl(20)  = clon
+c       tab_cntrl(21)  = clat
+c       tab_cntrl(22)  = grossismx
+c       tab_cntrl(23)  = grossismy
+c
+      IF ( fxyhypb )   THEN
+       tab_cntrl(24) = 1.
+c       tab_cntrl(25) = dzoomx
+c       tab_cntrl(26) = dzoomy
+       tab_cntrl(27) = 0.
+c       tab_cntrl(28) = taux
+c       tab_cntrl(29) = tauy
+      ELSE
+       tab_cntrl(24) = 0.
+c       tab_cntrl(25) = dzoomx
+c       tab_cntrl(26) = dzoomy
+       tab_cntrl(27) = 0.
+       tab_cntrl(28) = 0.
+       tab_cntrl(29) = 0.
+       IF( ysinus )  tab_cntrl(27) = 1.
+      ENDIF
+CAl1 iday_end -> day_end
+       tab_cntrl(30) = FLOAT(day_end)
+       tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
+c
+      CALL put_var("controle","Param. de controle Dyn1D",tab_cntrl)
+c
+
+c  Ecriture/extension de la coordonnee temps
+
+      nb = nb + 1
+
+c  Ecriture des champs
+c
+      CALL put_field("plev","p interfaces sauf la nulle",plev)
+      CALL put_field("play","",play)
+      CALL put_field("phi","geopotentielle",phi)
+      CALL put_field("phis","geopotentiell de surface",phis)
+      CALL put_field("presnivs","",presnivs)
+      CALL put_field("ucov","",ucov)
+      CALL put_field("vcov","",vcov)
+      CALL put_field("temp","",temp)
+      CALL put_field("omega2","",omega2)
+
+      Do iq=1,nqtot
+        CALL put_field("q"//nmq(iq),"eau vap ou condens et traceurs",
+     .                                                      q(:,:,iq))
+      EndDo
+      CALL close_restartphy
+
+c
+      RETURN
+      END
+      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
+      IMPLICIT NONE
+!=======================================================================
+!   passage d'un champ de la grille scalaire a la grille physique
+!=======================================================================
+ 
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+ 
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+ 
+      INTEGER i,j,ifield,ig
+ 
+!-----------------------------------------------------------------------
+!   calcul:
+!   -------
+ 
+      DO ifield=1,nfield
+!   traitement des poles
+         DO i=1,im
+            pdyn(i,1,ifield)=pfi(1,ifield)
+            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
+         ENDDO
+ 
+!   traitement des point normaux
+         DO j=2,jm-1
+	    ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
+	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
+         ENDDO
+      ENDDO
+ 
+      RETURN
+      END
+ 
+ 
+
+      SUBROUTINE abort_gcm(modname, message, ierr)
+ 
+      USE IOIPSL
+!
+! Stops the simulation cleanly, closing files and printing various
+! comments
+!
+!  Input: modname = name of calling program
+!         message = stuff to print
+!         ierr    = severity of situation ( = 0 normal )
+ 
+      character*20 modname
+      integer ierr
+      character*80 message
+ 
+      write(*,*) 'in abort_gcm'
+      call histclo
+!     call histclo(2)
+!     call histclo(3)
+!     call histclo(4)
+!     call histclo(5)
+      write(*,*) 'out of histclo'
+      write(*,*) 'Stopping in ', modname
+      write(*,*) 'Reason = ',message
+      call getin_dump
+!
+      if (ierr .eq. 0) then
+        write(*,*) 'Everything is cool'
+      else
+        write(*,*) 'Houston, we have a problem ', ierr
+      endif
+      STOP
+      END
+      REAL FUNCTION fq_sat(kelvin, millibar)
+!
+      IMPLICIT none
+!======================================================================
+! Autheur(s): Z.X. Li (LMD/CNRS)
+! Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
+!======================================================================
+! Arguments:
+! kelvin---input-R: temperature en Kelvin
+! millibar--input-R: pression en mb
+!
+! fq_sat----output-R: vapeur d'eau saturante en kg/kg
+!======================================================================
+!
+      REAL kelvin, millibar
+!
+      REAL r2es
+      PARAMETER (r2es=611.14 *18.0153/28.9644)
+!
+      REAL r3les, r3ies, r3es
+      PARAMETER (R3LES=17.269)
+      PARAMETER (R3IES=21.875)
+!
+      REAL r4les, r4ies, r4es
+      PARAMETER (R4LES=35.86)
+      PARAMETER (R4IES=7.66)
+!
+      REAL rtt
+      PARAMETER (rtt=273.16)
+!
+      REAL retv
+      PARAMETER (retv=28.9644/18.0153 - 1.0)
+!
+      REAL zqsat
+      REAL temp, pres
+!     ------------------------------------------------------------------
+!
+!
+      temp = kelvin
+      pres = millibar * 100.0
+!      write(*,*)'kelvin,millibar=',kelvin,millibar
+!      write(*,*)'temp,pres=',temp,pres
+!
+      IF (temp .LE. rtt) THEN
+         r3es = r3ies
+         r4es = r4ies
+      ELSE
+         r3es = r3les
+         r4es = r4les
+      ENDIF
+!
+      zqsat=r2es/pres * EXP ( r3es*(temp-rtt) / (temp-r4es) )
+      zqsat=MIN(0.5,ZQSAT)
+      zqsat=zqsat/(1.-retv  *zqsat)
+!
+      fq_sat = zqsat
+!
+      RETURN
+      END
+      subroutine scopy(n,sx,incx,sy,incy)
+!
+      IMPLICIT NONE
+!
+      integer n,incx,incy,ix,iy,i
+      real sx((n-1)*incx+1),sy((n-1)*incy+1)
+!
+      iy=1
+      ix=1
+      do 10 i=1,n
+	 sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+!
+      return
+      end
+      subroutine wrgradsfi(if,nl,field,name,titlevar)
+      implicit none
+ 
+!   Declarations
+ 
+#include "gradsdef.h"
+ 
+!   arguments
+      integer if,nl
+      real field(imx*jmx*lmx)
+      character*10 name,file
+      character*10 titlevar
+ 
+!   local
+ 
+      integer im,jm,lm,i,j,l,iv,iii,iji,iif,ijf
+ 
+      logical writectl
+ 
+ 
+      writectl=.false.
+ 
+!     print*,if,iid(if),jid(if),ifd(if),jfd(if)
+      iii=iid(if)
+      iji=jid(if)
+      iif=ifd(if)
+      ijf=jfd(if)
+      im=iif-iii+1
+      jm=ijf-iji+1
+      lm=lmd(if)
+
+
+!     print*,'im,jm,lm,name,firsttime(if)'
+!     print*,im,jm,lm,name,firsttime(if)
+ 
+      if(firsttime(if)) then
+         if(name.eq.var(1,if)) then
+            firsttime(if)=.false.
+            ivar(if)=1
+         print*,'fin de l initialiation de l ecriture du fichier'
+         print*,file
+           print*,'fichier no: ',if
+           print*,'unit ',unit(if)
+           print*,'nvar  ',nvar(if)
+           print*,'vars ',(var(iv,if),iv=1,nvar(if))
+         else
+            ivar(if)=ivar(if)+1
+            nvar(if)=ivar(if)
+            var(ivar(if),if)=name
+            tvar(ivar(if),if)=trim(titlevar)
+            nld(ivar(if),if)=nl
+            print*,'initialisation ecriture de ',var(ivar(if),if)
+            print*,'if ivar(if) nld ',if,ivar(if),nld(ivar(if),if)
+         endif
+         writectl=.true.
+         itime(if)=1
+      else
+         ivar(if)=mod(ivar(if),nvar(if))+1
+         if (ivar(if).eq.nvar(if)) then
+            writectl=.true.
+            itime(if)=itime(if)+1
+         endif
+ 
+         if(var(ivar(if),if).ne.name) then
+           print*,'Il faut stoker la meme succession de champs a chaque'
+           print*,'pas de temps'
+           print*,'fichier no: ',if
+           print*,'unit ',unit(if)
+           print*,'nvar  ',nvar(if)
+           print*,'vars ',(var(iv,if),iv=1,nvar(if))
+ 
+           stop
+         endif
+      endif
+ 
+!     print*,'ivar(if),nvar(if),var(ivar(if),if),writectl'
+!     print*,ivar(if),nvar(if),var(ivar(if),if),writectl
+      do l=1,nl
+         irec(if)=irec(if)+1
+!        print*,'Ecrit rec=',irec(if),iii,iif,iji,ijf,
+!    s (l-1)*imd(if)*jmd(if)+(iji-1)*imd(if)+iii
+!    s ,(l-1)*imd(if)*jmd(if)+(ijf-1)*imd(if)+iif
+         write(unit(if)+1,rec=irec(if))
+     s   ((field((l-1)*imd(if)*jmd(if)+(j-1)*imd(if)+i)
+     s   ,i=iii,iif),j=iji,ijf)
+      enddo
+      if (writectl) then
+ 
+      file=fichier(if)
+!   WARNING! on reecrase le fichier .ctl a chaque ecriture
+      open(unit(if),file=trim(file)//'.ctl',
+     &         form='formatted',status='unknown')
+      write(unit(if),'(a5,1x,a40)')
+     &       'DSET ','^'//trim(file)//'.dat'
+ 
+      write(unit(if),'(a12)') 'UNDEF 1.0E30'
+      write(unit(if),'(a5,1x,a40)') 'TITLE ',title(if)
+      call formcoord(unit(if),im,xd(iii,if),1.,.false.,'XDEF')
+      call formcoord(unit(if),jm,yd(iji,if),1.,.true.,'YDEF')
+      call formcoord(unit(if),lm,zd(1,if),1.,.false.,'ZDEF')
+      write(unit(if),'(a4,i10,a30)')
+     &       'TDEF ',itime(if),' LINEAR 07AUG1998 30MN '
+      write(unit(if),'(a4,2x,i5)') 'VARS',nvar(if)
+      do iv=1,nvar(if)
+!        print*,'if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)'
+!        print*,if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)
+         write(unit(if),1000) var(iv,if),nld(iv,if)-1/nld(iv,if)
+     &     ,99,tvar(iv,if)
+      enddo
+      write(unit(if),'(a7)') 'ENDVARS'
+!
+1000  format(a5,3x,i4,i3,1x,a39)
+ 
+      close(unit(if))
+ 
+      endif ! writectl
+ 
+      return
+ 
+      END
+ 
+      subroutine inigrads(if,im
+     s  ,x,fx,xmin,xmax,jm,y,ymin,ymax,fy,lm,z,fz
+     s  ,dt,file,titlel)
+ 
+ 
+      implicit none
+ 
+      integer if,im,jm,lm,i,j,l
+      real x(im),y(jm),z(lm),fx,fy,fz,dt
+      real xmin,xmax,ymin,ymax
+      integer nf
+ 
+      character file*10,titlel*40
+ 
+#include "gradsdef.h"
+ 
+      data unit/24,32,34,36,38,40,42,44,46,48/
+      data nf/0/
+ 
+      if (if.le.nf) stop'verifier les appels a inigrads'
+ 
+      print*,'Entree dans inigrads'
+ 
+      nf=if
+      title(if)=titlel
+      ivar(if)=0
+ 
+      fichier(if)=trim(file)
+ 
+      firsttime(if)=.true.
+      dtime(if)=dt
+ 
+      iid(if)=1
+      ifd(if)=im
+      imd(if)=im
+      do i=1,im
+         xd(i,if)=x(i)*fx
+         if(xd(i,if).lt.xmin) iid(if)=i+1
+         if(xd(i,if).le.xmax) ifd(if)=i
+      enddo
+      print*,'On stoke du point ',iid(if),'  a ',ifd(if),' en x'
+ 
+      jid(if)=1
+      jfd(if)=jm
+      jmd(if)=jm
+      do j=1,jm
+         yd(j,if)=y(j)*fy
+         if(yd(j,if).gt.ymax) jid(if)=j+1
+         if(yd(j,if).ge.ymin) jfd(if)=j
+      enddo
+      print*,'On stoke du point ',jid(if),'  a ',jfd(if),' en y'
+
+      print*,'Open de dat'
+      print*,'file=',file
+      print*,'fichier(if)=',fichier(if)
+ 
+      print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if))
+      print*,trim(file)//'.dat'
+ 
+      OPEN (unit(if)+1,FILE=trim(file)//'.dat',
+     s   FORM='UNFORMATTED',
+     s   ACCESS='DIRECT'
+     s  ,RECL=4*(ifd(if)-iid(if)+1)*(jfd(if)-jid(if)+1))
+ 
+      print*,'Open de dat ok'
+ 
+      lmd(if)=lm
+      do l=1,lm
+         zd(l,if)=z(l)*fz
+      enddo
+ 
+      irec(if)=0
+!CR 
+!      print*,if,imd(if),jmd(if),lmd(if)
+!      print*,'if,imd(if),jmd(if),lmd(if)'
+ 
+      return
+      end
+      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
+      IMPLICIT NONE
+!=======================================================================
+!   passage d'un champ de la grille scalaire a la grille physique
+!=======================================================================
+ 
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+ 
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+ 
+      INTEGER j,ifield,ig
+ 
+!-----------------------------------------------------------------------
+!   calcul:
+!   -------
+ 
+      IF(ngrid.NE.2+(jm-2)*(im-1).AND.ngrid.NE.1)
+     s    STOP 'probleme de dim'
+!   traitement des poles
+      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
+      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
+ 
+!   traitement des point normaux
+      DO ifield=1,nfield
+         DO j=2,jm-1
+	    ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
+         ENDDO
+      ENDDO
+ 
+      RETURN
+      END
+ 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine writelim
+     s   (phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,phy_ice,
+     s    phy_fter,phy_foce,phy_flic,phy_fsic)
+
+      use dimphy
+      implicit none
+!
+#include "dimensions.h"
+#include "netcdf.inc"
+ 
+      integer klon1d
+      integer k
+      parameter (klon1d=1)
+      REAL phy_nat(klon1d,360)
+      REAL phy_alb(klon1d,360)
+      REAL phy_sst(klon1d,360)
+      REAL phy_bil(klon1d,360)
+      REAL phy_rug(klon1d,360)
+      REAL phy_ice(klon1d,360)
+      REAL phy_fter(klon1d,360)
+      REAL phy_foce(klon1d,360)
+      REAL phy_flic(klon1d,360)
+      REAL phy_fsic(klon1d,360)
+ 
+      INTEGER ierr
+      INTEGER dimfirst(3)
+      INTEGER dimlast(3)
+!
+      INTEGER nid, ndim, ntim
+      INTEGER dims(2), debut(2), epais(2)
+      INTEGER id_tim
+      INTEGER id_NAT, id_SST, id_BILS, id_RUG, id_ALB
+      INTEGER id_FTER,id_FOCE,id_FSIC,id_FLIC
+ 
+      PRINT*, 'Ecriture du fichier limit'
+!
+      ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
+!
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30,
+     .                       "Fichier conditions aux limites")
+      ierr = NF_DEF_DIM (nid, "points_physiques", klon1d, ndim)
+      ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim)
+!
+      dims(1) = ndim
+      dims(2) = ntim
+!
+!cc      ierr = NF_DEF_VAR (nid, "TEMPS", NF_DOUBLE, 1,ntim, id_tim)
+      ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
+      ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
+     .                        "Jour dans l annee")
+!cc      ierr = NF_DEF_VAR (nid, "NAT", NF_DOUBLE, 2,dims, id_NAT)
+      ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
+      ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
+     .                        "Nature du sol (0,1,2,3)")
+!cc      ierr = NF_DEF_VAR (nid, "SST", NF_DOUBLE, 2,dims, id_SST)
+      ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
+      ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
+     .                        "Temperature superficielle de la mer")
+!cc      ierr = NF_DEF_VAR (nid, "BILS", NF_DOUBLE, 2,dims, id_BILS)
+      ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
+      ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
+     .                        "Reference flux de chaleur au sol")
+!cc      ierr = NF_DEF_VAR (nid, "ALB", NF_DOUBLE, 2,dims, id_ALB)
+      ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
+      ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
+     .                        "Albedo a la surface")
+!cc      ierr = NF_DEF_VAR (nid, "RUG", NF_DOUBLE, 2,dims, id_RUG)
+      ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
+      ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
+     .                        "Rugosite")
+
+      ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER)
+      ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 8,"Frac. Terre")
+      ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE)
+      ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 8,"Frac. Terre")
+      ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC)
+      ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 8,"Frac. Terre")
+      ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC)
+      ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 8,"Frac. Terre")
+!
+      ierr = NF_ENDDEF(nid)
+!
+      DO k = 1, 360
+!
+      debut(1) = 1
+      debut(2) = k
+      epais(1) = klon1d
+      epais(2) = 1
+!
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais,phy_nat(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_ALB,debut,epais,phy_alb(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_FTER,debut,epais,phy_fter(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_FOCE,debut,epais,phy_foce(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_FSIC,debut,epais,phy_fsic(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_FLIC,debut,epais,phy_flic(1,k))
+#else
+      ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
+      ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais,phy_nat(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_ALB,debut,epais,phy_alb(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_RUG,debut,epais,phy_rug(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_FTER,debut,epais,phy_fter(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais,phy_foce(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_FSIC,debut,epais,phy_fsic(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_FLIC,debut,epais,phy_flic(1,k))
+
+#endif
+!
+      ENDDO
+!
+      ierr = NF_CLOSE(nid)
+!
+      return
+      end
+ 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
+ 
+!    Auteur :  P. Le Van .
+!
+      IMPLICIT NONE
+ 
+#include "dimensions.h"
+#include "paramet.h"
+!
+!=======================================================================
+!
+!
+!    s = sigma ** kappa   :  coordonnee  verticale
+!    dsig(l)            : epaisseur de la couche l ds la coord.  s
+!    sig(l)             : sigma a l'interface des couches l et l-1
+!    ds(l)              : distance entre les couches l et l-1 en coord.s
+!
+!=======================================================================
+!
+      REAL pa,preff
+      REAL ap(llmp1),bp(llmp1),dpres(llm),nivsigs(llm),nivsig(llmp1)
+      REAL presnivs(llm)
+!
+!   declarations:
+!   -------------
+!
+      REAL sig(llm+1),dsig(llm)
+!
+      INTEGER l
+      REAL snorm
+      REAL alpha,beta,gama,delta,deltaz,h
+      INTEGER np,ierr
+      REAL pi,x
+ 
+!-----------------------------------------------------------------------
+!
+      pi=2.*ASIN(1.)
+ 
+      OPEN(99,file='sigma.def',status='old',form='formatted',
+     s   iostat=ierr)
+ 
+!-----------------------------------------------------------------------
+!   cas 1 on lit les options dans sigma.def:
+!   ----------------------------------------
+ 
+      IF (ierr.eq.0) THEN
+ 
+      print*,'WARNING!!! on lit les options dans sigma.def'
+      READ(99,*) deltaz
+      READ(99,*) h
+      READ(99,*) beta
+      READ(99,*) gama
+      READ(99,*) delta
+      READ(99,*) np
+      CLOSE(99)
+      alpha=deltaz/(llm*h)
+!
+ 
+       DO 1  l = 1, llm
+       dsig(l) = (alpha+(1.-alpha)*exp(-beta*(llm-l)))*
+     $          ( (tanh(gama*l)/tanh(gama*llm))**np +
+     $            (1.-l/FLOAT(llm))*delta )
+   1   CONTINUE
+ 
+       sig(1)=1.
+       DO 101 l=1,llm-1
+          sig(l+1)=sig(l)*(1.-dsig(l))/(1.+dsig(l))
+101    CONTINUE
+       sig(llm+1)=0.
+ 
+       DO 2  l = 1, llm
+       dsig(l) = sig(l)-sig(l+1)
+   2   CONTINUE
+!
+ 
+      ELSE
+!-----------------------------------------------------------------------
+!   cas 2 ancienne discretisation (LMD5...):
+!   ----------------------------------------
+ 
+      PRINT*,'WARNING!!! Ancienne discretisation verticale'
+ 
+      h=7.
+      snorm  = 0.
+      DO l = 1, llm
+         x = 2.*asin(1.) * (FLOAT(l)-0.5) / float(llm+1)
+         dsig(l) = 1.0 + 7.0 * SIN(x)**2
+         snorm = snorm + dsig(l)
+      ENDDO
+      snorm = 1./snorm
+      DO l = 1, llm
+         dsig(l) = dsig(l)*snorm
+      ENDDO
+      sig(llm+1) = 0.
+      DO l = llm, 1, -1
+         sig(l) = sig(l+1) + dsig(l)
+      ENDDO
+ 
+      ENDIF
+ 
+ 
+      DO l=1,llm
+        nivsigs(l) = FLOAT(l)
+      ENDDO
+ 
+      DO l=1,llmp1
+        nivsig(l)= FLOAT(l)
+      ENDDO
+ 
+!
+!    ....  Calculs  de ap(l) et de bp(l)  ....
+!    .........................................
+!
+!
+!   .....  pa et preff sont lus  sur les fichiers start par lectba  .....
+!
+ 
+      bp(llmp1) =   0.
+ 
+      DO l = 1, llm
+!c
+!cc    ap(l) = 0.
+!cc    bp(l) = sig(l)
+ 
+      bp(l) = EXP( 1. -1./( sig(l)*sig(l)) )
+      ap(l) = pa * ( sig(l) - bp(l) )
+!
+      ENDDO
+      ap(llmp1) = pa * ( sig(llmp1) - bp(llmp1) )
+ 
+      PRINT *,' BP '
+      PRINT *,  bp
+      PRINT *,' AP '
+      PRINT *,  ap
+ 
+      DO l = 1, llm
+       dpres(l) = bp(l) - bp(l+1)
+       presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
+      ENDDO
+ 
+      PRINT *,' PRESNIVS '
+      PRINT *,presnivs
+ 
+      RETURN
+      END
+
+!======================================================================
+       SUBROUTINE read_tsurf1d(knon,knindex,sst_out)
+
+! This subroutine specifies the surface temperature to be used in 1D simulations
+
+      USE dimphy, ONLY : klon
+
+      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
+      INTEGER, DIMENSION(klon), INTENT(IN) :: knindex  ! grid point number for compressed grid
+      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
+
+       INTEGER :: i
+! COMMON defined in lmdz1d.F:
+       real ts_cur
+       common /sst_forcing/ts_cur
+
+       DO i = 1, knon
+        sst_out(i) = ts_cur
+       ENDDO
+
+      END SUBROUTINE read_tsurf1d
+
+!===============================================================
+      subroutine advect_vert(llm,w,dt,q,plev)
+!===============================================================
+!   Schema amont pour l'advection verticale en 1D
+!   w est la vitesse verticale dp/dt en Pa/s
+!   Traitement en volumes finis 
+!   d / dt ( zm q ) = delta_z ( omega q )
+!   d / dt ( zm ) = delta_z ( omega )
+!   avec zm = delta_z ( p )
+!   si * designe la valeur au pas de temps t+dt
+!   zm*(l) q*(l) - zm(l) q(l) = w(l+1) q(l+1) - w(l) q(l)
+!   zm*(l) -zm(l) = w(l+1) - w(l)
+!   avec w=omega * dt
+!---------------------------------------------------------------
+      implicit none
+! arguments
+      integer llm
+      real w(llm+1),q(llm),plev(llm+1),dt
+
+! local
+      integer l
+      real zwq(llm+1),zm(llm+1),zw(llm+1)
+      real qold
+
+!---------------------------------------------------------------
+
+      do l=1,llm
+         zw(l)=dt*w(l)
+         zm(l)=plev(l)-plev(l+1)
+         zwq(l)=q(l)*zw(l)
+      enddo
+      zwq(llm+1)=0.
+      zw(llm+1)=0.
+ 
+      do l=1,llm
+         qold=q(l)
+         q(l)=(q(l)*zm(l)+zwq(l+1)-zwq(l))/(zm(l)+zw(l+1)-zw(l))
+         print*,'ADV Q ',zm(l),zw(l),zwq(l),qold,q(l)
+      enddo
+
+ 
+      return
+      end
+
+!===============================================================
+
+
+       SUBROUTINE advect_va(llm,omega,d_t_va,d_q_va,d_u_va,d_v_va,
+     !                q,temp,u,v,
+     !            play,plev)
+!itlmd 
+!----------------------------------------------------------------------
+!   Calcul de l'advection verticale (ascendance et subsidence) de 
+!   température et d'humidité. Hypothèse : ce qui rentre de l'extérieur
+!   a les mêmes caractéristiques que l'air de la colonne 1D (WTG) ou 
+!   sans WTG rajouter une advection horizontale 
+!----------------------------------------------------------------------  
+        implicit none
+#include "YOMCST.h"
+!        argument
+        integer llm
+        real  omega(llm+1),d_t_va(llm), d_q_va(llm,3)
+        real  d_u_va(llm), d_v_va(llm)
+        real  q(llm,3),temp(llm)
+        real  u(llm),v(llm)
+        real  play(llm),plev(llm+1)
+! interne
+        integer l
+        real alpha,omgdown,omgup
+
+      do l= 1,llm
+       if(l.eq.1) then
+!si omgup pour la couche 1, alors tendance nulle
+        omgdown=max(omega(2),0.0)
+        alpha = rkappa*temp(l)*(1.+q(l,1)*rv/rd)/(play(l)*
+     &           (1.+q(l,1)))
+        d_t_va(l)= alpha*(omgdown)- 
+     &              omgdown*(temp(l)-temp(l+1))
+     &              /(play(l)-play(l+1))              
+
+        d_q_va(l,:)= -omgdown*(q(l,:)-q(l+1,:))
+     &              /(play(l)-play(l+1))              
+
+        d_u_va(l)= -omgdown*(u(l)-u(l+1))
+     &              /(play(l)-play(l+1))              
+        d_v_va(l)= -omgdown*(v(l)-v(l+1))
+     &              /(play(l)-play(l+1))              
+
+        
+       elseif(l.eq.llm) then
+        omgup=min(omega(l),0.0)
+        alpha = rkappa*temp(l)*(1.+q(l,1)*rv/rd)/(play(l)*
+     &           (1.+q(l,1)))
+        d_t_va(l)= alpha*(omgup)- 
+!bug?     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-plev(l))
+     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-play(l))
+        d_q_va(l,:)= -omgup*(q(l-1,:)-q(l,:))/(play(l-1)-play(l))
+        d_u_va(l)= -omgup*(u(l-1)-u(l))/(play(l-1)-play(l))
+        d_v_va(l)= -omgup*(v(l-1)-v(l))/(play(l-1)-play(l))
+       
+       else
+        omgup=min(omega(l),0.0)
+        omgdown=max(omega(l+1),0.0)
+        alpha = rkappa*temp(l)*(1.+q(l,1)*rv/rd)/(play(l)*
+     &           (1.+q(l,1)))
+        d_t_va(l)= alpha*(omgup+omgdown)- 
+     &              omgdown*(temp(l)-temp(l+1))
+     &              /(play(l)-play(l+1))-              
+!bug?     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-plev(l))
+     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-play(l))
+!      print*, '  ??? '
+
+        d_q_va(l,:)= -omgdown*(q(l,:)-q(l+1,:))
+     &              /(play(l)-play(l+1))-              
+     &              omgup*(q(l-1,:)-q(l,:))/(play(l-1)-play(l))
+        d_u_va(l)= -omgdown*(u(l)-u(l+1))
+     &              /(play(l)-play(l+1))-              
+     &              omgup*(u(l-1)-u(l))/(play(l-1)-play(l))
+        d_v_va(l)= -omgdown*(v(l)-v(l+1))
+     &              /(play(l)-play(l+1))-              
+     &              omgup*(v(l-1)-v(l))/(play(l-1)-play(l))
+       
+      endif
+         
+      enddo
+!fin itlmd
+        return
+        end
+!       SUBROUTINE lstendH(llm,omega,d_t_va,d_q_va,d_u_va,d_v_va,
+       SUBROUTINE lstendH(llm,nqtot,omega,d_t_va,d_q_va,
+     !                q,temp,u,v,play)
+!itlmd 
+!----------------------------------------------------------------------
+!   Calcul de l'advection verticale (ascendance et subsidence) de 
+!   température et d'humidité. Hypothèse : ce qui rentre de l'extérieur
+!   a les mêmes caractéristiques que l'air de la colonne 1D (WTG) ou 
+!   sans WTG rajouter une advection horizontale 
+!----------------------------------------------------------------------  
+        implicit none
+#include "YOMCST.h"
+!        argument
+        integer llm,nqtot
+        real  omega(llm+1),d_t_va(llm), d_q_va(llm,nqtot)
+!        real  d_u_va(llm), d_v_va(llm)
+        real  q(llm,nqtot),temp(llm)
+        real  u(llm),v(llm)
+        real  play(llm)
+        real cor(llm)
+!        real dph(llm),dudp(llm),dvdp(llm),dqdp(llm),dtdp(llm)
+        real dph(llm),dqdp(llm),dtdp(llm)
+! interne
+        integer l,k
+        real alpha,omdn,omup
+
+!        dudp=0.
+!        dvdp=0.
+        dqdp=0.
+        dtdp=0.
+!        d_u_va=0.
+!        d_v_va=0.
+
+      cor(:) = rkappa*temp*(1.+q(:,1)*rv/rd)/(play*(1.+q(:,1)))
+
+
+      do k=2,llm-1
+
+       dph  (k-1) = (play(k  )- play(k-1  ))
+!       dudp (k-1) = (u   (k  )- u   (k-1  ))/dph(k-1)
+!       dvdp (k-1) = (v   (k  )- v   (k-1  ))/dph(k-1)
+       dqdp (k-1) = (q   (k,1)- q   (k-1,1))/dph(k-1)
+       dtdp (k-1) = (temp(k  )- temp(k-1  ))/dph(k-1)
+
+      enddo
+
+!      dudp (  llm  ) = dudp ( llm-1 )
+!      dvdp (  llm  ) = dvdp ( llm-1 )
+      dqdp (  llm  ) = dqdp ( llm-1 )
+      dtdp (  llm  ) = dtdp ( llm-1 )
+
+      do k=2,llm-1
+      omdn=max(0.0,omega(k+1))
+      omup=min(0.0,omega( k ))
+
+!      d_u_va(k)  = -omdn*dudp(k)-omup*dudp(k-1)
+!      d_v_va(k)  = -omdn*dvdp(k)-omup*dvdp(k-1)
+      d_q_va(k,1)= -omdn*dqdp(k)-omup*dqdp(k-1)
+      d_t_va(k)  = -omdn*dtdp(k)-omup*dtdp(k-1)
+     :              +(omup+omdn)*cor(k)
+      enddo
+
+      omdn=max(0.0,omega( 2 ))
+      omup=min(0.0,omega(llm))
+!      d_u_va( 1 )   = -omdn*dudp( 1 )
+!      d_u_va(llm)   = -omup*dudp(llm)
+!      d_v_va( 1 )   = -omdn*dvdp( 1 )
+!      d_v_va(llm)   = -omup*dvdp(llm)
+      d_q_va( 1 ,1) = -omdn*dqdp( 1 )
+      d_q_va(llm,1) = -omup*dqdp(llm)
+      d_t_va( 1 )   = -omdn*dtdp( 1 )+omdn*cor( 1 )
+      d_t_va(llm)   = -omup*dtdp(llm)!+omup*cor(llm)
+
+!      if(abs(rlat(1))>10.) then
+!     Calculate the tendency due agestrophic motions
+!      du_age = fcoriolis*(v-vg)
+!      dv_age = fcoriolis*(ug-u)
+!      endif
+
+!       call writefield_phy('d_t_va',d_t_va,llm)
+
+          return
+         end
+
+!======================================================================
+      SUBROUTINE read_togacoare(fich_toga,nlev_toga,nt_toga
+     :             ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga
+     :             ,ht_toga,vt_toga,hq_toga,vq_toga)
+      implicit none
+
+c-------------------------------------------------------------------------
+c Read TOGA-COARE forcing data 
+c-------------------------------------------------------------------------
+
+      integer nlev_toga,nt_toga
+      real ts_toga(nt_toga),plev_toga(nlev_toga,nt_toga)
+      real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
+      real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
+      real w_toga(nlev_toga,nt_toga)
+      real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+      real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+      character*80 fich_toga
+
+      integer no,l,k,ip
+      real riy,rim,rid,rih,bid
+
+      integer iy,im,id,ih
+      
+       real plev_min
+
+       plev_min = 55.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
+
+      open(21,file=trim(fich_toga),form='formatted')
+      read(21,'(a)') 
+      do ip = 1, nt_toga
+      read(21,'(a)') 
+      read(21,'(a)') 
+      read(21,223) iy, im, id, ih, bid, ts_toga(ip), bid,bid,bid,bid
+      read(21,'(a)') 
+      read(21,'(a)') 
+
+       do k = 1, nlev_toga
+         read(21,230) plev_toga(k,ip), t_toga(k,ip), q_toga(k,ip) 
+     :       ,u_toga(k,ip), v_toga(k,ip), w_toga(k,ip)
+     :       ,ht_toga(k,ip), vt_toga(k,ip), hq_toga(k,ip), vq_toga(k,ip)
+
+! conversion in SI units:
+         t_toga(k,ip)=t_toga(k,ip)+273.15     ! K
+         q_toga(k,ip)=q_toga(k,ip)*0.001      ! kg/kg
+         w_toga(k,ip)=w_toga(k,ip)*100./3600. ! Pa/s
+! no water vapour tendency above 55 hPa
+         if (plev_toga(k,ip) .lt. plev_min) then
+          q_toga(k,ip) = 0.
+          hq_toga(k,ip) = 0.
+          vq_toga(k,ip) =0.
+         endif
+       enddo
+
+         ts_toga(ip)=ts_toga(ip)+273.15       ! K
+       enddo
+       close(21)
+
+  223 format(4i3,6f8.2)
+  226 format(f7.1,1x,10f8.2)
+  227 format(f7.1,1x,1p,4e11.3)
+  230 format(6f9.3,4e11.3)
+
+          return
+          end
+
+!=====================================================================
+      subroutine read_twpice(fich_twpice,nlevel,ntime
+     :     ,T_srf,plev,T,q,u,v,omega
+     :     ,T_adv_h,T_adv_v,q_adv_h,q_adv_v)
+
+!program reading forcings of the TWP-ICE experiment
+
+!      use netcdf
+
+      implicit none
+
+#include "netcdf.inc"
+
+      integer ntime,nlevel
+      integer l,k
+      character*80 :: fich_twpice
+      real*8 time(ntime)
+      real*8 lat, lon, alt, phis	
+      real*8 lev(nlevel)
+      real*8 plev(nlevel,ntime)
+
+      real*8 T(nlevel,ntime)
+      real*8 q(nlevel,ntime),u(nlevel,ntime)
+      real*8 v(nlevel,ntime)
+      real*8 omega(nlevel,ntime), div(nlevel,ntime)
+      real*8 T_adv_h(nlevel,ntime)
+      real*8 T_adv_v(nlevel,ntime), q_adv_h(nlevel,ntime)
+      real*8 q_adv_v(nlevel,ntime)	
+      real*8 s(nlevel,ntime), s_adv_h(nlevel,ntime)
+      real*8 s_adv_v(nlevel,ntime)
+      real*8 p_srf_aver(ntime), p_srf_center(ntime)
+      real*8 T_srf(ntime)
+
+      integer nid, ierr
+      integer nbvar3d
+      parameter(nbvar3d=20)
+      integer var3didin(nbvar3d)
+
+      ierr = NF_OPEN(fich_twpice,NF_NOWRITE,nid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: Pb opening forcings cdf file '
+         write(*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+      ierr=NF_INQ_VARID(nid,"lat",var3didin(1))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lat'
+         endif
+      
+       ierr=NF_INQ_VARID(nid,"lon",var3didin(2))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lon'
+         endif
+
+       ierr=NF_INQ_VARID(nid,"alt",var3didin(3))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'alt'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"phis",var3didin(4))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'phis'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T",var3didin(5))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q",var3didin(6))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"u",var3didin(7))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'u'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"v",var3didin(8))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"omega",var3didin(9))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'omega'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"div",var3didin(10))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'div'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_adv_h",var3didin(11))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_adv_h'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_adv_v",var3didin(12))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q_adv_h",var3didin(13))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q_adv_h'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q_adv_v",var3didin(14))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"s",var3didin(15))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"s_adv_h",var3didin(16))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's_adv_h'
+         endif
+    
+      ierr=NF_INQ_VARID(nid,"s_adv_v",var3didin(17))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"p_srf_aver",var3didin(18))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'p_srf_aver'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"p_srf_center",var3didin(19))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'p_srf_center'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_srf",var3didin(20))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_srf'
+         endif
+
+!dimensions lecture
+      call catchaxis(nid,ntime,nlevel,time,lev,ierr)
+
+!pressure 
+       do l=1,ntime
+       do k=1,nlevel
+          plev(k,l)=lev(k)
+       enddo
+       enddo
+          
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),lat)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(1),lat)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture lat ok',lat
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),lon)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(2),lon)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture lon ok',lon
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),alt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(3),alt)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture alt ok',alt
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),phis)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(4),phis)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture phis ok',phis
+          
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),T)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(5),T)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),q)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(6),q)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q ok'
+!q in kg/kg
+       do l=1,ntime
+       do k=1,nlevel
+          q(k,l)=q(k,l)/1000.
+       enddo
+       enddo
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),u)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(7),u)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture u ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(8),v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture v ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),omega)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(9),omega)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture omega ok'
+!omega in mb/hour
+       do l=1,ntime
+       do k=1,nlevel
+          omega(k,l)=omega(k,l)*100./3600.
+       enddo
+       enddo
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),div)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(10),div)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture div ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),T_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(11),T_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_adv_h ok'
+!T adv in K/s
+       do l=1,ntime
+       do k=1,nlevel
+          T_adv_h(k,l)=T_adv_h(k,l)/3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),T_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(12),T_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_adv_v ok'
+!T adv in K/s
+       do l=1,ntime
+       do k=1,nlevel
+          T_adv_v(k,l)=T_adv_v(k,l)/3600.
+       enddo
+       enddo
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),q_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(13),q_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q_adv_h ok'
+!q adv in kg/kg/s
+       do l=1,ntime
+       do k=1,nlevel
+          q_adv_h(k,l)=q_adv_h(k,l)/1000./3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),q_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(14),q_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q_adv_v ok'
+!q adv in kg/kg/s
+       do l=1,ntime
+       do k=1,nlevel
+          q_adv_v(k,l)=q_adv_v(k,l)/1000./3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),s)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(15),s)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),s_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(16),s_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(17),s_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(17),s_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(18),p_srf_aver)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(18),p_srf_aver)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(19),p_srf_center)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(19),p_srf_center)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(20),T_srf)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(20),T_srf)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_srf ok', T_srf
+
+         return 
+         end subroutine read_twpice
+!=====================================================================
+         subroutine catchaxis(nid,ttm,llm,time,lev,ierr)
+
+!         use netcdf
+
+         implicit none
+#include "netcdf.inc"
+         integer nid,ttm,llm
+         real*8 time(ttm)
+         real*8 lev(llm)
+         integer ierr
+
+         integer i
+         integer timevar,levvar
+         integer timelen,levlen
+         integer timedimin,levdimin
+
+! Control & lecture on dimensions
+! ===============================
+         ierr=NF_INQ_DIMID(nid,"time",timedimin)
+         ierr=NF_INQ_VARID(nid,"time",timevar)
+         if (ierr.NE.NF_NOERR) then
+            write(*,*) 'ERROR: Field <time> is missing'
+            stop ""  
+         endif
+         ierr=NF_INQ_DIMLEN(nid,timedimin,timelen)
+
+         ierr=NF_INQ_DIMID(nid,"lev",levdimin)
+         ierr=NF_INQ_VARID(nid,"lev",levvar)
+         if (ierr.NE.NF_NOERR) then
+             write(*,*) 'ERROR: Field <lev> is lacking'
+             stop "" 
+         endif
+         ierr=NF_INQ_DIMLEN(nid,levdimin,levlen)
+
+         if((timelen/=ttm).or.(levlen/=llm)) then
+            write(*,*) 'ERROR: Not the good lenght for axis'
+            write(*,*) 'longitude: ',timelen,ttm+1
+            write(*,*) 'latitude: ',levlen,llm
+            stop ""  
+         endif
+
+!#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,timevar,time)
+         ierr = NF_GET_VAR_DOUBLE(nid,levvar,lev)
+!#else
+!        ierr = NF_GET_VAR_REAL(nid,timevar,time)
+!        ierr = NF_GET_VAR_REAL(nid,levvar,lev)
+!#endif
+
+       return
+       end
+
+!======================================================================
+      SUBROUTINE read_rico(fich_rico,nlev_rico,ps_rico,play
+     :             ,ts_rico,t_rico,q_rico,u_rico,v_rico,w_rico
+     :             ,dth_dyn,dqh_dyn)
+      implicit none
+
+c-------------------------------------------------------------------------
+c Read RICO forcing data 
+c-------------------------------------------------------------------------
+#include "dimensions.h"
+
+
+      integer nlev_rico
+      real ts_rico,ps_rico
+      real t_rico(llm),q_rico(llm)
+      real u_rico(llm),v_rico(llm)
+      real w_rico(llm)
+      real dth_dyn(llm)
+      real dqh_dyn(llm)
+      
+
+      real play(llm),zlay(llm)
+     
+
+      real prico(nlev_rico),zrico(nlev_rico)
+
+      character*80 fich_rico
+
+      integer k,l
+
+      
+      print*,fich_rico
+      open(21,file=trim(fich_rico),form='formatted')
+        do k=1,llm
+      zlay(k)=0.
+         enddo
+      
+        read(21,*) ps_rico,ts_rico
+        prico(1)=ps_rico
+        zrico(1)=0.0
+      do l=2,nlev_rico
+        read(21,*) k,prico(l),zrico(l)
+      enddo
+       close(21)
+
+      do k=1,llm
+        do l=1,80
+          if(prico(l)>play(k)) then
+              if(play(k)>prico(l+1)) then
+                zlay(k)=zrico(l)+(play(k)-prico(l)) * 
+     &              (zrico(l+1)-zrico(l))/(prico(l+1)-prico(l))
+              else
+                zlay(k)=zrico(l)+(play(k)-prico(80))* 
+     &              (zrico(81)-zrico(80))/(prico(81)-prico(80))
+              endif
+          endif
+        enddo
+        print*,k,zlay(k)
+        ! U
+        if(0 < zlay(k) .and. zlay(k) < 4000) then
+          u_rico(k)=-9.9 + (-1.9 + 9.9)*zlay(k)/4000
+        elseif(4000 < zlay(k) .and. zlay(k) < 12000) then
+       u_rico(k)=  -1.9 + (30.0 + 1.9) / 
+     :          (12000 - 4000) * (zlay(k) - 4000)
+        elseif(12000 < zlay(k) .and. zlay(k) < 13000) then
+          u_rico(k)=30.0
+        elseif(13000 < zlay(k) .and. zlay(k) < 20000) then
+          u_rico(k)=30.0 - (30.0) / 
+     : (20000 - 13000) * (zlay(k) - 13000)
+        else
+          u_rico(k)=0.0
+        endif
+
+!Q_v
+        if(0 < zlay(k) .and. zlay(k) < 740) then
+          q_rico(k)=16.0 + (13.8 - 16.0) / (740) * zlay(k)
+        elseif(740 < zlay(k) .and. zlay(k) < 3260) then
+          q_rico(k)=13.8 + (2.4 - 13.8) / 
+     :          (3260 - 740) * (zlay(k) - 740)
+        elseif(3260 < zlay(k) .and. zlay(k) < 4000) then
+          q_rico(k)=2.4 + (1.8 - 2.4) / 
+     :               (4000 - 3260) * (zlay(k) - 3260)
+        elseif(4000 < zlay(k) .and. zlay(k) < 9000) then
+          q_rico(k)=1.8 + (0 - 1.8) / 
+     :             (10000 - 4000) * (zlay(k) - 4000)
+        else
+          q_rico(k)=0.0
+        endif
+
+!T
+        if(0 < zlay(k) .and. zlay(k) < 740) then
+          t_rico(k)=299.2 + (292.0 - 299.2) / (740) * zlay(k)
+        elseif(740 < zlay(k) .and. zlay(k) < 4000) then
+          t_rico(k)=292.0 + (278.0 - 292.0) /
+     :       (4000 - 740) * (zlay(k) - 740)
+        elseif(4000 < zlay(k) .and. zlay(k) < 15000) then
+          t_rico(k)=278.0 + (203.0 - 278.0) /
+     :       (15000 - 4000) * (zlay(k) - 4000)
+        elseif(15000 < zlay(k) .and. zlay(k) < 17500) then
+          t_rico(k)=203.0 + (194.0 - 203.0) / 
+     :       (17500 - 15000)* (zlay(k) - 15000)
+        elseif(17500 < zlay(k) .and. zlay(k) < 20000) then
+          t_rico(k)=194.0 + (206.0 - 194.0) /
+     :       (20000 - 17500)* (zlay(k) - 17500)
+        elseif(20000 < zlay(k) .and. zlay(k) < 60000) then
+          t_rico(k)=206.0 + (270.0 - 206.0) / 
+     :        (60000 - 20000)* (zlay(k) - 20000)
+        endif
+
+! W
+        if(0 < zlay(k) .and. zlay(k) < 2260 ) then
+          w_rico(k)=- (0.005/2260) * zlay(k)
+        elseif(2260 < zlay(k) .and. zlay(k) < 4000 ) then
+          w_rico(k)=- 0.005
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000 ) then
+       w_rico(k)=- 0.005 + (0.005/ (5000 - 4000)) * (zlay(k) - 4000)
+        else
+          w_rico(k)=0.0
+        endif
+
+! dThrz+dTsw0+dTlw0
+        if(0 < zlay(k) .and. zlay(k) < 4000) then
+          dth_dyn(k)=- 2.51 / 86400 + (-2.18 + 2.51 )/ 
+     :               (86400*4000) * zlay(k)
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000) then
+          dth_dyn(k)=- 2.18 / 86400 + ( 2.18 ) /
+     :           (86400*(5000 - 4000)) * (zlay(k) - 4000)
+        else
+          dth_dyn(k)=0.0
+        endif
+! dQhrz
+        if(0 < zlay(k) .and. zlay(k) < 3000) then
+          dqh_dyn(k)=-1.0 / 86400 + (0.345 + 1.0)/
+     :                    (86400*3000) * (zlay(k))
+        elseif(3000 < zlay(k) .and. zlay(k) < 4000) then
+          dqh_dyn(k)=0.345 / 86400
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000) then
+          dqh_dyn(k)=0.345 / 86400 + 
+     +   (-0.345)/(86400 * (5000 - 4000)) * (zlay(k)-4000)
+        else
+          dqh_dyn(k)=0.0
+        endif
+
+!?        if(play(k)>6e4) then
+!?          ratqs0(1,k)=ratqsbas*(plev(1)-play(k))/(plev(1)-6e4)
+!?        elseif((play(k)>3e4).and.(play(k)<6e4)) then
+!?          ratqs0(1,k)=ratqsbas+(ratqshaut-ratqsbas)&
+!?                          *(6e4-play(k))/(6e4-3e4)
+!?        else
+!?          ratqs0(1,k)=ratqshaut
+!?        endif
+
+      enddo
+
+      do k=1,llm
+      q_rico(k)=q_rico(k)/1e3 
+      dqh_dyn(k)=dqh_dyn(k)/1e3
+      v_rico(k)=-3.8
+      enddo
+
+          return
+          end
+
+!=====================================================================
+c-------------------------------------------------------------------------
+      SUBROUTINE read_armcu(fich_armcu,nlev_armcu,nt_armcu,
+     : sens,flat,adv_theta,rad_theta,adv_qt)
+      implicit none
+
+c-------------------------------------------------------------------------
+c Read ARM_CU case forcing data
+c-------------------------------------------------------------------------
+
+      integer nlev_armcu,nt_armcu
+      real sens(nt_armcu),flat(nt_armcu)
+      real adv_theta(nt_armcu),rad_theta(nt_armcu),adv_qt(nt_armcu)
+      character*80 fich_armcu
+
+      integer no,l,k,ip
+      real riy,rim,rid,rih,bid
+
+      integer iy,im,id,ih,in
+
+      open(21,file=trim(fich_armcu),form='formatted')
+      read(21,'(a)')
+      do ip = 1, nt_armcu
+      read(21,'(a)')
+      read(21,'(a)')
+      read(21,223) iy, im, id, ih, in, sens(ip),flat(ip),
+     :             adv_theta(ip),rad_theta(ip),adv_qt(ip)
+      print *,'forcages=',iy,im,id,ih,in, sens(ip),flat(ip),
+     :             adv_theta(ip),rad_theta(ip),adv_qt(ip)
+      enddo
+      close(21)
+
+  223 format(5i3,5f8.3)
+  226 format(f7.1,1x,10f8.2)
+  227 format(f7.1,1x,1p,4e11.3)
+  230 format(6f9.3,4e11.3)
+
+          return
+          end
+
+!=====================================================================
+       SUBROUTINE interp_toga_vertical(play,nlev_toga,plev_prof
+     :         ,t_prof,q_prof,u_prof,v_prof,w_prof
+     :         ,ht_prof,vt_prof,hq_prof,vq_prof
+     :         ,t_mod,q_mod,u_mod,v_mod,w_mod
+     :         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+ 
+       implicit none
+ 
+#include "dimensions.h"
+
+c-------------------------------------------------------------------------
+c Vertical interpolation of TOGA-COARE forcing data onto model levels
+c-------------------------------------------------------------------------
+ 
+       integer nlevmax
+       parameter (nlevmax=41)
+       integer nlev_toga,mxcalc
+!       real play(llm), plev_prof(nlevmax) 
+!       real t_prof(nlevmax),q_prof(nlevmax)
+!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
+!       real ht_prof(nlevmax),vt_prof(nlevmax)
+!       real hq_prof(nlevmax),vq_prof(nlevmax)
+ 
+       real play(llm), plev_prof(nlev_toga) 
+       real t_prof(nlev_toga),q_prof(nlev_toga)
+       real u_prof(nlev_toga),v_prof(nlev_toga), w_prof(nlev_toga)
+       real ht_prof(nlev_toga),vt_prof(nlev_toga)
+       real hq_prof(nlev_toga),vq_prof(nlev_toga)
+ 
+       real t_mod(llm),q_mod(llm)
+       real u_mod(llm),v_mod(llm), w_mod(llm)
+       real ht_mod(llm),vt_mod(llm)
+       real hq_mod(llm),vq_mod(llm)
+ 
+       integer l,k,k1,k2,kp
+       real aa,frac,frac1,frac2,fact
+ 
+       do l = 1, llm
+
+        if (play(l).ge.plev_prof(nlev_toga)) then
+ 
+        mxcalc=l
+         k1=0
+         k2=0
+
+         if (play(l).le.plev_prof(1)) then
+
+         do k = 1, nlev_toga-1
+          if (play(l).le.plev_prof(k) 
+     :       .and. play(l).gt.plev_prof(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,play(l) = ',l,play(l)/100
+         do k = 1, nlev_toga-1
+          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
+         t_mod(l)= t_prof(k2) - frac*(t_prof(k2)-t_prof(k1))
+         q_mod(l)= q_prof(k2) - frac*(q_prof(k2)-q_prof(k1))
+         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
+         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
+         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
+         ht_mod(l)= ht_prof(k2) - frac*(ht_prof(k2)-ht_prof(k1))
+         vt_mod(l)= vt_prof(k2) - frac*(vt_prof(k2)-vt_prof(k1))
+         hq_mod(l)= hq_prof(k2) - frac*(hq_prof(k2)-hq_prof(k1))
+         vq_mod(l)= vq_prof(k2) - frac*(vq_prof(k2)-vq_prof(k1))
+     
+         else !play>plev_prof(1)
+
+         k1=1
+         k2=2
+         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
+         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
+         t_mod(l)= frac1*t_prof(k1) - frac2*t_prof(k2)
+         q_mod(l)= frac1*q_prof(k1) - frac2*q_prof(k2)
+         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
+         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
+         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
+         ht_mod(l)= frac1*ht_prof(k1) - frac2*ht_prof(k2)
+         vt_mod(l)= frac1*vt_prof(k1) - frac2*vt_prof(k2)
+         hq_mod(l)= frac1*hq_prof(k1) - frac2*hq_prof(k2)
+         vq_mod(l)= frac1*vq_prof(k1) - frac2*vq_prof(k2)
+
+         endif ! play.le.plev_prof(1)
+
+        else ! above max altitude of forcing file
+ 
+cjyg
+         fact=20.*(plev_prof(nlev_toga)-play(l))/plev_prof(nlev_toga) !jyg
+         fact = max(fact,0.)                                           !jyg
+         fact = exp(-fact)                                             !jyg
+         t_mod(l)= t_prof(nlev_toga)                                   !jyg
+         q_mod(l)= q_prof(nlev_toga)*fact                              !jyg
+         u_mod(l)= u_prof(nlev_toga)*fact                              !jyg
+         v_mod(l)= v_prof(nlev_toga)*fact                              !jyg
+         w_mod(l)= 0.0                                                 !jyg
+         ht_mod(l)= ht_prof(nlev_toga)                                 !jyg
+         vt_mod(l)= vt_prof(nlev_toga)                                 !jyg
+         hq_mod(l)= hq_prof(nlev_toga)*fact                            !jyg
+         vq_mod(l)= vq_prof(nlev_toga)*fact                            !jyg
+ 
+        endif ! play
+ 
+       enddo ! l
+
+!       do l = 1,llm
+!       print *,'t_mod(l),q_mod(l),ht_mod(l),hq_mod(l) ',
+!     $        l,t_mod(l),q_mod(l),ht_mod(l),hq_mod(l)
+!       enddo
+ 
+          return
+          end
+ 
+!======================================================================
+        SUBROUTINE interp_toga_time(day,day1,annee_ref
+     i             ,year_ini_toga,day_ini_toga,nt_toga,dt_toga,nlev_toga
+     i             ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga
+     i             ,ht_toga,vt_toga,hq_toga,vq_toga
+     o             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof
+     o             ,ht_prof,vt_prof,hq_prof,vq_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_toga: total nb of data in the forcing (e.g. 480 for TOGA-COARE)
+! dt_toga: total time interval (in sec) between 2 forcing data (e.g. 6h for TOGA-COARE)
+!---------------------------------------------------------------------------------------
+
+#include "compar1d.h"
+
+! inputs:
+        integer annee_ref
+        integer nt_toga,nlev_toga
+        integer year_ini_toga
+        real day, day1,day_ini_toga,dt_toga
+        real ts_toga(nt_toga)
+        real plev_toga(nlev_toga,nt_toga),t_toga(nlev_toga,nt_toga)
+        real q_toga(nlev_toga,nt_toga),u_toga(nlev_toga,nt_toga)
+        real v_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
+        real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+        real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+! outputs:
+        real ts_prof
+        real plev_prof(nlev_toga),t_prof(nlev_toga)
+        real q_prof(nlev_toga),u_prof(nlev_toga)
+        real v_prof(nlev_toga),w_prof(nlev_toga)
+        real ht_prof(nlev_toga),vt_prof(nlev_toga)
+        real hq_prof(nlev_toga),vq_prof(nlev_toga)
+! local:
+        integer it_toga1, it_toga2,k
+        real timeit,time_toga1,time_toga2,frac
+
+
+        if (forcing_type.eq.2) then
+! Check that initial day of the simulation consistent with TOGA-COARE period:
+       if (annee_ref.ne.1992 .and. annee_ref.ne.1993) then
+        print*,'Pour TOGA-COARE, annee_ref doit etre 1992 ou 1993'
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.1992 .and. day1.lt.day_ini_toga) then
+        print*,'TOGA-COARE a débuté le 1er Nov 1992 (jour julien=306)'
+        print*,'Changer dayref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.1993 .and. day1.gt.day_ini_toga+119) then
+        print*,'TOGA-COARE a fini le 28 Feb 1993 (jour julien=59)'
+        print*,'Changer dayref ou nday dans run.def'
+        stop
+       endif
+
+       else if (forcing_type.eq.4) then
+
+! Check that initial day of the simulation consistent with TWP-ICE period:
+       if (annee_ref.ne.2006) then
+        print*,'Pour TWP-ICE, annee_ref doit etre 2006'
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.2006 .and. day1.lt.day_ini_toga) then
+        print*,'TWP-ICE a debute le 17 Jan 2006 (jour julien=17)'
+        print*,'Changer dayref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.2006 .and. day1.gt.day_ini_toga+26) then
+        print*,'TWP-ICE a fini le 12 Feb 2006 (jour julien=43)'
+        print*,'Changer dayref ou nday dans run.def'
+        stop
+       endif
+
+       endif
+
+! Determine timestep relative to the 1st day of TOGA-COARE:
+!       timeit=(day-day1)*86400.
+!       if (annee_ref.eq.1992) then
+!        timeit=(day-day_ini_toga)*86400.
+!       else
+!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
+!       endif
+      timeit=(day-day_ini_toga)*86400
+
+! Determine the closest observation times:
+       it_toga1=INT(timeit/dt_toga)+1
+       it_toga2=it_toga1 + 1
+       time_toga1=(it_toga1-1)*dt_toga
+       time_toga2=(it_toga2-1)*dt_toga
+
+       if (it_toga1 .ge. nt_toga) then
+        write(*,*) 'PB-stop: day, it_toga1, it_toga2, timeit: '
+     :        ,day,it_toga1,it_toga2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_toga2-timeit)/(time_toga2-time_toga1)
+       frac=max(frac,0.0)
+
+       ts_prof = ts_toga(it_toga2)
+     :          -frac*(ts_toga(it_toga2)-ts_toga(it_toga1))
+
+!        print*,
+!     :'day,annee_ref,day_ini_toga,timeit,it_toga1,it_toga2,SST:',
+!     :day,annee_ref,day_ini_toga,timeit/86400.,it_toga1,it_toga2,ts_prof
+
+       do k=1,nlev_toga
+        plev_prof(k) = 100.*(plev_toga(k,it_toga2)
+     :          -frac*(plev_toga(k,it_toga2)-plev_toga(k,it_toga1)))
+        t_prof(k) = t_toga(k,it_toga2)
+     :          -frac*(t_toga(k,it_toga2)-t_toga(k,it_toga1))
+        q_prof(k) = q_toga(k,it_toga2)
+     :          -frac*(q_toga(k,it_toga2)-q_toga(k,it_toga1))
+        u_prof(k) = u_toga(k,it_toga2)
+     :          -frac*(u_toga(k,it_toga2)-u_toga(k,it_toga1))
+        v_prof(k) = v_toga(k,it_toga2)
+     :          -frac*(v_toga(k,it_toga2)-v_toga(k,it_toga1))
+        w_prof(k) = w_toga(k,it_toga2)
+     :          -frac*(w_toga(k,it_toga2)-w_toga(k,it_toga1))
+        ht_prof(k) = ht_toga(k,it_toga2)
+     :          -frac*(ht_toga(k,it_toga2)-ht_toga(k,it_toga1))
+        vt_prof(k) = vt_toga(k,it_toga2)
+     :          -frac*(vt_toga(k,it_toga2)-vt_toga(k,it_toga1))
+        hq_prof(k) = hq_toga(k,it_toga2)
+     :          -frac*(hq_toga(k,it_toga2)-hq_toga(k,it_toga1))
+        vq_prof(k) = vq_toga(k,it_toga2)
+     :          -frac*(vq_toga(k,it_toga2)-vq_toga(k,it_toga1))
+        enddo
+
+        return
+        END
+
+!======================================================================
+        SUBROUTINE interp_armcu_time(day,day1,annee_ref
+     i             ,year_ini_armcu,day_ini_armcu,nt_armcu,dt_armcu
+     i             ,nlev_armcu,fs_armcu,fl_armcu,at_armcu,rt_armcu
+     i             ,aqt_armcu,fs_prof,fl_prof,at_prof,rt_prof,aqt_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_armcu: total nb of data in the forcing (e.g. 31 for armcu)
+! dt_armcu: total time interval (in sec) between 2 forcing data (e.g. 1/2h for armcu)
+! fs= sensible flux
+! fl= latent flux
+! at,rt,aqt= advective and radiative tendencies
+!---------------------------------------------------------------------------------------
+
+! inputs:
+        integer annee_ref
+        integer nt_armcu,nlev_armcu
+        integer year_ini_armcu
+        real day, day1,day_ini_armcu,dt_armcu
+        real fs_armcu(nt_armcu),fl_armcu(nt_armcu),at_armcu(nt_armcu)
+        real rt_armcu(nt_armcu),aqt_armcu(nt_armcu)
+! outputs:
+        real fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
+! local:
+        integer it_armcu1, it_armcu2,k
+        real timeit,time_armcu1,time_armcu2,frac
+
+! Check that initial day of the simulation consistent with ARMCU period:
+       if (annee_ref.ne.1997 ) then
+        print*,'Pour ARMCU, annee_ref doit etre 1997 '
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+
+      timeit=(day-day_ini_armcu)*86400
+
+! Determine the closest observation times:
+       it_armcu1=INT(timeit/dt_armcu)+1
+       it_armcu2=it_armcu1 + 1
+       time_armcu1=(it_armcu1-1)*dt_armcu
+       time_armcu2=(it_armcu2-1)*dt_armcu
+       print *,'timeit day day_ini_armcu',timeit,day,day_ini_armcu
+       print *,'it_armcu1,it_armcu2,time_armcu1,time_armcu2',
+     .          it_armcu1,it_armcu2,time_armcu1,time_armcu2
+
+       if (it_armcu1 .ge. nt_armcu) then
+        write(*,*) 'PB-stop: day, it_armcu1, it_armcu2, timeit: '
+     :        ,day,it_armcu1,it_armcu2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_armcu2-timeit)/(time_armcu2-time_armcu1)
+       frac=max(frac,0.0)
+
+       fs_prof = fs_armcu(it_armcu2)
+     :          -frac*(fs_armcu(it_armcu2)-fs_armcu(it_armcu1))
+       fl_prof = fl_armcu(it_armcu2)
+     :          -frac*(fl_armcu(it_armcu2)-fl_armcu(it_armcu1))
+       at_prof = at_armcu(it_armcu2)
+     :          -frac*(at_armcu(it_armcu2)-at_armcu(it_armcu1))
+       rt_prof = rt_armcu(it_armcu2)
+     :          -frac*(rt_armcu(it_armcu2)-rt_armcu(it_armcu1))
+       aqt_prof = aqt_armcu(it_armcu2)
+     :          -frac*(aqt_armcu(it_armcu2)-aqt_armcu(it_armcu1))
+
+         print*,
+     :'day,annee_ref,day_ini_armcu,timeit,it_armcu1,it_armcu2,SST:',
+     :day,annee_ref,day_ini_armcu,timeit/86400.,it_armcu1,
+     :it_armcu2,fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
+
+        return
+        END
+
+!=====================================================================
+      subroutine readprofiles(nlev_max,kmax,height,
+     .           thlprof,qtprof,uprof,
+     .           vprof,e12prof,ugprof,vgprof,
+     .           wfls,dqtdxls,dqtdyls,dqtdtls,
+     .           thlpcar)
+      implicit none
+
+        integer nlev_max,kmax,kmax2
+        logical :: llesread = .true.
+
+        real height(nlev_max),thlprof(nlev_max),qtprof(nlev_max),
+     .       uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max),
+     .       ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max),
+     .       dqtdxls(nlev_max),dqtdyls(nlev_max),dqtdtls(nlev_max),
+     .           thlpcar(nlev_max)
+
+        integer, parameter :: ilesfile=1
+        integer :: ierr,irad,imax,jtot,k
+        logical :: lmoist,lcoriol,ltimedep
+        real :: xsize,ysize
+        real :: ustin,wsvsurf,timerad
+        character(80) :: chmess
+
+        if(.not.(llesread)) return
+
+       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        read (ilesfile,*) kmax
+        do k=1,kmax
+          read (ilesfile,*) height(k),thlprof(k),qtprof (k),
+     .                      uprof (k),vprof  (k),e12prof(k)
+        enddo
+        close(ilesfile)
+
+       open(ilesfile,file='lscale.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) stop 'ERROR:Lscale.inp does not exist'
+        read (ilesfile,*) kmax2
+        if (kmax .ne. kmax2) then
+          print *, 'fichiers prof.inp et lscale.inp incompatibles :'
+          print *, 'nbre de niveaux : ',kmax,' et ',kmax2
+          stop 'lecture profiles'
+        endif
+        do k=1,kmax
+          read (ilesfile,*) height(k),ugprof(k),vgprof(k),wfls(k),
+     .                      dqtdxls(k),dqtdyls(k),dqtdtls(k),thlpcar(k)
+        end do
+        close(ilesfile)
+
+        return
+        end
+
+
+!======================================================================
+      subroutine readprofile_armcu(nlev_max,kmax,height,pprof,uprof,
+     .       vprof,thetaprof,tprof,qvprof,rvprof,aprof,bprof)
+!======================================================================
+      implicit none
+
+        integer nlev_max,kmax,kmax2
+        logical :: llesread = .true.
+
+        real height(nlev_max),pprof(nlev_max),tprof(nlev_max),
+     .  thetaprof(nlev_max),rvprof(nlev_max),
+     .  qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max),
+     .  aprof(nlev_max+1),bprof(nlev_max+1)
+
+        integer, parameter :: ilesfile=1
+        integer, parameter :: ifile=2
+        integer :: ierr,irad,imax,jtot,k
+        logical :: lmoist,lcoriol,ltimedep
+        real :: xsize,ysize
+        real :: ustin,wsvsurf,timerad
+        character(80) :: chmess
+
+        if(.not.(llesread)) return
+
+! Read profiles at full levels
+       IF(nlev_max.EQ.19) THEN
+       open (ilesfile,file='prof.inp.19',status='old',iostat=ierr)
+       print *,'On ouvre prof.inp.19'
+       ELSE
+       open (ilesfile,file='prof.inp.40',status='old',iostat=ierr)
+       print *,'On ouvre prof.inp.40'
+       ENDIF
+        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        read (ilesfile,*) kmax
+        do k=1,kmax
+          read (ilesfile,*) height(k)    ,pprof(k),  uprof(k), vprof(k),
+     .                      thetaprof(k) ,tprof(k), qvprof(k),rvprof(k)
+        enddo
+        close(ilesfile)
+
+! Vertical coordinates half levels for eta-coordinates (plev = alpha + beta * psurf) 
+       IF(nlev_max.EQ.19) THEN
+       open (ifile,file='proh.inp.19',status='old',iostat=ierr)
+       print *,'On ouvre proh.inp.19'
+       if (ierr /= 0) stop 'ERROR:Proh.inp.19 does not exist'
+       ELSE
+       open (ifile,file='proh.inp.40',status='old',iostat=ierr)
+       print *,'On ouvre proh.inp.40'
+       if (ierr /= 0) stop 'ERROR:Proh.inp.40 does not exist'
+       ENDIF
+        read (ifile,*) kmax
+        do k=1,kmax
+          read (ifile,*) jtot,aprof(k),bprof(k)
+        enddo
+        close(ifile)
+
+        return
+        end
+!===============================================================
+      function ismin(n,sx,incx)
+
+      implicit none
+      integer n,i,incx,ismin,ix
+      real sx((n-1)*incx+1),sxmin
+
+      ix=1
+      ismin=1
+      sxmin=sx(1)
+      do i=1,n-1
+         ix=ix+incx
+         if(sx(ix).lt.sxmin) then
+             sxmin=sx(ix)
+             ismin=i+1
+         endif
+      enddo
+
+      return
+      end
+
+!===============================================================
+      function ismax(n,sx,incx)
+
+      implicit none
+      integer n,i,incx,ismax,ix
+      real sx((n-1)*incx+1),sxmax
+
+      ix=1
+      ismax=1
+      sxmax=sx(1)
+      do i=1,n-1
+         ix=ix+incx
+         if(sx(ix).gt.sxmax) then
+             sxmax=sx(ix)
+             ismax=i+1
+         endif
+      enddo
+
+      return
+      end
+
Index: LMDZ5/branches/testing/libf/phy1d/1DUTILS.h_with_writelim_old
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/1DUTILS.h_with_writelim_old	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/1DUTILS.h_with_writelim_old	(revision 1665)
@@ -0,0 +1,2647 @@
+!
+! $Id: conf_unicol.F 1279 2010-08-04 17:20:56Z lahellec $
+!
+c
+c
+      SUBROUTINE conf_unicol( tapedef )
+c
+#ifdef CPP_IOIPSL
+      use IOIPSL
+#else
+! if not using IOIPSL, we still need to use (a local version of) getin
+      use ioipsl_getincom
+#endif
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c     Auteurs :   A. Lahellec  .
+c
+c     Arguments :
+c
+c     tapedef   :
+
+       INTEGER tapedef
+c
+c   Declarations :
+c   --------------
+
+#include "compar1d.h"
+#include "flux_arp.h"
+#include "fcg_gcssold.h"
+#include "fcg_racmo.h"
+#include "iniprint.h"
+c
+c
+c   local:
+c   ------
+
+c      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
+      
+c
+c  -------------------------------------------------------------------
+c
+c      .........    Initilisation parametres du lmdz1D      ..........
+c
+c---------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+!Config  Key  = lunout
+!Config  Desc = unite de fichier pour les impressions
+!Config  Def  = 6
+!Config  Help = unite de fichier pour les impressions 
+!Config         (defaut sortie standard = 6)
+      lunout=6
+      CALL getin('lunout', lunout)
+      IF (lunout /= 5 .and. lunout /= 6) THEN
+        OPEN(lunout,FILE='lmdz.out')
+      ENDIF
+
+!Config  Key  = prt_level
+!Config  Desc = niveau d'impressions de débogage
+!Config  Def  = 0
+!Config  Help = Niveau d'impression pour le débogage
+!Config         (0 = minimum d'impression)
+c      prt_level = 0
+c      CALL getin('prt_level',prt_level)
+
+c-----------------------------------------------------------------------
+c  Parametres de controle du run:
+c-----------------------------------------------------------------------
+
+!Config  Key  = restart
+!Config  Desc = on repart des startphy et start1dyn
+!Config  Def  = false
+!Config  Help = les fichiers restart doivent etre renomme en start
+       restart = .FALSE.
+       CALL getin('restart',restart)
+
+!Config  Key  = forcing_type
+!Config  Desc = defines the way the SCM is forced:
+!Config  Def  = 0
+!!Config  Help = 0 ==> forcing_les = .true.
+!             initial profiles from file prof.inp.001
+!             no forcing by LS convergence ; 
+!             surface temperature imposed ;
+!             radiative cooling may be imposed (iflag_radia=0 in physiq.def)
+!         = 1 ==> forcing_radconv = .true.
+!             idem forcing_type = 0, but the imposed radiative cooling 
+!             is set to 0 (hence, if iflag_radia=0 in physiq.def, 
+!             then there is no radiative cooling at all)
+!         = 2 ==> forcing_toga = .true.
+!             initial profiles from TOGA-COARE IFA files 
+!             LS convergence and SST imposed from TOGA-COARE IFA files 
+!         = 3 ==> forcing_GCM2SCM = .true.
+!             initial profiles from the GCM output
+!             LS convergence imposed from the GCM output
+!         = 4 ==> forcing_twpi = .true.
+!             initial profiles from TWPICE nc files 
+!             LS convergence and SST imposed from TWPICE nc files 
+!         = 5 ==> forcing_rico = .true.
+!             initial profiles from RICO idealized
+!             LS convergence imposed from  RICO (cst) 
+!         = 40 ==> forcing_GCSSold = .true.
+!             initial profile from GCSS file
+!             LS convergence imposed from GCSS file
+!
+       forcing_type = 0
+       CALL getin('forcing_type',forcing_type)
+         imp_fcg_gcssold   = .false.
+         ts_fcg_gcssold    = .false.  
+         Tp_fcg_gcssold    = .false.  
+         Tp_ini_gcssold    = .false.  
+         xTurb_fcg_gcssold = .false. 
+        IF (forcing_type .eq.40) THEN
+          CALL getin('imp_fcg',imp_fcg_gcssold)
+          CALL getin('ts_fcg',ts_fcg_gcssold)
+          CALL getin('tp_fcg',Tp_fcg_gcssold)
+          CALL getin('tp_ini',Tp_ini_gcssold)
+          CALL getin('turb_fcg',xTurb_fcg_gcssold)
+        ENDIF
+
+!Config  Key  = ok_flux_surf
+!Config  Desc = forcage ou non par les flux de surface
+!Config  Def  = false
+!Config  Help = forcage ou non par les flux de surface
+       ok_flux_surf = .FALSE.
+       CALL getin('ok_flux_surf',ok_flux_surf)
+
+!Config  Key  = time_ini
+!Config  Desc = meaningless in this  case
+!Config  Def  = 0.
+!Config  Help = 
+       tsurf = 0.
+       CALL getin('time_ini',time_ini)
+
+!Config  Key  = rlat et rlon
+!Config  Desc = latitude et longitude
+!Config  Def  = 0.0  0.0
+!Config  Help = fixe la position de la colonne
+       xlat = 0.
+       xlon = 0.
+       CALL getin('rlat',xlat)
+       CALL getin('rlon',xlon)
+
+!Config  Key  = airephy
+!Config  Desc = Grid cell area
+!Config  Def  = 1.e11
+!Config  Help = 
+       airefi = 1.e11
+       CALL getin('airephy',airefi)
+
+!Config  Key  = nat_surf
+!Config  Desc = surface type
+!Config  Def  = 0 (ocean)
+!Config  Help = 0=ocean,1=land,2=glacier,3=banquise
+       nat_surf = 0.
+       CALL getin('nat_surf',nat_surf)
+
+!Config  Key  = tsurf
+!Config  Desc = surface temperature
+!Config  Def  = 290.
+!Config  Help = not used if type_ts_forcing=1 in lmdz1d.F
+       tsurf = 290.
+       CALL getin('tsurf',tsurf)
+
+!Config  Key  = psurf
+!Config  Desc = surface pressure
+!Config  Def  = 102400.
+!Config  Help = 
+       psurf = 102400.
+       CALL getin('psurf',psurf)
+
+!Config  Key  = zsurf
+!Config  Desc = surface altitude
+!Config  Def  = 0.
+!Config  Help = 
+       zsurf = 0.
+       CALL getin('zsurf',zsurf)
+
+!Config  Key  = rugos
+!Config  Desc = coefficient de frottement
+!Config  Def  = 0.0001
+!Config  Help = calcul du Cdrag
+       rugos = 0.0001
+       CALL getin('rugos',rugos)
+
+!Config  Key  = wtsurf et wqsurf
+!Config  Desc = ???
+!Config  Def  = 0.0 0.0
+!Config  Help = 
+       wtsurf = 0.0
+       wqsurf = 0.0
+       CALL getin('wtsurf',wtsurf)
+       CALL getin('wqsurf',wqsurf)
+
+!Config  Key  = albedo
+!Config  Desc = albedo
+!Config  Def  = 0.09
+!Config  Help = 
+       albedo = 0.09
+       CALL getin('albedo',albedo)
+
+!Config  Key  = agesno
+!Config  Desc = age de la neige
+!Config  Def  = 30.0
+!Config  Help = 
+       xagesno = 30.0
+       CALL getin('agesno',xagesno)
+
+!Config  Key  = restart_runoff
+!Config  Desc = age de la neige
+!Config  Def  = 30.0
+!Config  Help = 
+       restart_runoff = 0.0
+       CALL getin('restart_runoff',restart_runoff)
+
+!Config  Key  = qsolinp
+!Config  Desc = initial bucket water content (kg/m2) when land (5std)
+!Config  Def  = 30.0
+!Config  Help = 
+       qsolinp = 1.
+       CALL getin('qsolinp',qsolinp)
+
+!Config  Key  = zpicinp
+!Config  Desc = denivellation orographie
+!Config  Def  = 300.
+!Config  Help =  input brise
+       zpicinp = 300.
+       CALL getin('zpicinp',zpicinp)
+
+
+      write(lunout,*)' +++++++++++++++++++++++++++++++++++++++'
+      write(lunout,*)' Configuration des parametres du gcm1D: '
+      write(lunout,*)' +++++++++++++++++++++++++++++++++++++++'
+      write(lunout,*)' restart = ', restart
+      write(lunout,*)' forcing_type = ', forcing_type
+      write(lunout,*)' time_ini = ', time_ini
+      write(lunout,*)' rlat = ', xlat
+      write(lunout,*)' rlon = ', xlon
+      write(lunout,*)' airephy = ', airefi
+      write(lunout,*)' nat_surf = ', nat_surf
+      write(lunout,*)' tsurf = ', tsurf
+      write(lunout,*)' psurf = ', psurf
+      write(lunout,*)' zsurf = ', zsurf
+      write(lunout,*)' rugos = ', rugos
+      write(lunout,*)' wtsurf = ', wtsurf
+      write(lunout,*)' wqsurf = ', wqsurf
+      write(lunout,*)' albedo = ', albedo
+      write(lunout,*)' xagesno = ', xagesno
+      write(lunout,*)' restart_runoff = ', restart_runoff
+      write(lunout,*)' qsolinp = ', qsolinp
+      write(lunout,*)' zpicinp = ', zpicinp
+      IF (forcing_type .eq.40) THEN
+        write(lunout,*) '--- Forcing type GCSS Old --- with:'
+        write(lunout,*)'imp_fcg',imp_fcg_gcssold
+        write(lunout,*)'ts_fcg',ts_fcg_gcssold
+        write(lunout,*)'tp_fcg',Tp_fcg_gcssold
+        write(lunout,*)'tp_ini',Tp_ini_gcssold
+        write(lunout,*)'xturb_fcg',xTurb_fcg_gcssold
+      ENDIF
+
+      write(lunout,*)' +++++++++++++++++++++++++++++++++++++++'
+      write(lunout,*)
+c
+      RETURN
+      END
+!
+! $Id: dyn1deta0.F 1279 2010/07/30 A Lahellec$
+!
+c
+      SUBROUTINE dyn1deta0(fichnom,plev,play,phi,phis,presnivs,
+     &                          ucov,vcov,temp,q,omega2)
+      USE dimphy
+      USE mod_grid_phy_lmdz
+      USE mod_phys_lmdz_para
+      USE iophy
+      USE phys_state_var_mod
+      USE iostart
+      USE write_field_phy
+      USE infotrac
+      use control_mod
+
+      IMPLICIT NONE
+c=======================================================
+c Ecriture du fichier de redemarrage sous format NetCDF
+c=======================================================
+c   Declarations:
+c   -------------
+#include "dimensions.h"
+#include "comconst.h"
+#include "temps.h"
+!!#include "control.h"
+#include "logic.h"
+#include "netcdf.inc"
+
+c   Arguments:
+c   ----------
+      CHARACTER*(*) fichnom
+cAl1 plev tronque pour .nc mais plev(klev+1):=0
+      real :: plev(klon,klev),play (klon,klev),phi(klon,klev)
+      real :: presnivs(klon,klev)
+      real :: ucov(klon,klev),vcov(klon,klev),temp(klon,klev)
+      real :: q(klon,klev,nqtot),omega2(klon,klev)
+c      real :: ug(klev),vg(klev),fcoriolis
+      real :: phis(klon) 
+
+c   Variables locales pour NetCDF:
+c   ------------------------------
+      INTEGER nid, nvarid
+      INTEGER idim_s
+      INTEGER ierr, ierr_file 
+      INTEGER iq
+      INTEGER length
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      character*4 nmq(nqtot)
+      character*12 modname
+      character*80 abort_message
+      LOGICAL found
+c
+      INTEGER nb
+
+      modname = 'dyn1deta0 : '
+      nmq(1)="vap"
+      nmq(2)="cond"
+      do iq=3,nqtot
+        write(nmq(iq),'("tra",i1)') iq-2
+      enddo
+      print*,'in dyn1deta0 ',fichnom,klon,klev,nqtot
+      CALL open_startphy(fichnom)
+      print*,'after open startphy ',fichnom,nmq
+
+c
+c Lecture des parametres de controle:
+c
+      CALL get_var("controle",tab_cntrl)
+       
+
+      im         = tab_cntrl(1)
+      jm         = tab_cntrl(2)
+      lllm       = tab_cntrl(3)
+      day_ref    = tab_cntrl(4)
+      annee_ref  = tab_cntrl(5)
+c      rad        = tab_cntrl(6)
+c      omeg       = tab_cntrl(7)
+c      g          = tab_cntrl(8)
+c      cpp        = tab_cntrl(9)
+c      kappa      = tab_cntrl(10)
+c      daysec     = tab_cntrl(11)
+c      dtvr       = tab_cntrl(12)
+c      etot0      = tab_cntrl(13)
+c      ptot0      = tab_cntrl(14)
+c      ztot0      = tab_cntrl(15)
+c      stot0      = tab_cntrl(16)
+c      ang0       = tab_cntrl(17)
+c      pa         = tab_cntrl(18)
+c      preff      = tab_cntrl(19)
+c
+c      clon       = tab_cntrl(20)
+c      clat       = tab_cntrl(21)
+c      grossismx  = tab_cntrl(22)
+c      grossismy  = tab_cntrl(23)
+c
+      IF ( tab_cntrl(24).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(27).EQ.1. ) ysinus = . TRUE. 
+      ENDIF
+
+      day_ini = tab_cntrl(30)
+      itau_dyn = tab_cntrl(31)
+c   .................................................................
+c
+c
+c      PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
+cAl1
+       Print*,'day_ref,annee_ref,day_ini,itau_dyn',
+     &              day_ref,annee_ref,day_ini,itau_dyn
+
+c  Lecture des champs
+c
+      plev(1,klev+1)=0.
+      CALL get_field("plev",plev,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Plev> est absent'
+      CALL get_field("play",play,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Play> est absent'
+      CALL get_field("phi",phi,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Phi> est absent'
+      CALL get_field("phis",phis,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Phis> est absent'
+      CALL get_field("presnivs",presnivs,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Presnivs> est absent'
+      CALL get_field("ucov",ucov,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <ucov> est absent'
+      CALL get_field("vcov",vcov,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <vcov> est absent'
+      CALL get_field("temp",temp,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <temp> est absent'
+      CALL get_field("omega2",omega2,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <omega2> est absent'
+
+      Do iq=1,nqtot
+        CALL get_field("q"//nmq(iq),q(:,:,iq),found)
+        IF (.NOT. found)
+     &  PRINT*, modname//'Le champ <q'//nmq//'> est absent'
+      EndDo
+
+      CALL close_startphy
+      print*,' close startphy'
+     .      ,fichnom,play(1,1),play(1,klev),temp(1,klev)
+c
+      RETURN
+      END
+!
+! $Id: dyn1dredem.F 1279 2010/07/29 A Lahellec$
+!
+c
+      SUBROUTINE dyn1dredem(fichnom,plev,play,phi,phis,presnivs,
+     &                          ucov,vcov,temp,q,omega2)
+      USE dimphy
+      USE mod_grid_phy_lmdz
+      USE mod_phys_lmdz_para
+      USE phys_state_var_mod
+      USE iostart
+      USE infotrac
+      use control_mod
+
+      IMPLICIT NONE
+c=======================================================
+c Ecriture du fichier de redemarrage sous format NetCDF
+c=======================================================
+c   Declarations:
+c   -------------
+#include "dimensions.h"
+#include "comconst.h"
+#include "temps.h"
+!!#include "control.h"
+#include "logic.h"
+#include "netcdf.inc"
+
+c   Arguments:
+c   ----------
+      CHARACTER*(*) fichnom
+      REAL time
+cAl1 plev tronque pour .nc mais plev(klev+1):=0
+      real :: plev(klon,klev),play (klon,klev),phi(klon,klev)
+      real :: presnivs(klon,klev)
+      real :: ucov(klon,klev),vcov(klon,klev),temp(klon,klev)
+      real :: q(klon,klev,nqtot)
+      real :: omega2(klon,klev),rho(klon,klev+1)
+c      real :: ug(klev),vg(klev),fcoriolis
+      real :: phis(klon) 
+
+c   Variables locales pour NetCDF:
+c   ------------------------------
+      INTEGER nid, nvarid
+      INTEGER idim_s
+      INTEGER ierr, ierr_file 
+      INTEGER iq,l
+      INTEGER length
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      character*4 nmq(nqtot)
+      character*20 modname
+      character*80 abort_message
+c
+      INTEGER nb
+      SAVE nb
+      DATA nb / 0 /
+
+      REAL zan0,zjulian,hours
+      INTEGER yyears0,jjour0, mmois0
+      character*30 unites
+
+cDbg
+      CALL open_restartphy(fichnom)
+      print*,'redm1 ',fichnom,klon,klev,nqtot
+      nmq(1)="vap"
+      nmq(2)="cond"
+      nmq(3)="tra1"
+      nmq(4)="tra2"
+
+      modname = 'dyn1dredem'
+      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Pb. d ouverture "//fichnom
+         CALL abort
+      ENDIF
+
+      DO l=1,length
+       tab_cntrl(l) = 0.
+      ENDDO
+       tab_cntrl(1)  = FLOAT(iim)
+       tab_cntrl(2)  = FLOAT(jjm)
+       tab_cntrl(3)  = FLOAT(llm)
+       tab_cntrl(4)  = FLOAT(day_ref)
+       tab_cntrl(5)  = FLOAT(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
+c       tab_cntrl(13) = etot0
+c       tab_cntrl(14) = ptot0
+c       tab_cntrl(15) = ztot0
+c       tab_cntrl(16) = stot0
+c       tab_cntrl(17) = ang0
+c       tab_cntrl(18) = pa
+c       tab_cntrl(19) = preff
+c
+c    .....    parametres  pour le zoom      ......   
+
+c       tab_cntrl(20)  = clon
+c       tab_cntrl(21)  = clat
+c       tab_cntrl(22)  = grossismx
+c       tab_cntrl(23)  = grossismy
+c
+      IF ( fxyhypb )   THEN
+       tab_cntrl(24) = 1.
+c       tab_cntrl(25) = dzoomx
+c       tab_cntrl(26) = dzoomy
+       tab_cntrl(27) = 0.
+c       tab_cntrl(28) = taux
+c       tab_cntrl(29) = tauy
+      ELSE
+       tab_cntrl(24) = 0.
+c       tab_cntrl(25) = dzoomx
+c       tab_cntrl(26) = dzoomy
+       tab_cntrl(27) = 0.
+       tab_cntrl(28) = 0.
+       tab_cntrl(29) = 0.
+       IF( ysinus )  tab_cntrl(27) = 1.
+      ENDIF
+CAl1 iday_end -> day_end
+       tab_cntrl(30) = FLOAT(day_end)
+       tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
+c
+      CALL put_var("controle","Param. de controle Dyn1D",tab_cntrl)
+c
+
+c  Ecriture/extension de la coordonnee temps
+
+      nb = nb + 1
+
+c  Ecriture des champs
+c
+      CALL put_field("plev","p interfaces sauf la nulle",plev)
+      CALL put_field("play","",play)
+      CALL put_field("phi","geopotentielle",phi)
+      CALL put_field("phis","geopotentiell de surface",phis)
+      CALL put_field("presnivs","",presnivs)
+      CALL put_field("ucov","",ucov)
+      CALL put_field("vcov","",vcov)
+      CALL put_field("temp","",temp)
+      CALL put_field("omega2","",omega2)
+
+      Do iq=1,nqtot
+        CALL put_field("q"//nmq(iq),"eau vap ou condens et traceurs",
+     .                                                      q(:,:,iq))
+      EndDo
+      CALL close_restartphy
+
+c
+      RETURN
+      END
+      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
+      IMPLICIT NONE
+!=======================================================================
+!   passage d'un champ de la grille scalaire a la grille physique
+!=======================================================================
+ 
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+ 
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+ 
+      INTEGER i,j,ifield,ig
+ 
+!-----------------------------------------------------------------------
+!   calcul:
+!   -------
+ 
+      DO ifield=1,nfield
+!   traitement des poles
+         DO i=1,im
+            pdyn(i,1,ifield)=pfi(1,ifield)
+            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
+         ENDDO
+ 
+!   traitement des point normaux
+         DO j=2,jm-1
+	    ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
+	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
+         ENDDO
+      ENDDO
+ 
+      RETURN
+      END
+ 
+ 
+
+      SUBROUTINE abort_gcm(modname, message, ierr)
+ 
+      USE IOIPSL
+!
+! Stops the simulation cleanly, closing files and printing various
+! comments
+!
+!  Input: modname = name of calling program
+!         message = stuff to print
+!         ierr    = severity of situation ( = 0 normal )
+ 
+      character*20 modname
+      integer ierr
+      character*80 message
+ 
+      write(*,*) 'in abort_gcm'
+      call histclo
+!     call histclo(2)
+!     call histclo(3)
+!     call histclo(4)
+!     call histclo(5)
+      write(*,*) 'out of histclo'
+      write(*,*) 'Stopping in ', modname
+      write(*,*) 'Reason = ',message
+      call getin_dump
+!
+      if (ierr .eq. 0) then
+        write(*,*) 'Everything is cool'
+      else
+        write(*,*) 'Houston, we have a problem ', ierr
+      endif
+      STOP
+      END
+      REAL FUNCTION q_sat(kelvin, millibar)
+!
+      IMPLICIT none
+!======================================================================
+! Autheur(s): Z.X. Li (LMD/CNRS)
+! Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
+!======================================================================
+! Arguments:
+! kelvin---input-R: temperature en Kelvin
+! millibar--input-R: pression en mb
+!
+! q_sat----output-R: vapeur d'eau saturante en kg/kg
+!======================================================================
+!
+      REAL kelvin, millibar
+!
+      REAL r2es
+      PARAMETER (r2es=611.14 *18.0153/28.9644)
+!
+      REAL r3les, r3ies, r3es
+      PARAMETER (R3LES=17.269)
+      PARAMETER (R3IES=21.875)
+!
+      REAL r4les, r4ies, r4es
+      PARAMETER (R4LES=35.86)
+      PARAMETER (R4IES=7.66)
+!
+      REAL rtt
+      PARAMETER (rtt=273.16)
+!
+      REAL retv
+      PARAMETER (retv=28.9644/18.0153 - 1.0)
+!
+      REAL zqsat
+      REAL temp, pres
+!     ------------------------------------------------------------------
+!
+!
+      temp = kelvin
+      pres = millibar * 100.0
+!      write(*,*)'kelvin,millibar=',kelvin,millibar
+!      write(*,*)'temp,pres=',temp,pres
+!
+      IF (temp .LE. rtt) THEN
+         r3es = r3ies
+         r4es = r4ies
+      ELSE
+         r3es = r3les
+         r4es = r4les
+      ENDIF
+!
+      zqsat=r2es/pres * EXP ( r3es*(temp-rtt) / (temp-r4es) )
+      zqsat=MIN(0.5,ZQSAT)
+      zqsat=zqsat/(1.-retv  *zqsat)
+!
+      q_sat = zqsat
+!
+      RETURN
+      END
+      subroutine scopy(n,sx,incx,sy,incy)
+!
+      IMPLICIT NONE
+!
+      integer n,incx,incy,ix,iy,i
+      real sx((n-1)*incx+1),sy((n-1)*incy+1)
+!
+      iy=1
+      ix=1
+      do 10 i=1,n
+	 sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+!
+      return
+      end
+      subroutine wrgradsfi(if,nl,field,name,titlevar)
+      implicit none
+ 
+!   Declarations
+ 
+#include "gradsdef.h"
+ 
+!   arguments
+      integer if,nl
+      real field(imx*jmx*lmx)
+      character*10 name,file
+      character*10 titlevar
+ 
+!   local
+ 
+      integer im,jm,lm,i,j,l,iv,iii,iji,iif,ijf
+ 
+      logical writectl
+ 
+ 
+      writectl=.false.
+ 
+!     print*,if,iid(if),jid(if),ifd(if),jfd(if)
+      iii=iid(if)
+      iji=jid(if)
+      iif=ifd(if)
+      ijf=jfd(if)
+      im=iif-iii+1
+      jm=ijf-iji+1
+      lm=lmd(if)
+
+
+!     print*,'im,jm,lm,name,firsttime(if)'
+!     print*,im,jm,lm,name,firsttime(if)
+ 
+      if(firsttime(if)) then
+         if(name.eq.var(1,if)) then
+            firsttime(if)=.false.
+            ivar(if)=1
+         print*,'fin de l initialiation de l ecriture du fichier'
+         print*,file
+           print*,'fichier no: ',if
+           print*,'unit ',unit(if)
+           print*,'nvar  ',nvar(if)
+           print*,'vars ',(var(iv,if),iv=1,nvar(if))
+         else
+            ivar(if)=ivar(if)+1
+            nvar(if)=ivar(if)
+            var(ivar(if),if)=name
+            tvar(ivar(if),if)=trim(titlevar)
+            nld(ivar(if),if)=nl
+            print*,'initialisation ecriture de ',var(ivar(if),if)
+            print*,'if ivar(if) nld ',if,ivar(if),nld(ivar(if),if)
+         endif
+         writectl=.true.
+         itime(if)=1
+      else
+         ivar(if)=mod(ivar(if),nvar(if))+1
+         if (ivar(if).eq.nvar(if)) then
+            writectl=.true.
+            itime(if)=itime(if)+1
+         endif
+ 
+         if(var(ivar(if),if).ne.name) then
+           print*,'Il faut stoker la meme succession de champs a chaque'
+           print*,'pas de temps'
+           print*,'fichier no: ',if
+           print*,'unit ',unit(if)
+           print*,'nvar  ',nvar(if)
+           print*,'vars ',(var(iv,if),iv=1,nvar(if))
+ 
+           stop
+         endif
+      endif
+ 
+!     print*,'ivar(if),nvar(if),var(ivar(if),if),writectl'
+!     print*,ivar(if),nvar(if),var(ivar(if),if),writectl
+      do l=1,nl
+         irec(if)=irec(if)+1
+!        print*,'Ecrit rec=',irec(if),iii,iif,iji,ijf,
+!    s (l-1)*imd(if)*jmd(if)+(iji-1)*imd(if)+iii
+!    s ,(l-1)*imd(if)*jmd(if)+(ijf-1)*imd(if)+iif
+         write(unit(if)+1,rec=irec(if))
+     s   ((field((l-1)*imd(if)*jmd(if)+(j-1)*imd(if)+i)
+     s   ,i=iii,iif),j=iji,ijf)
+      enddo
+      if (writectl) then
+ 
+      file=fichier(if)
+!   WARNING! on reecrase le fichier .ctl a chaque ecriture
+      open(unit(if),file=trim(file)//'.ctl',
+     &         form='formatted',status='unknown')
+      write(unit(if),'(a5,1x,a40)')
+     &       'DSET ','^'//trim(file)//'.dat'
+ 
+      write(unit(if),'(a12)') 'UNDEF 1.0E30'
+      write(unit(if),'(a5,1x,a40)') 'TITLE ',title(if)
+      call formcoord(unit(if),im,xd(iii,if),1.,.false.,'XDEF')
+      call formcoord(unit(if),jm,yd(iji,if),1.,.true.,'YDEF')
+      call formcoord(unit(if),lm,zd(1,if),1.,.false.,'ZDEF')
+      write(unit(if),'(a4,i10,a30)')
+     &       'TDEF ',itime(if),' LINEAR 07AUG1998 30MN '
+      write(unit(if),'(a4,2x,i5)') 'VARS',nvar(if)
+      do iv=1,nvar(if)
+!        print*,'if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)'
+!        print*,if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)
+         write(unit(if),1000) var(iv,if),nld(iv,if)-1/nld(iv,if)
+     &     ,99,tvar(iv,if)
+      enddo
+      write(unit(if),'(a7)') 'ENDVARS'
+!
+1000  format(a5,3x,i4,i3,1x,a39)
+ 
+      close(unit(if))
+ 
+      endif ! writectl
+ 
+      return
+ 
+      END
+ 
+      subroutine inigrads(if,im
+     s  ,x,fx,xmin,xmax,jm,y,ymin,ymax,fy,lm,z,fz
+     s  ,dt,file,titlel)
+ 
+ 
+      implicit none
+ 
+      integer if,im,jm,lm,i,j,l
+      real x(im),y(jm),z(lm),fx,fy,fz,dt
+      real xmin,xmax,ymin,ymax
+      integer nf
+ 
+      character file*10,titlel*40
+ 
+#include "gradsdef.h"
+ 
+      data unit/24,32,34,36,38,40,42,44,46,48/
+      data nf/0/
+ 
+      if (if.le.nf) stop'verifier les appels a inigrads'
+ 
+      print*,'Entree dans inigrads'
+ 
+      nf=if
+      title(if)=titlel
+      ivar(if)=0
+ 
+      fichier(if)=trim(file)
+ 
+      firsttime(if)=.true.
+      dtime(if)=dt
+ 
+      iid(if)=1
+      ifd(if)=im
+      imd(if)=im
+      do i=1,im
+         xd(i,if)=x(i)*fx
+         if(xd(i,if).lt.xmin) iid(if)=i+1
+         if(xd(i,if).le.xmax) ifd(if)=i
+      enddo
+      print*,'On stoke du point ',iid(if),'  a ',ifd(if),' en x'
+ 
+      jid(if)=1
+      jfd(if)=jm
+      jmd(if)=jm
+      do j=1,jm
+         yd(j,if)=y(j)*fy
+         if(yd(j,if).gt.ymax) jid(if)=j+1
+         if(yd(j,if).ge.ymin) jfd(if)=j
+      enddo
+      print*,'On stoke du point ',jid(if),'  a ',jfd(if),' en y'
+
+      print*,'Open de dat'
+      print*,'file=',file
+      print*,'fichier(if)=',fichier(if)
+ 
+      print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if))
+      print*,trim(file)//'.dat'
+ 
+      OPEN (unit(if)+1,FILE=trim(file)//'.dat',
+     s   FORM='UNFORMATTED',
+     s   ACCESS='DIRECT'
+     s  ,RECL=4*(ifd(if)-iid(if)+1)*(jfd(if)-jid(if)+1))
+ 
+      print*,'Open de dat ok'
+ 
+      lmd(if)=lm
+      do l=1,lm
+         zd(l,if)=z(l)*fz
+      enddo
+ 
+      irec(if)=0
+!CR 
+!      print*,if,imd(if),jmd(if),lmd(if)
+!      print*,'if,imd(if),jmd(if),lmd(if)'
+ 
+      return
+      end
+      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
+      IMPLICIT NONE
+!=======================================================================
+!   passage d'un champ de la grille scalaire a la grille physique
+!=======================================================================
+ 
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+ 
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+ 
+      INTEGER j,ifield,ig
+ 
+!-----------------------------------------------------------------------
+!   calcul:
+!   -------
+ 
+      IF(ngrid.NE.2+(jm-2)*(im-1).AND.ngrid.NE.1)
+     s    STOP 'probleme de dim'
+!   traitement des poles
+      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
+      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
+ 
+!   traitement des point normaux
+      DO ifield=1,nfield
+         DO j=2,jm-1
+	    ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
+         ENDDO
+      ENDDO
+ 
+      RETURN
+      END
+ 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine writelim
+     s   (phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,phy_ice,
+     s    phy_fter,phy_foce,phy_flic,phy_fsic)
+
+      use dimphy
+      implicit none
+!
+#include "dimensions.h"
+#include "netcdf.inc"
+ 
+      integer klon1d
+      integer k
+      parameter (klon1d=1)
+      REAL phy_nat(klon1d,360)
+      REAL phy_alb(klon1d,360)
+      REAL phy_sst(klon1d,360)
+      REAL phy_bil(klon1d,360)
+      REAL phy_rug(klon1d,360)
+      REAL phy_ice(klon1d,360)
+      REAL phy_fter(klon1d,360)
+      REAL phy_foce(klon1d,360)
+      REAL phy_flic(klon1d,360)
+      REAL phy_fsic(klon1d,360)
+ 
+      INTEGER ierr
+      INTEGER dimfirst(3)
+      INTEGER dimlast(3)
+!
+      INTEGER nid, ndim, ntim
+      INTEGER dims(2), debut(2), epais(2)
+      INTEGER id_tim
+      INTEGER id_NAT, id_SST, id_BILS, id_RUG, id_ALB
+      INTEGER id_FTER,id_FOCE,id_FSIC,id_FLIC
+ 
+      PRINT*, 'Ecriture du fichier limit'
+!
+      ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
+!
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30,
+     .                       "Fichier conditions aux limites")
+      ierr = NF_DEF_DIM (nid, "points_physiques", klon1d, ndim)
+      ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim)
+!
+      dims(1) = ndim
+      dims(2) = ntim
+!
+!cc      ierr = NF_DEF_VAR (nid, "TEMPS", NF_DOUBLE, 1,ntim, id_tim)
+      ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
+      ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
+     .                        "Jour dans l annee")
+!cc      ierr = NF_DEF_VAR (nid, "NAT", NF_DOUBLE, 2,dims, id_NAT)
+      ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
+      ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
+     .                        "Nature du sol (0,1,2,3)")
+!cc      ierr = NF_DEF_VAR (nid, "SST", NF_DOUBLE, 2,dims, id_SST)
+      ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
+      ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
+     .                        "Temperature superficielle de la mer")
+!cc      ierr = NF_DEF_VAR (nid, "BILS", NF_DOUBLE, 2,dims, id_BILS)
+      ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
+      ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
+     .                        "Reference flux de chaleur au sol")
+!cc      ierr = NF_DEF_VAR (nid, "ALB", NF_DOUBLE, 2,dims, id_ALB)
+      ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
+      ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
+     .                        "Albedo a la surface")
+!cc      ierr = NF_DEF_VAR (nid, "RUG", NF_DOUBLE, 2,dims, id_RUG)
+      ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
+      ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
+     .                        "Rugosite")
+
+      ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER)
+      ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 8,"Frac. Terre")
+      ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE)
+      ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 8,"Frac. Terre")
+      ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC)
+      ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 8,"Frac. Terre")
+      ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC)
+      ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 8,"Frac. Terre")
+!
+      ierr = NF_ENDDEF(nid)
+!
+      DO k = 1, 360
+!
+      debut(1) = 1
+      debut(2) = k
+      epais(1) = klon1d
+      epais(2) = 1
+!
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais,phy_nat(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_ALB,debut,epais,phy_alb(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_FTER,debut,epais,phy_fter(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_FOCE,debut,epais,phy_foce(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_FSIC,debut,epais,phy_fsic(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_FLIC,debut,epais,phy_flic(1,k))
+#else
+      ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
+      ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais,phy_nat(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_ALB,debut,epais,phy_alb(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_RUG,debut,epais,phy_rug(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_FTER,debut,epais,phy_fter(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais,phy_foce(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_FSIC,debut,epais,phy_fsic(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_FLIC,debut,epais,phy_flic(1,k))
+
+#endif
+!
+      ENDDO
+!
+      ierr = NF_CLOSE(nid)
+!
+      return
+      end
+ 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
+ 
+!    Auteur :  P. Le Van .
+!
+      IMPLICIT NONE
+ 
+#include "dimensions.h"
+#include "paramet.h"
+!
+!=======================================================================
+!
+!
+!    s = sigma ** kappa   :  coordonnee  verticale
+!    dsig(l)            : epaisseur de la couche l ds la coord.  s
+!    sig(l)             : sigma a l'interface des couches l et l-1
+!    ds(l)              : distance entre les couches l et l-1 en coord.s
+!
+!=======================================================================
+!
+      REAL pa,preff
+      REAL ap(llmp1),bp(llmp1),dpres(llm),nivsigs(llm),nivsig(llmp1)
+      REAL presnivs(llm)
+!
+!   declarations:
+!   -------------
+!
+      REAL sig(llm+1),dsig(llm)
+!
+      INTEGER l
+      REAL snorm
+      REAL alpha,beta,gama,delta,deltaz,h
+      INTEGER np,ierr
+      REAL pi,x
+ 
+!-----------------------------------------------------------------------
+!
+      pi=2.*ASIN(1.)
+ 
+      OPEN(99,file='sigma.def',status='old',form='formatted',
+     s   iostat=ierr)
+ 
+!-----------------------------------------------------------------------
+!   cas 1 on lit les options dans sigma.def:
+!   ----------------------------------------
+ 
+      IF (ierr.eq.0) THEN
+ 
+      print*,'WARNING!!! on lit les options dans sigma.def'
+      READ(99,*) deltaz
+      READ(99,*) h
+      READ(99,*) beta
+      READ(99,*) gama
+      READ(99,*) delta
+      READ(99,*) np
+      CLOSE(99)
+      alpha=deltaz/(llm*h)
+!
+ 
+       DO 1  l = 1, llm
+       dsig(l) = (alpha+(1.-alpha)*exp(-beta*(llm-l)))*
+     $          ( (tanh(gama*l)/tanh(gama*llm))**np +
+     $            (1.-l/FLOAT(llm))*delta )
+   1   CONTINUE
+ 
+       sig(1)=1.
+       DO 101 l=1,llm-1
+          sig(l+1)=sig(l)*(1.-dsig(l))/(1.+dsig(l))
+101    CONTINUE
+       sig(llm+1)=0.
+ 
+       DO 2  l = 1, llm
+       dsig(l) = sig(l)-sig(l+1)
+   2   CONTINUE
+!
+ 
+      ELSE
+!-----------------------------------------------------------------------
+!   cas 2 ancienne discretisation (LMD5...):
+!   ----------------------------------------
+ 
+      PRINT*,'WARNING!!! Ancienne discretisation verticale'
+ 
+      h=7.
+      snorm  = 0.
+      DO l = 1, llm
+         x = 2.*asin(1.) * (FLOAT(l)-0.5) / float(llm+1)
+         dsig(l) = 1.0 + 7.0 * SIN(x)**2
+         snorm = snorm + dsig(l)
+      ENDDO
+      snorm = 1./snorm
+      DO l = 1, llm
+         dsig(l) = dsig(l)*snorm
+      ENDDO
+      sig(llm+1) = 0.
+      DO l = llm, 1, -1
+         sig(l) = sig(l+1) + dsig(l)
+      ENDDO
+ 
+      ENDIF
+ 
+ 
+      DO l=1,llm
+        nivsigs(l) = FLOAT(l)
+      ENDDO
+ 
+      DO l=1,llmp1
+        nivsig(l)= FLOAT(l)
+      ENDDO
+ 
+!
+!    ....  Calculs  de ap(l) et de bp(l)  ....
+!    .........................................
+!
+!
+!   .....  pa et preff sont lus  sur les fichiers start par lectba  .....
+!
+ 
+      bp(llmp1) =   0.
+ 
+      DO l = 1, llm
+!c
+!cc    ap(l) = 0.
+!cc    bp(l) = sig(l)
+ 
+      bp(l) = EXP( 1. -1./( sig(l)*sig(l)) )
+      ap(l) = pa * ( sig(l) - bp(l) )
+!
+      ENDDO
+      ap(llmp1) = pa * ( sig(llmp1) - bp(llmp1) )
+ 
+      PRINT *,' BP '
+      PRINT *,  bp
+      PRINT *,' AP '
+      PRINT *,  ap
+ 
+      DO l = 1, llm
+       dpres(l) = bp(l) - bp(l+1)
+       presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
+      ENDDO
+ 
+      PRINT *,' PRESNIVS '
+      PRINT *,presnivs
+ 
+      RETURN
+      END
+
+!======================================================================
+       SUBROUTINE read_tsurf1d(knon,knindex,sst_out)
+
+! This subroutine specifies the surface temperature to be used in 1D simulations
+
+      USE dimphy, ONLY : klon
+
+      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
+      INTEGER, DIMENSION(klon), INTENT(IN) :: knindex  ! grid point number for compressed grid
+      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
+
+       INTEGER :: i
+! COMMON defined in lmdz1d.F:
+       real ts_cur
+       common /sst_forcing/ts_cur
+
+       DO i = 1, knon
+        sst_out(i) = ts_cur
+       ENDDO
+
+      END SUBROUTINE read_tsurf1d
+
+!===============================================================
+      subroutine advect_vert(llm,w,dt,q,plev)
+!===============================================================
+!   Schema amont pour l'advection verticale en 1D
+!   w est la vitesse verticale dp/dt en Pa/s
+!   Traitement en volumes finis 
+!   d / dt ( zm q ) = delta_z ( omega q )
+!   d / dt ( zm ) = delta_z ( omega )
+!   avec zm = delta_z ( p )
+!   si * designe la valeur au pas de temps t+dt
+!   zm*(l) q*(l) - zm(l) q(l) = w(l+1) q(l+1) - w(l) q(l)
+!   zm*(l) -zm(l) = w(l+1) - w(l)
+!   avec w=omega * dt
+!---------------------------------------------------------------
+      implicit none
+! arguments
+      integer llm
+      real w(llm+1),q(llm),plev(llm+1),dt
+
+! local
+      integer l
+      real zwq(llm+1),zm(llm+1),zw(llm+1)
+      real qold
+
+!---------------------------------------------------------------
+
+      do l=1,llm
+         zw(l)=dt*w(l)
+         zm(l)=plev(l)-plev(l+1)
+         zwq(l)=q(l)*zw(l)
+/      enddo
+      zwq(llm+1)=0.
+      zw(llm+1)=0.
+ 
+      do l=1,llm
+         qold=q(l)
+         q(l)=(q(l)*zm(l)+zwq(l+1)-zwq(l))/(zm(l)+zw(l+1)-zw(l))
+         print*,'ADV Q ',zm(l),zw(l),zwq(l),qold,q(l)
+      enddo
+
+ 
+      return
+      end
+
+!===============================================================
+
+
+       SUBROUTINE advect_va(llm,omega,d_t_va,d_q_va,d_u_va,d_v_va,
+     !                q,temp,u,v,
+     !            play,plev)
+!itlmd 
+!----------------------------------------------------------------------
+!   Calcul de l'advection verticale (ascendance et subsidence) de 
+!   température et d'humidité. Hypothèse : ce qui rentre de l'extérieur
+!   a les mêmes caractéristiques que l'air de la colonne 1D (WTG) ou 
+!   sans WTG rajouter une advection horizontale 
+!----------------------------------------------------------------------  
+        implicit none
+#include "YOMCST.h"
+!        argument
+        integer llm
+        real  omega(llm+1),d_t_va(llm), d_q_va(llm,3)
+        real  d_u_va(llm), d_v_va(llm)
+        real  q(llm,3),temp(llm)
+        real  u(llm),v(llm)
+        real  play(llm),plev(llm+1)
+! interne
+        integer l
+        real alpha,omgdown,omgup
+
+      do l= 1,llm
+       if(l.eq.1) then
+!si omgup pour la couche 1, alors tendance nulle
+        omgdown=max(omega(2),0.0)
+        alpha = rkappa*temp(l)*(1.+q(l,1)*rv/rd)/(play(l)*
+     &           (1.+q(l,1)))
+        d_t_va(l)= alpha*(omgdown)- 
+     &              omgdown*(temp(l)-temp(l+1))
+     &              /(play(l)-play(l+1))              
+
+        d_q_va(l,:)= -omgdown*(q(l,:)-q(l+1,:))
+     &              /(play(l)-play(l+1))              
+
+        d_u_va(l)= -omgdown*(u(l)-u(l+1))
+     &              /(play(l)-play(l+1))              
+        d_v_va(l)= -omgdown*(v(l)-v(l+1))
+     &              /(play(l)-play(l+1))              
+
+        
+       elseif(l.eq.llm) then
+        omgup=min(omega(l),0.0)
+        alpha = rkappa*temp(l)*(1.+q(l,1)*rv/rd)/(play(l)*
+     &           (1.+q(l,1)))
+        d_t_va(l)= alpha*(omgup)- 
+!bug?     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-plev(l))
+     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-play(l))
+        d_q_va(l,:)= -omgup*(q(l-1,:)-q(l,:))/(play(l-1)-play(l))
+        d_u_va(l)= -omgup*(u(l-1)-u(l))/(play(l-1)-play(l))
+        d_v_va(l)= -omgup*(v(l-1)-v(l))/(play(l-1)-play(l))
+       
+       else
+        omgup=min(omega(l),0.0)
+        omgdown=max(omega(l+1),0.0)
+        alpha = rkappa*temp(l)*(1.+q(l,1)*rv/rd)/(play(l)*
+     &           (1.+q(l,1)))
+        d_t_va(l)= alpha*(omgup+omgdown)- 
+     &              omgdown*(temp(l)-temp(l+1))
+     &              /(play(l)-play(l+1))-              
+!bug?     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-plev(l))
+     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-play(l))
+!      print*, '  ??? '
+
+        d_q_va(l,:)= -omgdown*(q(l,:)-q(l+1,:))
+     &              /(play(l)-play(l+1))-              
+     &              omgup*(q(l-1,:)-q(l,:))/(play(l-1)-play(l))
+        d_u_va(l)= -omgdown*(u(l)-u(l+1))
+     &              /(play(l)-play(l+1))-              
+     &              omgup*(u(l-1)-u(l))/(play(l-1)-play(l))
+        d_v_va(l)= -omgdown*(v(l)-v(l+1))
+     &              /(play(l)-play(l+1))-              
+     &              omgup*(v(l-1)-v(l))/(play(l-1)-play(l))
+       
+      endif
+         
+      enddo
+!fin itlmd
+        return
+        end
+!       SUBROUTINE lstendH(llm,omega,d_t_va,d_q_va,d_u_va,d_v_va,
+       SUBROUTINE lstendH(llm,nqtot,omega,d_t_va,d_q_va,
+     !                q,temp,u,v,play)
+!itlmd 
+!----------------------------------------------------------------------
+!   Calcul de l'advection verticale (ascendance et subsidence) de 
+!   température et d'humidité. Hypothèse : ce qui rentre de l'extérieur
+!   a les mêmes caractéristiques que l'air de la colonne 1D (WTG) ou 
+!   sans WTG rajouter une advection horizontale 
+!----------------------------------------------------------------------  
+        implicit none
+#include "YOMCST.h"
+!        argument
+        integer llm,nqtot
+        real  omega(llm+1),d_t_va(llm), d_q_va(llm,nqtot)
+!        real  d_u_va(llm), d_v_va(llm)
+        real  q(llm,nqtot),temp(llm)
+        real  u(llm),v(llm)
+        real  play(llm)
+        real cor(llm)
+!        real dph(llm),dudp(llm),dvdp(llm),dqdp(llm),dtdp(llm)
+        real dph(llm),dqdp(llm),dtdp(llm)
+! interne
+        integer l,k
+        real alpha,omdn,omup
+
+!        dudp=0.
+!        dvdp=0.
+        dqdp=0.
+        dtdp=0.
+!        d_u_va=0.
+!        d_v_va=0.
+
+      cor(:) = rkappa*temp*(1.+q(:,1)*rv/rd)/(play*(1.+q(:,1)))
+
+
+      do k=2,llm-1
+
+       dph  (k-1) = (play(k  )- play(k-1  ))
+!       dudp (k-1) = (u   (k  )- u   (k-1  ))/dph(k-1)
+!       dvdp (k-1) = (v   (k  )- v   (k-1  ))/dph(k-1)
+       dqdp (k-1) = (q   (k,1)- q   (k-1,1))/dph(k-1)
+       dtdp (k-1) = (temp(k  )- temp(k-1  ))/dph(k-1)
+
+      enddo
+
+!      dudp (  llm  ) = dudp ( llm-1 )
+!      dvdp (  llm  ) = dvdp ( llm-1 )
+      dqdp (  llm  ) = dqdp ( llm-1 )
+      dtdp (  llm  ) = dtdp ( llm-1 )
+
+      do k=2,llm-1
+      omdn=max(0.0,omega(k+1))
+      omup=min(0.0,omega( k ))
+
+!      d_u_va(k)  = -omdn*dudp(k)-omup*dudp(k-1)
+!      d_v_va(k)  = -omdn*dvdp(k)-omup*dvdp(k-1)
+      d_q_va(k,1)= -omdn*dqdp(k)-omup*dqdp(k-1)
+      d_t_va(k)  = -omdn*dtdp(k)-omup*dtdp(k-1)
+     :              +(omup+omdn)*cor(k)
+      enddo
+
+      omdn=max(0.0,omega( 2 ))
+      omup=min(0.0,omega(llm))
+!      d_u_va( 1 )   = -omdn*dudp( 1 )
+!      d_u_va(llm)   = -omup*dudp(llm)
+!      d_v_va( 1 )   = -omdn*dvdp( 1 )
+!      d_v_va(llm)   = -omup*dvdp(llm)
+      d_q_va( 1 ,1) = -omdn*dqdp( 1 )
+      d_q_va(llm,1) = -omup*dqdp(llm)
+      d_t_va( 1 )   = -omdn*dtdp( 1 )+omdn*cor( 1 )
+      d_t_va(llm)   = -omup*dtdp(llm)!+omup*cor(llm)
+
+!      if(abs(rlat(1))>10.) then
+!     Calculate the tendency due agestrophic motions
+!      du_age = fcoriolis*(v-vg)
+!      dv_age = fcoriolis*(ug-u)
+!      endif
+
+!       call writefield_phy('d_t_va',d_t_va,llm)
+
+          return
+         end
+
+!======================================================================
+      SUBROUTINE read_togacoare(fich_toga,nlev_toga,nt_toga
+     :             ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga
+     :             ,ht_toga,vt_toga,hq_toga,vq_toga)
+      implicit none
+
+c-------------------------------------------------------------------------
+c Read TOGA-COARE forcing data 
+c-------------------------------------------------------------------------
+
+      integer nlev_toga,nt_toga
+      real ts_toga(nt_toga),plev_toga(nlev_toga,nt_toga)
+      real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
+      real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
+      real w_toga(nlev_toga,nt_toga)
+      real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+      real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+      character*80 fich_toga
+
+      integer no,l,k,ip
+      real riy,rim,rid,rih,bid
+
+      integer iy,im,id,ih
+      
+
+       real plev_min
+
+       plev_min = 55.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
+
+      open(21,file=trim(fich_toga),form='formatted')
+      read(21,'(a)') 
+      do ip = 1, nt_toga
+      read(21,'(a)') 
+      read(21,'(a)') 
+      read(21,223) iy, im, id, ih, bid, ts_toga(ip), bid,bid,bid,bid
+      read(21,'(a)') 
+      read(21,'(a)') 
+
+       do k = 1, nlev_toga
+         read(21,230) plev_toga(k,ip), t_toga(k,ip), q_toga(k,ip) 
+     :       ,u_toga(k,ip), v_toga(k,ip), w_toga(k,ip)
+     :       ,ht_toga(k,ip), vt_toga(k,ip), hq_toga(k,ip), vq_toga(k,ip)
+
+! conversion in SI units:
+         t_toga(k,ip)=t_toga(k,ip)+273.15     ! K
+         q_toga(k,ip)=q_toga(k,ip)*0.001      ! kg/kg
+         w_toga(k,ip)=w_toga(k,ip)*100./3600. ! Pa/s
+! no water vapour tendency above 55 hPa
+         if (plev_toga(k,ip) .lt. plev_min) then
+          q_toga(k,ip) = 0.
+          hq_toga(k,ip) = 0.
+          vq_toga(k,ip) =0.
+         endif
+       enddo
+
+         ts_toga(ip)=ts_toga(ip)+273.15       ! K
+       enddo
+       close(21)
+
+  223 format(4i3,6f8.2)
+  226 format(f7.1,1x,10f8.2)
+  227 format(f7.1,1x,1p,4e11.3)
+  230 format(6f9.3,4e11.3)
+
+          return
+          end
+       end
+
+!=====================================================================
+      subroutine read_twpice(fich_twpice,nlevel,ntime
+     :     ,T_srf,plev,T,q,u,v,omega
+     :     ,T_adv_h,T_adv_v,q_adv_h,q_adv_v)
+
+!program reading forcings of the TWP-ICE experiment
+
+!      use netcdf
+
+      implicit none
+
+#include "netcdf.inc"
+
+      integer ntime,nlevel
+      integer l,k
+      character*80 :: fich_twpice
+      real*8 time(ntime)
+      real*8 lat, lon, alt, phis	
+      real*8 lev(nlevel)
+      real*8 plev(nlevel,ntime)
+
+      real*8 T(nlevel,ntime)
+      real*8 q(nlevel,ntime),u(nlevel,ntime)
+      real*8 v(nlevel,ntime)
+      real*8 omega(nlevel,ntime), div(nlevel,ntime)
+      real*8 T_adv_h(nlevel,ntime)
+      real*8 T_adv_v(nlevel,ntime), q_adv_h(nlevel,ntime)
+      real*8 q_adv_v(nlevel,ntime)	
+      real*8 s(nlevel,ntime), s_adv_h(nlevel,ntime)
+      real*8 s_adv_v(nlevel,ntime)
+      real*8 p_srf_aver(ntime), p_srf_center(ntime)
+      real*8 T_srf(ntime)
+
+      integer nid, ierr
+      integer nbvar3d
+      parameter(nbvar3d=20)
+      integer var3didin(nbvar3d)
+
+      ierr = NF_OPEN(fich_twpice,NF_NOWRITE,nid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: Pb opening forcings cdf file '
+         write(*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+      ierr=NF_INQ_VARID(nid,"lat",var3didin(1))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lat'
+         endif
+      
+       ierr=NF_INQ_VARID(nid,"lon",var3didin(2))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lon'
+         endif
+
+       ierr=NF_INQ_VARID(nid,"alt",var3didin(3))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'alt'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"phis",var3didin(4))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'phis'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T",var3didin(5))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q",var3didin(6))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"u",var3didin(7))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'u'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"v",var3didin(8))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"omega",var3didin(9))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'omega'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"div",var3didin(10))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'div'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_adv_h",var3didin(11))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_adv_h'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_adv_v",var3didin(12))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q_adv_h",var3didin(13))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q_adv_h'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q_adv_v",var3didin(14))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"s",var3didin(15))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"s_adv_h",var3didin(16))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's_adv_h'
+         endif
+    
+      ierr=NF_INQ_VARID(nid,"s_adv_v",var3didin(17))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"p_srf_aver",var3didin(18))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'p_srf_aver'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"p_srf_center",var3didin(19))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'p_srf_center'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_srf",var3didin(20))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_srf'
+         endif
+
+!dimensions lecture
+      call catchaxis(nid,ntime,nlevel,time,lev,ierr)
+
+!pressure 
+       do l=1,ntime
+       do k=1,nlevel
+          plev(k,l)=lev(k)
+       enddo
+       enddo
+          
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),lat)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(1),lat)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture lat ok',lat
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),lon)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(2),lon)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture lon ok',lon
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),alt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(3),alt)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture alt ok',alt
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),phis)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(4),phis)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture phis ok',phis
+          
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),T)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(5),T)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),q)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(6),q)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q ok'
+!q in kg/kg
+       do l=1,ntime
+       do k=1,nlevel
+          q(k,l)=q(k,l)/1000.
+       enddo
+       enddo
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),u)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(7),u)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture u ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(8),v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture v ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),omega)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(9),omega)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture omega ok'
+!omega in mb/hour
+       do l=1,ntime
+       do k=1,nlevel
+          omega(k,l)=omega(k,l)*100./3600.
+       enddo
+       enddo
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),div)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(10),div)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture div ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),T_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(11),T_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_adv_h ok'
+!T adv in K/s
+       do l=1,ntime
+       do k=1,nlevel
+          T_adv_h(k,l)=T_adv_h(k,l)/3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),T_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(12),T_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_adv_v ok'
+!T adv in K/s
+       do l=1,ntime
+       do k=1,nlevel
+          T_adv_v(k,l)=T_adv_v(k,l)/3600.
+       enddo
+       enddo
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),q_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(13),q_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q_adv_h ok'
+!q adv in kg/kg/s
+       do l=1,ntime
+       do k=1,nlevel
+          q_adv_h(k,l)=q_adv_h(k,l)/1000./3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),q_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(14),q_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q_adv_v ok'
+!q adv in kg/kg/s
+       do l=1,ntime
+       do k=1,nlevel
+          q_adv_v(k,l)=q_adv_v(k,l)/1000./3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),s)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(15),s)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),s_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(16),s_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(17),s_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(17),s_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(18),p_srf_aver)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(18),p_srf_aver)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(19),p_srf_center)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(19),p_srf_center)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(20),T_srf)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(20),T_srf)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_srf ok', T_srf
+
+         return 
+         end subroutine read_twpice
+!=====================================================================
+         subroutine catchaxis(nid,ttm,llm,time,lev,ierr)
+
+!         use netcdf
+
+         implicit none
+#include "netcdf.inc"
+         integer nid,ttm,llm
+         real*8 time(ttm)
+         real*8 lev(llm)
+         integer ierr
+
+         integer i
+         integer timevar,levvar
+         integer timelen,levlen
+         integer timedimin,levdimin
+
+! Control & lecture on dimensions
+! ===============================
+         ierr=NF_INQ_DIMID(nid,"time",timedimin)
+         ierr=NF_INQ_VARID(nid,"time",timevar)
+         if (ierr.NE.NF_NOERR) then
+            write(*,*) 'ERROR: Field <time> is missing'
+            stop ""  
+         endif
+         ierr=NF_INQ_DIMLEN(nid,timedimin,timelen)
+
+         ierr=NF_INQ_DIMID(nid,"lev",levdimin)
+         ierr=NF_INQ_VARID(nid,"lev",levvar)
+         if (ierr.NE.NF_NOERR) then
+             write(*,*) 'ERROR: Field <lev> is lacking'
+             stop "" 
+         endif
+         ierr=NF_INQ_DIMLEN(nid,levdimin,levlen)
+
+         if((timelen/=ttm).or.(levlen/=llm)) then
+            write(*,*) 'ERROR: Not the good lenght for axis'
+            write(*,*) 'longitude: ',timelen,ttm+1
+            write(*,*) 'latitude: ',levlen,llm
+            stop ""  
+         endif
+
+!#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,timevar,time)
+         ierr = NF_GET_VAR_DOUBLE(nid,levvar,lev)
+!#else
+!        ierr = NF_GET_VAR_REAL(nid,timevar,time)
+!        ierr = NF_GET_VAR_REAL(nid,levvar,lev)
+!#endif
+
+       return
+
+!======================================================================
+      SUBROUTINE read_rico(fich_rico,nlev_rico,ps_rico,play
+     :             ,ts_rico,t_rico,q_rico,u_rico,v_rico,w_rico
+     :             ,dth_dyn,dqh_dyn)
+      implicit none
+
+c-------------------------------------------------------------------------
+c Read RICO forcing data 
+c-------------------------------------------------------------------------
+#include "dimensions.h"
+
+
+      integer nlev_rico
+      real ts_rico,ps_rico
+      real t_rico(llm),q_rico(llm)
+      real u_rico(llm),v_rico(llm)
+      real w_rico(llm)
+      real dth_dyn(llm)
+      real dqh_dyn(llm)
+      
+
+      real play(llm),zlay(llm)
+     
+
+      real prico(nlev_rico),zrico(nlev_rico)
+
+      character*80 fich_rico
+
+      integer k,l
+
+      
+      print*,fich_rico
+      open(21,file=trim(fich_rico),form='formatted')
+        do k=1,llm
+      zlay(k)=0.
+         enddo
+      
+        read(21,*) ps_rico,ts_rico
+        prico(1)=ps_rico
+        zrico(1)=0.0
+      do l=2,nlev_rico
+        read(21,*) k,prico(l),zrico(l)
+      enddo
+       close(21)
+
+      do k=1,llm
+        do l=1,80
+          if(prico(l)>play(k)) then
+              if(play(k)>prico(l+1)) then
+                zlay(k)=zrico(l)+(play(k)-prico(l)) * 
+     &              (zrico(l+1)-zrico(l))/(prico(l+1)-prico(l))
+              else
+                zlay(k)=zrico(l)+(play(k)-prico(80))* 
+     &              (zrico(81)-zrico(80))/(prico(81)-prico(80))
+              endif
+          endif
+        enddo
+        print*,k,zlay(k)
+        ! U
+        if(0 < zlay(k) .and. zlay(k) < 4000) then
+          u_rico(k)=-9.9 + (-1.9 + 9.9)*zlay(k)/4000
+        elseif(4000 < zlay(k) .and. zlay(k) < 12000) then
+       u_rico(k)=  -1.9 + (30.0 + 1.9) / 
+     :          (12000 - 4000) * (zlay(k) - 4000)
+        elseif(12000 < zlay(k) .and. zlay(k) < 13000) then
+          u_rico(k)=30.0
+        elseif(13000 < zlay(k) .and. zlay(k) < 20000) then
+          u_rico(k)=30.0 - (30.0) / 
+     : (20000 - 13000) * (zlay(k) - 13000)
+        else
+          u_rico(k)=0.0
+        endif
+
+!Q_v
+        if(0 < zlay(k) .and. zlay(k) < 740) then
+          q_rico(k)=16.0 + (13.8 - 16.0) / (740) * zlay(k)
+        elseif(740 < zlay(k) .and. zlay(k) < 3260) then
+          q_rico(k)=13.8 + (2.4 - 13.8) / 
+     :          (3260 - 740) * (zlay(k) - 740)
+        elseif(3260 < zlay(k) .and. zlay(k) < 4000) then
+          q_rico(k)=2.4 + (1.8 - 2.4) / 
+     :               (4000 - 3260) * (zlay(k) - 3260)
+        elseif(4000 < zlay(k) .and. zlay(k) < 9000) then
+          q_rico(k)=1.8 + (0 - 1.8) / 
+     :             (10000 - 4000) * (zlay(k) - 4000)
+        else
+          q_rico(k)=0.0
+        endif
+
+!T
+        if(0 < zlay(k) .and. zlay(k) < 740) then
+          t_rico(k)=299.2 + (292.0 - 299.2) / (740) * zlay(k)
+        elseif(740 < zlay(k) .and. zlay(k) < 4000) then
+          t_rico(k)=292.0 + (278.0 - 292.0) /
+     :       (4000 - 740) * (zlay(k) - 740)
+        elseif(4000 < zlay(k) .and. zlay(k) < 15000) then
+          t_rico(k)=278.0 + (203.0 - 278.0) /
+     :       (15000 - 4000) * (zlay(k) - 4000)
+        elseif(15000 < zlay(k) .and. zlay(k) < 17500) then
+          t_rico(k)=203.0 + (194.0 - 203.0) / 
+     :       (17500 - 15000)* (zlay(k) - 15000)
+        elseif(17500 < zlay(k) .and. zlay(k) < 20000) then
+          t_rico(k)=194.0 + (206.0 - 194.0) /
+     :       (20000 - 17500)* (zlay(k) - 17500)
+        elseif(20000 < zlay(k) .and. zlay(k) < 60000) then
+          t_rico(k)=206.0 + (270.0 - 206.0) / 
+     :        (60000 - 20000)* (zlay(k) - 20000)
+        endif
+
+! W
+        if(0 < zlay(k) .and. zlay(k) < 2260 ) then
+          w_rico(k)=- (0.005/2260) * zlay(k)
+        elseif(2260 < zlay(k) .and. zlay(k) < 4000 ) then
+          w_rico(k)=- 0.005
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000 ) then
+       w_rico(k)=- 0.005 + (0.005/ (5000 - 4000)) * (zlay(k) - 4000)
+        else
+          w_rico(k)=0.0
+        endif
+
+! dThrz+dTsw0+dTlw0
+        if(0 < zlay(k) .and. zlay(k) < 4000) then
+          dth_dyn(k)=- 2.51 / 86400 + (-2.18 + 2.51 )/ 
+     :               (86400*4000) * zlay(k)
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000) then
+          dth_dyn(k)=- 2.18 / 86400 + ( 2.18 ) /
+     :           (86400*(5000 - 4000)) * (zlay(k) - 4000)
+        else
+          dth_dyn(k)=0.0
+        endif
+! dQhrz
+        if(0 < zlay(k) .and. zlay(k) < 3000) then
+          dqh_dyn(k)=-1.0 / 86400 + (0.345 + 1.0)/
+     :                    (86400*3000) * (zlay(k))
+        elseif(3000 < zlay(k) .and. zlay(k) < 4000) then
+          dqh_dyn(k)=0.345 / 86400
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000) then
+          dqh_dyn(k)=0.345 / 86400 + 
+     +   (-0.345)/(86400 * (5000 - 4000)) * (zlay(k)-4000)
+        else
+          dqh_dyn(k)=0.0
+        endif
+
+!?        if(play(k)>6e4) then
+!?          ratqs0(1,k)=ratqsbas*(plev(1)-play(k))/(plev(1)-6e4)
+!?        elseif((play(k)>3e4).and.(play(k)<6e4)) then
+!?          ratqs0(1,k)=ratqsbas+(ratqshaut-ratqsbas)&
+!?                          *(6e4-play(k))/(6e4-3e4)
+!?        else
+!?          ratqs0(1,k)=ratqshaut
+!?        endif
+
+      enddo
+
+      do k=1,llm
+      q_rico(k)=q_rico(k)/1e3 
+      dqh_dyn(k)=dqh_dyn(k)/1e3
+      v_rico(k)=-3.8
+      enddo
+
+          return
+          end
+
+!=====================================================================
+c-------------------------------------------------------------------------
+      SUBROUTINE read_armcu(fich_armcu,nlev_armcu,nt_armcu,
+     : sens,flat,adv_theta,rad_theta,adv_qt)
+      implicit none
+
+c-------------------------------------------------------------------------
+c Read ARM_CU case forcing data
+c-------------------------------------------------------------------------
+
+      integer nlev_armcu,nt_armcu
+      real sens(nt_armcu),flat(nt_armcu)
+      real adv_theta(nt_armcu),rad_theta(nt_armcu),adv_qt(nt_armcu)
+      character*80 fich_armcu
+
+      integer no,l,k,ip
+      real riy,rim,rid,rih,bid
+
+      integer iy,im,id,ih,in
+
+      open(21,file=trim(fich_armcu),form='formatted')
+      read(21,'(a)')
+      do ip = 1, nt_armcu
+      read(21,'(a)')
+      read(21,'(a)')
+      read(21,223) iy, im, id, ih, in, sens(ip),flat(ip),
+     :             adv_theta(ip),rad_theta(ip),adv_qt(ip)
+      print *,'forcages=',iy,im,id,ih,in, sens(ip),flat(ip),
+     :             adv_theta(ip),rad_theta(ip),adv_qt(ip)
+      enddo
+      close(21)
+
+  223 format(5i3,5f8.3)
+  226 format(f7.1,1x,10f8.2)
+  227 format(f7.1,1x,1p,4e11.3)
+  230 format(6f9.3,4e11.3)
+
+          return
+          end
+
+!=====================================================================
+       SUBROUTINE interp_toga_vertical(play,nlev_toga,plev_prof
+     :         ,t_prof,q_prof,u_prof,v_prof,w_prof
+     :         ,ht_prof,vt_prof,hq_prof,vq_prof
+     :         ,t_mod,q_mod,u_mod,v_mod,w_mod
+     :         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+ 
+       implicit none
+ 
+#include "dimensions.h"
+
+c-------------------------------------------------------------------------
+c Vertical interpolation of TOGA-COARE forcing data onto model levels
+c-------------------------------------------------------------------------
+ 
+       integer nlevmax
+       parameter (nlevmax=41)
+       integer nlev_toga,mxcalc
+!       real play(llm), plev_prof(nlevmax) 
+!       real t_prof(nlevmax),q_prof(nlevmax)
+!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
+!       real ht_prof(nlevmax),vt_prof(nlevmax)
+!       real hq_prof(nlevmax),vq_prof(nlevmax)
+ 
+       real play(llm), plev_prof(nlev_toga) 
+       real t_prof(nlev_toga),q_prof(nlev_toga)
+       real u_prof(nlev_toga),v_prof(nlev_toga), w_prof(nlev_toga)
+       real ht_prof(nlev_toga),vt_prof(nlev_toga)
+       real hq_prof(nlev_toga),vq_prof(nlev_toga)
+ 
+       real t_mod(llm),q_mod(llm)
+       real u_mod(llm),v_mod(llm), w_mod(llm)
+       real ht_mod(llm),vt_mod(llm)
+       real hq_mod(llm),vq_mod(llm)
+ 
+       integer l,k,k1,k2,kp
+       real aa,frac,frac1,frac2,fact
+ 
+       do l = 1, llm
+
+        if (play(l).ge.plev_prof(nlev_toga)) then
+ 
+        mxcalc=l
+         k1=0
+         k2=0
+
+         if (play(l).le.plev_prof(1)) then
+
+         do k = 1, nlev_toga-1
+          if (play(l).le.plev_prof(k) 
+     :       .and. play(l).gt.plev_prof(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,play(l) = ',l,play(l)/100
+         do k = 1, nlev_toga-1
+          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
+         t_mod(l)= t_prof(k2) - frac*(t_prof(k2)-t_prof(k1))
+         q_mod(l)= q_prof(k2) - frac*(q_prof(k2)-q_prof(k1))
+         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
+         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
+         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
+         ht_mod(l)= ht_prof(k2) - frac*(ht_prof(k2)-ht_prof(k1))
+         vt_mod(l)= vt_prof(k2) - frac*(vt_prof(k2)-vt_prof(k1))
+         hq_mod(l)= hq_prof(k2) - frac*(hq_prof(k2)-hq_prof(k1))
+         vq_mod(l)= vq_prof(k2) - frac*(vq_prof(k2)-vq_prof(k1))
+     
+         else !play>plev_prof(1)
+
+         k1=1
+         k2=2
+         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
+         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
+         t_mod(l)= frac1*t_prof(k1) - frac2*t_prof(k2)
+         q_mod(l)= frac1*q_prof(k1) - frac2*q_prof(k2)
+         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
+         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
+         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
+         ht_mod(l)= frac1*ht_prof(k1) - frac2*ht_prof(k2)
+         vt_mod(l)= frac1*vt_prof(k1) - frac2*vt_prof(k2)
+         hq_mod(l)= frac1*hq_prof(k1) - frac2*hq_prof(k2)
+         vq_mod(l)= frac1*vq_prof(k1) - frac2*vq_prof(k2)
+
+         endif ! play.le.plev_prof(1)
+
+        else ! above max altitude of forcing file
+ 
+cjyg
+         fact=20.*(plev_prof(nlev_toga)-play(l))/plev_prof(nlev_toga) !jyg
+         fact = max(fact,0.)                                           !jyg
+         fact = exp(-fact)                                             !jyg
+         t_mod(l)= t_prof(nlev_toga)                                   !jyg
+         q_mod(l)= q_prof(nlev_toga)*fact                              !jyg
+         u_mod(l)= u_prof(nlev_toga)*fact                              !jyg
+         v_mod(l)= v_prof(nlev_toga)*fact                              !jyg
+         w_mod(l)= 0.0                                                 !jyg
+         ht_mod(l)= ht_prof(nlev_toga)                                 !jyg
+         vt_mod(l)= vt_prof(nlev_toga)                                 !jyg
+         hq_mod(l)= hq_prof(nlev_toga)*fact                            !jyg
+         vq_mod(l)= vq_prof(nlev_toga)*fact                            !jyg
+ 
+        endif ! play
+ 
+       enddo ! l
+
+!       do l = 1,llm
+!       print *,'t_mod(l),q_mod(l),ht_mod(l),hq_mod(l) ',
+!     $        l,t_mod(l),q_mod(l),ht_mod(l),hq_mod(l)
+!       enddo
+ 
+          return
+          end
+ 
+!======================================================================
+        SUBROUTINE interp_toga_time(day,day1,annee_ref
+     i             ,year_ini_toga,day_ini_toga,nt_toga,dt_toga,nlev_toga
+     i             ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga
+     i             ,ht_toga,vt_toga,hq_toga,vq_toga
+     o             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof
+     o             ,ht_prof,vt_prof,hq_prof,vq_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_toga: total nb of data in the forcing (e.g. 480 for TOGA-COARE)
+! dt_toga: total time interval (in sec) between 2 forcing data (e.g. 6h for TOGA-COARE)
+!---------------------------------------------------------------------------------------
+
+#include "compar1d.h"
+
+! inputs:
+        integer annee_ref
+        integer nt_toga,nlev_toga
+        integer year_ini_toga
+        real day, day1,day_ini_toga,dt_toga
+        real ts_toga(nt_toga)
+        real plev_toga(nlev_toga,nt_toga),t_toga(nlev_toga,nt_toga)
+        real q_toga(nlev_toga,nt_toga),u_toga(nlev_toga,nt_toga)
+        real v_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
+        real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+        real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+! outputs:
+        real ts_prof
+        real plev_prof(nlev_toga),t_prof(nlev_toga)
+        real q_prof(nlev_toga),u_prof(nlev_toga)
+        real v_prof(nlev_toga),w_prof(nlev_toga)
+        real ht_prof(nlev_toga),vt_prof(nlev_toga)
+        real hq_prof(nlev_toga),vq_prof(nlev_toga)
+! local:
+        integer it_toga1, it_toga2,k
+        real timeit,time_toga1,time_toga2,frac
+
+
+        if (forcing_type.eq.2) then
+! Check that initial day of the simulation consistent with TOGA-COARE period:
+       if (annee_ref.ne.1992 .and. annee_ref.ne.1993) then
+        print*,'Pour TOGA-COARE, annee_ref doit etre 1992 ou 1993'
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.1992 .and. day1.lt.day_ini_toga) then
+        print*,'TOGA-COARE a débuté le 1er Nov 1992 (jour julien=306)'
+        print*,'Changer dayref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.1993 .and. day1.gt.day_ini_toga+119) then
+        print*,'TOGA-COARE a fini le 28 Feb 1993 (jour julien=59)'
+        print*,'Changer dayref ou nday dans run.def'
+        stop
+       endif
+
+       else if (forcing_type.eq.4) then
+
+! Check that initial day of the simulation consistent with TWP-ICE period:
+       if (annee_ref.ne.2006) then
+        print*,'Pour TWP-ICE, annee_ref doit etre 2006'
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.2006 .and. day1.lt.day_ini_toga) then
+        print*,'TWP-ICE a debute le 17 Jan 2006 (jour julien=17)'
+        print*,'Changer dayref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.2006 .and. day1.gt.day_ini_toga+26) then
+        print*,'TWP-ICE a fini le 12 Feb 2006 (jour julien=43)'
+        print*,'Changer dayref ou nday dans run.def'
+        stop
+       endif
+
+       endif
+
+! Determine timestep relative to the 1st day of TOGA-COARE:
+!       timeit=(day-day1)*86400.
+!       if (annee_ref.eq.1992) then
+!        timeit=(day-day_ini_toga)*86400.
+!       else
+!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
+!       endif
+      timeit=(day-day_ini_toga)*86400
+
+! Determine the closest observation times:
+       it_toga1=INT(timeit/dt_toga)+1
+       it_toga2=it_toga1 + 1
+       time_toga1=(it_toga1-1)*dt_toga
+       time_toga2=(it_toga2-1)*dt_toga
+
+       if (it_toga1 .ge. nt_toga) then
+        write(*,*) 'PB-stop: day, it_toga1, it_toga2, timeit: '
+     :        ,day,it_toga1,it_toga2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_toga2-timeit)/(time_toga2-time_toga1)
+       frac=max(frac,0.0)
+
+       ts_prof = ts_toga(it_toga2)
+     :          -frac*(ts_toga(it_toga2)-ts_toga(it_toga1))
+
+!        print*,
+!     :'day,annee_ref,day_ini_toga,timeit,it_toga1,it_toga2,SST:',
+!     :day,annee_ref,day_ini_toga,timeit/86400.,it_toga1,it_toga2,ts_prof
+
+       do k=1,nlev_toga
+        plev_prof(k) = 100.*(plev_toga(k,it_toga2)
+     :          -frac*(plev_toga(k,it_toga2)-plev_toga(k,it_toga1)))
+        t_prof(k) = t_toga(k,it_toga2)
+     :          -frac*(t_toga(k,it_toga2)-t_toga(k,it_toga1))
+        q_prof(k) = q_toga(k,it_toga2)
+     :          -frac*(q_toga(k,it_toga2)-q_toga(k,it_toga1))
+        u_prof(k) = u_toga(k,it_toga2)
+     :          -frac*(u_toga(k,it_toga2)-u_toga(k,it_toga1))
+        v_prof(k) = v_toga(k,it_toga2)
+     :          -frac*(v_toga(k,it_toga2)-v_toga(k,it_toga1))
+        w_prof(k) = w_toga(k,it_toga2)
+     :          -frac*(w_toga(k,it_toga2)-w_toga(k,it_toga1))
+        ht_prof(k) = ht_toga(k,it_toga2)
+     :          -frac*(ht_toga(k,it_toga2)-ht_toga(k,it_toga1))
+        vt_prof(k) = vt_toga(k,it_toga2)
+     :          -frac*(vt_toga(k,it_toga2)-vt_toga(k,it_toga1))
+        hq_prof(k) = hq_toga(k,it_toga2)
+     :          -frac*(hq_toga(k,it_toga2)-hq_toga(k,it_toga1))
+        vq_prof(k) = vq_toga(k,it_toga2)
+     :          -frac*(vq_toga(k,it_toga2)-vq_toga(k,it_toga1))
+        enddo
+
+        return
+        END
+
+!======================================================================
+        SUBROUTINE interp_armcu_time(day,day1,annee_ref
+     i             ,year_ini_armcu,day_ini_armcu,nt_armcu,dt_armcu
+     i             ,nlev_armcu,fs_armcu,fl_armcu,at_armcu,rt_armcu
+     i             ,aqt_armcu,fs_prof,fl_prof,at_prof,rt_prof,aqt_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_armcu: total nb of data in the forcing (e.g. 31 for armcu)
+! dt_armcu: total time interval (in sec) between 2 forcing data (e.g. 1/2h for armcu)
+! fs= sensible flux
+! fl= latent flux
+! at,rt,aqt= advective and radiative tendencies
+!---------------------------------------------------------------------------------------
+
+! inputs:
+        integer annee_ref
+        integer nt_armcu,nlev_armcu
+        integer year_ini_armcu
+        real day, day1,day_ini_armcu,dt_armcu
+        real fs_armcu(nt_armcu),fl_armcu(nt_armcu),at_armcu(nt_armcu)
+        real rt_armcu(nt_armcu),aqt_armcu(nt_armcu)
+! outputs:
+        real fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
+! local:
+        integer it_armcu1, it_armcu2,k
+        real timeit,time_armcu1,time_armcu2,frac
+
+! Check that initial day of the simulation consistent with ARMCU period:
+       if (annee_ref.ne.1997 ) then
+        print*,'Pour ARMCU, annee_ref doit etre 1997 '
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+
+      timeit=(day-day_ini_armcu)*86400
+
+! Determine the closest observation times:
+       it_armcu1=INT(timeit/dt_armcu)+1
+       it_armcu2=it_armcu1 + 1
+       time_armcu1=(it_armcu1-1)*dt_armcu
+       time_armcu2=(it_armcu2-1)*dt_armcu
+       print *,'timeit day day_ini_armcu',timeit,day,day_ini_armcu
+       print *,'it_armcu1,it_armcu2,time_armcu1,time_armcu2',
+     .          it_armcu1,it_armcu2,time_armcu1,time_armcu2
+
+       if (it_armcu1 .ge. nt_armcu) then
+        write(*,*) 'PB-stop: day, it_armcu1, it_armcu2, timeit: '
+     :        ,day,it_armcu1,it_armcu2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_armcu2-timeit)/(time_armcu2-time_armcu1)
+       frac=max(frac,0.0)
+
+       fs_prof = fs_armcu(it_armcu2)
+     :          -frac*(fs_armcu(it_armcu2)-fs_armcu(it_armcu1))
+       fl_prof = fl_armcu(it_armcu2)
+     :          -frac*(fl_armcu(it_armcu2)-fl_armcu(it_armcu1))
+       at_prof = at_armcu(it_armcu2)
+     :          -frac*(at_armcu(it_armcu2)-at_armcu(it_armcu1))
+       rt_prof = rt_armcu(it_armcu2)
+     :          -frac*(rt_armcu(it_armcu2)-rt_armcu(it_armcu1))
+       aqt_prof = aqt_armcu(it_armcu2)
+     :          -frac*(aqt_armcu(it_armcu2)-aqt_armcu(it_armcu1))
+
+         print*,
+     :'day,annee_ref,day_ini_armcu,timeit,it_armcu1,it_armcu2,SST:',
+     :day,annee_ref,day_ini_armcu,timeit/86400.,it_armcu1,
+     :it_armcu2,fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
+
+        return
+        END
+
+!=====================================================================
+      subroutine readprofiles(nlev_max,kmax,height,
+     .           thlprof,qtprof,uprof,
+     .           vprof,e12prof,ugprof,vgprof,
+     .           wfls,dqtdxls,dqtdyls,dqtdtls,
+     .           thlpcar)
+      implicit none
+
+        integer nlev_max,kmax,kmax2
+        logical :: llesread = .true.
+
+        real height(nlev_max),thlprof(nlev_max),qtprof(nlev_max),
+     .       uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max),
+     .       ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max),
+     .       dqtdxls(nlev_max),dqtdyls(nlev_max),dqtdtls(nlev_max),
+     .           thlpcar(nlev_max)
+
+        integer, parameter :: ilesfile=1
+        integer :: ierr,irad,imax,jtot,k
+        logical :: lmoist,lcoriol,ltimedep
+        real :: xsize,ysize
+        real :: ustin,wsvsurf,timerad
+        character(80) :: chmess
+
+        if(.not.(llesread)) return
+
+       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        read (ilesfile,*) kmax
+        do k=1,kmax
+          read (ilesfile,*) height(k),thlprof(k),qtprof (k),
+     .                      uprof (k),vprof  (k),e12prof(k)
+        enddo
+        close(ilesfile)
+
+       open(ilesfile,file='lscale.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) stop 'ERROR:Lscale.inp does not exist'
+        read (ilesfile,*) kmax2
+        if (kmax .ne. kmax2) then
+          print *, 'fichiers prof.inp et lscale.inp incompatibles :'
+          print *, 'nbre de niveaux : ',kmax,' et ',kmax2
+          stop 'lecture profiles'
+        endif
+        do k=1,kmax
+          read (ilesfile,*) height(k),ugprof(k),vgprof(k),wfls(k),
+     .                      dqtdxls(k),dqtdyls(k),dqtdtls(k),thlpcar(k)
+        end do
+        close(ilesfile)
+
+        return
+        end
+
+!===============================================================
+      function ismin(n,sx,incx)
+
+      implicit none
+      integer n,i,incx,ismin,ix
+      real sx((n-1)*incx+1),sxmin
+
+      ix=1
+      ismin=1
+      sxmin=sx(1)
+      do i=1,n-1
+         ix=ix+incx
+         if(sx(ix).lt.sxmin) then
+             sxmin=sx(ix)
+             ismin=i+1
+         endif
+      enddo
+
+      return
+      end
+
+!===============================================================
+      function ismax(n,sx,incx)
+
+      implicit none
+      integer n,i,incx,ismax,ix
+      real sx((n-1)*incx+1),sxmax
+
+      ix=1
+      ismax=1
+      sxmax=sx(1)
+      do i=1,n-1
+         ix=ix+incx
+         if(sx(ix).gt.sxmax) then
+             sxmax=sx(ix)
+             ismax=i+1
+         endif
+      enddo
+
+      return
+      end
+
Index: LMDZ5/branches/testing/libf/phy1d/1D_decl_cases.h
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/1D_decl_cases.h	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/1D_decl_cases.h	(revision 1665)
@@ -0,0 +1,129 @@
+! Declarations specifiques au cas Toga
+        character*80 :: fich_toga
+!        integer nlev_prof
+!        parameter (nlev_prof = 41)
+        integer nlev_toga, nt_toga
+        parameter (nlev_toga=41, nt_toga=480)
+        integer year_ini_toga, day_ini_toga, mth_ini_toga
+        real day_ju_ini_toga   ! Julian day of toga coare first day
+        parameter (year_ini_toga=1992) 
+        parameter (mth_ini_toga=11)
+        parameter (day_ini_toga=1)  !  1erNov1992
+        real dt_toga
+        parameter (dt_toga=6.*3600.)
+!!
+        integer year_print, month_print, day_print
+        real    sec_print
+!!
+        integer nn
+        integer it_toga1, it_toga2
+        real time_toga1,time_toga2
+
+        real ts_toga(nt_toga)
+        real plev_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
+        real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
+        real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
+        real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+        real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+
+        real ts_prof
+        real plev_prof(nlev_toga),w_prof(nlev_toga)
+        real t_prof(nlev_toga),q_prof(nlev_toga)
+        real u_prof(nlev_toga),v_prof(nlev_toga)
+        real ht_prof(nlev_toga),vt_prof(nlev_toga)
+        real hq_prof(nlev_toga),vq_prof(nlev_toga)
+
+        real plev_mod(llm),w_mod(llm), t_mod(llm),q_mod(llm)
+        real u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm)
+        real hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
+
+        real ts_cur
+        common /sst_forcing/ts_cur ! also in read_tsurf1d.F
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Declarations specifiques au cas RICO
+        character*80 :: fich_rico
+        integer nlev_rico
+
+        parameter (nlev_rico=81)
+        real ts_rico,ps_rico
+        real w_rico(llm)
+        real t_rico(llm),q_rico(llm)
+        real u_rico(llm),v_rico(llm)
+        real dth_rico(llm)
+        real dqh_rico(llm)
+        real du_age(llm),dv_age(llm)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Declarations specifiques au cas TWPice
+        character*80 :: fich_twpice
+        integer nlev_twpi, nt_twpi
+        parameter (nlev_twpi=40, nt_twpi=215)
+        integer year_ini_twpi, day_ini_twpi, mth_ini_twpi
+        real heure_ini_twpi
+        real day_ju_ini_twpi   ! Julian day of twpice first day
+        parameter (year_ini_twpi=2006) 
+        parameter (mth_ini_twpi=1)
+        parameter (day_ini_twpi=17)  ! 17 = 17Jan2006
+        parameter (heure_ini_twpi=10800.) !3h en secondes
+        real dt_twpi
+        parameter (dt_twpi=3.*3600.)
+
+        real ts_twpi(nt_twpi)
+        real plev_twpi(nlev_twpi,nt_twpi),w_twpi(nlev_twpi,nt_twpi)
+        real t_twpi(nlev_twpi,nt_twpi),q_twpi(nlev_twpi,nt_twpi)
+        real u_twpi(nlev_twpi,nt_twpi),v_twpi(nlev_twpi,nt_twpi)
+        real ht_twpi(nlev_twpi,nt_twpi),vt_twpi(nlev_twpi,nt_twpi)
+        real hq_twpi(nlev_twpi,nt_twpi),vq_twpi(nlev_twpi,nt_twpi)
+
+        real ts_proftwp
+        real plev_proftwp(nlev_twpi),w_proftwp(nlev_twpi)
+        real t_proftwp(nlev_twpi),q_proftwp(nlev_twpi)
+        real u_proftwp(nlev_twpi),v_proftwp(nlev_twpi)
+        real ht_proftwp(nlev_twpi),vt_proftwp(nlev_twpi)
+        real hq_proftwp(nlev_twpi),vq_proftwp(nlev_twpi)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Declarations specifiques au cas GCSSold
+        character*80 :: fich_gcssold_ctl
+        character*80 :: fich_gcssold_dat
+        real  ht_gcssold(llm),hq_gcssold(llm),hw_gcssold(llm)
+        real  hu_gcssold(llm)
+        real  hv_gcssold(llm)
+        real  hthturb_gcssold(llm)
+        real  hqturb_gcssold(llm)
+        real  Ts_gcssold
+        real  dtime_frcg
+cAl1     logical :: imp_fcg_gcssold
+c        logical :: ts_fcg_gcssold 
+c        logical :: Tp_fcg_gcssold 
+        logical :: Turb_fcg_gcssold
+        common /turb_forcing/ dtime_frcg,
+     $      Turb_fcg_gcssold, hthturb_gcssold, hqturb_gcssold
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Declarations specifiques au cas Arm_cu
+        character*80 :: fich_armcu
+
+
+        integer nlev_armcu, nt_armcu
+        parameter (nlev_armcu=40, nt_armcu=31)
+        integer year_ini_armcu, day_ini_armcu, mth_ini_armcu
+        real  heure_ini_armcu
+        real day_ju_ini_armcu                                ! Julian day of armcu case first day
+        parameter (year_ini_armcu=1997) 
+        parameter (mth_ini_armcu=6)
+        parameter (day_ini_armcu=21)  ! 172 = 21 juin 1997
+        parameter (heure_ini_armcu=41400)   ! 11:30 en secondes
+        real dt_armcu
+        parameter (dt_armcu=1.*1800.)   ! forcages donnes ttes les demi-heures par ifa_armcu.txt
+        real sens_armcu(nt_armcu),flat_armcu(nt_armcu)
+        real adv_theta_armcu(nt_armcu),rad_theta_armcu(nt_armcu)
+        real adv_qt_armcu(nt_armcu)
+        real theta_mod(llm),rv_mod(llm),play_mod(llm)
+        real d_t_dyn_ls(llm),d_q_dyn_ls(llm)
+! profc comme "profil armcu"
+        real h_profc,play_profc,t_profc,th_profc,plev_profc
+        real u_profc,v_profc,qv_profc,rv_profc
+        
+! forcages interpoles dans le temps
+        real adv_theta_prof,rad_theta_prof,adv_qt_prof
+        real sens_prof,flat_prof,fact
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: LMDZ5/branches/testing/libf/phy1d/1D_interp_cases.h
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/1D_interp_cases.h	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/1D_interp_cases.h	(revision 1665)
@@ -0,0 +1,256 @@
+!---------------------------------------------------------------------
+! Interpolation forcing in time and onto model levels
+!---------------------------------------------------------------------
+      if (forcing_GCSSold) then
+
+       call get_uvd(it,timestep,fich_gcssold_ctl,fich_gcssold_dat,
+     :               ht_gcssold,hq_gcssold,hw_gcssold,
+     :               hu_gcssold,hv_gcssold,
+     :               hthturb_gcssold,hqturb_gcssold,Ts_gcssold,
+     :               imp_fcg_gcssold,ts_fcg_gcssold,
+     :               Tp_fcg_gcssold,Turb_fcg_gcssold)
+       if (prt_level.ge.1) then
+         print *,' get_uvd -> hqturb_gcssold ',it,hqturb_gcssold
+       endif
+! large-scale forcing :
+!!!      tsurf = ts_gcssold
+      do l = 1, llm
+!       u(l) = hu_gcssold(l) !  on prescrit le vent
+!       v(l) = hv_gcssold(l)    !  on prescrit le vent
+!       omega(l) = hw_gcssold(l)
+!       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!       omega2(l)=-rho(l)*omega(l)
+       omega(l) = hw_gcssold(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+       d_th_adv(l) = ht_gcssold(l)
+       d_q_adv(l,1) = hq_gcssold(l)
+       dt_cooling(l) = 0.0
+      enddo
+
+      endif ! forcing_GCSSold
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation Toga forcing 
+!---------------------------------------------------------------------
+      if (forcing_toga) then
+
+       if (prt_level.ge.1) then
+        print*,
+     : '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_toga=',
+     :    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_toga
+       endif
+
+! time interpolation:
+        CALL interp_toga_time(daytime,day1,annee_ref
+     i             ,year_ini_toga,day_ju_ini_toga,nt_toga,dt_toga
+     i             ,nlev_toga,ts_toga,plev_toga,t_toga,q_toga,u_toga
+     i             ,v_toga,w_toga,ht_toga,vt_toga,hq_toga,vq_toga
+     o             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof
+     o             ,ht_prof,vt_prof,hq_prof,vq_prof)
+
+        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
+
+! vertical interpolation:
+      CALL interp_toga_vertical(play,nlev_toga,plev_prof
+     :         ,t_prof,q_prof,u_prof,v_prof,w_prof
+     :         ,ht_prof,vt_prof,hq_prof,vq_prof
+     :         ,t_mod,q_mod,u_mod,v_mod,w_mod
+     :         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+
+! large-scale forcing :
+      tsurf = ts_prof
+      do l = 1, llm
+       u(l) = u_mod(l) ! sb: on prescrit le vent
+       v(l) = v_mod(l) ! sb: on prescrit le vent
+!       omega(l) = w_prof(l)
+!       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!       omega2(l)=-rho(l)*omega(l)
+       omega(l) = w_mod(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+       d_th_adv(l) = alpha*omega(l)/rcpd-(ht_mod(l)+vt_mod(l))
+       d_q_adv(l,1) = -(hq_mod(l)+vq_mod(l))
+       dt_cooling(l) = 0.0
+      enddo
+
+      endif ! forcing_toga
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing TWPice
+!---------------------------------------------------------------------
+      if (forcing_twpice) then
+
+        print*,
+     : '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_twpi=',
+     :    daytime,day1,(daytime-day1)*86400.,
+     :    (daytime-day1)*86400/dt_twpi
+
+! time interpolation:
+        CALL interp_toga_time(daytime,day1,annee_ref
+     i       ,year_ini_twpi,day_ju_ini_twpi,nt_twpi,dt_twpi,nlev_twpi
+     i       ,ts_twpi,plev_twpi,t_twpi,q_twpi,u_twpi,v_twpi,w_twpi
+     i       ,ht_twpi,vt_twpi,hq_twpi,vq_twpi
+     o       ,ts_proftwp,plev_proftwp,t_proftwp,q_proftwp,u_proftwp
+     o       ,v_proftwp,w_proftwp
+     o       ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp)
+
+! vertical interpolation:
+      CALL interp_toga_vertical(play,nlev_twpi,plev_proftwp
+     :         ,t_proftwp,q_proftwp,u_proftwp,v_proftwp,w_proftwp
+     :         ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp
+     :         ,t_mod,q_mod,u_mod,v_mod,w_mod
+     :         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+
+
+!calcul de l'advection verticale a partir du omega
+cCalcul des gradients verticaux
+cinitialisation
+      d_t_z(:)=0.
+      d_q_z(:)=0.
+      d_t_dyn_z(:)=0.
+      d_q_dyn_z(:)=0.
+      DO l=2,llm-1
+       d_t_z(l)=(temp(l+1)-temp(l-1))
+     &          /(play(l+1)-play(l-1))
+       d_q_z(l)=(q(l+1,1)-q(l-1,1))
+     &          /(play(l+1)-play(l-1))
+      ENDDO
+      d_t_z(1)=d_t_z(2)
+      d_q_z(1)=d_q_z(2)
+      d_t_z(llm)=d_t_z(llm-1)
+      d_q_z(llm)=d_q_z(llm-1)
+
+cCalcul de l advection verticale
+      d_t_dyn_z(:)=w_mod(:)*d_t_z(:)
+      d_q_dyn_z(:)=w_mod(:)*d_q_z(:)
+
+!wind nudging above 500m with a 2h time scale
+        do l=1,llm
+        if (nudge_wind) then
+!           if (phi(l).gt.5000.) then
+        if (phi(l).gt.0.) then
+        u(l)=u(l)
+     .      +timestep*(u_mod(l)-u(l))/(2.*3600.)
+        v(l)=v(l) 
+     .      +timestep*(v_mod(l)-v(l))/(2.*3600.)
+           endif    
+        else
+        u(l) = u_mod(l) 
+        v(l) = v_mod(l)
+        endif
+        enddo
+
+!CR:nudging of q and theta with a 6h time scale above 15km
+        if (nudge_thermo) then
+        do l=1,llm
+           zz(l)=phi(l)/9.8
+           if ((zz(l).le.16000.).and.(zz(l).gt.15000.)) then
+             zfact=(zz(l)-15000.)/1000.
+        q(l,1)=q(l,1)
+     .      +timestep*(q_mod(l)-q(l,1))/(6.*3600.)*zfact
+        temp(l)=temp(l) 
+     .      +timestep*(t_mod(l)-temp(l))/(6.*3600.)*zfact
+           else if (zz(l).gt.16000.) then 
+        q(l,1)=q(l,1)
+     .      +timestep*(q_mod(l)-q(l,1))/(6.*3600.)
+        temp(l)=temp(l) 
+     .      +timestep*(t_mod(l)-temp(l))/(6.*3600.)
+           endif
+        enddo    
+        endif
+
+      do l = 1, llm
+       omega(l) = w_mod(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!calcul de l'advection totale
+        if (cptadvw) then
+        d_th_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-d_t_dyn_z(l)
+!        print*,'temp vert adv',l,ht_mod(l),vt_mod(l),-d_t_dyn_z(l)
+        d_q_adv(l,1) = hq_mod(l)-d_q_dyn_z(l)
+!        print*,'q vert adv',l,hq_mod(l),vq_mod(l),-d_q_dyn_z(l)
+        else
+        d_th_adv(l) = alpha*omega(l)/rcpd+(ht_mod(l)+vt_mod(l))
+        d_q_adv(l,1) = (hq_mod(l)+vq_mod(l))
+        endif
+       dt_cooling(l) = 0.0
+      enddo
+
+      endif ! forcing_twpice
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing Rico
+!---------------------------------------------------------------------
+      if (forcing_rico) then
+!       call lstendH(llm,omega,dt_dyn,dq_dyn,du_dyn, dv_dyn,
+!     :  q,temp,u,v,play)
+       call lstendH(llm,nqtot,omega,dt_dyn,dq_dyn,
+     :  q,temp,u,v,play)
+
+        do l=1,llm
+       d_th_adv(l) =  (dth_rico(l) +  dt_dyn(l))
+       d_q_adv(l,1) = (dqh_rico(l) +  dq_dyn(l,1))
+       d_q_adv(l,2) = 0.
+        enddo
+      endif  ! forcing_rico
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing Arm_cu
+!---------------------------------------------------------------------
+      if (forcing_armcu) then
+
+        print*,
+     : '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_armcu=',
+     :    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_armcu
+
+! time interpolation:
+! ATTENTION, cet appel ne convient pas pour TOGA !!
+! revoir 1DUTILS.h et les arguments
+      CALL interp_armcu_time(daytime,day1,annee_ref
+     i            ,year_ini_armcu,day_ju_ini_armcu,nt_armcu,dt_armcu
+     i            ,nlev_armcu,sens_armcu,flat_armcu,adv_theta_armcu
+     i            ,rad_theta_armcu,adv_qt_armcu,sens_prof,flat_prof
+     i            ,adv_theta_prof,rad_theta_prof,adv_qt_prof)
+
+! vertical interpolation:
+! No vertical interpolation if nlev imposed to 19 or 40
+
+! For this case, fluxes are imposed
+       fsens=-1*sens_prof
+       flat=-1*flat_prof
+
+! Advective forcings are given in K or g/kg ... BY HOUR
+      do l = 1, llm
+       ug(l)= u_mod(l)
+       vg(l)= v_mod(l)
+       IF((phi(l)/RG).LT.1000) THEN
+         d_th_adv(l) = (adv_theta_prof + rad_theta_prof)/3600.
+         d_q_adv(l,1) = adv_qt_prof/1000./3600.
+         d_q_adv(l,2) = 0.0
+!        print *,'INF1000: phi dth dq1 dq2',
+!    :  phi(l)/RG,d_th_adv(l),d_q_adv(l,1),d_q_adv(l,2)
+       ELSEIF ((phi(l)/RG).GE.1000.AND.(phi(l)/RG).lt.3000) THEN
+         fact=((phi(l)/RG)-1000.)/2000.
+         fact=1-fact
+         d_th_adv(l) = (adv_theta_prof + rad_theta_prof)*fact/3600.
+         d_q_adv(l,1) = adv_qt_prof*fact/1000./3600.
+         d_q_adv(l,2) = 0.0
+!        print *,'SUP1000: phi fact dth dq1 dq2',
+!    :  phi(l)/RG,fact,d_th_adv(l),d_q_adv(l,1),d_q_adv(l,2)
+       ELSE
+         d_th_adv(l) = 0.0
+         d_q_adv(l,1) = 0.0
+         d_q_adv(l,2) = 0.0
+!        print *,'SUP3000: phi dth dq1 dq2',
+!    :  phi(l)/RG,d_th_adv(l),d_q_adv(l,1),d_q_adv(l,2)
+       ENDIF
+      dt_cooling(l) = 0.0  
+!     print *,'Interp armcu: phi dth dq1 dq2',
+!    :  l,phi(l),d_th_adv(l),d_q_adv(l,1),d_q_adv(l,2)
+      enddo
+      endif ! forcing_armcu
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: LMDZ5/branches/testing/libf/phy1d/1D_read_forc_cases.h
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/1D_read_forc_cases.h	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/1D_read_forc_cases.h	(revision 1665)
@@ -0,0 +1,368 @@
+!----------------------------------------------------------------------
+! forcing_les = .T. : Impose a constant cooling 
+! forcing_radconv = .T. : Pure radiative-convective equilibrium:
+!----------------------------------------------------------------------
+
+      if (forcing_les .or. forcing_radconv .or. forcing_GCSSold ) then
+
+!----------------------------------------------------------------------
+! Read profiles from files: prof.inp.001 and lscale.inp.001
+! (repris de readlesfiles)
+!----------------------------------------------------------------------
+
+      call readprofiles(nlev_max,kmax,height,
+     .           tttprof,qtprof,uprof,vprof,
+     .           e12prof,ugprof,vgprof,
+     .           wfls,dqtdxls,dqtdyls,dqtdtls,
+     .           thlpcar) 
+
+! compute altitudes of play levels.
+      zlay(1) =zsurf +  rd*tsurf*(psurf-play(1))/(rg*psurf)
+      do l = 2,llm
+        zlay(l) = zlay(l-1)+rd*tsurf*(psurf-play(1))/(rg*psurf)
+      enddo
+
+!----------------------------------------------------------------------
+! Interpolation of the profiles given on the input file to
+! model levels
+!----------------------------------------------------------------------
+      zlay(1) = zsurf +  rd*tsurf*(psurf-play(1))/(rg*psurf)
+      do l=1,llm
+        ! Above the max altutide of the input file
+
+        if (zlay(l)<height(kmax)) mxcalc=l
+
+        frac = (height(kmax)-zlay(l))/(height (kmax)-height(kmax-1))
+        ttt =tttprof(kmax)-frac*(tttprof(kmax)-tttprof(kmax-1))
+        if (forcing_GCSSold .AND. tp_ini_GCSSold) then ! pot. temp. in initial profile
+          temp(l) = ttt*(play(l)/pzero)**rkappa
+          teta(l) = ttt
+        else
+          temp(l) = ttt
+          teta(l) = ttt*(pzero/play(l))**rkappa
+        endif
+          print *,' temp,teta ',l,temp(l),teta(l)
+        q(l,1)  = qtprof(kmax)-frac*( qtprof(kmax)- qtprof(kmax-1))
+        u(l)    =  uprof(kmax)-frac*(  uprof(kmax)-  uprof(kmax-1))
+        v(l)    =  vprof(kmax)-frac*(  vprof(kmax)-  vprof(kmax-1))
+        ug(l)   = ugprof(kmax)-frac*( ugprof(kmax)- ugprof(kmax-1))
+        vg(l)   = vgprof(kmax)-frac*( vgprof(kmax)- vgprof(kmax-1))
+        omega(l)=   wfls(kmax)-frac*(   wfls(kmax)-   wfls(kmax-1))
+
+        dq_dyn(l,1) = dqtdtls(kmax)-frac*(dqtdtls(kmax)-dqtdtls(kmax-1))
+        dt_cooling(l)
+     .          =thlpcar(kmax)-frac*(thlpcar(kmax)-thlpcar(kmax-1))
+        do k=2,kmax
+          frac = (height(k)-zlay(l))/(height(k)-height(k-1))
+          if(l==1) print*,'k, height, tttprof',k,height(k),tttprof(k)
+          if(zlay(l)>height(k-1).and.zlay(l)<height(k)) then
+            ttt =tttprof(k)-frac*(tttprof(k)-tttprof(k-1))
+        if (forcing_GCSSold .AND. tp_ini_GCSSold) then ! pot. temp. in initial profile
+          temp(l) = ttt*(play(l)/pzero)**rkappa
+          teta(l) = ttt
+        else
+          temp(l) = ttt
+          teta(l) = ttt*(pzero/play(l))**rkappa
+        endif
+          print *,' temp,teta ',l,temp(l),teta(l)
+            q(l,1)  = qtprof(k)-frac*( qtprof(k)- qtprof(k-1))
+            u(l)    =  uprof(k)-frac*(  uprof(k)-  uprof(k-1))
+            v(l)    =  vprof(k)-frac*(  vprof(k)-  vprof(k-1))
+            ug(l)   = ugprof(k)-frac*( ugprof(k)- ugprof(k-1))
+            vg(l)   = vgprof(k)-frac*( vgprof(k)- vgprof(k-1))
+            omega(l)=   wfls(k)-frac*(   wfls(k)-   wfls(k-1))
+            dq_dyn(l,1)=dqtdtls(k)-frac*(dqtdtls(k)-dqtdtls(k-1))
+            dt_cooling(l)
+     .              =thlpcar(k)-frac*(thlpcar(k)-thlpcar(k-1))
+          elseif(zlay(l)<height(1)) then ! profils uniformes pour z<height(1)
+            ttt =tttprof(1)
+        if (forcing_GCSSold .AND. tp_ini_GCSSold) then ! pot. temp. in initial profile
+          temp(l) = ttt*(play(l)/pzero)**rkappa
+          teta(l) = ttt
+        else
+          temp(l) = ttt
+          teta(l) = ttt*(pzero/play(l))**rkappa
+        endif
+            q(l,1)  = qtprof(1)
+            u(l)    =  uprof(1)
+            v(l)    =  vprof(1)
+            ug(l)   = ugprof(1)
+            vg(l)   = vgprof(1)
+            omega(l)=   wfls(1)
+            dq_dyn(l,1)  =dqtdtls(1)
+            dt_cooling(l)=thlpcar(1)
+          endif
+        enddo 
+
+        temp(l)=max(min(temp(l),350.),150.)
+        rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+        if (l .lt. llm) then
+          zlay(l+1) = zlay(l) + (play(l)-play(l+1))/(rg*rho(l))
+        endif
+        omega2(l)=-rho(l)*omega(l)
+        omega(l)= omega(l)*(-rg*rho(l)) !en Pa/s
+        if (l>1) then
+        if(zlay(l-1)>height(kmax)) then
+           omega(l)=0.0
+           omega2(l)=0.0
+        endif   
+        endif
+        if(q(l,1)<0.) q(l,1)=0.0
+        q(l,2)  = 0.0
+      enddo
+
+      endif ! forcing_les .or. forcing_GCSSold
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing for GCSSold:
+!---------------------------------------------------------------------
+      if (forcing_GCSSold) then
+       fich_gcssold_ctl = './forcing.ctl'
+       fich_gcssold_dat = './forcing8.dat'
+       call copie(llm,play,psurf,fich_gcssold_ctl)
+       call get_uvd2(it,timestep,fich_gcssold_ctl,fich_gcssold_dat,
+     :               ht_gcssold,hq_gcssold,hw_gcssold,
+     :               hu_gcssold,hv_gcssold,
+     :               hthturb_gcssold,hqturb_gcssold,Ts_gcssold,
+     :               imp_fcg_gcssold,ts_fcg_gcssold,
+     :               Tp_fcg_gcssold,Turb_fcg_gcssold)
+       print *,' get_uvd2 -> hqturb_gcssold ',hqturb_gcssold
+      endif ! forcing_GCSSold
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing for RICO:
+!---------------------------------------------------------------------
+      if (forcing_rico) then
+
+!       call writefield_phy('omega', omega,llm+1)
+      fich_rico = 'rico.txt'
+       call read_rico(fich_rico,nlev_rico,ps_rico,play
+     :             ,ts_rico,t_rico,q_rico,u_rico,v_rico,w_rico
+     :             ,dth_rico,dqh_rico)
+        print*, ' on a lu et prepare RICO'
+
+       mxcalc=llm
+       print *, airefi, ' airefi '
+       do l = 1, llm
+       rho(l)  = play(l)/(rd*t_rico(l)*(1.+(rv/rd-1.)*q_rico(l)))
+       temp(l) = t_rico(l)
+       q(l,1) = q_rico(l)
+       q(l,2) = 0.0
+       u(l) = u_rico(l)
+       v(l) = v_rico(l)
+       ug(l)=u_rico(l)
+       vg(l)=v_rico(l)
+       omega(l) = -w_rico(l)*rg
+       omega2(l) = omega(l)/rg*airefi
+       enddo
+      endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from TOGA-COARE experiment (Ciesielski et al. 2002) :
+!---------------------------------------------------------------------
+
+      if (forcing_toga) then
+
+! read TOGA-COARE forcing (native vertical grid, nt_toga timesteps):
+      fich_toga = './d_toga/ifa_toga_coare_v21_dime.txt'
+      CALL read_togacoare(fich_toga,nlev_toga,nt_toga
+     :         ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga
+     :         ,ht_toga,vt_toga,hq_toga,vq_toga)
+
+       write(*,*) 'Forcing TOGA lu'
+
+! time interpolation for initial conditions:
+      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
+      CALL interp_toga_time(daytime,day1,annee_ref
+     i             ,year_ini_toga,day_ju_ini_toga,nt_toga,dt_toga
+     i             ,nlev_toga,ts_toga,plev_toga,t_toga,q_toga,u_toga
+     i             ,v_toga,w_toga,ht_toga,vt_toga,hq_toga,vq_toga
+     o             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof
+     o             ,ht_prof,vt_prof,hq_prof,vq_prof)
+
+! vertical interpolation:
+      CALL interp_toga_vertical(play,nlev_toga,plev_prof
+     :         ,t_prof,q_prof,u_prof,v_prof,w_prof
+     :         ,ht_prof,vt_prof,hq_prof,vq_prof
+     :         ,t_mod,q_mod,u_mod,v_mod,w_mod
+     :         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+       write(*,*) 'Profil initial forcing TOGA interpole'
+
+! initial and boundary conditions :
+      tsurf = ts_prof
+      write(*,*) 'SST initiale: ',tsurf
+      do l = 1, llm
+       temp(l) = t_mod(l)
+       q(l,1) = q_mod(l)
+       q(l,2) = 0.0
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       omega(l) = w_mod(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+!?       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!?       omega2(l)=-rho(l)*omega(l)
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+       d_th_adv(l) = alpha*omega(l)/rcpd-(ht_mod(l)+vt_mod(l))
+       d_q_adv(l,1) = -(hq_mod(l)+vq_mod(l))
+       d_q_adv(l,2) = 0.0
+      enddo
+
+      endif ! forcing_toga
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from TWPICE experiment (Shaocheng et al. 2010) :
+!---------------------------------------------------------------------
+
+      if (forcing_twpice) then
+!read TWP-ICE forcings
+      fich_twpice=
+     : 'd_twpi/twp180iopsndgvarana_v2.1_C3.c1.20060117.000000.cdf'
+      call read_twpice(fich_twpice,nlev_twpi,nt_twpi
+     :     ,ts_twpi,plev_twpi,t_twpi,q_twpi,u_twpi,v_twpi,w_twpi
+     :     ,ht_twpi,vt_twpi,hq_twpi,vq_twpi)
+
+      write(*,*) 'Forcing TWP-ICE lu'
+!Time interpolation for initial conditions using TOGA interpolation routine
+         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
+      CALL interp_toga_time(daytime,day1,annee_ref
+     i          ,year_ini_twpi,day_ju_ini_twpi,nt_twpi,dt_twpi,nlev_twpi
+     i             ,ts_twpi,plev_twpi,t_twpi,q_twpi,u_twpi,v_twpi,w_twpi
+     i             ,ht_twpi,vt_twpi,hq_twpi,vq_twpi
+     o             ,ts_proftwp,plev_proftwp,t_proftwp,q_proftwp
+     o             ,u_proftwp,v_proftwp,w_proftwp
+     o             ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp)
+
+! vertical interpolation using TOGA interpolation routine:
+!      write(*,*)'avant interp vert', t_proftwp
+      CALL interp_toga_vertical(play,nlev_twpi,plev_proftwp
+     :         ,t_proftwp,q_proftwp,u_proftwp,v_proftwp,w_proftwp
+     :         ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp
+     :         ,t_mod,q_mod,u_mod,v_mod,w_mod
+     :         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+!       write(*,*) 'Profil initial forcing TWP-ICE interpole',t_mod
+
+! initial and boundary conditions :
+!      tsurf = ts_proftwp
+      write(*,*) 'SST initiale: ',tsurf
+      do l = 1, llm
+       temp(l) = t_mod(l)
+       q(l,1) = q_mod(l)
+       q(l,2) = 0.0
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       omega(l) = w_mod(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!on applique le forcage total au premier pas de temps
+!attention: signe different de toga
+       d_th_adv(l) = alpha*omega(l)/rcpd+(ht_mod(l)+vt_mod(l))
+       d_q_adv(l,1) = (hq_mod(l)+vq_mod(l))
+       d_q_adv(l,2) = 0.0
+      enddo     
+       
+      endif !forcing_twpice
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from Arm_Cu case                   
+! For this case, ifa_armcu.txt contains sensible, latent heat fluxes
+! large scale advective forcing,radiative forcing 
+! and advective tendency of theta and qt to be applied 
+!---------------------------------------------------------------------
+
+      if (forcing_armcu) then
+! read armcu forcing :
+       write(*,*) 'Avant lecture Forcing Arm_Cu'
+      fich_armcu = './ifa_armcu.txt'
+      CALL read_armcu(fich_armcu,nlev_armcu,nt_armcu,
+     : sens_armcu,flat_armcu,adv_theta_armcu,
+     : rad_theta_armcu,adv_qt_armcu)
+       write(*,*) 'Forcing Arm_Cu lu'
+
+!----------------------------------------------------------------------
+! Read profiles from file: prof.inp.19 or prof.inp.40 
+! For this case, profiles are given for two vertical resolution
+! 19 or 40 levels
+!
+! Comment from: http://www.knmi.nl/samenw/eurocs/ARM/profiles.html
+! Note that the initial profiles contain no liquid water! 
+! (so potential temperature can be interpreted as liquid water 
+! potential temperature and water vapor as total water)
+! profiles are given at full levels
+!----------------------------------------------------------------------
+
+      call readprofile_armcu(nlev_max,kmax,height,play_mod,u_mod,
+     .           v_mod,theta_mod,t_mod,qv_mod,rv_mod,ap,bp)
+
+! time interpolation for initial conditions:
+      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
+
+      print *,'Avant interp_armcu_time'
+      print *,'daytime=',daytime
+      print *,'day1=',day1
+      print *,'annee_ref=',annee_ref
+      print *,'year_ini_armcu=',year_ini_armcu
+      print *,'day_ju_ini_armcu=',day_ju_ini_armcu
+      print *,'nt_armcu=',nt_armcu
+      print *,'dt_armcu=',dt_armcu
+      print *,'nlev_armcu=',nlev_armcu
+      CALL interp_armcu_time(daytime,day1,annee_ref
+     i            ,year_ini_armcu,day_ju_ini_armcu,nt_armcu,dt_armcu
+     i            ,nlev_armcu,sens_armcu,flat_armcu,adv_theta_armcu
+     i            ,rad_theta_armcu,adv_qt_armcu,sens_prof,flat_prof
+     i            ,adv_theta_prof,rad_theta_prof,adv_qt_prof)
+       write(*,*) 'Forcages interpoles dans temps'
+
+! No vertical interpolation if nlev imposed to 19 or 40
+! The vertical grid stops at 4000m # 600hPa
+      mxcalc=llm
+
+! initial and boundary conditions :
+!     tsurf = ts_prof
+! tsurf read in lmdz1d.def
+      write(*,*) 'Tsurf initiale: ',tsurf
+      do l = 1, llm
+       play(l)=play_mod(l)*100.
+       presnivs(l)=play(l)
+       zlay(l)=height(l)
+       temp(l) = t_mod(l)
+       teta(l)=theta_mod(l)
+       q(l,1) = qv_mod(l)/1000.
+! No liquid water in the initial profil
+       q(l,2) = 0.
+       u(l) = u_mod(l)
+       ug(l)= u_mod(l)
+       v(l) = v_mod(l)
+       vg(l)= v_mod(l)
+! Advective forcings are given in K or g/kg ... per HOUR
+!      IF(height(l).LT.1000) THEN
+!        d_th_adv(l) = (adv_theta_prof + rad_theta_prof)/3600.
+!        d_q_adv(l,1) = adv_qt_prof/1000./3600.
+!        d_q_adv(l,2) = 0.0
+!      ELSEIF (height(l).GE.1000.AND.height(l).LT.3000) THEN
+!        d_th_adv(l) = (adv_theta_prof + rad_theta_prof)*
+!    :               (1-(height(l)-1000.)/2000.)
+!        d_th_adv(l) = d_th_adv(l)/3600.
+!        d_q_adv(l,1) = adv_qt_prof*(1-(height(l)-1000.)/2000.)
+!        d_q_adv(l,1) = d_q_adv(l,1)/1000./3600.
+!        d_q_adv(l,2) = 0.0
+!      ELSE
+!        d_th_adv(l) = 0.0
+!        d_q_adv(l,1) = 0.0
+!        d_q_adv(l,2) = 0.0
+!      ENDIF
+      enddo
+! plev at half levels is given in proh.inp.19 or proh.inp.40 files
+      plev(1)= ap(llm+1)+bp(llm+1)*psurf
+      do l = 1, llm
+      plev(l+1) = ap(llm-l+1)+bp(llm-l+1)*psurf
+      print *,'Read_forc: l height play plev zlay temp',
+     :   l,height(l),play(l),plev(l),zlay(l),temp(l)
+      enddo
+! For this case, fluxes are imposed
+       fsens=-1*sens_prof
+       flat=-1*flat_prof
+
+      endif ! forcing_armcu
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: LMDZ5/branches/testing/libf/phy1d/1Dconv.h
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/1Dconv.h	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/1Dconv.h	(revision 1665)
@@ -0,0 +1,880 @@
+        subroutine get_uvd(itap,dtime,file_forctl,file_fordat,
+     :       ht,hq,hw,hu,hv,hthturb,hqturb,
+     :       Ts,imp_fcg,ts_fcg,Tp_fcg,Turb_fcg)
+c
+        implicit none
+ 
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c cette routine permet d obtenir u_convg,v_convg,ht,hq et ainsi de
+c pouvoir calculer la convergence et le cisaillement dans la physiq
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+#include "YOMCST.h"
+
+      INTEGER klev
+      REAL play(100)  !pression en Pa au milieu de chaque couche GCM
+      INTEGER JM(100) !pression en Pa au milieu de chaque couche GCM
+      REAL coef1(100) !coefficient d interpolation
+      REAL coef2(100) !coefficient d interpolation
+
+      INTEGER nblvlm !nombre de niveau de pression du mesoNH
+      REAL playm(100)  !pression en Pa au milieu de chaque couche Meso-NH
+      REAL hplaym(100) !pression en hPa milieux des couches Meso-NH
+
+      integer i,j,k,ii,ll,in
+      REAL tsol,qsol
+
+      CHARACTER*80 file_forctl,file_fordat
+
+      COMMON/com1_phys_gcss/klev,play,JM,coef1,coef2
+      COMMON/com2_phys_gcss/nblvlm,playm,hplaym
+
+c======================================================================
+c methode: on va chercher les donnees du mesoNH de meteo france, on y
+c          a acces a tout pas detemps grace a la routine rdgrads qui
+c          est une boucle lisant dans ces fichiers.
+c          Puis on interpole ces donnes sur les 11 niveaux du gcm et
+c          et sur les pas de temps de ce meme gcm
+c----------------------------------------------------------------------
+c input:
+c       pasmax     :nombre de pas de temps maximum du mesoNH
+c       dt         :pas de temps du meso_NH (en secondes)
+c----------------------------------------------------------------------
+      integer pasmax,dt
+      save pasmax,dt
+c----------------------------------------------------------------------
+c arguments:
+c           itap   :compteur de la physique(le nombre de ces pas est
+c                   fixe dans la subroutine calcul_ini_gcm de interpo
+c                   -lation
+c           dtime  :pas detemps du gcm (en secondes)
+c           ht     :convergence horizontale de temperature(K/s)
+c           hq     :    "         "       d humidite (kg/kg/s)
+c           hw     :vitesse verticale moyenne (m/s**2)
+c           hu     :convergence horizontale d impulsion le long de x
+c                  (kg/(m^2 s^2)
+c           hv     : idem le long de y.
+c           Ts     : Temperature de surface (K)
+c           imp_fcg: var. logical .eq. T si forcage en impulsion
+c           ts_fcg: var. logical .eq. T si forcage en Ts present dans fichier
+c           Tp_fcg: var. logical .eq. T si forcage donne en Temp potentielle
+c           Turb_fcg: var. logical .eq. T si forcage turbulent present dans fichier
+c----------------------------------------------------------------------
+        integer itap
+        real dtime
+        real ht(100)
+        real hq(100)
+        real hu(100)
+        real hv(100)
+        real hw(100)
+        real hthturb(100)
+        real hqturb(100)
+        real Ts, Ts_subr
+        logical imp_fcg
+        logical ts_fcg
+        logical Tp_fcg
+        logical Turb_fcg
+c----------------------------------------------------------------------
+c Variables internes de get_uvd (note : l interpolation temporelle
+c est faite entre les pas de temps before et after, sur les variables
+c definies sur la grille du SCM; on atteint exactement les valeurs Meso
+c aux milieux des pas de temps Meso)
+c     time0     :date initiale en secondes
+c     time      :temps associe a chaque pas du SCM
+c     pas       :numero du pas du meso_NH (on lit en pas : le premier pas
+c                 des donnees est duplique)
+c     pasprev   :numero du pas de lecture precedent
+c     htaft     :advection horizontale de temp. au pas de temps after
+c     hqaft     :    "         "      d humidite        "
+c     hwaft     :vitesse verticalle moyenne  au pas de temps after
+c     huaft,hvaft :advection horizontale d impulsion au pas de temps after
+c     tsaft     : surface temperature 'after time step'
+c     htbef     :idem htaft, mais pour le pas de temps before
+c     hqbef     :voir hqaft
+c     hwbef     :voir hwaft
+c     hubef,hvbef : idem huaft,hvaft, mais pour before
+c     tsbef     : surface temperature 'before time step'
+c----------------------------------------------------------------------
+        integer time0,pas,pasprev
+        save time0,pas,pasprev
+        real time
+        real htaft(100),hqaft(100),hwaft(100),huaft(100),hvaft(100)
+        real hthturbaft(100),hqturbaft(100)
+        real Tsaft
+        save htaft,hqaft,hwaft,huaft,hvaft,hthturbaft,hqturbaft
+        real htbef(100),hqbef(100),hwbef(100),hubef(100),hvbef(100)
+        real hthturbbef(100),hqturbbef(100)
+        real Tsbef
+        save htbef,hqbef,hwbef,hubef,hvbef,hthturbbef,hqturbbef
+c
+        real timeaft,timebef
+        save timeaft,timebef
+        integer temps
+        character*4 string
+c----------------------------------------------------------------------
+c variables arguments de la subroutine rdgrads
+c---------------------------------------------------------------------
+        integer icompt,icomp1 !compteurs de rdgrads
+        real z(100)         ! altitude (grille Meso)
+        real ht_mes(100)    !convergence horizontale de temperature
+                            !-(grille Meso)
+        real hq_mes(100)    !convergence horizontale d humidite
+                            !(grille Meso)
+        real hw_mes(100)    !vitesse verticale moyenne
+                            !(grille Meso)
+        real hu_mes(100),hv_mes(100)    !convergence horizontale d impulsion
+                                        !(grille Meso)
+        real hthturb_mes(100) !tendance horizontale de T_pot, due aux
+                              !flux turbulents
+        real hqturb_mes(100) !tendance horizontale d humidite, due aux
+                              !flux turbulents
+c
+c---------------------------------------------------------------------
+c variable argument de la subroutine copie
+c---------------------------------------------------------------------
+c SB        real pplay(100)    !pression en milieu de couche du gcm
+c SB                            !argument de la physique
+c---------------------------------------------------------------------
+c variables destinees a la lecture du pas de temps du fichier de donnees
+c---------------------------------------------------------------------
+       character*80 aaa,atemps,spaces,apasmax
+       integer nch,imn,ipa
+c---------------------------------------------------------------------
+c  procedures appelees
+        external rdgrads    !lire en iterant dans forcing.dat
+c---------------------------------------------------------------------
+               print*,'le pas itap est:',itap
+c*** on determine le pas du meso_NH correspondant au nouvel itap ***
+c*** pour aller chercher les champs dans rdgrads                 ***
+c
+        time=time0+itap*dtime
+cc        temps=int(time/dt+1)
+cc        pas=min(temps,pasmax)
+        temps = 1 + int((dt + 2*time)/(2*dt))
+        pas=min(temps,pasmax-1)
+             print*,'le pas Meso est:',pas
+c
+c
+c===================================================================
+c
+c*** on remplit les champs before avec les champs after du pas   ***
+c*** precedent en format gcm                                     ***
+        if(pas.gt.pasprev)then
+          do i=1,klev
+             htbef(i)=htaft(i)
+             hqbef(i)=hqaft(i)
+             hwbef(i)=hwaft(i)
+             hubef(i)=huaft(i)
+             hvbef(i)=hvaft(i)
+             hThTurbbef(i)=hThTurbaft(i)
+             hqTurbbef(i)=hqTurbaft(i)
+          enddo
+	       tsbef = tsaft
+          timebef=pasprev*dt
+          timeaft=timebef+dt
+          icomp1 = nblvlm*4
+          IF (ts_fcg) icomp1 = icomp1 + 1
+          IF (imp_fcg) icomp1 = icomp1 + nblvlm*2
+          IF (Turb_fcg) icomp1 = icomp1 + nblvlm*2
+          icompt = icomp1*pas
+         print *, 'imp_fcg,ts_fcg,Turb_fcg,pas,nblvlm,icompt'
+         print *, imp_fcg,ts_fcg,Turb_fcg,pas,nblvlm,icompt
+                       print*,'le pas pas est:',pas
+c*** on va chercher les nouveaux champs after dans toga.dat     ***
+c*** champs en format meso_NH                                   ***
+          open(99,FILE=file_fordat,FORM='UNFORMATTED',
+     .             ACCESS='DIRECT',RECL=8)
+          call rdgrads(99,icompt,nblvlm,z,ht_mes,hq_mes,hw_mes
+     .                  ,hu_mes,hv_mes,hthturb_mes,hqturb_mes
+     .                  ,ts_fcg,ts_subr,imp_fcg,Turb_fcg)
+c
+
+               if(Tp_fcg) then
+c     (le forcage est donne en temperature potentielle)
+         do i = 1,nblvlm
+           ht_mes(i) = ht_mes(i)*(hplaym(i)/1000.)**rkappa
+         enddo
+               endif ! Tp_fcg
+        if(Turb_fcg) then
+         do i = 1,nblvlm
+           hThTurb_mes(i) = hThTurb_mes(i)*(hplaym(i)/1000.)**rkappa
+         enddo
+        endif  ! Turb_fcg
+c
+               print*,'ht_mes ',(ht_mes(i),i=1,nblvlm)
+               print*,'hq_mes ',(hq_mes(i),i=1,nblvlm)
+               print*,'hw_mes ',(hw_mes(i),i=1,nblvlm)
+                  if(imp_fcg) then
+               print*,'hu_mes ',(hu_mes(i),i=1,nblvlm)
+               print*,'hv_mes ',(hv_mes(i),i=1,nblvlm)
+                  endif
+                  if(Turb_fcg) then
+               print*,'hThTurb_mes ',(hThTurb_mes(i),i=1,nblvlm)
+               print*,'hqTurb_mes ',(hqTurb_mes(i),i=1,nblvlm)
+                  endif
+	       IF (ts_fcg) print*,'ts_subr', ts_subr
+c*** on interpole les champs meso_NH sur les niveaux de pression***
+c*** gcm . on obtient le nouveau champ after                    ***
+            do k=1,klev
+             if (JM(k) .eq. 0) then
+         htaft(k)=              ht_mes(jm(k)+1)
+         hqaft(k)=              hq_mes(jm(k)+1)
+         hwaft(k)=              hw_mes(jm(k)+1)
+               if(imp_fcg) then
+           huaft(k)=              hu_mes(jm(k)+1)
+           hvaft(k)=              hv_mes(jm(k)+1)
+               endif ! imp_fcg
+               if(Turb_fcg) then
+           hThTurbaft(k)=         hThTurb_mes(jm(k)+1)
+           hqTurbaft(k)=          hqTurb_mes(jm(k)+1)
+               endif ! Turb_fcg
+             else ! JM(k) .eq. 0
+           htaft(k)=coef1(k)*ht_mes(jm(k))+coef2(k)*ht_mes(jm(k)+1)
+           hqaft(k)=coef1(k)*hq_mes(jm(k))+coef2(k)*hq_mes(jm(k)+1)
+           hwaft(k)=coef1(k)*hw_mes(jm(k))+coef2(k)*hw_mes(jm(k)+1)
+               if(imp_fcg) then
+           huaft(k)=coef1(k)*hu_mes(jm(k))+coef2(k)*hu_mes(jm(k)+1)
+           hvaft(k)=coef1(k)*hv_mes(jm(k))+coef2(k)*hv_mes(jm(k)+1)
+               endif ! imp_fcg
+               if(Turb_fcg) then
+           hThTurbaft(k)=coef1(k)*hThTurb_mes(jm(k))
+     $               +coef2(k)*hThTurb_mes(jm(k)+1)
+           hqTurbaft(k) =coef1(k)*hqTurb_mes(jm(k))
+     $               +coef2(k)*hqTurb_mes(jm(k)+1)
+               endif ! Turb_fcg
+             endif ! JM(k) .eq. 0
+            enddo
+            tsaft = ts_subr
+            pasprev=pas
+         else ! pas.gt.pasprev
+            print*,'timebef est:',timebef
+         endif ! pas.gt.pasprev    fin du bloc relatif au passage au pas
+                                  !de temps (meso) suivant
+c*** si on atteint le pas max des donnees experimentales ,on     ***
+c*** on conserve les derniers champs calcules                    ***
+      if(temps.ge.pasmax)then
+          do ll=1,klev
+               ht(ll)=htaft(ll)
+               hq(ll)=hqaft(ll)
+               hw(ll)=hwaft(ll)
+               hu(ll)=huaft(ll)
+               hv(ll)=hvaft(ll)
+               hThTurb(ll)=hThTurbaft(ll)
+               hqTurb(ll)=hqTurbaft(ll)
+          enddo
+	       ts_subr = tsaft
+      else ! temps.ge.pasmax
+c*** on interpole sur les pas de temps de 10mn du gcm a partir   ***
+c** des pas de temps de 1h du meso_NH                            ***
+         do j=1,klev
+         ht(j)=((timeaft-time)*htbef(j)+(time-timebef)*htaft(j))/dt
+         hq(j)=((timeaft-time)*hqbef(j)+(time-timebef)*hqaft(j))/dt
+         hw(j)=((timeaft-time)*hwbef(j)+(time-timebef)*hwaft(j))/dt
+             if(imp_fcg) then
+         hu(j)=((timeaft-time)*hubef(j)+(time-timebef)*huaft(j))/dt
+         hv(j)=((timeaft-time)*hvbef(j)+(time-timebef)*hvaft(j))/dt
+             endif ! imp_fcg
+             if(Turb_fcg) then
+         hThTurb(j)=((timeaft-time)*hThTurbbef(j)
+     $           +(time-timebef)*hThTurbaft(j))/dt
+         hqTurb(j)= ((timeaft-time)*hqTurbbef(j)
+     $           +(time-timebef)*hqTurbaft(j))/dt
+             endif ! Turb_fcg
+         enddo
+	      ts_subr = ((timeaft-time)*tsbef + (time-timebef)*tsaft)/dt
+       endif ! temps.ge.pasmax
+c
+        print *,' time,timebef,timeaft',time,timebef,timeaft
+        print *,' ht,htbef,htaft,hthturb,hthturbbef,hthturbaft'
+        do j= 1,klev
+           print *, j,ht(j),htbef(j),htaft(j),
+     $             hthturb(j),hthturbbef(j),hthturbaft(j)
+        enddo
+        print *,' hq,hqbef,hqaft,hqturb,hqturbbef,hqturbaft'
+        do j= 1,klev
+           print *, j,hq(j),hqbef(j),hqaft(j),
+     $             hqturb(j),hqturbbef(j),hqturbaft(j)
+        enddo
+c
+c-------------------------------------------------------------------
+c
+         IF (Ts_fcg) Ts = Ts_subr
+         return
+c
+c-----------------------------------------------------------------------
+c on sort les champs de "convergence" pour l instant initial 'in'
+c ceci se passe au pas temps itap=0 de la physique
+c-----------------------------------------------------------------------
+        entry get_uvd2(itap,dtime,file_forctl,file_fordat,
+     .           ht,hq,hw,hu,hv,hThTurb,hqTurb,ts,
+     .           imp_fcg,ts_fcg,Tp_fcg,Turb_fcg)
+             print*,'le pas itap est:',itap
+c
+c===================================================================
+c
+       write(*,'(a)') 'OPEN '//file_forctl
+       open(97,FILE=file_forctl,FORM='FORMATTED')
+c
+c------------------
+      do i=1,1000
+      read(97,1000,end=999) string
+ 1000 format (a4)
+      if (string .eq. 'TDEF') go to 50
+      enddo
+ 50   backspace(97)
+c-------------------------------------------------------------------
+c   *** on lit le pas de temps dans le fichier de donnees ***
+c   *** "forcing.ctl" et pasmax                           ***
+c-------------------------------------------------------------------
+      read(97,2000) aaa
+ 2000  format (a80)
+         print*,'aaa est',aaa
+      aaa=spaces(aaa,1)
+         print*,'aaa',aaa
+      call getsch(aaa,' ',' ',5,atemps,nch)
+         print*,'atemps est',atemps
+        atemps=atemps(1:nch-2)
+         print*,'atemps',atemps
+        read(atemps,*) imn
+        dt=imn*60
+         print*,'le pas de temps dt',dt
+      call getsch(aaa,' ',' ',2,apasmax,nch)
+        apasmax=apasmax(1:nch)
+        read(apasmax,*) ipa
+        pasmax=ipa
+         print*,'pasmax est',pasmax
+      CLOSE(97)
+c------------------------------------------------------------------
+c *** on lit le pas de temps initial de la simulation ***
+c------------------------------------------------------------------
+                  in=itap
+cc                  pasprev=in
+cc                  time0=dt*(pasprev-1)
+                  pasprev=in-1
+                  time0=dt*pasprev
+C
+          close(98)
+c
+      write(*,'(a)') 'OPEN '//file_fordat
+      open(99,FILE=file_fordat,FORM='UNFORMATTED',
+     .          ACCESS='DIRECT',RECL=8)
+          icomp1 = nblvlm*4
+          IF (ts_fcg) icomp1 = icomp1 + 1
+          IF (imp_fcg) icomp1 = icomp1 + nblvlm*2
+          IF (Turb_fcg) icomp1 = icomp1 + nblvlm*2
+          icompt = icomp1*(in-1)
+          call rdgrads(99,icompt,nblvlm,z,ht_mes,hq_mes,hw_mes
+     .                   ,hu_mes,hv_mes,hthturb_mes,hqturb_mes
+     .                   ,ts_fcg,ts_subr,imp_fcg,Turb_fcg)
+          print *, 'get_uvd : rdgrads ->'
+          print *, tp_fcg
+c
+c following commented out because we have temperature already in ARM case
+c   (otherwise this is the potential temperature )
+c------------------------------------------------------------------------
+               if(Tp_fcg) then
+          do i = 1,nblvlm
+            ht_mes(i) = ht_mes(i)*(hplaym(i)/1000.)**rkappa
+          enddo
+               endif ! Tp_fcg
+           print*,'ht_mes ',(ht_mes(i),i=1,nblvlm)
+           print*,'hq_mes ',(hq_mes(i),i=1,nblvlm)
+           print*,'hw_mes ',(hw_mes(i),i=1,nblvlm)
+              if(imp_fcg) then
+           print*,'hu_mes ',(hu_mes(i),i=1,nblvlm)
+           print*,'hv_mes ',(hv_mes(i),i=1,nblvlm)
+           print*,'t',ts_subr
+              endif ! imp_fcg
+              if(Turb_fcg) then
+                 print*,'hThTurb_mes ',(hThTurb_mes(i),i=1,nblvlm)
+                 print*,'hqTurb ',     (hqTurb_mes(i),i=1,nblvlm)
+              endif ! Turb_fcg
+c----------------------------------------------------------------------
+c on a obtenu des champs initiaux sur les niveaux du meso_NH
+c on interpole sur les niveaux du gcm(niveau pression bien sur!)
+c-----------------------------------------------------------------------
+            do k=1,klev
+             if (JM(k) .eq. 0) then
+cFKC bug? ne faut il pas convertir tsol en tendance ????
+cRT bug taken care of by removing the stuff
+           htaft(k)=              ht_mes(jm(k)+1)
+           hqaft(k)=              hq_mes(jm(k)+1)
+           hwaft(k)=              hw_mes(jm(k)+1)
+               if(imp_fcg) then
+           huaft(k)=              hu_mes(jm(k)+1)
+           hvaft(k)=              hv_mes(jm(k)+1)
+               endif ! imp_fcg
+               if(Turb_fcg) then
+           hThTurbaft(k)=         hThTurb_mes(jm(k)+1)
+           hqTurbaft(k)=          hqTurb_mes(jm(k)+1)
+               endif ! Turb_fcg
+             else ! JM(k) .eq. 0
+           htaft(k)=coef1(k)*ht_mes(jm(k))+coef2(k)*ht_mes(jm(k)+1)
+           hqaft(k)=coef1(k)*hq_mes(jm(k))+coef2(k)*hq_mes(jm(k)+1)
+           hwaft(k)=coef1(k)*hw_mes(jm(k))+coef2(k)*hw_mes(jm(k)+1)
+               if(imp_fcg) then
+           huaft(k)=coef1(k)*hu_mes(jm(k))+coef2(k)*hu_mes(jm(k)+1)
+           hvaft(k)=coef1(k)*hv_mes(jm(k))+coef2(k)*hv_mes(jm(k)+1)
+               endif ! imp_fcg
+               if(Turb_fcg) then
+           hThTurbaft(k)=coef1(k)*hThTurb_mes(jm(k))
+     $                  +coef2(k)*hThTurb_mes(jm(k)+1)
+           hqTurbaft(k) =coef1(k)*hqTurb_mes(jm(k))
+     $                  +coef2(k)*hqTurb_mes(jm(k)+1)
+               endif ! Turb_fcg
+             endif ! JM(k) .eq. 0
+            enddo
+            tsaft = ts_subr
+c valeurs initiales des champs de convergence
+          do k=1,klev
+             ht(k)=htaft(k)
+             hq(k)=hqaft(k)
+             hw(k)=hwaft(k)
+                if(imp_fcg) then
+             hu(k)=huaft(k)
+             hv(k)=hvaft(k)
+                endif ! imp_fcg
+                if(Turb_fcg) then
+             hThTurb(k)=hThTurbaft(k)
+             hqTurb(k) =hqTurbaft(k)
+                endif ! Turb_fcg
+          enddo
+	       ts_subr = tsaft
+          close(99)
+          close(98)
+c
+c-------------------------------------------------------------------
+c
+c
+ 100      IF (Ts_fcg) Ts = Ts_subr
+        return
+c
+999     continue
+        stop 'erreur lecture, file forcing.ctl'
+        end
+
+      SUBROUTINE advect_tvl(dtime,zt,zq,vu_f,vv_f,t_f,q_f
+     :                     ,d_t_adv,d_q_adv)
+      use dimphy
+      implicit none
+
+#include "dimensions.h"
+ccccc#include "dimphy.h"
+
+      integer k
+      real dtime, fact, du, dv, cx, cy, alx, aly
+      real zt(klev), zq(klev,3)
+     :   , vu_f(klev), vv_f(klev), t_f(klev), q_f(klev,3)
+
+      real d_t_adv(klev), d_q_adv(klev,3)
+
+c Velocity of moving cell
+      data cx,cy /12., -2./
+
+c Dimensions of moving cell
+      data alx,aly /100 000.,150 000./
+
+      do k = 1, klev
+            du = abs(vu_f(k)-cx)/alx
+            dv = abs(vv_f(k)-cy)/aly
+            fact = dtime *(du+dv-du*dv*dtime)
+            d_t_adv(k) = fact * (t_f(k)-zt(k))
+            d_q_adv(k,1) = fact * (q_f(k,1)-zq(k,1))
+            d_q_adv(k,2) = fact * (q_f(k,2)-zq(k,2))
+            d_q_adv(k,3) = fact * (q_f(k,3)-zq(k,3))
+      enddo
+
+      return
+      end
+
+      SUBROUTINE copie(klevgcm,playgcm,psolgcm,file_forctl)
+      implicit none
+
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c cette routine remplit les COMMON com1_phys_gcss et com2_phys_gcss.h
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      INTEGER klev !nombre de niveau de pression du GCM
+      REAL play(100)  !pression en Pa au milieu de chaque couche GCM
+      INTEGER JM(100)
+      REAL coef1(100)   !coefficient d interpolation
+      REAL coef2(100)   !coefficient d interpolation
+
+      INTEGER nblvlm !nombre de niveau de pression du mesoNH
+      REAL playm(100) !pression en Pa au milieu de chaque couche Meso-NH
+      REAL hplaym(100)!pression en hecto-Pa des milieux de couche Meso-NH
+
+      COMMON/com1_phys_gcss/klev,play,JM,coef1,coef2
+      COMMON/com2_phys_gcss/nblvlm,playm,hplaym
+
+      integer i,k,klevgcm
+      real playgcm(klevgcm) ! pression en milieu de couche du gcm
+      real psolgcm
+      character*80 file_forctl
+
+      klev = klevgcm
+
+c---------------------------------------------------------------------
+c pression au milieu des couches du gcm dans la physiq
+c (SB: remplace le call conv_lipress_gcm(playgcm) )
+c---------------------------------------------------------------------
+
+       do k = 1, klev
+        play(k) = playgcm(k)
+        print*,'la pression gcm est:',play(k)
+       enddo
+
+c----------------------------------------------------------------------
+c lecture du descripteur des donnees Meso-NH (forcing.ctl):
+c  -> nb niveaux du meso.NH (nblvlm) + pressions meso.NH
+c (on remplit le COMMON com2_phys_gcss)
+c----------------------------------------------------------------------
+
+      call mesolupbis(file_forctl)
+
+      print*,'la valeur de nblvlm est:',nblvlm
+
+c----------------------------------------------------------------------
+c etude de la correspondance entre les niveaux meso.NH et GCM;
+c calcul des coefficients d interpolation coef1 et coef2
+c (on remplit le COMMON com1_phys_gcss)
+c----------------------------------------------------------------------
+
+      call corresbis(psolgcm)
+
+c---------------------------------------------------------
+c TEST sur le remplissage de com1_phys_gcss et com2_phys_gcss:
+c---------------------------------------------------------
+ 
+      write(*,*) ' '
+      write(*,*) 'TESTS com1_phys_gcss et com2_phys_gcss dans copie.F'
+      write(*,*) '--------------------------------------'
+      write(*,*) 'GCM: nb niveaux:',klev,' et pression, coeffs:'
+      do k = 1, klev
+      write(*,*) play(k), coef1(k), coef2(k)
+      enddo
+      write(*,*) 'MESO-NH: nb niveaux:',nblvlm,' et pression:'
+      do k = 1, nblvlm
+      write(*,*) playm(k), hplaym(k)
+      enddo
+      write(*,*) ' '
+
+      end
+      SUBROUTINE mesolupbis(file_forctl)
+      implicit none 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c Lecture descripteur des donnees MESO-NH (forcing.ctl):
+c -------------------------------------------------------
+c
+c     Cette subroutine lit dans le fichier de controle "essai.ctl"
+c     et affiche le nombre de niveaux du Meso-NH ainsi que les valeurs
+c     des pressions en milieu de couche du Meso-NH (en Pa puis en hPa).
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      INTEGER nblvlm !nombre de niveau de pression du mesoNH
+      REAL playm(100)  !pression en Pa milieu de chaque couche Meso-NH
+      REAL hplaym(100) !pression en hPa des milieux de couche Meso-NH
+      COMMON/com2_phys_gcss/nblvlm,playm,hplaym
+
+      INTEGER i,lu,k,mlz,mlzh,j
+ 
+      character*80 file_forctl
+
+      character*4 a
+      character*80 aaa,anblvl,spaces
+      integer nch
+
+      lu=9
+      open(lu,file=file_forctl,form='formatted')
+c
+      do i=1,1000
+      read(lu,1000,end=999) a
+      if (a .eq. 'ZDEF') go to 100
+      enddo
+c
+ 100  backspace(lu)
+      print*,'  DESCRIPTION DES 2 MODELES : '
+      print*,' '
+c
+      read(lu,2000) aaa
+ 2000  format (a80)
+       aaa=spaces(aaa,1)
+       call getsch(aaa,' ',' ',2,anblvl,nch)
+         read(anblvl,*) nblvlm
+
+c
+      print*,'nbre de niveaux de pression Meso-NH :',nblvlm
+      print*,' '
+      print*,'pression en Pa de chaque couche du meso-NH :'
+c
+      read(lu,*) (playm(mlz),mlz=1,nblvlm)
+c      Si la pression est en HPa, la multiplier par 100
+      if (playm(1) .lt. 10000.) then
+        do mlz = 1,nblvlm
+         playm(mlz) = playm(mlz)*100.
+        enddo
+      endif
+      print*,(playm(mlz),mlz=1,nblvlm)
+c
+ 1000 format (a4)
+ 1001 format(5x,i2)
+c
+      print*,' '
+      do mlzh=1,nblvlm
+      hplaym(mlzh)=playm(mlzh)/100.
+      enddo
+c
+      print*,'pression en hPa de chaque couche du meso-NH: '
+      print*,(hplaym(mlzh),mlzh=1,nblvlm)
+c
+      close (lu)
+      return
+c
+ 999  stop 'erreur lecture des niveaux pression des donnees'
+      end
+
+      SUBROUTINE rdgrads(itape,icount,nl,z,ht,hq,hw,hu,hv,hthtur,hqtur,
+     :  ts_fcg,ts,imp_fcg,Turb_fcg)
+      IMPLICIT none
+      INTEGER itape,icount,icomp, nl
+      real z(nl),ht(nl),hq(nl),hw(nl),hu(nl),hv(nl)
+      real hthtur(nl),hqtur(nl)
+      real ts
+c
+      INTEGER i, k
+c
+      LOGICAL imp_fcg,ts_fcg,Turb_fcg
+c
+      icomp = icount
+c
+c
+         do k=1,nl
+            icomp=icomp+1
+            read(itape,rec=icomp)z(k)
+            print *,'icomp,k,z(k) ',icomp,k,z(k)
+         enddo
+         do k=1,nl
+            icomp=icomp+1
+            read(itape,rec=icomp)hT(k)
+             print*, hT(k), k
+         enddo
+         do k=1,nl
+            icomp=icomp+1
+            read(itape,rec=icomp)hQ(k)
+         enddo
+c
+             if(turb_fcg) then
+         do k=1,nl
+            icomp=icomp+1
+           read(itape,rec=icomp)hThTur(k)
+         enddo
+         do k=1,nl
+            icomp=icomp+1
+           read(itape,rec=icomp)hqTur(k)
+         enddo
+             endif
+         print *,' apres lecture hthtur, hqtur'
+c
+          if(imp_fcg) then
+
+         do k=1,nl
+            icomp=icomp+1
+           read(itape,rec=icomp)hu(k)
+         enddo
+         do k=1,nl
+            icomp=icomp+1
+            read(itape,rec=icomp)hv(k)
+         enddo
+
+          endif
+c
+         do k=1,nl
+            icomp=icomp+1
+            read(itape,rec=icomp)hw(k)
+         enddo
+c
+              if(ts_fcg) then
+         icomp=icomp+1
+         read(itape,rec=icomp)ts
+              endif
+c
+      print *,' rdgrads ->'
+
+      RETURN
+      END
+
+      SUBROUTINE corresbis(psol)
+      implicit none
+
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c Cette subroutine calcule et affiche les valeurs des coefficients
+c d interpolation qui serviront dans la formule d interpolation elle-
+c meme.
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      INTEGER klev    !nombre de niveau de pression du GCM
+      REAL play(100)  !pression en Pa au milieu de chaque couche GCM
+      INTEGER JM(100)
+      REAL coef1(100) !coefficient d interpolation
+      REAL coef2(100) !coefficient d interpolation
+
+      INTEGER nblvlm !nombre de niveau de pression du mesoNH
+      REAL playm(100) !pression en Pa milieu de chaque couche Meso-NH
+      REAL hplaym(100)!pression en hPa des milieux de couche Meso-NH
+
+      COMMON/com1_phys_gcss/klev,play,JM,coef1,coef2
+      COMMON/com2_phys_gcss/nblvlm,playm,hplaym
+
+      REAL psol
+      REAL val
+      INTEGER k, mlz, mlzh
+
+
+      do k=1,klev
+         val=play(k)
+       if (val .gt. playm(1)) then
+          mlz = 0
+          JM(1) = mlz
+          coef1(1)=(playm(mlz+1)-val)
+     *             /(playm(mlz+1)-psol)
+          coef2(1)=(val-psol)
+     *             /(playm(mlz+1)-psol)
+       else if (val .gt. playm(nblvlm)) then
+         do mlz=1,nblvlm
+          if (     val .le. playm(mlz)
+     *       .and. val .gt. playm(mlz+1))then
+           JM(k)=mlz
+           coef1(k)=(playm(mlz+1)-val)
+     *              /(playm(mlz+1)-playm(mlz))
+           coef2(k)=(val-playm(mlz))
+     *              /(playm(mlz+1)-playm(mlz))
+          endif
+         enddo
+       else
+         JM(k) = nblvlm-1
+         coef1(k) = 0.
+         coef2(k) = 0.
+       endif
+      enddo
+c
+cc      if (play(klev) .le. playm(nblvlm)) then
+cc         mlz=nblvlm-1
+cc         JM(klev)=mlz
+cc         coef1(klev)=(playm(mlz+1)-val)
+cc     *            /(playm(mlz+1)-playm(mlz))
+cc         coef2(klev)=(val-playm(mlz))
+cc     *            /(playm(mlz+1)-playm(mlz))
+cc      endif
+c
+      print*,' '
+      print*,'         INTERPOLATION  : '
+      print*,' '
+      print*,'correspondance de 9 niveaux du GCM sur les 53 du meso-NH:'
+      print*,(JM(k),k=1,klev)
+      print*,'correspondance de 9 niveaux du GCM sur les 53 du meso-NH:'
+      print*,(JM(k),k=1,klev)
+      print*,' '
+      print*,'valeurs du premier coef d"interpolation pour les 9 niveaux
+     *: '
+      print*,(coef1(k),k=1,klev)
+      print*,' '
+      print*,'valeurs du deuxieme coef d"interpolation pour les 9 niveau
+     *x: '
+      print*,(coef2(k),k=1,klev)
+c
+      return
+      end
+      SUBROUTINE GETSCH(STR,DEL,TRM,NTH,SST,NCH)
+C***************************************************************
+C*                                                             *
+C*                                                             *
+C* GETSCH                                                      *
+C*                                                             *
+C*                                                             *
+C* modified by :                                               *
+C***************************************************************
+C*   Return in SST the character string found between the NTH-1 and NTH
+C*   occurence of the delimiter 'DEL' but before the terminator 'TRM' in
+C*   the input string 'STR'. If TRM=DEL then STR is considered unlimited.
+C*   NCH=Length of the string returned in SST or =-1 if NTH is <1 or if
+C*   NTH is greater than the number of delimiters in STR.
+      IMPLICIT INTEGER (A-Z)
+      CHARACTER STR*(*),DEL*1,TRM*1,SST*(*)
+      NCH=-1
+      SST=' '
+      IF(NTH.GT.0) THEN
+        IF(TRM.EQ.DEL) THEN
+          LENGTH=LEN(STR)
+        ELSE
+          LENGTH=INDEX(STR,TRM)-1
+          IF(LENGTH.LT.0) LENGTH=LEN(STR)
+        ENDIF
+C*     Find beginning and end of the NTH DEL-limited substring in STR
+        END=-1
+        DO 1,N=1,NTH
+        IF(END.EQ.LENGTH) RETURN
+        BEG=END+2
+        END=BEG+INDEX(STR(BEG:LENGTH),DEL)-2
+        IF(END.EQ.BEG-2) END=LENGTH
+C*        PRINT *,'NTH,LENGTH,N,BEG,END=',NTH,LENGTH,N,BEG,END
+    1   CONTINUE
+        NCH=END-BEG+1
+        IF(NCH.GT.0) SST=STR(BEG:END)
+      ENDIF
+      END
+      CHARACTER*(*) FUNCTION SPACES(STR,NSPACE)
+C
+C CERN PROGLIB# M433    SPACES          .VERSION KERNFOR  4.14  860211
+C ORIG.  6/05/86 M.GOOSSENS/DD
+C
+C-    The function value SPACES returns the character string STR with
+C-    leading blanks removed and each occurence of one or more blanks
+C-    replaced by NSPACE blanks inside the string STR
+C
+      CHARACTER*(*) STR
+C
+      LENSPA = LEN(SPACES)
+      SPACES = ' '
+      IF (NSPACE.LT.0) NSPACE = 0
+      IBLANK = 1
+      ISPACE = 1
+  100 INONBL = INDEXC(STR(IBLANK:),' ')
+      IF (INONBL.EQ.0) THEN
+          SPACES(ISPACE:) = STR(IBLANK:)
+                                                    GO TO 999
+      ENDIF
+      INONBL = INONBL + IBLANK - 1
+      IBLANK = INDEX(STR(INONBL:),' ')
+      IF (IBLANK.EQ.0) THEN
+          SPACES(ISPACE:) = STR(INONBL:)
+                                                    GO TO 999
+      ENDIF
+      IBLANK = IBLANK + INONBL - 1
+      SPACES(ISPACE:) = STR(INONBL:IBLANK-1)
+      ISPACE = ISPACE + IBLANK - INONBL + NSPACE
+      IF (ISPACE.LE.LENSPA)                         GO TO 100
+  999 END
+      FUNCTION INDEXC(STR,SSTR)
+C
+C CERN PROGLIB# M433    INDEXC          .VERSION KERNFOR  4.14  860211
+C ORIG. 26/03/86 M.GOOSSENS/DD
+C
+C-    Find the leftmost position where substring SSTR does not match
+C-    string STR scanning forward
+C
+      CHARACTER*(*) STR,SSTR
+C
+      LENS   = LEN(STR)
+      LENSS  = LEN(SSTR)
+C
+      DO 10 I=1,LENS-LENSS+1
+          IF (STR(I:I+LENSS-1).NE.SSTR) THEN
+              INDEXC = I
+                                         GO TO 999
+          ENDIF
+   10 CONTINUE
+      INDEXC = 0
+C
+  999 END
Index: LMDZ5/branches/testing/libf/phy1d/add_pbl_tend.F
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/add_pbl_tend.F	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/add_pbl_tend.F	(revision 1665)
@@ -0,0 +1,51 @@
+      SUBROUTINE add_pbl_tend (zdu,zdv,zdt,zdq,zdql,text)
+!======================================================================
+! Ajoute les tendances de couche limite, soit determinees par la parametrisation
+! physique, soit forcees,  aux variables d etat de la dynamique t_seri, q_seri ...
+!======================================================================
+
+
+!======================================================================
+! Declarations
+!======================================================================
+
+      use dimphy
+      use phys_local_var_mod
+      use phys_state_var_mod
+      IMPLICIT none
+#include "dimensions.h"
+        real  hthturb_gcssold(llm)
+        real  hqturb_gcssold(llm)
+        real dtime_frcg
+        logical  Turb_fcg_gcssold
+        common /turb_forcing/ dtime_frcg,
+     $           Turb_fcg_gcssold, hthturb_gcssold, hqturb_gcssold
+! Arguments :
+!------------
+      REAL zdu(klon,klev),zdv(klon,klev)
+      REAL zdt(klon,klev),zdq(klon,klev),zdql(klon,klev)
+      CHARACTER*(*) text
+
+! Local :
+!--------
+      REAL zzdt(klon,klev),zzdq(klon,klev)
+      INTEGER i,k
+!
+      IF (Turb_fcg_gcssold) THEN
+       DO k = 1,klev
+        DO i = 1,klon
+         zzdt(i,k) = hthturb_gcssold(k)*dtime_frcg
+         zzdq(i,k) = hqturb_gcssold(k)*dtime_frcg
+        ENDDO
+       ENDDO
+       print *,' add_pbl_tend, dtime_frcg ', dtime_frcg
+       print *,' add_pbl_tend, zzdt ', zzdt
+       print *,' add_pbl_tend, zzdq ', zzdq
+       CALL add_phys_tend (zdu,zdv,zzdt,zzdq,zdql,text)
+      ELSE
+       CALL add_phys_tend (zdu,zdv, zdt, zdq,zdql,text)
+      ENDIF
+!
+
+      RETURN
+      END
Index: LMDZ5/branches/testing/libf/phy1d/compar1d.h
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/compar1d.h	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/compar1d.h	(revision 1665)
@@ -0,0 +1,43 @@
+!
+! $Id: compar1d.h 2010-08-04 17:02:56Z lahellec $
+!
+      integer :: forcing_type
+      real :: nat_surf
+      real :: tsurf
+      real :: rugos
+      real :: qsol(1:2)
+      real :: qsurf
+      real :: psurf
+      real :: zsurf
+      real :: albedo
+
+      real :: time
+      real :: time_ini
+      real :: xlat 
+      real :: xlon 
+      real :: airefi
+      real :: wtsurf 
+      real :: wqsurf 
+      real :: restart_runoff 
+      real :: xagesno 
+      real :: qsolinp 
+      real :: zpicinp 
+
+      logical :: restart
+
+      common/com_par1d/forcing_type,nat_surf,tsurf,rugos,               &
+     & qsol,qsurf,psurf,zsurf,albedo,time,time_ini,xlat,xlon,airefi,    &
+     & wtsurf,wqsurf,restart_runoff,xagesno,qsolinp,zpicinp,            &
+     & restart
+
+!$OMP THREADPRIVATE(/com_par1d/)
+
+
+
+
+
+
+
+
+
+
Index: LMDZ5/branches/testing/libf/phy1d/fcg_gcssold.h
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/fcg_gcssold.h	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/fcg_gcssold.h	(revision 1665)
@@ -0,0 +1,46 @@
+!
+! $Id: fcg_gcssold.h 2010-08-10 17:02:56Z lahellec $
+!
+      logical :: imp_fcg_gcssold,ts_fcg_gcssold,Tp_fcg_gcssold,
+     $ Tp_ini_gcssold,
+     $ xTurb_fcg_gcssold
+
+      common /fcg_gcssold/imp_fcg_gcssold,ts_fcg_gcssold,Tp_fcg_gcssold,
+     $ Tp_ini_gcssold,
+     $ xTurb_fcg_gcssold
+
+!$OMP THREADPRIVATE(/fcg_gcssold/)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: LMDZ5/branches/testing/libf/phy1d/fcg_racmo.h
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/fcg_racmo.h	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/fcg_racmo.h	(revision 1665)
@@ -0,0 +1,45 @@
+!
+! $Id: fcg_racmo.h 2011-02-16 17:02:56Z cheruy $
+!
+      real   :: a_guide 
+      logical :: ok_invertp 
+      integer :: forc_trb
+      character*31 :: fich_racmo
+
+      common /fcg_racmo/forc_trb,ok_invertp,a_guide,fich_racmo
+
+!$OMP THREADPRIVATE(/fcg_racmo/)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: LMDZ5/branches/testing/libf/phy1d/flux_arp.h
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/flux_arp.h	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/flux_arp.h	(revision 1665)
@@ -0,0 +1,14 @@
+!
+! $Id: flux_arp.h 2010-08-04 17:02:56Z lahellec $
+!
+      logical :: ok_flux_surf
+      real :: fsens
+      real :: flat
+
+      common /flux_arp/fsens,flat,ok_flux_surf
+
+!$OMP THREADPRIVATE(/flux_arp/)
+
+
+
+
Index: LMDZ5/branches/testing/libf/phy1d/lmdz1d.F
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/lmdz1d.F	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/lmdz1d.F	(revision 1665)
@@ -0,0 +1,811 @@
+      PROGRAM lmdz1d
+
+      USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar
+      use phys_state_var_mod
+      use comgeomphy
+      use dimphy
+      use surface_data, only : type_ocean,ok_veget
+      use pbl_surface_mod, only : pbl_surface_init, pbl_surface_final
+      use fonte_neige_mod, only : fonte_neige_init, fonte_neige_final 
+
+      use infotrac ! new
+      use control_mod
+
+      implicit none
+#include "dimensions.h"
+#include "YOMCST.h"
+#include "temps.h"
+!!#include "control.h"
+#include "iniprint.h"
+#include "clesphys.h"
+#include "dimsoil.h"
+#include "indicesol.h"
+
+#include "comvert.h"
+#include "compar1d.h"
+#include "flux_arp.h"
+#include "fcg_gcssold.h"
+!!!#include "fbforcing.h"
+
+!=====================================================================
+! DECLARATIONS
+!=====================================================================
+
+!---------------------------------------------------------------------
+!  Externals
+!---------------------------------------------------------------------
+      external fq_sat
+      real fq_sat
+
+!---------------------------------------------------------------------
+!  Arguments d' initialisations de la physique (USER DEFINE)
+!---------------------------------------------------------------------
+
+      integer, parameter :: ngrid=1
+      real :: zcufi    = 1.
+      real :: zcvfi    = 1.
+
+!-      real :: nat_surf
+!-      logical :: ok_flux_surf
+!-      real :: fsens
+!-      real :: flat
+!-      real :: tsurf
+!-      real :: rugos
+!-      real :: qsol(1:2)
+!-      real :: qsurf
+!-      real :: psurf
+!-      real :: zsurf
+!-      real :: albedo
+!-
+!-      real :: time     = 0.
+!-      real :: time_ini
+!-      real :: xlat 
+!-      real :: xlon 
+!-      real :: wtsurf 
+!-      real :: wqsurf 
+!-      real :: restart_runoff 
+!-      real :: xagesno 
+!-      real :: qsolinp 
+!-      real :: zpicinp 
+!-
+      real :: fnday 
+      real :: day, daytime 
+      real :: day1
+      real :: heure
+      integer :: jour
+      integer :: mois
+      integer :: an
+ 
+!
+      real :: paire    = 1.     ! aire de la maille
+!**      common /flux_arp/fsens,flat,ok_flux_surf
+
+!---------------------------------------------------------------------
+!  Declarations related to forcing and initial profiles 
+!---------------------------------------------------------------------
+
+        integer :: kmax = llm
+        integer nlev_max
+        parameter (nlev_max = 100)
+        real timestep, frac, timeit
+        real height(nlev_max),tttprof(nlev_max),qtprof(nlev_max),
+     .              uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max),
+     .              ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max),
+     .              dqtdxls(nlev_max),dqtdyls(nlev_max),
+     .              dqtdtls(nlev_max),thlpcar(nlev_max)
+
+        real    :: fff
+c        integer :: forcing_type
+        logical :: forcing_les     = .false.
+        logical :: forcing_armcu  = .false.
+        logical :: forcing_rico    = .false.
+        logical :: forcing_radconv = .false.
+        logical :: forcing_toga    = .false.
+        logical :: forcing_twpice  = .false.
+        logical :: forcing_GCM2SCM = .false.
+        logical :: forcing_GCSSold = .false.
+        integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
+!                                                            (cf read_tsurf1d.F)
+
+!vertical advection computation
+        real d_t_z(llm), d_q_z(llm)
+        real d_t_dyn_z(llm), d_q_dyn_z(llm)
+        real zz(llm)
+        real zfact
+
+!flag forcings
+        logical :: nudge_wind=.true.
+        logical :: nudge_thermo=.false.
+        logical :: cptadvw=.true.
+!=====================================================================
+! DECLARATIONS FOR EACH CASE
+!=====================================================================
+!
+#include "1D_decl_cases.h"
+!
+!---------------------------------------------------------------------
+!  Declarations related to vertical discretization:
+!---------------------------------------------------------------------
+      real :: pzero=1.e5
+      real :: play (llm),zlay (llm),sig_s(llm),plev(llm+1)
+      real :: playd(llm),zlayd(llm)
+
+!---------------------------------------------------------------------
+!  Declarations related to variables
+!---------------------------------------------------------------------
+
+      integer :: iq
+      real :: phi(llm)
+      real :: teta(llm),temp(llm),u(llm),v(llm)
+      real :: omega(llm+1),omega2(llm),rho(llm+1)
+      real :: ug(llm),vg(llm),fcoriolis
+      real :: du_phys(llm),dv_phys(llm),dt_phys(llm)
+      real :: du_dyn(llm),dv_dyn(llm),dt_dyn(llm)
+      real :: dt_cooling(llm),d_t_cool(llm),d_th_adv(llm)
+      real :: dq_cooling(llm),d_q_cool(llm)
+      real :: tmpvar(llm)
+      real :: alpha
+
+      REAL, ALLOCATABLE, DIMENSION(:,:):: q
+      REAL, ALLOCATABLE, DIMENSION(:,:):: dq
+      REAL, ALLOCATABLE, DIMENSION(:,:):: dq_dyn
+      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_adv
+
+!---------------------------------------------------------------------
+!  Initialization of surface variables
+!---------------------------------------------------------------------
+      real :: run_off_lic_0(1)
+      real :: fder(1),snsrf(1,nbsrf),qsurfsrf(1,nbsrf)
+      real :: evap(1,nbsrf),frugs(1,nbsrf)
+      real :: tsoil(1,nsoilmx,nbsrf)
+      real :: agesno(1,nbsrf)
+
+!---------------------------------------------------------------------
+!  Call to phyredem
+!---------------------------------------------------------------------
+      logical :: ok_writedem =.true.
+      
+!---------------------------------------------------------------------
+!  Call to physiq
+!---------------------------------------------------------------------
+      integer, parameter :: longcles=20
+      logical :: firstcall=.true.
+      logical :: lastcall=.false.
+      real :: phis    = 0.0
+      real :: clesphy0(longcles) = 0.0
+      real :: dpsrf 
+
+!---------------------------------------------------------------------
+!  Initializations of boundary conditions 
+!---------------------------------------------------------------------
+      integer, parameter :: yd = 360
+      real :: phy_nat (yd) = 0.0 ! 0=ocean libre,1=land,2=glacier,3=banquise
+      real :: phy_alb (yd)  ! Albedo land only (old value condsurf_jyg=0.3)
+      real :: phy_sst (yd)  ! SST (will not be used; cf read_tsurf1d.F)
+      real :: phy_bil (yd) = 1.0 ! Ne sert que pour les slab_ocean
+      real :: phy_rug (yd) ! Longueur rugosite utilisee sur land only
+      real :: phy_ice (yd) = 0.0 ! Fraction de glace
+      real :: phy_fter(yd) = 0.0 ! Fraction de terre
+      real :: phy_foce(yd) = 0.0 ! Fraction de ocean
+      real :: phy_fsic(yd) = 0.0 ! Fraction de glace
+      real :: phy_flic(yd) = 0.0 ! Fraction de glace
+
+!---------------------------------------------------------------------
+!  Fichiers et d'autres variables
+!---------------------------------------------------------------------
+      real ttt
+      integer :: ierr,k,l,i,it=1,mxcalc
+      integer jjmp1
+      parameter (jjmp1=jjm+1-1/jjm)
+      INTEGER nbteta
+      PARAMETER(nbteta=3)
+      REAL dudyn(iim+1,jjmp1,llm)
+      REAL PVteta(1,nbteta)
+      INTEGER read_climoz 
+!Al1
+      integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
+      data ecrit_slab_oc/-1/
+
+!=====================================================================
+! INITIALIZATIONS 
+!=====================================================================
+! Initialization of Common turb_forcing
+       dtime_frcg = 0.
+       Turb_fcg_gcssold=.false.
+       hthturb_gcssold = 0.
+       hqturb_gcssold = 0.
+
+!---------------------------------------------------------------------
+! OPTIONS OF THE 1D SIMULATION (lmdz1d.def => unicol.def)
+!---------------------------------------------------------------------
+cAl1
+        call conf_unicol(99)
+cAl1 moves this gcssold var from common fcg_gcssold to 
+        Turb_fcg_gcssold = xTurb_fcg_gcssold
+c --------------------------------------------------------------------
+        close(1)
+cAl1
+        write(*,*) 'lmdz1d.def lu => unicol.def'
+
+! forcing_type defines the way the SCM is forced:
+!forcing_type = 0 ==> forcing_les = .true.
+!             initial profiles from file prof.inp.001
+!             no forcing by LS convergence ; 
+!             surface temperature imposed ;
+!             radiative cooling may be imposed (iflag_radia=0 in physiq.def)
+!forcing_type = 1 ==> forcing_radconv = .true.
+!             idem forcing_type = 0, but the imposed radiative cooling 
+!             is set to 0 (hence, if iflag_radia=0 in physiq.def, 
+!             then there is no radiative cooling at all)
+!forcing_type = 2 ==> forcing_toga = .true.
+!             initial profiles from TOGA-COARE IFA files 
+!             LS convergence and SST imposed from TOGA-COARE IFA files 
+!forcing_type = 3 ==> forcing_GCM2SCM = .true.
+!             initial profiles from the GCM output
+!             LS convergence imposed from the GCM output
+!forcing_type = 4 ==> forcing_twpice = .true.
+!             initial profiles from TWP-ICE cdf file 
+!             LS convergence, omega and SST imposed from TWP-ICE files 
+!forcing_type = 5 ==> forcing_rico = .true.
+!             initial profiles from RICO files 
+!             LS convergence imposed from RICO files 
+!forcing_type = 40 ==> forcing_GCSSold = .true.
+!             initial profile from GCSS file
+!             LS convergence imposed from GCSS file
+!forcing_type = 61 ==> forcing_armcu = .true.
+!             initial profile from arm_cu file
+!             LS convergence imposed from arm_cu file
+!
+      if (forcing_type .eq.0) THEN
+       forcing_les = .true.
+      elseif (forcing_type .eq.1) THEN
+       forcing_radconv = .true.
+      elseif (forcing_type .eq.2) THEN
+       forcing_toga    = .true.
+      elseif (forcing_type .eq.3) THEN
+       forcing_GCM2SCM = .true.
+      elseif (forcing_type .eq.4) THEN
+       forcing_twpice = .true.
+      elseif (forcing_type .eq.5) THEN
+       forcing_rico = .true.
+      elseif (forcing_type .eq.40) THEN
+       forcing_GCSSold = .true.
+      elseif (forcing_type .eq.61) THEN
+       forcing_armcu = .true.
+      else
+       write (*,*) 'ERROR : unknown forcing_type ', forcing_type
+       stop 'Forcing_type should be 0,1,2,3 or 40'
+      ENDIF
+      print*,"forcing type=",forcing_type
+
+! if type_ts_forcing=0, the surface temp of 1D simulation is constant in time
+! (specified by tsurf in lmdz1d.def); if type_ts_forcing=1, the surface temperature
+! varies in time according to a forcing (e.g. forcing_toga) and is passed to read_tsurf1d.F
+! through the common sst_forcing.
+
+        type_ts_forcing = 0
+        if (forcing_toga) type_ts_forcing = 1
+
+!---------------------------------------------------------------------
+!  Definition of the run
+!---------------------------------------------------------------------
+
+      call conf_gcm( 99, .TRUE. , clesphy0 )
+c-----------------------------------------------------------------------
+c   Choix du calendrier
+c   -------------------
+
+c      calend = 'earth_365d'
+      if (calend == 'earth_360d') then
+        call ioconf_calendar('360d')
+        write(*,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
+      else if (calend == 'earth_365d') then
+        call ioconf_calendar('noleap')
+        write(*,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
+      else if (calend == 'earth_366d') then
+        call ioconf_calendar('all_leap')
+        write(*,*)'CALENDRIER CHOISI: Terrestre bissextile'
+      else if (calend == 'gregorian') then
+        call ioconf_calendar('gregorian') ! not to be used by normal users
+        write(*,*)'CALENDRIER CHOISI: Gregorien'
+      else
+        write (*,*) 'ERROR : unknown calendar ', calend
+        stop 'calend should be 360d,earth_365d,earth_366d,gregorian'
+      endif
+c-----------------------------------------------------------------------
+c
+cc Date :
+c      La date est supposee donnee sous la forme [annee, numero du jour dans 
+c      l annee] ; l heure est donnee dans time_ini, lu dans lmdz1d.def.
+c      On appelle ymds2ju pour convertir [annee, jour] en [jour Julien].
+c      Le numero du jour est dans "day". L heure est traitee separement.
+c      La date complete est dans "daytime" (l'unite est le jour).
+      fnday=nday
+c Special case for arm_cu which lasts less than one day : 53100s !! (MPL 20111026)
+      IF(forcing_type .EQ. 61) fnday=53100./86400.
+      annee_ref = anneeref
+      mois = 1
+      day_ref = dayref
+      heure = 0.
+      itau_dyn = 0
+      itau_phy = 0
+      call ymds2ju(annee_ref,mois,day_ref,heure,day)
+      day_ini = day
+      day_end = day_ini + nday
+! Convert the initial date of Toga-Coare to Julian day
+      call ymds2ju
+     $ (year_ini_toga,mth_ini_toga,day_ini_toga,heure,day_ju_ini_toga)
+
+! Convert the initial date of TWPICE to Julian day
+      call ymds2ju
+     $ (year_ini_twpi,mth_ini_twpi,day_ini_twpi,heure_ini_twpi
+     $ ,day_ju_ini_twpi)
+
+! Convert the initial date of Arm_cu to Julian day
+      call ymds2ju
+     $ (year_ini_armcu,mth_ini_armcu,day_ini_armcu,heure_ini_armcu
+     $ ,day_ju_ini_armcu)
+
+      daytime = day + time_ini/24. ! 1st day and initial time of the simulation 
+! Print out the actual date of the beginning of the simulation :
+      call ju2ymds(daytime,year_print, month_print,day_print,sec_print)
+      print *,' Time of beginning : ',
+     $        year_print, month_print, day_print, sec_print
+
+!---------------------------------------------------------------------
+! Initialization of dimensions, geometry and initial state
+!---------------------------------------------------------------------
+      call init_phys_lmdz(1,1,llm,1,(/1/))
+      call suphel
+      call initcomgeomphy
+      call infotrac_init 
+
+      allocate(q(llm,nqtot)) 
+      allocate(dq(llm,nqtot)) 
+      allocate(dq_dyn(llm,nqtot)) 
+      allocate(d_q_adv(llm,nqtot)) 
+
+c
+c   No ozone climatology need be read in this pre-initialization
+c          (phys_state_var_init is called again in physiq)
+      read_climoz = 0
+c
+      call phys_state_var_init(read_climoz)
+
+      if (ngrid.ne.klon) then
+         print*,'stop in inifis'
+         print*,'Probleme de dimensions :'
+         print*,'ngrid = ',ngrid
+         print*,'klon  = ',klon
+         stop
+      endif
+!!!=====================================================================
+!!! Feedback forcing values for Gateaux differentiation (al1)
+!!!=====================================================================
+!!! Surface Planck forcing bracketing call radiation
+!!      surf_Planck = 0.
+!!      surf_Conv   = 0.
+!!      write(*,*) 'Gateaux-dif Planck,Conv:',surf_Planck,surf_Conv
+!!! a mettre dans le lmdz1d.def ou autre
+!!
+!!
+      qsol = qsolinp
+      qsurf = fq_sat(tsurf,psurf/100.)
+      rlat=xlat
+      rlon=xlon
+      day1= day_ini
+      time=daytime-day
+      ts_toga(1)=tsurf ! needed by read_tsurf1d.F
+      rho(1)=psurf/(rd*tsurf*(1.+(rv/rd-1.)*qsurf)) 
+
+      ok_flux_surf=.false.
+      fsens=-wtsurf*rcpd*rho(1)
+      flat=-wqsurf*rlvtt*rho(1)
+
+! Vertical discretization and pressure levels at half and mid levels:
+
+      pa   = 5e4
+!!      preff= 1.01325e5
+      preff = psurf
+      call disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
+      sig_s=presnivs/preff
+      plev =ap+bp*psurf
+      play = 0.5*(plev(1:llm)+plev(2:llm+1))
+ccc      zlay=-rd*300.*log(play/psurf)/rg ! moved after reading profiles
+
+      write(*,*) '***********************'
+      do l = 1, llm
+       write(*,*) 'l,play(l),presnivs(l): ',l,play(l),presnivs(l)
+      enddo
+      write(*,*) '***********************'
+
+c
+!=====================================================================
+! EVENTUALLY, READ FORCING DATA :
+!=====================================================================
+
+#include "1D_read_forc_cases.h"
+
+      if (forcing_GCM2SCM) then
+        write (*,*) 'forcing_GCM2SCM not yet implemented'
+        stop 'in initialization'
+      endif ! forcing_GCM2SCM
+
+      print*,'mxcalc=',mxcalc
+      print*,'zlay=',zlay(mxcalc)
+      print*,'play=',play(mxcalc)
+
+cAl1 pour SST forced, appellé depuis ocean_forced_noice
+      ts_cur = tsurf ! SST used in read_tsurf1d
+!=====================================================================
+! Initialisation de la physique : 
+!=====================================================================
+
+!  Rq: conf_phys.F90 lit tous les flags de physiq.def; conf_phys appele depuis physiq.F
+!
+! day_step, iphysiq lus dans gcm.def ci-dessus
+! timestep: calcule ci-dessous from rday et day_step
+! ngrid=1
+! llm: defini dans .../modipsl/modeles/LMDZ4/libf/grid/dimension
+! rday: defini dans suphel.F (86400.)
+! day_ini: lu dans run.def (dayref)
+! rlat,rlon lus dans lmdz1d.def
+! airefi,zcufi,zcvfi initialises au debut de ce programme
+! rday,ra,rg,rd,rcpd declares dans YOMCST.h et calcules dans suphel.F
+      day_step = float(nsplit_phys)*day_step/float(iphysiq)
+      write (*,*) 'Time step divided by nsplit_phys (=',nsplit_phys,')'
+      timestep =rday/day_step
+      dtime_frcg = timestep
+!
+      zcufi=airefi
+      zcvfi=airefi
+
+      call iniphysiq(ngrid,llm,rday,day_ini,timestep,
+     .     rlat,rlon,airefi,zcufi,zcvfi,ra,rg,rd,rcpd)
+      print*,'apres iniphysiq'
+
+! 2 PARAMETRES QUI DEVRAIENT ETRE LUS DANS run.def MAIS NE LE SONT PAS ICI:
+      co2_ppm= 330.0
+      solaire=1370.0
+
+! Ecriture du startphy avant le premier appel a la physique.
+! On le met juste avant pour avoir acces a tous les champs
+! NB: les clesphy0 seront remplies dans phyredem d'apres les flags lus dans gcm.def
+
+      if (ok_writedem) then
+
+!--------------------------------------------------------------------------
+! pbl_surface_init (called here) and pbl_surface_final (called by phyredem)
+! need : qsol fder snow qsurf evap rugos agesno ftsoil
+!--------------------------------------------------------------------------
+
+        type_ocean = "force"
+        run_off_lic_0(1) = restart_runoff 
+        call fonte_neige_init(run_off_lic_0)
+
+        fder=0.
+        snsrf(1,:)=0.        ! couverture de neige des sous surface
+        qsurfsrf(1,:)=qsurf ! humidite de l'air des sous surface
+        evap=0.
+        frugs(1,:)=rugos     ! couverture de neige des sous surface
+        agesno  = xagesno
+        tsoil(:,:,:)=tsurf
+        call pbl_surface_init(qsol, fder, snsrf, qsurfsrf,
+     &                                    evap, frugs, agesno, tsoil)
+
+!------------------ prepare limit conditions for limit.nc -----------------
+!--   Ocean force
+
+        print*,'avant phyredem'
+        pctsrf(1,:)=0.
+        if (nat_surf.eq.0.) then
+          pctsrf(1,is_oce)=1.
+          pctsrf(1,is_ter)=0.
+        else
+          pctsrf(1,is_oce)=0.
+          pctsrf(1,is_ter)=1.
+        end if
+
+        print*,'nat_surf,pctsrf(1,is_oce),pctsrf(1,is_ter)',nat_surf
+     $        ,pctsrf(1,is_oce),pctsrf(1,is_ter)
+
+        zmasq=pctsrf(1,is_ter)+pctsrf(1,is_lic)
+        zpic = zpicinp
+        ftsol=tsurf
+        falb1 = albedo                            
+        falb2 = albedo                            
+        rugoro=rugos 
+        t_ancien(1,:)=temp(:)
+        q_ancien(1,:)=q(:,1)
+        pbl_tke=1.e-8
+
+        rain_fall=0.
+        snow_fall=0.
+        solsw=0.
+        sollw=0.
+        radsol=0.
+        rnebcon=0.
+        ratqs=0.
+        clwcon=0.
+        zmea=0.
+        zstd=0.
+        zsig=0.
+        zgam=0.
+        zval=0. 
+        zthe=0. 
+        ema_work1=0.
+        ema_work2=0.
+ 
+!------------------------------------------------------------------------
+! Make file containing restart for the physics (startphy.nc)
+!
+! NB: List of the variables to be written by phyredem (via put_field):
+! rlon,rlat,zmasq,pctsrf(:,is_ter),pctsrf(:,is_lic),pctsrf(:,is_oce)
+! pctsrf(:,is_sic),ftsol(:,nsrf),tsoil(:,isoil,nsrf),qsurf(:,nsrf)
+! qsol,falb1(:,nsrf),falb2(:,nsrf),evap(:,nsrf),snow(:,nsrf)
+! radsol,solsw,sollw,fder,rain_fall,snow_fall,frugs(:,nsrf)
+! agesno(:,nsrf),zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro
+! t_ancien,q_ancien,frugs(:,is_oce),clwcon(:,1),rnebcon(:,1),ratqs(:,1)
+! run_off_lic_0,pbl_tke(:,1:klev,nsrf),zmax0,f0,ema_work1,ema_work2
+! wake_deltat,wake_deltaq,wake_s,wake_cstar,wake_fip
+!------------------------------------------------------------------------
+CAl1 =============== restart option ==========================
+        if (.not.restart) then
+          call phyredem ("startphy.nc")
+        else
+c (desallocations)
+        print*,'callin surf final'
+          call pbl_surface_final(qsol, fder, snsrf, qsurfsrf,
+     &                                    evap, frugs, agesno, tsoil)
+        print*,'after surf final'
+          CALL fonte_neige_final(run_off_lic_0)
+        endif
+
+        ok_writedem=.false.
+        print*,'apres phyredem'
+
+      endif ! ok_writedem
+      
+!------------------------------------------------------------------------
+! Make file containing boundary conditions (limit.nc) **Al1->restartdyn***
+! --------------------------------------------------
+! NB: List of the variables to be written in limit.nc 
+!     (by writelim.F, subroutine of 1DUTILS.h):
+!        phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,phy_ice,
+!        phy_fter,phy_foce,phy_flic,phy_fsic)
+!------------------------------------------------------------------------
+      do i=1,yd
+        phy_nat(i)  = nat_surf
+        phy_alb(i)  = albedo
+        phy_sst(i)  = tsurf ! read_tsurf1d will be used instead
+        phy_rug(i)  = rugos
+        phy_fter(i) = pctsrf(1,is_ter)
+        phy_foce(i) = pctsrf(1,is_oce)
+        phy_fsic(i) = pctsrf(1,is_sic)
+        phy_flic(i) = pctsrf(1,is_lic)
+      enddo
+
+C fabrication de limit.nc
+      call writelim (1,phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,
+     &               phy_ice,phy_fter,phy_foce,phy_flic,phy_fsic)
+
+
+      call phys_state_var_end
+cAl1
+      if (restart) then
+        print*,'call to restart dyn 1d'
+        Call dyn1deta0("start1dyn.nc",
+     &              plev,play,phi,phis,presnivs,
+     &              u,v,temp,q,omega2)
+
+       print*,'fnday,annee_ref,day_ref,day_ini',
+     &     fnday,annee_ref,day_ref,day_ini
+c**      call ymds2ju(annee_ref,mois,day_ini,heure,day)
+       day = day_ini
+       day_end = day_ini + nday
+       daytime = day + time_ini/24. ! 1st day and initial time of the simulation 
+
+! Print out the actual date of the beginning of the simulation :
+       call ju2ymds(daytime, an, mois, jour, heure)
+       print *,' Time of beginning : y m d h',an, mois,jour,heure/3600.
+
+       day = int(daytime)
+       time=daytime-day
+  
+       print*,'****** intialised fields from restart1dyn *******'
+       print*,'plev,play,phi,phis,presnivs,u,v,temp,q,omega2'
+       print*,'temp(1),q(1,1),u(1),v(1),plev(1),phis :'
+       print*,temp(1),q(1,1),u(1),v(1),plev(1),phis
+c raz for safety
+       do l=1,llm
+         dq_dyn(l,1) = 0.
+       enddo
+      endif
+!Al1 ================  end restart =================================
+      IF (ecrit_slab_oc.eq.1) then
+         open(97,file='div_slab.dat',STATUS='UNKNOWN')
+       elseif (ecrit_slab_oc.eq.0) then
+         open(97,file='div_slab.dat',STATUS='OLD')
+       endif
+!=====================================================================
+! START OF THE TEMPORAL LOOP :
+!=====================================================================
+           
+      do while(it.le.nint(fnday*day_step))
+
+       if (prt_level.ge.1) then
+         print*,'XXXXXXXXXXXXXXXXXXX ITAP,day,time=',
+     .                                it,day,time,nint(fnday*day_step)
+         print*,'PAS DE TEMPS ',timestep
+       endif
+!Al1 demande de restartphy.nc
+       if (it.eq.nint(fnday*day_step)) lastcall=.True.
+
+!---------------------------------------------------------------------
+! Interpolation of forcings in time and onto model levels
+!---------------------------------------------------------------------
+
+#include "1D_interp_cases.h"
+
+      if (forcing_GCM2SCM) then
+        write (*,*) 'forcing_GCM2SCM not yet implemented'
+        stop 'in time loop'
+      endif ! forcing_GCM2SCM
+
+!---------------------------------------------------------------------
+!  Geopotential :
+!---------------------------------------------------------------------
+
+        phi(1)=RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
+        do l = 1, llm-1
+          phi(l+1)=phi(l)+RD*(temp(l)+temp(l+1))*
+     .    (play(l)-play(l+1))/(play(l)+play(l+1))
+        enddo
+
+!---------------------------------------------------------------------
+!   Call physiq :
+!---------------------------------------------------------------------
+
+       if (prt_level.ge.1) then
+         print *,' avant physiq : -------- day time ',day,time
+         print *,' temp ',temp
+         print *,' u ',u
+         print *,' q ',q
+         print *,' omega2 ',omega2
+       endif
+!       call writefield_phy('u', u,llm)
+
+        call physiq(ngrid,llm,
+     :              firstcall,lastcall,
+     :              day,time,timestep,
+     :              plev,play,phi,phis,presnivs,clesphy0,
+     :              u,v,temp,q,omega2,
+     :              du_phys,dv_phys,dt_phys,dq,dpsrf,
+     :              dudyn,PVteta)
+!       call writefield_phy('u', u,llm)
+
+        firstcall=.false.
+        if (prt_level.ge.1) then
+          print*,'APRES PHYS'
+          print *,' temp ',temp
+          print *,' q ',q
+          print *,' dq ',dq
+          print*,'dq_dyn',dq_dyn
+          print *,' dt_phys ',dt_phys
+          print *,' dpsrf ',dpsrf
+          print *,' dudyn ',dudyn
+          print *,' PVteta',PVteta
+        endif
+!---------------------------------------------------------------------
+!   Add physical tendencies :
+!---------------------------------------------------------------------
+
+      fcoriolis=2.*sin(rpi*rlat(1)/180.)*romega
+
+       if (forcing_radconv) then
+         fcoriolis=0.0
+         dt_cooling=0.0
+         d_th_adv=0.0
+         d_q_adv=0.0
+       endif
+
+       if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice) then
+         fcoriolis=0.0
+       endif
+         if(forcing_rico) then
+          dt_cooling=0.
+        endif
+
+      print*, 'fcoriolis ', fcoriolis, rlat(1)
+
+        du_age(1:mxcalc)=
+     : fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
+       dv_age(1:mxcalc)=
+     : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
+!         call  writefield_phy('dv_age' ,dv_age,llm)
+!         call  writefield_phy('du_age' ,du_age,llm)
+!         call  writefield_phy('du_phys' ,du_phys,llm)
+!         call  writefield_phy('u_tend' ,u,llm)
+!         call  writefield_phy('u_g' ,ug,llm)
+        u(1:mxcalc)=u(1:mxcalc) + timestep*(
+     :              du_phys(1:mxcalc)
+     :             +du_age(1:mxcalc) )            
+        v(1:mxcalc)=v(1:mxcalc) + timestep*(
+     :	             dv_phys(1:mxcalc)
+     :             +dv_age(1:mxcalc) )
+        q(1:mxcalc,:)=q(1:mxcalc,:)+timestep*(
+     :                dq(1:mxcalc,:)
+     :               +d_q_adv(1:mxcalc,:) )
+
+        if (prt_level.ge.1) then
+          print *,
+     :    'physiq-> temp(1),dt_phys(1),d_th_adv(1),dt_cooling(1) ',
+     :              temp(1),dt_phys(1),d_th_adv(1),dt_cooling(1)
+           print*,du_phys
+           print*, v
+           print*, vg
+        endif
+
+        temp(1:mxcalc)=temp(1:mxcalc)+timestep*(
+     .              dt_phys(1:mxcalc)
+     .             +d_th_adv(1:mxcalc)
+     .             +dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.
+
+        teta=temp*(pzero/play)**rkappa
+
+!---------------------------------------------------------------------
+!   Add large-scale tendencies (advection, etc) :
+!---------------------------------------------------------------------
+
+ccc nrlmd
+ccc        tmpvar=teta
+ccc        call advect_vert(llm,omega,timestep,tmpvar,plev)
+ccc
+ccc        teta(1:mxcalc)=tmpvar(1:mxcalc)
+ccc        tmpvar(:)=q(:,1)
+ccc        call advect_vert(llm,omega,timestep,tmpvar,plev)
+ccc        q(1:mxcalc,1)=tmpvar(1:mxcalc)
+ccc        tmpvar(:)=q(:,2)
+ccc        call advect_vert(llm,omega,timestep,tmpvar,plev)
+ccc        q(1:mxcalc,2)=tmpvar(1:mxcalc)
+
+!---------------------------------------------------------------------
+!   Air temperature :
+!---------------------------------------------------------------------        
+        if (lastcall) then
+          print*,'Pas de temps final ',it
+          call ju2ymds(daytime, an, mois, jour, heure)
+          print*,'a la date : a m j h',an, mois, jour ,heure/3600.
+        endif
+
+c  incremente day time
+c        print*,'daytime bef',daytime,1./day_step
+        daytime = daytime+1./day_step
+!Al1dbg
+        day = int(daytime+0.1/day_step)
+c        time = max(daytime-day,0.0)
+cAl1&jyg: correction de bug
+ccc        time = real(mod(it,day_step))/day_step
+        time = time_ini/24.+real(mod(it,day_step))/day_step
+c        print*,'daytime nxt time',daytime,time
+        it=it+1
+
+      enddo
+
+!Al1
+      if (ecrit_slab_oc.ne.-1) close(97)
+
+!Al1 Call to 1D equivalent of dynredem (an,mois,jour,heure ?)
+! -------------------------------------
+       call dyn1dredem("restart1dyn.nc",
+     :              plev,play,phi,phis,presnivs,
+     :              u,v,temp,q,omega2)
+
+        CALL abort_gcm ('lmdz1d   ','The End  ',0)
+
+      end
+
+#include "1DUTILS.h"
+#include "1Dconv.h"
+
+
Index: LMDZ5/branches/testing/libf/phy1d/ocean_forced_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/ocean_forced_mod.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/ocean_forced_mod.F90	(revision 1665)
@@ -0,0 +1,278 @@
+!
+MODULE ocean_forced_mod
+!
+! This module is used for both the sub-surfaces ocean and sea-ice for the case of a 
+! forced ocean,  "ocean=force".
+!
+  IMPLICIT NONE
+
+CONTAINS
+!
+!****************************************************************************************
+!
+  SUBROUTINE ocean_forced_noice( &
+       itime, dtime, jour, knon, knindex, &
+       p1lay, cdragh, cdragm, precip_rain, precip_snow, &
+       temp_air, spechum, &
+       AcoefH, AcoefQ, BcoefH, BcoefQ, &
+       AcoefU, AcoefV, BcoefU, BcoefV, &
+       ps, u1, v1, &
+       radsol, snow, agesno, & 
+       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
+       tsurf_new, dflux_s, dflux_l)
+!
+! This subroutine treats the "open ocean", all grid points that are not entierly covered
+! by ice.
+! The routine receives data from climatologie file limit.nc and does some calculations at the 
+! surface. 
+!
+    USE dimphy
+    USE calcul_fluxs_mod
+    USE limit_read_mod
+    USE mod_grid_phy_lmdz
+    INCLUDE "indicesol.h"
+    INCLUDE "YOMCST.h"
+
+! Input arguments
+!****************************************************************************************
+    INTEGER, INTENT(IN)                      :: itime, jour, knon
+    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
+    REAL, INTENT(IN)                         :: dtime
+    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
+    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
+    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
+    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
+    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
+    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
+    REAL, DIMENSION(klon), INTENT(IN)        :: ps
+    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
+
+! In/Output arguments
+!****************************************************************************************
+    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
+    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
+    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno !? put to 0 in ocean
+  
+! Output arguments
+!****************************************************************************************
+    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
+    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
+    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
+    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
+    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l
+
+! Local variables
+!****************************************************************************************
+    INTEGER                     :: i
+    REAL, DIMENSION(klon)       :: cal, beta, dif_grnd
+    REAL, DIMENSION(klon)       :: alb_neig, tsurf_lim, zx_sl
+    REAL, DIMENSION(klon)       :: u0, v0
+    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
+    LOGICAL                     :: check=.FALSE.
+
+!****************************************************************************************
+! Start calculation
+!****************************************************************************************
+    IF (check) WRITE(*,*)' Entering ocean_forced_noice'
+    
+!****************************************************************************************
+! 1)    
+! Read sea-surface temperature from file limit.nc
+!
+!****************************************************************************************
+!--sb:
+!!jyg    if (knon.eq.1) then ! single-column model
+    if (klon_glo.eq.1) then ! single-column model
+      CALL read_tsurf1d(knon,knindex,tsurf_lim) ! new
+    else ! GCM
+      CALL limit_read_sst(knon,knindex,tsurf_lim)
+    endif ! knon
+!sb--
+
+!****************************************************************************************
+! 2)
+! Flux calculation
+!
+!****************************************************************************************
+! Set some variables for calcul_fluxs
+    cal = 0.
+    beta = 1.
+    dif_grnd = 0.
+    alb_neig(:) = 0.
+    agesno(:) = 0.
+! Suppose zero surface speed
+    u0(:)=0.0
+    v0(:)=0.0
+    u1_lay(:) = u1(:) - u0(:)
+    v1_lay(:) = v1(:) - v0(:)
+
+! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf
+    CALL calcul_fluxs(knon, is_oce, dtime, &
+         tsurf_lim, p1lay, cal, beta, cdragh, ps, &
+         precip_rain, precip_snow, snow, qsurf,  &
+         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
+         AcoefH, AcoefQ, BcoefH, BcoefQ, &
+         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
+
+! - Flux calculation at first modele level for U and V
+    CALL calcul_flux_wind(knon, dtime, &
+         u0, v0, u1, v1, cdragm, &
+         AcoefU, AcoefV, BcoefU, BcoefV, &
+         p1lay, temp_air, &
+         flux_u1, flux_v1)  
+
+  END SUBROUTINE ocean_forced_noice
+!
+!***************************************************************************************
+!
+  SUBROUTINE ocean_forced_ice( &
+       itime, dtime, jour, knon, knindex, &
+       tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
+       AcoefH, AcoefQ, BcoefH, BcoefQ, &
+       AcoefU, AcoefV, BcoefU, BcoefV, &
+       ps, u1, v1, &
+       radsol, snow, qsol, agesno, tsoil, &
+       qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
+       tsurf_new, dflux_s, dflux_l)
+!
+! This subroutine treats the ocean where there is ice. 
+! The routine reads data from climatologie file and does flux calculations at the 
+! surface.
+!
+    USE dimphy
+    USE calcul_fluxs_mod
+    USE surface_data,     ONLY : calice, calsno, tau_gl
+    USE limit_read_mod
+    USE fonte_neige_mod,  ONLY : fonte_neige
+
+    INCLUDE "indicesol.h"
+    INCLUDE "dimsoil.h"
+    INCLUDE "YOMCST.h"
+    INCLUDE "clesphys.h"
+
+! Input arguments
+!****************************************************************************************
+    INTEGER, INTENT(IN)                  :: itime, jour, knon
+    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
+    REAL, INTENT(IN)                     :: dtime
+    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf_in
+    REAL, DIMENSION(klon), INTENT(IN)    :: p1lay
+    REAL, DIMENSION(klon), INTENT(IN)    :: cdragh, cdragm
+    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain, precip_snow
+    REAL, DIMENSION(klon), INTENT(IN)    :: temp_air, spechum
+    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefH, AcoefQ, BcoefH, BcoefQ
+    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefU, AcoefV, BcoefU, BcoefV
+    REAL, DIMENSION(klon), INTENT(IN)    :: ps
+    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1
+
+! In/Output arguments
+!****************************************************************************************
+    REAL, DIMENSION(klon), INTENT(INOUT)          :: radsol
+    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
+    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
+    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
+
+! Output arguments
+!****************************************************************************************
+    REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
+    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1_new  ! new albedo in visible SW interval
+    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2_new  ! new albedo in near IR interval
+    REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
+    REAL, DIMENSION(klon), INTENT(OUT)            :: flux_u1, flux_v1
+    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
+    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l      
+
+! Local variables
+!****************************************************************************************
+    LOGICAL                     :: check=.FALSE.
+    INTEGER                     :: i
+    REAL                        :: zfra
+    REAL, PARAMETER             :: t_grnd=271.35
+    REAL, DIMENSION(klon)       :: cal, beta, dif_grnd, capsol
+    REAL, DIMENSION(klon)       :: alb_neig, tsurf_tmp
+    REAL, DIMENSION(klon)       :: soilcap, soilflux
+    REAL, DIMENSION(klon)       :: u0, v0
+    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
+
+!****************************************************************************************
+! Start calculation
+!****************************************************************************************
+    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon 
+
+!****************************************************************************************
+! 1) 
+! Flux calculation : tsurf_new, evap, fluxlat, fluxsens, flux_u1, flux_v1
+!                    dflux_s, dflux_l and qsurf
+!****************************************************************************************
+    tsurf_tmp(:) = tsurf_in(:)
+
+! calculate the parameters cal, beta, capsol and dif_grnd
+    CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd)
+
+    
+    IF (soil_model) THEN 
+! update tsoil and calculate soilcap and soilflux
+       CALL soil(dtime, is_sic, knon, snow, tsurf_tmp, tsoil,soilcap, soilflux)
+       cal(1:knon) = RCPD / soilcap(1:knon)
+       radsol(1:knon) = radsol(1:knon)  + soilflux(1:knon)
+       dif_grnd = 1.0 / tau_gl
+    ELSE 
+       dif_grnd = 1.0 / tau_gl
+       cal = RCPD * calice
+       WHERE (snow > 0.0) cal = RCPD * calsno 
+    ENDIF
+
+    beta = 1.0
+! Suppose zero surface speed
+    u0(:)=0.0
+    v0(:)=0.0
+    u1_lay(:) = u1(:) - u0(:)
+    v1_lay(:) = v1(:) - v0(:)
+    CALL calcul_fluxs(knon, is_sic, dtime, &
+         tsurf_tmp, p1lay, cal, beta, cdragh, ps, &
+         precip_rain, precip_snow, snow, qsurf,  &
+         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
+         AcoefH, AcoefQ, BcoefH, BcoefQ, &
+         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
+
+! - Flux calculation at first modele level for U and V
+    CALL calcul_flux_wind(knon, dtime, &
+         u0, v0, u1, v1, cdragm, &
+         AcoefU, AcoefV, BcoefU, BcoefV, &
+         p1lay, temp_air, &
+         flux_u1, flux_v1)  
+
+!****************************************************************************************
+! 2)
+! Calculations due to snow and runoff
+!
+!****************************************************************************************
+    CALL fonte_neige( knon, is_sic, knindex, dtime, &
+         tsurf_tmp, precip_rain, precip_snow, &
+         snow, qsol, tsurf_new, evap)
+    
+! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno)
+! 
+    CALL albsno(klon, knon, dtime, agesno(:), alb_neig(:), precip_snow(:))  
+
+    WHERE (snow(1:knon) .LT. 0.0001) agesno(1:knon) = 0.
+
+    alb1_new(:) = 0.0
+    DO i=1, knon
+       zfra = MAX(0.0,MIN(1.0,snow(i)/(snow(i)+10.0)))
+       alb1_new(i) = alb_neig(i) * zfra +  0.6 * (1.0-zfra)
+    ENDDO
+
+    alb2_new(:) = alb1_new(:)
+
+  END SUBROUTINE ocean_forced_ice
+!
+!****************************************************************************************
+!
+END MODULE ocean_forced_mod
+
+
+
+
+
+
Index: LMDZ5/branches/testing/libf/phy1d/orografi_strato.F
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/orografi_strato.F	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/orografi_strato.F	(revision 1665)
@@ -0,0 +1,2060 @@
+      SUBROUTINE drag_noro_strato (nlon,nlev,dtime,paprs,pplay,
+     e                   pmea,pstd, psig, pgam, pthe,ppic,pval,
+     e                   kgwd,kdx,ktest,
+     e                   t, u, v,
+     s                   pulow, pvlow, pustr, pvstr,
+     s                   d_t, d_u, d_v)
+c
+      USE dimphy
+      IMPLICIT none
+c======================================================================
+c Auteur(s): F.Lott (LMD/CNRS) date: 19950201
+c Object: Mountain drag interface. Made necessary because:
+C 1. in the LMD-GCM Layers are from bottom to top,
+C    contrary to most European GCM.
+c 2. the altitude above ground of each model layers
+c    needs to be known (variable zgeom)
+c======================================================================
+c Explicit Arguments:
+c ==================
+c nlon----input-I-Total number of horizontal points that get into physics
+c nlev----input-I-Number of vertical levels
+c dtime---input-R-Time-step (s)
+c paprs---input-R-Pressure in semi layers    (Pa)
+c pplay---input-R-Pressure model-layers      (Pa)
+c t-------input-R-temperature (K)
+c u-------input-R-Horizontal wind (m/s)
+c v-------input-R-Meridional wind (m/s)
+c pmea----input-R-Mean Orography (m)
+C pstd----input-R-SSO standard deviation (m)
+c psig----input-R-SSO slope
+c pgam----input-R-SSO Anisotropy
+c pthe----input-R-SSO Angle
+c ppic----input-R-SSO Peacks elevation (m)
+c pval----input-R-SSO Valleys elevation (m)
+c
+c kgwd- -input-I: Total nb of points where the orography schemes are active
+c ktest--input-I: Flags to indicate active points
+c kdx----input-I: Locate the physical location of an active point.
+
+c pulow, pvlow -output-R: Low-level wind
+c pustr, pvstr -output-R: Surface stress due to SSO drag      (Pa)
+c
+c d_t-----output-R: T increment            
+c d_u-----output-R: U increment              
+c d_v-----output-R: V increment              
+c
+c Implicit Arguments:
+c ===================
+c
+c iim--common-I: Number of longitude intervals
+c jjm--common-I: Number of latitude intervals
+c klon-common-I: Number of points seen by the physics
+c                (iim+1)*(jjm+1) for instance
+c klev-common-I: Number of vertical layers
+c======================================================================
+c Local Variables:
+c ================
+c
+c zgeom-----R: Altitude of layer above ground
+c pt, pu, pv --R: t u v from top to bottom
+c pdtdt, pdudt, pdvdt --R: t u v tendencies (from top to bottom) 
+c papmf: pressure at model layer (from top to bottom)
+c papmh: pressure at model 1/2 layer (from top to bottom)
+c 
+c======================================================================
+cym#include "dimensions.h"
+cym#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOEGWD.h"
+c
+c  ARGUMENTS
+c
+      INTEGER nlon,nlev
+      REAL dtime
+      REAL paprs(nlon,nlev+1)
+      REAL pplay(nlon,nlev)
+      REAL pmea(nlon),pstd(nlon),psig(nlon),pgam(nlon),pthe(nlon)
+      REAL ppic(nlon),pval(nlon)
+      REAL pulow(nlon),pvlow(nlon),pustr(nlon),pvstr(nlon)
+      REAL t(nlon,nlev), u(nlon,nlev), v(nlon,nlev)
+      REAL d_t(nlon,nlev), d_u(nlon,nlev), d_v(nlon,nlev)
+c
+      INTEGER i, k, kgwd,  kdx(nlon), ktest(nlon)
+c
+c LOCAL VARIABLES:
+c
+      REAL zgeom(klon,klev)
+      REAL pdtdt(klon,klev), pdudt(klon,klev), pdvdt(klon,klev)
+      REAL pt(klon,klev), pu(klon,klev), pv(klon,klev)
+      REAL papmf(klon,klev),papmh(klon,klev+1)
+      CHARACTER (LEN=20) :: modname='orografi_strato'
+      CHARACTER (LEN=80) :: abort_message
+c
+c INITIALIZE OUTPUT VARIABLES 
+c
+      DO i = 1,klon
+         pulow(i) = 0.0
+         pvlow(i) = 0.0
+         pustr(i) = 0.0
+         pvstr(i) = 0.0
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+         pdudt(i,k)=0.0
+         pdvdt(i,k)=0.0
+         pdtdt(i,k)=0.0
+      ENDDO
+      ENDDO
+c
+c PREPARE INPUT VARIABLES FOR ORODRAG (i.e., ORDERED FROM TOP TO BOTTOM)
+C CALCULATE LAYERS HEIGHT ABOVE GROUND)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         pt(i,k) = t(i,klev-k+1) 
+         pu(i,k) = u(i,klev-k+1)
+         pv(i,k) = v(i,klev-k+1)
+         papmf(i,k) = pplay(i,klev-k+1)
+      ENDDO
+      ENDDO
+      DO k = 1, klev+1
+      DO i = 1, klon
+         papmh(i,k) = paprs(i,klev-k+2)
+      ENDDO
+      ENDDO
+      DO i = 1, klon
+         zgeom(i,klev) = RD * pt(i,klev)
+     .                  * LOG(papmh(i,klev+1)/papmf(i,klev))
+      ENDDO
+      DO k = klev-1, 1, -1
+      DO i = 1, klon
+         zgeom(i,k) = zgeom(i,k+1) + RD * (pt(i,k)+pt(i,k+1))/2.0
+     .               * LOG(papmf(i,k+1)/papmf(i,k))
+      ENDDO
+      ENDDO
+c
+c CALL SSO DRAG ROUTINES        
+c
+      CALL orodrag_strato(klon,klev,kgwd,kdx,ktest,
+     .            dtime,
+     .            papmh, papmf, zgeom,
+     .            pt, pu, pv,
+     .            pmea, pstd, psig, pgam, pthe, ppic,pval,
+     .            pulow,pvlow,
+     .            pdudt,pdvdt,pdtdt)
+C
+C COMPUTE INCREMENTS AND STRESS FROM TENDENCIES
+
+      DO k = 1, klev
+      DO i = 1, klon
+         d_u(i,klev+1-k) = dtime*pdudt(i,k)
+         d_v(i,klev+1-k) = dtime*pdvdt(i,k)
+         d_t(i,klev+1-k) = dtime*pdtdt(i,k)
+         pustr(i)        = pustr(i)
+     .                    +pdudt(i,k)*(papmh(i,k+1)-papmh(i,k))/rg
+         pvstr(i)        = pvstr(i)
+     .                    +pdvdt(i,k)*(papmh(i,k+1)-papmh(i,k))/rg
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
+
+      SUBROUTINE orodrag_strato( nlon,nlev 
+     i                 , kgwd,  kdx, ktest
+     r                 , ptsphy
+     r                 , paphm1,papm1,pgeom1,ptm1,pum1,pvm1
+     r                 , pmea, pstd, psig, pgam, pthe, ppic, pval
+c outputs
+     r                 , pulow,pvlow
+     r                 , pvom,pvol,pte )
+      
+      USE dimphy
+      IMPLICIT NONE
+c
+c
+c**** *orodrag* - does the SSO drag  parametrization.
+c
+c     purpose.
+c     --------
+c
+c     this routine computes the physical tendencies of the
+c     prognostic variables u,v  and t due to  vertical transports by
+c     subgridscale orographically excited gravity waves, and to
+c     low level blocked flow drag.
+c
+c**   interface.
+c     ----------
+c          called from *drag_noro*.
+c
+c          the routine takes its input from the long-term storage:
+c          u,v,t and p at t-1.
+c
+c        explicit arguments :
+c        --------------------
+c     ==== inputs ===
+c nlon----input-I-Total number of horizontal points that get into physics
+c nlev----input-I-Number of vertical levels
+c
+c kgwd- -input-I: Total nb of points where the orography schemes are active
+c ktest--input-I: Flags to indicate active points
+c kdx----input-I: Locate the physical location of an active point.
+c ptsphy--input-R-Time-step (s)
+c paphm1--input-R: pressure at model 1/2 layer
+c papm1---input-R: pressure at model layer
+c pgeom1--input-R: Altitude of layer above ground
+c ptm1, pum1, pvm1--R-: t, u and v
+c pmea----input-R-Mean Orography (m)
+C pstd----input-R-SSO standard deviation (m)
+c psig----input-R-SSO slope
+c pgam----input-R-SSO Anisotropy
+c pthe----input-R-SSO Angle
+c ppic----input-R-SSO Peacks elevation (m)
+c pval----input-R-SSO Valleys elevation (m)
+
+      integer nlon,nlev,kgwd
+      real ptsphy
+
+c     ==== outputs ===
+c pulow, pvlow -output-R: Low-level wind
+c
+c pte -----output-R: T tendency
+c pvom-----output-R: U tendency
+c pvol-----output-R: V tendency
+c
+c
+c Implicit Arguments:
+c ===================
+c
+c klon-common-I: Number of points seen by the physics
+c klev-common-I: Number of vertical layers
+c
+c     method.
+c     -------
+c
+c     externals.
+c     ----------
+      integer ismin, ismax
+      external ismin, ismax
+c
+c     reference.
+c     ----------
+c
+c     author.
+c     -------
+c     m.miller + b.ritter   e.c.m.w.f.     15/06/86.
+c
+c     f.lott + m. miller    e.c.m.w.f.     22/11/94
+c-----------------------------------------------------------------------
+c
+c
+cym#include "dimensions.h"
+cym#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOEGWD.h"
+c-----------------------------------------------------------------------
+c
+c*       0.1   arguments
+c              ---------
+c
+c
+      real  pte(nlon,nlev),
+     *      pvol(nlon,nlev),
+     *      pvom(nlon,nlev),
+     *      pulow(nlon),
+     *      pvlow(nlon)
+      real  pum1(nlon,nlev),
+     *      pvm1(nlon,nlev),
+     *      ptm1(nlon,nlev),
+     *      pmea(nlon),pstd(nlon),psig(nlon),
+     *      pgam(nlon),pthe(nlon),ppic(nlon),pval(nlon),
+     *      pgeom1(nlon,nlev),
+     *      papm1(nlon,nlev),
+     *      paphm1(nlon,nlev+1)
+c
+      integer  kdx(nlon),ktest(nlon)
+c-----------------------------------------------------------------------
+c
+c*       0.2   local arrays
+c              ------------
+      integer  isect(klon),
+     *         icrit(klon),
+     *         ikcrith(klon),
+     *         ikenvh(klon),
+     *         iknu(klon),
+     *         iknu2(klon),
+     *         ikcrit(klon),
+     *         ikhlim(klon)
+c
+      real   ztau(klon,klev+1),
+     *       zstab(klon,klev+1),
+     *       zvph(klon,klev+1),
+     *       zrho(klon,klev+1),
+     *       zri(klon,klev+1),
+     *       zpsi(klon,klev+1),
+     *       zzdep(klon,klev)
+      real   zdudt(klon),
+     *       zdvdt(klon),
+     *       zdtdt(klon),
+     *       zdedt(klon),
+     *       zvidis(klon),
+     *       ztfr(klon),
+     *       znu(klon),
+     *       zd1(klon),
+     *       zd2(klon),
+     *       zdmod(klon)
+
+
+c local quantities:
+
+      integer jl,jk,ji
+      real ztmst,zdelp,ztemp,zforc,ztend,rover                
+      real zb,zc,zconb,zabsv,zzd1,ratio,zbet,zust,zvst,zdis
+   
+c
+c------------------------------------------------------------------
+c
+c*         1.    initialization
+c                --------------
+c
+c        print *,' in orodrag'
+ 100  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         1.1   computational constants
+c                -----------------------
+c
+ 110  continue
+c
+c     ztmst=twodt
+c     if(nstep.eq.nstart) ztmst=0.5*twodt
+      ztmst=ptsphy
+c     ------------------------------------------------------------------
+c
+ 120  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         1.3   check whether row contains point for printing
+c                ---------------------------------------------
+c
+ 130  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         2.     precompute basic state variables.
+c*                ---------- ----- ----- ----------
+c*                define low level wind, project winds in plane of
+c*                low level wind, determine sector in which to take
+c*                the variance and set indicator for critical levels.
+c
+
+  200 continue
+c
+c
+c
+      call orosetup_strato
+     *     ( nlon, nlev , ktest 
+     *     , ikcrit, ikcrith, icrit, isect, ikhlim, ikenvh,iknu,iknu2
+     *     , paphm1, papm1 , pum1   , pvm1 , ptm1 , pgeom1, pstd
+     *     , zrho  , zri   , zstab  , ztau , zvph , zpsi, zzdep
+     *     , pulow, pvlow 
+     *     , pthe,pgam,pmea,ppic,pval,znu  ,zd1,  zd2,  zdmod )
+
+
+c
+c
+c
+c***********************************************************
+c
+c
+c*         3.      compute low level stresses using subcritical and
+c*                 supercritical forms.computes anisotropy coefficient
+c*                 as measure of orographic twodimensionality.
+c
+  300 continue
+c
+      call gwstress_strato
+     *    ( nlon  , nlev
+     *    , ikcrit, isect, ikhlim, ktest, ikcrith, icrit, ikenvh, iknu
+     *    , zrho  , zstab, zvph  , pstd,  psig, pmea, ppic, pval
+     *    , ztfr   , ztau 
+     *    , pgeom1,pgam,zd1,zd2,zdmod,znu)
+
+c
+c
+c*         4.      compute stress profile including
+c                  trapped waves, wave breaking,
+c                  linear decay in stratosphere.
+c
+  400 continue
+c
+c
+
+      call gwprofil_strato
+     *       (  nlon , nlev
+     *       , kgwd   , kdx  , ktest
+     *       , ikcrit, ikcrith, icrit  , ikenvh, iknu
+     *       ,iknu2 , paphm1, zrho   , zstab , ztfr   , zvph
+     *       , zri   , ztau 
+ 
+     *       , zdmod , znu    , psig  , pgam , pstd , ppic , pval)
+
+c
+c*         5.      Compute tendencies from waves stress profile.
+c                  Compute low level blocked flow drag. 
+c*                 --------------------------------------------
+c
+  500 continue
+
+      
+c
+c  explicit solution at all levels for the gravity wave
+c  implicit solution for the blocked levels
+
+      do 510 jl=kidia,kfdia
+      zvidis(jl)=0.0
+      zdudt(jl)=0.0
+      zdvdt(jl)=0.0
+      zdtdt(jl)=0.0
+  510 continue
+c
+
+      do 524 jk=1,klev
+c
+
+C  WAVE STRESS 
+C-------------
+c
+c
+      do 523 ji=kidia,kfdia
+
+      if(ktest(ji).eq.1) then
+
+      zdelp=paphm1(ji,jk+1)-paphm1(ji,jk)
+      ztemp=-rg*(ztau(ji,jk+1)-ztau(ji,jk))/(zvph(ji,klev+1)*zdelp)
+
+      zdudt(ji)=(pulow(ji)*zd1(ji)-pvlow(ji)*zd2(ji))*ztemp/zdmod(ji)
+      zdvdt(ji)=(pvlow(ji)*zd1(ji)+pulow(ji)*zd2(ji))*ztemp/zdmod(ji)
+c
+c Control Overshoots
+c
+
+      if(jk.ge.nstra)then
+        rover=0.10
+        if(abs(zdudt(ji)).gt.rover*abs(pum1(ji,jk))/ztmst)
+     C    zdudt(ji)=rover*abs(pum1(ji,jk))/ztmst*
+     C              zdudt(ji)/(abs(zdudt(ji))+1.E-10)
+        if(abs(zdvdt(ji)).gt.rover*abs(pvm1(ji,jk))/ztmst)
+     C    zdvdt(ji)=rover*abs(pvm1(ji,jk))/ztmst*
+     C              zdvdt(ji)/(abs(zdvdt(ji))+1.E-10)
+      endif 
+
+      rover=0.25
+      zforc=sqrt(zdudt(ji)**2+zdvdt(ji)**2)        
+      ztend=sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/ztmst                      
+
+      if(zforc.ge.rover*ztend)then
+        zdudt(ji)=rover*ztend/zforc*zdudt(ji)
+        zdvdt(ji)=rover*ztend/zforc*zdvdt(ji)
+      endif
+c
+c BLOCKED FLOW DRAG:
+C -----------------
+c
+      if(jk.gt.ikenvh(ji)) then
+         zb=1.0-0.18*pgam(ji)-0.04*pgam(ji)**2
+         zc=0.48*pgam(ji)+0.3*pgam(ji)**2
+         zconb=2.*ztmst*gkwake*psig(ji)/(4.*pstd(ji))
+         zabsv=sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/2.
+         zzd1=zb*cos(zpsi(ji,jk))**2+zc*sin(zpsi(ji,jk))**2
+         ratio=(cos(zpsi(ji,jk))**2+pgam(ji)*sin(zpsi(ji,jk))**2)/
+     *   (pgam(ji)*cos(zpsi(ji,jk))**2+sin(zpsi(ji,jk))**2)
+         zbet=max(0.,2.-1./ratio)*zconb*zzdep(ji,jk)*zzd1*zabsv
+c
+c OPPOSED TO THE WIND
+c
+         zdudt(ji)=-pum1(ji,jk)/ztmst
+         zdvdt(ji)=-pvm1(ji,jk)/ztmst
+c
+c PERPENDICULAR TO THE SSO MAIN AXIS:
+C                            
+cmod     zdudt(ji)=-(pum1(ji,jk)*cos(pthe(ji)*rpi/180.)
+cmod *              +pvm1(ji,jk)*sin(pthe(ji)*rpi/180.))
+cmod *              *cos(pthe(ji)*rpi/180.)/ztmst
+cmod     zdvdt(ji)=-(pum1(ji,jk)*cos(pthe(ji)*rpi/180.)
+cmod *              +pvm1(ji,jk)*sin(pthe(ji)*rpi/180.))
+cmod *              *sin(pthe(ji)*rpi/180.)/ztmst
+C
+         zdudt(ji)=zdudt(ji)*(zbet/(1.+zbet))
+         zdvdt(ji)=zdvdt(ji)*(zbet/(1.+zbet))
+      end if
+      pvom(ji,jk)=zdudt(ji)
+      pvol(ji,jk)=zdvdt(ji)
+      zust=pum1(ji,jk)+ztmst*zdudt(ji)
+      zvst=pvm1(ji,jk)+ztmst*zdvdt(ji)
+      zdis=0.5*(pum1(ji,jk)**2+pvm1(ji,jk)**2-zust**2-zvst**2)
+      zdedt(ji)=zdis/ztmst
+      zvidis(ji)=zvidis(ji)+zdis*zdelp
+      zdtdt(ji)=zdedt(ji)/rcpd
+c
+c  NO TENDENCIES ON TEMPERATURE .....
+c
+c  Instead of, pte(ji,jk)=zdtdt(ji), due to mechanical dissipation
+c
+      pte(ji,jk)=0.0
+
+      endif
+
+  523 continue
+  524 continue
+c
+c
+  501 continue
+
+      return
+      end
+      SUBROUTINE orosetup_strato
+     *         ( nlon   , nlev  , ktest
+     *         , kkcrit, kkcrith, kcrit, ksect , kkhlim
+     *         , kkenvh, kknu  , kknu2
+     *         , paphm1, papm1 , pum1   , pvm1 , ptm1  , pgeom1, pstd
+     *         , prho  , pri   , pstab  , ptau , pvph  ,ppsi, pzdep
+     *         , pulow , pvlow  
+     *         , ptheta, pgam, pmea, ppic, pval
+     *         , pnu  ,  pd1  ,  pd2  ,pdmod  )
+C
+c**** *gwsetup*
+c
+c     purpose.
+c     --------
+c     SET-UP THE ESSENTIAL PARAMETERS OF THE SSO DRAG SCHEME:
+C     DEPTH OF LOW WBLOCKED LAYER, LOW-LEVEL FLOW, BACKGROUND
+C     STRATIFICATION.....
+c
+c**   interface.
+c     ----------
+c          from *orodrag*
+c
+c        explicit arguments :
+c        --------------------
+c     ==== inputs ===
+c 
+c nlon----input-I-Total number of horizontal points that get into physics
+c nlev----input-I-Number of vertical levels
+c ktest--input-I: Flags to indicate active points
+c
+c ptsphy--input-R-Time-step (s)
+c paphm1--input-R: pressure at model 1/2 layer
+c papm1---input-R: pressure at model layer
+c pgeom1--input-R: Altitude of layer above ground
+c ptm1, pum1, pvm1--R-: t, u and v
+c pmea----input-R-Mean Orography (m)
+C pstd----input-R-SSO standard deviation (m)
+c psig----input-R-SSO slope
+c pgam----input-R-SSO Anisotropy
+c pthe----input-R-SSO Angle
+c ppic----input-R-SSO Peacks elevation (m)
+c pval----input-R-SSO Valleys elevation (m)
+
+c     ==== outputs ===
+c pulow, pvlow -output-R: Low-level wind
+c kkcrit----I-: Security value for top of low level flow
+c kcrit-----I-: Critical level 
+c ksect-----I-: Not used
+c kkhlim----I-: Not used
+c kkenvh----I-: Top of blocked flow layer
+c kknu------I-: Layer that sees mountain peacks
+c kknu2-----I-: Layer that sees mountain peacks above mountain mean
+c kknub-----I-: Layer that sees mountain mean above valleys
+c prho------R-: Density at 1/2 layers
+c pri-------R-: Background Richardson Number, Wind shear measured along GW stress
+c pstab-----R-: Brunt-Vaisala freq. at 1/2 layers
+c pvph------R-: Wind in  plan of GW stress, Half levels.
+c ppsi------R-: Angle between low level wind and SS0 main axis.
+c pd1-------R-| Compared the ratio of the stress
+c pd2-------R-| that is along the wind to that Normal to it.
+c               pdi define the plane of low level stress
+c               compared to the low level wind.
+c see p. 108 Lott & Miller (1997).                      
+c pdmod-----R-: Norme of pdi
+
+c     === local arrays ===
+c
+c zvpf------R-: Wind projected in the plan of the low-level stress.
+
+c     ==== outputs ===
+c
+c        implicit arguments :   none
+c        --------------------
+c
+c     method.
+c     -------
+c
+c
+c     externals.
+c     ----------
+c
+c
+c     reference.
+c     ----------
+c
+c        see ecmwf research department documentation of the "i.f.s."
+c
+c     author.
+c     -------
+c
+c     modifications.
+c     --------------
+c     f.lott  for the new-gwdrag scheme november 1993
+c
+c-----------------------------------------------------------------------
+      USE dimphy
+      implicit none
+c
+
+cym#include "dimensions.h"
+cym#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOEGWD.h"
+
+c-----------------------------------------------------------------------
+c
+c*       0.1   arguments
+c              ---------
+c
+      integer nlon,nlev
+      integer kkcrit(nlon),kkcrith(nlon),kcrit(nlon),ksect(nlon),
+     *        kkhlim(nlon),ktest(nlon),kkenvh(nlon)
+
+c
+      real paphm1(nlon,klev+1),papm1(nlon,klev),pum1(nlon,klev),
+     *     pvm1(nlon,klev),ptm1(nlon,klev),pgeom1(nlon,klev),
+     *     prho(nlon,klev+1),pri(nlon,klev+1),pstab(nlon,klev+1),
+     *     ptau(nlon,klev+1),pvph(nlon,klev+1),ppsi(nlon,klev+1),
+     *     pzdep(nlon,klev)
+       real pulow(nlon),pvlow(nlon),ptheta(nlon),pgam(nlon),pnu(nlon),
+     *     pd1(nlon),pd2(nlon),pdmod(nlon)
+      real pstd(nlon),pmea(nlon),ppic(nlon),pval(nlon)
+c
+c-----------------------------------------------------------------------
+c
+c*       0.2   local arrays
+c              ------------
+c
+c
+      integer ilevh ,jl,jk
+      real zcons1,zcons2,zhgeo,zu,zphi
+      real zvt1,zvt2,zdwind,zwind,zdelp
+      real zstabm,zstabp,zrhom,zrhop
+      logical lo 
+      logical ll1(klon,klev+1)
+      integer kknu(klon),kknu2(klon),kknub(klon),kknul(klon),
+     *        kentp(klon),ncount(klon)  
+c
+      real zhcrit(klon,klev),zvpf(klon,klev),
+     *     zdp(klon,klev)
+      real znorm(klon),zb(klon),zc(klon),
+     *      zulow(klon),zvlow(klon),znup(klon),znum(klon)
+c       
+c     ------------------------------------------------------------------
+c
+c*         1.    initialization
+c                --------------
+c
+c       PRINT *,' in orosetup'
+ 100  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         1.1   computational constants
+c                -----------------------
+c
+ 110  continue
+c
+      ilevh =klev/3
+c
+      zcons1=1./rd
+      zcons2=rg**2/rcpd
+c
+c
+c     ------------------------------------------------------------------
+c
+c*         2.
+c                --------------
+c
+ 200  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         2.1     define low level wind, project winds in plane of
+c*                 low level wind, determine sector in which to take
+c*                 the variance and set indicator for critical levels.
+c
+c
+c
+      do 2001 jl=kidia,kfdia
+      kknu(jl)    =klev
+      kknu2(jl)   =klev
+      kknub(jl)   =klev
+      kknul(jl)   =klev
+      pgam(jl) =max(pgam(jl),gtsec)
+      ll1(jl,klev+1)=.false.
+ 2001 continue
+c
+c Ajouter une initialisation (L. Li, le 23fev99):
+c
+      do jk=klev,ilevh,-1
+      do jl=kidia,kfdia
+      ll1(jl,jk)= .false.
+      ENDDO
+      ENDDO
+c
+c*      define top of low level flow
+c       ----------------------------
+      do 2002 jk=klev,ilevh,-1
+      do 2003 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      lo=(paphm1(jl,jk)/paphm1(jl,klev+1)).ge.gsigcr
+      if(lo) then
+        kkcrit(jl)=jk
+      endif
+      zhcrit(jl,jk)=ppic(jl)-pval(jl)           
+      zhgeo=pgeom1(jl,jk)/rg
+      ll1(jl,jk)=(zhgeo.gt.zhcrit(jl,jk))
+      if(ll1(jl,jk).neqv.ll1(jl,jk+1)) then
+        kknu(jl)=jk
+      endif
+      if(.not.ll1(jl,ilevh))kknu(jl)=ilevh
+      endif
+ 2003 continue
+ 2002 continue
+      do 2004 jk=klev,ilevh,-1
+      do 2005 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      zhcrit(jl,jk)=ppic(jl)-pmea(jl)
+      zhgeo=pgeom1(jl,jk)/rg
+      ll1(jl,jk)=(zhgeo.gt.zhcrit(jl,jk))
+      if(ll1(jl,jk).neqv.ll1(jl,jk+1)) then
+        kknu2(jl)=jk
+      endif
+      if(.not.ll1(jl,ilevh))kknu2(jl)=ilevh
+      endif
+ 2005 continue
+ 2004 continue
+      do 2006 jk=klev,ilevh,-1
+      do 2007 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      zhcrit(jl,jk)=amin1(ppic(jl)-pmea(jl),pmea(jl)-pval(jl))
+      zhgeo=pgeom1(jl,jk)/rg
+      ll1(jl,jk)=(zhgeo.gt.zhcrit(jl,jk))
+      if(ll1(jl,jk).neqv.ll1(jl,jk+1)) then
+        kknub(jl)=jk
+      endif
+      if(.not.ll1(jl,ilevh))kknub(jl)=ilevh
+      endif
+ 2007 continue
+ 2006 continue
+c
+      do 2010 jl=kidia,kfdia  
+      if(ktest(jl).eq.1) then
+      kknu(jl)=min(kknu(jl),nktopg)
+      kknu2(jl)=min(kknu2(jl),nktopg)
+      kknub(jl)=min(kknub(jl),nktopg)
+      kknul(jl)=klev
+      endif
+ 2010 continue      
+c
+ 210  continue
+c
+cc*     initialize various arrays
+c
+      do 2107 jl=kidia,kfdia
+      prho(jl,klev+1)  =0.0
+cym correction en attendant mieux
+      prho(jl,1)  =0.0      
+      pstab(jl,klev+1) =0.0
+      pstab(jl,1)      =0.0
+      pri(jl,klev+1)   =9999.0
+      ppsi(jl,klev+1)  =0.0
+      pri(jl,1)        =0.0
+      pvph(jl,1)       =0.0
+      pvph(jl,klev+1)  =0.0
+cym correction en attendant mieux
+cym      pvph(jl,klev)    =0.0
+      pulow(jl)        =0.0
+      pvlow(jl)        =0.0
+      zulow(jl)        =0.0
+      zvlow(jl)        =0.0
+      kkcrith(jl)      =klev
+      kkenvh(jl)       =klev
+      kentp(jl)        =klev
+      kcrit(jl)        =1
+      ncount(jl)       =0
+      ll1(jl,klev+1)   =.false.
+ 2107 continue
+c
+c*     define flow density and stratification (rho and N2)
+c      at semi layers.
+c      -------------------------------------------------------
+c
+      do 223 jk=klev,2,-1
+      do 222 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+        zdp(jl,jk)=papm1(jl,jk)-papm1(jl,jk-1)
+        prho(jl,jk)=2.*paphm1(jl,jk)*zcons1/(ptm1(jl,jk)+ptm1(jl,jk-1))
+        pstab(jl,jk)=2.*zcons2/(ptm1(jl,jk)+ptm1(jl,jk-1))*
+     *  (1.-rcpd*prho(jl,jk)*(ptm1(jl,jk)-ptm1(jl,jk-1))/zdp(jl,jk))
+        pstab(jl,jk)=max(pstab(jl,jk),gssec)
+      endif
+  222 continue
+  223 continue
+c
+c********************************************************************
+c
+c*     define Low level flow (between ground and peacks-valleys)
+c      ---------------------------------------------------------
+      do 2115 jk=klev,ilevh,-1
+      do 2116 jl=kidia,kfdia
+      if(ktest(jl).eq.1)  then
+      if(jk.ge.kknu2(jl).and.jk.le.kknul(jl)) then
+        pulow(jl)=pulow(jl)+pum1(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+        pvlow(jl)=pvlow(jl)+pvm1(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+        pstab(jl,klev+1)=pstab(jl,klev+1)
+     c                   +pstab(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+        prho(jl,klev+1)=prho(jl,klev+1)
+     c                   +prho(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+      end if
+      endif
+ 2116 continue
+ 2115 continue
+      do 2110 jl=kidia,kfdia
+      if(ktest(jl).eq.1)  then
+      pulow(jl)=pulow(jl)/(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknu2(jl)))
+      pvlow(jl)=pvlow(jl)/(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknu2(jl)))
+      znorm(jl)=max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+      pvph(jl,klev+1)=znorm(jl)
+      pstab(jl,klev+1)=pstab(jl,klev+1)
+     c                /(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknu2(jl)))
+      prho(jl,klev+1)=prho(jl,klev+1)
+     c                /(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknu2(jl)))
+      endif
+ 2110 continue
+
+c
+c*******  setup orography orientation relative to the low level
+C       wind and define parameters of the Anisotropic wave stress.
+c
+      do 2112 jl=kidia,kfdia
+      if(ktest(jl).eq.1)  then
+        lo=(pulow(jl).lt.gvsec).and.(pulow(jl).ge.-gvsec)
+        if(lo) then
+          zu=pulow(jl)+2.*gvsec
+        else
+          zu=pulow(jl)
+        endif
+        zphi=atan(pvlow(jl)/zu)
+        ppsi(jl,klev+1)=ptheta(jl)*rpi/180.-zphi
+        zb(jl)=1.-0.18*pgam(jl)-0.04*pgam(jl)**2
+        zc(jl)=0.48*pgam(jl)+0.3*pgam(jl)**2
+        pd1(jl)=zb(jl)-(zb(jl)-zc(jl))*(sin(ppsi(jl,klev+1))**2)
+        pd2(jl)=(zb(jl)-zc(jl))*sin(ppsi(jl,klev+1))
+     *                         *cos(ppsi(jl,klev+1))
+        pdmod(jl)=sqrt(pd1(jl)**2+pd2(jl)**2)
+      endif
+ 2112 continue
+c
+c  ************ projet flow in plane of lowlevel stress *************
+C  ************ Find critical levels...                 *************
+c
+      do 213 jk=1,klev
+      do 212 jl=kidia,kfdia
+      if(ktest(jl).eq.1)  then
+        zvt1       =pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk)
+        zvt2       =-pvlow(jl)*pum1(jl,jk)+pulow(jl)*pvm1(jl,jk)
+        zvpf(jl,jk)=(zvt1*pd1(jl)+zvt2*pd2(jl))/(znorm(jl)*pdmod(jl))
+      endif
+      ptau(jl,jk)  =0.0
+      pzdep(jl,jk) =0.0
+      ppsi(jl,jk)  =0.0
+      ll1(jl,jk)   =.false.
+  212 continue
+  213 continue
+      do 215 jk=2,klev
+      do 214 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+        zdp(jl,jk)=papm1(jl,jk)-papm1(jl,jk-1)
+        pvph(jl,jk)=((paphm1(jl,jk)-papm1(jl,jk-1))*zvpf(jl,jk)+
+     *            (papm1(jl,jk)-paphm1(jl,jk))*zvpf(jl,jk-1))
+     *            /zdp(jl,jk)
+        if(pvph(jl,jk).lt.gvsec) then
+          pvph(jl,jk)=gvsec
+          kcrit(jl)=jk
+        endif
+      endif
+  214 continue
+  215 continue
+c
+c*         2.3     mean flow richardson number.
+c
+  230 continue
+c
+      do 232 jk=2,klev
+      do 231 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+        zdwind=max(abs(zvpf(jl,jk)-zvpf(jl,jk-1)),gvsec)
+        pri(jl,jk)=pstab(jl,jk)*(zdp(jl,jk)
+     *          /(rg*prho(jl,jk)*zdwind))**2
+        pri(jl,jk)=max(pri(jl,jk),grcrit)
+      endif
+  231 continue
+  232 continue
+  
+c
+c
+c*      define top of 'envelope' layer
+c       ----------------------------
+
+      do 233 jl=kidia,kfdia
+      pnu (jl)=0.0
+      znum(jl)=0.0
+ 233  continue
+      
+      do 234 jk=2,klev-1
+      do 234 jl=kidia,kfdia
+      
+      if(ktest(jl).eq.1) then
+       
+      if (jk.ge.kknu2(jl)) then
+          
+            znum(jl)=pnu(jl)
+            zwind=(pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/
+     *            max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+            zwind=max(sqrt(zwind**2),gvsec)
+            zdelp=paphm1(jl,jk+1)-paphm1(jl,jk)
+            zstabm=sqrt(max(pstab(jl,jk  ),gssec))
+            zstabp=sqrt(max(pstab(jl,jk+1),gssec))
+            zrhom=prho(jl,jk  )
+            zrhop=prho(jl,jk+1)
+            pnu(jl) = pnu(jl) + (zdelp/rg)*
+     *            ((zstabp/zrhop+zstabm/zrhom)/2.)/zwind     
+            if((znum(jl).le.gfrcrit).and.(pnu(jl).gt.gfrcrit)
+     *                          .and.(kkenvh(jl).eq.klev))
+     *      kkenvh(jl)=jk
+     
+      endif    
+
+      endif
+      
+ 234  continue
+      
+c  calculation of a dynamical mixing height for when the waves
+C  BREAK AT LOW LEVEL: The drag will be repartited over
+C  a depths that depends on waves vertical wavelength,
+C  not just between two adjacent model layers.
+c  of gravity waves:
+
+      do 235 jl=kidia,kfdia
+      znup(jl)=0.0
+      znum(jl)=0.0
+ 235  continue
+
+      do 236 jk=klev-1,2,-1
+      do 236 jl=kidia,kfdia
+      
+      if(ktest(jl).eq.1) then
+
+            znum(jl)=znup(jl)
+            zwind=(pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/
+     *            max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+            zwind=max(sqrt(zwind**2),gvsec)
+            zdelp=paphm1(jl,jk+1)-paphm1(jl,jk)
+            zstabm=sqrt(max(pstab(jl,jk  ),gssec))
+            zstabp=sqrt(max(pstab(jl,jk+1),gssec))
+            zrhom=prho(jl,jk  )
+            zrhop=prho(jl,jk+1)
+            znup(jl) = znup(jl) + (zdelp/rg)*
+     *            ((zstabp/zrhop+zstabm/zrhom)/2.)/zwind     
+            if((znum(jl).le.rpi/4.).and.(znup(jl).gt.rpi/4.)
+     *                          .and.(kkcrith(jl).eq.klev))
+     *      kkcrith(jl)=jk
+     
+      endif
+      
+ 236  continue
+ 
+      do 237 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      kkcrith(jl)=max0(kkcrith(jl),ilevh*2)
+      kkcrith(jl)=max0(kkcrith(jl),kknu(jl))
+      if(kcrit(jl).ge.kkcrith(jl))kcrit(jl)=1
+      endif
+ 237  continue         
+c
+c     directional info for flow blocking ************************* 
+c
+      do 251 jk=1,klev    
+      do 252 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      lo=(pum1(jl,jk).lt.gvsec).and.(pum1(jl,jk).ge.-gvsec)
+      if(lo) then
+        zu=pum1(jl,jk)+2.*gvsec
+      else
+        zu=pum1(jl,jk)
+      endif
+       zphi=atan(pvm1(jl,jk)/zu)
+       ppsi(jl,jk)=ptheta(jl)*rpi/180.-zphi
+      endif
+ 252  continue
+ 251  continue
+
+c      forms the vertical 'leakiness' **************************
+
+      do 254  jk=ilevh,klev
+      do 253  jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      pzdep(jl,jk)=0
+      if(jk.ge.kkenvh(jl).and.kkenvh(jl).ne.klev) then
+        pzdep(jl,jk)=(pgeom1(jl,kkenvh(jl)  )-pgeom1(jl,  jk))/
+     *               (pgeom1(jl,kkenvh(jl)  )-pgeom1(jl,klev))
+      end if
+      endif
+ 253  continue
+ 254  continue
+
+      return
+      end
+      SUBROUTINE gwstress_strato
+     *         (  nlon  , nlev
+     *         , kkcrit, ksect, kkhlim, ktest, kkcrith, kcrit, kkenvh
+     *         , kknu
+     *         , prho  , pstab , pvph  , pstd, psig
+     *         , pmea , ppic , pval  , ptfr  , ptau  
+     *         , pgeom1 , pgamma , pd1  , pd2   , pdmod , pnu )
+c
+c**** *gwstress*
+c
+c     purpose.
+c     --------
+c  Compute the surface stress due to Gravity Waves, according
+c  to the Phillips (1979) theory of 3-D flow above 
+c  anisotropic elliptic ridges.
+
+C  The stress is reduced two account for cut-off flow over
+C  hill.  The flow only see that part of the ridge located
+c  above the blocked layer (see zeff).
+c
+c**   interface.
+c     ----------
+c     call *gwstress*  from *gwdrag*
+c
+c        explicit arguments :
+c        --------------------
+c     ==== inputs ===
+c     ==== outputs ===
+c
+c        implicit arguments :   none
+c        --------------------
+c
+c     method.
+c     -------
+c
+c
+c     externals.
+c     ----------
+c
+c
+c     reference.
+c     ----------
+c
+c   LOTT and MILLER (1997)  &  LOTT (1999)
+c
+c     author.
+c     -------
+c
+c     modifications.
+c     --------------
+c     f. lott put the new gwd on ifs      22/11/93
+c
+c-----------------------------------------------------------------------
+      USE dimphy
+      implicit none
+
+cym#include "dimensions.h"
+cym#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOEGWD.h"
+
+c-----------------------------------------------------------------------
+c
+c*       0.1   arguments
+c              ---------
+c
+      integer nlon,nlev
+      integer kkcrit(nlon),kkcrith(nlon),kcrit(nlon),ksect(nlon),
+     *        kkhlim(nlon),ktest(nlon),kkenvh(nlon),kknu(nlon)
+c
+      real prho(nlon,nlev+1),pstab(nlon,nlev+1),ptau(nlon,nlev+1),
+     *     pvph(nlon,nlev+1),ptfr(nlon),
+     *     pgeom1(nlon,nlev),pstd(nlon)
+c
+      real pd1(nlon),pd2(nlon),pnu(nlon),psig(nlon),pgamma(nlon)
+      real pmea(nlon),ppic(nlon),pval(nlon)
+      real pdmod(nlon)
+c
+c-----------------------------------------------------------------------
+c
+c*       0.2   local arrays
+c              ------------
+c  zeff--real: effective height seen by the flow when there is blocking
+
+      integer jl
+      real zeff  
+c
+c-----------------------------------------------------------------------
+c
+c*       0.3   functions
+c              ---------
+c     ------------------------------------------------------------------
+c
+c*         1.    initialization
+c                --------------
+c
+c      PRINT *,' in gwstress'
+ 100  continue
+c
+c*         3.1     gravity wave stress.
+c
+  300 continue
+c
+c
+      do 301 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      
+c  effective mountain height above the blocked flow
+  
+         zeff=ppic(jl)-pval(jl)
+         if(kkenvh(jl).lt.klev)then
+         zeff=amin1(GFRCRIT*pvph(jl,klev+1)/sqrt(pstab(jl,klev+1))
+     c              ,zeff)
+         endif
+
+      
+        ptau(jl,klev+1)=gkdrag*prho(jl,klev+1)
+     *     *psig(jl)*pdmod(jl)/4./pstd(jl)
+     *     *pvph(jl,klev+1)*sqrt(pstab(jl,klev+1))
+     *     *zeff**2
+
+
+c  too small value of stress or  low level flow include critical level
+c  or low level flow:  gravity wave stress nul.
+                
+c       lo=(ptau(jl,klev+1).lt.gtsec).or.(kcrit(jl).ge.kknu(jl))
+c    *      .or.(pvph(jl,klev+1).lt.gvcrit)
+c       if(lo) ptau(jl,klev+1)=0.0
+      
+c      print *,jl,ptau(jl,klev+1)
+
+      else
+      
+          ptau(jl,klev+1)=0.0
+          
+      endif
+
+  301 continue
+
+c      write(21)(ptau(jl,klev+1),jl=kidia,kfdia)
+ 
+      return
+      end
+
+      subroutine gwprofil_strato
+     *         ( nlon, nlev
+     *         , kgwd ,kdx  , ktest
+     *         , kkcrit, kkcrith, kcrit ,  kkenvh, kknu,kknu2
+     *         , paphm1, prho   , pstab , ptfr , pvph , pri , ptau
+     *         , pdmod   , pnu   , psig ,pgamma, pstd, ppic,pval)
+
+C**** *gwprofil*
+C
+C     purpose.
+C     --------
+C
+C**   interface.
+C     ----------
+C          from *gwdrag*
+C
+C        explicit arguments :
+C        --------------------
+C     ==== inputs ===
+C
+C     ==== outputs ===
+C
+C        implicit arguments :   none
+C        --------------------
+C
+C     method:
+C     -------
+C     the stress profile for gravity waves is computed as follows:
+C     it decreases linearly with heights from the ground 
+C     to the low-level indicated by kkcrith,
+C     to simulates lee waves or 
+C     low-level gravity wave breaking.
+C     above it is constant, except when the waves encounter a critical
+C     level (kcrit) or when they break.
+C     The stress is also uniformly distributed above the level
+C     nstra.                                          
+C
+      USE dimphy
+      IMPLICIT NONE
+
+cym#include "dimensions.h"
+cym#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOEGWD.h"
+
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      integer nlon,nlev,kgwd
+      integer kkcrit(nlon),kkcrith(nlon),kcrit(nlon)
+     *       ,kdx(nlon),ktest(nlon)
+     *       ,kkenvh(nlon),kknu(nlon),kknu2(nlon)
+C
+      real paphm1(nlon,nlev+1), pstab(nlon,nlev+1),
+     *     prho  (nlon,nlev+1), pvph (nlon,nlev+1),
+     *     pri   (nlon,nlev+1), ptfr (nlon), ptau(nlon,nlev+1)
+     
+      real pdmod (nlon) , pnu (nlon) , psig(nlon),
+     *     pgamma(nlon) , pstd(nlon) , ppic(nlon), pval(nlon)
+     
+C-----------------------------------------------------------------------
+C
+C*       0.2   local arrays
+C              ------------
+C
+      integer jl,jk
+      real zsqr,zalfa,zriw,zdel,zb,zalpha,zdz2n,zdelp,zdelpt
+
+      real zdz2 (klon,klev) , znorm(klon) , zoro(klon)
+      real ztau (klon,klev+1)
+C
+C-----------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+C
+C      print *,' entree gwprofil' 
+ 100  CONTINUE
+C
+C
+C*    COMPUTATIONAL CONSTANTS.
+C     ------------- ----------
+C
+      do 400 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+      zoro(jl)=psig(jl)*pdmod(jl)/4./pstd(jl)
+      ztau(jl,klev+1)=ptau(jl,klev+1)
+c     print *,jl,ptau(jl,klev+1)
+      ztau(jl,kkcrith(jl))=grahilo*ptau(jl,klev+1)
+      endif
+  400 continue
+  
+C
+      do 430 jk=klev+1,1,-1
+C
+C
+C*         4.1    constant shear stress until top of the
+C                 low-level breaking/trapped layer
+  410 CONTINUE
+C
+      do 411 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+           if(jk.gt.kkcrith(jl)) then
+           zdelp=paphm1(jl,jk)-paphm1(jl,klev+1) 
+           zdelpt=paphm1(jl,kkcrith(jl))-paphm1(jl,klev+1) 
+           ptau(jl,jk)=ztau(jl,klev+1)+zdelp/zdelpt*
+     c                 (ztau(jl,kkcrith(jl))-ztau(jl,klev+1))
+           else                    
+           ptau(jl,jk)=ztau(jl,kkcrith(jl))
+           endif
+       endif
+ 411  continue             
+C
+C*         4.15   constant shear stress until the top of the
+C                 low level flow layer.
+ 415  continue
+C        
+C
+C*         4.2    wave displacement at next level.
+C
+  420 continue
+C
+  430 continue
+
+C
+C*         4.4    wave richardson number, new wave displacement
+C*                and stress:  breaking evaluation and critical 
+C                 level
+C
+                          
+      do 440 jk=klev,1,-1
+
+      do 441 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+      znorm(jl)=prho(jl,jk)*sqrt(pstab(jl,jk))*pvph(jl,jk)
+      zdz2(jl,jk)=ptau(jl,jk)/amax1(znorm(jl),gssec)/zoro(jl)
+      endif
+  441 continue
+
+      do 442 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+          if(jk.lt.kkcrith(jl)) then
+          if((ptau(jl,jk+1).lt.gtsec).or.(jk.le.kcrit(jl))) then
+             ptau(jl,jk)=0.0
+          else
+               zsqr=sqrt(pri(jl,jk))
+               zalfa=sqrt(pstab(jl,jk)*zdz2(jl,jk))/pvph(jl,jk)
+               zriw=pri(jl,jk)*(1.-zalfa)/(1+zalfa*zsqr)**2
+               if(zriw.lt.grcrit) then
+C                 print *,' breaking!!!',ptau(jl,jk)
+                  zdel=4./zsqr/grcrit+1./grcrit**2+4./grcrit
+                  zb=1./grcrit+2./zsqr
+                  zalpha=0.5*(-zb+sqrt(zdel))
+                  zdz2n=(pvph(jl,jk)*zalpha)**2/pstab(jl,jk)
+                  ptau(jl,jk)=znorm(jl)*zdz2n*zoro(jl)
+               endif
+                
+               ptau(jl,jk)=amin1(ptau(jl,jk),ptau(jl,jk+1))
+                  
+          endif
+          endif
+      endif
+  442 continue
+  440 continue
+
+C  REORGANISATION OF THE STRESS PROFILE AT LOW LEVEL
+
+      do 530 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+         ztau(jl,kkcrith(jl)-1)=ptau(jl,kkcrith(jl)-1)
+         ztau(jl,nstra)=ptau(jl,nstra)
+      endif
+ 530  continue      
+
+      do 531 jk=1,klev
+      
+      do 532 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+                
+         if(jk.gt.kkcrith(jl)-1)then
+
+          zdelp=paphm1(jl,jk)-paphm1(jl,klev+1    )
+          zdelpt=paphm1(jl,kkcrith(jl)-1)-paphm1(jl,klev+1    )
+          ptau(jl,jk)=ztau(jl,klev+1    ) +
+     .                (ztau(jl,kkcrith(jl)-1)-ztau(jl,klev+1    ) )*
+     .                zdelp/zdelpt
+     
+        endif
+      endif
+            
+ 532  continue    
+ 
+C  REORGANISATION AT THE MODEL TOP....
+
+      do 533 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+
+         if(jk.lt.nstra)then
+
+          zdelp =paphm1(jl,nstra)
+          zdelpt=paphm1(jl,jk)
+          ptau(jl,jk)=ztau(jl,nstra)*zdelpt/zdelp 
+c         ptau(jl,jk)=ztau(jl,nstra)                
+
+        endif
+
+      endif
+
+ 533  continue
+
+ 
+ 531  continue        
+
+
+ 123   format(i4,1x,20(f6.3,1x))
+
+
+      return
+      end
+      subroutine lift_noro_strato (nlon,nlev,dtime,paprs,pplay,      
+     i                   plat,pmea,pstd, psig, pgam, pthe, ppic,pval,
+     i                   kgwd,kdx,ktest,
+     i                   t, u, v,
+     o                   pulow, pvlow, pustr, pvstr,
+     o                   d_t, d_u, d_v)
+c
+      USE dimphy
+      implicit none
+c======================================================================
+c Auteur(s): F.Lott (LMD/CNRS) date: 19950201
+c Object: Mountain lift interface (enhanced vortex stretching).
+c         Made necessary because:
+C 1. in the LMD-GCM Layers are from bottom to top,
+C    contrary to most European GCM.
+c 2. the altitude above ground of each model layers
+c    needs to be known (variable zgeom)
+c======================================================================
+c Explicit Arguments:
+c ==================
+c nlon----input-I-Total number of horizontal points that get into physics
+c nlev----input-I-Number of vertical levels
+c dtime---input-R-Time-step (s)
+c paprs---input-R-Pressure in semi layers    (Pa)
+c pplay---input-R-Pressure model-layers      (Pa)
+c t-------input-R-temperature (K)
+c u-------input-R-Horizontal wind (m/s)
+c v-------input-R-Meridional wind (m/s)
+c pmea----input-R-Mean Orography (m)
+C pstd----input-R-SSO standard deviation (m)
+c psig----input-R-SSO slope
+c pgam----input-R-SSO Anisotropy
+c pthe----input-R-SSO Angle
+c ppic----input-R-SSO Peacks elevation (m)
+c pval----input-R-SSO Valleys elevation (m)
+c
+c kgwd- -input-I: Total nb of points where the orography schemes are active
+c ktest--input-I: Flags to indicate active points
+c kdx----input-I: Locate the physical location of an active point.
+
+c pulow, pvlow -output-R: Low-level wind
+c pustr, pvstr -output-R: Surface stress due to SSO drag      (Pa)
+c
+c d_t-----output-R: T increment
+c d_u-----output-R: U increment
+c d_v-----output-R: V increment
+c
+c Implicit Arguments:
+c ===================
+c
+c iim--common-I: Number of longitude intervals
+c jjm--common-I: Number of latitude intervals
+c klon-common-I: Number of points seen by the physics
+c                (iim+1)*(jjm+1) for instance
+c klev-common-I: Number of vertical layers
+c======================================================================
+c Local Variables:
+c ================
+c
+c zgeom-----R: Altitude of layer above ground
+c pt, pu, pv --R: t u v from top to bottom
+c pdtdt, pdudt, pdvdt --R: t u v tendencies (from top to bottom)
+c papmf: pressure at model layer (from top to bottom)
+c papmh: pressure at model 1/2 layer (from top to bottom)
+c
+c======================================================================
+
+cym#include "dimensions.h"
+cym#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOEGWD.h"
+c
+c ARGUMENTS
+c
+      INTEGER nlon,nlev
+      REAL dtime
+      REAL paprs(klon,klev+1)
+      REAL pplay(klon,klev)
+      REAL plat(nlon),pmea(nlon)
+      REAL pstd(nlon),psig(nlon),pgam(nlon),pthe(nlon)
+      REAL ppic(nlon),pval(nlon)
+      REAL pulow(nlon),pvlow(nlon),pustr(nlon),pvstr(nlon)
+      REAL t(nlon,nlev), u(nlon,nlev), v(nlon,nlev)
+      REAL d_t(nlon,nlev), d_u(nlon,nlev), d_v(nlon,nlev)
+c
+      INTEGER i, k, kgwd,  kdx(nlon), ktest(nlon)
+c
+c Variables locales:
+c
+      REAL zgeom(klon,klev)
+      REAL pdtdt(klon,klev), pdudt(klon,klev), pdvdt(klon,klev)
+      REAL pt(klon,klev), pu(klon,klev), pv(klon,klev)
+      REAL papmf(klon,klev),papmh(klon,klev+1)
+c
+c initialiser les variables de sortie (pour securite)
+c
+
+c     print *,'in lift_noro'
+      DO i = 1,klon
+         pulow(i) = 0.0
+         pvlow(i) = 0.0
+         pustr(i) = 0.0
+         pvstr(i) = 0.0
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+         pdudt(i,k)=0.0
+         pdvdt(i,k)=0.0
+         pdtdt(i,k)=0.0
+      ENDDO
+      ENDDO
+c
+c preparer les variables d'entree (attention: l'ordre des niveaux 
+c verticaux augmente du haut vers le bas)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         pt(i,k) = t(i,klev-k+1) 
+         pu(i,k) = u(i,klev-k+1)
+         pv(i,k) = v(i,klev-k+1)
+         papmf(i,k) = pplay(i,klev-k+1)
+      ENDDO
+      ENDDO
+      DO k = 1, klev+1
+      DO i = 1, klon
+         papmh(i,k) = paprs(i,klev-k+2)
+      ENDDO
+      ENDDO
+      DO i = 1, klon
+         zgeom(i,klev) = RD * pt(i,klev)
+     .                  * LOG(papmh(i,klev+1)/papmf(i,klev))
+      ENDDO
+      DO k = klev-1, 1, -1
+      DO i = 1, klon
+         zgeom(i,k) = zgeom(i,k+1) + RD * (pt(i,k)+pt(i,k+1))/2.0
+     .               * LOG(papmf(i,k+1)/papmf(i,k))
+      ENDDO
+      ENDDO
+c
+c appeler la routine principale
+c
+
+      CALL OROLIFT_strato(klon,klev,kgwd,kdx,ktest,
+     .            dtime,
+     .            papmh, papmf, zgeom,
+     .            pt, pu, pv,
+     .            plat,pmea, pstd, psig, pgam, pthe, ppic,pval,
+     .            pulow,pvlow,
+     .            pdudt,pdvdt,pdtdt)
+C
+      DO k = 1, klev
+      DO i = 1, klon
+         d_u(i,klev+1-k) = dtime*pdudt(i,k)
+         d_v(i,klev+1-k) = dtime*pdvdt(i,k)
+         d_t(i,klev+1-k) = dtime*pdtdt(i,k)
+         pustr(i)        = pustr(i)
+     .                    +pdudt(i,k)*(papmh(i,k+1)-papmh(i,k))/rg
+         pvstr(i)        = pvstr(i)
+     .                    +pdvdt(i,k)*(papmh(i,k+1)-papmh(i,k))/rg
+      ENDDO
+      ENDDO
+
+c     print *,' out lift_noro'
+c
+      RETURN
+      END
+      subroutine orolift_strato( nlon,nlev
+     I                 , kgwd, kdx, ktest
+     R                 , ptsphy
+     R                 , paphm1,papm1,pgeom1,ptm1,pum1,pvm1
+     R                 , plat
+     R                 , pmea, pstd, psig, pgam, pthe,ppic,pval
+C OUTPUTS
+     R                 , pulow,pvlow
+     R                 , pvom,pvol,pte )
+
+C
+C**** *OROLIFT: SIMULATE THE GEOSTROPHIC LIFT.
+C
+C     PURPOSE.
+C     --------
+C this routine computes the physical tendencies of the
+C prognostic variables u,v  when enhanced vortex stretching
+C is needed.
+C
+C**   INTERFACE.
+C     ----------
+C          CALLED FROM *lift_noro
+c        explicit arguments :
+c        --------------------
+c     ==== inputs ===
+c nlon----input-I-Total number of horizontal points that get into physics
+c nlev----input-I-Number of vertical levels
+c
+c kgwd- -input-I: Total nb of points where the orography schemes are active
+c ktest--input-I: Flags to indicate active points
+c kdx----input-I: Locate the physical location of an active point.
+c ptsphy--input-R-Time-step (s)
+c paphm1--input-R: pressure at model 1/2 layer
+c papm1---input-R: pressure at model layer
+c pgeom1--input-R: Altitude of layer above ground
+c ptm1, pum1, pvm1--R-: t, u and v
+c pmea----input-R-Mean Orography (m)
+C pstd----input-R-SSO standard deviation (m)
+c psig----input-R-SSO slope
+c pgam----input-R-SSO Anisotropy
+c pthe----input-R-SSO Angle
+c ppic----input-R-SSO Peacks elevation (m)
+c pval----input-R-SSO Valleys elevation (m)
+c plat----input-R-Latitude (degree)
+c
+c     ==== outputs ===
+c pulow, pvlow -output-R: Low-level wind
+c
+c pte -----output-R: T tendency
+c pvom-----output-R: U tendency
+c pvol-----output-R: V tendency
+c
+c
+c Implicit Arguments:
+c ===================
+c
+c klon-common-I: Number of points seen by the physics
+c klev-common-I: Number of vertical layers
+c
+
+C     ----------
+C
+C     AUTHOR.
+C     -------
+C     F.LOTT  LMD 22/11/95
+C
+       USE dimphy
+       implicit none
+C
+C
+cym#include "dimensions.h"
+cym#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOEGWD.h"
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+C
+      integer nlon,nlev,kgwd
+      real ptsphy
+      real  pte(nlon,nlev),
+     *      pvol(nlon,nlev),
+     *      pvom(nlon,nlev),
+     *      pulow(nlon),
+     *      pvlow(nlon)
+      real  pum1(nlon,nlev),
+     *      pvm1(nlon,nlev),
+     *      ptm1(nlon,nlev),
+     *      plat(nlon),pmea(nlon),
+     *      pstd(nlon),psig(nlon),pgam(nlon),
+     *      pthe(nlon),ppic(nlon),pval(nlon),
+     *      pgeom1(nlon,nlev),
+     *      papm1(nlon,nlev),
+     *      paphm1(nlon,nlev+1)
+C
+      INTEGER  KDX(NLON),KTEST(NLON)
+C-----------------------------------------------------------------------
+C
+C*       0.2   local arrays
+
+      integer jl,ilevh,jk
+      real zhgeo,zdelp,zslow,zsqua,zscav,zbet
+C              ------------
+      integer  iknub(klon),
+     *         iknul(klon)
+      logical ll1(klon,klev+1)
+C
+      real   ztau(klon,klev+1),
+     *       ztav(klon,klev+1),
+     *       zrho(klon,klev+1)
+      real   zdudt(klon),
+     *       zdvdt(klon)
+      real zhcrit(klon,klev)
+
+      logical lifthigh
+      real zcons1,ztmst
+      CHARACTER (LEN=20) :: modname='orolift_strato'
+      CHARACTER (LEN=80) :: abort_message
+
+
+C-----------------------------------------------------------------------
+C
+C*         1.1  initialisations
+C               ---------------
+
+      lifthigh=.false.
+
+      if(nlon.ne.klon.or.nlev.ne.klev) then
+        abort_message = 'pb dimension'
+        CALL abort_gcm (modname,abort_message,1)
+      ENDIF
+      zcons1=1./rd
+      ztmst=ptsphy
+C
+      do 1001 jl=kidia,kfdia
+      zrho(jl,klev+1)  =0.0
+      pulow(jl)        =0.0
+      pvlow(jl)        =0.0
+      iknub(JL)   =klev
+      iknul(JL)   =klev
+      ilevh=klev/3
+      ll1(jl,klev+1)=.false.
+      do 1000 jk=1,klev
+      pvom(jl,jk)=0.0
+      pvol(jl,jk)=0.0
+      pte (jl,jk)=0.0
+ 1000 continue
+ 1001 continue
+
+C
+C*         2.1     DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF
+C*                 LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE
+C*                 THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS.
+C
+C
+C
+      do 2006 jk=klev,1,-1
+      do 2007 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      zhcrit(jl,jk)=amax1(ppic(jl)-pval(jl),100.)
+      zhgeo=pgeom1(jl,jk)/rg
+      ll1(jl,jk)=(zhgeo.gt.zhcrit(jl,jk))
+      if(ll1(jl,jk).neqv.ll1(jl,jk+1)) then
+        iknub(jl)=jk
+      endif
+      endif
+ 2007 continue
+ 2006 continue
+C
+
+      do 2010 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      iknub(jl)=max(iknub(jl),klev/2)
+      iknul(jl)=max(iknul(jl),2*klev/3)
+      if(iknub(jl).gt.nktopg) iknub(jl)=nktopg
+      if(iknub(jl).eq.nktopg) iknul(jl)=klev
+      if(iknub(jl).eq.iknul(jl)) iknub(jl)=iknul(jl)-1
+      endif
+ 2010 continue
+
+      do 223 jk=klev,2,-1
+      do 222 jl=kidia,kfdia
+        zrho(jl,jk)=2.*paphm1(jl,jk)*zcons1/(ptm1(jl,jk)+ptm1(jl,jk-1))
+  222 continue
+  223 continue
+c     print *,'  dans orolift: 223'
+
+C********************************************************************
+C
+c*     define low level flow
+C      -------------------
+      do 2115 jk=klev,1,-1
+      do 2116 jl=kidia,kfdia
+      if(ktest(jl).eq.1) THEN
+      if(jk.ge.iknub(jl).and.jk.le.iknul(jl)) then
+        pulow(JL)=pulow(JL)+pum1(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+        pvlow(JL)=pvlow(JL)+pvm1(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+        zrho(JL,klev+1)=zrho(JL,klev+1)
+     *                 +zrho(JL,JK)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+      endif
+      endif
+ 2116 continue
+ 2115 continue
+      do 2110 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      pulow(JL)=pulow(JL)/(paphm1(jl,iknul(jl)+1)-paphm1(jl,iknub(jl)))
+      pvlow(JL)=pvlow(JL)/(paphm1(jl,iknul(jl)+1)-paphm1(jl,iknub(jl)))
+      zrho(JL,klev+1)=zrho(Jl,klev+1)
+     *               /(paphm1(jl,iknul(jl)+1)-paphm1(jl,iknub(jl)))
+      endif
+ 2110 continue
+
+
+200   continue
+
+C***********************************************************
+C
+C*         3.      COMPUTE MOUNTAIN LIFT
+C
+  300 continue
+C
+      do 301 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+       ztau(jl,klev+1)= - gklift*zrho(jl,klev+1)*2.*romega*
+c    *                 (2*pstd(jl)+pmea(jl))*
+     *                 2*pstd(jl)*
+     *                 sin(rpi/180.*plat(jl))*pvlow(jl)
+       ztav(jl,klev+1)=   gklift*zrho(jl,klev+1)*2.*romega*
+c    *                 (2*pstd(jl)+pmea(jl))*
+     *                 2*pstd(jl)*
+     *                 sin(rpi/180.*plat(jl))*pulow(jl)
+      else
+       ztau(jl,klev+1)=0.0
+       ztav(jl,klev+1)=0.0
+      endif
+301   continue
+
+C
+C*         4.      COMPUTE LIFT PROFILE         
+C*                 --------------------   
+C
+
+  400 continue
+
+      do 401 jk=1,klev
+      do 401 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      ztau(jl,jk)=ztau(jl,klev+1)*paphm1(jl,jk)/paphm1(jl,klev+1)
+      ztav(jl,jk)=ztav(jl,klev+1)*paphm1(jl,jk)/paphm1(jl,klev+1)
+      else
+      ztau(jl,jk)=0.0
+      ztav(jl,jk)=0.0
+      endif
+401   continue
+C
+C
+C*         5.      COMPUTE TENDENCIES.
+C*                 -------------------
+      if(lifthigh)then
+C
+  500 continue
+C
+C  EXPLICIT SOLUTION AT ALL LEVELS
+C
+      do 524 jk=1,klev
+      do 523 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      zdelp=paphm1(jl,jk+1)-paphm1(jl,jk)
+      zdudt(jl)=-rg*(ztau(jl,jk+1)-ztau(jl,jk))/zdelp
+      zdvdt(jl)=-rg*(ztav(jl,jk+1)-ztav(jl,jk))/zdelp
+      endif  
+  523 continue
+  524 continue
+C
+C  PROJECT PERPENDICULARLY TO U NOT TO DESTROY ENERGY
+C
+      do 530 jk=1,klev
+      do 530 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+
+        zslow=sqrt(pulow(jl)**2+pvlow(jl)**2)
+        zsqua=amax1(sqrt(pum1(jl,jk)**2+pvm1(jl,jk)**2),gvsec)
+        zscav=-zdudt(jl)*pvm1(jl,jk)+zdvdt(jl)*pum1(jl,jk)
+        if(zsqua.gt.gvsec)then
+          pvom(jl,jk)=-zscav*pvm1(jl,jk)/zsqua**2
+          pvol(jl,jk)= zscav*pum1(jl,jk)/zsqua**2
+        else
+          pvom(jl,jk)=0.0
+          pvol(jl,jk)=0.0      
+        endif  
+        zsqua=sqrt(pum1(jl,jk)**2+pum1(jl,jk)**2)               
+        if(zsqua.lt.zslow)then
+          pvom(jl,jk)=zsqua/zslow*pvom(jl,jk)
+          pvol(jl,jk)=zsqua/zslow*pvol(jl,jk)
+        endif 
+
+      endif  
+530   continue
+C
+C  6.  LOW LEVEL LIFT, SEMI IMPLICIT:
+C  ----------------------------------
+
+      else
+
+        do 601 jl=kidia,kfdia
+        if(ktest(jl).eq.1) then
+          do jk=klev,iknub(jl),-1
+          zbet=gklift*2.*romega*sin(rpi/180.*plat(jl))*ztmst*
+     *        (pgeom1(jl,iknub(jl)-1)-pgeom1(jl,  jk))/
+     *        (pgeom1(jl,iknub(jl)-1)-pgeom1(jl,klev))
+          zdudt(jl)=-pum1(jl,jk)/ztmst/(1+zbet**2)
+          zdvdt(jl)=-pvm1(jl,jk)/ztmst/(1+zbet**2)
+          pvom(jl,jk)= zbet**2*zdudt(jl) - zbet   *zdvdt(jl)
+          pvol(jl,jk)= zbet   *zdudt(jl) + zbet**2*zdvdt(jl)    
+          enddo
+        endif
+ 601    continue
+
+      endif
+
+c     print *,' out orolift'
+
+      return
+      end
+      SUBROUTINE SUGWD_strato(NLON,NLEV,paprs,pplay)
+C     
+C
+C**** *SUGWD* INITIALIZE COMMON YOEGWD CONTROLLING GRAVITY WAVE DRAG
+C
+C     PURPOSE.
+C     --------
+C           INITIALIZE YOEGWD, THE COMMON THAT CONTROLS THE
+C           GRAVITY WAVE DRAG PARAMETRIZATION.
+C    VERY IMPORTANT:
+C    ______________
+C           THIS ROUTINE SET_UP THE "TUNABLE PARAMETERS" OF THE
+C           VARIOUS SSO SCHEMES
+C
+C**   INTERFACE.
+C     ----------
+C        CALL *SUGWD* FROM *SUPHEC*
+C              -----        ------
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C        PAPRS,PPLAY : Pressure at semi and full model levels
+C        NLEV        : number of model levels
+c        NLON        : number of points treated in the physics
+C
+C        IMPLICIT ARGUMENTS :
+C        --------------------
+C        COMMON YOEGWD
+C-GFRCRIT-R:  Critical Non-dimensional mountain Height
+C             (HNC in (1),    LOTT 1999)
+C-GKWAKE--R:  Bluff-body drag coefficient for low level wake
+C             (Cd in (2),     LOTT 1999)
+C-GRCRIT--R:  Critical Richardson Number 
+C             (Ric, End of first column p791 of LOTT 1999) 
+C-GKDRAG--R:  Gravity wave drag coefficient
+C             (G in (3),      LOTT 1999)
+C-GKLIFT--R:  Mountain Lift coefficient
+C             (Cl in (4),     LOTT 1999)
+C-GHMAX---R:  Not used
+C-GRAHILO-R:  Set-up the trapped waves fraction
+C             (Beta , End of first column,  LOTT 1999)
+C
+C-GSIGCR--R:  Security value for blocked flow depth
+C-NKTOPG--I:  Security value for blocked flow level
+C-nstra----I:  An estimate to qualify the upper levels of
+C             the model where one wants to impose strees
+C             profiles
+C-GSSECC--R:  Security min value for low-level B-V frequency
+C-GTSEC---R:  Security min value for anisotropy and GW stress.
+C-GVSEC---R:  Security min value for ulow
+C         
+C
+C     METHOD.
+C     -------
+C        SEE DOCUMENTATION
+C
+C     EXTERNALS.
+C     ----------
+C        NONE
+C
+C     REFERENCE.
+C     ----------
+C     Lott, 1999: Alleviation of stationary biases in a GCM through...
+C                 Monthly Weather Review, 127, pp 788-801.
+C
+C     AUTHOR.
+C     -------
+C        FRANCOIS LOTT        *LMD*
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL : 90-01-01 (MARTIN MILLER, ECMWF)
+C        LAST:  99-07-09     (FRANCOIS LOTT,LMD)
+C     ------------------------------------------------------------------
+      USE dimphy
+      USE mod_phys_lmdz_para
+      USE mod_grid_phy_lmdz
+      IMPLICIT NONE
+C
+C     -----------------------------------------------------------------
+#include "YOEGWD.h"
+C      ----------------------------------------------------------------
+C
+C  ARGUMENTS
+      integer nlon,nlev
+      REAL paprs(nlon,nlev+1)
+      REAL pplay(nlon,nlev)
+C
+      INTEGER JK
+      REAL ZPR,ZTOP,ZSIGT,ZPM1R
+      REAL :: pplay_glo(klon_glo,nlev)
+      REAL :: paprs_glo(klon_glo,nlev+1)
+
+C
+C*       1.    SET THE VALUES OF THE PARAMETERS
+C              --------------------------------
+C
+ 100  CONTINUE
+C
+      PRINT *,' DANS SUGWD NLEV=',NLEV
+      GHMAX=10000.
+C
+      ZPR=100000.
+      ZTOP=0.001 
+      ZSIGT=0.94
+cold  ZPR=80000.
+cold  ZSIGT=0.85
+C
+      CALL gather(pplay,pplay_glo)
+      CALL bcast(pplay_glo)
+      CALL gather(paprs,paprs_glo)
+      CALL bcast(paprs_glo)
+
+      DO 110 JK=1,NLEV
+      ZPM1R=pplay_glo(klon_glo/2+1,jk)/paprs_glo(klon_glo/2+1,1) 
+      IF(ZPM1R.GE.ZSIGT)THEN
+         nktopg=JK
+      ENDIF
+      ZPM1R=pplay_glo(klon_glo/2+1,jk)/paprs_glo(klon_glo/2+1,1) 
+      IF(ZPM1R.GE.ZTOP)THEN
+         nstra=JK
+      ENDIF
+  110 CONTINUE
+c
+c  inversion car dans orodrag on compte les niveaux a l'envers
+      nktopg=nlev-nktopg+1
+      nstra=nlev-nstra
+      print *,' DANS SUGWD nktopg=', nktopg
+      print *,' DANS SUGWD nstra=', nstra
+C
+      GSIGCR=0.80
+C
+      GKDRAG=0.1875
+      GRAHILO=0.1   
+      GRCRIT=1.00 
+      GFRCRIT=1.00
+      GKWAKE=0.50
+C
+      GKLIFT=0.25
+      GVCRIT =0.1
+
+      WRITE(UNIT=6,FMT='('' *** SSO essential constants ***'')')
+      WRITE(UNIT=6,FMT='('' *** SPECIFIED IN SUGWD ***'')')
+      WRITE(UNIT=6,FMT='('' Gravity wave ct '',E13.7,'' '')')GKDRAG
+      WRITE(UNIT=6,FMT='('' Trapped/total wave dag '',E13.7,'' '')')
+     S      GRAHILO
+      WRITE(UNIT=6,FMT='('' Critical Richardson   = '',E13.7,'' '')')
+     S                  GRCRIT
+      WRITE(UNIT=6,FMT='('' Critical Froude'',e13.7)') GFRCRIT
+      WRITE(UNIT=6,FMT='('' Low level Wake bluff cte'',e13.7)') GKWAKE
+      WRITE(UNIT=6,FMT='('' Low level lift  cte'',e13.7)') GKLIFT
+
+C
+C
+C      ----------------------------------------------------------------
+C
+C*       2.    SET VALUES OF SECURITY PARAMETERS
+C              ---------------------------------
+C
+ 200  CONTINUE
+C
+      GVSEC=0.10
+      GSSEC=0.0001
+C
+      GTSEC=0.00001
+C
+      RETURN
+      END
+
Index: LMDZ5/branches/testing/libf/phy1d/surf_land_bucket_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/surf_land_bucket_mod.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/surf_land_bucket_mod.F90	(revision 1665)
@@ -0,0 +1,178 @@
+!
+MODULE surf_land_bucket_mod
+!
+! Surface land bucket module
+!
+! This module is used when no external land model is choosen.
+!
+  IMPLICIT NONE
+
+CONTAINS
+
+  SUBROUTINE surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
+       tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, &
+       spechum, petAcoef, peqAcoef, petBcoef, peqBcoef, pref, &
+       u1, v1, rugoro, swnet, lwnet, &
+       snow, qsol, agesno, tsoil, &
+       qsurf, z0_new, alb1_new, alb2_new, evap, &
+       fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
+
+    USE limit_read_mod
+    USE surface_data
+    USE fonte_neige_mod
+    USE calcul_fluxs_mod
+    USE cpl_mod
+    USE dimphy
+    USE mod_grid_phy_lmdz
+    USE mod_phys_lmdz_para
+!****************************************************************************************
+! Bucket calculations for surface. 
+!
+    INCLUDE "clesphys.h"
+    INCLUDE "indicesol.h"
+    INCLUDE "dimsoil.h"
+    INCLUDE "YOMCST.h"
+
+! Input variables  
+!****************************************************************************************
+    INTEGER, INTENT(IN)                     :: itime, jour, knon
+    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
+    LOGICAL, INTENT(IN)                     :: debut
+    REAL, INTENT(IN)                        :: dtime
+    REAL, DIMENSION(klon), INTENT(IN)       :: tsurf
+    REAL, DIMENSION(klon), INTENT(IN)       :: p1lay
+    REAL, DIMENSION(klon), INTENT(IN)       :: tq_cdrag
+    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow
+    REAL, DIMENSION(klon), INTENT(IN)       :: temp_air, spechum
+    REAL, DIMENSION(klon), INTENT(IN)       :: petAcoef, peqAcoef
+    REAL, DIMENSION(klon), INTENT(IN)       :: petBcoef, peqBcoef
+    REAL, DIMENSION(klon), INTENT(IN)       :: pref
+    REAL, DIMENSION(klon), INTENT(IN)       :: u1, v1
+    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
+    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
+
+! In/Output variables
+!****************************************************************************************
+    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
+    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
+    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
+
+! Output variables
+!****************************************************************************************
+    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
+    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
+    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
+    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
+    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
+    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l      
+
+! Local variables
+!****************************************************************************************
+    REAL, DIMENSION(klon) :: soilcap, soilflux
+    REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol
+    REAL, DIMENSION(klon) :: alb_neig, alb_lim
+    REAL, DIMENSION(klon) :: zfra
+    REAL, DIMENSION(klon) :: radsol       ! total net radiance at surface
+    REAL, DIMENSION(klon) :: u0, v0, u1_lay, v1_lay
+    REAL, DIMENSION(klon) :: dummy_riverflow,dummy_coastalflow 
+    INTEGER               :: i
+!
+!****************************************************************************************
+
+
+!
+!* Read from limit.nc : albedo(alb_lim), length of rugosity(z0_new)
+!
+    CALL limit_read_rug_alb(itime, dtime, jour,&
+         knon, knindex, &
+         z0_new, alb_lim)
+!
+!* Calcultaion of fluxes 
+!
+
+! calculate total absorbed radiance at surface
+       radsol(:) = 0.0
+       radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
+
+! calculate constants
+    CALL calbeta(dtime, is_ter, knon, snow, qsol, beta, capsol, dif_grnd)
+       
+! calculate temperature, heat capacity and conduction flux in soil
+    IF (soil_model) THEN 
+       CALL soil(dtime, is_ter, knon, snow, tsurf, tsoil, soilcap, soilflux)
+       DO i=1, knon
+          cal(i) = RCPD / soilcap(i)
+          radsol(i) = radsol(i)  + soilflux(i)
+       END DO
+    ELSE 
+       cal(:) = RCPD * capsol(:)
+       IF (klon_glo .EQ. 1) THEN
+         cal(:) = 0.
+       ENDIF
+    ENDIF
+    
+! Suppose zero surface speed
+    u0(:)=0.0
+    v0(:)=0.0
+    u1_lay(:) = u1(:) - u0(:)
+    v1_lay(:) = v1(:) - v0(:)
+
+    CALL calcul_fluxs(knon, is_ter, dtime, &
+         tsurf, p1lay, cal, beta, tq_cdrag, pref, &
+         precip_rain, precip_snow, snow, qsurf,  &
+         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
+         petAcoef, peqAcoef, petBcoef, peqBcoef, &
+         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
+    
+!
+!* Calculate snow height, run_off, age of snow
+!      
+    CALL fonte_neige( knon, is_ter, knindex, dtime, &
+         tsurf, precip_rain, precip_snow, &
+         snow, qsol, tsurf_new, evap)
+!
+!* Calculate the age of snow
+!
+    CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))  
+    
+    WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
+    
+    DO i=1, knon
+       zfra(i) = MAX(0.0,MIN(1.0, snow(i)/(snow(i)+10.0)))
+       alb_lim(i)  = alb_neig(i) *zfra(i) + alb_lim(i)*(1.0-zfra(i))
+    END DO
+
+!
+!* Return albedo : 
+!    alb1_new and alb2_new are here given the same values
+!
+    alb1_new(:) = 0.0
+    alb2_new(:) = 0.0
+    alb1_new(1:knon) = alb_lim(1:knon)
+    alb2_new(1:knon) = alb_lim(1:knon)
+       
+!
+!* Calculate the rugosity
+!
+    DO i = 1, knon
+       z0_new(i) = MAX(1.5e-05,SQRT(z0_new(i)**2 + rugoro(i)**2))
+    END DO
+
+!* Send to coupler
+!  The run-off from river and coast are not calculated in the bucket modele.
+!  For testing purpose of the coupled modele we put the run-off to zero.
+    IF (type_ocean=='couple') THEN
+       dummy_riverflow(:)   = 0.0
+       dummy_coastalflow(:) = 0.0
+       CALL cpl_send_land_fields(itime, knon, knindex, &
+            dummy_riverflow, dummy_coastalflow)
+    ENDIF
+
+!
+!* End
+!
+  END SUBROUTINE surf_land_bucket
+!
+!****************************************************************************************
+!
+END MODULE surf_land_bucket_mod
Index: LMDZ5/branches/testing/libf/phy1d/ttt/pbl_surface_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/ttt/pbl_surface_mod.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/ttt/pbl_surface_mod.F90	(revision 1665)
@@ -0,0 +1,1400 @@
+!
+! $Id: pbl_surface_mod.F90 1413 2010-07-13 07:55:22Z idelkadi $
+!
+MODULE pbl_surface_mod
+!
+! Planetary Boundary Layer and Surface module
+!
+! This module manage the calculation of turbulent diffusion in the boundary layer 
+! and all interactions towards the differents sub-surfaces.
+!
+!
+  USE dimphy
+  USE mod_phys_lmdz_para,  ONLY : mpi_size
+  USE ioipsl
+  USE surface_data,        ONLY : type_ocean, ok_veget
+  USE surf_land_mod,       ONLY : surf_land
+  USE surf_landice_mod,    ONLY : surf_landice
+  USE surf_ocean_mod,      ONLY : surf_ocean
+  USE surf_seaice_mod,     ONLY : surf_seaice
+  USE cpl_mod,             ONLY : gath2cpl
+  USE climb_hq_mod,        ONLY : climb_hq_down, climb_hq_up
+  USE climb_wind_mod,      ONLY : climb_wind_down, climb_wind_up
+  USE coef_diff_turb_mod,  ONLY : coef_diff_turb
+  USE control_mod
+
+
+  IMPLICIT NONE
+
+! Declaration of variables saved in restart file
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: qsol   ! water height in the soil (mm)
+  !$OMP THREADPRIVATE(qsol)
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: fder   ! flux drift
+  !$OMP THREADPRIVATE(fder)
+  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: snow   ! snow at surface
+  !$OMP THREADPRIVATE(snow)
+  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: qsurf  ! humidity at surface
+  !$OMP THREADPRIVATE(qsurf)
+  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: evap   ! evaporation at surface
+  !$OMP THREADPRIVATE(evap)
+  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: rugos  ! rugosity at surface (m)
+  !$OMP THREADPRIVATE(rugos)
+  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: agesno ! age of snow at surface
+  !$OMP THREADPRIVATE(agesno)
+  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: ftsoil ! soil temperature
+  !$OMP THREADPRIVATE(ftsoil)
+
+CONTAINS
+!
+!****************************************************************************************
+!
+  SUBROUTINE pbl_surface_init(qsol_rst, fder_rst, snow_rst, qsurf_rst,&
+       evap_rst, rugos_rst, agesno_rst, ftsoil_rst)
+
+! This routine should be called after the restart file has been read.
+! This routine initialize the restart variables and does some validation tests
+! for the index of the different surfaces and tests the choice of type of ocean.
+
+    INCLUDE "indicesol.h"
+    INCLUDE "dimsoil.h"
+    INCLUDE "iniprint.h"
+ 
+! Input variables
+!****************************************************************************************
+    REAL, DIMENSION(klon), INTENT(IN)                 :: qsol_rst
+    REAL, DIMENSION(klon), INTENT(IN)                 :: fder_rst
+    REAL, DIMENSION(klon, nbsrf), INTENT(IN)          :: snow_rst
+    REAL, DIMENSION(klon, nbsrf), INTENT(IN)          :: qsurf_rst
+    REAL, DIMENSION(klon, nbsrf), INTENT(IN)          :: evap_rst
+    REAL, DIMENSION(klon, nbsrf), INTENT(IN)          :: rugos_rst
+    REAL, DIMENSION(klon, nbsrf), INTENT(IN)          :: agesno_rst
+    REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(IN) :: ftsoil_rst
+
+  
+! Local variables
+!****************************************************************************************
+    INTEGER                       :: ierr
+    CHARACTER(len=80)             :: abort_message
+    CHARACTER(len = 20)           :: modname = 'pbl_surface_init'
+    
+
+!****************************************************************************************
+! Allocate and initialize module variables with fields read from restart file.
+!
+!****************************************************************************************    
+    ALLOCATE(qsol(klon), stat=ierr)
+    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
+
+    ALLOCATE(fder(klon), stat=ierr)
+    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
+
+    ALLOCATE(snow(klon,nbsrf), stat=ierr)
+    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
+
+    ALLOCATE(qsurf(klon,nbsrf), stat=ierr)
+    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
+
+    ALLOCATE(evap(klon,nbsrf), stat=ierr)
+    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
+
+    ALLOCATE(rugos(klon,nbsrf), stat=ierr)
+    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
+
+    ALLOCATE(agesno(klon,nbsrf), stat=ierr)
+    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
+
+    ALLOCATE(ftsoil(klon,nsoilmx,nbsrf), stat=ierr)
+    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
+
+
+    qsol(:)       = qsol_rst(:)
+    fder(:)       = fder_rst(:)
+    snow(:,:)     = snow_rst(:,:)
+    qsurf(:,:)    = qsurf_rst(:,:)
+    evap(:,:)     = evap_rst(:,:)
+    rugos(:,:)    = rugos_rst(:,:)
+    agesno(:,:)   = agesno_rst(:,:)
+    ftsoil(:,:,:) = ftsoil_rst(:,:,:)
+
+
+!****************************************************************************************
+! Test for sub-surface indices
+!
+!****************************************************************************************
+    IF (is_ter /= 1) THEN 
+      WRITE(lunout,*)" *** Warning ***"
+      WRITE(lunout,*)" is_ter n'est pas le premier surface, is_ter = ",is_ter
+      WRITE(lunout,*)"or on doit commencer par les surfaces continentales"
+      abort_message="voir ci-dessus"
+      CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+
+    IF ( is_oce > is_sic ) THEN
+      WRITE(lunout,*)' *** Warning ***'
+      WRITE(lunout,*)' Pour des raisons de sequencement dans le code'
+      WRITE(lunout,*)' l''ocean doit etre traite avant la banquise'
+      WRITE(lunout,*)' or is_oce = ',is_oce, '> is_sic = ',is_sic
+      abort_message='voir ci-dessus'
+      CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+
+    IF ( is_lic > is_sic ) THEN
+      WRITE(lunout,*)' *** Warning ***'
+      WRITE(lunout,*)' Pour des raisons de sequencement dans le code'
+      WRITE(lunout,*)' la glace contineltalle doit etre traite avant la glace de mer'
+      WRITE(lunout,*)' or is_lic = ',is_lic, '> is_sic = ',is_sic
+      abort_message='voir ci-dessus'
+      CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+
+!****************************************************************************************
+! Validation of ocean mode
+!
+!****************************************************************************************
+
+    IF (type_ocean /= 'slab  ' .AND. type_ocean /= 'force ' .AND. type_ocean /= 'couple') THEN
+       WRITE(lunout,*)' *** Warning ***'
+       WRITE(lunout,*)'Option couplage pour l''ocean = ', type_ocean
+       abort_message='option pour l''ocean non valable'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+
+  END SUBROUTINE pbl_surface_init
+!  
+!****************************************************************************************
+!  
+
+  SUBROUTINE pbl_surface( &
+       dtime,     date0,     itap,     jour,          &
+       debut,     lafin,                              &
+       rlon,      rlat,      rugoro,   rmu0,          &
+       rain_f,    snow_f,    solsw_m,  sollw_m,       &
+       t,         q,         u,        v,             &
+       pplay,     paprs,     pctsrf,                  &
+       ts,        alb1,      alb2,     u10m,   v10m,  &
+       lwdown_m,  cdragh,    cdragm,   zu1,    zv1,   &
+       alb1_m,    alb2_m,    zxsens,   zxevap,        &
+       zxtsol,    zxfluxlat, zt2m,     qsat2m,        &
+       d_t,       d_q,       d_u,      d_v,           & 
+       zcoefh,    slab_wfbils,                        &
+       qsol_d,    zq2m,      s_pblh,   s_plcl,        &
+       s_capCL,   s_oliqCL,  s_cteiCL, s_pblT,        &
+       s_therm,   s_trmb1,   s_trmb2,  s_trmb3,       &
+       zxrugs,    zu10m,     zv10m,    fder_print,    &
+       zxqsurf,   rh2m,      zxfluxu,  zxfluxv,       &
+       rugos_d,   agesno_d,  sollw,    solsw,         &
+       d_ts,      evap_d,    fluxlat,  t2m,           &
+       wfbils,    wfbilo,    flux_t,   flux_u, flux_v,&
+       dflux_t,   dflux_q,   zxsnow,                  &
+       zxfluxt,   zxfluxq,   q2m,      flux_q, tke    )
+!****************************************************************************************
+! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+! Objet: interface de "couche limite" (diffusion verticale)
+!
+!AA REM:
+!AA-----
+!AA Tout ce qui a trait au traceurs est dans phytrac maintenant
+!AA pour l'instant le calcul de la couche limite pour les traceurs
+!AA se fait avec cltrac et ne tient pas compte de la differentiation
+!AA des sous-fraction de sol.
+!AA REM bis :
+!AA----------
+!AA Pour pouvoir extraire les coefficient d'echanges et le vent 
+!AA dans la premiere couche, 3 champs supplementaires ont ete crees
+!AA zcoefh, zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
+!AA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir 
+!AA si les informations des subsurfaces doivent etre prises en compte
+!AA il faudra sortir ces memes champs en leur ajoutant une dimension, 
+!AA c'est a dire nbsrf (nbre de subsurface).
+!
+! Arguments:
+!
+! dtime----input-R- interval du temps (secondes)
+! itap-----input-I- numero du pas de temps
+! date0----input-R- jour initial
+! t--------input-R- temperature (K)
+! q--------input-R- vapeur d'eau (kg/kg)
+! u--------input-R- vitesse u
+! v--------input-R- vitesse v
+! ts-------input-R- temperature du sol (en Kelvin)
+! paprs----input-R- pression a intercouche (Pa)
+! pplay----input-R- pression au milieu de couche (Pa)
+! rlat-----input-R- latitude en degree
+! rugos----input-R- longeur de rugosite (en m)
+!
+! d_t------output-R- le changement pour "t"
+! d_q------output-R- le changement pour "q"
+! d_u------output-R- le changement pour "u"
+! d_v------output-R- le changement pour "v"
+! d_ts-----output-R- le changement pour "ts"
+! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
+!                    (orientation positive vers le bas)
+! tke---input/output-R- tke (kg/m**2/s)
+! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
+! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
+! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
+! dflux_t--output-R- derive du flux sensible
+! dflux_q--output-R- derive du flux latent
+! zu1------output-R- le vent dans la premiere couche
+! zv1------output-R- le vent dans la premiere couche
+! trmb1----output-R- deep_cape
+! trmb2----output-R- inhibition 
+! trmb3----output-R- Point Omega
+! cteiCL---output-R- Critere d'instab d'entrainmt des nuages de CL
+! plcl-----output-R- Niveau de condensation
+! pblh-----output-R- HCL
+! pblT-----output-R- T au nveau HCL
+!
+    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
+    IMPLICIT NONE
+
+    INCLUDE "indicesol.h"
+    INCLUDE "dimsoil.h"
+    INCLUDE "YOMCST.h"
+    INCLUDE "iniprint.h"
+    INCLUDE "FCTTRE.h"
+    INCLUDE "clesphys.h"
+    INCLUDE "compbl.h"
+    INCLUDE "dimensions.h"
+    INCLUDE "YOETHF.h"
+    INCLUDE "temps.h"
+!****************************************************************************************
+! Declarations specifiques pour le 1D. A reprendre 
+    INCLUDE flux_arp.h
+! Input variables
+!****************************************************************************************
+    REAL,                         INTENT(IN)        :: dtime   ! time interval (s)
+    REAL,                         INTENT(IN)        :: date0   ! initial day
+    INTEGER,                      INTENT(IN)        :: itap    ! time step
+    INTEGER,                      INTENT(IN)        :: jour    ! current day of the year
+    LOGICAL,                      INTENT(IN)        :: debut   ! true if first run step
+    LOGICAL,                      INTENT(IN)        :: lafin   ! true if last run step
+    REAL, DIMENSION(klon),        INTENT(IN)        :: rlon    ! longitudes in degrees
+    REAL, DIMENSION(klon),        INTENT(IN)        :: rlat    ! latitudes in degrees
+    REAL, DIMENSION(klon),        INTENT(IN)        :: rugoro  ! rugosity length
+    REAL, DIMENSION(klon),        INTENT(IN)        :: rmu0    ! cosine of solar zenith angle
+    REAL, DIMENSION(klon),        INTENT(IN)        :: rain_f  ! rain fall
+    REAL, DIMENSION(klon),        INTENT(IN)        :: snow_f  ! snow fall
+    REAL, DIMENSION(klon),        INTENT(IN)        :: solsw_m ! net shortwave radiation at mean surface
+    REAL, DIMENSION(klon),        INTENT(IN)        :: sollw_m ! net longwave radiation at mean surface
+    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: t       ! temperature (K)
+    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: q       ! water vapour (kg/kg)
+    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: u       ! u speed
+    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: v       ! v speed
+    REAL, DIMENSION(klon,klev),   INTENT(IN)        :: pplay   ! mid-layer pression (Pa)
+    REAL, DIMENSION(klon,klev+1), INTENT(IN)        :: paprs   ! pression between layers (Pa) 
+    REAL, DIMENSION(klon, nbsrf), INTENT(IN)        :: pctsrf  ! sub-surface fraction
+
+! Input/Output variables
+!****************************************************************************************
+    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: ts      ! temperature at surface (K)
+    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: alb1    ! albedo in visible SW interval
+    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: alb2    ! albedo in near infra-red SW interval
+    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: u10m    ! u speed at 10m
+    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: v10m    ! v speed at 10m
+    REAL, DIMENSION(klon, klev+1, nbsrf), INTENT(INOUT) :: tke 
+
+! Output variables
+!****************************************************************************************
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: lwdown_m   ! Downcoming longwave radiation
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: cdragh     ! drag coefficient for T and Q
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: cdragm     ! drag coefficient for wind
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: zu1        ! u wind speed in first layer
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: zv1        ! v wind speed in first layer
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: alb1_m     ! mean albedo in visible SW interval
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: alb2_m     ! mean albedo in near IR SW interval
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxsens     ! sensible heat flux at surface with inversed sign 
+                                                                  ! (=> positive sign upwards)
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxevap     ! water vapour flux at surface, positiv upwards
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxtsol     ! temperature at surface, mean for each grid point
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxfluxlat  ! latent flux, mean for each grid point
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: zt2m       ! temperature at 2m, mean for each grid point
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: qsat2m
+    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_t        ! change in temperature 
+    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_q        ! change in water vapour
+    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_u        ! change in u speed
+    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_v        ! change in v speed
+    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zcoefh     ! coef for turbulent diffusion of T and Q, mean for each grid point
+
+! Output only for diagnostics
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: slab_wfbils! heat balance at surface only for slab at ocean points
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: qsol_d     ! water height in the soil (mm)
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: zq2m       ! water vapour at 2m, mean for each grid point
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_pblh     ! height of the planetary boundary layer(HPBL)
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_plcl     ! condensation level
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_capCL    ! CAPE of PBL
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_oliqCL   ! liquid water intergral of PBL
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_cteiCL   ! cloud top instab. crit. of PBL
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_pblT     ! temperature at PBLH
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_therm    ! thermal virtual temperature excess
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_trmb1    ! deep cape, mean for each grid point
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_trmb2    ! inhibition, mean for each grid point
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_trmb3    ! point Omega, mean for each grid point
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxrugs     ! rugosity at surface (m), mean for each grid point
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: zu10m      ! u speed at 10m, mean for each grid point
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: zv10m      ! v speed at 10m, mean for each grid point
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: fder_print ! fder for printing (=fder(i) + dflux_t(i) + dflux_q(i))
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxqsurf    ! humidity at surface, mean for each grid point
+    REAL, DIMENSION(klon),        INTENT(OUT)       :: rh2m       ! relative humidity at 2m
+    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxu    ! u wind tension, mean for each grid point
+    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxv    ! v wind tension, mean for each grid point
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: rugos_d    ! rugosity length (m)
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: agesno_d   ! age of snow at surface
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: solsw      ! net shortwave radiation at surface 
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: sollw      ! net longwave radiation at surface
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: d_ts       ! change in temperature at surface
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: evap_d     ! evaporation at surface
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: fluxlat    ! latent flux
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: t2m        ! temperature at 2 meter height
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: wfbils     ! heat balance at surface
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: wfbilo     ! water balance at surface
+    REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_t     ! sensible heat flux (CpT) J/m**2/s (W/m**2)
+                                                                  ! positve orientation downwards
+    REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_u     ! u wind tension (kg m/s)/(m**2 s) or Pascal
+    REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v     ! v wind tension (kg m/s)/(m**2 s) or Pascal
+
+! Output not needed
+    REAL, DIMENSION(klon),       INTENT(OUT)        :: dflux_t    ! change of sensible heat flux 
+    REAL, DIMENSION(klon),       INTENT(OUT)        :: dflux_q    ! change of water vapour flux
+    REAL, DIMENSION(klon),       INTENT(OUT)        :: zxsnow     ! snow at surface, mean for each grid point
+    REAL, DIMENSION(klon, klev), INTENT(OUT)        :: zxfluxt    ! sensible heat flux, mean for each grid point
+    REAL, DIMENSION(klon, klev), INTENT(OUT)        :: zxfluxq    ! water vapour flux, mean for each grid point
+    REAL, DIMENSION(klon, nbsrf),INTENT(OUT)        :: q2m        ! water vapour at 2 meter height
+    REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_q     ! water vapour flux(latent flux) (kg/m**2/s)
+
+
+! Local variables with attribute SAVE
+!****************************************************************************************
+    INTEGER, SAVE                            :: nhoridbg, nidbg   ! variables for IOIPSL
+!$OMP THREADPRIVATE(nhoridbg, nidbg)
+    LOGICAL, SAVE                            :: debugindex=.FALSE.
+!$OMP THREADPRIVATE(debugindex)
+    LOGICAL, SAVE                            :: first_call=.TRUE.
+!$OMP THREADPRIVATE(first_call)
+    CHARACTER(len=8), DIMENSION(nbsrf), SAVE :: cl_surf
+!$OMP THREADPRIVATE(cl_surf)
+
+! Other local variables
+!****************************************************************************************
+    INTEGER                            :: i, k, nsrf 
+    INTEGER                            :: knon, j
+    INTEGER                            :: idayref
+    INTEGER , DIMENSION(klon)          :: ni
+    REAL                               :: zx_alf1, zx_alf2 !valeur ambiante par extrapola
+    REAL                               :: amn, amx
+    REAL                               :: f1 ! fraction de longeurs visibles parmi tout SW intervalle
+    REAL, DIMENSION(klon)              :: r_co2_ppm     ! taux CO2 atmosphere
+    REAL, DIMENSION(klon)              :: yts, yrugos, ypct, yz0_new
+    REAL, DIMENSION(klon)              :: yalb, yalb1, yalb2
+    REAL, DIMENSION(klon)              :: yu1, yv1
+    REAL, DIMENSION(klon)              :: ysnow, yqsurf, yagesno, yqsol
+    REAL, DIMENSION(klon)              :: yrain_f, ysnow_f
+    REAL, DIMENSION(klon)              :: ysolsw, ysollw
+    REAL, DIMENSION(klon)              :: yfder
+    REAL, DIMENSION(klon)              :: yrugoro
+    REAL, DIMENSION(klon)              :: yfluxlat
+    REAL, DIMENSION(klon)              :: y_d_ts
+    REAL, DIMENSION(klon)              :: y_flux_t1, y_flux_q1
+    REAL, DIMENSION(klon)              :: y_dflux_t, y_dflux_q
+    REAL, DIMENSION(klon)              :: y_flux_u1, y_flux_v1
+    REAL, DIMENSION(klon)              :: yt2m, yq2m, yu10m
+    REAL, DIMENSION(klon)              :: yustar
+    REAL, DIMENSION(klon)              :: ywindsp
+    REAL, DIMENSION(klon)              :: yt10m, yq10m
+    REAL, DIMENSION(klon)              :: ypblh
+    REAL, DIMENSION(klon)              :: ylcl
+    REAL, DIMENSION(klon)              :: ycapCL
+    REAL, DIMENSION(klon)              :: yoliqCL
+    REAL, DIMENSION(klon)              :: ycteiCL
+    REAL, DIMENSION(klon)              :: ypblT
+    REAL, DIMENSION(klon)              :: ytherm
+    REAL, DIMENSION(klon)              :: ytrmb1
+    REAL, DIMENSION(klon)              :: ytrmb2
+    REAL, DIMENSION(klon)              :: ytrmb3
+    REAL, DIMENSION(klon)              :: uzon, vmer
+    REAL, DIMENSION(klon)              :: tair1, qair1, tairsol
+    REAL, DIMENSION(klon)              :: psfce, patm
+    REAL, DIMENSION(klon)              :: qairsol, zgeo1
+    REAL, DIMENSION(klon)              :: rugo1
+    REAL, DIMENSION(klon)              :: yfluxsens
+    REAL, DIMENSION(klon)              :: AcoefH, AcoefQ, BcoefH, BcoefQ
+    REAL, DIMENSION(klon)              :: AcoefU, AcoefV, BcoefU, BcoefV
+    REAL, DIMENSION(klon)              :: ypsref
+    REAL, DIMENSION(klon)              :: yevap, ytsurf_new, yalb1_new, yalb2_new
+    REAL, DIMENSION(klon)              :: ztsol
+    REAL, DIMENSION(klon)              :: alb_m  ! mean albedo for whole SW interval
+    REAL, DIMENSION(klon,klev)         :: y_d_t, y_d_q
+    REAL, DIMENSION(klon,klev)         :: y_d_u, y_d_v
+    REAL, DIMENSION(klon,klev)         :: y_flux_t, y_flux_q
+    REAL, DIMENSION(klon,klev)         :: y_flux_u, y_flux_v
+    REAL, DIMENSION(klon,klev)         :: ycoefh, ycoefm
+    REAL, DIMENSION(klon)              :: ycdragh, ycdragm
+    REAL, DIMENSION(klon,klev)         :: yu, yv
+    REAL, DIMENSION(klon,klev)         :: yt, yq
+    REAL, DIMENSION(klon,klev)         :: ypplay, ydelp
+    REAL, DIMENSION(klon,klev)         :: delp
+    REAL, DIMENSION(klon,klev+1)       :: ypaprs
+    REAL, DIMENSION(klon,klev+1)       :: ytke
+    REAL, DIMENSION(klon,nsoilmx)      :: ytsoil
+    CHARACTER(len=80)                  :: abort_message
+    CHARACTER(len=20)                  :: modname = 'pbl_surface'
+    LOGICAL, PARAMETER                 :: zxli=.FALSE. ! utiliser un jeu de fonctions simples
+    LOGICAL, PARAMETER                 :: check=.FALSE.
+
+! For debugging with IOIPSL
+    INTEGER, DIMENSION(iim*(jjm+1))    :: ndexbg
+    REAL                               :: zjulian
+    REAL, DIMENSION(klon)              :: tabindx
+    REAL, DIMENSION(iim,jjm+1)         :: zx_lon, zx_lat
+    REAL, DIMENSION(iim,jjm+1)         :: debugtab
+
+
+    REAL, DIMENSION(klon,nbsrf)        :: pblh         ! height of the planetary boundary layer
+    REAL, DIMENSION(klon,nbsrf)        :: plcl         ! condensation level
+    REAL, DIMENSION(klon,nbsrf)        :: capCL
+    REAL, DIMENSION(klon,nbsrf)        :: oliqCL
+    REAL, DIMENSION(klon,nbsrf)        :: cteiCL
+    REAL, DIMENSION(klon,nbsrf)        :: pblT
+    REAL, DIMENSION(klon,nbsrf)        :: therm
+    REAL, DIMENSION(klon,nbsrf)        :: trmb1        ! deep cape
+    REAL, DIMENSION(klon,nbsrf)        :: trmb2        ! inhibition
+    REAL, DIMENSION(klon,nbsrf)        :: trmb3        ! point Omega
+    REAL, DIMENSION(klon,nbsrf)        :: zx_rh2m, zx_qsat2m
+    REAL, DIMENSION(klon,nbsrf)        :: zx_t1
+    REAL, DIMENSION(klon, nbsrf)       :: alb          ! mean albedo for whole SW interval
+    REAL, DIMENSION(klon)              :: ylwdown      ! jg : temporary (ysollwdown)
+
+    REAL                               :: zx_qs1, zcor1, zdelta1 
+
+!****************************************************************************************
+! Declarations specifiques pour le 1D. A reprendre 
+!****************************************************************************************
+! End of declarations
+!****************************************************************************************
+
+
+!****************************************************************************************
+! 1) Initialisation and validation tests 
+!    Only done first time entering this subroutine
+!
+!****************************************************************************************
+
+    IF (first_call) THEN
+       first_call=.FALSE.
+      
+       ! Initialize ok_flux_surf (for 1D model)
+       if (klon>1) ok_flux_surf=.FALSE.
+       
+       ! Initilize debug IO
+       IF (debugindex .AND. mpi_size==1) THEN 
+          ! initialize IOIPSL output
+          idayref = day_ini
+          CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
+          CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
+          DO i = 1, iim
+             zx_lon(i,1) = rlon(i+1)
+             zx_lon(i,jjm+1) = rlon(i+1)
+          ENDDO
+          CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat)
+          CALL histbeg("sous_index", iim,zx_lon(:,1),jjm+1,zx_lat(1,:), &
+               1,iim,1,jjm+1, &
+               itau_phy,zjulian,dtime,nhoridbg,nidbg) 
+          ! no vertical axis
+          cl_surf(1)='ter'
+          cl_surf(2)='lic'
+          cl_surf(3)='oce'
+          cl_surf(4)='sic'
+          DO nsrf=1,nbsrf
+             CALL histdef(nidbg, cl_surf(nsrf),cl_surf(nsrf), "-",iim, &
+                  jjm+1,nhoridbg, 1, 1, 1, -99, 32, "inst", dtime,dtime) 
+          END DO
+
+          CALL histend(nidbg)
+          CALL histsync(nidbg)
+
+       END IF
+       
+    ENDIF
+          
+!****************************************************************************************
+! Force soil water content to qsol0 if qsol0>0 and VEGET=F (use bucket
+! instead of ORCHIDEE)
+    IF (qsol0>0.) THEN
+      PRINT*,'WARNING : On impose qsol=',qsol0
+      qsol(:)=qsol0
+    ENDIF
+!****************************************************************************************
+
+!****************************************************************************************
+! 2) Initialization to zero 
+!    Done for all local variables that will be compressed later
+!    and argument with INTENT(OUT)
+!****************************************************************************************
+    cdragh = 0.0  ; cdragm = 0.0     ; dflux_t = 0.0   ; dflux_q = 0.0
+    ypct = 0.0    ; yts = 0.0        ; ysnow = 0.0
+    zv1 = 0.0     ; yqsurf = 0.0     ; yalb1 = 0.0     ; yalb2 = 0.0    
+    yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0    
+    ysollw = 0.0  ; yrugos = 0.0     ; yu1 = 0.0    
+    yv1 = 0.0     ; ypaprs = 0.0     ; ypplay = 0.0
+    ydelp = 0.0   ; yu = 0.0         ; yv = 0.0        ; yt = 0.0         
+    yq = 0.0      ; y_dflux_t = 0.0  ; y_dflux_q = 0.0 
+    yrugoro = 0.0 ; ywindsp = 0.0   
+    d_ts = 0.0    ; yfluxlat=0.0     ; flux_t = 0.0    ; flux_q = 0.0     
+    flux_u = 0.0  ; flux_v = 0.0     ; d_t = 0.0       ; d_q = 0.0      
+    d_u = 0.0     ; d_v = 0.0        ; yqsol = 0.0    
+    ytherm = 0.0  ; ytke=0.
+    
+    zcoefh(:,:) = 0.0
+    zcoefh(:,1) = 999999. ! zcoefh(:,k=1) should never be used
+    ytsoil = 999999. 
+
+    rh2m(:)        = 0.
+    qsat2m(:)      = 0.
+!****************************************************************************************
+! 3) - Calculate pressure thickness of each layer
+!    - Calculate the wind at first layer
+!    - Mean calculations of albedo
+!    - Calculate net radiance at sub-surface
+!****************************************************************************************
+    DO k = 1, klev
+       DO i = 1, klon
+          delp(i,k) = paprs(i,k)-paprs(i,k+1)
+       ENDDO
+    ENDDO
+
+!****************************************************************************************
+! Test for rugos........ from physiq.. A la fin plutot???
+!
+!****************************************************************************************
+
+    zxrugs(:) = 0.0
+    DO nsrf = 1, nbsrf
+       DO i = 1, klon
+          rugos(i,nsrf) = MAX(rugos(i,nsrf),0.000015)
+          zxrugs(i) = zxrugs(i) + rugos(i,nsrf)*pctsrf(i,nsrf)
+       ENDDO
+    ENDDO
+
+! Mean calculations of albedo
+!
+! Albedo at sub-surface
+! * alb1 : albedo in visible SW interval
+! * alb2 : albedo in near infrared SW interval
+! * alb  : mean albedo for whole SW interval
+!
+! Mean albedo for grid point
+! * alb1_m : albedo in visible SW interval
+! * alb2_m : albedo in near infrared SW interval
+! * alb_m  : mean albedo at whole SW interval
+
+    alb1_m(:) = 0.0
+    alb2_m(:) = 0.0
+    DO nsrf = 1, nbsrf
+       DO i = 1, klon
+          alb1_m(i) = alb1_m(i) + alb1(i,nsrf) * pctsrf(i,nsrf)
+          alb2_m(i) = alb2_m(i) + alb2(i,nsrf) * pctsrf(i,nsrf)
+       ENDDO
+    ENDDO
+
+! We here suppose the fraction f1 of incoming radiance of visible radiance 
+! as a fraction of all shortwave radiance 
+    f1 = 0.5 
+!    f1 = 1    ! put f1=1 to recreate old calculations
+
+    DO nsrf = 1, nbsrf
+       DO i = 1, klon
+          alb(i,nsrf) = f1*alb1(i,nsrf) + (1-f1)*alb2(i,nsrf)
+       ENDDO
+    ENDDO
+
+    DO i = 1, klon
+       alb_m(i) = f1*alb1_m(i) + (1-f1)*alb2_m(i)
+    END DO
+
+! Calculation of mean temperature at surface grid points
+    ztsol(:) = 0.0
+    DO nsrf = 1, nbsrf
+       DO i = 1, klon
+          ztsol(i) = ztsol(i) + ts(i,nsrf)*pctsrf(i,nsrf)
+       ENDDO
+    ENDDO
+
+! Linear distrubution on sub-surface of long- and shortwave net radiance
+    DO nsrf = 1, nbsrf
+       DO i = 1, klon
+          sollw(i,nsrf) = sollw_m(i) + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ts(i,nsrf))
+          solsw(i,nsrf) = solsw_m(i) * (1.-alb(i,nsrf)) / (1.-alb_m(i))
+       ENDDO
+    ENDDO
+
+
+! Downwelling longwave radiation at mean surface
+    lwdown_m(:) = 0.0
+    DO i = 1, klon
+       lwdown_m(i) = sollw_m(i) + RSIGMA*ztsol(i)**4
+    ENDDO
+
+!****************************************************************************************
+! 4) Loop over different surfaces
+!
+! Only points containing a fraction of the sub surface will be threated.
+! 
+!****************************************************************************************
+   
+    loop_nbsrf: DO nsrf = 1, nbsrf
+
+! Search for index(ni) and size(knon) of domaine to treat
+       ni(:) = 0
+       knon  = 0
+       DO i = 1, klon
+          IF (pctsrf(i,nsrf) > 0.) THEN
+             knon = knon + 1
+             ni(knon) = i
+          ENDIF
+       ENDDO
+
+       ! write index, with IOIPSL
+       IF (debugindex .AND. mpi_size==1) THEN 
+          tabindx(:)=0.
+          DO i=1,knon
+             tabindx(i)=REAL(i)
+          END DO
+          debugtab(:,:) = 0.
+          ndexbg(:) = 0
+          CALL gath2cpl(tabindx,debugtab,knon,ni)
+          CALL histwrite(nidbg,cl_surf(nsrf),itap,debugtab,iim*(jjm+1), ndexbg)
+       ENDIF
+       
+!****************************************************************************************
+! 5) Compress variables 
+!
+!****************************************************************************************
+
+       DO j = 1, knon
+          i = ni(j)
+          ypct(j)    = pctsrf(i,nsrf)
+          yts(j)     = ts(i,nsrf)
+          ysnow(j)   = snow(i,nsrf)
+          yqsurf(j)  = qsurf(i,nsrf)
+          yalb(j)    = alb(i,nsrf)
+          yalb1(j)   = alb1(i,nsrf)
+          yalb2(j)   = alb2(i,nsrf)
+          yrain_f(j) = rain_f(i)
+          ysnow_f(j) = snow_f(i)
+          yagesno(j) = agesno(i,nsrf)
+          yfder(j)   = fder(i)
+          ysolsw(j)  = solsw(i,nsrf)
+          ysollw(j)  = sollw(i,nsrf)
+          yrugos(j)  = rugos(i,nsrf)
+          yrugoro(j) = rugoro(i)
+          yu1(j)     = u(i,1)
+          yv1(j)     = v(i,1)
+          ypaprs(j,klev+1) = paprs(i,klev+1)
+          ywindsp(j) = SQRT(u10m(i,nsrf)**2 + v10m(i,nsrf)**2 )
+       END DO
+
+       DO k = 1, klev
+          DO j = 1, knon
+             i = ni(j)
+             ypaprs(j,k) = paprs(i,k)
+             ypplay(j,k) = pplay(i,k)
+             ydelp(j,k)  = delp(i,k)
+             ytke(j,k)   = tke(i,k,nsrf)
+             yu(j,k) = u(i,k)
+             yv(j,k) = v(i,k)
+             yt(j,k) = t(i,k)
+             yq(j,k) = q(i,k)
+          ENDDO
+       ENDDO
+       
+       DO k = 1, nsoilmx
+          DO j = 1, knon
+             i = ni(j)
+             ytsoil(j,k) = ftsoil(i,k,nsrf)
+          END DO
+       END DO
+       
+       ! qsol(water height in soil) only for bucket continental model
+       IF ( nsrf .EQ. is_ter .AND. .NOT. ok_veget ) THEN 
+          DO j = 1, knon
+             i = ni(j)
+             yqsol(j) = qsol(i)
+          END DO
+       ENDIF
+       
+!****************************************************************************************
+! 6a) Calculate coefficients for turbulent diffusion at surface, cdragh et cdragm.
+!
+!****************************************************************************************
+
+       CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
+            yu(:,1), yv(:,1), yt(:,1), yq(:,1), &
+            yts, yqsurf, yrugos, &
+            ycdragm, ycdragh )
+
+!****************************************************************************************
+! 6b) Calculate coefficients for turbulent diffusion in the atmosphere, ycoefm et ycoefm.
+!
+!****************************************************************************************
+
+       CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
+            ypaprs, ypplay, yu, yv, yq, yt, yts, yrugos, yqsurf, ycdragm, &
+            ycoefm, ycoefh, ytke)
+       
+!****************************************************************************************
+! 
+! 8) "La descente" - "The downhill"
+!  
+!  climb_hq_down and climb_wind_down calculate the coefficients
+!  Ccoef_X et Dcoef_X for X=[H, Q, U, V].
+!  Only the coefficients at surface for H and Q are returned.
+!
+!****************************************************************************************
+
+! - Calculate the coefficients Ccoef_H, Ccoef_Q, Dcoef_H and Dcoef_Q 
+       CALL climb_hq_down(knon, ycoefh, ypaprs, ypplay, &
+            ydelp, yt, yq, dtime, &
+            AcoefH, AcoefQ, BcoefH, BcoefQ)
+
+! - Calculate the coefficients Ccoef_U, Ccoef_V, Dcoef_U and Dcoef_V
+       CALL climb_wind_down(knon, dtime, ycoefm, ypplay, ypaprs, yt, ydelp, yu, yv, &
+            AcoefU, AcoefV, BcoefU, BcoefV)
+      
+
+!****************************************************************************************
+! 9) Small calculations
+!
+!****************************************************************************************
+
+! - Reference pressure is given the values at surface level          
+       ypsref(:) = ypaprs(:,1)  
+
+! - CO2 field on 2D grid to be sent to ORCHIDEE
+!   Transform to compressed field
+       IF (carbon_cycle_cpl) THEN
+          DO i=1,knon
+             r_co2_ppm(i) = co2_send(ni(i))
+          END DO
+       ELSE
+          r_co2_ppm(:) = co2_ppm     ! Constant field
+       END IF
+
+!****************************************************************************************
+!
+! Calulate t2m and q2m for the case of calculation at land grid points 
+! t2m and q2m are needed as input to ORCHIDEE
+!
+!****************************************************************************************
+       IF (nsrf == is_ter) THEN
+
+          DO i = 1, knon
+             zgeo1(i) = RD * yt(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
+                  * (ypaprs(i,1)-ypplay(i,1))
+          END DO
+
+          ! Calculate the temperature et relative humidity at 2m and the wind at 10m 
+          CALL stdlevvar(klon, knon, is_ter, zxli, &
+               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
+               yts, yqsurf, yrugos, ypaprs(:,1), ypplay(:,1), &
+               yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
+          
+       END IF
+
+!****************************************************************************************
+!
+! 10) Switch selon current surface
+!     It is necessary to start with the continental surfaces because the ocean
+!     needs their run-off.
+!
+!****************************************************************************************
+       SELECT CASE(nsrf)
+     
+       CASE(is_ter)
+          ! ylwdown : to be removed, calculation is now done at land surface in surf_land
+          ylwdown(:)=0.0
+          DO i=1,knon
+             ylwdown(i)=lwdown_m(ni(i))
+          END DO
+          CALL surf_land(itap, dtime, date0, jour, knon, ni,&
+               rlon, rlat, &
+               debut, lafin, ydelp(:,1), r_co2_ppm, ysolsw, ysollw, yalb, &
+               yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
+               AcoefH, AcoefQ, BcoefH, BcoefQ, & 
+               AcoefU, AcoefV, BcoefU, BcoefV, & 
+               ypsref, yu1, yv1, yrugoro, pctsrf, &
+               ylwdown, yq2m, yt2m, &
+               ysnow, yqsol, yagesno, ytsoil, &
+               yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
+               yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
+               y_flux_u1, y_flux_v1 )
+               
+     
+       CASE(is_lic)
+          CALL surf_landice(itap, dtime, knon, ni, &
+               ysolsw, ysollw, yts, ypplay(:,1), &
+               ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
+               AcoefH, AcoefQ, BcoefH, BcoefQ, &
+               AcoefU, AcoefV, BcoefU, BcoefV, &
+               ypsref, yu1, yv1, yrugoro, pctsrf, &
+               ysnow, yqsurf, yqsol, yagesno, &
+               ytsoil, yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
+               ytsurf_new, y_dflux_t, y_dflux_q, &
+               y_flux_u1, y_flux_v1)
+          
+       CASE(is_oce)
+          CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb1, &
+               yrugos, ywindsp, rmu0, yfder, yts, &
+               itap, dtime, jour, knon, ni, &
+               ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
+               AcoefH, AcoefQ, BcoefH, BcoefQ, &
+               AcoefU, AcoefV, BcoefU, BcoefV, &
+               ypsref, yu1, yv1, yrugoro, pctsrf, &
+               ysnow, yqsurf, yagesno, &
+               yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
+               ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, &
+               y_flux_u1, y_flux_v1)
+          
+       CASE(is_sic)
+          CALL surf_seaice( &
+               rlon, rlat, ysolsw, ysollw, yalb1, yfder, &
+               itap, dtime, jour, knon, ni, &
+               lafin, &
+               yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
+               AcoefH, AcoefQ, BcoefH, BcoefQ, &
+               AcoefU, AcoefV, BcoefU, BcoefV, &
+               ypsref, yu1, yv1, yrugoro, pctsrf, &
+               ysnow, yqsurf, yqsol, yagesno, ytsoil, &
+               yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
+               ytsurf_new, y_dflux_t, y_dflux_q, &
+               y_flux_u1, y_flux_v1)
+          
+
+       CASE DEFAULT
+          WRITE(lunout,*) 'Surface index = ', nsrf
+          abort_message = 'Surface index not valid'
+          CALL abort_gcm(modname,abort_message,1)
+       END SELECT
+
+
+!****************************************************************************************
+! 11) - Calcul the increment of surface temperature
+!
+!****************************************************************************************
+       y_d_ts(1:knon)   = ytsurf_new(1:knon) - yts(1:knon)
+ 
+!****************************************************************************************
+!
+! 12) "La remontee" - "The uphill"
+!
+!  The fluxes (y_flux_X) and tendancy (y_d_X) are calculated 
+!  for X=H, Q, U and V, for all vertical levels.
+!
+!****************************************************************************************
+! H and Q
+       IF (ok_flux_surf) THEN
+          PRINT *,'pbl_surface: fsens flat RLVTT=',fsens,flat,RLVTT
+          y_flux_t1(:) =  fsens
+          y_flux_q1(:) =  flat/RLVTT
+          yfluxlat(:) =  flat
+       ELSE
+          y_flux_t1(:) =  yfluxsens(:)
+          y_flux_q1(:) = -yevap(:)
+       ENDIF
+
+       CALL climb_hq_up(knon, dtime, yt, yq, &
+            y_flux_q1, y_flux_t1, ypaprs, ypplay, &
+            y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:))    
+       
+
+       CALL climb_wind_up(knon, dtime, yu, yv, y_flux_u1, y_flux_v1, &
+            y_flux_u, y_flux_v, y_d_u, y_d_v)
+
+
+       DO j = 1, knon
+          y_dflux_t(j) = y_dflux_t(j) * ypct(j)
+          y_dflux_q(j) = y_dflux_q(j) * ypct(j)
+       ENDDO
+
+!****************************************************************************************
+! 13) Transform variables for output format : 
+!     - Decompress
+!     - Multiply with pourcentage of current surface
+!     - Cumulate in global variable
+!
+!****************************************************************************************
+
+       tke(:,:,nsrf) = 0.
+       DO k = 1, klev
+          DO j = 1, knon
+             i = ni(j)
+             y_d_t(j,k)  = y_d_t(j,k) * ypct(j)
+             y_d_q(j,k)  = y_d_q(j,k) * ypct(j)
+             y_d_u(j,k)  = y_d_u(j,k) * ypct(j)
+             y_d_v(j,k)  = y_d_v(j,k) * ypct(j)
+
+             flux_t(i,k,nsrf) = y_flux_t(j,k)
+             flux_q(i,k,nsrf) = y_flux_q(j,k)
+             flux_u(i,k,nsrf) = y_flux_u(j,k)
+             flux_v(i,k,nsrf) = y_flux_v(j,k)
+
+             tke(i,k,nsrf)    = ytke(j,k)
+
+          ENDDO
+       ENDDO
+
+       evap(:,nsrf) = - flux_q(:,1,nsrf)
+       
+       alb1(:, nsrf) = 0.
+       alb2(:, nsrf) = 0.
+       snow(:, nsrf) = 0.
+       qsurf(:, nsrf) = 0.
+       rugos(:, nsrf) = 0.
+       fluxlat(:,nsrf) = 0.
+       DO j = 1, knon
+          i = ni(j)
+          d_ts(i,nsrf) = y_d_ts(j)
+          alb1(i,nsrf) = yalb1_new(j)  
+          alb2(i,nsrf) = yalb2_new(j)
+          snow(i,nsrf) = ysnow(j)  
+          qsurf(i,nsrf) = yqsurf(j)
+          rugos(i,nsrf) = yz0_new(j)
+          fluxlat(i,nsrf) = yfluxlat(j)
+          agesno(i,nsrf) = yagesno(j)  
+          cdragh(i) = cdragh(i) + ycdragh(j)*ypct(j)
+          cdragm(i) = cdragm(i) + ycdragm(j)*ypct(j)
+          dflux_t(i) = dflux_t(i) + y_dflux_t(j)
+          dflux_q(i) = dflux_q(i) + y_dflux_q(j)
+       END DO
+
+       DO k = 2, klev
+          DO j = 1, knon
+             i = ni(j)
+             zcoefh(i,k) = zcoefh(i,k) + ycoefh(j,k)*ypct(j)
+          END DO
+       END DO
+
+       IF ( nsrf .EQ. is_ter ) THEN 
+          DO j = 1, knon
+             i = ni(j)
+             qsol(i) = yqsol(j)
+          END DO
+       END IF
+       
+       ftsoil(:,:,nsrf) = 0.
+       DO k = 1, nsoilmx
+          DO j = 1, knon
+             i = ni(j)
+             ftsoil(i, k, nsrf) = ytsoil(j,k)
+          END DO
+       END DO
+       
+       
+       DO k = 1, klev
+          DO j = 1, knon
+             i = ni(j)
+             d_t(i,k) = d_t(i,k) + y_d_t(j,k)
+             d_q(i,k) = d_q(i,k) + y_d_q(j,k)
+             d_u(i,k) = d_u(i,k) + y_d_u(j,k)
+             d_v(i,k) = d_v(i,k) + y_d_v(j,k)
+          END DO
+       END DO
+
+!****************************************************************************************
+! 14) Calculate the temperature et relative humidity at 2m and the wind at 10m 
+!     Call HBTM
+!
+!****************************************************************************************
+       t2m(:,nsrf)    = 0.
+       q2m(:,nsrf)    = 0.
+       u10m(:,nsrf)   = 0.
+       v10m(:,nsrf)   = 0.
+
+       pblh(:,nsrf)   = 0.        ! Hauteur de couche limite
+       plcl(:,nsrf)   = 0.        ! Niveau de condensation de la CLA
+       capCL(:,nsrf)  = 0.        ! CAPE de couche limite
+       oliqCL(:,nsrf) = 0.        ! eau_liqu integree de couche limite
+       cteiCL(:,nsrf) = 0.        ! cloud top instab. crit. couche limite
+       pblt(:,nsrf)   = 0.        ! T a la Hauteur de couche limite
+       therm(:,nsrf)  = 0.
+       trmb1(:,nsrf)  = 0.        ! deep_cape
+       trmb2(:,nsrf)  = 0.        ! inhibition 
+       trmb3(:,nsrf)  = 0.        ! Point Omega
+
+#undef T2m     
+#define T2m     
+#ifdef T2m
+! Calculations of diagnostic t,q at 2m and u, v at 10m
+
+       DO j=1, knon
+          i = ni(j)
+          uzon(j) = yu(j,1) + y_d_u(j,1)
+          vmer(j) = yv(j,1) + y_d_v(j,1)
+          tair1(j) = yt(j,1) + y_d_t(j,1)
+          qair1(j) = yq(j,1) + y_d_q(j,1)
+          zgeo1(j) = RD * tair1(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
+               * (ypaprs(j,1)-ypplay(j,1))
+          tairsol(j) = yts(j) + y_d_ts(j)
+          rugo1(j) = yrugos(j)
+          IF(nsrf.EQ.is_oce) THEN
+             rugo1(j) = rugos(i,nsrf)
+          ENDIF
+          psfce(j)=ypaprs(j,1)
+          patm(j)=ypplay(j,1)
+          qairsol(j) = yqsurf(j)
+       END DO
+       
+
+! Calculate the temperature et relative humidity at 2m and the wind at 10m 
+       CALL stdlevvar(klon, knon, nsrf, zxli, &
+            uzon, vmer, tair1, qair1, zgeo1, &
+            tairsol, qairsol, rugo1, psfce, patm, &
+            yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
+
+       DO j=1, knon
+          i = ni(j)
+          t2m(i,nsrf)=yt2m(j)
+          q2m(i,nsrf)=yq2m(j)
+          
+          ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
+          u10m(i,nsrf)=(yu10m(j) * uzon(j))/SQRT(uzon(j)**2+vmer(j)**2)
+          v10m(i,nsrf)=(yu10m(j) * vmer(j))/SQRT(uzon(j)**2+vmer(j)**2)
+       END DO
+
+!IM Calcule de l'humidite relative a 2m (rh2m) pour diagnostique
+!IM Ajoute dependance type surface
+       IF (thermcep) THEN
+          DO j = 1, knon
+             i=ni(j)
+             zdelta1 = MAX(0.,SIGN(1., rtt-yt2m(j) ))
+             zx_qs1  = r2es * FOEEW(yt2m(j),zdelta1)/paprs(i,1)
+             zx_qs1  = MIN(0.5,zx_qs1)
+             zcor1   = 1./(1.-RETV*zx_qs1)
+             zx_qs1  = zx_qs1*zcor1
+             
+             rh2m(i)   = rh2m(i)   + yq2m(j)/zx_qs1 * pctsrf(i,nsrf)
+             qsat2m(i) = qsat2m(i) + zx_qs1  * pctsrf(i,nsrf)
+          END DO
+       END IF
+
+       CALL HBTM(knon, ypaprs, ypplay, &
+            yt2m,yt10m,yq2m,yq10m,yustar, &
+            y_flux_t,y_flux_q,yu,yv,yt,yq, &
+            ypblh,ycapCL,yoliqCL,ycteiCL,ypblT, &
+            ytherm,ytrmb1,ytrmb2,ytrmb3,ylcl)
+       
+       DO j=1, knon
+          i = ni(j)
+          pblh(i,nsrf)   = ypblh(j)
+          plcl(i,nsrf)   = ylcl(j)
+          capCL(i,nsrf)  = ycapCL(j)
+          oliqCL(i,nsrf) = yoliqCL(j)
+          cteiCL(i,nsrf) = ycteiCL(j)
+          pblT(i,nsrf)   = ypblT(j)
+          therm(i,nsrf)  = ytherm(j)
+          trmb1(i,nsrf)  = ytrmb1(j)
+          trmb2(i,nsrf)  = ytrmb2(j)
+          trmb3(i,nsrf)  = ytrmb3(j)
+       END DO
+       
+#else 
+! T2m not defined
+! No calculation
+       PRINT*,' Warning !!! No T2m calculation. Output is set to zero.'
+#endif
+
+!****************************************************************************************
+! 15) End of loop over different surfaces
+!
+!****************************************************************************************
+    END DO loop_nbsrf
+
+!****************************************************************************************
+! 16) Calculate the mean value over all sub-surfaces for som variables
+!
+!****************************************************************************************
+    
+    zxfluxt(:,:) = 0.0 ; zxfluxq(:,:) = 0.0
+    zxfluxu(:,:) = 0.0 ; zxfluxv(:,:) = 0.0
+    DO nsrf = 1, nbsrf
+       DO k = 1, klev
+          DO i = 1, klon
+             zxfluxt(i,k) = zxfluxt(i,k) + flux_t(i,k,nsrf) * pctsrf(i,nsrf)
+             zxfluxq(i,k) = zxfluxq(i,k) + flux_q(i,k,nsrf) * pctsrf(i,nsrf)
+             zxfluxu(i,k) = zxfluxu(i,k) + flux_u(i,k,nsrf) * pctsrf(i,nsrf)
+             zxfluxv(i,k) = zxfluxv(i,k) + flux_v(i,k,nsrf) * pctsrf(i,nsrf)
+          END DO
+       END DO
+    END DO
+
+    DO i = 1, klon
+       zxsens(i)     = - zxfluxt(i,1) ! flux de chaleur sensible au sol
+       zxevap(i)     = - zxfluxq(i,1) ! flux d'evaporation au sol
+       fder_print(i) = fder(i) + dflux_t(i) + dflux_q(i)
+    ENDDO
+   
+!
+! Incrementer la temperature du sol
+!
+    zxtsol(:) = 0.0  ; zxfluxlat(:) = 0.0
+    zt2m(:) = 0.0    ; zq2m(:) = 0.0 
+    zu10m(:) = 0.0   ; zv10m(:) = 0.0
+    s_pblh(:) = 0.0  ; s_plcl(:) = 0.0 
+    s_capCL(:) = 0.0 ; s_oliqCL(:) = 0.0
+    s_cteiCL(:) = 0.0; s_pblT(:) = 0.0
+    s_therm(:) = 0.0 ; s_trmb1(:) = 0.0
+    s_trmb2(:) = 0.0 ; s_trmb3(:) = 0.0
+    
+    
+    DO nsrf = 1, nbsrf
+       DO i = 1, klon          
+          ts(i,nsrf) = ts(i,nsrf) + d_ts(i,nsrf)
+          
+          wfbils(i,nsrf) = ( solsw(i,nsrf) + sollw(i,nsrf) &
+               + flux_t(i,1,nsrf) + fluxlat(i,nsrf) ) * pctsrf(i,nsrf)
+          wfbilo(i,nsrf) = (evap(i,nsrf) - (rain_f(i) + snow_f(i))) * &
+               pctsrf(i,nsrf)
+
+          zxtsol(i)    = zxtsol(i)    + ts(i,nsrf)      * pctsrf(i,nsrf)
+          zxfluxlat(i) = zxfluxlat(i) + fluxlat(i,nsrf) * pctsrf(i,nsrf)
+          
+          zt2m(i)  = zt2m(i)  + t2m(i,nsrf)  * pctsrf(i,nsrf)
+          zq2m(i)  = zq2m(i)  + q2m(i,nsrf)  * pctsrf(i,nsrf)
+          zu10m(i) = zu10m(i) + u10m(i,nsrf) * pctsrf(i,nsrf)
+          zv10m(i) = zv10m(i) + v10m(i,nsrf) * pctsrf(i,nsrf)
+
+          s_pblh(i)   = s_pblh(i)   + pblh(i,nsrf)  * pctsrf(i,nsrf)
+          s_plcl(i)   = s_plcl(i)   + plcl(i,nsrf)  * pctsrf(i,nsrf)
+          s_capCL(i)  = s_capCL(i)  + capCL(i,nsrf) * pctsrf(i,nsrf)
+          s_oliqCL(i) = s_oliqCL(i) + oliqCL(i,nsrf)* pctsrf(i,nsrf)
+          s_cteiCL(i) = s_cteiCL(i) + cteiCL(i,nsrf)* pctsrf(i,nsrf)
+          s_pblT(i)   = s_pblT(i)   + pblT(i,nsrf)  * pctsrf(i,nsrf)
+          s_therm(i)  = s_therm(i)  + therm(i,nsrf) * pctsrf(i,nsrf)
+          s_trmb1(i)  = s_trmb1(i)  + trmb1(i,nsrf) * pctsrf(i,nsrf)
+          s_trmb2(i)  = s_trmb2(i)  + trmb2(i,nsrf) * pctsrf(i,nsrf)
+          s_trmb3(i)  = s_trmb3(i)  + trmb3(i,nsrf) * pctsrf(i,nsrf)
+       END DO
+    END DO
+
+    IF (check) THEN
+       amn=MIN(ts(1,is_ter),1000.)
+       amx=MAX(ts(1,is_ter),-1000.)
+       DO i=2, klon
+          amn=MIN(ts(i,is_ter),amn)
+          amx=MAX(ts(i,is_ter),amx)
+       ENDDO
+       PRINT*,' debut apres d_ts min max ftsol(ts)',itap,amn,amx
+    ENDIF
+
+!jg ?
+!!$!
+!!$! If a sub-surface does not exsist for a grid point, the mean value for all 
+!!$! sub-surfaces is distributed.
+!!$!
+!!$    DO nsrf = 1, nbsrf
+!!$       DO i = 1, klon
+!!$          IF ((pctsrf_new(i,nsrf) .LT. epsfra) .OR. (t2m(i,nsrf).EQ.0.)) THEN
+!!$             ts(i,nsrf)     = zxtsol(i)
+!!$             t2m(i,nsrf)    = zt2m(i)
+!!$             q2m(i,nsrf)    = zq2m(i)
+!!$             u10m(i,nsrf)   = zu10m(i)
+!!$             v10m(i,nsrf)   = zv10m(i)
+!!$
+!!$! Les variables qui suivent sont plus utilise, donc peut-etre pas la peine a les mettre ajour
+!!$             pblh(i,nsrf)   = s_pblh(i)
+!!$             plcl(i,nsrf)   = s_plcl(i)
+!!$             capCL(i,nsrf)  = s_capCL(i)
+!!$             oliqCL(i,nsrf) = s_oliqCL(i) 
+!!$             cteiCL(i,nsrf) = s_cteiCL(i)
+!!$             pblT(i,nsrf)   = s_pblT(i)
+!!$             therm(i,nsrf)  = s_therm(i)
+!!$             trmb1(i,nsrf)  = s_trmb1(i)
+!!$             trmb2(i,nsrf)  = s_trmb2(i)
+!!$             trmb3(i,nsrf)  = s_trmb3(i)
+!!$          ENDIF
+!!$       ENDDO
+!!$    ENDDO
+
+
+    DO i = 1, klon
+       fder(i) = - 4.0*RSIGMA*zxtsol(i)**3 
+    ENDDO
+    
+    zxqsurf(:) = 0.0
+    zxsnow(:)  = 0.0
+    DO nsrf = 1, nbsrf
+       DO i = 1, klon
+          zxqsurf(i) = zxqsurf(i) + qsurf(i,nsrf) * pctsrf(i,nsrf)
+          zxsnow(i)  = zxsnow(i)  + snow(i,nsrf)  * pctsrf(i,nsrf)
+       END DO
+    END DO
+
+! Premier niveau de vent sortie dans physiq.F
+    zu1(:) = u(:,1)
+    zv1(:) = v(:,1)
+
+! Some of the module declared variables are returned for printing in physiq.F
+    qsol_d(:)     = qsol(:)
+    evap_d(:,:)   = evap(:,:)
+    rugos_d(:,:)  = rugos(:,:) 
+    agesno_d(:,:) = agesno(:,:)
+
+
+  END SUBROUTINE pbl_surface
+!
+!****************************************************************************************
+!
+  SUBROUTINE pbl_surface_final(qsol_rst, fder_rst, snow_rst, qsurf_rst, &
+       evap_rst, rugos_rst, agesno_rst, ftsoil_rst)
+
+    INCLUDE "indicesol.h"
+    INCLUDE "dimsoil.h"
+
+! Ouput variables
+!****************************************************************************************
+    REAL, DIMENSION(klon), INTENT(OUT)                 :: qsol_rst
+    REAL, DIMENSION(klon), INTENT(OUT)                 :: fder_rst
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: snow_rst
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: qsurf_rst
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: evap_rst
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: rugos_rst
+    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: agesno_rst
+    REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(OUT) :: ftsoil_rst
+
+ 
+!****************************************************************************************
+! Return module variables for writing to restart file
+!
+!****************************************************************************************    
+    qsol_rst(:)       = qsol(:)
+    fder_rst(:)       = fder(:)
+    snow_rst(:,:)     = snow(:,:)
+    qsurf_rst(:,:)    = qsurf(:,:)
+    evap_rst(:,:)     = evap(:,:)
+    rugos_rst(:,:)    = rugos(:,:)
+    agesno_rst(:,:)   = agesno(:,:)
+    ftsoil_rst(:,:,:) = ftsoil(:,:,:)
+
+!****************************************************************************************
+! Deallocate module variables
+!
+!****************************************************************************************
+!   DEALLOCATE(qsol, fder, snow, qsurf, evap, rugos, agesno, ftsoil)
+    IF (ALLOCATED(qsol)) DEALLOCATE(qsol)
+    IF (ALLOCATED(fder)) DEALLOCATE(fder)
+    IF (ALLOCATED(snow)) DEALLOCATE(snow)
+    IF (ALLOCATED(qsurf)) DEALLOCATE(qsurf)
+    IF (ALLOCATED(evap)) DEALLOCATE(evap)
+    IF (ALLOCATED(rugos)) DEALLOCATE(rugos)
+    IF (ALLOCATED(agesno)) DEALLOCATE(agesno)
+    IF (ALLOCATED(ftsoil)) DEALLOCATE(ftsoil)
+
+  END SUBROUTINE pbl_surface_final
+!  
+!****************************************************************************************
+! 
+  SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, tsurf, alb1, alb2, u10m, v10m, tke)
+
+    ! Give default values where new fraction has appread
+
+    INCLUDE "indicesol.h"
+    INCLUDE "dimsoil.h"
+    INCLUDE "clesphys.h"
+    INCLUDE "compbl.h"
+
+! Input variables
+!****************************************************************************************
+    INTEGER, INTENT(IN)                     :: itime
+    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf_new, pctsrf_old
+
+! InOutput variables
+!****************************************************************************************
+    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: tsurf
+    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: alb1, alb2
+    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: u10m, v10m
+    REAL, DIMENSION(klon,klev+1,nbsrf), INTENT(INOUT) :: tke
+
+! Local variables
+!****************************************************************************************
+    INTEGER           :: nsrf, nsrf_comp1, nsrf_comp2, nsrf_comp3, i
+    CHARACTER(len=80) :: abort_message
+    CHARACTER(len=20) :: modname = 'pbl_surface_newfrac'
+    INTEGER, DIMENSION(nbsrf) :: nfois=0, mfois=0, pfois=0
+!
+! All at once !! 
+!****************************************************************************************
+    
+    DO nsrf = 1, nbsrf
+       ! First decide complement sub-surfaces
+       SELECT CASE (nsrf)
+       CASE(is_oce)
+          nsrf_comp1=is_sic
+          nsrf_comp2=is_ter
+          nsrf_comp3=is_lic
+       CASE(is_sic)
+          nsrf_comp1=is_oce
+          nsrf_comp2=is_ter
+          nsrf_comp3=is_lic
+       CASE(is_ter)
+          nsrf_comp1=is_lic
+          nsrf_comp2=is_oce
+          nsrf_comp3=is_sic
+       CASE(is_lic)
+          nsrf_comp1=is_ter
+          nsrf_comp2=is_oce
+          nsrf_comp3=is_sic
+       END SELECT
+
+       ! Initialize all new fractions
+       DO i=1, klon
+          IF (pctsrf_new(i,nsrf) > 0. .AND. pctsrf_old(i,nsrf) == 0.) THEN
+             
+             IF (pctsrf_old(i,nsrf_comp1) > 0.) THEN
+                ! Use the complement sub-surface, keeping the continents unchanged
+                qsurf(i,nsrf) = qsurf(i,nsrf_comp1)
+                evap(i,nsrf)  = evap(i,nsrf_comp1)
+                rugos(i,nsrf) = rugos(i,nsrf_comp1)
+                tsurf(i,nsrf) = tsurf(i,nsrf_comp1)
+                alb1(i,nsrf)  = alb1(i,nsrf_comp1)
+                alb2(i,nsrf)  = alb2(i,nsrf_comp1)
+                u10m(i,nsrf)  = u10m(i,nsrf_comp1)
+                v10m(i,nsrf)  = v10m(i,nsrf_comp1)
+                if (iflag_pbl > 1) then
+                 tke(i,:,nsrf) = tke(i,:,nsrf_comp1)
+                endif
+                mfois(nsrf) = mfois(nsrf) + 1
+             ELSE
+                ! The continents have changed. The new fraction receives the mean sum of the existent fractions
+                qsurf(i,nsrf) = qsurf(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + qsurf(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
+                evap(i,nsrf)  = evap(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + evap(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
+                rugos(i,nsrf) = rugos(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + rugos(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
+                tsurf(i,nsrf) = tsurf(i,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tsurf(i,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
+                alb1(i,nsrf)  = alb1(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + alb1(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
+                alb2(i,nsrf)  = alb2(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + alb2(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
+                u10m(i,nsrf)  = u10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + u10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
+                v10m(i,nsrf)  = v10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + v10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
+                if (iflag_pbl > 1) then
+                 tke(i,:,nsrf) = tke(i,:,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tke(i,:,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
+                endif
+            
+                ! Security abort. This option has never been tested. To test, comment the following line.
+!                abort_message='The fraction of the continents have changed!'
+!                CALL abort_gcm(modname,abort_message,1)
+                nfois(nsrf) = nfois(nsrf) + 1
+             END IF
+             snow(i,nsrf)     = 0.
+             agesno(i,nsrf)   = 0.
+             ftsoil(i,:,nsrf) = tsurf(i,nsrf)
+          ELSE
+             pfois(nsrf) = pfois(nsrf)+ 1
+          END IF
+       END DO
+       
+    END DO
+
+  END SUBROUTINE pbl_surface_newfrac
+
+!  
+!****************************************************************************************
+!  
+
+END MODULE pbl_surface_mod
Index: LMDZ5/branches/testing/libf/phy1d/ttt/ttt.x
===================================================================
--- LMDZ5/branches/testing/libf/phy1d/ttt/ttt.x	(revision 1665)
+++ LMDZ5/branches/testing/libf/phy1d/ttt/ttt.x	(revision 1665)
@@ -0,0 +1,8 @@
+ echo Update pbl_surface_mod.F90
+ sed -e "/^ *INCLUDE *\"temps.h\"/{
+ a\\
+!****************************************************************************************\\
+! Declarations specifiques pour le 1D. A reprendre \\
+    INCLUDE "flux_arp.h"
+ }; /^.*REAL *::.*fsens *, *flat/d; /^.*LOGICAL *::.*ok_flux_surf/d; /^.*COMMON.*flux_arp.*/d " /home/jygz/LMDZ/TLMDZ/test_int_20110531/LMDZ5/modipsl/modeles/LMDZ5/libf/phylmd/pbl_surface_mod.F90 >pbl_surface_mod.F90
+
Index: LMDZ5/branches/testing/libf/phydev/comcstphy.h
===================================================================
--- LMDZ5/branches/testing/libf/phydev/comcstphy.h	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/comcstphy.h	(revision 1665)
@@ -0,0 +1,2 @@
+      real rradius,rr,rg,rcpp
+      common/comcstphy/rradius,rr,rg,rcpp
Index: LMDZ5/branches/testing/libf/phydev/comgeomphy.F90
===================================================================
--- LMDZ5/branches/testing/libf/phydev/comgeomphy.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/comgeomphy.F90	(revision 1665)
@@ -0,0 +1,1 @@
+link ../phylmd/comgeomphy.F90
Index: LMDZ5/branches/testing/libf/phydev/dimphy.F90
===================================================================
--- LMDZ5/branches/testing/libf/phydev/dimphy.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/dimphy.F90	(revision 1665)
@@ -0,0 +1,1 @@
+link ../phylmd/dimphy.F90
Index: LMDZ5/branches/testing/libf/phydev/iniphysiq.F
===================================================================
--- LMDZ5/branches/testing/libf/phydev/iniphysiq.F	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/iniphysiq.F	(revision 1665)
@@ -0,0 +1,114 @@
+!
+! $Id: iniphysiq.F 1403 2010-07-01 09:02:53Z fairhead $
+!
+c
+c
+      SUBROUTINE iniphysiq(ngrid,nlayer,
+     $           punjours,
+     $           pdayref,ptimestep,
+     $           plat,plon,parea,pcu,pcv,
+     $           prad,pg,pr,pcpp)
+      USE dimphy
+      USE mod_grid_phy_lmdz
+      USE mod_phys_lmdz_para
+      USE comgeomphy
+
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c   Initialisation for the physical parametrisations of the LMD 
+c   martian atmospheric general circulation modele.
+c
+c   author: Frederic Hourdin 15 / 10 /93
+c   -------
+c
+c   arguments:
+c   ----------
+c
+c   input:
+c   ------
+c
+c    ngrid                 Size of the horizontal grid.
+c                          All internal loops are performed on that grid.
+c    nlayer                Number of vertical layers.
+c    pdayref               Day of reference for the simulation
+c    firstcall             True at the first call
+c    lastcall              True at the last call
+c    pday                  Number of days counted from the North. Spring
+c                          equinoxe.
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+ 
+cym#include "dimensions.h"
+cym#include "dimphy.h"
+cym#include "comgeomphy.h"
+#include "comcstphy.h"
+      REAL prad,pg,pr,pcpp,punjours
+ 
+      INTEGER ngrid,nlayer
+      REAL plat(ngrid),plon(ngrid),parea(klon_glo)
+      REAL pcu(klon_glo),pcv(klon_glo)
+      INTEGER pdayref
+      INTEGER :: ibegin,iend,offset
+ 
+      REAL ptimestep
+      CHARACTER (LEN=20) :: modname='iniphysiq'
+      CHARACTER (LEN=80) :: abort_message
+ 
+      IF (nlayer.NE.klev) THEN
+         PRINT*,'STOP in inifis'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'nlayer     = ',nlayer
+         PRINT*,'klev   = ',klev
+         abort_message = ''
+         CALL abort_gcm (modname,abort_message,1)
+      ENDIF
+
+      IF (ngrid.NE.klon_glo) THEN
+         PRINT*,'STOP in inifis'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'ngrid     = ',ngrid
+         PRINT*,'klon   = ',klon_glo
+         abort_message = ''
+         CALL abort_gcm (modname,abort_message,1)
+      ENDIF
+c$OMP PARALLEL PRIVATE(ibegin,iend) 
+c$OMP+         SHARED(parea,pcu,pcv,plon,plat)
+      
+      offset=klon_mpi_begin-1
+      airephy(1:klon_omp)=parea(offset+klon_omp_begin:
+     &                          offset+klon_omp_end)
+      cuphy(1:klon_omp)=pcu(offset+klon_omp_begin:offset+klon_omp_end)
+      cvphy(1:klon_omp)=pcv(offset+klon_omp_begin:offset+klon_omp_end)
+      rlond(1:klon_omp)=plon(offset+klon_omp_begin:offset+klon_omp_end)
+      rlatd(1:klon_omp)=plat(offset+klon_omp_begin:offset+klon_omp_end)
+
+!     call suphel
+!     prad,pg,pr,pcpp
+      rradius=prad
+      rg=pg
+      rr=pr
+      rcpp=pcpp
+
+      
+
+c$OMP END PARALLEL
+
+      print*,'ATTENTION !!! TRAVAILLER SUR INIPHYSIQ'
+      print*,'CONTROLE DES LATITUDES, LONGITUDES, PARAMETRES ...'
+
+      RETURN
+9999  CONTINUE
+      abort_message ='Cette version demande les fichier rnatur.dat
+     & et surf.def'
+      CALL abort_gcm (modname,abort_message,1)
+
+      END
Index: LMDZ5/branches/testing/libf/phydev/init_phys_lmdz.F90
===================================================================
--- LMDZ5/branches/testing/libf/phydev/init_phys_lmdz.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/init_phys_lmdz.F90	(revision 1665)
@@ -0,0 +1,1 @@
+link ../phylmd/init_phys_lmdz.F90
Index: LMDZ5/branches/testing/libf/phydev/iophy.F90
===================================================================
--- LMDZ5/branches/testing/libf/phydev/iophy.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/iophy.F90	(revision 1665)
@@ -0,0 +1,1 @@
+link ../phylmd/iophy.F90
Index: LMDZ5/branches/testing/libf/phydev/mod_grid_phy_lmdz.F90
===================================================================
--- LMDZ5/branches/testing/libf/phydev/mod_grid_phy_lmdz.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/mod_grid_phy_lmdz.F90	(revision 1665)
@@ -0,0 +1,1 @@
+link ../phylmd/mod_grid_phy_lmdz.F90
Index: LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_mpi_data.F90
===================================================================
--- LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_mpi_data.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_mpi_data.F90	(revision 1665)
@@ -0,0 +1,1 @@
+link ../phylmd/mod_phys_lmdz_mpi_data.F90
Index: LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_mpi_transfert.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_mpi_transfert.F90	(revision 1665)
@@ -0,0 +1,1 @@
+link ../phylmd/mod_phys_lmdz_mpi_transfert.F90
Index: LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_omp_data.F90
===================================================================
--- LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_omp_data.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_omp_data.F90	(revision 1665)
@@ -0,0 +1,1 @@
+link ../phylmd/mod_phys_lmdz_omp_data.F90
Index: LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_omp_transfert.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_omp_transfert.F90	(revision 1665)
@@ -0,0 +1,1 @@
+link ../phylmd/mod_phys_lmdz_omp_transfert.F90
Index: LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_para.F90
===================================================================
--- LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_para.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_para.F90	(revision 1665)
@@ -0,0 +1,1 @@
+link ../phylmd/mod_phys_lmdz_para.F90
Index: LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_transfert_para.F90
===================================================================
--- LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_transfert_para.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/mod_phys_lmdz_transfert_para.F90	(revision 1665)
@@ -0,0 +1,1 @@
+link ../phylmd/mod_phys_lmdz_transfert_para.F90
Index: LMDZ5/branches/testing/libf/phydev/phyaqua.F
===================================================================
--- LMDZ5/branches/testing/libf/phydev/phyaqua.F	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/phyaqua.F	(revision 1665)
@@ -0,0 +1,26 @@
+! Routines complementaires pour la physique planetaire.
+
+
+      subroutine iniaqua(nlon,latfi,lonfi,iflag_phys)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!  Creation d'un etat initial et de conditions aux limites 
+!  (resp startphy.nc et limit.nc) pour des configurations idealisees 
+! du modele LMDZ dans sa version terrestre.
+!  iflag_phys est un parametre qui controle
+!  iflag_phys = N  
+!    de 100 a 199 : aqua planetes avec SST forcees
+!                 N-100 determine le type de SSTs
+!    de 200 a 299 : terra planetes avec Ts calcule
+!        
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+      integer nlon,iflag_phys
+cIM ajout latfi, lonfi
+      REAL, DIMENSION (nlon) :: lonfi, latfi
+
+
+      return
+      end
+
Index: LMDZ5/branches/testing/libf/phydev/physiq.F90
===================================================================
--- LMDZ5/branches/testing/libf/phydev/physiq.F90	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/physiq.F90	(revision 1665)
@@ -0,0 +1,124 @@
+! $Id: physiq.F 1565 2011-08-31 12:53:29Z jghattas $
+!#define IO_DEBUG
+
+      SUBROUTINE physiq (nlon,nlev, &
+     &            debut,lafin,jD_cur, jH_cur,pdtphys, &
+     &            paprs,pplay,pphi,pphis,presnivs,clesphy0, &
+     &            u,v,t,qx, &
+     &            flxmass_w, &
+     &            d_u, d_v, d_t, d_qx, d_ps &
+     &            , dudyn &
+     &            , PVteta)
+
+      USE dimphy
+      USE infotrac
+      USE comgeomphy
+
+      IMPLICIT none
+!======================================================================
+! Objet: Moniteur general de la physique du modele
+!======================================================================
+!
+!  Arguments:
+!
+! nlon----input-I-nombre de points horizontaux
+! nlev----input-I-nombre de couches verticales, doit etre egale a klev
+! debut---input-L-variable logique indiquant le premier passage
+! lafin---input-L-variable logique indiquant le dernier passage
+! jD_cur       -R-jour courant a l'appel de la physique (jour julien)
+! jH_cur       -R-heure courante a l'appel de la physique (jour julien)
+! pdtphys-input-R-pas d'integration pour la physique (seconde)
+! paprs---input-R-pression pour chaque inter-couche (en Pa)
+! pplay---input-R-pression pour le mileu de chaque couche (en Pa)
+! pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
+! pphis---input-R-geopotentiel du sol
+! presnivs-input_R_pressions approximat. des milieux couches ( en PA)
+! u-------input-R-vitesse dans la direction X (de O a E) en m/s
+! v-------input-R-vitesse Y (de S a N) en m/s
+! t-------input-R-temperature (K)
+! qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
+! d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
+! d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
+! flxmass_w -input-R- flux de masse verticale
+! d_u-----output-R-tendance physique de "u" (m/s/s)
+! d_v-----output-R-tendance physique de "v" (m/s/s)
+! d_t-----output-R-tendance physique de "t" (K/s)
+! d_qx----output-R-tendance physique de "qx" (kg/kg/s)
+! d_ps----output-R-tendance physique de la pression au sol
+!IM
+! PVteta--output-R-vorticite potentielle a des thetas constantes
+!======================================================================
+#include "dimensions.h"
+#include "comcstphy.h"
+
+      integer jjmp1
+      parameter (jjmp1=jjm+1-1/jjm)
+      integer iip1
+      parameter (iip1=iim+1)
+
+      INTEGER ivap          ! indice de traceurs pour vapeur d'eau
+      PARAMETER (ivap=1)
+      INTEGER iliq          ! indice de traceurs pour eau liquide
+      PARAMETER (iliq=2)
+
+!
+!
+! Variables argument:
+!
+      INTEGER nlon
+      INTEGER nlev
+      REAL, intent(in):: jD_cur, jH_cur
+
+      REAL pdtphys
+      LOGICAL debut, lafin
+      REAL paprs(klon,klev+1)
+      REAL pplay(klon,klev)
+      REAL pphi(klon,klev)
+      REAL pphis(klon)
+      REAL presnivs(klev)
+      REAL znivsig(klev)
+      real pir
+
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+      REAL t(klon,klev),theta(klon,klev)
+      REAL qx(klon,klev,nqtot)
+      REAL flxmass_w(klon,klev)
+      REAL omega(klon,klev) ! vitesse verticale en Pa/s
+      REAL d_u(klon,klev)
+      REAL d_v(klon,klev)
+      REAL d_t(klon,klev)
+      REAL d_qx(klon,klev,nqtot)
+      REAL d_ps(klon)
+      real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
+!IM definition dynamique o_trac dans phys_output_open
+!      type(ctrl_out) :: o_trac(nqtot)
+!FH! REAL PVteta(klon,nbteta)
+      REAL PVteta(klon,1)
+      REAL dudyn(iim+1,jjmp1,klev)
+
+    INTEGER        longcles
+    PARAMETER    ( longcles = 20 )
+
+real temp_newton(klon,klev)
+integer k
+logical, save :: first=.true.
+
+      REAL clesphy0( longcles      )
+
+d_u=0.
+d_v=0.
+d_t=0.
+d_qx=0.
+d_ps=0.
+
+     d_u(:,1)=-u(:,1)/86400.
+     do k=1,klev
+        temp_newton(:,k)=280.+cos(rlatd(:))*40.-pphi(:,k)/rg*6.e-3
+        d_t(:,k)=(temp_newton(:,k)-t(:,k))/1.e5
+     enddo
+
+
+      print*,'COUCOU PHYDEV'
+      return
+      end
Index: LMDZ5/branches/testing/libf/phydev/tetalevel.F
===================================================================
--- LMDZ5/branches/testing/libf/phydev/tetalevel.F	(revision 1665)
+++ LMDZ5/branches/testing/libf/phydev/tetalevel.F	(revision 1665)
@@ -0,0 +1,1 @@
+link ../phylmd/tetalevel.F
Index: LMDZ5/branches/testing/libf/phylmd/calwake.F
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/calwake.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/calwake.F	(revision 1665)
@@ -60,5 +60,5 @@
       REAL wake_dtKE(klon,klev),wake_dqKE(klon,klev)
       REAL wake_dtPBL(klon,klev),wake_dqPBL(klon,klev)
-      REAL wake_omg(klon,klev+1),wake_dp_deltomg(klon,klev)
+      REAL wake_omg(klon,klev),wake_dp_deltomg(klon,klev)
       REAL wake_spread(klon,klev),wake_Cstar(klon)
       REAL wake_ddeltat(klon,klev),wake_ddeltaq(klon,klev)
@@ -84,5 +84,5 @@
       REAL tu(klon,klev),qu(klon,klev)
       REAL hw(klon),sigmaw(klon),wape(klon),fip(klon),gfl(klon)
-      REAL omgbdth(klon,klev),dp_omgb(klon,klev)
+      REAL omgbdth(klon,klev+1),dp_omgb(klon,klev)
       REAL dtKE(klon,klev),dqKE(klon,klev)
       REAL dtPBL(klon,klev),dqPBL(klon,klev)
Index: LMDZ5/branches/testing/libf/phylmd/climb_hq_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/climb_hq_mod.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/climb_hq_mod.F90	(revision 1665)
@@ -252,4 +252,6 @@
        Bcoef(i) = -1. * RG / buf
     END DO
+    acoef(knon+1: klon) = 0.
+    bcoef(knon+1: klon) = 0.
 
   END SUBROUTINE calc_coef
Index: LMDZ5/branches/testing/libf/phylmd/climb_wind_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/climb_wind_mod.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/climb_wind_mod.F90	(revision 1665)
@@ -209,4 +209,6 @@
        Bcoef(i) = -RG/buf
     END DO
+    acoef(knon+1: klon) = 0.
+    bcoef(knon+1: klon) = 0.
 
   END SUBROUTINE calc_coef
Index: LMDZ5/branches/testing/libf/phylmd/coef_diff_turb_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/coef_diff_turb_mod.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/coef_diff_turb_mod.F90	(revision 1665)
@@ -389,5 +389,9 @@
 !           calculer la fraction nuageuse (processus humide):
 !
-          zfr = (zq+ratqs*zq-zqs) / (2.0*ratqs*zq)
+          if (zq /= 0.) then
+             zfr = (zq+ratqs*zq-zqs) / (2.0*ratqs*zq)
+          else
+             zfr = 0.
+          end if
           zfr = MAX(0.0,MIN(1.0,zfr))
           IF (.NOT.richum) zfr = 0.0
Index: LMDZ5/branches/testing/libf/phylmd/concvl.F
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/concvl.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/concvl.F	(revision 1665)
@@ -248,5 +248,5 @@
          DO i = 1, klon
           cbmf(i) = 0.
-          plcl(i) = 0.
+!          plcl(i) = 0.
           sigd(i) = 0.
          ENDDO
@@ -256,4 +256,5 @@
       plfc(:)  = 0.
       wbeff(:) = 100.
+      plcl(:) = 0.
 
       DO k = 1, klev+1
Index: LMDZ5/branches/testing/libf/phylmd/cpl_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/cpl_mod.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/cpl_mod.F90	(revision 1665)
@@ -345,5 +345,5 @@
        IF (is_sequential) THEN
           ndexcs(:) = 0
-          itau_w = itau_phy + itime
+          itau_w = itau_phy + itime + start_time * day_step / iphysiq
           DO i = 1, maxrecv
             IF (inforecv(i)%action) THEN
@@ -1232,5 +1232,5 @@
     IF (is_sequential) THEN
        ndexct(:) = 0
-       itau_w = itau_phy + itime
+       itau_w = itau_phy + itime + start_time * day_step / iphysiq
        CALL histwrite(nidct,'tauxe',itau_w,tmp_taux,iim*(jjm+1),ndexct)
        CALL histwrite(nidct,'tauyn',itau_w,tmp_tauy,iim*(jjm+1),ndexct)
Index: LMDZ5/branches/testing/libf/phylmd/iostart.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/iostart.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/iostart.F90	(revision 1665)
@@ -177,6 +177,20 @@
          ierr=NF90_GET_VAR(nid_start,varid,field_glo)
          IF (ierr/=NF90_NOERR) THEN
+           ! La variable exist dans le fichier mais la lecture a echouee. 
            PRINT*, 'phyetat0: Lecture echouee pour <'//field_name//'>'
-           CALL abort
+
+           IF (field_name=='CLWCON' .OR. field_name=='RNEBCON' .OR. field_name=='RATQS') THEN
+              ! Essaye de lire le variable sur surface uniqument, comme fait avant
+              field_glo(:)=0.
+              ierr=NF90_GET_VAR(nid_start,varid,field_glo(1:klon_glo))
+              IF (ierr/=NF90_NOERR) THEN
+                 PRINT*, 'phyetat0: Lecture echouee aussi en 2D pour <'//field_name//'>'
+                 CALL abort
+              ELSE
+                 PRINT*, 'phyetat0: La variable <'//field_name//'> lu sur surface seulement'!, selon ancien format, le reste mis a zero'
+              END IF
+           ELSE
+              CALL abort
+           ENDIF
          ENDIF
 
Index: LMDZ5/branches/testing/libf/phylmd/limit_read_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/limit_read_mod.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/limit_read_mod.F90	(revision 1665)
@@ -150,4 +150,5 @@
     
     INCLUDE "indicesol.h"
+    INCLUDE "iniprint.h"
 
 ! In- and ouput arguments
@@ -165,5 +166,7 @@
 !$OMP THREADPRIVATE(lmt_pas) 
     LOGICAL, SAVE                             :: first_call=.TRUE.
-!$OMP THREADPRIVATE(first_call)    
+!$OMP THREADPRIVATE(first_call)  
+    INTEGER, SAVE                             :: jour_lu = -1
+!$OMP THREADPRIVATE(jour_lu)  
 ! Locals variables
 !****************************************************************************************
@@ -209,5 +212,6 @@
 
     is_modified = .FALSE.
-    IF (MOD(itime-1, lmt_pas) == 0) THEN   ! time to read
+    IF (MOD(itime-1, lmt_pas) == 0 .OR. jour_lu /= jour ) THEN   ! time to read
+       jour_lu = jour
        is_modified = .TRUE.
 !$OMP MASTER  ! Only master thread
Index: LMDZ5/branches/testing/libf/phylmd/lnblnk1.F
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/lnblnk1.F	(revision 1664)
+++ 	(revision )
@@ -1,47 +1,0 @@
-!
-! $Header$
-!
-      INTEGER FUNCTION lnblnk1 (letter)
-
-C--------------------------------------------------------
-C Fonction qui determine la longeur d'un string sans les
-C blancs qui suivent. Le critere pour determiner la fin du
-C string est, trois blancs de suite
-C---------------------------------------------------------
-C     ARGUMENTS
-C     +++++++++
-C     letter: CHARACTER*xxx (xxx < imax)
-C             le string dont on determine la longuer
-C     lnblnk1: INTEGER
-C             le nombre de characteres
-C
-C     PARAMETER
-C     +++++++++
-C     imax : INTEGER
-C            le nombre maximale de character que peut contenir le string
-C            a traiter
-
-      IMPLICIT NONE
-      INTEGER i,imax
-      PARAMETER (imax = 256)
-c     CHARACTER*256 letter
-      CHARACTER*4 letter
-
-      i=0
-
-10    i=i+1
-c     IF (letter(i:i+1) . EQ . ' ') THEN
-      IF (letter(i:i) . EQ . ' ') THEN
-c      print*,'i=',i,'letter(i:i+1)=',letter(i:i+1)
-c      print*,'i=',i
-       GOTO 20
-      ELSE
-       GOTO 10
-      ENDIF
-
-20    lnblnk1=i-1
-c     PRINT*,'lnblnk1=',lnblnk1
-
-      RETURN
-      END
-
Index: LMDZ5/branches/testing/libf/phylmd/phyetat0.F
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/phyetat0.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/phyetat0.F	(revision 1665)
@@ -749,10 +749,20 @@
       ENDIF
 
-      u_ancien = 0.0   !AXC: We don't have u_ancien and v_ancien in the start
-      v_ancien = 0.0   !AXC: files, therefore they have to be initialized.
-c
+      CALL get_field("UANCIEN",u_ancien,found)
+      IF (.NOT. found) THEN
+         PRINT*, "phyetat0: Le champ <UANCIEN> est absent"
+         PRINT*, "Depart legerement fausse. Mais je continue"
+         ancien_ok = .FALSE.
+      ENDIF
+
+      CALL get_field("VANCIEN",v_ancien,found)
+      IF (.NOT. found) THEN
+         PRINT*, "phyetat0: Le champ <VANCIEN> est absent"
+         PRINT*, "Depart legerement fausse. Mais je continue"
+         ancien_ok = .FALSE.
+      ENDIF
 
       clwcon=0.
-      CALL get_field("CLWCON",clwcon(:,1),found)
+      CALL get_field("CLWCON",clwcon,found)
       IF (.NOT. found) THEN
          PRINT*, "phyetat0: Le champ CLWCON est absent"
@@ -766,5 +776,5 @@
 c
       rnebcon = 0.
-      CALL get_field("RNEBCON",rnebcon(:,1),found)
+      CALL get_field("RNEBCON",rnebcon,found)
       IF (.NOT. found) THEN
          PRINT*, "phyetat0: Le champ RNEBCON est absent"
@@ -781,5 +791,5 @@
 c
       ratqs=0.
-      CALL get_field("RATQS",ratqs(:,1),found)
+      CALL get_field("RATQS",ratqs,found)
       IF (.NOT. found) THEN
          PRINT*, "phyetat0: Le champ <RATQS> est absent"
Index: LMDZ5/branches/testing/libf/phylmd/phyredem.F
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/phyredem.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/phyredem.F	(revision 1665)
@@ -267,13 +267,17 @@
       
       CALL put_field("QANCIEN","QANCIEN",q_ancien)
-      
+
+      CALL put_field("UANCIEN","",u_ancien)
+
+      CALL put_field("VANCIEN","",v_ancien)
+
       CALL put_field("RUGMER","Longueur de rugosite sur mer",
      .               frugs(:,is_oce))
       
-      CALL put_field("CLWCON","Eau liquide convective",clwcon(:,1))
-      
-      CALL put_field("RNEBCON","Nebulosite convective",rnebcon(:,1))
-      
-      CALL put_field("RATQS", "Ratqs",ratqs(:,1))
+      CALL put_field("CLWCON","Eau liquide convective",clwcon)
+      
+      CALL put_field("RNEBCON","Nebulosite convective",rnebcon)
+      
+      CALL put_field("RATQS", "Ratqs",ratqs)
 c
 c run_off_lic_0
Index: LMDZ5/branches/testing/libf/phylmd/phys_output_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/phys_output_mod.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/phys_output_mod.F90	(revision 1665)
@@ -1318,10 +1318,8 @@
           ! Couplage conv-CL
           IF (iflag_con.GE.3) THEN
-             IF (iflag_coupl>=1) THEN
                 CALL histdef2d(iff,clef_stations(iff), &
                      o_ale_bl%flag,o_ale_bl%name, "ALE BL", "m2/s2") 
                 CALL histdef2d(iff,clef_stations(iff), &
                      o_alp_bl%flag,o_alp_bl%name, "ALP BL", "m2/s2") 
-             ENDIF
           ENDIF !(iflag_con.GE.3)
 
@@ -1491,10 +1489,4 @@
                 CALL histdef2d(iff,clef_stations(iff), &
                      o_alp_wk%flag,o_alp_wk%name, "ALP WK", "m2/s2")
-                CALL histdef2d(iff,clef_stations(iff), &
-                     o_ale%flag,o_ale%name, "ALE", "m2/s2")
-                CALL histdef2d(iff,clef_stations(iff), &
-                     o_alp%flag,o_alp%name, "ALP", "W/m2")
-                CALL histdef2d(iff,clef_stations(iff),o_cin%flag,o_cin%name, "Convective INhibition", "m2/s2")
-                CALL histdef2d(iff,clef_stations(iff),o_wape%flag,o_WAPE%name, "WAPE", "m2/s2")
                 CALL histdef2d(iff,clef_stations(iff),o_wake_h%flag,o_wake_h%name, "wake_h", "-")
                 CALL histdef2d(iff,clef_stations(iff),o_wake_s%flag,o_wake_s%name, "wake_s", "-")
@@ -1504,5 +1496,11 @@
                 CALL histdef3d(iff,clef_stations(iff),o_wake_deltaq%flag,o_wake_deltaq%name, "wake_deltaq", " ")
                 CALL histdef3d(iff,clef_stations(iff),o_wake_omg%flag,o_wake_omg%name, "wake_omg", " ")
+                CALL histdef2d(iff,clef_stations(iff),o_wape%flag,o_WAPE%name, "WAPE", "m2/s2")
              ENDIF
+             CALL histdef2d(iff,clef_stations(iff), &
+                     o_ale%flag,o_ale%name, "ALE", "m2/s2")
+             CALL histdef2d(iff,clef_stations(iff), &
+                     o_alp%flag,o_alp%name, "ALP", "W/m2")
+             CALL histdef2d(iff,clef_stations(iff),o_cin%flag,o_cin%name, "Convective INhibition", "m2/s2")
              CALL histdef3d(iff,clef_stations(iff),o_Vprecip%flag,o_Vprecip%name, "precipitation vertical profile", "-")
              CALL histdef3d(iff,clef_stations(iff),o_ftd%flag,o_ftd%name, "tend temp due aux descentes precip", "-")
@@ -1859,5 +1857,5 @@
     if ( type == 'day'.or.type == 'days'.or.type == 'jours'.or.type == 'jour' ) timestep = ttt * dayseconde
     if ( type == 'mounths'.or.type == 'mth'.or.type == 'mois' ) then
-       write(lunout,*)'annee_ref,day_ref mon_len',annee_ref,day_ref,ioget_mon_len(annee_ref,day_ref)
+       write(lunout,*)'annee_ref,day_ref mon_len',annee_ref,day_ref,mth_len
        timestep = ttt * dayseconde * mth_len
     endif
Index: LMDZ5/branches/testing/libf/phylmd/phys_output_write.h
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/phys_output_write.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/phys_output_write.h	(revision 1665)
@@ -1,3 +1,3 @@
-      itau_w = itau_phy + itap
+      itau_w = itau_phy + itap + start_time * day_step / iphysiq
 
       DO iff=1,nfiles
@@ -801,5 +801,4 @@
 ! Couplage convection-couche limite
       IF (iflag_con.GE.3) THEN
-      IF (iflag_coupl>=1) THEN
        IF (o_ale_bl%flag(iff)<=lev_files(iff)) THEN
        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
@@ -810,5 +809,4 @@
      $o_alp_bl%name,itau_w,alp_bl)
        ENDIF
-      ENDIF !iflag_coupl>=1
       ENDIF !(iflag_con.GE.3)
 
@@ -825,16 +823,4 @@
        ENDIF
 
-       IF (o_ale%flag(iff)<=lev_files(iff)) THEN
-       CALL histwrite_phy(nid_files(iff),clef_stations(iff),
-     $o_ale%name,itau_w,ale)
-       ENDIF
-       IF (o_alp%flag(iff)<=lev_files(iff)) THEN
-       CALL histwrite_phy(nid_files(iff),clef_stations(iff),
-     $o_alp%name,itau_w,alp)
-       ENDIF
-       IF (o_cin%flag(iff)<=lev_files(iff)) THEN
-       CALL histwrite_phy(nid_files(iff),clef_stations(iff),
-     $o_cin%name,itau_w,cin)
-       ENDIF
        IF (o_wape%flag(iff)<=lev_files(iff)) THEN
        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
@@ -883,4 +869,16 @@
       ENDIF ! iflag_wake>=1
 
+       IF (o_ale%flag(iff)<=lev_files(iff)) THEN
+       CALL histwrite_phy(nid_files(iff),clef_stations(iff),
+     $o_ale%name,itau_w,ale)
+       ENDIF
+       IF (o_alp%flag(iff)<=lev_files(iff)) THEN
+       CALL histwrite_phy(nid_files(iff),clef_stations(iff),
+     $o_alp%name,itau_w,alp)
+       ENDIF
+       IF (o_cin%flag(iff)<=lev_files(iff)) THEN
+       CALL histwrite_phy(nid_files(iff),clef_stations(iff),
+     $o_cin%name,itau_w,cin)
+       ENDIF
         IF (o_Vprecip%flag(iff)<=lev_files(iff)) THEN
        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
Index: LMDZ5/branches/testing/libf/phylmd/physiq.F
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/physiq.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/physiq.F	(revision 1665)
@@ -614,6 +614,6 @@
       REAL dd_t(klon,klev),dd_q(klon,klev)
 
-      real, save :: alp_bl_prescr=0.
-      real, save :: ale_bl_prescr=0.
+      real, save :: alp_bl_prescr=0.1
+      real, save :: ale_bl_prescr=4.
 
       real, save :: ale_max=1000.
@@ -791,7 +791,4 @@
 cIM
       EXTERNAL haut2bas  !variables de haut en bas
-      INTEGER lnblnk1
-      EXTERNAL lnblnk1   !enleve les blancs a la fin d'une variable de type
-                         !caracter
       EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression
       EXTERNAL undefSTD      !somme les valeurs definies d'1 var a 1 niveau de pression
@@ -1220,4 +1217,5 @@
       INTEGER :: nbtr_tmp ! Number of tracer inside concvl
       REAL, dimension(klon,klev) :: sh_in ! Specific humidity entering in phytrac
+      integer iostat
 
 cIM for NMC files
@@ -1492,10 +1490,8 @@
 cCR:04.12.07: initialisations poches froides
 c Controle de ALE et ALP pour la fermeture convective (jyg)
-          if (iflag_wake>=1) then
-            CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr
+         CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr
      s                  ,alp_bl_prescr, ale_bl_prescr)
 c 11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU)
 c        print*,'apres ini_wake iflag_cldcon=', iflag_cldcon
-          endif
 
         do i = 1,klon
@@ -1508,5 +1504,6 @@
       nCFMIP=npCFMIP
       OPEN(98,file='npCFMIP_param.data',status='old',
-     $          form='formatted',err=999)
+     $          form='formatted',iostat=iostat)
+            if (iostat == 0) then
       READ(98,*,end=998) nCFMIP
 998   CONTINUE
@@ -1540,5 +1537,9 @@
      $tabijGCM, lonGCM, latGCM, iGCM, jGCM)
 c
-999      CONTINUE
+            else
+               ALLOCATE(tabijGCM(0))
+               ALLOCATE(lonGCM(0), latGCM(0))
+               ALLOCATE(iGCM(0), jGCM(0))
+            end if
          ENDIF !debut
  
@@ -2041,53 +2042,57 @@
 c
 
-      CALL pbl_surface( 
-     e     dtime,     date0,     itap,    days_elapsed+1,
-     e     debut,     lafin,
-     e     rlon,      rlat,      rugoro,  rmu0,     
-     e     rain_fall, snow_fall, solsw,   sollw,    
-     e     t_seri,    q_seri,    u_seri,  v_seri,   
-     e     pplay,     paprs,     pctsrf,            
-     +     ftsol,     falb1,     falb2,   u10m,   v10m,
-     s     sollwdown, cdragh,    cdragm,  u1,    v1,
-     s     albsol1,   albsol2,   sens,    evap,  
-     s     zxtsol,    zxfluxlat, zt2m,    qsat2m, 
-     s     d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf,
-     s     coefh,     coefm,     slab_wfbils,                
-     d     qsol,      zq2m,      s_pblh,  s_lcl,
-     d     s_capCL,   s_oliqCL,  s_cteiCL,s_pblT,
-     d     s_therm,   s_trmb1,   s_trmb2, s_trmb3,
-     d     zxrugs,    zu10m,     zv10m,   fder,
-     d     zxqsurf,   rh2m,      zxfluxu, zxfluxv,
-     d     frugs,     agesno,    fsollw,  fsolsw,
-     d     d_ts,      fevap,     fluxlat, t2m,
-     d     wfbils,    wfbilo,    fluxt,   fluxu,  fluxv,
-     -     dsens,     devap,     zxsnow,
-     -     zxfluxt,   zxfluxq,   q2m,     fluxq, pbl_tke )
+      if (iflag_pbl/=0) then 
+
+        CALL pbl_surface( 
+     e       dtime,     date0,     itap,    days_elapsed+1,
+     e       debut,     lafin,
+     e       rlon,      rlat,      rugoro,  rmu0,     
+     e       rain_fall, snow_fall, solsw,   sollw,    
+     e       t_seri,    q_seri,    u_seri,  v_seri,   
+     e       pplay,     paprs,     pctsrf,            
+     +       ftsol,     falb1,     falb2,   u10m,   v10m,
+     s       sollwdown, cdragh,    cdragm,  u1,    v1,
+     s       albsol1,   albsol2,   sens,    evap,  
+     s       zxtsol,    zxfluxlat, zt2m,    qsat2m, 
+     s       d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf,
+     s       coefh,     coefm,     slab_wfbils,                
+     d       qsol,      zq2m,      s_pblh,  s_lcl,
+     d       s_capCL,   s_oliqCL,  s_cteiCL,s_pblT,
+     d       s_therm,   s_trmb1,   s_trmb2, s_trmb3,
+     d       zxrugs,    zu10m,     zv10m,   fder,
+     d       zxqsurf,   rh2m,      zxfluxu, zxfluxv,
+     d       frugs,     agesno,    fsollw,  fsolsw,
+     d       d_ts,      fevap,     fluxlat, t2m,
+     d       wfbils,    wfbilo,    fluxt,   fluxu,  fluxv,
+     -       dsens,     devap,     zxsnow,
+     -       zxfluxt,   zxfluxq,   q2m,     fluxq, pbl_tke )
 
 
 !-----------------------------------------------------------------------------------------
 ! ajout des tendances de la diffusion turbulente
-      CALL add_phys_tend(d_u_vdf,d_v_vdf,d_t_vdf,d_q_vdf,dql0,'vdf')
+        CALL add_phys_tend(d_u_vdf,d_v_vdf,d_t_vdf,d_q_vdf,dql0,'vdf')
 !-----------------------------------------------------------------------------------------
 
-      if (mydebug) then
-        call writefield_phy('u_seri',u_seri,llm)
-        call writefield_phy('v_seri',v_seri,llm)
-        call writefield_phy('t_seri',t_seri,llm)
-        call writefield_phy('q_seri',q_seri,llm)
-      endif
-
-
-      IF (ip_ebil_phy.ge.2) THEN 
-        ztit='after surface_main'
-        CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime
+        if (mydebug) then
+          call writefield_phy('u_seri',u_seri,llm)
+          call writefield_phy('v_seri',v_seri,llm)
+          call writefield_phy('t_seri',t_seri,llm)
+          call writefield_phy('q_seri',q_seri,llm)
+        endif
+
+
+        IF (ip_ebil_phy.ge.2) THEN 
+          ztit='after surface_main'
+          CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime
      e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
      s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-         call diagphy(airephy,ztit,ip_ebil_phy
+          call diagphy(airephy,ztit,ip_ebil_phy
      e      , zero_v, zero_v, zero_v, zero_v, sens
      e      , evap  , zero_v, zero_v, ztsol
      e      , d_h_vcol, d_qt, d_ec
      s      , fs_bound, fq_bound )
-      END IF 
+        END IF 
+
+      ENDIF
 
 c =================================================================== c
@@ -2239,23 +2244,10 @@
 cdans le thermique sinon
        if (iflag_coupl.eq.0) then
-          if (debut.and.prt_level.gt.9)
-     $                     WRITE(lunout,*)'ALE et ALP imposes'
-          do i = 1,klon
-con ne couple que ale
-c           ALE(i) = max(ale_wake(i),Ale_bl(i))
-            ALE(i) = max(ale_wake(i),ale_bl_prescr)
-con ne couple que alp
-c           ALP(i) = alp_wake(i) + Alp_bl(i)
-            ALP(i) = alp_wake(i) + alp_bl_prescr
-          enddo
+          if (debut.and.prt_level.gt.9)WRITE(lunout,*) 'ALE&ALP imposes'
+          Ale_bl(1:klon) = ale_bl_prescr
+          Alp_bl(1:klon) = alp_bl_prescr
        else
          IF(prt_level>9)WRITE(lunout,*)'ALE et ALP couples au thermique'
-!         do i = 1,klon
-!             ALE(i) = max(ale_wake(i),Ale_bl(i))
-! avant        ALP(i) = alp_wake(i) + Alp_bl(i)
-!             ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
-!         write(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i)
-!         write(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i)
-!         enddo
+       endif
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2264,4 +2256,5 @@
 ! w si <0
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
        do i = 1,klon
           ALE(i) = max(ale_wake(i),Ale_bl(i))
@@ -2276,7 +2269,7 @@
           endif
        enddo
+
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-       endif
        do i=1,klon
           if (alp(i)>alp_max) then
@@ -2634,5 +2627,5 @@
 c  ==============
 
-! Dans le cas oÃ¹ on active les thermiques, on fait partir l'ajustement
+! Dans le cas o\`u on active les thermiques, on fait partir l'ajustement
 ! a partir du sommet des thermiques.
 ! Dans le cas contraire, on demarre au niveau 1.
@@ -2821,5 +2814,5 @@
 ! FH 22/09/2009
 ! La ligne ci-dessous faisait osciller le modele et donnait une solution
-! assymptotique bidon et dÃ©pendant fortement du pas de temps.
+! asymptotique bidon et d\'ependant fortement du pas de temps.
 !        ratqs(:,:)=sqrt(ratqs(:,:)**2+ratqss(:,:)**2)
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -3576,5 +3569,4 @@
 
        IF (ok_hines) then
-
          CALL hines_gwd(klon,klev,dtime,paprs,pplay,
      i                  rlat,t_seri,u_seri,v_seri,
@@ -3584,10 +3576,6 @@
 c  ajout des tendances
         CALL add_phys_tend(d_u_hin,d_v_hin,d_t_hin,dq0,dql0,'hin')
-
       ENDIF
-c
-
-c
-cIM cf. FLott BEG
+
 C STRESS NECESSAIRES: TOUTE LA PHYSIQUE
 
@@ -3614,5 +3602,5 @@
 cIM calcul composantes axiales du moment angulaire et couple des montagnes
 c
-      IF (is_sequential) THEN
+      IF (is_sequential .and. ok_orodr) THEN
       
         CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur,
Index: LMDZ5/branches/testing/libf/phylmd/phytrac.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/phytrac.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/phytrac.F90	(revision 1665)
@@ -214,5 +214,5 @@
      SELECT CASE(type_trac)
      CASE('lmdz')
-        CALL traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage)
+        CALL traclmdz_init(pctsrf, xlat, xlon, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage)
      CASE('inca')
         source(:,:)=0.
Index: LMDZ5/branches/testing/libf/phylmd/readaerosol.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/readaerosol.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/readaerosol.F90	(revision 1665)
@@ -247,11 +247,11 @@
   
        WRITE(lunout,*) 'reading variable ',TRIM(varname),' in file ', TRIM(fname)
-       CALL check_err( nf90_open(TRIM(fname), NF90_NOWRITE, ncid) )
+       CALL check_err( nf90_open(TRIM(fname), NF90_NOWRITE, ncid), "pb open "//trim(varname) )
 
 ! Test for equal longitudes and latitudes in file and model
 !****************************************************************************************
        ! Read and test longitudes
-       CALL check_err( nf90_inq_varid(ncid, 'lon', varid) )
-       CALL check_err( nf90_get_var(ncid, varid, lon_src(:)) )
+       CALL check_err( nf90_inq_varid(ncid, 'lon', varid),"pb inq lon" )
+       CALL check_err( nf90_get_var(ncid, varid, lon_src(:)),"pb get lon" )
        
        IF (maxval(ABS(lon_src - io_lon)) > 0.001) THEN
@@ -264,6 +264,6 @@
 
        ! Read and test latitudes
-       CALL check_err( nf90_inq_varid(ncid, 'lat', varid) )
-       CALL check_err( nf90_get_var(ncid, varid, lat_src(:)) )
+       CALL check_err( nf90_inq_varid(ncid, 'lat', varid),"pb inq lat" )
+       CALL check_err( nf90_get_var(ncid, varid, lat_src(:)),"pb get lat" )
 
        ! Invert source latitudes
@@ -311,5 +311,5 @@
 ! 2) Find vertical dimension klev_src
 !****************************************************************************************
-       CALL check_err( nf90_inquire_dimension(ncid, dimid, len = klev_src) )
+       CALL check_err( nf90_inquire_dimension(ncid, dimid, len = klev_src),"pb inq dim for PRESNIVS or lev" )
        
      ! Allocate variables depending on the number of vertical levels
@@ -330,5 +330,5 @@
 !**************************************************************************************************
        ierr = nf90_inq_dimid(ncid, 'TIME',dimid)
-       CALL check_err( nf90_inquire_dimension(ncid, dimid, len = nbr_tsteps) )
+       CALL check_err( nf90_inquire_dimension(ncid, dimid, len = nbr_tsteps),"pb inq dim TIME" )
 !       IF (nbr_tsteps /= 12 .AND. nbr_tsteps /= 14) THEN
        IF (nbr_tsteps /= 12 ) THEN
@@ -339,43 +339,43 @@
 !****************************************************************************************
           ! Get variable id
-          CALL check_err( nf90_inq_varid(ncid, TRIM(varname), varid) )
+          CALL check_err( nf90_inq_varid(ncid, TRIM(varname), varid),"pb inq var "//TRIM(varname) )
           
           ! Get the variable
-          CALL check_err( nf90_get_var(ncid, varid, varyear(:,:,:,:)) )
+          CALL check_err( nf90_get_var(ncid, varid, varyear(:,:,:,:)),"pb get var "//TRIM(varname) )
           
 ! ++) Read surface pression, 12 month in one variable
 !****************************************************************************************
           ! Get variable id
-          CALL check_err( nf90_inq_varid(ncid, "ps", varid) )
+          CALL check_err( nf90_inq_varid(ncid, "ps", varid),"pb inq var ps" )
           ! Get the variable
-          CALL check_err( nf90_get_var(ncid, varid, psurf_glo2D) )
+          CALL check_err( nf90_get_var(ncid, varid, psurf_glo2D),"pb get var ps" )
           
 ! ++) Read mass load, 12 month in one variable
 !****************************************************************************************
           ! Get variable id
-          CALL check_err( nf90_inq_varid(ncid, "load_"//TRIM(varname), varid) )
+          CALL check_err( nf90_inq_varid(ncid, "load_"//TRIM(varname), varid) ,"pb inq var load_"//TRIM(varname))
           ! Get the variable
-          CALL check_err( nf90_get_var(ncid, varid, load_glo2D) )
+          CALL check_err( nf90_get_var(ncid, varid, load_glo2D),"pb get var load_"//TRIM(varname) )
           
 ! ++) Read ap
 !****************************************************************************************
           ! Get variable id
-          CALL check_err( nf90_inq_varid(ncid, "ap", varid) )
+          CALL check_err( nf90_inq_varid(ncid, "ap", varid),"pb inq var ap" )
           ! Get the variable
-          CALL check_err( nf90_get_var(ncid, varid, pt_ap) )
+          CALL check_err( nf90_get_var(ncid, varid, pt_ap),"pb get var ap" )
 
 ! ++) Read b
 !****************************************************************************************
           ! Get variable id
-          CALL check_err( nf90_inq_varid(ncid, "b", varid) )
+          CALL check_err( nf90_inq_varid(ncid, "b", varid),"pb inq var b" )
           ! Get the variable
-          CALL check_err( nf90_get_var(ncid, varid, pt_b) )
+          CALL check_err( nf90_get_var(ncid, varid, pt_b),"pb get var b" )
 
 ! ++) Read p0 : reference pressure
 !****************************************************************************************
           ! Get variable id
-          CALL check_err( nf90_inq_varid(ncid, "p0", varid) )
+          CALL check_err( nf90_inq_varid(ncid, "p0", varid),"pb inq var p0" )
           ! Get the variable
-          CALL check_err( nf90_get_var(ncid, varid, p0) )
+          CALL check_err( nf90_get_var(ncid, varid, p0),"pb get var p0" )
           
 
@@ -412,8 +412,8 @@
              
              ! Get variable id
-             CALL check_err( nf90_inq_varid(ncid, TRIM(cvar), varid) )
+             CALL check_err( nf90_inq_varid(ncid, TRIM(cvar), varid),"pb inq var "//TRIM(cvar) )
              
              ! Get the variable
-             CALL check_err( nf90_get_var(ncid, varid, varmth) )
+             CALL check_err( nf90_get_var(ncid, varid, varmth),"pb get var "//TRIM(cvar) )
              
              ! Store in variable for the whole year
@@ -432,5 +432,5 @@
 ! 4) Close file  
 !****************************************************************************************
-       CALL check_err( nf90_close(ncid) )
+       CALL check_err( nf90_close(ncid),"pb in close" )
      
 
@@ -570,5 +570,5 @@
 
 
-  SUBROUTINE check_err(status)
+  SUBROUTINE check_err(status,text)
     USE netcdf
     IMPLICIT NONE
@@ -576,7 +576,11 @@
     INCLUDE "iniprint.h"
     INTEGER, INTENT (IN) :: status
+    CHARACTER(len=*), INTENT (IN), OPTIONAL :: text
 
     IF (status /= NF90_NOERR) THEN
-       WRITE(lunout,*) 'Error in get_aero_fromfile ',status
+       WRITE(lunout,*) 'Error in get_aero_fromfile, netcdf error code = ',status
+       IF (PRESENT(text)) THEN
+          WRITE(lunout,*) 'Error in get_aero_fromfile : ',text
+       END IF
        CALL abort_gcm('get_aero_fromfile',trim(nf90_strerror(status)),1)
     END IF
Index: LMDZ5/branches/testing/libf/phylmd/readaerosol_interp.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/readaerosol_interp.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/readaerosol_interp.F90	(revision 1665)
@@ -175,5 +175,5 @@
      ! Reading values corresponding to the closest year taking into count the choice of aer_type. 
      ! For aer_type=scenario interpolation between 2 data sets is done in readaerosol.
-     ! If aer_type=mix1 or mix2, the run type and file name depends on the aerosol.
+     ! If aer_type=mix1, mix2 or mix3, the run type and file name depends on the aerosol.
      IF (aer_type=='preind' .OR. aer_type=='actuel' .OR. aer_type=='annuel' .OR. aer_type=='scenario') THEN
         ! Standard case
@@ -196,4 +196,13 @@
         ELSE
            filename='aerosols'
+           type='preind'
+        END IF
+     ELSE  IF (aer_type == 'mix3') THEN
+        ! Special case using a mix of annual sulfate file and natrual aerosols
+        IF (name_aero(id_aero) == 'SO4') THEN
+           filename='aerosols'
+           type='annuel'
+        ELSE
+           filename='aerosols' 
            type='preind'
         END IF
Index: LMDZ5/branches/testing/libf/phylmd/traclmdz_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/traclmdz_mod.F90	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/traclmdz_mod.F90	(revision 1665)
@@ -84,5 +84,5 @@
 
 
-  SUBROUTINE traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage)
+  SUBROUTINE traclmdz_init(pctsrf, xlat, xlon, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage)
     ! This subroutine allocates and initialize module variables and control variables.
     ! Initialization of the tracers should be done here only for those not found in the restart file.
@@ -99,4 +99,6 @@
 ! Input variables
     REAL,DIMENSION(klon,nbsrf),INTENT(IN)     :: pctsrf ! Pourcentage de sol f(nature du sol)
+    REAL,DIMENSION(klon),INTENT(IN)           :: xlat   ! latitudes en degres pour chaque point 
+    REAL,DIMENSION(klon),INTENT(IN)           :: xlon   ! longitudes en degres pour chaque point 
     REAL,DIMENSION(klon,nbsrf),INTENT(IN)     :: ftsol  ! Temperature du sol (surf)(Kelvin)
     REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri! Concentration Traceur [U/KgA]  
Index: LMDZ5/branches/testing/libf/phylmd/wrgradsfi.F
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/wrgradsfi.F	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/wrgradsfi.F	(revision 1665)
@@ -23,5 +23,5 @@
 c   local
 
-      integer lm,l,lnblnk
+      integer lm,l
 
 
Index: LMDZ5/branches/testing/libf/phylmd/write_bilKP_ave.h
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/write_bilKP_ave.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/write_bilKP_ave.h	(revision 1665)
@@ -9,5 +9,5 @@
 c Champs 2D:
 c
-      itau_w = itau_phy + itap
+      itau_w = itau_phy + itap + start_time * day_step / iphysiq
 c
 cym      CALL gr_fi_ecrit(klev, klon,iim,jjmp1, ue_lay,zx_tmp_3d)
Index: LMDZ5/branches/testing/libf/phylmd/write_bilKP_ins.h
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/write_bilKP_ins.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/write_bilKP_ins.h	(revision 1665)
@@ -7,5 +7,5 @@
       ndex3d = 0
 c
-      itau_w = itau_phy + itap
+      itau_w = itau_phy + itap + start_time * day_step / iphysiq
 c
 c Champs 3D:
Index: LMDZ5/branches/testing/libf/phylmd/write_histISCCP.h
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/write_histISCCP.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/write_histISCCP.h	(revision 1665)
@@ -9,5 +9,5 @@
        ndex3d = 0
 c
-       itau_w = itau_phy + itap
+       itau_w = itau_phy + itap + start_time * day_step / iphysiq
 c
        IF(type_run.EQ."ENSP".OR.type_run.EQ."CLIM") THEN
Index: LMDZ5/branches/testing/libf/phylmd/write_histREGDYN.h
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/write_histREGDYN.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/write_histREGDYN.h	(revision 1665)
@@ -8,5 +8,5 @@
 
       ndex3d = 0
-      itau_w = itau_phy + itap
+      itau_w = itau_phy + itap + start_time * day_step / iphysiq
 c
        CALL histwrite(nid_regdyn,"hw1",itau_w,histoW(:,:,:,1),
Index: LMDZ5/branches/testing/libf/phylmd/write_histdayNMC.h
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/write_histdayNMC.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/write_histdayNMC.h	(revision 1665)
@@ -5,5 +5,5 @@
 c
        ndex3d = 0
-       itau_w = itau_phy + itap
+       itau_w = itau_phy + itap + start_time * day_step / iphysiq
 ccc
 c  Champs interpolles sur des niveaux de pression du NMC
Index: LMDZ5/branches/testing/libf/phylmd/write_histday_seri.h
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/write_histday_seri.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/write_histday_seri.h	(revision 1665)
@@ -7,5 +7,5 @@
 c
       ndex2d = 0
-      itau_w = itau_phy + itap
+      itau_w = itau_phy + itap + start_time * day_step / iphysiq
 c
 c Champs 2D:
Index: LMDZ5/branches/testing/libf/phylmd/write_histhf3d.h
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/write_histhf3d.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/write_histhf3d.h	(revision 1665)
@@ -7,5 +7,5 @@
       ndex3d = 0
 c
-      itau_w = itau_phy + itap
+      itau_w = itau_phy + itap + start_time * day_step / iphysiq
 c
 c Champs 3D:
Index: LMDZ5/branches/testing/libf/phylmd/write_histhfNMC.h
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/write_histhfNMC.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/write_histhfNMC.h	(revision 1665)
@@ -5,5 +5,5 @@
 c
        ndex3d = 0
-       itau_w = itau_phy + itap
+       itau_w = itau_phy + itap + start_time * day_step / iphysiq
 ccc
 c  Champs interpolles sur des niveaux de pression du NMC
Index: LMDZ5/branches/testing/libf/phylmd/write_histmthNMC.h
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/write_histmthNMC.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/write_histmthNMC.h	(revision 1665)
@@ -5,5 +5,5 @@
 c
        ndex3d = 0
-       itau_w = itau_phy + itap
+       itau_w = itau_phy + itap + start_time * day_step / iphysiq
 ccc
 c  Champs interpolles sur des niveaux de pression du NMC
Index: LMDZ5/branches/testing/libf/phylmd/write_histrac.h
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/write_histrac.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/write_histrac.h	(revision 1665)
@@ -5,5 +5,5 @@
   IF (ecrit_tra > 0.) THEN
      
-     itau_w = itau_phy + nstep
+     itau_w = itau_phy + nstep + start_time * day_step / iphysiq
      
      CALL histwrite_phy(nid_tra,.FALSE.,"phis",itau_w,pphis)
Index: LMDZ5/branches/testing/libf/phylmd/write_paramLMDZ_phy.h
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/write_paramLMDZ_phy.h	(revision 1664)
+++ LMDZ5/branches/testing/libf/phylmd/write_paramLMDZ_phy.h	(revision 1665)
@@ -27,5 +27,5 @@
 c
       ndex2d = 0
-      itau_w = itau_phy + itap
+      itau_w = itau_phy + itap + start_time * day_step / iphysiq
 c
 c Variables globales
